pixler/tools/polystudio.bas

$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 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

' Global polygon trace registers
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
state.threshold=127
updateimage

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 
        updateimage
        state.change = 0
    END IF
    
    ' Render quantized base image
    _PUTIMAGE (0, 0), state.handle
    
    ' Render the vector transparent overlay shapes on top
    _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
        
        ' 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
            
            ' Fetch look-up color index from the generated active handle
            _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
                        ' 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 + ")"
                        
                        ' Send string array payload safely to system clipboard hardware
                        _CLIPBOARD$ = clipStr
                        
                        ' Render transparent vector overlay on overlay handler sheet
                        DIM oldDest AS LONG
                        oldDest = _DEST
                        _DEST state.overlay
                        
                        ' Render with a semi-transparent green color (Alpha = 100)
                        filledpolygon polyPoints(), _RGBA32(0, 255, 0, 100)
                        
                        _DEST oldDest
                    END IF
                END IF
            END IF
        END IF
        mouseclicked = 0
    END IF
    
    ol = state.levels
    ot = state.threshold
    interface
    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 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 

    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

    _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)
                    ' 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

' =========================================================================
' SUBROUTINE: Moore-Neighbor Contour Tracer
' =========================================================================
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
        
        ' 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

' =========================================================================
' 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