visionmercer/pixler
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Hush screaming code, save a bit of space.

Browse source
This commit is contained in:
visionmercer 2026-05-26 13:26:36 +02:00
commit 5a1d279b0a
1 changed files with 354 additions and 354 deletions
Download patch file Download diff file Expand all files Collapse all files

578
tools/polystudio.bas
View file

@ -1,389 +1,389 @@
$CONSOLE $console
_SCREENHIDE _screenhide
IF COMMAND$ = "" THEN _ECHO "please specify image file to process": SYSTEM 1 if command$=""then _echo"please specify image file to process":system 1
_SCREENSHOW _screenshow
TYPE Point2D type point2d
X AS LONG x as long
Y AS LONG y as long
END TYPE end type
TYPE statetype type statetype
change AS _BYTE change as _byte
levels AS _UNSIGNED _BYTE levels as _unsigned _byte
threshold AS _UNSIGNED _BYTE threshold as _unsigned _byte
mode AS _BYTE mode as _byte
handle AS LONG handle as long
orgimg AS LONG orgimg as long
overlay AS LONG overlay as long
END TYPE end type
DIM SHARED state AS statetype dim shared state as statetype
DIM file AS STRING dim file as string
DIM SHARED done AS _BYTE dim shared done as _byte
DIM SHARED mouseclicked AS _BYTE dim shared mouseclicked as _byte
DIM SHARED mbd AS _BYTE dim shared mbd as _byte
' Global polygon trace registers ' Global polygon trace registers
REDIM SHARED Contour(4999) AS Point2D redim shared contour(4999) as point2d
DIM SHARED TotalPoints AS LONG dim shared totalpoints as long
IF _FILEEXISTS(COMMAND$) THEN file = COMMAND$ if _fileexists(command$) then file=command$
state.orgimg = _LOADIMAGE(file, 32) state.orgimg=_loadimage(file,32)
state.handle = _COPYIMAGE(state.orgimg) state.handle=_copyimage(state.orgimg)
state.overlay = _NEWIMAGE(_WIDTH(state.orgimg), _HEIGHT(state.orgimg), 32) state.overlay=_newimage(_width(state.orgimg),_height(state.orgimg),32)
state.levels = 10 state.levels=10
state.threshold=127 state.threshold=127
updateimage updateimage
SCREEN _NEWIMAGE(_WIDTH(state.orgimg) + 200, _HEIGHT(state.orgimg) + 200, 32) screen _newimage(_width(state.orgimg)+200,_height(state.orgimg)+200,32)
DO UNTIL done do until done
CLS cls
WHILE _MOUSEINPUT: WEND while _mouseinput:wend
mouseclicked = NOT _MOUSEBUTTON(1) AND mbd mouseclicked=not _mousebutton(1) and mbd
mbd = _MOUSEBUTTON(1) mbd=_mousebutton(1)
IF state.change THEN if state.change then
updateimage updateimage
state.change = 0 state.change=0
END IF end if
' Render quantized base image ' Render quantized base image
_PUTIMAGE (0, 0), state.handle _putimage (0,0),state.handle
' Render the vector transparent overlay shapes on top ' Render the vector transparent overlay shapes on top
_PUTIMAGE (0, 0), state.overlay _putimage (0,0),state.overlay
' Process interactive trace when clicking inside image viewport ' Process interactive trace when clicking inside image viewport
IF mouseclicked THEN if mouseclicked then
DIM clickX AS LONG, clickY AS LONG dim clickx as long,clicky as long
clickX = _MOUSEX clickx=_mousex
clickY = _MOUSEY clicky=_mousey
' Verify click coordinates are safely within the source image canvas bounding box ' Verify click coordinates are safely within the source image canvas bounding box
IF clickX >= 0 AND clickX < _WIDTH(state.orgimg) AND clickY >= 0 AND clickY < _HEIGHT(state.orgimg) THEN if clickx>=0 and clickx<_width(state.orgimg) and clicky>=0 and clicky<_height(state.orgimg) then
DIM TargetColor AS _UNSIGNED LONG dim targetcolor as _unsigned long
' Fetch look-up color index from the generated active handle ' Fetch look-up color index from the generated active handle
_SOURCE state.handle _source state.handle
TargetColor = POINT(clickX, clickY) targetcolor=point(clickx,clicky)
_SOURCE 0 ' Restore background source monitor pointer _source 0 ' Restore background source monitor pointer
' SAFEGUARD 1: Do not attempt to parse pure black background/borders ' SAFEGUARD 1: Do not attempt to parse pure black background/borders
IF TargetColor <> _RGB32(0, 0, 0) AND TargetColor <> _RGBA32(0, 0, 0, 0) THEN if targetcolor<>_rgb32(0,0,0) and targetcolor<>_rgba32(0,0,0,0) then
TotalPoints = 0 totalpoints=0
TraceContour TargetColor, clickX, clickY tracecontour targetcolor,clickx,clicky
IF TotalPoints >= 3 AND TotalPoints < (_WIDTH(state.orgimg) * _HEIGHT(state.orgimg)) THEN if totalpoints>=3 and totalpoints<(_width(state.orgimg)*_height(state.orgimg)) then
REDIM _PRESERVE Contour(TotalPoints - 1) AS Point2D redim _preserve contour(totalpoints-1) as point2d
SimplifyPolygon simplifypolygon
IF TotalPoints >= 3 THEN if totalpoints>=3 then
' Build flat 1D coordinate matrix map array (X1, Y1, X2, Y2...) ' Build flat 1D coordinate matrix map array (X1, Y1, X2, Y2...)
DIM polyPoints(0 TO (TotalPoints * 2) - 1) AS LONG dim polypoints(0 to (totalpoints*2)-1) as long
DIM i AS LONG dim i as long
DIM clipStr AS STRING dim clipstr as string
clipStr = "fpolygon(" clipstr="fpolygon("
FOR i = 0 TO TotalPoints - 1 for i=0 to totalpoints-1
polyPoints(i * 2) = Contour(i).X polypoints(i*2)=contour(i).x
polyPoints(i * 2 + 1) = Contour(i).Y polypoints(i*2+1)=contour(i).y
clipStr = clipStr + LTRIM$(STR$(Contour(i).X)) + "," + LTRIM$(STR$(Contour(i).Y)) clipstr=clipstr+ltrim$(str$(contour(i).x))+","+ltrim$(str$(contour(i).y))
IF i < TotalPoints - 1 THEN clipStr = clipStr + "," if i<totalpoints-1 then clipstr=clipstr+","
NEXT i next i
clipStr = clipStr + ")" clipstr=clipstr+")"
' Send string array payload safely to system clipboard hardware ' Send string array payload safely to system clipboard hardware
_CLIPBOARD$ = clipStr _clipboard$=clipstr
' Render transparent vector overlay on overlay handler sheet ' Render transparent vector overlay on overlay handler sheet
DIM oldDest AS LONG dim olddest as long
oldDest = _DEST olddest=_dest
_DEST state.overlay _dest state.overlay
' Render with a semi-transparent green color (Alpha = 100) ' Render with a semi-transparent green color (Alpha = 100)
filledpolygon polyPoints(), _RGBA32(0, 255, 0, 100) filledpolygon polypoints(),_rgba32(0,255,0,100)
_DEST oldDest _dest olddest
END IF end if
END IF end if
END IF end if
END IF end if
mouseclicked = 0 mouseclicked=0
END IF end if
ol = state.levels ol=state.levels
ot = state.threshold ot=state.threshold
interface interface
IF ol <> state.levels THEN state.change = -1 if ol<>state.levels then state.change=-1
IF ot <> state.threshold THEN state.change = -1 if ot<>state.threshold then state.change=-1
_LIMIT 30 _limit 30
_DISPLAY _display
LOOP loop
SYSTEM system
'$include: '../include/ui.bm' '$include: '../include/ui.bm'
SUB interface sub interface
IF button(10, _HEIGHT - 34, 60, 23, "exit") THEN done = -1 if button(10,_height-34,60,23,"exit") then done=-1
COLOR highlightcolor color highlightcolor
_PRINTSTRING (10, _height(state.handle)+10), "levels" _printstring (10,_height(state.handle)+10),"levels"
state.levels = slider(10, _height(state.handle)+28, 100, state.levels * 10) / 10 state.levels=slider(10,_height(state.handle)+28,100,state.levels*10)/10
COLOR highlightcolor color highlightcolor
_PRINTSTRING (118, _height(state.handle)+28), STR$(state.levels) _printstring (118,_height(state.handle)+28),str$(state.levels)
_PRINTSTRING (10, _height(state.handle)+40), "threshold" _printstring (10,_height(state.handle)+40),"threshold"
state.threshold = slider(10, _height(state.handle)+58 , 100, state.threshold / 255 * 100) / 100 * 255 state.threshold=slider(10,_height(state.handle)+58,100,state.threshold/255*100)/100*255
COLOR highlightcolor color highlightcolor
_PRINTSTRING (118, _height(state.handle)+58), STR$(state.threshold) _printstring (118,_height(state.handle)+58),str$(state.threshold)
END SUB end sub
SUB updateimage sub updateimage
DIM odest AS LONG dim odest as long
DIM osource AS LONG dim osource as long
odest = _DEST odest=_dest
osource = _SOURCE osource=_source
_SOURCE state.orgimg _source state.orgimg
_DEST state.handle _dest state.handle
DIM x AS LONG, y AS LONG, l AS INTEGER dim x as long,y as long,l as integer
DIM numSteps AS INTEGER dim numsteps as integer
IF state.levels < 2 THEN state.levels = 2 if state.levels<2 then state.levels=2
numSteps = state.levels - 1 numsteps=state.levels-1
FOR y = 0 TO _HEIGHT - 1 for y=0 to _height-1
FOR x = 0 TO _WIDTH - 1 for x=0 to _width-1
l = luma(POINT(x, y)) l=luma(point(x,y))
DIM adjustedL AS SINGLE dim adjustedl as single
IF state.threshold = 0 OR state.threshold = 255 THEN if state.threshold=0 or state.threshold=255 then
adjustedL = l adjustedl=l
ELSEIF l <= state.threshold THEN elseif l<=state.threshold then
adjustedL = (l / state.threshold) * 127.5 adjustedl=(l/state.threshold)*127.5
ELSE else
adjustedL = 127.5 + ((l - state.threshold) / (255 - state.threshold)) * 127.5 adjustedl=127.5+((l-state.threshold)/(255-state.threshold))*127.5
END IF end if
DIM currentStep AS INTEGER dim currentstep as integer
currentStep = INT((adjustedL / 256) * state.levels) currentstep=int((adjustedl/256)*state.levels)
IF currentStep < 0 THEN currentStep = 0 if currentstep<0 then currentstep=0
IF currentStep > numSteps THEN currentStep = numSteps if currentstep>numsteps then currentstep=numsteps
l = INT(currentStep * (255 / numSteps)) l=int(currentstep*(255/numsteps))
PSET (x, y), _RGB32(l) pset (x,y),_rgb32(l)
NEXT x next x
NEXT y next y
_SOURCE osource _source osource
_DEST odest _dest odest
END SUB end sub
FUNCTION luma (col AS _UNSIGNED LONG) function luma (col as _unsigned long)
luma = 0.21 * _RED(col) + 0.72 * _GREEN(col) + 0.07 * _BLUE(col) luma=0.21*_red(col)+0.72*_green(col)+0.07*_blue(col)
END FUNCTION end function
' ========================================================================= ' =========================================================================
' SUBROUTINE: Solid Filled Scanning Polygon Vector Renderer ' SUBROUTINE: Solid Filled Scanning Polygon Vector Renderer
' ========================================================================= ' =========================================================================
SUB filledpolygon (points() AS LONG, col AS LONG) sub filledpolygon (points() as long,col as long)
DIM i AS INTEGER, j AS INTEGER dim i as integer,j as integer
DIM x1 AS SINGLE, y1 AS SINGLE, x2 AS SINGLE, y2 AS SINGLE dim x1 as single,y1 as single,x2 as single,y2 as single
DIM intersectx AS SINGLE dim intersectx as single
DIM numpoints AS INTEGER dim numpoints as integer
numpoints = (UBOUND(points) + 1) \ 2 numpoints=(ubound(points)+1) \ 2
DIM intersections(4999) AS SINGLE ' SAFEGUARD 2: Larger intersection limit dim intersections(4999) as single ' SAFEGUARD 2: Larger intersection limit
DIM numintersections AS INTEGER dim numintersections as integer
DIM y AS LONG dim y as long
FOR y = 0 TO _HEIGHT - 1 for y=0 to _height-1
numintersections = 0 numintersections=0
FOR i = 0 TO numpoints - 1 for i=0 to numpoints-1
x1 = points(i * 2) x1=points(i*2)
y1 = points(i * 2 + 1) y1=points(i*2+1)
x2 = points(((i + 1) MOD numpoints) * 2) x2=points(((i+1) mod numpoints)*2)
y2 = points(((i + 1) MOD numpoints) * 2 + 1) y2=points(((i+1) mod numpoints)*2+1)
IF ((y1 > y AND y2 <= y) OR (y2 > y AND y1 <= y)) THEN if ((y1>y and y2<=y) or (y2>y and y1<=y)) then
IF y2 - y1 <> 0 THEN if y2-y1<>0 then
intersectx = x1 + (y - y1) * (x2 - x1) / (y2 - y1) intersectx=x1+(y-y1)*(x2-x1)/(y2-y1)
' SAFEGUARD 3: Array bounds protection ' SAFEGUARD 3: Array bounds protection
IF numintersections <= UBOUND(intersections) THEN if numintersections<=ubound(intersections) then
intersections(numintersections) = intersectx intersections(numintersections)=intersectx
numintersections = numintersections + 1 numintersections=numintersections+1
END IF end if
END IF end if
END IF end if
NEXT i next i
FOR i = 0 TO numintersections - 1 for i=0 to numintersections-1
FOR j = i + 1 TO numintersections - 1 for j=i+1 to numintersections-1
IF intersections(i) > intersections(j) THEN if intersections(i)>intersections(j) then
SWAP intersections(i), intersections(j) swap intersections(i),intersections(j)
END IF end if
NEXT j next j
NEXT i next i
FOR i = 0 TO numintersections - 1 STEP 2 for i=0 to numintersections-1 step 2
IF i + 1 < numintersections THEN if i+1<numintersections then
LINE (intersections(i), y)-(intersections(i + 1), y), col line (intersections(i),y)-(intersections(i+1),y),col
END IF end if
NEXT i next i
NEXT y next y
END SUB end sub
' ========================================================================= ' =========================================================================
' SUBROUTINE: Moore-Neighbor Contour Tracer ' SUBROUTINE: Moore-Neighbor Contour Tracer
' ========================================================================= ' =========================================================================
SUB TraceContour (TargColor AS _UNSIGNED LONG, MX AS LONG, MY AS LONG) sub tracecontour (targcolor as _unsigned long,mx as long,my as long)
DIM StartX AS LONG, StartY AS LONG dim startx as long,starty as long
DIM FoundStart AS _BYTE dim foundstart as _byte
DIM oldSource AS LONG dim oldsource as long
oldSource = _SOURCE oldsource=_source
_SOURCE state.handle _source state.handle
DIM y& dim y&
FOR y& = MY TO 0 STEP -1 for y&=my to 0 step -1
IF POINT(MX, y&) <> TargColor THEN if point(mx,y&)<>targcolor then
StartX = MX startx=mx
StartY = y& + 1 starty=y&+1
FoundStart = -1 foundstart=-1
EXIT FOR exit for
END IF end if
NEXT y& next y&
IF NOT FoundStart THEN if not foundstart then
StartX = MX: StartY = MY startx=mx:starty=my
END IF end if
DIM dx(0 TO 7) AS INTEGER dim dx(0 to 7) as integer
DIM dy(0 TO 7) AS INTEGER dim dy(0 to 7) as integer
dx(0) = -1: dx(1) = 0: dx(2) = 1: dx(3) = 1: dx(4) = 1: dx(5) = 0: dx(6) = -1: dx(7) = -1 dx(0)=-1:dx(1)=0:dx(2)=1:dx(3)=1:dx(4)=1:dx(5)=0:dx(6)=-1:dx(7)=-1
dy(0) = -1: dy(1) = -1: dy(2) = -1: dy(3) = 0: dy(4) = 1: dy(5) = 1: dy(6) = 1: dy(7) = 0 dy(0)=-1:dy(1)=-1:dy(2)=-1:dy(3)=0:dy(4)=1:dy(5)=1:dy(6)=1:dy(7)=0
DIM CurrentX AS LONG, CurrentY AS LONG dim currentx as long,currenty as long
DIM BacktrackDir AS INTEGER, CheckDir AS INTEGER dim backtrackdir as integer,checkdir as integer
DIM StartBacktrackDir AS INTEGER dim startbacktrackdir as integer
CurrentX = StartX currentx=startx
CurrentY = StartY currenty=starty
TotalPoints = 0 totalpoints=0
BacktrackDir = 1 backtrackdir=1
StartBacktrackDir = 1 startbacktrackdir=1
DIM FirstStep AS _BYTE dim firststep as _byte
FirstStep = -1 firststep=-1
' Calculate absolute ceiling area parameter to handle escape routes ' Calculate absolute ceiling area parameter to handle escape routes
DIM maxAllowedPoints AS LONG dim maxallowedpoints as long
maxAllowedPoints = _WIDTH(state.handle) * _HEIGHT(state.handle) maxallowedpoints=_width(state.handle)*_height(state.handle)
DO do
Contour(TotalPoints).X = CurrentX contour(totalpoints).x=currentx
Contour(TotalPoints).Y = CurrentY contour(totalpoints).y=currenty
TotalPoints = TotalPoints + 1 totalpoints=totalpoints+1
' SAFEGUARD 4: Break if loop gets stuck spinning in empty coordinates ' SAFEGUARD 4: Break if loop gets stuck spinning in empty coordinates
IF TotalPoints >= maxAllowedPoints THEN if totalpoints>=maxallowedpoints then
TotalPoints = 0 totalpoints=0
EXIT DO exit do
END IF end if
IF TotalPoints >= UBOUND(Contour) THEN if totalpoints>=ubound(contour) then
REDIM _PRESERVE Contour(UBOUND(Contour) + 1000) AS Point2D redim _preserve contour(ubound(contour)+1000) as point2d
END IF end if
CheckDir = (BacktrackDir + 1) MOD 8 checkdir=(backtrackdir+1) mod 8
DIM Steps AS INTEGER dim steps as integer
Steps = 0 steps=0
DO WHILE Steps < 8 do while steps<8
DIM NX AS LONG, NY AS LONG dim nx as long,ny as long
NX = CurrentX + dx(CheckDir) nx=currentx+dx(checkdir)
NY = CurrentY + dy(CheckDir) ny=currenty+dy(checkdir)
IF NX >= 0 AND NX < _WIDTH(state.handle) AND NY >= 0 AND NY < _HEIGHT(state.handle) THEN if nx>=0 and nx<_width(state.handle) and ny>=0 and ny<_height(state.handle) then
IF POINT(NX, NY) = TargColor THEN if point(nx,ny)=targcolor then
BacktrackDir = (CheckDir + 4) MOD 8 backtrackdir=(checkdir+4) mod 8
CurrentX = NX currentx=nx
CurrentY = NY currenty=ny
IF FirstStep THEN if firststep then
StartBacktrackDir = BacktrackDir startbacktrackdir=backtrackdir
FirstStep = 0 firststep=0
END IF end if
EXIT DO exit do
END IF end if
END IF end if
CheckDir = (CheckDir + 1) MOD 8 checkdir=(checkdir+1) mod 8
Steps = Steps + 1 steps=steps+1
LOOP loop
IF Steps = 8 THEN EXIT DO if steps=8 then exit do
LOOP UNTIL (CurrentX = StartX AND CurrentY = StartY AND BacktrackDir = StartBacktrackDir) loop until (currentx=startx and currenty=starty and backtrackdir=startbacktrackdir)
_SOURCE oldSource _source oldsource
END SUB end sub
' ========================================================================= ' =========================================================================
' SUBROUTINE: SimplifyPolygon ' SUBROUTINE: SimplifyPolygon
' ========================================================================= ' =========================================================================
SUB SimplifyPolygon sub simplifypolygon
DIM numPoints AS LONG dim numpoints as long
numPoints = TotalPoints numpoints=totalpoints
IF numPoints > 2 THEN if numpoints>2 then
IF Contour(numPoints - 1).X = Contour(0).X AND Contour(numPoints - 1).Y = Contour(0).Y THEN if contour(numpoints-1).x=contour(0).x and contour(numpoints-1).y=contour(0).y then
numPoints = numPoints - 1 numpoints=numpoints-1
END IF end if
END IF end if
IF numPoints < 3 THEN EXIT SUB if numpoints<3 then exit sub
DIM temp(0 TO numPoints - 1) AS Point2D dim temp(0 to numpoints-1) as point2d
DIM keepCount AS LONG dim keepcount as long
temp(0) = Contour(0) temp(0)=contour(0)
keepCount = 1 keepcount=1
DIM i AS LONG dim i as long
FOR i = 1 TO numPoints - 1 for i=1 to numpoints-1
DIM prevIdx AS LONG: prevIdx = i - 1 dim previdx as long:previdx=i-1
DIM nextIdx AS LONG: nextIdx = i + 1 dim nextidx as long:nextidx=i+1
IF nextIdx > numPoints - 1 THEN nextIdx = 0 if nextidx>numpoints-1 then nextidx=0
DIM dx1 AS SINGLE: dx1 = Contour(i).X - Contour(prevIdx).X dim dx1 as single:dx1=contour(i).x-contour(previdx).x
DIM dy1 AS SINGLE: dy1 = Contour(i).Y - Contour(prevIdx).Y dim dy1 as single:dy1=contour(i).y-contour(previdx).y
DIM dx2 AS SINGLE: dx2 = Contour(nextIdx).X - Contour(i).X dim dx2 as single:dx2=contour(nextidx).x-contour(i).x
DIM dy2 AS SINGLE: dy2 = Contour(nextIdx).Y - Contour(i).Y dim dy2 as single:dy2=contour(nextidx).y-contour(i).y
DIM crossProduct AS SINGLE dim crossproduct as single
crossProduct = (dx1 * dy2) - (dy1 * dx2) crossproduct=(dx1*dy2)-(dy1*dx2)
IF ABS(crossProduct) > 0.05 THEN if abs(crossproduct)>0.05 then
temp(keepCount) = Contour(i) temp(keepcount)=contour(i)
keepCount = keepCount + 1 keepcount=keepcount+1
END IF end if
NEXT i next i
IF keepCount >= 3 THEN if keepcount>=3 then
REDIM Contour(keepCount - 1) AS Point2D redim contour(keepcount-1) as point2d
FOR i = 0 TO keepCount - 1 for i=0 to keepcount-1
Contour(i) = temp(i) contour(i)=temp(i)
NEXT i next i
TotalPoints = keepCount totalpoints=keepcount
ELSE else
REDIM Contour(numPoints - 1) AS Point2D redim contour(numpoints-1) as point2d
FOR i = 0 TO numPoints - 1 for i=0 to numpoints-1
Contour(i) = temp(i) contour(i)=temp(i)
NEXT i next i
TotalPoints = numPoints totalpoints=numpoints
END IF end if
END SUB end sub