Microsoft Small Basic

Program Listing:
Embed this in your website
' 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
Copyright (c) Microsoft Corporation. All rights reserved.