'''''''''''''''''''''''''''''''''''''''''''''''
'Deoxyribonucleic and Ribonucleic acid builder'
'''''''''''''''''''''''''''''''''''''''''''''''

const Title = "Nucleic Acid Builder"

function Main as string

Dim Form, CurrentDoc, Page, TextBox as object
Dim Done, CheckPage as boolean
Dim SHand, Type, WhatToBuild, HBonds,TempStr, Text as string
Dim i, CommitNAcid, TextLen, h, DiagAndTextBoxNum as integer

  CurrentDoc = ActiveDocument
  Page = CurrentDoc.ActivePage	
  if (CurrentDoc.Count = 1) and (Page.Drawings.Count = 0) then 
    if not CurrentDoc.SaveDoc then
      Main = "You have to save your document to execute the function."
      exit function
    end if
  end if
  DiagAndTextBoxNum = Page.Drawings.Count
  if DiagAndTextBoxNum > 0 then Page = ActiveDocument.AddEmpty
  Type = "DNA"
  WhatToBuild = "The whole structure"
  HBonds = ""
  SHand = "5-ACTGGG-3"

  Do
    Done = False
    Form = ReadForm("Nuclbld.frm")
    Form.SetStrValue("Type", Type)
    Form.SetStrValue("WhatToBuild", WhatToBuild)
    Form.SetStrValue("SHand", SHand)
    'Display form
    If Form.ExecForm Then
      Type = Form.GetStrValue("Type")
      WhatToBuild = Form.GetStrValue("WhatToBuild")
      SHand = Form.GetStrValue("SHand")
    Else
      Main = "Cancelled"
      Exit Function
    End If
    Text = Type
    HBonds = ""
    if Type = "DNA" Then
      Done = MakeCommitment(Page, 4, WhatToBuild, SHand, HBonds) 
      TextBox = Page.TextBoxes.AddEmpty
      TextBox.SetContent("Deoxyribonucleic acid short-hand:")
      h = 100
      Textbox.SetBound(160, 150, 2000, h)
    Else
      Done = MakeCommitment(Page, 0, WhatToBuild, SHand, HBonds)
      TextBox = Page.TextBoxes.AddEmpty
      TextBox.SetContent("Ribonucleic acid short-hand:")
      h = 100
      Textbox.SetBound(160, 150, 2000, h)
    End If
  Loop While not Done
  Main = "Completed."

end function 

'''''''''''''''''''''''''''''''''''''''''
'Check the TextBox and make a commitment'
'''''''''''''''''''''''''''''''''''''''''
function MakeCommitment(Page as object, ByVal CommitNAcid as integer, WhatToBuild As String, SHand As String, HBonds As String) as boolean
Dim Text, TempStr, ChainText, Chain2Text, NewChain, ModifText, TempMess as string
Dim Res1, Res2 as boolean
Dim Form, TextBox, Atoms, Atom as object
Dim h as integer

  MakeCommitment = False
  Text = WhatToBuild
  If WhatToBuild = "The whole structure" Then
        ChainText = SHand
        ChainText = Remove3And5(RemoveSpaces(ChainText))
        Res1 = CheckText(ChainText, CommitNAcid)
        If Res1 = False Then Exit Function
        ModifText = "5-" + ChainText + "-3"
        TextBox = Page.TextBoxes.AddEmpty
        TextBox.SetContent(Ucase(ModifText))
        Textbox.SetBound(160, 200, 1000, 100)
        ChainText = ConvertText(ChainText)
        Chain2Text = BuildSecondChain(ChainText, CommitNAcid)
        Chain2Text = ConvertText(Chain2Text)
        NewChain = "3-" + Chain2Text + "-5"
        TextBox = Page.TextBoxes.AddEmpty
        TextBox.SetContent(Ucase(NewChain))
        Textbox.SetBound(160, 250, 1000, 100)
        Atoms = BuildChainOfNAcidStructure(Page, CommitNAcid, Ucase(ChainText), 4)
        if (HBonds <> "") then
            ShowDiagram(Page, Atoms.Structures.Item(1), 4)
            AddSolidLines()
            MakeCommitment = True
            exit function
        end if
        for each Atom in Atoms
             if (Ucase(Atom.GetName) = "A1") or (Ucase(Atom.GetName) = "A2") or (Ucase(Atom.GetName) = "A3") then
      		Atom.SetName("")
      		Atom.SetElNumber(1)
      		Atom.SetMass(1.0079)
             end if
        next Atom
        ShowDiagram(Page, Atoms.Structures.Item(1), 4)
        Kill(Atoms)
  else
        Text = SHand
        TextBox = Page.TextBoxes.AddEmpty
        ChainText = Remove3And5(RemoveSpaces(Text))
        Res1 = CheckText(ChainText, CommitNAcid)
        If Res1 = False Then Exit Function
        ModifText = "5-" + ChainText + "-3"
        TextBox.SetContent(Ucase(ModifText))
        Textbox.SetBound(160, 200, 1000, 100)
        ChainText = ConvertText(ChainText)
        Atoms = BuildChainOfNAcidStructure(Page, CommitNAcid, Ucase(ChainText), 0)
        ShowDiagram(Page, Atoms.Structures.Item(1), 0)
        Kill(Atoms)
  end if	
  MakeCommitment = True	

end function

''''''''''''''''''''''''''''
'Add line like a DrawObject'
''''''''''''''''''''''''''''
sub AddSolidLines()
Dim Atom1, Atoms1, Diag1, Conf1, Mol1, Struct, Assembl as object
Dim x1, y1, z1, MinDist as double
Dim TempDoc, Line, MyLine as object
Dim MyPen, l, t, w, h as integer
Dim CurrentDoc, Page as object
Dim Font as object
	CurrentDoc = ActiveDocument
	Page = CurrentDoc.ActivePage
	TempDoc = Documents.AddFromFile("csdocs\Hbond.sk2", FT_SKETCH)
	if TempDoc = NULL then Stop "Error: Doc is NULL."
	CurrentDoc.SetActiveDocument
	Line = TempDoc.Item(1).Drawings.Item(1)
	Diag1 = Page.Diagrams.Item(1)
	Font = Diag1.GetFont
	Atoms1 = Assemblies.AddFromCS(Diag1)
	if Atoms1 = NULL then MessageBox("NULL", "Error",MBB_OK) 
	Conf1 = Atoms1.Conformations.Item(1)
	Mol1= Atoms1.Molecules.Item(1)
	MinDist = 1.7*GetMinBondLength(Conf1, Mol1)
	for each Atom1 in Atoms1
		if UCase(Atom1.GetName) = "A1" then
			Conf1.GetAtomXYZ(Atom1, x1, y1, z1)
			Atom1.SetName("")
			Atom1.SetElNumber(1)
			Atom1.SetMass(1.0079)
			MyLine = Line.LoadOnto(Page)
			if MyLine = NULL then MessageBox("Line is NULL", "Error",MBB_OK)
			MyLine.SetBound(Int(A2Pixel(x1 + 0.2)), -Int(A2Pixel(y1)), Int(A2Pixel(MinDist)), 0)
		end if
		if UCase(Atom1.GetName) = "A2" then
			Conf1.GetAtomXYZ(Atom1, x1, y1, z1)
			Atom1.SetName("")
			Atom1.SetElNumber(1)
			Atom1.SetMass(1.0079)
			MyLine = Line.LoadOnto(Page)
			MyLine.SetBound(Int(A2Pixel(x1-MinDist-0.2)), -Int(A2Pixel(y1)), Int(A2Pixel(MinDist)), 0)
		end if
	next Atom1
	Diag1.GetBound(l, t, w, h)
	Assembl = Atoms1.Self
	Struct = Assembl.Structures.Item(1)
	Diag1.Depict(Struct)
	Diag1.SetFont(Font)
	Kill(TempDoc)
end sub

function Remove3And5 (ByVal Text as string) as string
Dim pos, i, TextLen as integer
Dim SLet, TempStr as string
	TextLen = Len(Text)
	TempStr = ""
	for i = 1 to TextLen
		SLet = Mid(Text, i, 1)
		if (SLet <> "3") And (SLet <> "5") And (SLet <> "-") then TempStr = TempStr + SLet
	next i
	Remove3And5 = TempStr
end function

function ConvertText (ByVal Text as string) as string
Dim pos, i, TextLen as integer
Dim SLet, TempStr as string
	TextLen = Len(Text)
	TempStr = ""
	for i = TextLen to 1 step -1
		SLet = Mid(Text, i, 1)
		TempStr = TempStr + SLet
	next i
	ConvertText = TempStr
end function

function RemoveSpaces(ByVal Text as string) as string
Dim i, TextLen as integer
Dim SLet, TempStr as string
	TextLen = Len(Text)
	TempStr = ""
	for i = 1 to TextLen
		SLet = Mid(Text, i, 1)
		if SLet <> " " then TempStr = TempStr + SLet
	next i
	RemoveSpaces = TempStr
end function

function CheckText(Text as string, byval CommitNAcid as integer) as boolean
Dim TempStr, SLet, NAcidNameStr as string
Dim pos, TextLen, i as integer

	CheckText = False	
	TextLen = Len(Text)
	TempStr = "You entered an illegal symbol. Only the following letters are acceptable:" + Chr(13)+ "A,C,G,T,U."
	if TextLen = 0 then
		MessageBox(TempStr, Title,MBB_OK or MBI_STOP)
		exit function
	end if
	if TextLen > 20 then
		TempStr = "Please reduce short-hand form." 
		MessageBox(TempStr, Title,MBB_OK)
 		exit function
	end if
	if CommitNAcid = 4 then NAcidNameStr = "CGAT"
	if CommitNAcid = 0 then NAcidNameStr = "CGAU"
	for i = 1 to TextLen
		SLet = Mid(Ucase(Text),i,1)
		pos = InStr(1, NAcidNameStr, SLet)
		'TempStr = "You entered an illegal symbol. Only the following letters are acceptable:" + Chr(13)+ "A,C,G,T,U."
		if pos = 0 then
			if CommitNAcid = 4 and Ucase(SLet) = "U" then TempStr = "There mustn't be any uracil in the DNA structure."
			if CommitNAcid = 0 and Ucase(SLet) = "T" then TempStr = "There mustn't be any thymine in RNA structure."
			MessageBox(TempStr, Title,MBB_OK or MBI_STOP)
			exit function
		end if
	next i
	CheckText = True
end function

function BuildSecondChain(Text as string, CommitNAcid as integer) as string 
Dim TempStr, TLet, SLet as string
Dim i, pos as integer
Dim NAcidNameStr as string
	NAcidNameStr = "CGAU"
	if CommitNAcid = 4 then
		NAcidNameStr = "CGAT"
		TempStr = ""
		for i = 1 to Len(Text)
			SLet = Mid(Text,i,1)
			pos = InStr(1, NAcidNameStr, Ucase(SLet))
			select case pos
				case 1
					TLet = "G"
				case 2
					TLet = "C"
				case 3
					TLet = "T"
				case 4
					TLet = "A"
			end select
			TempStr = TempStr + TLet
		next i
		BuildSecondChain = TempStr
		exit function
	end if
	TempStr = ""
	for i = 1 to Len(Text)
		SLet = Mid(Text,i,1)
		pos = InStr(1, NAcidNameStr, Ucase(SLet))
		select case pos
			case 1
				TLet = "G"
			case 2
				TLet = "C"
			case 3
				TLet = "U"
			case 4
				TLet = "A"
		end select
		TempStr = TempStr + TLet
	next i
	BuildSecondChain = TempStr

end function



function BuildChainOfNAcidStructure(Page as object, CommitNAcid as integer, byval Text as string, byval SOrWStruct as integer) as object
Dim MainAssembl, Assembl, MainMol, Mol, MainConf, Conf, MainStruct, Struct as object
Dim x, y, z, x1, y1, z1, x2, y2, z2, dx, dy, dxR1R2, mx, my, mz, DistAtoms as double
Dim i, pos, TextLen, SorW as integer
Dim Atom, R1Atom, R2Atom, MainR1Atom, R3Atom, R4Atom, MainR3Atom as object
Dim SLet, NAcidNameStr, NAcidFileName as string
Dim Res as boolean
	BuildChainOfNAcidStructure = NULL
	MainAssembl = NULL
	MainR1Atom = NULL
	Res = CheckText(Text, CommitNAcid)
	if Res = False then exit function
	TextLen = Len(Text)
	for i = 1 to TextLen
		SLet = Mid(Text, i, 1)
		if CommitNAcid = 4 then
			 NAcidNameStr = "CGAT"
			pos = InStr(1, NAcidNameStr, SLet)
			pos = pos + SOrWStruct
			select case pos
				case 1
					NAcidFileName = "Mol/cyt2.mol"
				case 2
					NAcidFileName = "Mol/gua2.mol"
				case 3
					NAcidFileName = "Mol/aden2.mol"
				case 4
					NAcidFileName = "Mol/thym.mol"
				case 5
					NAcidFileName = "Mol/cytgua2.mol"
				case 6
					NAcidFileName = "Mol/guacyt2.mol"
				case 7
					NAcidFileName = "Mol/adethy.mol"
				case 8
					NAcidFileName = "Mol/thyade.mol"
			end select
		end if
		if CommitNAcid = 0 then 
			NAcidNameStr = "CGAU"
			pos = InStr(1, NAcidNameStr, SLet)
			pos = pos + CommitNAcid + SOrWStruct
			select case pos
				case 1
					NAcidFileName = "Mol/cyt1.mol"
				case 2
					NAcidFileName = "Mol/gua1.mol"
				case 3
					NAcidFileName = "Mol/aden1.mol"
				case 4
					NAcidFileName = "Mol/uri.mol"
				case 5
					NAcidFileName = "Mol/cytgua1.mol"
				case 6
					NAcidFileName = "Mol/guacyt1.mol"
				case 7
					NAcidFileName = "Mol/adeuri.mol"
				case 8
					NAcidFileName = "Mol/uriade.mol"
			end select
		end if

		Assembl = Assemblies.AddFromFile(NAcidFileName,FT_MOL)
		if Assembl = NULL then
			MessageBox("Assembly is NULL", "Error", MBB_OK)	
			exit function
		end if
		Mol = Assembl.Molecules.Item(1)
		Conf = Assembl.Conformations.Item(1)	
		if MainAssembl = NULL then
			MainAssembl = Assembl
			MainConf = MainAssembl.Conformations.Item(1)
			R2Atom = FindAtom(MainAssembl, "R2", False, False)
			R1Atom = FindAtom(MainAssembl, "R1", True, True)
			R3Atom = FindAtom(MainAssembl, "R3", True, False)
			R4Atom = FindAtom(MainAssembl, "R4", False, False)
			MainConf.GetAtomXYZ(R1Atom, x1, y1, z1)
			MainConf.GetAtomXYZ(R2Atom, x2, y2, z2)
			dxR1R2 = x2-x1
			MainR3Atom = R3Atom
			MainR1Atom = R1Atom
			Goto L1
		end if

		MainMol = MainAssembl.Molecules.Item(1)
		if MainMol = NULL then
			MessageBox("Mol is NULL", "Error", MBB_OK)	
			exit function
		end if
		
		R2Atom = FindAtom(MainAssembl, "R2", True, False)
		R4Atom = FindAtom(MainAssembl, "R4", True, True)
		R1Atom = FindAtom(Assembl, "R1", False, True)
		R3Atom = FindAtom(MainAssembl, "R3", False, False)
		MainConf.GetAtomXYZ(R2Atom, mx, my, mz)
		Conf.GetAtomXYZ(R1Atom, x, y, z)
		dx = x-mx
		dy = y-my
		for each Atom in Assembl

			Conf.GetAtomXYZ(Atom, x1, y1, z1)
			Conf.SetAtomXYZ(Atom, x1-dx-dxR1R2, y1-dy-1.32, 0)

		next Atom
		Struct = Assembl.Structures.Item(1)
		MainAssembl.Merge(Struct)
		Kill(Assembl)

		MainMol = MainAssembl.Molecules.Item(1)
		MainStruct = MainAssembl.Structures.Item(1)
		R1Atom = FindAtom(MainAssembl, "R1", True, True)
		R3Atom = FindAtom(MainAssembl, "R3", True, False)
		if SOrWStruct = 4 then MainMol.AddBond(R3Atom, R4Atom, 1)
		MainMol.AddBond(R1Atom, R2Atom, 1)
L1:
	next i

	if MainAssembl <> NULL then
		R2Atom = FindAtom(MainAssembl, "R2", TRUE, False)
		R4Atom = FindAtom(MainAssembl, "R4", TRUE, True)
		R1Atom = MainR1Atom
		R3Atom = MainR3Atom
		AddNewAtomToMainStructure(MainAssembl, R2Atom, 1 )
		if SOrWStruct = 4 then AddNewAtomToMainStructure(MainAssembl, R3Atom, -1 )
		BuildChainOfNAcidStructure = MainAssembl
	end if
		
end function



sub FindLableAtom (Atoms as object, ByVal Lable as string, byval NewLable as string)
Dim Atom as object
Dim L1Atom, L2Atom as object
	L1Atom = NULL
	L2Atom = NULL
	for each Atom in Atoms
		if Atom.GetName = Lable then 
			L1Atom = Atom
		else 
			if Atom.GetName = NewLable then L2Atom = Atom
		end if
		if (L1Atom <> NULL) and (L2Atom <> NULL) then exit for
	next Atom	

	if (L1Atom <> NULL) and (L2Atom <> NULL) then 
		L1Atom.SetName(NewLable)
		L2Atom.SetName(Lable)
	end if
end sub

function FindAtom (Atoms as object, ByVal Lable as String, byval ChangeLable as boolean, ByVal ChangeAtom as boolean) as object
Dim Atom as object
	for each Atom in Atoms
		if Atom.GetName = Lable then
			if ChangeLable = TRUE then Atom.SetName("")
			if ChangeAtom = True then 
				Atom.GetElNumber
				Atom.SetElNumber(8)
				Atom.SetMass(15.9994)
			end if
			FindAtom = Atom
			exit function
		end if
	next Atom	
end function

sub ShowDiagram (Page as object, Struct as object, ByVal SingleOrWholeStruct as integer) 
Dim Diagram as object
Dim l, t, ph, pw, dh, dw as integer
Dim scaleX, scaleY, minScale as double
	pw = Page.GetWidth
	ph = Page.GetHeight
	Diagram = Page.Diagrams.AddEmpty
	Diagram.Depict(Struct)
	Diagram.GetBound(l, t, dw, dh)

	if SingleOrWholeStruct = 2 then
		if (dw < pw-160) and (dh < ph-300) then
			Diagram.SetBound(Int(pw/3), 300, dw, dh)
			exit sub
		end if
		scaleX = (pw-160)/dw
		scaleY = (ph-450)/dh
		minScale = MinDouble(scaleX, scaleY)
		Diagram.SetBound(Int(pw/3), 600, Int(dw*minScale), Int(dh*minScale))
	end if
	
	if (dw < pw-100) and (dh < ph-600) then
		Diagram.SetBound(160, 300, dw, dh)
		exit sub
	end if
	scaleX = (pw-160)/dw
	scaleY = (ph-450)/dh
	minScale = MinDouble(scaleX, scaleY)
	Diagram.SetBound(160, 300, Int(dw*minScale), Int(dh*minScale))
end sub

function MinDouble(x1 as double, x2 as double) as double
	if x1 < x2 then MinDouble = x1
	MinDouble = x2
end function

sub AddNewAtomToMainStructure(Atoms as object, CurAtom as object,ByVal dxR1R2 as double)
Dim Atom, Mol, Conf as object
Dim x, y, z as double
	Atom = NewAtom(8)
	Atoms.Add(Atom)
	Mol = Atoms.Molecules.Item(1)
	Mol.AddBond(CurAtom, Atom, 1)
	Conf = Atoms.Conformations.Item(1)
	Conf.GetAtomXYZ(CurAtom, x, y, z)
	Conf.SetAtomXYZ(Atom,x-dxR1R2,y-dxR1R2,0)
end sub

function GetMinBondLength(Conf as Object, Mol as Object) as Double
Dim MinIsFound as Boolean
Dim MinDist, Dist as Double
Dim CurBond as Object
	MinIsFound = False
	MinDist = 0
	for each CurBond in Mol
		Dist = Conf.GetDist(CurBond.Atom1, CurBond.Atom2)
		if (not MinIsFound) or (Dist < MinDist) then MinDist = Dist
		MinIsFound = True
	next CurBond

	GetMinBondLength = MinDist
end function
