Microsoft Small Basic

Program Listing: ZBG977-4
' Small Basic Parser Generator 1.4
' for Code Block Generator
' Copyright (c) 2012, 2013 Nonki Takahashi. All rights reserved.
'
' History :
' 1.4 2013-08-24 Added string color. Overflow-x also automated. (ZBG977-4)
' 1.3 2012-10-28 Bug fixed - source lines remain in preview. (ZBG977-3)
' 1.2 2012-10-28 Bug fixed - source null line collapsed in Web. (ZBG977-1)
' 1.1b 2012-10-26 Simplified BNF. (ZBG977)
' 1.0 2012-10-25 Rewrote as HTML code block generator. (not complete)
' 0.4 2012-10-06 Rewrote as Parser Generator. (XWX066)
' 0.3 2012-09-01 Modified for all GraphicsWindows operations (*).
' 0.2 2012-09-01 Support more statements (*).
' 0.1 2012-08-31 Created (*).
' (*) as Small Basic Compiler Compiler
'
version = "1.4"
title = "Small Basic Parser Generator " + version
dir = Program.Directory
filename = dir + "/ParserGenerator1_4.smallbasic"
targetname = dir + "/CodeBlockGenerator1_4.smallbasic"
TextWindow.Title = title
TextWindow.WriteLine("Wait a moment...")
traceC = "False" ' debug
PG_Init()
PG_Main()
TextWindow.Write(code)
' The following line could be harmful and has been automatically commented.
' File.WriteContents(targetname, code)

Sub CBG_Main
' Code Block Generator | Main
title = "Code Block Generator " + version
traceC = "False" ' trace subroutine call
traceX = "False" ' trace operation execution
WQ = Text.GetCharacter(34)
CRLF = Text.GetCharacter(13) + Text.GetCharacter(10)
bcolor[1] = "#FFFFFF" ' background color 1
bcolor[0] = "#F8F8F8" ' background color 2
rcolor = "#008020" ' remark (comment) color
scolor = "#CC6633" ' string color
ncolor = "#DD6633" ' number color
kcolor = "#7777FF" ' keyword color
ccolor = "#006060" ' class (object) color
mcolor = "#802020" ' member (property, operation, event) color
ocolor = "#800000" ' operator color
lcolor = "#5C5C5C" ' line number color
fcolor = "#7F9DB9" ' frame color
vcolor = "#000000" ' variable (or label) color
sample[1] = "' Sample Program"
sample[2] = "For i = 1 To 10"
sample[3] = " TextWindow.Write(i + " + WQ + " " + WQ + ")"
sample[4] = "EndFor"
sample[5] = "TextWindow.WriteLine(" + WQ + WQ + ")"
GraphicsWindow.Title = title
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.FontName = "Consolas"
fsize = 12
GraphicsWindow.FontSize = fsize
lheight = fsize * 1.22 ' line height
cwidth = fsize * 0.54 ' column width
gwidth = GraphicsWindow.Width
gheight = GraphicsWindow.Height
oheight = lheight * 6 ' options height
fheight = lheight * 3 ' footer height
bheight = (gheight - oheight - fheight - lheight * 3 - 20) / 2 ' source / preview text box
dheight = gheight - fheight - lheight - 20 ' destination text box
Lex_Init()
While "True"
CBG_ShowSourceWindow()
nlines = Array.GetItemCount(sample) ' number of lines
sbuf = ""
For line = 1 To nlines
sbuf = Text.Append(sbuf, sample[line])
If line < nlines Then
sbuf = Text.Append(sbuf, CRLF)
EndIf
EndFor
Controls.SetTextBoxText(stextbox, sbuf)
Controls.ButtonClicked = CBG_OnButtonClicked
GraphicsWindow.MouseDown = CBG_OnMouseDown
clicked = ""
x0 = 12
x = x0 + 4
y0 = 10 + lheight * 3 + bheight + oheight + 2
height = lheight
While clicked <> obutton
If clicked = pbutton Then
clicked = ""
swidth = Controls.GetTextBoxText(wtextbox) ' max snippet width
sheight = Controls.GetTextBoxText(htextbox) ' max snippet height
GraphicsWindow.BrushColor = "White"
GraphicsWindow.FillRectangle(x0 - 4, y0 - 4, _swidth + 4, _sheight + 4)
If (swidth <> lswidth) Or (sheight <> lsheight)Then
lswidth = swidth ' last snippet width
lsheight = sheight ' last snippet height
If Text.EndsWith(swidth, "%") Then
percent = Text.GetSubText(swidth, 1, Text.GetLength(swidth) - 1)
_swidth = Math.Floor((gwidth - 20) * percent / 100)
ElseIf swidth = "" Then
_swidth = gwidth - 20
Else
_swidth = swidth
EndIf
If Text.EndsWith(sheight, "%") Then
percent = Text.GetSubText(sheight, 1, Text.GetLength(sheight) - 1)
_sheight = Math.Floor(bheight * percent / 100)
ElseIf sheight = "" Then
_sheight = bheight
Else
_sheight = sheight
EndIf
EndIf
GraphicsWindow.PenWidth = 1
GraphicsWindow.PenColor = fcolor
GraphicsWindow.DrawRectangle(x0 - 2, y0 - 2, _swidth, _sheight)
sbuf = Controls.GetTextBoxText(stextbox) ' source buffer
CBG_GetLineCount() ' get nlines (number of lines)
max = Math.Floor(_sheight / lheight)
nlines = Math.Min(nlines, max)
display = "True"
CBG_Parse()
ElseIf clicked = "cbox" Then
clicked = ""
If dispnum Then
dispnum = "False"
Shapes.HideShape(check)
Else
dispnum = "True"
Shapes.ShowShape(check)
EndIf
Else
Program.Delay(100)
EndIf
EndWhile
display = "False"
swidth = Controls.GetTextBoxText(wtextbox) ' max snippet width
sheight = Controls.GetTextBoxText(htextbox) ' max snippet height
sbuf = Controls.GetTextBoxText(stextbox) ' source buffer
CBG_GetLineCount() ' get nlines (number of lines)
CBG_Parse()
CBG_ShowDestinationWindow()
clicked = ""
While clicked <> obutton
Program.Delay(100)
EndWhile
EndWhile
EndSub

Sub CBG_OnMouseDown
mx = GraphicsWindow.MouseX
my = GraphicsWindow.MouseY
If (bx0 <= mx) And (mx <= bx1) And (by0 <= my) And (my <= by1) Then
clicked = "cbox"
EndIf
EndSub

Sub CBG_Parse
GraphicsWindow.FontBold = "False"
cbuf = "
If swidth <> "" Then
cbuf = cbuf + "width:" + swidth
If Text.EndsWith(swidth, "%") = "False" Then
cbuf = cbuf + "px"
EndIf
cbuf = cbuf + "; "
EndIf
If sheight <> "" Then
cbuf = cbuf + "height:" + sheight
If Text.EndsWith(sheight, "%") = "False" Then
cbuf = cbuf + "px"
EndIf
cbuf = cbuf + "; "
EndIf
cbuf = cbuf + "overflow:auto; font-size:12px;" + WQ + ">" + CRLF + " "
For line = 1 To nlines
linetop = "True"
cbuf = cbuf + "
"
If dispnum Then
cbuf = cbuf + " cbuf = cbuf + "style=" + WQ + "color:" + lcolor + "; float:left; width:3em; padding-right:0.3em; text-align:right; display:block;" + WQ + ">" + line + ". cbuf = cbuf + ">"
EndIf
If display Then
y = y0 + height * (line - 1)
GraphicsWindow.BrushColor = bcolor[Math.Remainder(line, 2)]
GraphicsWindow.FillRectangle(x0, y, _swidth - 4, height)
If dispnum Then
GraphicsWindow.BrushColor = lcolor
GraphicsWindow.DrawText(x, y, Text.Append(line, "."))
column = 5
Else
column = 1
EndIf
EndIf
CBG_GetLine()
len = Text.GetLength(buf)
ptr = 1
Parse_State()
If linetop Then
linetop = "False"
cbuf = cbuf + " " ' to avoid null line collapse
Else
cbuf = cbuf + ""
EndIf
cbuf = cbuf + "
" + CRLF
If line < nlines Then
cbuf = cbuf + " "
EndIf
If ptr <= len Then
TextWindow.ForegroundColor = "Green"
TextWindow.WriteLine("Syntax Error")
TextWindow.WriteLine(buf)
TextWindow.WriteLine(Text.GetSubText(SP60, 1, ptr - 1) + "^")
TextWindow.ForegroundColor = "Gray"
EndIf
EndFor
cbuf = cbuf + "
" + CRLF
EndSub

Sub CBG_GetLineCount
' param sbuf - source buffer
' return slen - source buffer length
' return nlines - source buffer number of lines
' return sptr - source buffer pointer = 1
slen = Text.GetLength(sbuf)
sptr = 1
_ptr = 1
nlines = 0
While 0 < _ptr And _ptr <= slen
nlines = nlines + 1
_ptr = Text.GetIndexOf(Text.GetSubTextToEnd(sbuf, sptr), CRLF)
If 0 < _ptr Then
sptr = sptr + _ptr + 1
EndIf
EndWhile
sptr = 1
EndSub

Sub CBG_GetLine
' param sbuf - source buffer
' param slen - source buffer length
' param sptr - source buffer pointer
' return buf - line buffer
_ptr = Text.GetIndexOf(Text.GetSubTextToEnd(sbuf, sptr), CRLF)
If _ptr = 0 Then
_ptr = slen - sptr + 2
EndIf
buf = Text.GetSubText(sbuf, sptr, _ptr - 1)
sptr = sptr + _ptr + 1
EndSub

Sub CBG_ShowSourceWindow
GraphicsWindow.Clear()
' draw source code
GraphicsWindow.BrushColor = "SteelBlue"
GraphicsWindow.DrawText(10, 10, "Paste source code below")
GraphicsWindow.BrushColor = "Black"
stextbox = Controls.AddMultiLineTextBox(10, 10 + lheight)
Controls.SetSize(stextbox, gwidth - 20, bheight)
' draw options
GraphicsWindow.BrushColor = "SteelBlue"
GraphicsWindow.DrawText(10, 10 + lheight * 2 + bheight, "Options")
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.DrawText(10, 10 + lheight * 3.2 + bheight, "Max Snippet Width")
wtextbox = Controls.AddTextBox(10 + cwidth * 18, 10 + lheight * 3 + bheight)
Controls.SetSize(wtextbox, cwidth * 7, fsize * 1.7)
Controls.SetTextBoxText(wtextbox, 550)
GraphicsWindow.DrawText(10 + cwidth * 26, 10 + lheight * 3.2 + bheight, "px / %")
GraphicsWindow.DrawText(10, 10 + fsize * 1.4 + bheight + lheight * 4.2, "Max Snippet Height")
htextbox = Controls.AddTextBox(10 + cwidth * 19, 10 + lheight * 5 + bheight)
Controls.SetSize(htextbox, cwidth * 7, fsize * 1.7)
GraphicsWindow.DrawText(10 + cwidth * 27, 10 + lheight * 5.2 + bheight "px / %")
GraphicsWindow.DrawText(gwidth / 2, 10 + bheight + lheight * 3.2, "Display Line Numbers")
GraphicsWindow.PenWidth = 1
GraphicsWindow.PenColor = "LightGray"
bx0 = gwidth / 2 + cwidth * 21 ' for check box
by0 = 10 + lheight * 3.2 + bheight
bx1 = bx0 + fsize
by1 = by0 + fsize
GraphicsWindow.DrawRectangle(bx0, by0, fsize, fsize)
check = Shapes.AddText("✔")
Shapes.Move(check, gwidth / 2 + cwidth * 21, 10 + lheight * 3.2 + bheight)
dispnum = "False"
Shapes.HideShape(check)
pbutton = Controls.AddButton("Preview", gwidth - 10 - cwidth * 9, 10 + lheight * 3 + bheight)
' draw preview
GraphicsWindow.BrushColor = "SteelBlue"
GraphicsWindow.DrawText(10, 10 + lheight * 2 + bheight + oheight, "Preview")
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.PenWidth = 1
GraphicsWindow.PenColor = fcolor
swidth = 550 ' gwidth - 20
_swidth = swidth
sheight = ""
_sheight = bheight
GraphicsWindow.DrawRectangle(10, 10 + lheight * 3 + bheight + oheight, _swidth, _sheight)
' draw footer
obutton = Controls.AddButton("OK", gwidth - 10 - cwidth * 4, 10 + lheight * 4 + bheight * 2 + oheight)
EndSub

Sub CBG_ShowDestinationWindow
GraphicsWindow.Clear()
' draw source code
GraphicsWindow.BrushColor = "SteelBlue"
GraphicsWindow.DrawText(10, 10, "Generated code block")
GraphicsWindow.BrushColor = "Black"
dtextbox = Controls.AddMultiLineTextBox(10, 10 + lheight)
Controls.SetSize(dtextbox, gwidth - 20, dheight)
Controls.SetTextBoxText(dtextbox, cbuf)
GraphicsWindow.DrawText(10, 10 + lheight * 4 + bheight * 2 + oheight, "Click textbox above, push Ctrl+A, Ctrl+C to copy and save to your editor")
obutton = Controls.AddButton("OK", gwidth - 10 - cwidth * 4, 10 + lheight * 4 + bheight * 2 + oheight)
EndSub

Sub CBG_OnButtonClicked
clicked = Controls.LastClickedButton
EndSub

Sub Exec_Mem
' Execution | Member
' mem ::= <_name>[].[]<_name>
If match Then
If traceX Then
TextWindow.Write("Mem:_const=" + WQ + _const + WQ + ",_val=" + WQ + _val + WQ)
EndIf
val = _val[1] + "." + _val[2]
If traceX Then
TextWindow.WriteLine(",val=" + WQ + val + WQ)
EndIf
EndIf
EndSub

Sub Exec_Real
' Execution | Real number
' real ::= [-]<_num>[.<_num>]
If match Then
If traceX Then
TextWindow.Write("Rem:_const=" + WQ + _const + WQ + ",_val=" + WQ + _val + WQ)
EndIf
val = Text.Append(_const[1], _val[1])
val = Text.Append(val, _const[2])
val = Text.Append(val, _val[2])
If traceX Then
TextWindow.WriteLine(",val=" + WQ + val + WQ)
EndIf
EndIf
EndSub

Sub Exec_Rem
' Execution | Remark (comment)
' rem ::= _SQ*
If match Then
If traceX Then
TextWindow.Write("Rem:_const=" + WQ + _const + WQ + ",_val=" + WQ + _val + WQ)
EndIf
str = _const[1] + _const[2]
Lex_StrConvert() ' conversion &, <, > for HTML
val = str
If traceX Then
TextWindow.WriteLine(",val=" + WQ + val + WQ)
EndIf
EndIf
EndSub

Sub Exec_Token
' Excecution | Token
' token ::= {||||<_str>|||[]}
If match Then
If traceX Then
TextWindow.Write("Token:_const=" + WQ + _const + WQ + ",_val=" + WQ + _val + WQ)
EndIf
bold = "False"
italic = "False"
If _opt[1] = "kw" Then ' keyword
val = _val[1]
color = kcolor
bold = "True"
ElseIf _opt[1] = "op" Then ' operator
val = _val[2]
val2 = val
If val = "<" Then
val = "<"
ElseIf val = "<=" Then
val = "<="
ElseIf val = ">" Then
val = ">"
ElseIf val = ">=" Then
val = ">="
ElseIf val = "<>" Then
val = "<>"
EndIf
color = ocolor
ElseIf _opt[1] = "mem" Then ' member (property, operation, event)
ptrp = Text.GetIndexOf(_val[3], ".")
val = Text.GetSubText(_val[3], 1, ptrp - 1)
val2 = Text.GetSubTextToEnd(_val[3], ptrp + 1)
color = ccolor
ElseIf _opt[1] = "real" Then ' real
val = _val[4]
color = ncolor
ElseIf _opt[1] = "_str" Then ' string
val = _val[5]
color = scolor
ElseIf _opt[1] = "var" Then ' variable, label, subroutine
val = _val[6]
color = vcolor
ElseIf _opt[1] = "rem" Then ' remark (comment)
val = _val[7]
color = rcolor
italic = "True"
ElseIf _opt[1] = "" Then ' space
If nspace = 1 Then
val = " "
Else
val = ""
For _sp = 1 To nspace
val = val + " "
EndFor
EndIf
EndIf
If _opt[1] = "" Then
If linetop Then
linetop = "False"
cbuf = cbuf + ""
EndIf
Else
If linetop Then
linetop = "False"
Else
cbuf = cbuf + "
"
EndIf
cbuf = cbuf + " cbuf = cbuf + "style=" + WQ + "color:" + color + ";"
If bold Then
cbuf = cbuf + " font-weight:bold;"
EndIf
If italic Then
cbuf = cbuf + " font-style:italic;"
EndIf
cbuf = cbuf + WQ
cbuf = cbuf + ">"
EndIf
cbuf = cbuf + val
If _opt[1] = "mem" Then
cbuf = cbuf + " cbuf = cbuf + "style=" + WQ + "color:" + ocolor + ";" + WQ + ">."
cbuf = cbuf + " cbuf = cbuf + "style=" + WQ + "color:" + mcolor + ";" + WQ + ">" + val2
EndIf
If display Then
GraphicsWindow.FontBold = bold
GraphicsWindow.FontItalic = italic
GraphicsWindow.BrushColor = color
If _opt[1] = "op" Then
val = val2
EndIf
If _opt[1] = "" Then
val = Text.GetSubText(SP60, 1, nspace)
Else
GraphicsWindow.DrawText(x + cwidth * (column - 1), y, val)
EndIf
GraphicsWindow.FontBold = "False"
GraphicsWindow.FontItalic = "False"
column = column + Text.GetLength(val)
If _opt[1] = "mem" Then
GraphicsWindow.BrushColor = ocolor
GraphicsWindow.DrawText(x + cwidth * (column - 1), y, ".")
column = column + 1
GraphicsWindow.BrushColor = mcolor
GraphicsWindow.DrawText(x + cwidth * (column - 1), y, val2)
column = column + Text.GetLength(val2)
EndIf
EndIf
If traceX Then
TextWindow.WriteLine(",val=" + WQ + val + WQ)
EndIf
EndIf
EndSub

Sub Lex_Init
' Lexical analysis | Initialization
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
SP60 = " "
EndSub

Sub Lex_Name
' Lexical analysis | Name
' param buf - buffer
' param ptr - pointer
' return match - "True" if match
' return ptr - next pointer
' return name, val - 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 match Then
val = name
EndIf
If traceC Then
TextWindow.WriteLine("
" + ptr)
EndIf
EndSub

Sub Lex_Num
' Lexical analysis | Number
' 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
' Lexical analysis | Null or space
' param buf - buffer
' param ptr - pointer
' return match - "True"
' return ptr - next pointer
' return nspace - number of space
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
txt = " "
nspace = 0
match = "True"
While match
Lex_Text()
If match Then
nspace = nspace + 1
EndIf
EndWhile
match = "True"
If traceC Then
TextWindow.WriteLine("
" + ptr)
EndIf
EndSub

Sub Lex_Space1
' Lexical analysis | At least one space
' param buf - buffer
' param ptr - pointer
' return match - "True"
' return ptr - next pointer
' return nspace - number of space
If traceC Then
TextWindow.WriteLine(" " + ptr)
EndIf
txt = " "
nspace = 0
Lex_Text()
If match Then
nspace = nspace + 1
While match
Lex_Text()
If match Then
nspace = nspace + 1
EndIf
EndWhile
match = "True"
Else
TextWindow.WriteLine("Syntax Error: space not found")
EndIf
If traceC Then
TextWindow.WriteLine("
" + ptr)
EndIf
EndSub

Sub Lex_Str
' Lexical analysis | String
' 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 = Text.Append(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
Lex_StrConvert()
val = WQ + str + WQ
Else
val = ""
ptr = _ptr
EndIf
EndSub

Sub Lex_StrConvert
' Lexical analysis | String convert for HTML
' param str - string in source code
' return str - converted string for HTML
Stack.PushValue("local", ptr)
Stack.PushValue("local", len)
len = Text.GetLength(str)
_str = ""
For ptr = 1 To len
ch = Text.GetSubText(str, ptr, 1)
If ch = "&" Then
_str = _str + "&"
ElseIf ch = "<" Then
_str = _str + "<"
ElseIf ch = ">" Then
_str = _str + ">"
Else
_str = Text.Append(_str, ch)
EndIf
EndFor
str = _str
len = Stack.PopValue("local")
ptr = Stack.PopValue("local")
EndSub

Sub Lex_Text
' Lexical analysis | 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 Parse_State
' dummy
_opt = ""
_val = ""
_const = ""
prop = ""
EndSub

Sub Parse_Val
' dummy
EndSub

Sub PG_DumpBuf ' for debug
' Parser Generator | Dump buf (buffer)
' param buf
' param ptr
TextWindow.ForegroundColor = "Green"
TextWindow.WriteLine(buf)
TextWindow.WriteLine(Text.GetSubText(SP60, 1, ptr - 1) + "^")
TextWindow.ForegroundColor = "Gray"
EndSub

Sub PG_DumpCode ' for debug
' Parser Generator | Dump code
' param code
TextWindow.ForegroundColor = "Green"
TextWindow.Write(code)
TextWindow.ForegroundColor = "Gray"
EndSub

Sub PG_ExecCode
' Parser Generator | Execute code
' param index[i] - syntax name
name = "<" + index[i] + ">"
If Text.GetIndexOf(syntax["prop"], name) > 0 Then
code = code + Text.GetSubText(SP60, 1, nIndent) + "If match Then" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + " prop = " + WQ + index[i] + WQ + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + " val = " + syntax[index[i]] + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "EndIf" + CRLF
ElseIf Text.GetIndexOf(syntax["valOpe"], name) > 0 Then
code = code + Text.GetSubText(SP60, 1, nIndent) + "If match Then" + CRLF
ptrb = Text.GetIndexOf(syntax[index[i]], "[")
ope = Text.GetSubText(syntax[index[i]], 1, ptrb - 1)
code = code + Text.GetSubText(SP60, 1, nIndent) + " val = " + ope + "("
For n = 1 To nVal
If n > 1 Then
code = code + ", "
EndIf
code = code + "_val[" + n + "]"
EndFor
code = code + ")" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + " If traceX Then" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + " TextWindow.WriteLine("
code = code + WQ + "! " + WQ + " + val + " + WQ + "=" + ope + "("
If nVal > 0 Then
code = code + WQ + " + "
EndIf
For n = 1 To nVal
If n > 1 Then
code = code + " + " + WQ + "," + WQ + " + "
EndIf
code = code + "_val[" + n + "]"
EndFor
If nVal > 0 Then
code = code + " + " + WQ
EndIf
code = code + ")" + WQ + ")" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + " EndIf" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "EndIf" + CRLF
ElseIf Text.GetIndexOf(syntax["voidOpe"], name) > 0 Then
code = code + Text.GetSubText(SP60, 1, nIndent) + "If match Then" + CRLF
ptrb = Text.GetIndexOf(syntax[index[i]], "[")
ope = Text.GetSubText(syntax[index[i]], 1, ptrb - 1)
code = code + Text.GetSubText(SP60, 1, nIndent) + " " + ope + "("
For n = 1 To nVal
If n > 1 Then
code = code + ", "
EndIf
code = code + "_val[" + n + "]"
EndFor
code = code + ")" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + " If traceX Then" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + " TextWindow.WriteLine("
code = code + WQ + "! " + ope + "("
If nVal > 0 Then
code = code + WQ + " + "
EndIf
For n = 1 To nVal
If n > 1 Then
code = code + " + " + WQ + "," + WQ + " + "
EndIf
code = code + "_val[" + n + "]"
EndFor
If nVal > 0 Then
code = code + " + " + WQ
EndIf
code = code + ")" + WQ + ")" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + " EndIf" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "EndIf" + CRLF
EndIf
EndSub

Sub PG_Init
' Parser Generator | Initialize
' return subs[] - subroutine names to copy
' return syntax[] - BNF syntax array to parse

' initialize subroutine names to copy
subs[1] = "CBG_Main" ' will be used in PG_Main as subs[1]
subs[2] = "CBG_GetLine"
subs[3] = "CBG_GetLineCount"
subs[4] = "CBG_OnButtonClicked"
subs[5] = "CBG_OnMouseDown"
subs[6] = "CBG_Parse"
subs[7] = "CBG_ShowDestinationWindow"
subs[8] = "CBG_ShowSourceWindow"
subs[9] = "Exec_Mem" ' for member (property, operation, event)
subs[10] = "Exec_Real" ' for real number
subs[11] = "Exec_Rem" ' for remark (comment)
subs[12] = "Exec_Token" ' for token (keyword, operator, member, literal, variable, remark, space)
subs[13] = "Lex_Init"
subs[14] = "Lex_Name"
subs[15] = "Lex_Num"
subs[16] = "Lex_Space0"
subs[17] = "Lex_Space1"
subs[18] = "Lex_Str" ' for string
subs[19] = "Lex_StrConvert"
subs[20] = "Lex_Text"
' initialize constants
Lex_Init()
nIndent = 0
' initialize syntax array
syntax["state"] = "*[]" ' statement
syntax["token"] = "{||||<_str>|||[]}" ' token
syntax["kw"] = "{For|To|Step|EndFor|If|Then|ElseIf|Else|EndIf|While|EndWhile|Goto|Sub|EndSub}" ' 14 keywords
syntax["op"] = "{+|-|'*'|/|=|'<'|'>'|'<='|'>='|'<>'|And|Or|(|,|)|:}" ' operator
syntax["mem"] = "<_name>[].[]<_name>" ' member (property or event)
syntax["var"] = "{<_name>|'['|']'}" ' variable
syntax["rem"] = "_SQ*" ' remark (comment)
syntax["real"] = "[-]<_num>[.<_num>]" ' real number
EndSub

Sub PG_Main
' Parser Generator | Main
' return code
code = "' " + Clock.Date + " " + Clock.Time + " Code generated "
code = code + "by " + title + CRLF + CRLF
code = code + "version = " + WQ + version + WQ + CRLF
code = code + subs[1] + "()" + CRLF + CRLF
count = Array.GetItemCount(subs)
For i = 1 To count
subname = subs[i]
SB_GetSub()
code = code + buf + CRLF + CRLF
EndFor
count = Array.GetItemCount(syntax)
index = Array.GetAllIndices(syntax)
For i = 1 To count
exec = ""
nExec = 0
nVal = 0
nConst = 0
buf = syntax[index[i]]
len = Text.GetLength(buf)
ptr = 1
i1 = Text.ConvertToUpperCase(Text.GetSubText(index[i], 1, 1))
i2 = Text.GetSubTextToEnd(index[i], 2)
code = code + Text.GetSubText(SP60, 1, nIndent) + "Sub Parse_" + i1 + i2 + CRLF
nIndent = nIndent + 2
code = code + Text.GetSubText(SP60, 1, nIndent) + "' " + index[i] + " ::= " + buf + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "If traceC Then" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + " TextWindow.WriteLine(" + WQ + " " + WQ + " + ptr)" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "EndIf" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "_const = " + WQ + WQ + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "Stack.PushValue(" + WQ + "local" + WQ + ", _opt)" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "_opt = " + WQ + WQ + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "Stack.PushValue(" + WQ + "local" + WQ + ", _val)" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "_val = " + WQ + WQ + CRLF
delim = "&"
PG_Syntax()
PG_ExecCode()
If Array.ContainsValue(subs, "Exec_" + i1 + i2) Then
code = code + Text.GetSubText(SP60, 1, nIndent) + "Exec_" + i1 + i2 + "()" + CRLF
EndIf
code = code + Text.GetSubText(SP60, 1, nIndent) + "_val = Stack.PopValue(" + WQ + "local" + WQ + ")" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "_opt = Stack.PopValue(" + WQ + "local" + WQ + ")" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "If traceC Then" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + " TextWindow.WriteLine(" + WQ + "
" + WQ + " + ptr)" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "EndIf" + CRLF
nIndent = nIndent - 2
code = code + Text.GetSubText(SP60, 1, nIndent) + "EndSub" + CRLF
If i < count Then
code = code + CRLF
EndIf
EndFor
EndSub

Sub PG_Syntax
' Parser Generator | BNF Syntax
' syntax ::= *[ ]
' param buf - program buffer
' param ptr - program pointer
' param len - program buffer length
' param delim - delimiter
' return match - "True" if match
' return code - generated code
Stack.PushValue("local", code)
nOpt = 0
code = ""
PG_Term()
code1 = code
code = Stack.PopValue("local")
If (ptr <= len) And (Text.GetIndexOf(delim, Text.GetSubText(buf, ptr, 1)) = 0) Then
code = code + Text.GetSubText(SP60, 1, nIndent) + "Stack.PushValue(" + WQ + "ptr" + WQ + ",ptr)" + CRLF
code = code + code1
While (ptr <= len) And (Text.GetIndexOf(delim, Text.GetSubText(buf, ptr, 1)) = 0)
code = code + Text.GetSubText(SP60, 1, nIndent) + "If match Then" + CRLF
nIndent = nIndent + 2
PG_Term()
nIndent = nIndent - 2
code = code + Text.GetSubText(SP60, 1, nIndent) + "EndIf" + CRLF
EndWhile
code = code + Text.GetSubText(SP60, 1, nIndent) + "_ptr = Stack.PopValue(" + WQ + "ptr" + WQ + ")" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "If match = " + WQ + "False" + WQ + " Then" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + " ptr = _ptr" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "EndIf" + CRLF
Else
code = code + code1
EndIf
EndSub

Sub PG_Term
' Parser Generator | BNF Term
' term ::= { '[' ']' | '[' ']' | '*[' ']' | '{' [ '|' ] '}' | '<' '>' | }
' param buf - program buffer
' param ptr - program pointer
' param len - program buffer length
' return match - "True" if match
' return code - generated code
' return term - terminal symbol | non-terminal symbol
term = ""
If Text.GetSubText(buf, ptr, 1) = "[" Then
ptr = ptr + 1
If Text.GetSubText(buf, ptr, 1) = "]" Then
code = code + Text.GetSubText(SP60, 1, nIndent) + "Lex_Space0()" + CRLF
Else
Stack.PushValue("local", delim)
delim = "]"
PG_Syntax()
delim = Stack.PopValue("local")
code = code + Text.GetSubText(SP60, 1, nIndent) + "match = " + WQ + "True" + WQ + CRLF
EndIf
ptr = ptr + 1
ElseIf Text.StartsWith(Text.GetSubTextToEnd(buf, ptr), "*[") Then
ptr = ptr + 2
code = code + Text.GetSubText(SP60, 1, nIndent) + "match = " + WQ + "True" + WQ + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "While match And (ptr <= len)" + CRLF
nIndent = nIndent + 2
Stack.PushValue("local", delim)
delim = "]"
PG_Syntax()
delim = Stack.PopValue("local")
ptr = ptr + 1
nIndent = nIndent - 2
code = code + Text.GetSubText(SP60, 1, nIndent) + "EndWhile" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "match = " + WQ + "True" + WQ + CRLF
ElseIf Text.GetSubText(buf, ptr, 1) = "{" Then
ptr = ptr + 1
nOr = 0
nOpt = nOpt + 1
While (Text.GetSubText(buf, ptr, 1) <> "}") And (ptr <= len)
Stack.PushValue("local", delim)
Stack.PushValue("local", nOr)
Stack.PushValue("local", nOpt)
delim = "|}"
PG_Syntax()
nOpt = Stack.PopValue("local")
nOr = Stack.PopValue("local")
delim = Stack.PopValue("local")
code = code + Text.GetSubText(SP60, 1, nIndent) + "If match Then" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + " _opt[" + nOpt + "] = " + WQ + term + WQ + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "EndIf" + CRLF
If Text.GetSubText(buf, ptr, 1) = "|" Then
nOr = nOr + 1
ptr = ptr + 1
If nOr > 1 Then
nIndent = nIndent - 2
code = code + Text.GetSubText(SP60, 1, nIndent) + "EndIf" + CRLF
EndIf
code = code + Text.GetSubText(SP60, 1, nIndent) + "If match = " + WQ + "False" + WQ + " Then" + CRLF
nIndent = nIndent + 2
EndIf
EndWhile
ptr = ptr + 1
If nOr > 0 Then
nIndent = nIndent - 2
code = code + Text.GetSubText(SP60, 1, nIndent) + "EndIf" + CRLF
EndIf
ElseIf Text.GetSubText(buf, ptr, 1) = "<" Then ' non-terminal symbol
ptr = ptr + 1
term = ""
While (Text.GetSubText(buf, ptr, 1) <> ">") And (ptr <= len)
term = Text.Append(term, Text.GetSubText(buf, ptr, 1))
ptr = ptr + 1
EndWhile
ptr = ptr + 1
t1 = Text.ConvertToUpperCase(Text.GetSubText(term, 1, 1))
If t1 = "_" Then
t1 = Text.ConvertToUpperCase(Text.GetSubText(term, 2, 1))
t2 = Text.GetSubTextToEnd(term, 3)
code = code + Text.GetSubText(SP60, 1, nIndent) + "Lex_" + t1 + t2 + "()" + CRLF
nVal = nVal + 1
code = code + Text.GetSubText(SP60, 1, nIndent) + "_val[" + nVal + "] = val" + CRLF
Else
t2 = Text.GetSubTextToEnd(term, 2)
code = code + Text.GetSubText(SP60, 1, nIndent) + "Parse_" + t1 + t2 + "()" + CRLF
nVal = nVal + 1
code = code + Text.GetSubText(SP60, 1, nIndent) + "_val[" + nVal + "] = val" + CRLF
EndIf
ElseIf Text.GetSubText(buf, ptr, 1) = "'" Then ' (quoted) terminal symbol
ptr = ptr + 1
term = ""
While (Text.GetSubText(buf, ptr, 1) <> "'") And (ptr <= len)
term = Text.Append(term, Text.GetSubText(buf, ptr, 1))
ptr = ptr + 1
EndWhile
ptr = ptr + 1
If term = "_SQ" Then
code = code + Text.GetSubText(SP60, 1, nIndent) + "txt = SQ" + CRLF
ElseIf term = "_CRLF" Then
code = code + Text.GetSubText(SP60, 1, nIndent) + "txt = CRLF" + CRLF
Else
code = code + Text.GetSubText(SP60, 1, nIndent) + "txt = " + WQ + term + WQ + CRLF
EndIf
code = code + Text.GetSubText(SP60, 1, nIndent) + "Lex_Text()" + CRLF
nConst = nConst + 1
code = code + Text.GetSubText(SP60, 1, nIndent) + "_const[" + nConst + "] = val" + CRLF
ElseIf Text.GetSubText(buf, ptr, 1) = " " Then
code = code + Text.GetSubText(SP60, 1, nIndent) + "Lex_Space1()" + CRLF
ptr = ptr + 1
ElseIf Text.GetSubText(buf, ptr, 1) = "*" Then
code = code + Text.GetSubText(SP60, 1, nIndent) + "_ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), CRLF)" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "If _ptr = 0 Then" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + " _ptr = len + 1" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "EndIf" + CRLF
nConst = nConst + 1
code = code + Text.GetSubText(SP60, 1, nIndent) + "_const[" + nConst + "] = Text.GetSubText(buf, ptr, _ptr - 1)" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "ptr = ptr + _ptr + 1" + CRLF
code = code + Text.GetSubText(SP60, 1, nIndent) + "match = " + WQ + "True" + WQ + CRLF
ptr = ptr + 1
Else ' terminal symbol
term = ""
While (Text.GetIndexOf("[]*{|}<>' ", Text.GetSubText(buf, ptr, 1)) = 0) And (ptr <= len)
term = term + Text.GetSubText(buf, ptr, 1)
ptr = ptr + 1
EndWhile
If term <> "" Then
If term = "_SQ" Then
code = code + Text.GetSubText(SP60, 1, nIndent) + "txt = SQ" + CRLF
Else
code = code + Text.GetSubText(SP60, 1, nIndent) + "txt = " + WQ + term + WQ + CRLF
EndIf
code = code + Text.GetSubText(SP60, 1, nIndent) + "Lex_Text()" + CRLF
nConst = nConst + 1
code = code + Text.GetSubText(SP60, 1, nIndent) + "_const[" + nConst + "] = val" + CRLF
EndIF
EndIf
EndSub

Sub SB_GetSub
' Small Basic | Get subroutine from Small Basic source file
' param filename - file name
' param subname - subroutine name
' return buf - subroutine buffer
len = Text.GetLength(subname)
' The following line could be harmful and has been automatically commented.
' buf = File.ReadContents(filename)
ptr = 1
notFound = "True"
While notFound
_ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), "Sub")
If _ptr = 0 Then
buf = ""
Goto sbgs_exit
EndIf
ptrSub = ptr + _ptr - 1
ptr = ptrSub + 3
While Text.GetSubText(buf, ptr, 1) = " "
ptr = ptr + 1
EndWhile
If Text.GetSubText(buf, ptr, len) = subname And Text.IsSubText(TCHAR, Text.GetSubText(buf, ptr + len, 1)) = "False" Then
notFound = "False"
EndIf
EndWhile
_ptre = _ptr - 1
_ptrq = _ptr
While (0 < _ptrq) And (_ptre < _ptrq) ' EOL exists before single quote (comment)
_ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), "EndSub")
If _ptr = 0 Then
buf = ""
Goto sbgs_exit
EndIf
_ptre = ptr + _ptr - 3
While (1 <= _ptre) And (Text.GetSubText(buf, _ptre, 2) <> CRLF)
_ptre = _ptre - 1
EndWhile
_ptrq = ptr + _ptr - 2
While (1 <= _ptrq) And (Text.GetSubText(buf, _ptrq, 1) <> "'")
_ptrq = _ptrq - 1
EndWhile
If (0 < _ptrq) And (_ptre < _ptrq) Then
ptr = ptr + _ptr + 5
EndIf
EndWhile
ptrEndSub = ptr + _ptr - 1
ptr = ptrEndSub + 6
len = ptr - ptrSub
buf = Text.GetSubText(buf, ptrSub, len)
sbgs_exit:
EndSub