Sub DrawMolecule
' insert sort for drawing order
order = ""
order[-1] = 0 ' start
order[0] = -1 ' end
For j = 1 To 8
param = ""
_i = -1
i = order[-1]
gt = "True"
While gt And (-1 < i)
param["name1"] = "v" + i
param["name2"] = "v" + j
Vector_Comp()
If gt Then
_i = i ' last i
i = order[i]
EndIf
EndWhile
' insert vj before vi (or end)
order[_i] = j
order[j] = i
EndFor
' draw atoms
i = -1
i = order[i]
n = 0
If debug Then
buf = buf + "drawing order" + LF
EndIf
v0done = "False"
While -1 < i
vertex = "v" + i
If vertex = "v0" Then
' draw C
a = "C"
v0done = "True"
ElseIf vertex = "v1" Then
' draw C
a = "C"
ElseIf vertex = "v2" Then
' draw O
a = "O"
v2done = "True"
Else
' draw H
a = "H"
EndIf
size = atom[a]["size"]
entry = matrix[vertex]
values = entry["values"]
x = values[1][1]
y = values[2][1]
If a = "C" Then
' draw shadow
GraphicsWindow.BrushColor = "#11111111"
GraphicsWindow.FillRectangle(0, 0, gw, gh)
EndIf
If v0done And ((a = "H") Or (vertex = "v1") Or (vertex = "v2")) Then
DrawArm()
EndIf
GraphicsWindow.BrushColor = atom[a]["color"]
n = n + 1
GraphicsWindow.FillEllipse(gw / 2 + x - size / 2, gh / 2 + y - size / 2, size, size)
If debug Then
buf = buf + n + " : " + vertex + LF
EndIf
If Not[v0done] And ((a = "H") Or (vertex = "v1") Or (vertex = "v2")) Then
DrawArm()
EndIf
i = order[i]
EndWhile
If debug Then
DumpBuf()
EndIf
EndSub
Sub DrawMolecularName
GraphicsWindow.FontName = "Trebuchet MS"
GraphicsWindow.BrushColor = "Black"
x = 30
For p = 1 To Text.GetLength(mol)
c = Text.GetSubText(mol, p, 1)
If c = "_" Then
y = 35
p = p + 1
fs = 20
c = Text.GetSubText(mol, p, 1)
Else
y = 20
fs = 30
EndIf
GraphicsWindow.FontSize = fs
GraphicsWindow.DrawText(x, y, c)
x = x + fs * 0.7
EndFor
EndSub
Sub DumpBuf
Shapes.SetText(console, buf)
EndSub
Sub Format
' format value as ###0.00
value = value * 1
dot = Text.GetIndexOf(value, DECIMAL)
If 0 < dot Then
value = Math.Round(value * 100) / 100
Else
value = Text.Append(value, ".")
EndIf
dot = Text.GetIndexOf(value, DECIMAL)
len = Text.GetLength(value)
If len < dot + 2 Then
value = Text.Append(value, Text.GetSubText("00", 1, dot + 2 - len))
EndIf
len = Text.GetLength(value)
If len < 7 Then
value = Text.Append(Text.GetSubText(" ", 1, 7 - len), value)
EndIf
EndSub
Sub Init
debug = "False"
Not = "False=True;True=False;"
DECIMAL = "."
LF = Text.GetCharacter(10)
space = " "
For l = 3 To 10
space = space + " "
sp[l] = space
EndFor
GraphicsWindow.BackgroundColor = "LightGray"
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.FontName = "Consolas"
GraphicsWindow.FontSize = 12
console = Shapes.AddText("")
gw = GraphicsWindow.Width
gh = GraphicsWindow.Height
Shapes.Move(console, gw - 150, 10)
buf = ""
EndSub
Sub Rotate
buf = ""
param = "name1=R;"
For vi = 1 To 24
param["name2"] = "v" + vi
param["name"] = "v" + vi
Matrix_Mul()
If vi <= 8 Then
Matrix_Dump()
EndIf
EndFor
EndSub
Sub Matrix_Add
' add two matrices
' param["name1"] - left matrix name
' param["name2"] - right matrix name
' param["name"] - matrix name to return
name1 = param["name1"]
entry1 = matrix[name1]
cols1 = entry1["cols"]
rows1 = entry1["rows"]
name2 = param["name2"]
entry2 = matrix[name2]
cols2 = entry2["cols"]
rows2 = entry2["rows"]
If (cols1 = cols2) And (rows1 = rows2) Then
values1 = entry1["values"]
values2 = entry2["values"]
values = ""
For col = 1 To cols1
For row = 1 To rows1
values[row][col] = values1[row][col] + values2[row][col]
EndFor
EndFor
name = param["name"]
If Array.ContainsIndex(matrix, name) Then
entry = ""
entry["cols"] = cols1
entry["rows"] = rows1
entry["values"] = values
matrix[name] = entry
Else
Stack.PushValue("local", param)
param = ""
param["name"] = name
param["cols"] = cols1
param["rows"] = rows1
param["init"] = values
Matrix_Init()
param = Stack.PopValue("local")
EndIf
Else
msg = "rows1 = " + rows1 + ", rows2 = " + rows2 + LF
msg = msg + "cols1 = " + cols1 + ", cols2 = " + cols2
If rows1 <> rows2 Then
msg = "Matrix " + name1 + " has " + rows1 + " row[s],"
msg = LF + "but matrix " + name2 + " has " + rows2 + " row[s]"
EndIf
If cols1 <> cols2 Then
msg = "Matrix " + name1 + " has " + cols1 + " column[s],"
msg = LF + "but matrix " + name2 + " has " + cols2 + " column[s]"
EndIf
GraphicsWindow.ShowMessage(msg, "Matrix_Add Error")
EndIf
EndSub
Sub Matrix_Dump
' param["name"] - matrix name to set
name = param["name"]
entry = matrix[name]
rows = entry["rows"]
cols = entry["cols"]
values = entry["values"]
left = name + " = "
For row = 1 To rows
buf = buf + left
If row = 1 Then
left = sp[Text.GetLength(left)]
EndIf
For col = 1 To cols
value = values[row][col]
Format()
buf = buf + value
If col < cols Then
buf = buf + " "
EndIf
EndFor
buf = buf + LF
DumpBuf()
EndFor
EndSub
Sub Matrix_Init
' param["name"] - matrix name to initialize
' param["rows"] - number of rows
' param["cols"] - number of columns
' param["init"] - initial data array
name = param["name"]
rows = param["rows"]
cols = param["cols"]
init = param["init"]
_init = ""
_rows = Array.GetItemCount(init)
_row = Array.GetAllIndices(init)
For j = 1 To _rows
row = _row[j]
_cols = Array.GetItemCount(init[row])
_col = Array.GetAllIndices(init[row])
For i = 1 To _cols
col = _col[i]
_init[row][col] = init[row][col]
EndFor
EndFor
entry["rows"] = rows
entry["cols"] = cols
entry["values"] = _init
matrix[name] = entry
EndSub
Sub Matrix_Mul
' multiply two matrices
' param["name1"] - left matrix name
' param["name2"] - right matrix name
' param["name"] - matrix name to return
name1 = param["name1"]
entry1 = matrix[name1]
cols1 = entry1["cols"]
rows1 = entry1["rows"]
name2 = param["name2"]
entry2 = matrix[name2]
cols2 = entry2["cols"]
rows2 = entry2["rows"]
If cols1 = rows2 Then
values1 = entry1["values"]
values2 = entry2["values"]
values = ""
For col = 1 To cols2
For row = 1 To rows1
For i = 1 To cols1
values[row][col] = values[row][col] + values1[row][i] * values2[i][col]
EndFor
EndFor
EndFor
name = param["name"]
Stack.PushValue("local", param)
param = ""
param["name"] = name
param["cols"] = cols2
param["rows"] = rows1
param["init"] = values
Matrix_Init()
param = Stack.PopValue("local")
Else
msg = "Matrix " + name1 + " has " + cols1 + "column[s],"
msg = msg + LF + "but matrix " + name2 + " has " + rows2 + "row[s]"
GraphicsWindow.ShowMessage(msg, "Matrix_Mul Error")
EndIf
EndSub
Sub Vector_Abs
' calculate vector length
' param["name"] - 1×n matrix for vector
' return - vector length
name = param["name"]
entry = matrix[name]
cols = entry["cols"]
If cols = 1 Then
values = entry["values"]
return = 0
For row = 1 To entry["rows"]
return = return + Math.Power(values[row][1], 2)
EndFor
return = Math.SquareRoot(return)
Else
msg = "Vector " + name + " has " + cols + "columns"
GraphicsWindow.ShowMessage(msg, "Vector_Abs Error")
EndIf
EndSub
Sub Vector_Comp
' param["name1"] - v1 name to compare
' param["name2"] - v2 name to compare
' return le - "True" if v1 <= v2
' return lt - "True" if v1 < v2
' return eq - "True" if v1 = v2
' return ge - "True" if v1 >= v2
' return gt - "True" if v1 > v2
name1 = param["name1"]
name2 = param["name2"]
entry1 = matrix[name1]
entry2 = matrix[name2]
cols1 = entry1["cols"]
cols2 = entry2["cols"]
rows1 = entry1["rows"]
rows2 = entry2["rows"]
If cols1 <> 1 Then
msg = "Vector " + name1 + " has " + cols1 + "columns"
GraphicsWindow.ShowMessage(msg, "Vector_Comp Error")
ElseIf rows1 <> 3 Then
msg = "Vector " + name1 + " has " + rows1 + "row[s]"
GraphicsWindow.ShowMessage(msg, "Vector_Comp Error")
ElseIf cols2 <> 1 Then
msg = "Vector " + name2 + " has " + cols2 + "columns"
GraphicsWindow.ShowMessage(msg, "Vector_Comp Error")
ElseIf rows2 <> 3 Then
msg = "Vector " + name1 + " has " + rows2 + "row[s]"
GraphicsWindow.ShowMessage(msg, "Vector_Comp Error")
Else
values1 = entry1["values"]
values2 = entry2["values"]
z1 = values1[3][1]
z2 = values2[3][1]
lt = "False"
le = "False"
eq = "False"
gt = "False"
ge = "False"
If z1 < z2 Then
lt = "True"
le = "True"
ElseIf z1 = z2 Then
y1 = values1[2][1]
y2 = values2[2][1]
If y1 < y2 Then
gt = "True"
ge = "True"
ElseIf y1 = y2 Then
x1 = values1[1][1]
x2 = values2[1][1]
If x1 < x2 Then
gt = "True"
ge = "True"
ElseIf x1 = x2 Then
le = "True"
eq = "True"
ge = "True"
Else ' x1 > x2
le = "True"
lt = "True"
EndIf
Else ' y1 > y2
le = "True"
lt = "True"
EndIf
Else ' z1 > z2
gt = "True"
ge = "True"
EndIf
EndIf
EndSub
Program Listing: JXK757