try again

This commit is contained in:
visionmercer 2026-05-28 14:07:51 +02:00
commit 684e3d1b0c
10 changed files with 484 additions and 59 deletions

View file

@ -64,6 +64,22 @@ state.bcolor=closestcolor(_rgb32(255,255,255),pal())
addcommand"fcolor ("+hex$(state.fcolor)+")"
addcommand"bcolor ("+hex$(state.bcolor)+")"
DIM SHARED fontHandles(1 TO 10) AS INTEGER
DIM SHARED activeFontIndex AS INTEGER: activeFontIndex = 1
DIM SHARED activeFontSize AS SINGLE: activeFontSize = 16
DIM SHARED textToolString AS STRING
fontHandles(1) = LoadBGIFont("./fonts/SIMP.CHR")
fontHandles(2) = LoadBGIFont("./fonts/BOLD.CHR")
fontHandles(3) = LoadBGIFont("./fonts/EURO.CHR")
fontHandles(4) = LoadBGIFont("./fonts/GOTH.CHR")
fontHandles(5) = LoadBGIFont("./fonts/LCOM.CHR")
fontHandles(6) = LoadBGIFont("./fonts/LITT.CHR")
fontHandles(7) = LoadBGIFont("./fonts/SANS.CHR")
fontHandles(8) = LoadBGIFont("./fonts/SCRI.CHR")
fontHandles(9) = LoadBGIFont("./fonts/TRIP.CHR")
fontHandles(10) = LoadBGIFont("./fonts/TSCR.CHR")
dim lastmx,lastmy
dim keyin as string
dim mouseworldy as long
@ -117,6 +133,7 @@ do
end if
' Keyboarding
if not state.tool=16 and not state.isdrawing then
keyin=inkey$
select case keyin
case chr$(27)
@ -165,12 +182,13 @@ do
redraw
end if
end select
end if
canvas
if showtoolbox then toolbox
if showcolorpicker then colorpicker
if showcommands then commandlist
if state.tool = 12 then drawTextToolPanel
_limit 30
_display
loop
@ -198,6 +216,76 @@ sub commandlist
if button(x,_height-25,60,23,"redraw") then redraw
end sub
sub drawTextToolPanel
dim panelWidth as integer: panelWidth = 160
dim x as integer: x = _width - panelWidth
static showFontList as integer ' Tracks the expanding drop-down list state
' Draw the side panel background card block
line (x, 0)-(_width - 1, _height - 1), backgroundcolor1, bf
line (x, 0)-(x, _height - 1), backgroundcolor2
_printmode _keepbackground
_printstring (x + 10, 15), "TEXT TOOL OPTIONS"
line (x + 10, 30)-(x + 140, 30), backgroundcolor2
' --- Font Size Controls ---
_printstring (x + 10, 45), "Size: " + tst(int(activeFontSize))
if button(x + 85, 42, 24, 20, "-") then
if activeFontSize > 4 then activeFontSize = activeFontSize - 2
end if
if button(x + 115, 42, 24, 20, "+") then
if activeFontSize < 120 then activeFontSize = activeFontSize + 2
end if
' --- Expandable Font Selection Links ---
dim currentFontName as string
select case activeFontIndex
case 1: currentFontName = "SIMP.CHR"
case 2: currentFontName = "BOLD.CHR"
case 3: currentFontName = "EURO.CHR"
case 4: currentFontName = "GOTH.CHR"
case 5: currentFontName = "LCOM.CHR"
case 6: currentFontName = "LITT.CHR"
case 7: currentFontName = "SANS.CHR"
case 8: currentFontName = "SCRI.CHR"
case 9: currentFontName = "TRIP.CHR"
case 10: currentFontName = "TSCR.CHR"
end select
_printstring (x + 10, 80), "Font: "
if link(x + 55, 80, "[" + currentFontName + " ]") then
showFontList = not showFontList ' Toggle expansion list visibility
end if
' Render the drop-down links when expanded
if showFontList then
dim fontNames(1 to 10) as string
fontNames(1) = "Simplex": fontNames(2) = "Bold": fontNames(3) = "Euro"
fontNames(4) = "Gothic": fontNames(5) = "Complex": fontNames(6) = "Little"
fontNames(7) = "Sans": fontNames(8) = "Script": fontNames(9) = "Triplex"
fontNames(10) = "TScript"
dim ly as integer, idx as integer
for idx = 1 to 10
ly = 80 + (idx * 20)
' Highlight the currently active font selection with an asterisk
dim itemPrefix as string
if idx = activeFontIndex then itemPrefix = "* " else itemPrefix = " "
if link(x + 20, ly, itemPrefix + fontNames(idx)) then
activeFontIndex = idx
showFontList = 0 ' Auto-collapse list upon selection
end if
next idx
end if
' Guard the UI boundaries so clicks on this panel do not draw on the canvas below it
if _mousex >= x then
if _mousebutton(1) or _mousebutton(2) then mouseclicked = 0: rmouseclicked = 0
end if
end sub
sub redraw
redim numarr(0) as long
dim i as integer
@ -257,6 +345,32 @@ sub redraw
boundaryfill numarr(0),numarr(1),numarr(2),numarr(3)
case "gradient"
ditheredgradient numarr(0),numarr(1),numarr(2),numarr(3),state.fcolor,state.bcolor
case "gradient"
ditheredgradient numarr(0),numarr(1),numarr(2),numarr(3),state.fcolor,state.bcolor
case "text"
' Extract the string parameter from the command structure manually
' e.g., text (X, Y, FontHandleIndex, FontSize, FColor, Your String Content)
dim txtStart as integer: txtStart = instr(commands(i), ",")
' Advance past the first 5 commas to isolate the text string
dim commaCount as integer: commaCount = 0
dim searchPos as integer: searchPos = 1
while commaCount < 5
searchPos = instr(searchPos, commands(i), ",")
if searchPos > 0 then
commaCount = commaCount + 1
searchPos = searchPos + 1
else
exit while
end if
wend
if commaCount = 5 then
dim textMsg as string
textMsg = mid$(commands(i), searchPos, instr(searchPos, commands(i), ")") - searchPos)
' Draw text to the drawing layer directly
DisplayBGIText fontHandles(numarr(2)), numarr(0), numarr(1), textMsg, numarr(3), numarr(4)
end if
case ""
' blank line do nothing
case else
@ -401,64 +515,64 @@ sub canvas
end if
next
_dest layers(2).ihandle:cls,0:_dest 0
' 2.5 if the mouse is in ui thats all we need
if showtoolbox then
if _mousex>=0 and _mousex<=70 then
exit sub
' 2.5 Check if the mouse pointer is hitting the UI boundaries
dim mouseInUI as _byte
mouseInUI = 0
if showtoolbox and (_mousex>=0 and _mousex<=70) then mouseInUI = -1
if showcolorpicker and (_mousey>=_height-20) then mouseInUI = -1
if showcommands and (_mousex>=drawx2) then mouseInUI = -1
' 3. Calculate Canvas Coordinates (Center-aligned to the zoom block)
dim canx as long
dim cany as long
canx=int((_mousex-state.offsetx+(state.zoom \ 2))/state.zoom)
cany=int((_mousey-state.offsety+(state.zoom \ 2))/state.zoom)
static drawcol
if _mousebutton(1) then drawcol=state.fcolor
if _mousebutton(2) then drawcol=state.bcolor
' ONLY initiate drawing actions if the mouse is NOT in the UI
if mouseInUI = 0 then
if (mousedown or rmousedown) and state.isdrawing=0 then
state.startx=canx
state.starty=cany
state.isdrawing=-1
end if
end if
end if
if showcolorpicker then
if _mousey>=_height-20 then
exit sub
' Bypass tool execution for regular click-and-drag shapes,
' but ALWAYS allow text tool (12) to pass through so it draws the live overlay
if mouseInUI = 0 or state.tool = 12 then
select case state.tool
case 1
do.pencil canx,cany,drawcol
case 2
do.line state.startx,state.starty,canx,cany,drawcol
case 3
do.circle state.startx,state.starty,canx,cany,drawcol
case 4
do.fcircle state.startx,state.starty,canx,cany,drawcol
case 5
do.box state.startx,state.starty,canx,cany,drawcol
case 6
do.fbox state.startx,state.starty,canx,cany,drawcol
case 7
do.polygon canx,cany
case 8
do.fpolygon canx,cany
case 9
do.floodfill canx,cany,drawcol
case 10
do.eyedropper canx,cany
case 11
do.gradient state.startx,state.starty,canx,cany
case 12
do.text canx, cany, drawcol
end select
end if
end if
if showcommands then
if _mousex>=drawx2 then
exit sub
end if
end if
' 3. Calculate Canvas Coordinates (Center-aligned to the zoom block)
dim canx as long
dim cany as long
canx=int((_mousex-state.offsetx+(state.zoom \ 2))/state.zoom)
cany=int((_mousey-state.offsety+(state.zoom \ 2))/state.zoom)
static drawcol
if _mousebutton(1) then drawcol=state.fcolor
if _mousebutton(2) then drawcol=state.bcolor
if (mousedown or rmousedown) and state.isdrawing=0 then
state.startx=canx
state.starty=cany
state.isdrawing=-1
end if
select case state.tool
case 1
do.pencil canx,cany,drawcol
case 2
do.line state.startx,state.starty,canx,cany,drawcol
case 3
do.circle state.startx,state.starty,canx,cany,drawcol
case 4
do.fcircle state.startx,state.starty,canx,cany,drawcol
case 5
do.box state.startx,state.starty,canx,cany,drawcol
case 6
do.fbox state.startx,state.starty,canx,cany,drawcol
case 7
do.polygon canx,cany
case 8
do.fpolygon canx,cany
case 9
do.floodfill canx,cany,drawcol
case 10
do.eyedropper canx,cany
case 11
do.gradient state.startx,state.starty,canx,cany
end select
end sub
sub do.pencil(x as long,y as long,col as long)
@ -836,6 +950,21 @@ sub do.gradient(sx as long,sy as long,ex as long,ey as long)
if state.isdrawing then
osource=_source
odest=_dest
if _keydown(100303) or _keydown(100304) then
dim dx as single:dx=ex-sx
dim dy as single:dy=ey-sy
if dx<>0 or dy<>0 then
dim linelen as single:linelen=sqr(dx*dx+dy*dy)
dim angle as single:angle=_atan2(dy,dx)
dim degrees as single:degrees=angle*(180.0/_pi)
dim snappeddegrees as single:snappeddegrees=int((degrees+22.5)/45.0)*45.0
dim snappedangle as single:snappedangle=snappeddegrees*(_pi/180.0)
ex=sx+_round(linelen*cos(snappedangle))
ey=sy+_round(linelen*sin(snappedangle))
end if
end if
if mouseclicked or rmouseclicked then
_dest layers(1).ihandle
addcommand"gradient ("+tst(sx)+","+tst(sy)+","+tst(ex)+","+tst(ey)+")"
@ -850,6 +979,54 @@ sub do.gradient(sx as long,sy as long,ex as long,ey as long)
end if
end sub
sub do.text (x as long, y as long, col as long)
dim osource as long
dim odest as long
' 1. Mouse Click on Canvas initiates the Typing Focus Lock
if (mouseclicked) and state.isdrawing = 0 then
state.startx = x
state.starty = y
state.isdrawing = -1
textToolString = "" ' Clear typing input buffer
_keyclear ' Flush background buffer lines
end if
if state.isdrawing then
osource = _source
odest = _dest
' 2. Intercept keyboard streams directly inside the active lock state
dim k as long
do
k = _keyhit
if k = 0 then exit do
' Character keys range check
if k >= 32 and k <= 126 then
textToolString = textToolString + chr$(k)
elseif k = 8 and len(textToolString) > 0 then ' Backspace behavior
textToolString = left$(textToolString, len(textToolString) - 1)
elseif k = 13 then
_dest layers(1).ihandle
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 + ")"
state.isdrawing = 0
_dest odest
_source osource
while inkey$<>"":wend
exit sub
elseif k = 27 then
state.isdrawing = 0
exit sub
end if
loop
' 3. Render dynamic typing string overlay to active live preview layer (layer 2)
_dest layers(2).ihandle
DisplayBGIText fontHandles(activeFontIndex), state.startx, state.starty, textToolString + "_", activeFontSize, col
_source osource
_dest odest
end if
end sub
function icon (index as long)
static init as integer
static icons() as long
@ -927,9 +1104,18 @@ function icon (index as long)
line (22,10)-(26,6),c ' Squeeze bulb cap
_dest 0
icons(10)=_newimage(32,32,32):_dest icons(10)
ditheredgradient 6, 6, 26, 26, highlightcolor, backgroundcolor1
icons(11) = _NEWIMAGE(32, 32, 32): _DEST icons(11)
line (8, 8)-(24, 8), c
line (16, 8)-(16, 24), c
line (12, 24)-(20, 24), c
_DEST 0
' Fill remaining fallback slots (10-19) with clean blank images
dim j as integer
for j=10 to 19
for j=11 to 19
if icons(j)=0 then icons(j)=_newimage(32,32,32)
next
@ -947,6 +1133,7 @@ end function
'$include: 'include/imgout.bm'
'$include: 'include/palette.bm'
'$include: 'include/tools.bm'
'$include: 'include/bgifnt.bm'
''$include: 'include/effects.bm'
function adduiicon(imagehandle as long)