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