Microsoft Small Basic

Program Listing: FQH921
' Musical Score 0.1
' Copyright (c) 2014 Nonki Takahashi. All rights reserved.
'
' History:
' 0.1 2014-01-06 Created.
' 0.0 2012-10-18 12:51:09 Code generated by Small Basic Parser Generator 0.4
'
GraphicsWindow.Title = "Musical Score 0.1"
var["gw"] = 598
var["gh"] = 428
GraphicsWindow.Width = var["gw"]
GraphicsWindow.Height = var["gh"]
traceC = "False" ' trace subroutine call
traceX = "False" ' trace operation execution
traceV = "False" ' dump variable array after parse
Lex_Init()
DrawLines()
var["cw"] = var["width"] / 3
DrawGClef()
DrawFClef()
Sub DrawFClef
x = var["x1"] + var["width"] * 0.8
y = var["y1"] + var["width"] * (7 - 0.7 / 2)
width = var["width"] * 0.7
height = var["width"] * 0.7
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.FillEllipse(x, y, width, height)
param = "cx=x1+width*1.2;cy=y1+width*7.1;"
param["rx"] = "width*(a+240)/(90+240)*1.5"
param["ry"] = "width*(a+240)/(90+240)*2.3"
param["a1"] = -240
param["a2"] = -90
param["pw"] = "2+(a-a2)/(a1-a2)*(cw-2)"
DrawArc()
param["a1"] = -90
param["a2"] = 0
param["pw"] = "2+(a-a1)/(a2-a1)*(cw-2)"
DrawArc()
param["a1"] = 0
param["a2"] = 90
param["pw"] = "2+(a-a2)/(a1-a2)*(cw-2)"
DrawArc()
x = var["x1"] + var["width"] * 2.8
y = var["y1"] + var["width"] * (6.5 - 0.3 / 2)
width = var["width"] * 0.3
height = var["width"] * 0.3
GraphicsWindow.FillEllipse(x, y, width, height)
y = var["y1"] + var["width"] * (7.5 - 0.3 / 2)
GraphicsWindow.FillEllipse(x, y, width, height)
EndSub
Sub DrawLines
var["offsetY"] = 60
var["offsetX"] = 40
var["width"] = 30
var["x1"] = var["offsetX"]
var["y1"] = var["offsetY"]
var["x2"] = var["gw"] - var["offsetX"]
var["y2"] = var["y1"] + var["width"] * 10
For y = var["y1"] To var["y2"] Step var["width"]
If y <> var["offsetY"] + var["width"] * 5 Then
GraphicsWindow.DrawLine(var["x1"], y, var["x2"], y)
EndIf
EndFor
GraphicsWindow.DrawLine(var["x1"], var["y1"], var["x1"], var["y2"])
GraphicsWindow.DrawLine(var["x2"], var["y1"], var["x2"], var["y2"])
EndSub
Sub DrawGClef
param = "cx=x1+width*2;cy=y1+width*2.9;"
param["rx"] = "width*(0.4+(a+270)/(240+270))"
param["ry"] = "width*(0.4+(a+270)/(240+270))"
param["a1"] = -270
param["a2"] = -90
param["pw"] = "0+(a-a1)/(a2-a1)*(cw-0)"
DrawArc()
param["a1"] = -90
param["a2"] = 90
param["pw"] = "2+(a-a2)/(a1-a2)*(cw-2)"
DrawArc()
param["a1"] = 90
param["a2"] = 240
param["pw"] = "2+(a-a1)/(a2-a1)*(cw-2)"
DrawArc()
x1 = (x3 + x4) / 2
y1 = (y3 + y4) / 2 + 1
x2 = cx
y2 = var["offsetY"] + var["width"]
GraphicsWindow.PenWidth = var["cw"]
GraphicsWindow.DrawLine(x1 ,y1 ,x2 ,y2)
param = "cx=x1+width;cy=y1;"
param["rx"] = var["width"] * Math.SquareRoot(2)
param["ry"] = var["width"] * Math.SquareRoot(2)
param["a1"] = 0
param["a2"] = 45
param["pw"] = "2+(a-a1)/(a2-a1)*(cw-2)"
DrawArc()
param["a1"] = -45
param["a2"] = 0
param["pw"] = "2+(a-a2)/(a1-a2)*(cw-2)"
DrawArc()
param = "cx=x1+width*2;cy=y1;"
param["rx"] = var["width"] * 0.5
param["ry"] = var["width"] - 2
param["a1"] = 180
param["a2"] = 280
param["pw"] = "2+(a-a1)/(a2-a1)*cw"
DrawArc()
x1 = var["x1"] + var["width"] * 1.5
y1 = var["y1"]
x2 = var["x1"] + var["width"] * 2.25
y2 = var["y1"] + var["width"] * 5
GraphicsWindow.PenWidth = 2
GraphicsWindow.DrawLine(x1 ,y1 ,x2 ,y2)
param = "cx=x1+width*(1.5+2.25)/2;cy=y1+width*5;"
param["rx"] = "width*(2.25-1.5)/2"
param["ry"] = "width*(2.25-1.5)/2"
param["a1"] = 0
param["a2"] = 180
param["pw"] = "2"
DrawArc()
x = var["x1"] + var["width"] * 1.5 - 1
y = var["y1"] + var["width"] * (5 - 0.5 / 2)
width = var["width"] * 0.5
height = var["width"] * 0.5
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.FillEllipse(x, y, width, height)
EndSub
Sub DrawArc
bc = GraphicsWindow.BrushColor
GraphicsWindow.BrushColor = GraphicsWindow.PenColor
buf = param["a1"]
Calc()
var["a1"] = var["ans"]
buf = param["a2"]
Calc()
var["a2"] = var["ans"]
For a = var["a1"] To var["a2"] Step 5
var["a"] = a
buf = param["pw"]
Calc()
pw = var["ans"]
buf = param["rx"]
Calc()
rx = var["ans"]
buf = param["ry"]
Calc()
ry = var["ans"]
buf = param["cx"]
Calc()
cx = var["ans"]
buf = param["cy"]
Calc()
cy = var["ans"]
_a = Math.GetRadians(a)
x3 = cx + (rx - pw / 2) * Math.Cos(_a)
y3 = cy + (ry - pw / 2) * Math.Sin(_a)
x4 = cx + (rx + pw / 2) * Math.Cos(_a)
y4 = cy + (ry + pw / 2) * Math.Sin(_a)
If var["a1"] < a Then
GraphicsWindow.FillTriangle(x1, y1, x2, y2, x3, y3)
GraphicsWindow.FillTriangle(x2, y2, x3, y3, x4, y4)
EndIf
x1 = x3
y1 = y3
x2 = x4
y2 = y4
EndFor
GraphicsWindow.BrushColor = bc
EndSub
Sub Calc
' param buf - expression
' param var[] - variables
' return var["ans"] - answer
If traceC Then
TextWindow.WriteLine(" " + buf)
EndIf
len = Text.GetLength(buf)
ptr = 1
Parse_Expr()
If ptr <= len Then
TextWindow.WriteLine("Syntax error in expression " + buf + ".")
EndIf
var["ans"] = val
If traceV Then
TextWindow.WriteLine("var=" + WQ + var + WQ)
EndIf
If traceC Then
TextWindow.WriteLine("
" + val)
EndIf
EndSub
Sub Exec_Expr
' Excecution | Expression
' expr ::= [[]{+|-}[]]
' return val - result of expression
If match Then
If traceX Then
TextWindow.Write("Expr:_opt=" + WQ + _opt + WQ + ",_val=" + WQ + _val + WQ)
EndIf
n = Array.GetItemCount(_opt)
val = _val[1]
For i = 1 To n
If _opt[i] = "+" Then
val = val + _val[i + 1]
ElseIf _opt[i] = "-" Then
val = val - _val[i + 1]
EndIf
EndFor
If traceX Then
TextWindow.WriteLine(",val=" + WQ + val + WQ)
EndIf
EndIf
EndSub
Sub Exec_Factor
' Excecution | Factor
' factor ::= {|([][])}
If match Then
If traceX Then
TextWindow.Write("Factor:_val=" + WQ + _val + WQ)
EndIf
If _opt[1] = "val" Then
val = _val[1]
ElseIf _opt[1] = ")" Then
val = _val[2]
EndIf
If traceX Then
TextWindow.WriteLine(",val=" + WQ + val + WQ)
EndIf
EndIf
EndSub
Sub Exec_Literal
' Excecution | Literal
' literal ::= {|<_str>}
If match Then
If traceX Then
TextWindow.Write("Literal:_opt=" + WQ + _opt + WQ + ",_val=" + WQ + _val + WQ)
EndIf
If _opt[1] = "real" Then
val = _val[1]
ElseIf _opt[1] = "_str" Then
val = _val[2]
EndIf
If traceX Then
TextWindow.WriteLine(",val=" + WQ + val + WQ)
EndIf
EndIf
EndSub
Sub Exec_Real
' Excecution | Real
' real ::= [-]<_num>[.<_num>]
If match Then
If traceX Then
TextWindow.Write("Real:_const=" + WQ + _const + WQ + ",_val=" + WQ + _val + WQ)
EndIf
val = _const[1] + _val[1] ' sign + int
If _const[2] = "." Then
val = Text.Append(val + ".", _val[2]) ' sign + int + "." + frac
EndIf
If traceX Then
TextWindow.WriteLine(",val=" + WQ + val + WQ)
EndIf
EndIf
EndSub
Sub Exec_Term
' Excecution | Term
' term ::= [[]{'*'|/}[]]
If match Then
If traceX Then
TextWindow.Write("Term:_opt=" + WQ + _opt + WQ + ",_val=" + WQ + _val + WQ)
EndIf
n = Array.GetItemCount(_opt)
val = _val[1]
For i = 1 To n
If _opt[i] = "*" Then
val = val * _val[i + 1]
ElseIf _opt[i] = "/" Then
val = val / _val[i + 1]
EndIf
EndFor
If traceX Then
TextWindow.WriteLine(",val=" + WQ + val + WQ)
EndIf
EndIf
EndSub
Sub Lex_Init
UPPER = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
LOWER = "abcdefghijklmnopqrstuvwxyz"
DIGIT = "0123456789"
FCHAR = UPPER + LOWER ' first charcters for label/variable/sub
TCHAR = FCHAR + DIGIT + "_" ' trailing characters for label/variable/sub
WQ = Text.GetCharacter(34) ' double quote
SQ = "'" ' single quote
CRLF = Text.GetCharacter(13) + Text.GetCharacter(10) ' carriage return + line feed
Not = "True=False;False=True;"
EndSub
Sub Lex_Label
' param buf - buffer
' param ptr - pointer
' return match - "True" if match
' return ptr - next pointer
' return label[] - label name array
' return val - label name
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
Lex_Name()
If match And (Array.ContainsValue(label, val) = "False") Then
nLabel = nLabel + 1
label[nLabel] = val
EndIf
If traceC Then
TextWindow.WriteLine("
" + ptr)
EndIf
EndSub
Sub Lex_Name
' param buf - buffer
' param ptr - pointer
' return match - "True" if match
' return ptr - next pointer
' return name - name
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
ch = Text.GetSubText(buf, ptr, 1)
If Text.GetIndexOf(FCHAR, ch) > 0 Then
name = ch
ptr = ptr + 1
match = "True"
While match
ch = Text.GetSubText(buf, ptr, 1)
If Text.GetIndexOf(TCHAR, ch) > 0 Then
ptr = ptr + 1
name = name + ch
Else
match = "False"
EndIf
EndWhile
match = "True"
Else
name = ""
match = "False"
EndIf
If traceC Then
TextWindow.WriteLine("
" + ptr)
EndIf
EndSub
Sub Lex_Num
' param buf - buffer
' param ptr - pointer
' return match - "True"
' return ptr - next pointer
' return val - number
ch = Text.GetSubText(buf, ptr, 1)
If Text.GetIndexOf(DIGIT, ch) > 0 Then
val = ch
ptr = ptr + 1
match = "True"
While match
ch = Text.GetSubText(buf, ptr, 1)
If Text.GetIndexOf(DIGIT, ch) > 0 Then
ptr = ptr + 1
val = Text.Append(val, ch)
Else
match = "False"
EndIf
EndWhile
match = "True"
Else
val = ""
match = "False"
EndIf
EndSub
Sub Lex_Space0
' param buf - buffer
' param ptr - pointer
' return match - "True"
' return ptr - next pointer
txt = " "
match = "True"
While match
Lex_Text()
EndWhile
match = "True"
EndSub
Sub Lex_Space1
' param buf - buffer
' param ptr - pointer
' return match - "True"
' return ptr - next pointer
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
txt = " "
Lex_Text()
If match Then
While match
Lex_Text()
EndWhile
match = "True"
Else
TextWindow.WriteLine("Syntax Error: space not found")
EndIf
If traceC Then
TextWindow.WriteLine("
" + ptr)
EndIf
EndSub
Sub Lex_Str
' param buf - buffer
' param ptr - pointer
' return match - "True"
' return ptr - next pointer
' return val - string
Stack.PushValue("local", ptr)
txt = WQ
Lex_Text()
If match Then
ch = Text.GetSubText(buf, ptr, 1)
str = ""
While ch <> WQ
str = str + ch
ptr = ptr + 1
ch = Text.GetSubText(buf, ptr, 1)
EndWhile
EndIf
If match Then
txt = WQ
Lex_Text()
EndIf
_ptr = Stack.PopValue("local")
If match Then
val = str
Else
val = ""
ptr = _ptr
EndIf
EndSub
Sub Lex_Text
' param buf - buffer
' param ptr - pointer
' param txt - text to lexical analysis
' return match - "True" if match
' return ptr - next pointer
' return val - txt if match
If traceC Then
If txt = CRLF Then
_txt = "CRLF"
ElseIf txt = WQ Then
_txt = SQ + txt + SQ
Else
_txt = WQ + txt + WQ
EndIf
TextWindow.WriteLine(" " + ptr)
EndIf
val = ""
txtlen = Text.GetLength(txt)
lotxt = Text.ConvertToLowerCase(txt)
lobuf = Text.ConvertToLowerCase(Text.GetSubText(buf, ptr, txtlen))
If lobuf = lotxt Then
match = "True"
ptr = ptr + txtlen
val = txt
Else
match = "False"
EndIf
If traceC Then
TextWindow.WriteLine("
" + ptr)
EndIf
EndSub
Sub Lex_Var
' _var ::= <_name>['['[][]']'['['[][]']']]
' param buf - buffer
' param ptr - pointer
' return match - "True" if match
' return ptr - next pointer
' return var[] - variable name array
' return name - variable name
' return val - variable
Stack.PushValue("local", _val)
_val = ""
Lex_Name()
_val[1] = val
Stack.PushValue("local", name)
If match Then
Stack.PushValue("ptr",ptr)
If match Then
txt = "["
Lex_Text()
EndIf
If match Then
Lex_Space0()
EndIf
If match Then
Parse_Val()
_val[2] = val
EndIf
If match Then
Lex_Space0()
EndIf
If match Then
txt = "]"
Lex_Text()
EndIf
If match Then
Stack.PushValue("ptr",ptr)
If match Then
txt = "["
Lex_Text()
EndIf
If match Then
Lex_Space0()
EndIf
If match Then
Parse_Val()
_val[3] = val
EndIf
If match Then
Lex_Space0()
EndIf
If match Then
txt = "]"
Lex_Text()
EndIf
_ptr = Stack.PopValue("ptr")
If Not[match] Then
ptr = _ptr
match = "True"
EndIf
EndIf
_ptr = Stack.PopValue("ptr")
If Not[match] Then
ptr = _ptr
match = "True"
EndIf
EndIf
name = Stack.PopValue("local")
If match Then
If _val[3] <> "" Then
name = name + "[" + _val[2] + "][" + _val[3] + "]"
ElseIf _Val[2] <> "" Then
name = name + "[" + _val[2] + "]
EndIf
If Array.ContainsIndex(var, name) Then
val = var[name]
If val = "N/A" Then
val = ""
EndIf
Else
var[name] = "N/A"
val = ""
EndIf
EndIf
_val = Stack.PopValue("local")
EndSub
Sub Parse_Expr
' expr ::= [[]{+|-}[]]
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
_const = ""
Stack.PushValue("local", _opt)
_opt = ""
Stack.PushValue("local", _val)
_val = ""
Stack.PushValue("ptr",ptr)
Parse_Term()
i = 1
_val[i] = val
If match Then
While match
Stack.PushValue("ptr",ptr)
Lex_Space0()
txt = "+"
Lex_Text()
_const[i] = val
If match Then
_opt[i] = "+"
Else
txt = "-"
Lex_Text()
_const[i] = val
If match Then
_opt[i] = "-"
EndIf
EndIf
If match Then
Lex_Space0()
EndIf
If match Then
Stack.PushValue("local", i)
Parse_Term()
i = Stack.PopValue("local")
_val[i + 1] = val
EndIf
_ptr = Stack.PopValue("ptr")
If Not[match] Then
ptr = _ptr
_opt[i] = ""
EndIf
i = i + 1
EndWhile
match = "True"
EndIf
_ptr = Stack.PopValue("ptr")
If Not[match] Then
ptr = _ptr
EndIf
Exec_Expr()
_val = Stack.PopValue("local")
_opt = Stack.PopValue("local")
If traceC Then
TextWindow.WriteLine("
" + ptr)
EndIf
EndSub
Sub Parse_Term
' term ::= [[]{'*'|/}[]]
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
_const = ""
Stack.PushValue("local", _opt)
_opt = ""
Stack.PushValue("local", _val)
_val = ""
Stack.PushValue("ptr", ptr)
Parse_Factor()
i = 1
_val[i] = val
If match Then
While match
Stack.PushValue("ptr", ptr)
Lex_Space0()
If match Then
txt = "*"
Lex_Text()
_const[i] = val
If match Then
_opt[i] = "*"
Else
txt = "/"
Lex_Text()
_const[i] = val
If match Then
_opt[i] = "/"
EndIf
EndIf
EndIf
If match Then
Lex_Space0()
EndIf
If match Then
Stack.PushValue("local", i)
Parse_Factor()
i = Stack.PopValue("local")
_val[i + 1] = val
EndIf
_ptr = Stack.PopValue("ptr")
If Not[match] Then
ptr = _ptr
_opt[i] = ""
EndIf
i = i + 1
EndWhile
match = "True"
EndIf
_ptr = Stack.PopValue("ptr")
If Not[match] Then
ptr = _ptr
EndIf
Exec_Term()
_val = Stack.PopValue("local")
_opt = Stack.PopValue("local")
If traceC Then
TextWindow.WriteLine("
" + ptr)
EndIf
EndSub
Sub Parse_Factor
' factor ::= {|([][])}
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
_const = ""
Stack.PushValue("local", _opt)
_opt = ""
Stack.PushValue("local", _val)
_val = ""
Parse_Val()
_val[1] = val
If match Then
_opt[1] = "val"
Else
Stack.PushValue("ptr",ptr)
txt = "("
Lex_Text()
_const[1] = val
If match Then
Lex_Space0()
EndIf
If match Then
Parse_Expr()
_val[2] = val
EndIf
If match Then
Lex_Space0()
EndIf
If match Then
txt = ")"
Lex_Text()
_const[2] = val
EndIf
_ptr = Stack.PopValue("ptr")
If Not[match] Then
ptr = _ptr
EndIf
If match Then
_opt[1] = ")"
EndIf
EndIf
Exec_Factor()
_val = Stack.PopValue("local")
_opt = Stack.PopValue("local")
If traceC Then
TextWindow.WriteLine("
" + ptr)
EndIf
EndSub
Sub Parse_Val
' val ::= {|<_var>}
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
_const = ""
Stack.PushValue("local", _opt)
_opt = ""
Stack.PushValue("local", _val)
_val = ""
Parse_Literal()
_val[1] = val
If match Then
_opt[1] = "literal"
Else
Lex_Var()
_val[2] = val
If match Then
_opt[1] = "_var"
EndIf
EndIf
_val = Stack.PopValue("local")
_opt = Stack.PopValue("local")
If traceC Then
TextWindow.WriteLine("
" + ptr)
EndIf
EndSub
Sub Parse_Literal
' literal ::= {|<_str>}
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
_const = ""
Stack.PushValue("local", _opt)
_opt = ""
Stack.PushValue("local", _val)
_val = ""
Parse_Real()
_val[1] = val
If match Then
_opt[1] = "real"
Else
Lex_Str()
_val[2] = val
If match Then
_opt[1] = "_str"
EndIf
EndIf
Exec_Literal()
_val = Stack.PopValue("local")
_opt = Stack.PopValue("local")
If traceC Then
TextWindow.WriteLine("
" + ptr)
EndIf
EndSub
Sub Parse_Real
' real ::= [-]<_num>[.<_num>]
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
_const = ""
Stack.PushValue("local", _opt)
_opt = ""
Stack.PushValue("local", _val)
_val = ""
Stack.PushValue("ptr",ptr)
txt = "-"
Lex_Text()
_const[1] = val
match = "True"
If match Then
Lex_Num()
_val[1] = val
EndIf
If match Then
Stack.PushValue("ptr",ptr)
txt = "."
Lex_Text()
_const[2] = val
If match Then
Lex_Num()
_val[2] = val
EndIf
_ptr = Stack.PopValue("ptr")
If Not[match] Then
ptr = _ptr
EndIf
match = "True"
EndIf
_ptr = Stack.PopValue("ptr")
If Not[match] Then
ptr = _ptr
EndIf
Exec_Real()
_val = Stack.PopValue("local")
_opt = Stack.PopValue("local")
If traceC Then
TextWindow.WriteLine("
" + ptr)
EndIf
EndSub