Microsoft Small Basic

Program Listing: GTV460-1

List Program

' Subroutines 1.7b (GTV460-1)
' These subroutines are for Shapes 1.7b.
Sub ReadShapes
File_Open()
' Parse "shX = ..."
ptr = Text.GetIndexOf(buf, "shX = ")
If ptr = 0 Then
Goto rs_exit
EndIf
shX = ""
ptr = ptr + 6
c = Text.GetSubText(buf, ptr, 1)
While Text.GetIndexOf("0123456789", c) > 0
shX = Text.Append(shX, c)
ptr = ptr + 1
c = Text.GetSubText(buf, ptr, 1)
EndWhile
' Parse "shY = ..."
_ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), "shY = ")
If _ptr = 0 Then
Goto rs_exit
EndIf
shY = ""
ptr = ptr + _ptr + 5
c = Text.GetSubText(buf, ptr, 1)
While Text.GetIndexOf("0123456789", c) > 0
shY = Text.Append(shY, c)
ptr = ptr + 1
c = Text.GetSubText(buf, ptr, 1)
EndWhile
' Parse "shape[i] = ..."
While "True"
_ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), "shape[")
If _ptr = 0 Then
Goto rs_exit
EndIf
ptr = ptr + _ptr + 5
_ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), "] = " + WQ)
If _ptr = 0 Then
Goto rs_exit
EndIf
i = Text.GetSubText(buf, ptr, _ptr - 1)
ptr = ptr + _ptr + 4
_ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), WQ)
If _ptr = 0 Then
Goto rs_exit
EndIf
shape[nShapes + i] = Text.GetSubText(buf, ptr, _ptr - 1)
ptr = ptr + _ptr
EndWhile
rs_exit:
iMin = nShapes + 1
nShapes = Array.GetItemCount(shape)
iMax = nShapes
For i = iMin To iMax
shape[i]["x"] = shape[i]["x"] + shX
shape[i]["y"] = shape[i]["y"] + shY
If shape[i]["func"] = "tri" And (shape[i]["y2"] < shape[i]["y1"]) Then
shape[i]["y2"] = shape[i]["y1"]
shape[i]["y1"] = shape[i]["y3"]
shape[i]["y3"] = shape[i]["y2"]
shape[i]["angle"] = shape[i]["angle"] + 180
If shape[i]["angle"] >= 360 Then
shape[i]["angle"] = shape[i]["angle"] - 360
EndIf
EndIf
CalcDetectBorder()
If shape[i]["pc"] <> "" Then
color = shape[i]["pc"]
CS_AddColorToPalette()
EndIf
If shape[i]["bc"] <> "" Then
color = shape[i]["bc"]
CS_AddColorToPalette()
EndIf
EndFor
shX = 0
shY = 0
scale = 1
Shapes_Add()
EndSub
Sub File_Open
' File | Show output program to save
Stack.PushValue("local", cont)
TOPY = 80 ' top y
LEFTX = 25 ' left x
CAPTIONCOLOR = "White"
POPUPCOLOR = "Black"
TEXTCOLOR = "Black"
GraphicsWindow.PenWidth = 0
GraphicsWindow.BrushColor = POPUPCOLOR
oPopup = Shapes.AddRectangle(570, 310)
Shapes.SetOpacity(oPopup, 64)
Shapes.Move(oPopup, LEFTX - 10, TOPY - 10)
GraphicsWindow.BrushColor = CAPTIONCOLOR
oCaption = Shapes.AddText("Filename")
Shapes.Move(oCaption, LEFTX, TOPY + 2)
GraphicsWindow.BrushColor = TEXTCOLOR
oFilename = Controls.AddTextBox(LEFTX + 80, TOPY)
Controls.SetSize(oFilename, 300, 24)
oText = Controls.AddTextBox(LEFTX, TOPY + 30)
Controls.SetSize(oText, 550, 210)
oOK = Controls.AddButton("OK", LEFTX + 500, TOPY + 260)
Controls.ButtonClicked = File_OnButtonClicked
Controls.TextTyped = File_OnTextTyped
subname = "Shapes_Init"
fo_retry:
typed = "False"
cont = "True" ' continue
While cont
If typed Then
filename = Controls.GetTextBoxText(oFilename)
buf = ""
SB_AppendSub()
Controls.SetTextBoxText(oText, buf)
typed = "False"
Else
Program.Delay(200)
EndIf
EndWhile
Controls.Remove(oCaption)
Controls.Remove(oFilename)
Controls.Remove(oText)
Controls.Remove(oOK)
Controls.Remove(oPopup)
cont = Stack.PopValue("local")
EndSub
Sub File_OnTextTyped
' File | Textbox event handler
typed = "True"
EndSub