pixler/pixler.bas

677 lines
22 KiB
QBasic

type statetype
tool as long
fcolor as long
bcolor as long
offsetX as long
offsetY as long
zoom as single
brushsize as integer
startX as long
startY as long
isDrawing as integer
end type
type layertype
ihandle as long
blendmode as long
filter as long
kind as long
end type
redim shared layers(3) as layertype
dim shared state as statetype
redim shared commands(0) as string
dim shared showtoolbox as _byte: showtoolbox=-1
dim shared showcolorpicker as _byte: showcolorpicker=-1
dim shared showcommands as _byte: showcommands=0
dim shared mouseclicked as integer
dim shared mousedown as integer
dim shared rmouseclicked as integer
dim shared rmousedown as integer
$resize:on
screen _newimage(750,480,32)
_delay 0.1
temp&=_resize
redim shared pal(0) as _unsigned long
dim as integer ch1,ch2,ch3,bt
loadpalette "slso8",pal()
layers(0).ihandle=_newimage(320,320,32)
layers(1).ihandle=_newimage(320,320,32)
layers(2).ihandle=_newimage(320,320,32)
layers(3).ihandle=_newimage(320,320,32)
_dest layers(0).ihandle
addcommand "canvas ("+tst(_width)+","+tst(_height)+")"
for y = 0 to _height - 16 step 16
for x = 0 to _width - 16 step 16
if ((x + y) / 16 AND 1) = 0 then
line (x, y)-(x + 16, y + 16), _rgb32(127), bf
else
line (x, y)-(x + 16, y + 16), _rgb32(192), bf
end if
next
next
_dest 0
state.tool = 1
state.zoom = 1.0
state.offsetX = 70 + 20
state.offsetY = 20
state. brushsize = 1
state.fcolor=closestcolor(_rgb32(0,0,0),pal())
state.bcolor=closestcolor(_rgb32(255,255,255),pal())
addcommand "fcolor ("+hex$(state.fcolor)+")"
addcommand "bcolor ("+hex$(state.bcolor)+")"
dim lastMX, lastMY
dim keyin as string
dim mouseWorldY as integer
dim mouseWorldX as integer
dim diffX as integer
dim diffY as integer
dim oldWidth as integer
dim oldHeight as integer
oldWidth=_width
oldHeight=_height
do
if CheckResize(_source) = -1 THEN
diffX = _width - oldWidth
diffY = _height - oldHeight
state.offsetX = state.offsetX + (diffX / 2)
state.offsetY = state.offsetY + (diffY / 2)
oldWidth = _width
oldHeight = _height
end if
canvas
if showtoolbox then toolbox
if showcolorpicker then colorpicker
if showcommands then commandlist
'Mouse Handling
while _mouseinput:mw=mw+_mousewheel:wend
mouseclicked = 0
rmouseclicked = 0
if mousedown = -1 and _mousebutton(1) = 0 then mouseclicked = -1
if rmousedown = -1 and _mousebutton(2) = 0 then rmouseclicked = -1
mousedown = _mousebutton(1)
rmousedown = _mousebutton(2)
' Panning (Middle Mouse)
if _mousebutton(3) then
state.offsetX = int(state.offsetX + (_mousex - lastMX))
state.offsetY = int(state.offsetY + (_mousey - lastMY))
end if
lastMX = _mousex: lastMY = _mousey
' Zooming
if mw <> 0 then
' 1. Capture current world position
mouseWorldX = (_mousex - state.offsetX) / state.zoom
mouseWorldY = (_mousey - state.offsetY) / state.zoom
' 2. Calculate the new zoom level (Snap to whole numbers)
if mw > 0 then
state.zoom = state.zoom + 1
else
state.zoom = state.zoom - 1
end if
' 3. Constrain zoom (Min 1, Max 20)
if state.zoom < 1 then state.zoom = 1
if state.zoom > 20 then state.zoom = 20
' 4. Adjust offsets
state.offsetX = _mousex - (mouseWorldX * state.zoom)
state.offsetY = _mousey - (mouseWorldY * state.zoom)
mw = 0
end if
' Keyboarding
keyin=inkey$
select case keyin
case "+"
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)+")"
case chr$(19) ' ctrl+s
'TODO: save logic
case chr$(27)' esc
menu
case "h"
state.zoom=1.0
state.offsetX=(_width/2)- (_width(layers(0).ihandle)/2)
state.offsetY=(_height/2)- (_height(layers(0).ihandle)/2)
case "t"
showtoolbox=not showtoolbox
case "c"
showcolorpicker=not showcolorpicker
case "l"
showcommands=not showcommands
end select
_limit 30
_display
line (0,0)-(_width-1,_height-1),backgroundcolor1,bf
loop
sub commandlist
dim i as long
dim listWidth as integer:listWidth = 250
dim x as integer:x=_width-listWidth
' Draw background for the list
line (x,0)-(_width-1,_height - 1),backgroundcolor1, bf
line (x,0)-(x,_height-1),backgroundcolor2
_printmode _keepbackground
dim y as integer
for i = ubound(commands) - 1 to 0 step -1
y = (ubound(commands)-i) * 16
if y < _height - 20 then
'_printstring (x + 5, y + 5), left$(commands(i), 31)
if link(x + 5, y + 5, left$(commands(i), 31)) then
commands(i)=textinput(x + 5, y + 5,248,23, commands(i))
end if
end if
next i
if button(x,_height-25, 60,23, "redraw") then redraw
end sub
sub redraw
redim numarr(0) as long
for i=lbound(commands) to ubound(commands)
select case lcase$(_trim$(left$(commands(i),instr(commands(i),"(")-1)))
case "canvas"
case "fcolor"
case "bcolor"
case "pixel"
case "line"
case "brushwidth"
case "box"
case "fbox"
case "circle"
case "fcircle"
case "polygon"
case "fpolygon"
case "floodfill"
case else
end select
next i
end sub
sub toolbox
dim i, x, y
dim btnSize : btnSize = 32
dim spacing : spacing = 1
for i = 0 to 19
' Force integer math to keep columns locked at 2
' x will only ever be 0 or 33
x = (i mod 2) * (btnSize + spacing)
' y will only increase every 2 buttons
' Use Int() if your language doesn't support the \ operator
y = Int(i / 2) * (btnSize + spacing)
if imagebutton(x, y, btnSize, btnSize, icon(i)) then
state.tool = i + 1
end if
next
'colorindicator
y=y+btnSize+16
line (16,y+16)-(64,y+64),state.bcolor,bf
line (16,y+16)-(64,y+64),highlightcolor,b
line (0,y)-(48,y+48),state.fcolor,bf
line (0,y)-(48,y+48),highlightcolor,b
if clickregion(0, y, 48, 48) then
palettemanager state.fcolor
elseif clickregion(16, y + 16, 48, 48) then
palettemanager state.bcolor
end if
end sub
sub colorpicker
dim img as long
img=_newimage(16,16,32)
for i=0 to ubound(pal)
_dest img
cls ,pal(i)
line (0,0)-(_width-1,height-1),pal(i),bf
_dest 0
select case imagebutton(i*16,_height-17,16,16,img)
case -1
state.fcolor=pal(i)
addcommand "fcolor ("+hex$(pal(i))+")"
case -2
state.bcolor=pal(i)
addcommand "bcolor ("+hex$(pal(i))+")"
end select
next i
_freeimage img
end sub
sub addcommand(cmd as string)
'this check is probably more clever than good is.
if commands(ubound(commands)+(ubound(commands)>0))<>cmd then
commands(ubound(commands))=cmd
redim _preserve commands(ubound(commands)+1) as string
end if
end sub
sub canvas
' 1. Define the Viewport (The "Window" on your screen)
dim viewX1 as integer
if showtoolbox then viewX1 = 70 else viewX1 = 0
dim viewY1 as integer: viewY1 = 0
dim viewX2 as integer
if showcommands then viewX2 = _width - 151 else viewX2 = _width - 1
dim viewY2 as integer
if showcolorpicker then viewY2 = _height - 20 else viewY2 = _height - 1
_dest 0
' 2. Render Layers with Clipping
dim srcX1 as long
dim srcY1 as long
dim srcX2 as long
dim srcY2 as long
dim drawX1 as long
dim drawY1 as long
dim drawX2 as long
dim drawY2 as long
dim i as integer
for i = 0 to ubound(layers)
dim img as long: img = layers(i).ihandle
dim imgW as integer: imgW = _width(img)
dim imgH as integer: imgH = _height(img)
' Current scaled dimensions
dim fullScaledW as single: fullScaledW = imgW * state.zoom
dim fullScaledH as single: fullScaledH = imgH * state.zoom
' Calculate visible area in screen coordinates (Overlap of image and viewport)
drawX1 = state.offsetX
drawY1 = state.offsetY
drawX2 = state.offsetX + fullScaledW
drawY2 = state.offsetY + fullScaledH
' Clip the destination to the Viewport
if drawX1 < viewX1 then drawX1 = viewX1
if drawY1 < viewY1 then drawY1 = viewY1
if drawX2 > viewX2 then drawX2 = viewX2
if drawY2 > viewY2 then drawY2 = viewY2
' Only draw if the image is actually inside the viewport
if drawX2 > drawX1 and drawY2 > drawY1 then
' Map screen-clipped coordinates back to the source image coordinates
srcX1 = int((drawX1 - state.offsetX) / state.zoom)
srcY1 = int((drawY1 - state.offsetY) / state.zoom)
srcX2 = int((drawX2 - state.offsetX) / state.zoom)
srcY2 = int((drawY2 - state.offsetY) / state.zoom)
' Syntax: _PUTIMAGE (destX1, destY1)-(destX2, destY2), sourceHandle, 0, (srcX1, srcY1)-(srcX2, srcY2)
_putimage (drawX1, drawY1)-(drawX2, drawY2), img, 0, (srcX1, srcY1)-(srcX2, srcY2)
end if
next
' 2.5 if the mouse is in ui thats all we need
if showtoolbox then
if _mousex >= 0 and _mousex <= 70 then
exit sub
end if
end if
if showcolorpicker then
if _mousey >= _height - 20 then
exit sub
end if
end if
if showcommands then
if _mousex >= drawX2 then
exit sub
end if
end if
dim r as integer
' 3. Calculate Canvas Coordinates
dim canX as long
dim canY as long
canX = int((_mousex - state.offsetX) / state.zoom)
canY = int((_mousey - state.offsetY) / state.zoom)
static polypoints(200) as single
static pointCount as integer
static drawCol
if _mousebutton(1) then drawCol = state.fcolor
if _mousebutton(2) then drawCol = state.bcolor
if state.tool = 9 and (mouseclicked or rmouseclicked) then
_dest layers(1).ihandle
_source layers(1).ihandle
if mouseclicked then
floodfill canX,canY,state.fcolor
addcommand "floodfill ("+tst(canX)+","+tst(canY)+","+hex$(state.fcolor)+")"
else
floodfill canX,canY,state.bcolor
addcommand "floodfill ("+tst(canX)+","+tst(canY)+","+hex$(state.bcolor)+")"
end if
_dest 0
_source 0
exit sub
end if
if state.tool = 10 and (mouseclicked or rmouseclicked) then
_dest layers(1).ihandle
_source layers(1).ihandle
if mouseclicked then
state.fcolor=point(canX,canY)
addcommand "fcolor ("+hex$(point(canX,canY))+")"
else
state.bcolor=point(canX,canY)
addcommand "bcolor ("+hex$(point(canX,cany))+")"
end if
_dest 0
_source 0
exit sub
end if
if state.tool = 7 or state.tool = 8 then
if mouseclicked then
polypoints(pointCount * 2) = canX
polypoints(pointCount * 2 + 1) = canY
pointCount = pointCount + 1
state.isDrawing = -1
end if
else
if (mousedown or rmousedown) and state.isDrawing = 0 then
state.startX = canX
state.startY = canY
state.isDrawing = -1
end if
end if
if state.isDrawing then
' We use Layer 2 as the temporary preview "rubber-band" layer
_dest layers(2).ihandle
cls , 0
select case state.tool
case 1 ' Pencil
_dest layers(1).ihandle
if canX=state.startX and canY=state.startY then
thickpixel canX,canY,drawCol
addcommand "pixel ("+tst(canX)+","+tst(canY)+","+hex$(drawCol)+")"
else
thickline state.startX, state.startY, canX, canY, drawCol
addcommand "line ("+tst(state.startX)+","+tst(state.startY)+","+tst(canX)+","+tst(canY)+","+hex$(drawCol)+")"
end if
state.startX = canX: state.startY = canY
case 2 ' Straight Line
thickline state.startX, state.startY, canX, canY, drawCol
case 3 ' Circle
r = sqr((canX - state.startX)^2 + (canY - state.startY)^2)
thickcircle state.startX, state.startY, r + 1, drawCol
case 4 ' Filled Circle
r = sqr((canX - state.startX)^2 + (canY - state.startY)^2)
filledcircle state.startX, state.startY, r, drawCol
case 5 ' Rect
thickline state.startX, state.startY, canX, state.startY, drawCol
thickline canX, state.startY, canX, canY, drawCol
thickline canX, canY, state.startX, canY, drawCol
thickline state.startX, canY, state.startX, state.startY, drawCol
case 6 ' Filled Rect
line (state.startX, state.startY)-(canX, canY), drawCol, bf
case 7, 8 ' Polygons
if pointCount > 0 then
for p = 1 to pointCount - 1
thickline polypoints((p - 1) * 2), polypoints((p - 1) * 2 + 1), polypoints(p * 2), polypoints(p * 2 + 1), state.fcolor
next p
thickline polypoints((pointCount - 1) * 2), polypoints((pointCount - 1) * 2 + 1), canX, canY, state.fcolor
end if
end select
' 5. Commit Logic
dim commit as integer: commit = 0
if state.tool = 7 or state.tool = 8 then
if rmouseclicked then commit = -1
else
if (mousedown=0) and (rmousedown=0) then commit = -1
end if
if commit then
_dest layers(1).ihandle ' Final destination is always the drawing layer
if (state.tool = 8 or state.tool=7) and pointCount > 2 then
redim finalP(pointCount * 2 - 1) as long
for p = 0 to (pointCount * 2) - 1: finalP(p) = polypoints(p): next
dim tmpstr as string
if state.tool =8 then
filledPolygon finalP(), state.fcolor
tmpstr="fpolygon ("
for i=0 to ubound(finalP)-1
tmpstr=tmpstr+tst(finalP(i))+","
next i
tmpstr=tmpstr+tst(finalP(i))+","+hex$(state.fcolor)+")"
addcommand tmpstr
else
Polygon finalP(), state.fcolor
tmpstr="polygon ("
for i=0 to ubound(finalP)-1
tmpstr=tmpstr+tst(finalP(i))+","
next i
tmpstr=tmpstr+tst(finalP(i))+","+hex$(state.fcolor)+")"
addcommand tmpstr
end if
else
' Merge the preview into the drawing layer
'_putimage , layers(2).ihandle, layers(1).ihandle
select case state.tool
case 2 ' Line
if canX=state.startX and canY=state.startY then
thickpixel canX,canY,drawCol
addcommand "pixel ("+tst(canX)+","+tst(canY)+","+hex$(drawCol)+")"
else
thickline state.startX, state.startY, canX, canY, drawCol
addcommand "line ("+tst(state.startX)+","+tst(state.startY)+","+tst(canX)+","+tst(canY)+","+hex$(drawCol)+")"
end if
case 3 ' Circle
r = int(sqr((canX - state.startX)^2 + (canY - state.startY)^2))
thickcircle state.startX, state.startY, r + 1, drawCol
addcommand "circle ("+tst(state.startX)+","+tst(state.startY)+","+tst(int(r))+","+hex$(drawCol)+")"
case 4
r = int(sqr((canX - state.startX)^2 + (canY - state.startY)^2))
filledcircle state.startX, state.startY, r + 1, drawCol
addcommand "fcircle ("+tst(state.startX)+","+tst(state.startY)+","+tst(int(r))+","+hex$(drawCol)+")"
case 5 ' Box
line (state.startX, state.startY)-(canX, canY), drawCol, b
addcommand "box ("+tst(state.startX)+","+tst(state.startY)+","+tst(canX)+","+tst(canY)+","+hex$(drawCol)+")"
case 6 ' Filled Box
line (state.startX, state.startY)-(canX, canY), drawCol, bf
addcommand "fbox ("+tst(state.startX)+","+tst(state.startY)+","+tst(canX)+","+tst(canY)+","+hex$(drawCol)+")"
end select
end if
_dest layers(2).ihandle: cls , 0
state.isDrawing = 0
pointCount = 0
end if
end if
_dest 0
end sub
function icon (index as long)
static init as integer
static icons() as long
if not init then
redim icons(19) as long ' Room for 20 icons
' Define your specific tool icons here
icons(0) = _newimage(32,32,32): _dest icons(0): line (5, 27)-(27, 5): _dest 0
icons(1) = _newimage(32,32,32): _dest icons(1): circle (15, 15), 13: _dest 0
icons(2) = _newimage(32,32,32): _dest icons(2): line (5, 5)-(27, 27), , b: _dest 0
icons(6) = _newimage(32,32,32): _dest icons(6)
line (5,15)-(15,5):line -(25,15):line -(20,25): line -(10,25):line -(5,15)
_dest 0
icons(7) = _newimage(32, 32, 32): _dest icons(7)
' Draw a small filled shape for the filled polygon icon
for fy = 10 to 20: line (10, fy)-(22, fy): next
_dest 0
icons(8) = _newimage(32, 32, 32): _dest icons(8)
' Simple "Bucket" icon
line (8, 10)-(24, 10): line -(26, 22): line -(6, 22): line -(8, 10)
line (10, 8)-(22, 8) ' Handle
_dest 0
' Fill the remaining slots with blank 32x32 images
dim j as integer
for j = 0 to 19
if icons(j) = 0 then icons(j) = _newimage(32, 32, 32)
next
init = -1
end if
' Bounds checking to prevent returning 0 or crashing
if index >= 0 and index <= 19 then
icon = icons(index)
else
icon = icons(0)
end if
end function
'$include: 'include/ui.bm'
'$include: 'include/imgout.bm'
'$include: 'include/palette.bm'
'$include: 'include/tools.bm'
''$include: 'include/effects.bm'
function adduiicon(imagehandle as long)
dim unknown as long
adduiicon=__internaluiicon(unknown,imagehandle,1)
end function
function adduiiconfromfile(filename as string)
dim unknown as long
adduiiconfromfile=__internaluiicon(unknown,_loadimage(filename),1)
end function
function uiicon(index)
dim unknown as long
uiicon=internaluiicon(index,unknown,2)
end function
function __internaluiicon&(index as long,imagehandle as long,mode as integer)
static init as integer
static icons() as long
if not init or mode=3 then
if mode<3 then
redim icons(3) as long
else
_freeimage icons(0)
_freeimage icons(1)
_freeimage icons(2)
_freeimage icons(3)
end if
icons(0)=_newimage(23,23,32) 'Up arrow'
_dest icons(0)
color textcolor
icons(1)=_newimage(23,23,32) 'Down arrow'
_dest icons(1)
color textcolor
icons(2)=_newimage(23,23,32) 'Left arrow'
_dest icons(2)
color textcolor
icons(3)=_newimage(23,23,32) 'Right arrow'
_dest icons(3)
color textcolor
_dest 0
init=-1
end if
select case mode
case 1
redim _preserve icons(ubound(icons)+1)
icons(ubound(icons))=imagehandle
__internaluiicon=ubound(icons)
case 2
__internaluiicon=icons(index)
end select
end function
FUNCTION CheckResize (CurrentScreen AS _UNSIGNED LONG) 'pulled straight out of the wiki'
DIM TempScreen AS _UNSIGNED LONG
CheckResize = 0
IF _RESIZE THEN
TempScreen = _COPYIMAGE(CurrentScreen, 32)
SCREEN TempScreen
_FREEIMAGE CurrentScreen
CurrentScreen = _NEWIMAGE(_RESIZEWIDTH, _RESIZEHEIGHT, 32)
SCREEN CurrentScreen
_PUTIMAGE (0, 0), TempScreen, CurrentScreen
_DISPLAY
_FREEIMAGE TempScreen
CheckResize = -1
END IF
END FUNCTION
sub menu()
dim logo as long
logo=_loadimage("logo.png")
Line (0,0)-(_width-1,_height-1),_rgb32(0,192),bf
do until done
k$=inkey$
while _mouseinput:wend
mouseclicked=mbd and not _mousebutton(1)
mbd=_mousebutton(1)
if link(10,10,"open") then system
if link(10,34,"save") then system
if link(10,56,"exit") then system
if k$=chr$(27) then done=-1
_limit 30
_display
loop
end sub
sub palettemanager(col as _unsigned long)
line (0,0)-(_width-1,_height-1),col,bf
'TODO: build palette mamager ui
end sub
FUNCTION closestcolor~& (colour AS _UNSIGNED LONG, carr() AS _UNSIGNED LONG)
DIM r AS INTEGER
DIM g AS INTEGER
DIM b AS INTEGER
DIM ar AS INTEGER
DIM ag AS INTEGER
DIM ab AS INTEGER
DIM i AS INTEGER
DIM nearest AS INTEGER
DIM shortestdistance AS INTEGER
DIM distance AS INTEGER
r = _RED (colour)
g = _GREEN(colour)
b = _BLUE (colour)
shortestdistance = 443
FOR i = 0 TO UBOUND(carr)
ar = _RED (carr(i))
ag = _GREEN(carr(i))
ab = _BLUE (carr(i))
distance = SQR((r - ar) ^ 2 + (g - ag) ^ 2 + (b - ab) ^ 2)
IF distance <= shortestdistance THEN shortestdistance = distance: nearest = i
NEXT i
closestcolor = carr(nearest)
END FUNCTION
' trimmed str$
function tst$(numb)
tst=_trim$(str$(numb))
end function