Microsoft Small Basic

Program Listing:
Embed this in your website
' Ethanol Rotation Anime
' Copyright © 2020 Nonki Takahashi. The MIT License.
' Last update 2020-03-11

GraphicsWindow.Title = "Ethanol Rotation Anime"
Init()
atom["H"] = "color=White;size=55;1=32;"
atom["C"] = "color=Black;size=85;1=75;2=67;3=60;"
atom["O"] = "color=#EE0000;size=76;1=63;2=57;3=53;"
sH = atom["H"]["size"]
dH = atom["H"][1]
sC = atom["C"]["size"]
dC = atom["C"][1]
sO = atom["O"]["size"]
dO = atom["O"][1]
root2 = Math.SquareRoot(2)
root3 = Math.SquareRoot(3)
mol = "C_2H_5OH"
DrawMolecularName()
gw = GraphicsWindow.Width
gh = GraphicsWindow.Height
' calculate v0 (C)
v[1][1] = 0
v[2][1] = 0
v[3][1] = 0
param = "name=v0;rows=3;cols=1;"
param["init"] = v
Matrix_Init()
Matrix_Dump()
' calculate v1 (C)
v[1][1] = -1
v[2][1] = 1
v[3][1] = 1
param = "name=v1;rows=3;cols=1;"
param["init"] = v
Matrix_Init()
Vector_Abs()
abs_v1 = return
origin = 0
arm = 1
CalcArm()
k[1][1] = (dC + dC) / abs_v1
param = "name=kCC;rows=1;cols=1;"
param["init"] = k ' = (dC + dC) / |v1|
Matrix_Init()
Matrix_Dump()
param = "name1=v1;name2=kCC;name=v1;"
Matrix_Mul()
Matrix_Dump()
Vector_Abs()
buf = buf + "|v1| = " + (Math.Round(return * 100) / 100) + LF
DumpBuf()
k[1][1] = (dC + dO) / abs_v1
param = "name=kCO;rows=1;cols=1;"
param["init"] = k ' = (dC + dO) / |v1|
Matrix_Init()
Matrix_Dump()
' calculate v2 (O)
v[1][1] = 1
v[2][1] = -1
v[3][1] = 1
param = "name=v2;rows=3;cols=1;"
param["init"] = v
Matrix_Init()
arm = 2
CalcArm()
param = "name1=v2;name2=kCO;name=v2;"
Matrix_Mul()
Matrix_Dump()
' calculate v3 (H)
k[1][1] = (dC + dH) / abs_v1
param = "name=kCH;rows=1;cols=1;"
param["init"] = k ' = (dC + dH) / |v1|
Matrix_Init()
Matrix_Dump()
v[1][1] = 1
v[2][1] = 1
v[3][1] = -1
param = "name=v3;rows=3;cols=1;"
param["init"] = v
Matrix_Init()
arm = 3
CalcArm()
param = "name1=v3;name2=kCH;name=v3;"
Matrix_Mul()
Matrix_Dump()
' calculate v4 (H)
v[1][1] = -1
v[2][1] = -1
v[3][1] = -1
param = "name=v4;rows=3;cols=1;"
param["init"] = v
Matrix_Init()
arm = 4
CalcArm()
param = "name1=v4;name2=kCH;name=v4;"
Matrix_Mul()
Matrix_Dump()
' calculate v5 (H)
v[1][1] = -1
v[2][1] = 1
v[3][1] = -1
param = "name=v5;rows=3;cols=1;"
param["init"] = v
Matrix_Init()
origin = 1
arm = 5
CalcArm()
param = "name1=v5;name2=kCH;name=v5;"
Matrix_Mul()
param = "name1=v5;name2=v1;name=v5;"
Matrix_Add()
Matrix_Dump()
MoveArm()
' calculate v6 (H)
v[1][1] = -1
v[2][1] = -1
v[3][1] = 1
param = "name=v6;rows=3;cols=1;"
param["init"] = v
Matrix_Init()
origin = 1
arm = 6
CalcArm()
param = "name1=v6;name2=kCH;name=v6;"
Matrix_Mul()
param = "name1=v6;name2=v1;name=v6;"
Matrix_Add()
Matrix_Dump()
MoveArm()
' calculate v7 (H)
v[1][1] = 1
v[2][1] = 1
v[3][1] = 1
param = "name=v7;rows=3;cols=1;"
param["init"] = v
Matrix_Init()
origin = 1
arm = 7
CalcArm()
param = "name1=v7;name2=kCH;name=v7;"
Matrix_Mul()
param = "name1=v7;name2=v1;name=v7;"
Matrix_Add()
Matrix_Dump()
MoveArm()
' calculate v8 (H)
v[1][1] = 1
v[2][1] = -1
v[3][1] = -1.2
param = "name=v8;rows=3;cols=1;"
param["init"] = v
Matrix_Init()
Vector_Abs()
abs_v1 = return
k[1][1] = (dO + dH) / abs_v1
param = "name=kOH;rows=1;cols=1;"
param["init"] = k ' = (dO + dH) / |v8|
Matrix_Init()
Matrix_Dump()
origin = 2
arm = 8
CalcArm()
param = "name1=v8;name2=kOH;name=v8;"
Matrix_Mul()
param = "name1=v8;name2=v2;name=v8;"
Matrix_Add()
Matrix_Dump()
MoveArm()
' draw!
DrawMolecule()
' calculate rotation
α = 0
β = Math.GetRadians(10)
γ = 0
m[1][1] = Math.Cos(β) * Math.Cos(γ)
m[1][2] = Math.Sin(α) * Math.Sin(β) * Math.Cos(γ) - Math.Cos(α) * Math.Sin(γ)
m[1][3] = Math.Sin(α) * Math.Sin(γ) + Math.Cos(α) * Math.Sin(β) * Math.Cos(γ)
m[2][1] = Math.Cos(β) * Math.Sin(γ)
m[2][2] = Math.Sin(α) * Math.Sin(β) * Math.Sin(γ) + Math.Cos(α) * Math.Cos(γ)
m[2][3] = -Math.Sin(α) * Math.Cos(γ) + Math.Cos(α) * Math.Sin(β) * Math.Sin(γ)
m[3][1] = -Math.Sin(β)
m[3][2] = Math.Sin(α) * Math.Cos(β)
m[3][3] = Math.Cos(α) * Math.Cos(β)
param = "name=R;rows=3;cols=3;"
param["init"] = m
Matrix_Init()
Matrix_Dump()
While "True"
  Program.Delay(200)
  Rotate()
  ClearMolecule()
  DrawMolecule()
EndWhile

Sub CalcArm
  ' param abs_v1 - |v1|
  ' param origin - vertex number
  ' param arm - vertex number
  vs = arm * 2 + 7
  ve = arm * 2 + 8
  If (origin = 0) Or (origin = 1) Then
    d1 = dC
    s1 = sC
  Else
    d1 = dO
    s1 = sO
  EndIf
  f[1][1] = (s1 / 2) / abs_v1
  param = "name=f;rows=1;cols=1;"
  param["init"] = f
  Matrix_Init()
  param = "name1=v" + arm + ";name2=f;name=v" + vs + ";"
  Matrix_Mul()
  xs = matrix["v" + vs]["values"][1][1]
  ys = matrix["v" + vs]["values"][2][1]
  If arm = 1 Then
    d2 = dC
    s2 = sC
  ElseIf arm = 2 Then
    d2 = dO
    s2 = sO
  Else
    d2 = dH
    s2 = sH
  EndIf
  f[1][1] = (d1 + d2 - s2 / 2) / abs_v1
  param = "name=f;rows=1;cols=1;"
  param["init"] = f
  Matrix_Init()
  param = "name1=v" + arm + ";name2=f;name=v" + ve + ";"
  Matrix_Mul()
  xe = matrix["v" + ve]["values"][1][1]
  ye = matrix["v" + ve]["values"][2][1]
EndSub

Sub ClearMolecule
  GraphicsWindow.BrushColor = "LightGray"
  GraphicsWindow.FillRectangle(0, 0, gw, gh)
  DrawMolecularName()
EndSub

Sub DrawArm
  ' draw arm
  name1 = "v" + (i * 2 + 7)
  entry1 = matrix[name1]
  values1 = entry1["values"]
  x1 = values1[1][1]
  y1 = values1[2][1]
  name2 = "v" + (i * 2 + 8)
  entry2 = matrix[name2]
  values2 = entry2["values"]
  x2 = values2[1][1]
  y2 = values2[2][1]
  GraphicsWindow.PenColor = "Gray"
  GraphicsWindow.PenWidth = 4
  GraphicsWindow.DrawLine(gw / 2 + x1, gh / 2 + y1, gw / 2 + x2, gh / 2 + y2)
EndSub

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 MoveArm
  param = ""
  param["name1"] = "v" + (2 * arm + 7)
  param["name2"] = "v" + origin
  param["name"] = param["name1"]
  Matrix_Add()
  param["name1"] = "v" + (2 * arm + 8)
  param["name2"] = "v" + origin
  param["name"] = param["name1"]
  Matrix_Add()
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
Copyright (c) Microsoft Corporation. All rights reserved.