Microsoft Small Basic

Program Listing:
Embed this in your website
''' Plain PPM Editor
''' Version 0.9b
''' Copyright © 2015-2016 Nonki Takahashi. The MIT License.
''' Last update 2016-04-25
''' Program ID RFT686-8
''' Repository https://iconeditorsb.codeplex.com/
'
' TODO:
' [✓] #15 Bug fixed - saved PPM has wrong dimension
' [ ] #10 Support other image format in Open
' [ ] #9 Workaround for Silverlight
' [ ] #8 Add unit test feature
'
' set graphics window title
title = "Icon Editor 0.9b"
fname = "Untitled"
GraphicsWindow.Title = fname + " - " + title
' define variables as constants or functions
debug = "False"
If debug Then
  TextWindow.Title = "Debug - " + title
  Timer.Interval = 500
  Timer.Tick = Mouse_OnTick
EndIf
CR = Text.GetCharacter(13)
LF = Text.GetCharacter(10)
TAB = Text.GetCharacter(9)
DIGIT = "0123456789"
Not = "False=True;True=False;"
' width/height [%] of each character in Trebuchet MS font
ratio = "32=30;48=58;49=58;50=58;51=58;52=58;53=58;54=58;55=58;56=58;"
ratio = ratio + "57=58;65=63;66=59;67=61;68=64;69=57;70=58;71=67;"
ratio = ratio + "72=68;73=28;74=53;75=62;76=55;77=74;78=67;79=70;"
ratio = ratio + "80=59;81=71;82=61;83=51;84=61;85=68;86=62;87=88;"
ratio = ratio + "88=60;89=61;90=56;97=53;98=58;99=51;100=58;101=57;"
ratio = ratio + "102=37;103=50;104=59;105=30;106=37;107=55;108=29;"
ratio = ratio + "109=86;110=59;111=56;112=58;113=58;114=43;115=43;"
ratio = ratio + "116=39;117=59;118=53;119=78;120=55;121=53;122=53;"
' initialize mouse and keyboard events
Mouse_Init()
KB_Init()
' show menu, white icon, and edit field in graphics window
pcolor = GraphicsWindow.PenColor
Form()
GraphicsWindow.FontSize = 12
Color_Init()
Msg_Init()
Macro_Init()
While "True"
  If clicked Then
    ' find clicked object - menu item or pixel of the icon
    Mouse_DetectObject()
    ' create message (command) for the object if found
    If name = "pen color" Then
      param = "cmd=color;"
      Msg_Set()
    ElseIf name = "icon" Then
      Icon_MouseToXY()
      If 0 <= x And 0 <= y Then
        param = "cmd=pixel;x=" + x + ";y=" + y + ";"
        Msg_Set()
      EndIf
    ElseIf name <> "" Then
      param = "cmd=" + name + ";"
      Msg_Set()
    EndIf
    clicked = "False"
  EndIf
  While keyOut < keyIn
    KB_InKey()
    ' create message (command) for the shortcut if found
    If c = "^N" Then
      param = "cmd=new;"
      Msg_Set()
      c = ""
    ElseIf c = "^O" Then
      param = "cmd=open;"
      Msg_Set()
      c = ""
    ElseIf c = "^S" Then
      param = "cmd=save;"
      Msg_Set()
      c = ""
    ElseIf c = "^Z" Then
      param = "cmd=undo;"
      Msg_Set()
      c = ""
    ElseIf c = "^Y" Then
      param = "cmd=redo;"
      Msg_Set()
      c = ""
    ElseIf debug Then
      TextWindow.ForegroundColor = "Red"
      TextWindow.WriteLine("Unknown cmd: '" + c + "'")
      TextWindow.ForegroundColor = "Gray"
      c = ""
    EndIf
  EndWhile
  If msgOut < msgIn Then
    ' do action for the message (command)
    msgOut = msgOut + 1
    msg = message[msgOut]
    If msg["cmd"] = "new" Then
      New()
    ElseIf msg["cmd"] = "open" Then
      Open()
    ElseIf msg["cmd"] = "save" Then
      Save()
    ElseIf msg["cmd"] = "undo" Then
      Macro_Undo()
    ElseIf msg["cmd"] = "redo" Then
      Macro_Redo()
    ElseIf msg["cmd"] = "color" Then
      color = pcolor
      CS_ShowPopup()
      pcolor = color
      Color_SetPenColor()
    ElseIf msg["cmd"] = "pixel" Then
      x = msg["x"]
      y = msg["y"]
      Icon_GetPixel()
      msg["from"] = color
      msg["to"] = pcolor
      Macro_Add()
      color = pcolor
      Icon_SetPixel()
    Else
      GraphicsWindow.Title = msg["cmd"] + " - " + title
    EndIf
  EndIf
  If debug Then
    Debug_StateChanged()
    If changed Then
      Debug_Dump()
    EndIf
  EndIf
EndWhile
Sub Form
  ''' Draw GUI form
  gw = 598
  gh = 428
  GraphicsWindow.Width = gw
  GraphicsWindow.Height = gh
  GraphicsWindow.BackgroundColor = "DimGray"
  sizes[1] = "iw=16;ih=16;dot=16;"
  sizes[2] = "iw=32;ih=32;dot=8;"
  sizes[3] = "iw=40;ih=40;dot=6;"
  id = 2
  iconWidth = sizes[id]["iw"]
  iconHeight = sizes[id]["ih"]
  itemSize = 40
  itemGap = 10
  menuHeight = 60
  size = sizes[id]["dot"]
  gap = 2
  Menu_Draw()
  xEdit = Math.Floor((gw - (size + gap + 1) * iconWidth) / 2) + iconWidth
  yEdit = Math.Floor((gh - menuHeight - (size + gap) * iconHeight) / 2) + menuHeight
  xIcon = Math.Floor((xEdit - iconWidth) / 2)
  yIcon = yEdit
  add = "True"
  Icon_Clear()
  add = "False"
EndSub
Sub New
  ''' New command - start new icon edit
  yes = "True"
  If Text.IsSubText(GraphicsWindow.Title, "*") Then
    caution = "Are you sure to clear the icon?"
    Dialog_YesNo()
  EndIf
  If yes Then
    Icon_Clear()
    fname = "Untitled"
    relPath = ""
    Macro_Init()
  EndIf
EndSub
Sub Open
  ''' Open command - open PPM file
  File_Open()
  Parse_PPM()
  If match And relPath <> "" Then
    fname = relPath
    Macro_Init()
  EndIf
EndSub
Sub Save
  ''' Save command - save PPM file
  File_GeneratePPM()
  File_Save()
EndSub
Sub Array_GetIndexOfValue
  ''' Array | Get index of value
  ''' param arry - array
  ''' param value - value to get index
  ''' return index - index if found or "" if not found
  nValue = Array.GetItemCount(arry)
  indices = Array.GetAllIndices(arry)
  index = ""
  For iArry = 1 To nValue
    If value = arry[indices[iArry]] Then
      index = indices[iArry]
      iArry = nValue + 1  ' break
    EndIf
  EndFor
EndSub
Sub Color_ColorToRGB
  ''' Color | Convert Color to RGB
  ''' param sColor - "#rrggbb"
  ''' return iR, iG, iB - [0, 255]
  sR = Text.GetSubText(sColor, 2, 2)
  sG = Text.GetSubText(sColor, 4, 2)
  sB = Text.GetSubText(sColor, 6, 2)
  sHex = sR
  Math_Hex2Dec()
  iR = iDec
  sHex = sG
  Math_Hex2Dec()
  iG = iDec
  sHex = sB
  Math_Hex2Dec()
  iB = iDec
EndSub
Sub Color_HSLtoRGB
  ''' Color | Convert HSL to RGB
  ''' param rHue - [0, 360) or UNDEFINED
  ''' param rLightness - [0, 1]
  ''' param rSaturation - [0, 1]
  ''' return iR, iG, iB - RGB color
  ''' return sColor - "#rrggbb"
  If rLightness <= 0.5 Then
    rN2 = rLightness * (1 + rSaturation)
  Else
    rN2 = rLightness + rSaturation - rLightness * rSaturation
  EndIf
  rN1 = 2 * rLightness - rN2
  If rSaturation = 0 Then
    iR = Math.Round(rLightness * 255)
    iG = Math.Round(rLightness * 255)
    iB = Math.Round(rLightness * 255)
  Else
    rH = rHue + 120
    Color_Value()
    iR = iValue
    rH = rHue
    Color_Value()
    iG = iValue
    rH = rHue - 120
    Color_Value()
    iB = iValue
  EndIf
  sColor = GraphicsWindow.GetColorFromRGB(iR, iG, iB)
EndSub
Sub Color_Init
  ''' Color | Initialize for colors
  Popup_Init()
  Color_SetPenColor()
  CS_InitPalette()          ' initialize palette for color slider
EndSub
Sub Color_RGBtoHSL
  ''' Color | Convert RGB to HSL
  ''' param sColor - "#rrggbb"
  ''' return rHue - [0, 360) or UNDEFINED
  ''' return rLightness - (0, 1)
  ''' return rSaturation - (0, 1)
  Color_ColorToRGB()
  ' rR = iR / 255 ' occurs Math.Max() bug
  rR = Math.Round(iR / 255 * 10000) / 10000
  ' rG = iG / 255 ' occurs Math.Max() bug
  rG = Math.Round(iG / 255 * 10000) / 10000
  ' rB = iB / 255 ' occurs Math.Max() bug
  rB = Math.Round(iB / 255 * 10000) / 10000
  rMax = Math.Max(rR, rG)
  rMax = Math.Max(rMax, rB)
  rMin = Math.Min(rR, rG)
  rMin = Math.Min(rMin, rB)
  rLightness = (rMax + rMin) / 2
  If rMax = rMin Then ' rR = rG = rB
    rSaturation = 0
    rHue = UNDEFINED
  Else
    If rLightness <= 0.5 Then
      rSaturation = (rMax - rMin) / (rMax + rMin)
    Else
      rSaturation = (rMax - rMin) / (2 - rMax - rMin)
    EndIf
    rRC = (rMax - rR) / (rMax - rMin)
    rGC = (rMax - rG) / (rMax - rMin)
    rBC = (rMax - rB) / (rMax - rMin)
    If rR = rMax Then     ' between Yellow and Magenta
      rHue = rBC - rGC
    ElseIf rG = rMax Then ' between Cyan and Yellow
      rHue = 2 + rRC - rBC
    ElseIf rB = rMax Then ' between Magenta and Cyan
      rHue = 4 + rGC - rRC
    Else
      TextWindow.WriteLine("Error:")
      TextWindow.WriteLine("rMax=" + rMax)
      TextWindow.WriteLine("rR=" + rR + ",sR=" + sR)
      TextWindow.WriteLine("rG=" + rG + ",sG=" + sG)
      TextWindow.WriteLine("rB=" + rB + ",sB=" + sB)
    EndIf
    rHue = rHue * 60
    If rHue < 0 Then
      rHue = rHue + 360
    EndIf
  EndIf
EndSub
Sub Color_Value
  ''' Color | Function value
  ''' param rN1, rN2
  ''' param rH - [-120, 480)
  ''' return iValue - 0..255
  If rH >= 360 Then
    rH = rH - 360
  EndIF
  If rH < 0 Then
    rH = rH + 360
  EndIF
  If rH < 60 Then
    rV = rN1 + (rN2 - rN1) * rH / 60
  ElseIf rH < 180 Then
    rV = rN2
  ElseIf rH < 240 Then
    rV = rN1 + (rN2 - rN1) * (240 - rH) / 60
  Else
    rV = rN1
  EndIf
  iValue = Math.Round(rV * 255)
EndSub
Sub CS_AddColorToPalette
  ''' Color Selector | Add color to palette
  ''' param color - color to set
  ''' param maxPalette
  ''' param nPalette
  ''' param palette
  ''' param tPalette - target palette
  Stack.PushValue("local", i)
  For i = 1 To nPalette
    pltt = palette[i]
    If color = pltt["color"] Then
      Goto csactp_not_new_color
    EndIf
  EndFor
  pltt = palette[tPalette]
  pltt["color"] = color
  palette[tPalette] = pltt
  If nPalette < maxPalette Then
    nPalette = nPalette + 1
  EndIf
  tPalette = tPalette + 1
  If maxPalette < tPalette Then
    tPalette = 1
  EndIf
  csactp_not_new_color:
  i = Stack.PopValue("local")
EndSub
Sub CS_AdjustSlider
  ''' Color Selector | Adjust slider
  ''' param iSlider - moved slider
  Stack.PushValue("local", iSlider)
  If iSlider = iHue Or iSlider = iLightness Or iSlider = iSaturation Then
    If iSlider = iHue Then
      Slider_GetLevel()
      rHue = level
    ElseIf iSlider = iLightness Then
      Slider_GetLevel()
      rLightness = level / 100
    Else
      Slider_GetLevel()
      rSaturation = level / 100
    EndIf
    Color_HSLtoRGB()
    iSlider = iRed
    level = iR
    Slider_SetLevel()
    iSlider = iGreen
    level = iG
    Slider_SetLevel()
    iSlider = iBlue
    level = iB
    Slider_SetLevel()
  Else
    CS_GetColorFromSlider()
    sColor = GraphicsWindow.GetColorFromRGB(red, green, blue)
    Color_RGBtoHSL()
    If rHue = UNDEFINED Then
      rHue = 0
    EndIf
    iSlider = iHue
    level = Math.Floor(rHue)
    Slider_SetLevel()
    iSlider = iSaturation
    level = Math.Floor(rSaturation * 100)
    Slider_SetLevel()
    iSlider = iLightness
    level = Math.Floor(rLightness * 100)
    Slider_SetLevel()
  EndIf
  iSlider = Stack.PopValue("local")
EndSub
Sub CS_DoObject
  ''' Color Selector | Do object
  ''' param - obj
  While obj <> ""
    CS_DoSlider()
    If obj <> "" Then
      CS_DoPalette()
    EndIf
  EndWhile
EndSub
Sub CS_DoPalette
  ''' Color Selector | Do palette
  ''' param obj - clicked object
  If Text.StartsWith(obj, "palette") Then
    iPalette = Text.GetSubTextToEnd(obj, 8)
    pltt = palette[iPalette]
    color = pltt["color"]
    CS_SetColorToSlider()   ' set color to slider
    CS_ShowNewColor()       ' show new color name
    CS_DrawColorRect()      ' draw new color rectangle
    obj = ""
    param = "down=True;move=False;up=False;"  ' wait to click
    Mouse_SetHandler()
  EndIf
EndSub
Sub CS_DoSlider
  ''' Color Selector | Do slider
  ''' param obj - clicked object
  ''' param iSlider - index of slider
  If Text.StartsWith(obj, "slider") Then
    Slider_WaitToRelease()
    obj = ""
    param = "down=True;move=False;up=False;"  ' wait to click
    Mouse_SetHandler()
  EndIf
EndSub
Sub CS_DrawColorRect
  ''' Color Selector | Draw color rectangle
  ''' param color - color of rectangle
  ''' param x, y, width, height - position and size of rectangle
  ''' return oRect - rectangle object
  GraphicsWindow.BrushColor = color
  GraphicsWindow.PenColor = BORDERCOLOR
  If oRect <> "" Then
    Shapes.Remove(oRect)
  EndIf
  oRect = Shapes.AddRectangle(width, height)
  Shapes.Move(oRect, x, y)
EndSub
Sub CS_DrawPalette
  ''' Color Selector | Draw palette
  ''' param palette[] - color palette
  ''' param nPalette - number of color in palette
  ''' param x, y, width, height - position and size of rectangle
  ''' return oPalette[] - palette object array
  Stack.PushValue("local", i)
  GraphicsWindow.PenColor = BORDERCOLOR
  For i = 1 To nPalette
    pltt = palette[i]
    GraphicsWindow.BrushColor = pltt["color"]
    pltt["oCell"] = Shapes.AddRectangle(width, height)
    dx = Math.Remainder((i - 1), (maxPalette / 2)) * (width + 4)
    dy = Math.Floor((i - 1) / (maxPalette / 2)) * (height + 4)
    Shapes.Move(pltt["oCell"], x + dx, y + dy)
    pltt["x"] = x + dx
    pltt["y"] = y + dy
    pltt["width"] = width
    pltt["height"] = height
    palette[i] = pltt
  EndFor
  i = Stack.PopValue("local")
EndSub
Sub CS_GetColorFromSlider
  ''' Color Selector | get color from slider
  ''' return color
  Stack.PushValue("local", iSlider)
  iSlider = iRed    ' slider index
  Slider_GetLevel()
  red = level
  iSlider = iGreen  ' slider index
  Slider_GetLevel()
  green = level
  iSlider = iBlue   ' slider index
  Slider_GetLevel()
  blue = level
  color = GraphicsWindow.GetColorFromRGB(red, green, blue)
  iSlider = Stack.PopValue("local")
EndSub
Sub CS_Init
  ''' Color Selector | Initialize sliders
  width = 256
  min = 0
  max = 255
  left = 190
  ' add red slider
  top = TOPY
  caption = "R"
  Slider_Add()
  iRed = iSlider        ' index of slider
  ' add green slider
  top = top + DELTAY
  caption = "G"
  Slider_Add()
  iGreen = iSlider      ' index of slider
  ' add blue slider
  top = top + DELTAY
  caption = "B"
  Slider_Add()
  iBlue = iSlider       ' index of slider
  ' add hue slider
  width = 360
  top = top + DELTAY
  max = 360
  caption = "H"
  Slider_Add()
  iHue = iSlider        ' index of slider
  ' add saturation slider
  width = 100
  top = top + DELTAY
  max = 100
  caption = "S"
  Slider_Add()
  iSaturation = iSlider ' index of slider
  ' add lightness slider
  width = 100
  top = top + DELTAY
  max = 100
  caption = "L"
  Slider_Add()
  iLightness = iSlider  ' index of slider
  ' draw color rectangle
  CS_GetColorFromSlider()
  CS_ShowNewColor()
  x = LEFTX
  y = TOPY + DELTAY * 4
  width = 100
  height = 100
  CS_DrawColorRect()
  ' add text box
  GraphicsWindow.BrushColor = CAPTIONCOLOR
  top = y + height + 4
  oNewColor = Shapes.AddText("")
  Shapes.Move(oNewColor, LEFTX, top)
EndSub
Sub CS_DumpSlider
  ''' Color Selector | Dump slider for debug
  For i = 1 To numSlider
    TextWindow.WriteLine("slider" + i)
    TextWindow.WriteLine(slider[i])
  EndFor
EndSub
Sub CS_InitPalette
  ''' Color Selector | Initialize palette
  ''' This subroutine should be called before CS_ShowPopup().
  pcolor = GraphicsWindow.PenColor
  If Text.GetLength(pcolor) = 9 Then      ' for Silverlight
    pcolor = "#" + Text.GetSubText(pcolor, 4, 6)
  EndIf
  maxPalette = 24 ' max cell number of palette
  nPalette = 1    ' number of palette in use
  tPalette = 2    ' index of update target cell
  pltt = palette[1]
  pltt["color"] = pcolor
  palette[1] = pltt
EndSub
Sub CS_RemovePalette
  ''' Color Selector | Remove palette
  ''' param nPalette - number of color in palette
  ''' return oPalette[] - palette object array
  Stack.PushValue("local", i)
  For i = 1 To nPalette
    oPalette = "Palette" + i
    pltt = palette[i]
    Shapes.Remove(pltt["oCell"])
  EndFor
  i = Stack.PopValue("local")
EndSub
Sub CS_RemoveSliders
  ''' Color Selector | Remove sliders
  For iSlider = 1 To numSlider
    Slider_Remove()
  EndFor
  numSlider = 0
EndSub
Sub CS_SearchClickedObject
  ''' Color Selector | Check slider clicked
  ''' param mxD, myD - clicked point
  ''' return obj - clicked slider or palette
  ''' return iSlider - index if obj is slider
  ''' return iPalette - index if obj is palette
  Stack.PushValue("local", i)
  For iSlider = 1 To numSlider
    obj = "slider" + iSlider
    sldr = slider[iSlider]
    x2 = sldr["x2"]
    y2 = sldr["y2"]
    x3 = sldr["x3"]
    y3 = sldr["y3"]
    If x2 <= mxD And mxD <= x3 And y2 <= myD And myD <= y3 Then
      Goto scco_obj_found
    EndIf
  EndFor
  For iPalette = 1 To nPalette
    obj = "palette" + iPalette
    pltt = palette[iPalette]
    x2 = pltt["x"]
    y2 = pltt["y"]
    x3 = pltt["x"] + pltt["width"]
    y3 = pltt["y"] + pltt["height"]
    If x2 <= mxD And mxD <= x3 And y2 <= myD And myD <= y3 Then
      Goto scco_obj_found
    EndIf
  EndFor
  obj = ""
  scco_obj_found:
  i = Stack.PopValue("local")
EndSub
Sub CS_SetColorToSlider
  ''' Color Selector | Set color to slider
  ''' param color
  Stack.PushValue("local", iSlider)
  sColor = color
  Color_ColorToRGB()
  iSlider = iRed
  level = iR
  Slider_SetLevel()
  iSlider = iGreen
  level = iG
  Slider_SetLevel()
  iSlider = iBlue
  level = iB
  Slider_SetLevel()
  CS_AdjustSlider()
  iSlider = Stack.PopValue("local")
EndSub
Sub CS_ShowNewColor
  ''' Color Selector | Show new color
  ''' param oColor
  ''' param color
  Shapes.SetText(oNewColor, color)
EndSub
Sub CS_ShowPopup
  ''' Color Selector | Show popup
  ''' param color - current color
  ''' return color - new color
  ' define constant
  Stack.PushValue("local", cont)
  fs = 12
  GraphicsWindow.FontSize = fs
  GraphicsWindow.FontBold = "False"
  GraphicsWindow.BrushColor = "Black"
  colorInit = color           ' initial color
  GraphicsWindow.PenWidth = 2
  GraphicsWindow.PenColor = POPUPCOLOR
  GraphicsWindow.BrushColor = POPUPCOLOR
  oPopup = Shapes.AddRectangle(gw, gh)
  Shapes.SetOpacity(oPopup, 64)
  Shapes.Move(oPopup, LEFTX - 10, TOPY - 10)
  GraphicsWindow.BrushColor = CAPTIONCOLOR
  oOK = Controls.AddButton("OK", gw - 100, gh - 34)
  oCancel = Controls.AddButton("Cancel", gw - 60, gh - 34)
  Controls.ButtonClicked = CS_OnButtonClicked
  CS_Init()
  Stack.PushValue("local", y)
  y = TOPY
  color = colorInit
  CS_DrawColorRect()    ' original color
  oRectCurrent = oRect
  oRect = ""            ' keep current color
  If Text.GetLength(color) = 9 Then       ' for Silverlight
    color = "#" + Text.GetSubText(color, 4, 6)
  EndIf
  GraphicsWindow.BrushColor = CAPTIONCOLOR
  oColor = Shapes.AddText(colorInit)
  Shapes.Move(oColor, x, y + height + 2)
  y = Stack.PopValue("local")
  CS_SetColorToSlider()
  CS_DrawColorRect()    ' draw new color rectangle
  CS_ShowNewColor()     ' show new color name
  Stack.PushValue("local", x)
  Stack.PushValue("local", y)
  Stack.PushValue("local", width)
  Stack.PushValue("local", height)
  x = x + width + 30
  y = TOPY + height * 2 + 24
  width = 30
  height = 30
  CS_DrawPalette()
  height = Stack.PopValue("local")
  width = Stack.PopValue("local")
  y = Stack.PopValue("local")
  x = Stack.PopValue("local")
  cont = "True"         ' continue
  param = "down=True;move=False;up=False;"   ' wait click
  Mouse_SetHandler()
  While cont
    If clicked Then
      CS_SearchClickedObject()
      CS_DoObject()
      clicked = "False"
    Else
      Program.Delay(100)
    EndIf
  EndWhile
  If cancel Then
    color = colorInit
  Else
    CS_AddColorToPalette()
  EndIf
  CS_RemovePalette()
  CS_RemoveSliders()
  Shapes.Remove(oColor)
  Shapes.Remove(oNewColor)
  Shapes.Remove(oRectCurrent)
  Shapes.Remove(oRect)
  Controls.Remove(oOK)
  Controls.Remove(oCancel)
  Shapes.Remove(oPopup)
  cont = Stack.PopValue("local")
EndSub
Sub CS_OnButtonClicked
  ''' Color Selector | Event handler on button clicked
  cont = "False"
  If Controls.LastClickedButton = oCancel Then
    cancel = "True"
  Else
    cancel = "False"
  EndIf
EndSub
Sub Color_SetPenColor
  ''' Color | Set pen color
  ''' param pcolor
  GraphicsWindow.BrushColor = pcolor
  padding = 4
  arry = item
  value = "Pen Color"
  Array_GetIndexOfValue()
  y = Math.Floor((menuHeight - itemSize - 10) / 2) + padding
  x = (index - 1) * (itemSize + itemGap) + itemGap + padding
  GraphicsWindow.FillRectangle(x, y, itemSize - 2 * padding, itemSize - 2 * padding)
EndSub
Sub Debug_StateChanged
  ''' Debug | Check state changed
  ''' return changed - "True" if state changed
  changed = "False"
  If keyIn <> lastKeyIn Then
    lastKeyIn = keyIn
    changed = "True"
  EndIf
  If keyOut <> lastKeyOut Then
    lastKeyOut = keyOut
    changed = "True"
  EndIf
  If msgIn <> lastMsgIn Then
    lastMsgIn = msgIn
    changed = "True"
  EndIf
  If msgOut <> lastMsgOut Then
    lastMsgOut = msgOut
    changed = "True"
  EndIf
EndSub
Sub Debug_Dump
  ''' Debug | Dump state
  TextWindow.WriteLine("fifo = " + fifo)
  TextWindow.WriteLine("keyIn = " + keyIn)
  TextWindow.WriteLine("keyOut = " + keyOut)
  TextWindow.WriteLine("message = " + message)
  TextWindow.WriteLine("msgIn = " + msgIn)
  TextWindow.WriteLine("msgOut = " + msgOut)
EndSub
Sub Dialog_YesNo
  ''' param caution - message
  ''' return yes - if [Yes] pushed
  yes = "True"
  GraphicsWindow.PenWidth = 0
  GraphicsWindow.BrushColor = POPUPCOLOR
  oMsgBox = Shapes.AddRectangle(gw, gh)
  Shapes.SetOpacity(oMsgBox, 64)
  GraphicsWindow.BrushColor = CAPTIONCOLOR
  oCaution = Shapes.AddText(caution)
  yCaution = (gh - 80) / 2
  Shapes.Move(oCaution, 150, yCaution)
  oYes = Controls.AddButton("Yes", 360, yCaution + 50)
  oNo = Controls.AddButton("No", 400, yCaution + 50)
  cont = "True"         ' continue
  Controls.ButtonClicked = File_OnButtonClicked
  While cont
    Program.Delay(500)
  EndWhile
  If Controls.LastClickedButton = oNo Then
    yes = "False"
  EndIf
  Controls.Remove(oNo)
  Controls.Remove(oYes)
  Shapes.Remove(oCaution)
  Shapes.Remove(oMsgBox)
EndSub
Sub File_GetAbsPath
  ''' param curDir - current directory
  ''' param relPath - relative path
  ''' return absPath - absolute path
  If Text.IsSubText(relPath, ":") Or Text.StartsWith(relPath, "\") Or relPath = "" Then
    absPath = relPath
  Else
    absPath = curDir + "\" + relPath
    File_RemoveDots()
  EndIf
EndSub
Sub File_RemoveDots
  ''' param absPath - with dots
  ''' return absPath - without dots
  path = absPath
  folder = ""
  n = 0
  While Text.IsSubText(path, "\")
    n = n + 1
    p = Text.GetIndexOf(path, "\")
    folder[n] = Text.GetSubText(path, 1, p - 1)
    path = Text.GetSubTextToEnd(path, p + 1)
  EndWhile
  If path <> "" Then
    n = n + 1
    folder[n] = path
  EndIf
  While Array.ContainsValue(folder, ".") Or Array.ContainsValue(folder, "..")
    For i = 1 To n
      If folder[i] = "." Then
        File_RemoveEntry()
        i = n + 1 ' break
      ElseIf folder[i] = ".." Then
        i = i - 1
        File_RemoveEntry()
        File_RemoveEntry()
        i = n + 1 ' break
      EndIf
    EndFor
  EndWhile
  absPath = folder[1]
  For i = 2 To n
    absPath = absPath + "\" + folder[i]
  EndFor
EndSub
Sub File_RemoveEntry
  ''' param folder - entry array
  ''' param i - entry index
  ''' return folder - updated entry array
  ''' return n
  For _i = i To n - 1
    folder[_i] = folder[_i + 1]
  EndFor
  folder[n] = ""
  n = n - 1
EndSub
Sub File_CloseDialog
  ''' File | Close dialog for Open/Save
  ''' param oPopup
  ''' param oCaption
  ''' param oFilename
  ''' param oText
  ''' param oMsg
  ''' param oCancel
  Controls.Remove(oCancel)
  Controls.Remove(oMsg)
  Controls.Remove(oText)
  Controls.Remove(oFilename)
  Controls.Remove(oCaption)
  Controls.Remove(oPopup)
EndSub
Sub File_GeneratePPM
  ''' File | Generate PPM in buf
  ''' return buf - buffer
  buf = "P3" + CR + LF
  buf = buf + iconWidth + " " + iconHeight + CR + LF
  buf = buf + "255" + CR + LF
  nRGB = 0
  For y = 0 To iconHeight - 1
    nCol = 0
    For x = 0 To iconWidth - 1
      Icon_GetPixel()
      sColor = color
      Color_ColorToRGB()
      len = Text.GetLength(iR)
      sp = Text.GetSubTextToEnd(" ", len)
      buf = buf + sp + iR + " "
      len = Text.GetLength(iG)
      sp = Text.GetSubTextToEnd(" ", len)
      buf = buf + sp + iG + " "
      len = Text.GetLength(iB)
      sp = Text.GetSubTextToEnd(" ", len)
      buf = buf + sp + iB
      If (Math.Remainder(nCol, 5) = 4) Or (nCol = iconWidth - 1) Then
        buf = buf + CR + LF
      Else
        buf = buf + " "
      EndIf
      nCol = nCol + 1
    EndFor
  EndFor
EndSub
Sub File_GetBasename
  ''' FIle | Get basename from filename
  ''' param filename
  ''' return basename
  ''' return ext - extension
  pFilename = 1
  While Text.IsSubText(Text.GetSubTextToEnd(filename, pFilename), "\")
    iBackslash = Text.GetIndexOf(Text.GetSubTextToEnd(filename, pFilename), "\")
    pFilename = pFilename + iBackslash
  EndWhile
  iDot = Text.GetIndexOf(Text.GetSubTextToEnd(filename, pFilename), ".")
  If 0 < iDot Then
    basename = Text.GetSubText(filename, pFilename, iDot - 1)
    ext = Text.GetSubTextToEnd(filename, pFilename + iDot)
  Else
    basename = Text.GetSubTextToEnd(filename, pFilename)
    ext = ""
  EndIf
EndSub
Sub File_Open
  ''' File | Show input code to open
  ''' return buf
  ''' return filename
  Stack.PushValue("local", cont)
  relPath = ""
  filename = ""
  File_OpenDialog()
  oOpen = Controls.AddButton("Open", 486, gh - 34)
  Shapes.SetText(oMsg, "You can also click above, push Ctrl+V to paste from clipboard")
  Controls.ButtonClicked = File_OnButtonClicked
  Controls.TextTyped = File_OnTextTyped
  subname = "Shapes_Init"
  typed = "False"
  done = "False"
  While Not[done]
    cont = "True"         ' continue
    While cont
      If typed Then
        curDir = Program.Directory
        relPath = Controls.GetTextBoxText(oFilename)
        File_GetAbsPath()
        filename = absPath
        buf = ""
' The following line could be harmful and has been automatically commented.
' buf = File.ReadContents(filename)
        Controls.SetTextBoxText(oText, buf)
        typed = "False"
      Else
        Program.Delay(200)
      EndIf
    EndWhile
    If Controls.LastClickedButton = oOpen Then
      buf = Controls.GetTextBoxText(oText)
      If buf <> "" Then
        done = "True"
      EndIf
    Else
      buf = ""
      relPath = ""
      filename = ""
      done = "True"
    EndIf
  EndWhile
  Controls.Remove(oOpen)
  File_CloseDialog()
  cont = Stack.PopValue("local")
EndSub
Sub File_OpenDialog
  ''' File | Open dialog and common parts for Open/Save
  ''' param relPath
  ''' return oPopup
  ''' return oCaption
  ''' return oFilename
  ''' return oText
  ''' return oMsg
  ''' return oCancel
  GraphicsWindow.PenWidth = 0
  GraphicsWindow.BrushColor = POPUPCOLOR
  oPopup = Shapes.AddRectangle(gw, gh)
  Shapes.SetOpacity(oPopup, 64)
  Shapes.Move(oPopup, LEFTX - 10, TOPY - 10)
  GraphicsWindow.BrushColor = CAPTIONCOLOR
  oCaption = Shapes.AddText("Filename")
  Shapes.Move(oCaption, LEFTX, TOPY + 4)
  GraphicsWindow.BrushColor = TEXTCOLOR
  oFilename = Controls.AddTextBox(LEFTX + 80, TOPY)
  Shapes.SetOpacity(oFilename, OPACITY)
  Controls.SetSize(oFilename, 300, 24)
  Controls.SetTextBoxText(oFilename, relPath)
  oText = Controls.AddMultiLineTextBox(LEFTX, TOPY + 30)
  Controls.SetSize(oText, gw - 20, gh - 84)
  Shapes.SetOpacity(oText, OPACITY)
  GraphicsWindow.BrushColor = CAPTIONCOLOR
  oMsg = Shapes.AddText("")
  Shapes.Move(oMsg, LEFTX, gh - 28)
  GraphicsWindow.BrushColor = TEXTCOLOR
  oCancel = Controls.AddButton("Cancel", 535, gh - 34)
EndSub
Sub File_Save
  ''' File | Show output code to save
  ''' param buf - program buffer
  ''' param filename
  Stack.PushValue("local", cont)
  File_OpenDialog()
  Controls.SetTextBoxText(oText, buf)
  oSave = Controls.AddButton("Save", 488, gh - 34)
  Shapes.SetText(oMsg, "You can also click above, push Ctrl+A, Ctrl+C to copy to clipboard")
  Controls.ButtonClicked = File_OnButtonClicked
  Controls.TextTyped = File_OnTextTyped
  done = "False"
  While Not[done]
    cont = "True"         ' continue
    While cont
      If typed Then
        curDir = Program.Directory
        relPath = Controls.GetTextBoxText(oFilename)
        File_GetAbsPath()
        filename = absPath
        File_GetBasename()
        lowerExt = Text.ConvertToLowerCase(ext)
        typed = "False"
      Else
        Program.Delay(500)
      EndIf
    EndWhile
    buf = Controls.GetTextBoxText(oText)
    If (Controls.LastClickedButton = oSave) And (filename <> "") Then
      dummy = ""  ' for Silverlight
' The following line could be harmful and has been automatically commented.
' dummy = File.ReadContents(filename)
      yes = "True"
      If dummy <> "" Then
        caution = "'" + basename + "." +  ext + "' already exists." + CR + LF + "Do you want to replace it?"
        Dialog_YesNo()
      EndIf
      If yes Then
' The following line could be harmful and has been automatically commented.
' File.WriteContents(filename, buf)
        done = "True" ' saved
      EndIf
    ElseIf Controls.LastClickedButton = oCancel Then
      done = "True"   ' canceled
    EndIf
  EndWhile
  Controls.Remove(oSave)
  File_CloseDialog()
  cont = Stack.PopValue("local")
EndSub
Sub File_OnButtonClicked
  ''' File | Button event handler
  cont = "False"
EndSub
Sub File_OnTextTyped
  ''' File | Textbox event handler
  If Controls.LastTypedTextBox = oFilename Then
    typed = "True"
  EndIf
EndSub
Sub Icon_Clear
  '' Icon | Clear icon
  ''' param add - "True" to add menu to mouse object
  GraphicsWindow.BrushColor = "White"
  GraphicsWindow.FillRectangle(xIcon, yIcon, iconWidth, iconHeight)
  For row = 0 To iconHeight - 1
    y = yEdit + row * (size + gap)
    For col = 0 To iconWidth - 1
      x = xEdit + col * (size + gap)
      GraphicsWindow.FillRectangle(x, y, size, size)
    EndFor
  EndFor
  If add Then
    param = ""
    param["name"] = "icon"
    param["xLeft"] = xEdit
    param["xRight"] = xEdit + iconWidth * (size + gap) - gap
    param["yTop"] = yEdit
    param["yBottom"] = yEdit + iconHeight * (size + gap) - gap
    Mouse_AddObject()
  EndIf
EndSub
Sub Icon_GetPixel
  ''' Icon | Get pixel
  ''' param x, y - position in icon
  ''' return color - got color
  color = GraphicsWindow.GetPixel(xIcon + x, yIcon + y)
  If Text.GetLength(color) = 9 Then
    color = "#" + Text.GetSubTextToEnd(color, 4)
  EndIf
EndSub
Sub Icon_MouseToXY
  ''' Icon | Calc x, y position in icon from mouse position
  ''' param xRel, yRel - position in icon edit field
  ''' return x, y - pixel of the icon or (-1, -1) if on the grid
  x = Math.Floor(xRel / (size + gap))
  y = Math.Floor(yRel / (size + gap))
  If (iconWidth - 1 < x) Or (iconHeight - 1 < y) Then
    x = -1
    y = -1
  Else
    xMod = Math.Remainder(xRel, (size + gap))
    yMod = Math.Remainder(yRel, (size + gap))
    If (size - 1 < xMod) Or (size - 1 < yMod) Then
      x = -1
      y = -1
    EndIf
  EndIf
EndSub
Sub Icon_SetPixel
  ''' Icon | Set pixel
  ''' param x, y - position in icon
  ''' param color - set color
  GraphicsWindow.SetPixel(xIcon + x, yIcon + y, color)
  GraphicsWindow.BrushColor = color
  GraphicsWindow.FillRectangle(xEdit + x * (size + gap), yEdit + y * (size + gap), size, size)
EndSub
Sub KB_Init
  ''' Keyboard | Initialization (use only ^n, ^o, ^s, ^z, ^y)
  shift = ""
  ctrl = ""
  keyIn = 0
  keyOut = 0
  GraphicsWindow.KeyDown = KB_OnKeyDown
  GraphicsWindow.KeyUp = KB_OnKeyUp
EndSub
Sub KB_InKey
  ''' Keyboard | In key
  ''' return c - input key
  If keyOut < keyIn Then
    keyOut = keyOut + 1
    c = fifo[keyOut]
    'fifo[keyOut] = ""
  EndIf
EndSub
Sub KB_OnKeyDown
  ''' Keyboard | Key down event handler
  key = GraphicsWindow.LastKey
  If key = "LeftShift" Or key = "RightShift" Or key = "Shift" Then
    shift = "+"
  ElseIf key = "LeftCtrl" Or key = "RightCtrl" Then
    ctrl = "^"
  Else
    ' solution for known issue 29976 (keyIn increment moved after fifo update)
    fifo[keyIn + 1] = shift + ctrl + key
    keyIn = keyIn + 1
  EndIf
EndSub
Sub KB_OnKeyUp
  ''' Keyboard | Key up event handler
  key = GraphicsWindow.LastKey
  If key = "LeftShift" Or key = "RightShift" Or key = "Shift" Then
    shift = ""
  ElseIf key = "LeftCtrl" Or key = "RightCtrl" Then
    ctrl = ""
  EndIf
EndSub
Sub Macro_Add
  ''' Macro | Add macro
  ''' param msg - message command
  iMacro = iMacro + 1
  nMacro = iMacro
  macro[iMacro] = msg
  name = "undo"
  Menu_EnableItem()
  GraphicsWindow.Title = fname + " * - " + title
  name = "redo"
  Menu_DisableItem()
EndSub
Sub Macro_Init
  ''' Macro | Initialize
  macro = ""
  iMacro = 0
  nMacro = 0
  name = "undo"
  Menu_DisableItem()
  GraphicsWindow.Title = fname + " - " + title
  name = "redo"
  Menu_DisableItem()
EndSub
Sub Macro_Redo
  ''' Macro | Redo
  If iMacro < nMacro Then
    iMacro = iMacro + 1
    msg = macro[iMacro]
    If msg["cmd"] = "pixel" Then
      x = msg["x"]
      y = msg["y"]
      color = msg["to"]
      Icon_SetPixel()
    ElseIf debug Then
      TextWindow.ForegroundColor = "Red"
      TextWindow.WriteLine("Unknown macro: '" + msg["cmd"] + "'")
      TextWindow.ForegroundColor = "Gray"
    EndIf
    name = "undo"
    Menu_EnableItem()
    GraphicsWindow.Title = fname + " * - " + title
    If iMacro = nMacro Then
      name = "redo"
      Menu_DisableItem()
    EndIf
  EndIf
EndSub
Sub Macro_Undo
  ''' Macro | Undo
  If 0 < iMacro Then
    msg = macro[iMacro]
    If msg["cmd"] = "pixel" Then
      x = msg["x"]
      y = msg["y"]
      color = msg["from"]
      Icon_SetPixel()
      iMacro = iMacro - 1
      name = "redo"
      Menu_EnableItem()
      If iMacro = 0 Then
        name = "undo"
        Menu_DisableItem()
        GraphicsWindow.Title = fname + " - " + title
      EndIf
    ElseIf debug Then
      TextWindow.ForegroundColor = "Red"
      TextWindow.WriteLine("Unknown macro: '" + msg["cmd"] + "'")
      TextWindow.ForegroundColor = "Gray"
    EndIf
  EndIf
EndSub
Sub Math_Hex2Dec
  ''' Math | Convert hexadecimal to decimal
  ''' param sHex
  ''' return iDec
  iDec = 0
  iLen = Text.GetLength(sHex)
  For iPtr = 1 To iLen
    iDec = iDec * 16 + Text.GetIndexOf("0123456789ABCDEF", Text.GetSubText(sHex, iPtr, 1)) - 1
  EndFor
EndSub
Sub Menu_Draw
  ''' Menu | draw menu
  GraphicsWindow.BrushColor = "#EEEEEE"
  GraphicsWindow.FillRectangle(0, 0, gw, menuHeight)
  item = "1=New;2=Open;3=Save;4=Undo;5=Redo;6=Pen Color;"
  nItem = Array.GetItemCount(item)
  add = "True"
  For i = 1 To nItem
    Menu_DrawItem()
  EndFor
  add = "False"
EndSub
Sub Menu_EnableItem
  ''' Menu | Enable item
  ''' param name - name of the menu item
  ''' param item - array of the menu items
  ''' param nItem - number of the menu items
  i = 1
  While (Text.ConvertToLowerCase(item[i]) <> Text.ConvertToLowerCase(name)) And (i <= nItem)
    i = i + 1
  EndWhile
  If (i <= nItem) And (mask[i] <> "") Then
    Shapes.Remove(mask[i])
    mask[i] = ""
  EndIf
EndSub
Sub Menu_DisableItem
  ''' Menu | Disable item
  ''' param name - name of the menu item
  ''' param item - array of the menu items
  ''' param nItem - number of the menu items
  i = 1
  While (Text.ConvertToLowerCase(item[i]) <> Text.ConvertToLowerCase(name)) And (i <= nItem)
    i = i + 1
  EndWhile
  If (i <= nItem) And (mask[i] = "") Then
    y = Math.Floor((menuHeight - itemSize - 10) / 2)
    x = (i - 1) * (itemSize + itemGap) + itemGap
    GraphicsWindow.PenWidth = 0
    GraphicsWindow.BrushColor = "#EEEEEE"
    mask[i] = Shapes.AddRectangle(itemSize, itemSize)
    Shapes.SetOpacity(mask[i], 70)
    Shapes.Move(mask[i], x, y)
  EndIf
EndSub
Sub Menu_DrawItem
  ''' Menu | Draw menu item
  ''' param i - index number of the menu item
  ''' param add - "True" to add menu to mouse object
  y = Math.Floor((menuHeight - itemSize - 10) / 2)
  x = (i - 1) * (itemSize + itemGap) + itemGap
  url = "http://www.nonkit.com/smallbasic.files/" + Text.ConvertToLowerCase(item[i]) + ".png"
  GraphicsWindow.DrawImage(url, x, y)
  If add Then
    param = ""
    param["name"] = Text.ConvertToLowerCase(item[i])
    param["xLeft"] = x
    param["xRight"] = x + itemSize
    param["yTop"] = y
    param["yBottom"] = y + itemSize
    Mouse_AddObject()
  EndIf
  fs = 10
  GraphicsWindow.FontSize = fs
  GraphicsWindow.FontBold = "False"
  GraphicsWindow.FontName = "Trebuchet MS"
  GraphicsWindow.BrushColor = "Black"
  txt = item[i]
  Text_GetWidthInPx()
  dx = Math.Floor((itemSize - px) / 2)
  GraphicsWindow.DrawText(x + dx, y + itemSize, item[i])
EndSub
Sub Mouse_AddObject
  ''' Mouse | Add object to click
  ''' param["name"] - name of the object to add
  ''' param["xLeft"] - left x coordinate of the object
  ''' param["xRight"] - right x coordinate of the object
  ''' param["yTop"] - top y coordinate of the object
  ''' param["yBottom"] - bottom y coordinate of the object
  ''' return object
  ''' return nObject
  nObject = nObject + 1
  object[nObject] = param
EndSub
Sub Mouse_DetectObject
  ''' Mouse | Detect object
  ''' param mxD, myD - mouse clicked coordinate
  ''' return name - clicked object name if found, "" if not found
  ''' return xRel - relative x coordinate from left x of the object
  ''' return yRel - relative y coordinate from top y of the object
  name = ""               ' not found
  For iObject = 1 To nObject
    obj = object[iObject]
    If obj["xLeft"] <= mxD And mxD <= obj["xRight"] And obj["yTop"] <= myD And myD <= obj["yBottom"] Then
      name = obj["name"]  ' found
      xRel = mxD - obj["xLeft"]
      yRel = myD - obj["yTop"]
      iObject = nObject   ' break
    EndIf
  EndFor
EndSub
Sub Mouse_Init
  ''' Mouse | Initialize for common event handler
  clicked = "False"
  released = "False"
  moved = "False"
  object = ""
  nObject = 0
  GraphicsWindow.MouseDown = Mouse_OnDown
EndSub
Sub Mouse_SetHandler
  ''' Mouse | Set or reset common event handler
  ''' param["down"] - "True" if set, "False" if reset
  ''' param["move"] - "True" if set, "False" if reset
  ''' param["up"] - - "True" if set, "False" if reset
  ''' return clicked - "False" if set MouseDown
  ''' return moved - "False" if set MouseMove
  ''' return released - "False" if set MouseUp
  ''' return dmu - which handlers are set for debug
  If param["up"] Then
    released = "False"
    GraphicsWindow.MouseUp = Mouse_OnUp
    handler["up"] = "U"
  ElseIf Not[param["up"]] Then
    GraphicsWindow.MouseUp = Mouse_DoNothing
    handler["up"] = ""
  EndIf
  If param["down"] Then
    clicked = "False"
    GraphicsWindow.MouseDown = Mouse_OnDown
    handler["down"] = "D"
  ElseIf Not[param["down"]] Then
    GraphicsWindow.MouseDown = Mouse_DoNothing
    handler["down"] = ""
  EndIf
  If param["move"] Then
    moved = "False"
    GraphicsWindow.MouseMove = Mouse_OnMove
    handler["move"] = "M"
  ElseIf Not[param["move"]] Then
    GraphicsWindow.MouseMove = Mouse_DoNothing
    handler["move"] = ""
  EndIf
  dmu = handler["down"] + handler["move"] + handler["up"]
  If debug Then
    smrc = " set "
  EndIf
EndSub
Sub Mouse_OnDown
  ''' Mouse | Common event handler on mouse down
  ''' return mxD, myD - position on mouse down
  mxD = Math.Floor(GraphicsWindow.MouseX)
  myD = Math.Floor(GraphicsWindow.MouseY)
  clicked = "True"
  released = "False"
  If debug Then
    smrc = " clicked " + mxD + "," + myD
  EndIf
EndSub
Sub Mouse_DoNothing
  ''' Mouse | Common event handler to do nothing
EndSub
Sub Mouse_OnMove
  ''' Mouse | Common event handler on mouse move
  ''' return mxM, myM - position on mouse move
  mxM = Math.Floor(GraphicsWindow.MouseX)
  myM = Math.Floor(GraphicsWindow.MouseY)
  moved = "True"
  If debug Then
    smrc = " moved " + mxM + "," + myM
  EndIf
EndSub
Sub Mouse_OnTick
  ''' Mouse | debug routine
  If clicked Then
    cmr = "C"
  Else
    cmr = ""
  EndIf
  If moved Then
    cmr = cmr + "M"
  EndIf
  If released Then
    cmr = cmr + "R"
  EndIf
  GraphicsWindow.Title = title + smrc + " " + dmu + " " + cmr
EndSub
Sub Mouse_OnUp
  ''' Mouse | Common event handler on mouse up
  ''' return mxU, myU - position on mouse up
  mxU = Math.Floor(GraphicsWindow.MouseX)
  myU = Math.Floor(GraphicsWindow.MouseY)
  released = "True"
  If debug Then
    smrc = " released " + mxU + "," + myU
  EndIf
EndSub
Sub Msg_Init
  ''' Message | Initialize
  msgIn = 0
  msgOut = 0
EndSub
Sub Msg_Set
  ''' Message | Set message to fifo
  ''' param["cmd"] - massage command
  ''' param["*"].. - message operands
  msgIn = msgIn + 1
  message[msgIn] = param
EndSub
Sub Parse_Comment
  ''' Parse | Parse comment
  ''' param buf - buffer to parse
  ''' param p - poiter to the buffer
  ''' return p - updated pointer
  char = Text.GetSubText(buf, p, 1)
  If char = "#" Then
    lenBuf = Text.GetLength(buf)
    While (char <> LF) And (p < lenBuf)
      p = p + 1
      char = Text.GetSubText(buf, p, 1)
    EndWhile
  EndIf
EndSub
Sub Parse_Decimal
  ''' Parse | Parse decimal
  ''' param buf - buffer to parse
  ''' param p - poiter to the buffer
  ''' return p - updated pointer
  ''' return dec - decimal number
  ''' return match - "True" if match
  match = "False"
  isDigit = "True"
  dec = 0
  While isDigit
    char = Text.GetSubText(buf, p, 1)
    If Text.IsSubText(DIGIT, char) Then
      dec = dec * 10 + char
      p = p + 1
      match = "True"
    Else
      isDigit = "False"
    EndIf
  EndWhile
EndSub
Sub Parse_MagicNumber
  ''' Parse | Parse magic number
  ''' param buf - buffer to parse
  ''' param p - poiter to the buffer
  ''' return p - updated pointer
  ''' return match - "True" if match
  If Text.StartsWith(Text.GetSubTextToEnd(buf, p), "P3") Then
    p = p + 2
    match = "True"
  Else
    match = "False"
  EndIf
EndSub
Sub Parse_PPM
  ''' Parse | Parse PPM
  ''' param buf - buffer to parse
  ''' return p - updated pointer
  ''' return match - "True" if match
  p = 1
  Parse_MagicNumber()
  If match Then
    Parse_WhiteSpaceAndComment()
  EndIf
  If match Then
    Parse_Decimal()
    If match Then
      If dec <> iconWidth Then
        match = "False"
      EndIf
    EndIf
  EndIf
  If match Then
    Parse_WhiteSpaceAndComment()
  EndIf
  If match Then
    Parse_Decimal()
    If match Then
      If dec <> iconHeight Then
        match = "False"
      EndIf
    EndIf
  EndIf
  If match Then
    Parse_WhiteSpaceAndComment()
  EndIf
  If match Then
    Parse_Decimal()
    If match Then
      If 0 < dec And dec < 65536 Then
        maxVal = dec
      Else
        match = "False"
      EndIf
    EndIf
  EndIf
  If match Then
    Parse_WhiteSpaceAndComment()
  EndIf
  If match Then
    Icon_Clear()
    For y = 0 To iconHeight - 1
      For x = 0 To iconWidth - 1
        Parse_WhiteSpace()
        Parse_Decimal()
        If match Then
          iR = Math.Floor(255 * dec / maxVal)
        Else
          Goto PPPM_Error
        EndIf
        Parse_WhiteSpace()
        Parse_Decimal()
        If match Then
          iG = Math.Floor(255 * dec / maxVal)
        Else
          Goto PPPM_Error
        EndIf
        Parse_WhiteSpace()
        Parse_Decimal()
        If match Then
          iB = Math.Floor(255 * dec / maxVal)
        Else
          Goto PPPM_Error
        EndIf
        color = GraphicsWindow.GetColorFromRGB(iR, iG, iB)
        Icon_SetPixel()
      EndFor
    EndFor
  EndIf
  PPPM_Error:
EndSub
Sub Parse_WhiteSpace
  ''' Parse | Parse white space
  ''' param buf - buffer to parse
  ''' param p - poiter to the buffer
  ''' return p - updated pointer
  ''' return match - "True"
  isSpace = "True"
  While isSpace
    char = Text.GetSubText(buf, p, 1)
    If Text.IsSubText(" " + TAB + CR + LF, char) Then
      p = p + 1
    Else
      isSpace = "False"
    EndIf
  EndWhile
  match = "True"
EndSub
Sub Parse_WhiteSpaceAndComment
  ''' Parse | Parse white space and comment
  ''' param buf - buffer to parse
  ''' param p - poiter to the buffer
  ''' return p - updated pointer
  ''' return match - "True"
  isSpace = "True"
  While isSpace
    char = Text.GetSubText(buf, p, 1)
    If char = "#" Then
      Parse_Comment()
    ElseIf Text.IsSubText(" " + TAB + CR + LF, char) Then
      p = p + 1
    Else
      isSpace = "False"
    EndIf
  EndWhile
  match = "True"
EndSub
Sub Popup_Init
  ''' Popup | Initialize popup
  TOPY = 10   ' top y
  LEFTX = 10  ' left x
  DELTAY = 36 ' delta y
  OPACITY = 70
  POPUPCOLOR = "LightGray"
  CAPTIONCOLOR = "Black"
  TEXTCOLOR = "Black"
  BORDERCOLOR = "#666666"
  BOXCOLOR = "LightGray"
  SLITCOLOR = "#555555"
  UNDEFINED = "N/A"
EndSub
Sub Slider_Add
  ''' Slider | Add slider as shapes and property
  ''' param width
  ''' param caption
  ''' param min, max
  ''' param left, top
  ''' return slider[] - property of slider
  ''' return iSlider - added slider index
  numSlider = numSlider + 1
  iSlider = numSlider
  ' add shapes for slider
  GraphicsWindow.BrushColor = CAPTIONCOLOR
  len = Text.GetLength(caption)
  sldr = slider[iSlider]
  sldr["oCaption"] = Shapes.AddText(caption)
  Shapes.Move(sldr["oCaption"], left - (len * 5 + 10), top + 1)
  level = Math.Floor((min + max) / 2)
  sldr["level"] = level  ' property
  sldr["min"] = min
  sldr["max"] = max
  GraphicsWindow.PenColor = BORDERCOLOR
  mag = (level - min) / (max - min)
  GraphicsWindow.BrushColor = SLITCOLOR
  sldr["oSlit"] = Shapes.AddRectangle(width, 10)
  GraphicsWindow.PenColor = BORDERCOLOR
  GraphicsWindow.BrushColor = BOXCOLOR
  sldr["oBox"] = Shapes.AddRectangle(10, 18)
  GraphicsWindow.BrushColor = CAPTIONCOLOR
  sldr["oLevel"] = Shapes.AddText(level)
  sldr["x0"] = left
  sldr["x1"] = left + width
  sldr["y0"] = top
  Shapes.Move(sldr["oLevel"], left + width + 5, top)
  ' move and zoom shapes for slider
  Shapes.Move(sldr["oSlit"], left, top + 4)
  slider[iSlider] = sldr
  Slider_SetLevel()
EndSub
Sub Slider_CallBack
  ''' Slider | Call back
  ''' param iSlider - changed slider
  CS_AdjustSlider()
  CS_GetColorFromSlider()
  CS_ShowNewColor()       ' show new color name
  CS_DrawColorRect()      ' draw new color rectangle
EndSub
Sub Slider_GetLevel
  ''' Slider | Get latest level of slider
  ''' param iSlider
  ''' return level
  sldr = slider[iSlider]
  level = sldr["level"]
EndSub
Sub Slider_GetMouseLevel
  ''' Slider | Get mouse level of slider
  ''' param iSlider
  ''' return level
  sldr = slider[iSlider]
  x0 = sldr["x0"]
  x1 = sldr["x1"]
  max = sldr["max"]
  min = sldr["min"]
  level = min + Math.Floor((max - min) * (mxM - x0) / (x1 - x0))
EndSub
Sub Slider_WaitToRelease
  ''' Slider | Get released point for slider moving
  ''' param iSlider
  param = "down=False;move=True;up=True;"  ' for slider moving / wait to release
  Mouse_SetHandler()
  While Not[released]
    If moved Then
      param = "move=False;"  ' while slider moving
      Mouse_SetHandler()
      sldr = slider[iSlider]
      x0_ = sldr["x0"]
      x1_ = sldr["x1"]
      If mxM < x0_ Then
        mxM = x0_
      EndIf
      If x1_ < mxM Then
        mxM = x1_
      EndIf
      Slider_GetMouseLevel()  ' get mouse level of slider
      Slider_SetLevel()       ' set slider level and move slider box
      Slider_CallBack()
      param = "move=True;"    ' for next slider moving
      Mouse_SetHandler()
    Else
      Program.Delay(100)
    EndIf
  EndWhile
  param = "move=False;up=False;"  ' mouse released
  Mouse_SetHandler()
EndSub
Sub Slider_Remove
  ''' Slider | Remove a slider
  ''' param iSlider
  sldr = slider[iSlider]
  Shapes.Remove(sldr["oCaption"])
  Shapes.Remove(sldr["oSlit"])
  Shapes.Remove(sldr["oBox"])
  Shapes.Remove(sldr["oLevel"])
EndSub
Sub Slider_SetLevel
  ''' Slider | Set slider level and move slider box
  ''' param iSlider
  ''' param level
  Stack.PushValue("local", width)
  sldr = slider[iSlider]
  x0 = sldr["x0"]
  x1 = sldr["x1"]
  y0 = sldr["y0"]
  width = x1 - x0
  sldr["level"] = level
  Shapes.SetText(sldr["oLevel"], level)
  ' move bar
  min = sldr["min"]
  max = sldr["max"]
  mag = (level - min) / (max - min)
  ' move box
  Shapes.Move(sldr["oBox"], x0 + Math.Floor(width * mag) - 5, y0)
  sldr["x2"] = x0 + Math.Floor(width * mag) - 5
  sldr["x3"] = x0 + Math.Floor(width * mag) - 5 + 10
  sldr["y2"] = y0
  sldr["y3"] = y0 + 18
  slider[iSlider] = sldr
  width = Stack.PopValue("local")
EndSub
Sub Text_GetWidthInPx
  ''' Text | Get width in px (pixels)
  ''' param txt - text to get width in px
  ''' param ratio - character width/height in a font
  ''' param fs - font size (height)
  ''' return px - width in px (pixels)
  len = Text.GetLength(txt)
  px = 0
  For p = 1 To len
    px = px + ratio[Text.GetCharacterCode(Text.GetSubText(txt, p, 1))]
  EndFor
  px = Math.Floor(px * fs / 100)
EndSub
Copyright (c) Microsoft Corporation. All rights reserved.