contour/basiccoder

Dim As UInteger w,h,x,y,count
Dim As String shapedata

ScreenRes 640,480,32

Dim As Any Ptr horse,temp,t2
horse = ImageCreate(640,480)
temp  = ImageCreate(640,480)
t2  = ImageCreate(640,480,RGBA(0,0,0,255))
BLoad "batman.bmp",horse
BLoad "batman.bmp",temp
Put (0,0),horse,PSet            'place on display
Put (1,0),horse,Xor             'xor x shifted version onto display
Put temp,(0,1),horse,Xor    'xor y shifted version onto temp
Put temp,(0,0),t2,Or         'reset alpha channel
Put (0,0),temp,Or               'or shifted versions together onto display

BSave ExePath + "\horseOutline.bmp",0

BLoad ExePath + "\horseOutline.bmp",temp 'load the outline image
ImageInfo temp,w,h 'get image dimensions
Color RGB(255,255,255)

Cls
Put (0,0),temp,PSet 'draw outline image on screen
Locate 3,40
Print "TRAVERSING"
'create outline data file
Open ExePath + "\oTdata.txt" For Output As #1
Do
    'scan for line starting point from the top to the bottom
    ' and from the left to the right
    For y = 2 To h-1
        For x = 2 To w-1 'scan line
            If POINT (x,y,temp) <> RGBA(0,0,0,255) Then
                Exit For,For 'line found
            EndIf
        Next
    Next
    If (x = w) And (y = h) Then 'no line found => end scanning
        Exit Do
    EndIf
    Print #1,x 'line starting point
    Print #1,y
    Do 'traverse line
        PSet (x,y),RGB(255,0,0) 'set pixel on screen for control
        PSet temp,(x,y),RGBA(0,0,0,255) 'delete scanned pixel
        If POINT (x+1,y,temp) <> RGBA(0,0,0,255) Then 'right
            x += 1
            shapedata += Chr(50)
        ElseIf POINT (x-1,y,temp) <> RGBA(0,0,0,255) Then 'left
            x -= 1
            shapedata += Chr(51)
        ElseIf POINT (x,y+1,temp) <> RGBA(0,0,0,255) Then 'up
            y += 1
            shapedata += Chr(48)
        ElseIf POINT (x,y-1,temp) <> RGBA(0,0,0,255) Then 'down
            y -= 1
            shapedata += Chr(49)
        ElseIf (Point (x+1,y+1,temp) <> RGBA(0,0,0,255)) Then 'right/up
            x += 1
            y += 1
            shapedata += Chr(55)
        ElseIf (Point (x-1,y+1,temp) <> RGBA(0,0,0,255)) Then 'left/up
            x -= 1
            y += 1
            shapedata += Chr(54)
        ElseIf (Point (x+1,y-1,temp) <> RGBA(0,0,0,255)) Then 'left/down
            x += 1
            y -= 1
            shapedata += Chr(53)
        ElseIf (Point (x-1,y-1,temp) <> RGBA(0,0,0,255)) Then 'right/down
            x -= 1
            y -= 1
            shapedata += Chr(52)
        Else 'line ended
            Print #1, shapedata
            shapedata = ""
            Exit Do 'search for next line
        EndIf
        Sleep 1
    Loop
Loop
Close
Locate 3,40
Print "          "

ImageDestroy horse
ImageDestroy temp

'draw image outline from the saved file
Locate 3,40
Print "DRAWING FROM FILE"
Open ExePath + "\oTdata.txt" For Input As #1
Do
    Input #1, x, y 'starting point
    PSet(x,y),RGB(0,255,0)

    Input #1, shapedata
    If Len(shapedata) = 0 Then 'single point
        Continue Do
    EndIf
    For count = 0 To Len(shapedata) - 1
        Select Case shapedata[count] - 48
            Case 0 'down
                y += 1
            Case 1 'up
                y -= 1
            Case 2 'right
                x += 1
            Case 3 'left
                x -= 1
            Case 4 'left/up
                x -= 1
                y -= 1
            Case 5 'right/up
                x += 1
                y -= 1
            Case 6 'left/down
                x -= 1
                y += 1
            Case 7 'right/down
                x += 1
                y += 1
        End Select
        PSet(x,y),RGB(0,255,0)
        Locate 31,40
        Print "^"
        Locate 30,30
        Print Mid(shapedata,count-10,20)
        Sleep 3, 1
    Next
Loop Until Eof(1)
Close

Sleep