Advertisement
Dr_Davenstein

contour/basiccoder

May 30th, 2022
3,025
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Dim As UInteger w,h,x,y,count
  2. Dim As String shapedata
  3.  
  4. ScreenRes 640,480,32
  5.  
  6. Dim As Any Ptr horse,temp,t2
  7. horse = ImageCreate(640,480)
  8. temp  = ImageCreate(640,480)
  9. t2  = ImageCreate(640,480,RGBA(0,0,0,255))
  10. BLoad "batman.bmp",horse
  11. BLoad "batman.bmp",temp
  12. Put (0,0),horse,PSet            'place on display
  13. Put (1,0),horse,Xor             'xor x shifted version onto display
  14. Put temp,(0,1),horse,Xor    'xor y shifted version onto temp
  15. Put temp,(0,0),t2,Or         'reset alpha channel
  16. Put (0,0),temp,Or               'or shifted versions together onto display
  17.  
  18. BSave ExePath + "\horseOutline.bmp",0
  19.  
  20. BLoad ExePath + "\horseOutline.bmp",temp 'load the outline image
  21. ImageInfo temp,w,h 'get image dimensions
  22. Color RGB(255,255,255)
  23.  
  24. Cls
  25. Put (0,0),temp,PSet 'draw outline image on screen
  26. Locate 3,40
  27. Print "TRAVERSING"
  28. 'create outline data file
  29. Open ExePath + "\oTdata.txt" For Output As #1
  30. Do
  31.     'scan for line starting point from the top to the bottom
  32.     ' and from the left to the right
  33.     For y = 2 To h-1
  34.         For x = 2 To w-1 'scan line
  35.             If POINT (x,y,temp) <> RGBA(0,0,0,255) Then
  36.                 Exit For,For 'line found
  37.             EndIf
  38.         Next
  39.     Next
  40.     If (x = w) And (y = h) Then 'no line found => end scanning
  41.         Exit Do
  42.     EndIf
  43.     Print #1,x 'line starting point
  44.     Print #1,y
  45.     Do 'traverse line
  46.         PSet (x,y),RGB(255,0,0) 'set pixel on screen for control
  47.         PSet temp,(x,y),RGBA(0,0,0,255) 'delete scanned pixel
  48.         If POINT (x+1,y,temp) <> RGBA(0,0,0,255) Then 'right
  49.             x += 1
  50.             shapedata += Chr(50)
  51.         ElseIf POINT (x-1,y,temp) <> RGBA(0,0,0,255) Then 'left
  52.             x -= 1
  53.             shapedata += Chr(51)
  54.         ElseIf POINT (x,y+1,temp) <> RGBA(0,0,0,255) Then 'up
  55.             y += 1
  56.             shapedata += Chr(48)
  57.         ElseIf POINT (x,y-1,temp) <> RGBA(0,0,0,255) Then 'down
  58.             y -= 1
  59.             shapedata += Chr(49)
  60.         ElseIf (Point (x+1,y+1,temp) <> RGBA(0,0,0,255)) Then 'right/up
  61.             x += 1
  62.             y += 1
  63.             shapedata += Chr(55)
  64.         ElseIf (Point (x-1,y+1,temp) <> RGBA(0,0,0,255)) Then 'left/up
  65.             x -= 1
  66.             y += 1
  67.             shapedata += Chr(54)
  68.         ElseIf (Point (x+1,y-1,temp) <> RGBA(0,0,0,255)) Then 'left/down
  69.             x += 1
  70.             y -= 1
  71.             shapedata += Chr(53)
  72.         ElseIf (Point (x-1,y-1,temp) <> RGBA(0,0,0,255)) Then 'right/down
  73.             x -= 1
  74.             y -= 1
  75.             shapedata += Chr(52)
  76.         Else 'line ended
  77.             Print #1, shapedata
  78.             shapedata = ""
  79.             Exit Do 'search for next line
  80.         EndIf
  81.         Sleep 1
  82.     Loop
  83. Loop
  84. Close
  85. Locate 3,40
  86. Print "          "
  87.  
  88. ImageDestroy horse
  89. ImageDestroy temp
  90.  
  91. 'draw image outline from the saved file
  92. Locate 3,40
  93. Print "DRAWING FROM FILE"
  94. Open ExePath + "\oTdata.txt" For Input As #1
  95. Do
  96.     Input #1, x, y 'starting point
  97.     PSet(x,y),RGB(0,255,0)
  98.  
  99.     Input #1, shapedata
  100.     If Len(shapedata) = 0 Then 'single point
  101.         Continue Do
  102.     EndIf
  103.     For count = 0 To Len(shapedata) - 1
  104.         Select Case shapedata[count] - 48
  105.             Case 0 'down
  106.                 y += 1
  107.             Case 1 'up
  108.                 y -= 1
  109.             Case 2 'right
  110.                 x += 1
  111.             Case 3 'left
  112.                 x -= 1
  113.             Case 4 'left/up
  114.                 x -= 1
  115.                 y -= 1
  116.             Case 5 'right/up
  117.                 x += 1
  118.                 y -= 1
  119.             Case 6 'left/down
  120.                 x -= 1
  121.                 y += 1
  122.             Case 7 'right/down
  123.                 x += 1
  124.                 y += 1
  125.         End Select
  126.         PSet(x,y),RGB(0,255,0)
  127.         Locate 31,40
  128.         Print "^"
  129.         Locate 30,30
  130.         Print Mid(shapedata,count-10,20)
  131.         Sleep 3, 1
  132.     Next
  133. Loop Until Eof(1)
  134. Close
  135.  
  136. Sleep
  137.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement