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
@ -187,7 +187,7 @@ do
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
@ -238,7 +238,7 @@ sub listcontextmenu (index as long, mx as integer, my as integer)
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
@ -292,10 +292,10 @@ sub listcontextmenu (index as long, mx as integer, my as integer)
' 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
@ -305,9 +305,9 @@ sub listcontextmenu (index as long, mx as integer, my as integer)
' 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
@ -353,15 +353,15 @@ sub listcontextmenu (index as long, mx as integer, my as integer)
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
@ -373,52 +373,52 @@ sub drawTextToolPanel
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
@ -494,24 +494,24 @@ sub redraw
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,12 +659,12 @@ 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
@ -678,7 +678,7 @@ sub canvas
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
@ -688,7 +688,7 @@ sub canvas
' 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
@ -1130,7 +1130,7 @@ sub do.text (x as long, y as long, col as long)
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
@ -1144,13 +1144,13 @@ sub do.text (x as long, y as long, col as long)
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
@ -1163,7 +1163,7 @@ sub do.text (x as long, y as long, col as long)
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
@ -1249,11 +1249,11 @@ function icon (index as long)
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