Microsoft Small Basic

Program Listing: RFT686-8
''' 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