This commit is contained in:
visionmercer 2026-06-08 12:30:31 +02:00
commit 4a698757a3

View file

@ -64,21 +64,21 @@ state.bcolor=closestcolor(_rgb32(255,255,255),pal())
addcommand"fcolor ("+hex$(state.fcolor)+")" addcommand"fcolor ("+hex$(state.fcolor)+")"
addcommand"bcolor ("+hex$(state.bcolor)+")" addcommand"bcolor ("+hex$(state.bcolor)+")"
DIM SHARED fontHandles(1 TO 10) AS INTEGER dim shared fonthandles(1 to 10) as integer
DIM SHARED activeFontIndex AS INTEGER: activeFontIndex = 1 dim shared activefontindex as integer:activefontindex=1
DIM SHARED activeFontSize AS SINGLE: activeFontSize = 16 dim shared activefontsize as single:activefontsize=16
DIM SHARED textToolString AS STRING dim shared texttoolstring as string
fontHandles(1) = LoadBGIFont("./fonts/SIMP.CHR") fonthandles(1)=loadbgifont("./fonts/SIMP.CHR")
fontHandles(2) = LoadBGIFont("./fonts/BOLD.CHR") fonthandles(2)=loadbgifont("./fonts/BOLD.CHR")
fontHandles(3) = LoadBGIFont("./fonts/EURO.CHR") fonthandles(3)=loadbgifont("./fonts/EURO.CHR")
fontHandles(4) = LoadBGIFont("./fonts/GOTH.CHR") fonthandles(4)=loadbgifont("./fonts/GOTH.CHR")
fontHandles(5) = LoadBGIFont("./fonts/LCOM.CHR") fonthandles(5)=loadbgifont("./fonts/LCOM.CHR")
fontHandles(6) = LoadBGIFont("./fonts/LITT.CHR") fonthandles(6)=loadbgifont("./fonts/LITT.CHR")
fontHandles(7) = LoadBGIFont("./fonts/SANS.CHR") fonthandles(7)=loadbgifont("./fonts/SANS.CHR")
fontHandles(8) = LoadBGIFont("./fonts/SCRI.CHR") fonthandles(8)=loadbgifont("./fonts/SCRI.CHR")
fontHandles(9) = LoadBGIFont("./fonts/TRIP.CHR") fonthandles(9)=loadbgifont("./fonts/TRIP.CHR")
fontHandles(10) = LoadBGIFont("./fonts/TSCR.CHR") fonthandles(10)=loadbgifont("./fonts/TSCR.CHR")
dim lastmx,lastmy dim lastmx,lastmy
dim keyin as string dim keyin as string
@ -134,60 +134,60 @@ do
' Keyboarding ' Keyboarding
if not state.tool=16 and not state.isdrawing then if not state.tool=16 and not state.isdrawing then
keyin=inkey$ keyin=inkey$
select case keyin select case keyin
case chr$(27) case chr$(27)
menu menu
case "+" case "+"
state.brushsize=state.brushsize+1 state.brushsize=state.brushsize+1
addcommand"brushsize ("+tst(state.brushsize)+")"
case "-"
if state.brushsize>1 then
state.brushsize=state.brushsize-1
addcommand"brushsize ("+tst(state.brushsize)+")" addcommand"brushsize ("+tst(state.brushsize)+")"
end if case "-"
case "h" if state.brushsize>1 then
state.zoom=1 state.brushsize=state.brushsize-1
state.offsetx=(_width/2)-(_width(layers(0).ihandle)/2) addcommand"brushsize ("+tst(state.brushsize)+")"
state.offsety=(_height/2)-(_height(layers(0).ihandle)/2) end if
case "h"
state.zoom=1
state.offsetx=(_width/2)-(_width(layers(0).ihandle)/2)
state.offsety=(_height/2)-(_height(layers(0).ihandle)/2)
case "f","F" case "f","F"
' --- ZOOM TO FIT ("f") OR OVERFLOW SHORTEST SIDE ("F") --- ' --- ZOOM TO FIT ("f") OR OVERFLOW SHORTEST SIDE ("F") ---
' 1. Calculate and choose the fitting ratio based on the lowercase/uppercase state ' 1. Calculate and choose the fitting ratio based on the lowercase/uppercase state
if (((_width-(showtoolbox and 70)-(showcommands and 250)) \ _width(layers(0).ihandle))<((_height-(showcolorpicker and 20)) \ _height(layers(0).ihandle)) xor (keyin="F")) then if (((_width-(showtoolbox and 70)-(showcommands and 250)) \ _width(layers(0).ihandle))<((_height-(showcolorpicker and 20)) \ _height(layers(0).ihandle)) xor (keyin="F")) then
state.zoom=((_width-(showtoolbox and 70)-(showcommands and 250)) \ _width(layers(0).ihandle)) state.zoom=((_width-(showtoolbox and 70)-(showcommands and 250)) \ _width(layers(0).ihandle))
else else
state.zoom=((_height-(showcolorpicker and 20)) \ _height(layers(0).ihandle)) state.zoom=((_height-(showcolorpicker and 20)) \ _height(layers(0).ihandle))
end if end if
' 2. Clamp the zoom factor within safe limits (1 to 20) ' 2. Clamp the zoom factor within safe limits (1 to 20)
if state.zoom<1 then state.zoom=1 else if state.zoom>20 then state.zoom=20 if state.zoom<1 then state.zoom=1 else if state.zoom>20 then state.zoom=20
' 3. Center the canvas inside the viewport (overflowing sides will center-clip perfectly) ' 3. Center the canvas inside the viewport (overflowing sides will center-clip perfectly)
state.offsetx=(showtoolbox and 70)+(((_width-(showtoolbox and 70)-(showcommands and 250)) \ 2)-((_width(layers(0).ihandle)*state.zoom) \ 2)) state.offsetx=(showtoolbox and 70)+(((_width-(showtoolbox and 70)-(showcommands and 250)) \ 2)-((_width(layers(0).ihandle)*state.zoom) \ 2))
state.offsety=(((_height-(showcolorpicker and 20)) \ 2)-((_height(layers(0).ihandle)*state.zoom) \ 2)) state.offsety=(((_height-(showcolorpicker and 20)) \ 2)-((_height(layers(0).ihandle)*state.zoom) \ 2))
case "t" case "t"
showtoolbox=not showtoolbox showtoolbox=not showtoolbox
case "c" case "c"
showcolorpicker=not showcolorpicker showcolorpicker=not showcolorpicker
case "l" case "l"
showcommands=not showcommands showcommands=not showcommands
case chr$(26) ' Ctrl+Z case chr$(26) ' Ctrl+Z
if ubound(commands)>3 then if ubound(commands)>3 then
' Drop the trailing empty slot and the last valid command ' Drop the trailing empty slot and the last valid command
redim _preserve commands(ubound(commands)-2) as string redim _preserve commands(ubound(commands)-2) as string
' Re-create the empty trailing slot required by addcommand ' Re-create the empty trailing slot required by addcommand
redim _preserve commands(ubound(commands)+1) as string redim _preserve commands(ubound(commands)+1) as string
redraw redraw
end if end if
end select end select
end if end if
canvas canvas
if showtoolbox then toolbox if showtoolbox then toolbox
if showcolorpicker then colorpicker if showcolorpicker then colorpicker
if state.tool = 12 then drawTextToolPanel if state.tool=12 then drawtexttoolpanel
if showcommands then commandlist if showcommands then commandlist
_limit 30 _limit 30
_display _display
@ -211,7 +211,7 @@ sub commandlist
case -1 ' Left-Click triggers the inline text rename input box case -1 ' Left-Click triggers the inline text rename input box
commands(i)=textinput(x+5,y+5,248,23,commands(i)) commands(i)=textinput(x+5,y+5,248,23,commands(i))
case -2 ' Right-Click opens the context menu layout overlay case -2 ' Right-Click opens the context menu layout overlay
listcontextmenu i, _mousex, _mousey listcontextmenu i,_mousex,_mousey
exit sub exit sub
end select end select
end if end if
@ -219,129 +219,129 @@ sub commandlist
if button(x,_height-25,60,23,"redraw") then redraw if button(x,_height-25,60,23,"redraw") then redraw
end sub end sub
sub listcontextmenu (index as long, mx as integer, my as integer) sub listcontextmenu (index as long,mx as integer,my as integer)
if index < 0 or index >= ubound(commands) then exit sub if index<0 or index>=ubound(commands) then exit sub
dim done as integer: done = 0 dim done as integer:done=0
dim menuw as integer: menuw = 120 dim menuw as integer:menuw=120
dim menuh as integer: menuh = 6 * 24 + 4 ' 6 items at 24px layout spacing dim menuh as integer:menuh=6*24+4 ' 6 items at 24px layout spacing
' Position correction so context panels don't clip outside screens ' Position correction so context panels don't clip outside screens
dim x as integer: x = mx dim x as integer:x=mx
if x + menuw > _width then x = _width - menuw if x+menuw>_width then x=_width-menuw
dim y as integer: y = my dim y as integer:y=my
if y + menuh > _height then y = _height - menuh if y+menuh>_height then y=_height-menuh
do do
' UI Backdrop reconstruction stack to prevent flickering frames ' UI Backdrop reconstruction stack to prevent flickering frames
cls, backgroundcolor1 cls,backgroundcolor1
canvas canvas
if showtoolbox then toolbox if showtoolbox then toolbox
if showcolorpicker then colorpicker if showcolorpicker then colorpicker
if state.tool = 12 then drawTextToolPanel if state.tool=12 then drawtexttoolpanel
' Manual render block for command list data under the active frame ' Manual render block for command list data under the active frame
dim lx as integer: lx = _width - 250 dim lx as integer:lx=_width-250
line (lx, 0)-(_width - 1, _height - 1), backgroundcolor1, bf line (lx,0)-(_width-1,_height-1),backgroundcolor1,bf
line (lx, 0)-(lx, _height - 1), backgroundcolor2 line (lx,0)-(lx,_height-1),backgroundcolor2
_printmode _keepbackground _printmode _keepbackground
dim ly as integer, i as long dim ly as integer,i as long
for i = ubound(commands) - 1 to 0 step -1 for i=ubound(commands)-1 to 0 step -1
ly = (ubound(commands) - i) * 16 ly=(ubound(commands)-i)*16
if ly < _height - 20 then if ly<_height-20 then
_printstring (lx + 5, ly + 5), left$(commands(i), 31) _printstring (lx+5,ly+5),left$(commands(i),31)
end if end if
next i next i
if button(lx, _height - 25, 60, 23, "redraw") then redraw if button(lx,_height-25,60,23,"redraw") then redraw
' Render Context Container Box ' Render Context Container Box
line (x, y)-(x + menuw, y + menuh), backgroundcolor1, bf line (x,y)-(x+menuw,y+menuh),backgroundcolor1,bf
line (x, y)-(x + menuw, y + menuh), highlightcolor, b line (x,y)-(x+menuw,y+menuh),highlightcolor,b
' Standard poll for incoming click state loops ' Standard poll for incoming click state loops
while _mouseinput: wend while _mouseinput:wend
mouseclicked = 0: rmouseclicked = 0 mouseclicked=0:rmouseclicked=0
if mousedown = -1 and _mousebutton(1) = 0 then mouseclicked = -1 if mousedown=-1 and _mousebutton(1)=0 then mouseclicked=-1
if rmousedown = -1 and _mousebutton(2) = 0 then rmouseclicked = -1 if rmousedown=-1 and _mousebutton(2)=0 then rmouseclicked=-1
mousedown = _mousebutton(1) mousedown=_mousebutton(1)
rmousedown = _mousebutton(2) rmousedown=_mousebutton(2)
' Clicking completely outside the menu closes the context window ' Clicking completely outside the menu closes the context window
if mouseclicked or rmouseclicked then if mouseclicked or rmouseclicked then
if not (_mousex > x and _mousex < x + menuw and _mousey > y and _mousey < y + menuh) then if not (_mousex>x and _mousex<x+menuw and _mousey>y and _mousey<y+menuh) then
done = -1 done=-1
end if end if
end if end if
dim bx as integer: bx = x + 2 dim bx as integer:bx=x+2
dim by as integer: by = y + 2 dim by as integer:by=y+2
dim bw as integer: bw = menuw - 4 dim bw as integer:bw=menuw-4
dim bh as integer: bh = 22 dim bh as integer:bh=22
' Item 1: Delete ' Item 1: Delete
if button(bx, by, bw, bh, "Delete") then if button(bx,by,bw,bh,"Delete") then
dim k as long dim k as long
for k = index to ubound(commands) - 1 for k=index to ubound(commands)-1
commands(k) = commands(k + 1) commands(k)=commands(k+1)
next k next k
redim _preserve commands(ubound(commands) - 1) as string redim _preserve commands(ubound(commands)-1) as string
redraw redraw
done = -1 done=-1
end if end if
by = by + 24 by=by+24
' Item 2: Move Up (moves toward end of array visually) ' Item 2: Move Up (moves toward end of array visually)
if button(bx, by, bw, bh, "Move Up") then if button(bx,by,bw,bh,"Move Up") then
if index < ubound(commands) - 2 then if index<ubound(commands)-2 then
dim tempCmd as string dim tempcmd as string
tempCmd = commands(index) tempcmd=commands(index)
commands(index) = commands(index + 1) commands(index)=commands(index+1)
commands(index + 1) = tempCmd commands(index+1)=tempcmd
redraw redraw
end if end if
done = -1 done=-1
end if end if
by = by + 24 by=by+24
' Item 3: Move Down (moves toward array index 0) ' Item 3: Move Down (moves toward array index 0)
if button(bx, by, bw, bh, "Move Down") then if button(bx,by,bw,bh,"Move Down") then
if index > 0 then if index>0 then
tempCmd = commands(index) tempcmd=commands(index)
commands(index) = commands(index - 1) commands(index)=commands(index-1)
commands(index - 1) = tempCmd commands(index-1)=tempcmd
redraw redraw
end if end if
done = -1 done=-1
end if end if
by = by + 24 by=by+24
' Item 4: Insert Above ' Item 4: Insert Above
if button(bx, by, bw, bh, "Insert Above") then if button(bx,by,bw,bh,"Insert Above") then
redim _preserve commands(ubound(commands) + 1) as string redim _preserve commands(ubound(commands)+1) as string
for k = ubound(commands) - 1 to index + 2 step -1 for k=ubound(commands)-1 to index+2 step -1
commands(k) = commands(k - 1) commands(k)=commands(k-1)
next k next k
commands(index + 1) = "" commands(index+1)=""
redraw redraw
done = -1 done=-1
end if end if
by = by + 24 by=by+24
' Item 5: Insert Below ' Item 5: Insert Below
if button(bx, by, bw, bh, "Insert Below") then if button(bx,by,bw,bh,"Insert Below") then
redim _preserve commands(ubound(commands) + 1) as string redim _preserve commands(ubound(commands)+1) as string
for k = ubound(commands) - 1 to index + 1 step -1 for k=ubound(commands)-1 to index+1 step -1
commands(k) = commands(k - 1) commands(k)=commands(k-1)
next k next k
commands(index) = "" commands(index)=""
redraw redraw
done = -1 done=-1
end if end if
by = by + 24 by=by+24
' Item 6: Copy to OS Clipboard ' Item 6: Copy to OS Clipboard
if button(bx, by, bw, bh, "Copy") then if button(bx,by,bw,bh,"Copy") then
_clipboard$ = commands(index) _clipboard$=commands(index)
done = -1 done=-1
end if end if
_limit 30 _limit 30
@ -349,83 +349,83 @@ sub listcontextmenu (index as long, mx as integer, my as integer)
loop until done or _keydown(27) loop until done or _keydown(27)
' Flush trailing triggers so the next loop cycle doesn't draw accidental strokes ' Flush trailing triggers so the next loop cycle doesn't draw accidental strokes
mouseclicked = 0 mouseclicked=0
rmouseclicked = 0 rmouseclicked=0
end sub end sub
sub drawTextToolPanel sub drawtexttoolpanel
dim panelWidth as integer: panelWidth = 160 dim panelwidth as integer:panelwidth=160
dim x as integer: x = _width - panelWidth dim x as integer:x=_width-panelwidth
static showFontList as integer ' Tracks the expanding drop-down list state static showfontlist as integer ' Tracks the expanding drop-down list state
if showcommands then if showcommands then
x = _width - panelWidth - 250 x=_width-panelwidth-250
else else
x = _width - panelWidth x=_width-panelwidth
end if end if
' Draw the side panel background card block ' Draw the side panel background card block
line (x, 0)-(_width - 1, _height - 1), backgroundcolor1, bf line (x,0)-(_width-1,_height-1),backgroundcolor1,bf
line (x, 0)-(x, _height - 1), backgroundcolor2 line (x,0)-(x,_height-1),backgroundcolor2
_printmode _keepbackground _printmode _keepbackground
_printstring (x + 10, 15), "TEXT TOOL OPTIONS" _printstring (x+10,15),"TEXT TOOL OPTIONS"
line (x + 10, 30)-(x + 140, 30), backgroundcolor2 line (x+10,30)-(x+140,30),backgroundcolor2
' --- Font Size Controls --- ' --- Font Size Controls ---
_printstring (x + 10, 45), "Size: " + tst(int(activeFontSize)) _printstring (x+10,45),"Size: "+tst(int(activefontsize))
if button(x + 85, 42, 24, 20, "-") then if button(x+85,42,24,20,"-") then
if activeFontSize > 4 then activeFontSize = activeFontSize - 2 if activefontsize>4 then activefontsize=activefontsize-2
end if end if
if button(x + 115, 42, 24, 20, "+") then if button(x+115,42,24,20,"+") then
if activeFontSize < 120 then activeFontSize = activeFontSize + 2 if activefontsize<120 then activefontsize=activefontsize+2
end if end if
' --- Expandable Font Selection Links --- ' --- Expandable Font Selection Links ---
dim currentFontName as string dim currentfontname as string
select case activeFontIndex select case activefontindex
case 1: currentFontName = "SIMP.CHR" case 1:currentfontname="SIMP.CHR"
case 2: currentFontName = "BOLD.CHR" case 2:currentfontname="BOLD.CHR"
case 3: currentFontName = "EURO.CHR" case 3:currentfontname="EURO.CHR"
case 4: currentFontName = "GOTH.CHR" case 4:currentfontname="GOTH.CHR"
case 5: currentFontName = "LCOM.CHR" case 5:currentfontname="LCOM.CHR"
case 6: currentFontName = "LITT.CHR" case 6:currentfontname="LITT.CHR"
case 7: currentFontName = "SANS.CHR" case 7:currentfontname="SANS.CHR"
case 8: currentFontName = "SCRI.CHR" case 8:currentfontname="SCRI.CHR"
case 9: currentFontName = "TRIP.CHR" case 9:currentfontname="TRIP.CHR"
case 10: currentFontName = "TSCR.CHR" case 10:currentfontname="TSCR.CHR"
end select end select
_printstring (x + 10, 80), "Font: " _printstring (x+10,80),"Font: "
if link(x + 55, 80, "[" + currentFontName + " ]") then if link(x+55,80,"["+currentfontname+" ]") then
showFontList = not showFontList ' Toggle expansion list visibility showfontlist=not showfontlist ' Toggle expansion list visibility
end if end if
' Render the drop-down links when expanded ' Render the drop-down links when expanded
if showFontList then if showfontlist then
dim fontNames(1 to 10) as string dim fontnames(1 to 10) as string
fontNames(1) = "Simplex": fontNames(2) = "Bold": fontNames(3) = "Euro" fontnames(1)="Simplex":fontnames(2)="Bold":fontnames(3)="Euro"
fontNames(4) = "Gothic": fontNames(5) = "Complex": fontNames(6) = "Little" fontnames(4)="Gothic":fontnames(5)="Complex":fontnames(6)="Little"
fontNames(7) = "Sans": fontNames(8) = "Script": fontNames(9) = "Triplex" fontnames(7)="Sans":fontnames(8)="Script":fontnames(9)="Triplex"
fontNames(10) = "TScript" fontnames(10)="TScript"
dim ly as integer, idx as integer dim ly as integer,idx as integer
for idx = 1 to 10 for idx=1 to 10
ly = 80 + (idx * 20) ly=80+(idx*20)
' Highlight the currently active font selection with an asterisk ' Highlight the currently active font selection with an asterisk
dim itemPrefix as string dim itemprefix as string
if idx = activeFontIndex then itemPrefix = "* " else itemPrefix = " " if idx=activefontindex then itemprefix="* "else itemprefix=" "
if link(x + 20, ly, itemPrefix + fontNames(idx)) then if link(x+20,ly,itemprefix+fontnames(idx)) then
activeFontIndex = idx activefontindex=idx
showFontList = 0 ' Auto-collapse list upon selection showfontlist=0 ' Auto-collapse list upon selection
end if end if
next idx next idx
end if end if
' Guard the UI boundaries so clicks on this panel do not draw on the canvas below it ' Guard the UI boundaries so clicks on this panel do not draw on the canvas below it
if _mousex >= x then if _mousex>=x then
if _mousebutton(1) or _mousebutton(2) then mouseclicked = 0: rmouseclicked = 0 if _mousebutton(1) or _mousebutton(2) then mouseclicked=0:rmouseclicked=0
end if end if
end sub end sub
@ -489,29 +489,29 @@ sub redraw
case "gradient" case "gradient"
ditheredgradient numarr(0),numarr(1),numarr(2),numarr(3),state.fcolor,state.bcolor ditheredgradient numarr(0),numarr(1),numarr(2),numarr(3),state.fcolor,state.bcolor
case "gradient" case "gradient"
ditheredgradient numarr(0),numarr(1),numarr(2),numarr(3),state.fcolor,state.bcolor ditheredgradient numarr(0),numarr(1),numarr(2),numarr(3),state.fcolor,state.bcolor
case "text" case "text"
' Extract the string parameter from the command structure manually ' Extract the string parameter from the command structure manually
' e.g., text (X, Y, FontHandleIndex, FontSize, FColor, Your String Content) ' e.g., text (X, Y, FontHandleIndex, FontSize, FColor, Your String Content)
dim txtStart as integer: txtStart = instr(commands(i), ",") dim txtstart as integer:txtstart=instr(commands(i),",")
' Advance past the first 5 commas to isolate the text string ' Advance past the first 5 commas to isolate the text string
dim commaCount as integer: commaCount = 0 dim commacount as integer:commacount=0
dim searchPos as integer: searchPos = 1 dim searchpos as integer:searchpos=1
while commaCount < 5 while commacount<5
searchPos = instr(searchPos, commands(i), ",") searchpos=instr(searchpos,commands(i),",")
if searchPos > 0 then if searchpos>0 then
commaCount = commaCount + 1 commacount=commacount+1
searchPos = searchPos + 1 searchpos=searchpos+1
else else
exit while exit while
end if end if
wend wend
if commaCount = 5 then if commacount=5 then
dim textMsg as string dim textmsg as string
textMsg = mid$(commands(i), searchPos, instr(searchPos, commands(i), ")") - searchPos) textmsg=mid$(commands(i),searchpos,instr(searchpos,commands(i),")")-searchpos)
' Draw text to the drawing layer directly ' Draw text to the drawing layer directly
DisplayBGIText fontHandles(numarr(2)), numarr(0), numarr(1), textMsg, numarr(3), numarr(4) displaybgitext fonthandles(numarr(2)),numarr(0),numarr(1),textmsg,numarr(3),numarr(4)
end if end if
case "" case ""
@ -659,63 +659,63 @@ sub canvas
next next
_dest layers(2).ihandle:cls,0:_dest 0 _dest layers(2).ihandle:cls,0:_dest 0
' 2.5 Check if the mouse pointer is hitting the UI boundaries ' 2.5 Check if the mouse pointer is hitting the UI boundaries
dim mouseInUI as _byte dim mouseinui as _byte
mouseInUI = 0 mouseinui=0
if showtoolbox and (_mousex>=0 and _mousex<=70) then mouseInUI = -1 if showtoolbox and (_mousex>=0 and _mousex<=70) then mouseinui=-1
if showcolorpicker and (_mousey>=_height-20) then mouseInUI = -1 if showcolorpicker and (_mousey>=_height-20) then mouseinui=-1
if showcommands and (_mousex>=drawx2) then mouseInUI = -1 if showcommands and (_mousex>=drawx2) then mouseinui=-1
' 3. Calculate Canvas Coordinates (Center-aligned to the zoom block) ' 3. Calculate Canvas Coordinates (Center-aligned to the zoom block)
dim canx as long dim canx as long
dim cany as long dim cany as long
canx=int((_mousex-state.offsetx+(state.zoom \ 2))/state.zoom) canx=int((_mousex-state.offsetx+(state.zoom \ 2))/state.zoom)
cany=int((_mousey-state.offsety+(state.zoom \ 2))/state.zoom) cany=int((_mousey-state.offsety+(state.zoom \ 2))/state.zoom)
static drawcol static drawcol
if _mousebutton(1) then drawcol=state.fcolor if _mousebutton(1) then drawcol=state.fcolor
if _mousebutton(2) then drawcol=state.bcolor if _mousebutton(2) then drawcol=state.bcolor
' ONLY initiate drawing actions if the mouse is NOT in the UI ' ONLY initiate drawing actions if the mouse is NOT in the UI
if mouseInUI = 0 then if mouseinui=0 then
if (mousedown or rmousedown) and state.isdrawing=0 then if (mousedown or rmousedown) and state.isdrawing=0 then
state.startx=canx state.startx=canx
state.starty=cany state.starty=cany
state.isdrawing=-1 state.isdrawing=-1
end if
end if end if
end if
' Bypass tool execution for regular click-and-drag shapes, ' Bypass tool execution for regular click-and-drag shapes,
' but ALWAYS allow text tool (12) to pass through so it draws the live overlay ' but ALWAYS allow text tool (12) to pass through so it draws the live overlay
if mouseInUI = 0 or state.tool = 12 then if mouseinui=0 or state.tool=12 then
select case state.tool select case state.tool
case 1 case 1
do.pencil canx,cany,drawcol do.pencil canx,cany,drawcol
case 2 case 2
do.line state.startx,state.starty,canx,cany,drawcol do.line state.startx,state.starty,canx,cany,drawcol
case 3 case 3
do.circle state.startx,state.starty,canx,cany,drawcol do.circle state.startx,state.starty,canx,cany,drawcol
case 4 case 4
do.fcircle state.startx,state.starty,canx,cany,drawcol do.fcircle state.startx,state.starty,canx,cany,drawcol
case 5 case 5
do.box state.startx,state.starty,canx,cany,drawcol do.box state.startx,state.starty,canx,cany,drawcol
case 6 case 6
do.fbox state.startx,state.starty,canx,cany,drawcol do.fbox state.startx,state.starty,canx,cany,drawcol
case 7 case 7
do.polygon canx,cany do.polygon canx,cany
case 8 case 8
do.fpolygon canx,cany do.fpolygon canx,cany
case 9 case 9
do.floodfill canx,cany,drawcol do.floodfill canx,cany,drawcol
case 10 case 10
do.eyedropper canx,cany do.eyedropper canx,cany
case 11 case 11
do.gradient state.startx,state.starty,canx,cany do.gradient state.startx,state.starty,canx,cany
case 12 case 12
do.text canx, cany, drawcol do.text canx,cany,drawcol
end select end select
end if end if
end sub end sub
sub do.pencil(x as long,y as long,col as long) sub do.pencil(x as long,y as long,col as long)
@ -1121,49 +1121,49 @@ sub do.gradient(sx as long,sy as long,ex as long,ey as long)
end if end if
end sub end sub
sub do.text (x as long, y as long, col as long) sub do.text (x as long,y as long,col as long)
dim osource as long dim osource as long
dim odest as long dim odest as long
' 1. Mouse Click on Canvas initiates the Typing Focus Lock ' 1. Mouse Click on Canvas initiates the Typing Focus Lock
if (mouseclicked) and state.isdrawing = 0 then if (mouseclicked) and state.isdrawing=0 then
state.startx = x state.startx=x
state.starty = y state.starty=y
state.isdrawing = -1 state.isdrawing=-1
textToolString = "" ' Clear typing input buffer texttoolstring="" ' Clear typing input buffer
_keyclear ' Flush background buffer lines _keyclear ' Flush background buffer lines
end if end if
if state.isdrawing then if state.isdrawing then
osource = _source osource=_source
odest = _dest odest=_dest
' 2. Intercept keyboard streams directly inside the active lock state ' 2. Intercept keyboard streams directly inside the active lock state
dim k as long dim k as long
do do
k = _keyhit k=_keyhit
if k = 0 then exit do if k=0 then exit do
' Character keys range check ' Character keys range check
if k >= 32 and k <= 126 then if k>=32 and k<=126 then
textToolString = textToolString + chr$(k) texttoolstring=texttoolstring+chr$(k)
elseif k = 8 and len(textToolString) > 0 then ' Backspace behavior elseif k=8 and len(texttoolstring)>0 then ' Backspace behavior
textToolString = left$(textToolString, len(textToolString) - 1) texttoolstring=left$(texttoolstring,len(texttoolstring)-1)
elseif k = 13 then elseif k=13 then
_dest layers(1).ihandle _dest layers(1).ihandle
DisplayBGIText fontHandles(activeFontIndex), state.startx, state.starty, textToolString, activeFontSize, col displaybgitext fonthandles(activefontindex),state.startx,state.starty,texttoolstring,activefontsize,col
addcommand "text (" + tst(state.startx) + "," + tst(state.starty) + "," + tst(activeFontIndex) + "," + tst(int(activeFontSize)) + "," + hex$(col) + "," + textToolString + ")" addcommand"text ("+tst(state.startx)+","+tst(state.starty)+","+tst(activefontindex)+","+tst(int(activefontsize))+","+hex$(col)+","+texttoolstring+")"
state.isdrawing = 0 state.isdrawing=0
_dest odest _dest odest
_source osource _source osource
while inkey$<>"":wend while inkey$<>"":wend
exit sub exit sub
elseif k = 27 then elseif k=27 then
state.isdrawing = 0 state.isdrawing=0
exit sub exit sub
end if end if
loop loop
' 3. Render dynamic typing string overlay to active live preview layer (layer 2) ' 3. Render dynamic typing string overlay to active live preview layer (layer 2)
_dest layers(2).ihandle _dest layers(2).ihandle
DisplayBGIText fontHandles(activeFontIndex), state.startx, state.starty, textToolString + "_", activeFontSize, col displaybgitext fonthandles(activefontindex),state.startx,state.starty,texttoolstring+"_",activefontsize,col
_source osource _source osource
_dest odest _dest odest
end if end if
@ -1247,13 +1247,13 @@ function icon (index as long)
_dest 0 _dest 0
icons(10)=_newimage(32,32,32):_dest icons(10) icons(10)=_newimage(32,32,32):_dest icons(10)
ditheredgradient 6, 6, 26, 26, highlightcolor, backgroundcolor1 ditheredgradient 6,6,26,26,highlightcolor,backgroundcolor1
icons(11) = _NEWIMAGE(32, 32, 32): _DEST icons(11) icons(11)=_newimage(32,32,32):_dest icons(11)
line (8, 8)-(24, 8), c line (8,8)-(24,8),c
line (16, 8)-(16, 24), c line (16,8)-(16,24),c
line (12, 24)-(20, 24), c line (12,24)-(20,24),c
_DEST 0 _dest 0
' Fill remaining fallback slots (10-19) with clean blank images ' Fill remaining fallback slots (10-19) with clean blank images
dim j as integer dim j as integer