Microsoft Small Basic

Program Listing: CBF139-3
' Polyline Editor
' Copyright © 2014 Nonki Takahashi. The MIT License.
' Version 0.32b
' Last update 2014-11-21
' Program ID CBF139-3
'
GraphicsWindow.Title = "Polyline Editor 0.32b"
Not = "False=True;True=False;"
CR = Text.GetCharacter(13)
LF = Text.GetCharacter(10)
LT = Text.GetCharacter(60)
gw = 598
gh = 428
GraphicsWindow.Width = gw
GraphicsWindow.Height = gh
GraphicsWindow.BackgroundColor = "LightGray"
fw = 550
fh = 340
x0 = (gw - fw) / 2
y0 = (gh - fh) / 2 + 32
x1 = x0 + fw - 1
y1 = y0 + fh - 1
GraphicsWindow.BrushColor = "White"
GraphicsWindow.FillRectangle(x0, y0, fw, fh)
nPos = 0
pw = 2
pc = "#000000"
GraphicsWindow.PenWidth = pw
GraphicsWindow.PenColor = pc
GraphicsWindow.BrushColor = pc
tFname = Controls.AddTextBox(x0, 10)
bNew = Controls.AddButton("New", x0, 40)
bOpen = Controls.AddButton("Open", x0 + 46, 40)
bSave = Controls.AddButton("Save", x0 + 97, 40)
tOutput = Controls.AddMultiLineTextBox(gw / 2 - 100, 10)
Controls.SetSize(tOutput, fw / 2 + 100, 54)
InitSVG()
mouseDown = "False"
mouseUp = "False"
mouseMove = "False"
buttonClicked = "False"
GraphicsWindow.MouseDown = OnMouseDown
GraphicsWindow.MouseUp = OnMouseUp
GraphicsWindow.MouseMove = OnMouseMove
Controls.ButtonClicked = OnButtonClicked
While "True"
If buttonClicked Then
If button = bNew Then
New()
ElseIf button = bOpen Then
Open()
ElseIf button = bSave Then
Save()
EndIf
buttonClicked = "False"
ElseIf mouseDown Then
If x0 <= dx And dx <= x1 And y0 <= dy And dy <= y1 Then
nPos = nPos + 1
pos["x"] = dx - x0
pos["y"] = dy - y0
polyline[nPos] = pos
AddPos()
Controls.SetTextBoxText(tOutput, header + body + footer)
EndIf
mouseDown = "False"
ElseIf mouseUp Then
mouseUp = "False"
ElseIf mouseMove Then
mouseMove = "False"
Else
Program.Delay(300)
EndIf
EndWhile
Sub AddPos
If nPos = 1 Then
shape[nPos] = Shapes.AddRectangle(pw, pw)
Shapes.Move(shape[nPos], dx, dy)
Else
body = body + " "
posLast = polyline[nPos - 1]
shape[nPos] = Shapes.AddLine(posLast["x"] + x0, posLast["y"] + y0, dx, dy)
EndIf
body = body + pos["x"] + "," + pos["y"]
EndSub
Sub New
If 0 < nPos Then
OpenFilePopup()
Shapes.SetText(msg, "Are you sure to clear current polyline?")
WaitOKCancel()
If button = bOK Then
ClearPoints()
EndIf
CloseFilePopup()
EndIf
EndSub
Sub ClearPoints
For i = 1 To nPos
Shapes.Remove(shape[i])
EndFor
shape = ""
Controls.SetTextBoxText(tFname, "")
Controls.SetTextBoxText(tOutput, "")
nPos = 0
polyline = ""
body = ""
EndSub
Sub Open
button = ""
Stack.PushValue("local", Controls.GetTextBoxText(tFname))
New()
Controls.SetTextBoxText(tFname, Stack.PopValue("local"))
If button <> bCancel Then
OpenFilePopup()
If buf = "" Then
Shapes.SetText(msg, "Error:" + CR + LF + "File " + path + " not exist or empty.")
WaitOK()
Else
ParseSVG()
Shapes.SetText(msg, "File " + path + " has been opened.")
WaitOK()
EndIf
CloseFilePopup()
EndIf
EndSub
Sub OpenFilePopup
fname = Controls.GetTextBoxText(tFname)
path = Program.Directory + "\" + fname
GraphicsWindow.PenWidth = 0
GraphicsWindow.BrushColor = "Black"
popup = Shapes.AddRectangle(gw, gh)
Shapes.SetOpacity(popup, 80)
buf = ""
' The following line could be harmful and has been automatically commented.
' buf = File.ReadContents(path)
GraphicsWindow.BrushColor = "White"
msg = Shapes.AddText("")
Shapes.Move(msg, 10, 10)
EndSub
Sub CloseFilePopup
Shapes.Remove(msg)
Shapes.Remove(popup)
GraphicsWindow.PenWidth = pw
EndSub
Sub Save
OpenFilePopup()
If Not[Text.EndsWith(Text.ConvertToLowerCase(fname), ".svg")] Then
Shapes.SetText(msg, "Error:" + CR + LF + "File name should have .svg file extension.")
WaitOK()
ElseIf buf <> "" Then
Shapes.SetText(msg, "Are you sure to override" + CR + LF + path + "?")
WaitOKCancel()
If button = bOK Then
SaveToFile()
EndIf
Else
SaveToFile()
EndIf
CloseFilePopup()
EndSub
Sub SaveToFile
result = ""
' The following line could be harmful and has been automatically commented.
' result = File.WriteContents(path, header + body + footer)
If result = "SUCCESS" Then
Shapes.SetText(msg, path + " saved.")
Else
' The following line could be harmful and has been automatically commented.
' Shapes.SetText(msg, "Error: " + CR + LF + File.LastError)
EndIf
WaitOK()
EndSub
Sub WaitOK
buttonClicked = "False"
button = ""
GraphicsWindow.BrushColor = "Black"
bOK = Controls.AddButton("OK", 10, 60)
continue = "True"
While continue
If buttonClicked Then
If button = bOK Then
continue = "False"
EndIf
buttonClicked = "False"
Else
Program.Delay(200)
EndIf
EndWhile
Controls.Remove(bOK)
EndSub
Sub WaitOKCancel
buttonClicked = "False"
button = ""
GraphicsWindow.BrushColor = "Black"
bOK = Controls.AddButton("OK", 10, 60)
bCancel = Controls.AddButton("Cancel", 50, 60)
continue = "True"
While continue
If buttonClicked Then
If button = bOK Or button = bCancel Then
continue = "False"
EndIf
buttonClicked = "False"
Else
Program.Delay(200)
EndIf
EndWhile
Controls.Remove(bOK)
Controls.Remove(bCancel)
EndSub
Sub OnButtonClicked
button = Controls.LastClickedButton
buttonClicked = "True"
EndSub
Sub OnMouseDown
dx = Math.Floor(GraphicsWindow.MouseX)
dy = Math.Floor(GraphicsWindow.MouseY)
mouseDown = "True"
EndSub
Sub OnMouseUp
ux = Math.Floor(GraphicsWindow.MouseX)
uy = Math.Floor(GraphicsWindow.MouseY)
mouseUp = "True"
EndSub
Sub OnMouseMove
mx = Math.Floor(GraphicsWindow.MouseX)
my = Math.Floor(GraphicsWindow.MouseY)
mouseMove = "True"
EndSub
Sub InitSVG
' param pc - pen color
' param pw - pen width
header = LT + "svg width='" + fw + "' height='" + fh + "'>" + CR + LF
'header = header + " " + LT + "rect x='0' y='0' width='" + fw + "' height='" + fh + "'" + CR + LF
'header = header + " fill='white' stroke='lightgray'/>" + CR + LF
header = header + " " + LT + "polyline points='"
body = ""
footer = "'" + CR + LF
footer = footer + " style='fill:none;stroke:" + Text.ConvertToLowerCase(pc) + ";stroke-width:" + pw + "' />" + CR + LF
footer = footer + LT + "/svg>"
EndSub
Sub ParseSVG
' param buf - SVG buffer
' return polyline[]
p = 1
param = "tag=polyline;"
FindTag()
GetAttrAndText()
'DumpAttr()
SetStyle()
polyline = ""
InitSVG()
nPos = 0
p = 1
lPoints = Text.GetLength(attr["points"])
GraphicsWindow.PenWidth = pw
GraphicsWindow.PenColor = pc
GraphicsWindow.BrushColor = pc
While p <= lPoints
pComma = Text.GetIndexOf(Text.GetSubTextToEnd(attr["points"], p), ",")
pos["x"] = Text.GetSubText(attr["points"], p, pComma - 1)
p = p + pComma
pSpace = Text.GetIndexOf(Text.GetSubTextToEnd(attr["points"], p), " ")
If pSpace = 0 Then
pSpace = lPoints - p + 2
EndIf
pos["y"] = Text.GetSubText(attr["points"], p, pSpace - 1)
nPos = nPos + 1
polyline[nPos] = pos
dx = pos["x"] + x0
dy = pos["y"] + y0
AddPos()
p = p + pSpace
EndWhile
Controls.SetTextBoxText(tOutput, header + body + footer)
EndSub
Sub DumpAttr
nAttr = Array.GetItemCount(attr)
iAttr = Array.GetAllIndices(attr)
For i = 1 To nAttr
TextWindow.WriteLine("attr['" + iAttr[i] + "']='" + attr[iAttr[i]] + "'")
EndFor
EndSub
Sub SetStyle
p = 1
kw = "stroke"
GetStyleAttr()
pc = value
kw = "stroke-width"
GetStyleAttr()
pw = value
EndSub
Sub GetStyleAttr
' param kw - keyword
' param attr["style"] - style attribute
' param p - pointer to search in style attribute
' return value - value
pKw = Text.GetIndexOf(Text.GetSubTextToEnd(attr["style"], p), kw)
If pKw = 0 Then
value = ""
Else
pValue = p + pKw + Text.GetLength(kw)
pColon = Text.GetIndexOf(Text.GetSubTextToEnd(attr["style"], pValue), ";")
If pColon = 0 Then
pColon = Text.GetLength(kw) + 1
EndIf
value = Text.GetSubText(attr["style"], pValue, pColon - 1)
EndIf
EndSub
Sub FindTag
' find tag from html buffer
' param["tag"] - tag name
' param["class"] - class name
' param p - pointer for buffer
' param buf - html buffer
' return tag - found tag
pSave = p
tag = ""
findNext = "True"
While findNext
findNext = "False" ' tag may be not found
pTag = Text.GetIndexOf(Text.GetSubTextToEnd(buf, p), LT + param["tag"])
If 0 < pTag Then
lTag = Text.GetLength(param["tag"]) + 1
pTag = p + pTag - 1
len = Text.GetIndexOf(Text.GetSubTextToEnd(buf, pTag), "/" + param["tag"] + ">")
If len = 0 Then
lTag = 1
len = Text.GetIndexOf(Text.GetSubTextToEnd(buf, pTag), "/>")
EndIf
If param["class"] = "" Then
len = len + lTag
tag = Text.GetSubText(buf, pTag, len)
findNext = "False" ' found the tag
ElseIf 0 < len Then
findNext = "True" ' tag may have different class
len = len + lTag
attr = "class=" + "'" + param["class"] + "'"
pAttr = pTag + lTag + 1
lAttr = Text.GetLength(attr)
If Text.GetSubText(buf, pAttr, lAttr) = attr Then
tag = Text.GetSubText(buf, pTag, len)
findNext = "False" ' found the tag
EndIf
EndIf
p = pTag + len
EndIf
EndWhile
If tag = "" Then
p = pSave
EndIf
EndSub
Sub GetAttrAndText
' get attributes and text from given tag
' param tag - given tag
' return attr[] - array of attributes in the tag
' return txt - text in the tag
pTag = Text.GetIndexOf(tag, " ") + 1
pEnd = Text.GetIndexOf(tag, ">")
attr = ""
While pTag <= pEnd
SkipSpace()
pEq = Text.GetIndexOf(Text.GetSubTextToEnd(tag, pTag), "=")
If 0 < pEq Then
pEq = pTag + pEq - 1
If Text.GetSubText(tag, pEq + 1, 1) = "'" Then
pQ = Text.GetIndexOf(Text.GetSubTextToEnd(tag, pEq + 2), "'")
If 0 < pQ Then
pQ = pEq + 2 + pQ - 1
attr[Text.GetSubText(tag, pTag, pEq - pTag)] = Text.GetSubText(tag, pEq + 2, pQ - pEq - 2)
pTag = pQ + 2
EndIf
EndIf
Else
pTag = pEnd + 1
EndIf
EndWhile
If pEnd + 1 < pTag Then
pTag = pEnd + 1
EndIf
len = Text.GetLength(tag)
txt = ""
While pTag <= len
pL = Text.GetIndexOf(Text.GetSubTextToEnd(tag, pTag), LT)
If pL = 0 Then
txt = Text.Append(txt, Text.GetSubTextToEnd(tag, pTag))
pTag = len + 1
Else
pL = pTag + pL - 1
txt = Text.Append(txt, Text.GetSubText(tag, pTag, pL - pTag))
pR = Text.GetIndexOf(Text.GetSubTextToEnd(tag, pTag), ">")
If 0 < pR Then
pTag = pTag + pR
Else
pTag = len + 1
EndIf
EndIf
EndWhile
EndSub
Sub SkipSpace
' param pTag - point to tag
' param tag - tag
' return pTag - updated point to tag
isSpace = "True"
While isSpace
char = Text.GetSubText(tag, pTag, 1)
If Text.IsSubText(" " + CR + LF, char) Then
pTag = pTag + 1
Else
isSpace = "False"
EndIf
EndWhile
EndSub