Tracer revisited

BasicCoder2 · Post by **BasicCoder2** » Dec 01, 2020 5:13

Re: Pentacles
Postby srvaldez » Nov 29, 2020 10:54

@BasicCoder2
very nice drawing :-)
could you post your latest tracer code ?

As I wrote I would post the code I have but it is still user unfriendly with lots of changes required to make it a stand alone, and easy to use, program for a wider audience. To use it you have to be a FreeBASIC programmer and modify the actual source code to load your image as the image's file name is hard coded. Need to add a button to allow a user to select and load any sized image file to fix that.

So to use the program you first must have a 640x480x32bit image placed it into the same folder as Tracer.bas and type its file name into Tracer.bas source code in the load image subroutine. You can use the attached image if you convert it to a .bmp version.

Tracer.bas starts in the DRAW mode. You left click a pixel in the image and that is the starting point. You then click another pixel and a line will be drawn between it and the first pixel. Continually left click points to make connected lines. To restart else where click the right mouse button and then choose the next starting point.

You can change the thickness of the line with the number keys.

To color fill in an area enclosed by drawn lines (make sure no gaps) choose PICK and click on a color in the image and then it will automatically go into FILL mode. Or click a color on the palette. You can use the FILL button at any time.

If you make a mistake there is an UNDO button.

ESC key exits the program.

Play with the buttons to figure out the rest.

The result is DrawTracing.bas which will draw the result when run.

tracer.bas

Code: Select all

chdir exepath()

screenres 900,600,32
color rgb(0,0,0),rgb(255,255,255):cls

'variables used for creating macro language program
dim shared as integer pen,prevX,prevY
dim shared as integer drawMode
dim shared as uinteger color1,color2
dim shared as integer mag,showHideImage,grid
grid = 0           'off=0   on=1
mag  = 0           'off=0   on=1
showHideImage = 1  'hide=0  show=1

color1 = rgb(0,0,0)         'pen color
color2 = rgb(255,255,255)   'fill color
drawMode = 0

'variables creating a program for the macro language
dim shared as string  cmd(3000)
dim shared as integer px(3000),py(3000),cmdCount
dim shared as integer penSize
penSize = 0

dim as string  s  'alternative compact storage of program as a string

pen = 0 'start with pen UP

dim shared as any ptr canvas1,canvas2,canvas3
canvas1 = imagecreate(640,480,rgb(255,0,255))  ' loaded image to trace
canvas2 = imagecreate(640,480,rgb(255,0,255))  ' drawing by DrawIt()
canvas3 = imagecreate(640,480,rgb(255,0,255))  ' merged loaded image with drawing for display

sub loadImage()
    bload "finches.bmp",canvas1
end sub

dim shared as integer mx,my,mb

type BUTTON   'button with two states
    as integer  x
    as integer  y
    as integer  w
    as integer  h
    as uinteger fg  'forground color
    as uinteger bg  'background color
    as string   t
end type

sub drawButton(btn as BUTTON)
    line (btn.x,btn.y)-(btn.x+btn.w,btn.y+btn.h),rgb(0,0,0),b
    draw string (btn.x+4,btn.y+4),btn.t
end sub


dim shared as BUTTON btnDraw,btnFill,btnUndo,btnPick,btnMag,btnShow
dim shared as BUTTON btnGray,btnPost,btnLoad,btnGrid,btnInvert,btnSave
dim shared as BUTTON btnClear

btnDraw.x = 700
btnDraw.y = 48
btnDraw.w = 8*7
btnDraw.h = 16
btnDraw.fg = rgb(0,0,0)
btnDraw.bg = rgb(255,255,255)
btnDraw.t  = " DRAW "

btnFill.x = 700
btnFill.y = 80
btnFill.w = 8*7
btnFill.h = 16
btnFill.fg = rgb(0,0,0)
btnFill.bg = rgb(255,255,255)
btnFill.t  = " FILL "

btnUndo.x = 700
btnUndo.y = 112
btnUndo.w = 8*7
btnUndo.h = 16
btnUndo.fg = rgb(0,0,0)
btnUndo.bg = rgb(255,255,255)
btnUndo.t  = " UNDO "

btnPick.x = 700
btnPick.y = 144
btnPick.w = 8*7
btnPick.h = 16
btnPick.fg = rgb(0,0,0)
btnPick.bg = rgb(255,255,255)
btnPick.t  = " PICK "

btnMag.x = 700
btnMag.y = 174
btnMag.w = 8*8
btnMag.h = 16
btnMag.fg = rgb(0,0,0)
btnMag.bg = rgb(255,255,255)
btnMag.t  = "MAG ON"

btnShow.x = 700
btnShow.y = 206
btnShow.w = 8*11
btnShow.h = 16
btnShow.fg = rgb(0,0,0)
btnShow.bg = rgb(255,255,255)
btnShow.t  = "HIDE IMAGE "

btnGray.x = 700
btnGray.y = 238
btnGray.w = 8*11
btnGray.h = 16
btnGray.fg = rgb(0,0,0)
btnGray.bg = rgb(255,255,255)
btnGray.t  = "GRAY IMAGE "

btnPost.x = 700
btnPost.y = 270
btnPost.w = 8*11
btnPost.h = 16
btnPost.fg = rgb(0,0,0)
btnPost.bg = rgb(255,255,255)
btnPost.t  = "POSTERIZE "

btnInvert.x = 700
btnInvert.y = 302
btnInvert.w = 8*7
btnInvert.h = 16
btnInvert.fg = rgb(0,0,0)
btnInvert.bg = rgb(255,255,255)
btnInvert.t  = "INVERT"

btnLoad.x = 700
btnLoad.y = 334
btnLoad.w = 8*6
btnLoad.h = 16
btnLoad.fg = rgb(0,0,0)
btnLoad.bg = rgb(255,255,255)
btnLoad.t  = "COLOR"

btnGrid.x = 700
btnGrid.y = 366
btnGrid.w = 8*9
btnGrid.h = 16
btnGrid.fg = rgb(0,0,0)
btnGrid.bg = rgb(255,255,255)
btnGrid.t  = "GRID ON"

btnSave.x = 700
btnSave.y = 398
btnSave.w = 8*15
btnSave.h = 16
btnSave.fg = rgb(0,0,0)
btnSave.bg = rgb(255,255,255)
btnSave.t  = "SAVE AS BITMAP"

btnClear.x = 700
btnClear.y = 430
btnClear.w = 8*15
btnClear.h = 16
btnClear.fg = rgb(0,0,0)
btnClear.bg = rgb(255,255,255)
btnClear.t  = "CLEAR DRAWING"

dim shared as uinteger quarkColor(32,2)
dim as uinteger r,g,b
for j as integer = 0 to 1
    for i as integer = 0 to 31
        read r,g,b
        quarkColor(i,j)=rgb(r,g,b)
    next i
next j

sub grayImage()
    dim as uinteger v,r,g,b
    for j as integer = 0 to 479
        for i as integer = 0 to 639
            v = point(i,j,canvas1)
            r = v shr 16 and 255
            g = v shr 8 and 255
            b = v and 255
            v = (r+g+b)\3
            pset canvas1,(i,j),rgb(v,v,v)
        next i
    next j
end sub

sub posterizeImage()
    dim as uinteger v,r,g,b,mask
    mask = &HC0
    for j as integer = 0 to 479
        for i as integer = 0 to 639
            v = point(i,j,canvas1)
            r = v shr 16 and 255
            g = v shr 8 and 255
            b = v and 255
            r = r and mask
            g = g and mask
            b = b and mask
            pset canvas1,(i,j),rgb(r,g,b)
        next i
    next j
end sub
            
sub invertImage()
    dim as uinteger v,r,g,b
    for j as integer = 0 to 479
        for i as integer = 0 to 639
            v = point(i,j,canvas1)
            r = v shr 16 and 255
            g = v shr 8 and 255
            b = v and 255
            r = 255-r
            g = 255-g
            b = 255-b
            pset canvas1,(i,j),rgb(r,g,b)
        next i
    next j
end sub

Sub drawLine(canvas as any ptr,x1 as integer,y1 as integer,x2 as integer, y2 as integer,size as integer,c as uinteger)
    Dim As Integer ax, ay, d, dx, dy, x, y
    circle canvas,(x1,y1),size,c,,,,f
    If x1 = x2 And y1 = y2 Then Exit Sub
  
    If x1 = x2 Then
        x = x1
        if y2>y1 then
            For y as integer  = y1 To y2
                if size = 0 then
                    pset canvas,(x,y),c
                else
                    circle canvas,(x,y),size,c,,,,f
                end if
            Next y
        else
            for y as integer = y2 to y1
                if size = 0 then
                    pset canvas,(x,y),c
                else
                    circle canvas,(x,y),size,c,,,,f
                end if
            next y
        end if
      
    Elseif y1 = y2 Then
        y = y1
        if x2>x1 then
            For x as integer = x1 To x2
                if size = 0 then
                    pset canvas,(x,y),c
                else
                    circle canvas,(x,y),size,c,,,,f
                end if
            next x
        else
            for x as integer = x2 to x1
                if size = 0 then
                    pset canvas,(x,y),c
                else
                    circle canvas,(x,y),size,c,,,,f
                end if
            next x
        end if

    Else
        dx = x2 - x1
        dy = y2 - y1
        ax = 1
        ay = 1
    
        If dx < 0 Then
            dx = -dx
            ax = -1
        End If
    
        If dy < 0 Then
            dy = -dy
            ay = -1
        End If
    
        x = x1
        y = y1
    
        dim as integer ii
    
        If dx >= dy Then
            ii = dx + 1
            dy Shl= 1
            d = dy - dx
            dx Shl= 1
      
            While ii > 0
                ii -= 1
                if size = 0 then
                    pset canvas,(x,y),c
                else
                    circle canvas,(x,y),size,c,,,,f
                end if
        
                If d >= 0 Then
                    y += ay
                    d -= dx
                 End If
        
                 d += dy
                 x += ax
              Wend
          Else
              ii = dy + 1
              dx Shl= 1
              d = dx - dy
              dy Shl= 1
              While ii > 0
                  ii -= 1
                if size = 0 then
                    pset canvas,(x,y),c
                else
                    circle canvas,(x,y),size,c,,,,f
                end if
        
                  If d >= 0 Then
                      x += ax
                      d -= dy
                  End If
        
                  d += dx
                  y += ay
              Wend
          End If
    End If
End Sub

sub DrawIt()
    dim as integer prevX1,prevY1,penSize
    dim as uinteger color1,color2
    color1 = rgb(0,0,0)
    color2 = rgb(255,255,255)
    
    penSize = 0 'default draw one pixel wide
    line canvas2,(0,0)-(640,480),rgb(255,0,255),bf  'clear canvas2
    prevX1 = 0
    prevY1 = 0
    if cmdCount<>0 then
        for i as integer = 0 to cmdCount-1
            if cmd(i)="M" then
                prevX1 = px(i)
                prevY1 = py(i)
            end if
            if cmd(i)="D" then
                'line canvas2,(prevX1,prevY1)-(px(i),py(i)),rgb(0,0,0)
                drawLine(canvas2,prevX1,prevY1,px(i),py(i),penSize,rgb(0,0,0))
                prevX1 = px(i)
                prevY1 = py(i)
            end if
            if cmd(i)="P" then
                paint canvas2,(px(i),py(i)),color2,rgb(0,0,0)
            end if
            if cmd(i)="L" then
                penSize = px(i)
            end if
            if cmd(i)="C" then
                color1 = px(i)
                color2 = py(i)
            end if
        next i
    end if
end sub

sub update()
    screenlock()
    cls
    
    put (0,0),canvas3,pset            'display image
    
    line (0,0)-(639,479),rgb(0,0,0),b  'border the image
    
    'magnify around mouse position
    if mag = 1 then
        for j as integer = -15 to 15
            for i as integer = -15 to 15
                line (i*3+mx,j*3+my)-(i*3+2+mx,j*3+2+my),point(i+mx,j+my,canvas3),bf
            next i
        next j
    end if
    
    if grid = 1 then
        for j as integer = 0 to 479 step 32
            for i as integer = 0 to 639 step 32
                line (i,j)-(i+32,j+32),rgb(200,200,200),b
            next i
        next j
    end if
    
    drawButton(btnDraw)
    drawButton(btnFill)
    drawButton(btnUndo)
    drawButton(btnPick)
    drawButton(btnMag)
    drawButton(btnShow)
    drawButton(btnGray)
    drawButton(btnPost)
    drawButton(btnInvert)
    drawButton(btnLoad)
    drawButton(btnGrid)
    drawButton(btnSave)
    drawButton(btnClear)
    
    'display color palette
    for j as integer = 0 to 1
        for i as integer = 0 to 31
            line (i*16,j*16+500)-(i*16+16,j*16+516),quarkColor(i,j),bf
            line (i*16,j*16+500)-(i*16+16,j*16+516),rgb(0,0,0),b
        next i
    next j
    'display selected paint colors
    line (524,500)-(580,532),color2,bf
    line (582,500)-(640,532),color1,bf
    line (524,500)-(580,532),rgb(0,0,0),b
    line (582,500)-(640,532),rgb(0,0,0),b
    draw string (530,540),"color2"
    draw string (588,540),"color1"
    
    if drawMode = 0 then
        if pen = 0 then
            getmouse mx,my,,mb
            line (mx,my-17)-(mx+8*14,my-7),rgb(255,255,255),bf
            draw string (mx,my-16),"NEW LINE"
        end if
        line (btnDraw.x,btnDraw.y)-(btnDraw.x+btnDraw.w,btnDraw.y+btnDraw.h),rgb(255,0,0),b
    end if
    if drawMode = 1 then
        line (btnFill.x,btnFill.y)-(btnFill.x+btnFill.w,btnFill.y+btnFill.h),rgb(255,0,0),b
        line (mx,my-17)-(mx+8*4,my-7),rgb(255,255,255),bf
        draw string (mx,my-16),"FILL COLOR"
    end if
    if drawMode = 2 then
        line (btnPick.x,btnPick.y)-(btnPick.x+btnPick.w,btnPick.y+btnPick.h),rgb(255,0,0),b
        line (mx,my-17)-(mx+8*4,my-7),rgb(255,255,255),bf
        draw string (mx,my-16),"PICK COLOR"
    end if    
    
    draw string (700,24),"PEN SIZE = " & str(penSize+1)
    
    draw string (642,4),"Change pen size with number keys 1-8"
    screenunlock()
    
end sub

dim as string key

loadImage()

cmdCount = 0
Dim As Integer myHandle
myHandle = FreeFile ()
Open "Edit.dat" For Input As #myHandle
if Lof(myHandle)<>0 then
    Do Until Eof(myHandle)
        Input #myHandle, cmd(cmdCount),px(cmdCount),py(cmdCount)
        cmdCount = cmdCount + 1
    Loop
end if
Close #myHandle

do
    key = inkey
    if key > "0" and key < "9" then
        penSize = asc(key)-49
        cmd(cmdCount)="L"
        px(cmdCount)=penSize
        cmdCount = cmdCount + 1
        pen = 0  'new line for new size
    end if
    
    getmouse mx,my,,mb
    if mb = 2 then
        pen = 0      'PEN UP    
        while mb=2
            getmouse mx,my,,mb
        wend
    end if
    
    if mb = 1 then
        'is it over drawing area?
        if mx<640 and my<480 then
            if drawMode = 0 then
                if pen = 1 then
                    cmd(cmdCount)="D"
                else
                    cmd(cmdCount)="M"
                end if
        
                px(cmdCount)=mx
                py(cmdCount)=my
                cmdCount = cmdCount+1
        
                prevX = mx
                prevY = my
                pen = 1
            end if
        
            if drawMode = 1 then
                cmd(cmdCount)="P"
                px(cmdCount)= mx
                py(cmdCount)= my
                cmdCount = cmdCount + 1
            end if
            
            if drawMode = 2 then
                color2 = point(mx,my)
                cmd(cmdCount)="C"
                px(cmdCount)=color1
                py(cmdCount)=color2
                cmdCount = cmdCount + 1
                drawMode = 1
            end if
            
        end if
        
        'is it over palette?
        if mx<512 and my>500 and my<532 then
            if mb=1 then
                color2 = point(mx,my)
                cmd(cmdCount)="C"
                px(cmdCount)=color1
                py(cmdCount)=color2
                cmdCount = cmdCount + 1
            end if
        end if
        
        'is it over draw button?
        if mx>btnDraw.x and mx<btnDraw.x+btnDraw.w and my>btnDraw.y and my<btnDraw.y+btnDraw.h then
            drawMode = 0
            pen = 0        'start new lines
        end if
        
        'is it over fill button?
        if mx>btnFill.x and mx<btnFill.x+btnFill.w and my>btnFill.y and my<btnFill.y+btnFill.h then
            drawMode = 1
        end if

        'is it over undo button?
        if mx>btnUndo.x and mx<btnUndo.x+btnUndo.w and my>btnUndo.y and my<btnUndo.y+btnUndo.h then
            if cmdCount > 0 then
                cmdCount = cmdCount-1
            end if
            if cmdCount < 2 then
                pen = 0
            end if
        end if
        
        'is it over pick button?
        if mx>btnPick.x and mx<btnPick.x+btnPick.w and my>btnPick.y and my<btnPick.y+btnPick.h then
            drawMode = 2
        end if
        
        'is it over magnification button?
        if mx>btnMag.x and mx<btnMag.x+btnMag.w and my>btnMag.y and my<btnMag.y+btnMag.h then
            if mag = 0 then
                mag = 1
                btnMag.t = "MAG ON"
            else
                mag = 0
                btnMag.t = "MAG OFF"
            end if
        end if
        
        'is it over show/hide image button?
        if mx>btnShow.x and mx<btnShow.x+btnShow.w and my>btnShow.y and my<btnShow.y+btnShow.h then
            if showHideImage = 0 then
                showHideImage = 1
                btnShow.t = "HIDE IMAGE"
            else
                showHideImage = 0
                btnShow.t = "SHOW IMAGE"
            end if
        end if

        'is it over gray image button?
        if mx>btnGray.x and mx<btnGray.x+btnGray.w and my>btnGray.y and my<btnGray.y+btnGray.h then
            grayImage()
        end if
        
        'is it over posterize image button?
        if mx>btnPost.x and mx<btnPost.x+btnPost.w and my>btnPost.y and my<btnPost.y+btnPost.h then
            posterizeImage()
        end if 
        
        'is it over invert image button?
        if mx>btnInvert.x and mx<btnInvert.x+btnInvert.w and my>btnInvert.y and my<btnInvert.y+btnInvert.h then
            invertImage()
        end if 
        
        'is it over reload image button
        if mx>btnLoad.x and mx<btnLoad.x+btnLoad.w and my>btnLoad.y and my<btnLoad.y+btnLoad.h then
            LoadImage()
        end if 
        
        'is it over grid button?
        if mx>btnGrid.x and mx<btnGrid.x+btnGrid.w and my>btnGrid.y and my<btnGrid.y+btnGrid.h then
            if grid = 0 then
                grid = 1
                btnGrid.t = "GRID OFF"
            else
                grid = 0
                btnGrid.t = "GRID ON"
            end if
        end if

        'is it over save drawing as bitmap button
        if mx>btnSave.x and mx<btnSave.x+btnSave.w and my>btnSave.y and my<btnSave.y+btnSave.h then
            bsave "Drawing.bmp",canvas2
        end if 
        
        'is it over clear drawing button
        if mx>btnClear.x and mx<btnClear.x+btnClear.w and my>btnClear.y and my<btnClear.y+btnClear.h then
            cmdCount = 0
        end if 
        
        while mb=1
            getmouse mx,my,,mb
        wend 


    end if
    
    drawIt()  'draw onto canvas2
    
    if showHideImage = 1 then
        put canvas3,(0,0),canvas1,pset    'restore image
    else
        line canvas3,(0,0)-(639,479),rgb(255,255,255),bf
    end if
    
    put canvas3,(0,0),canvas2,trans   'overlay image
    
    update()
    
    sleep 2
    
loop until multikey(&H01)

imagedestroy(canvas3)
imagedestroy(canvas2)
imagedestroy(canvas1)

'convert to data statements save as .bas file
dim as integer count
if cmdCount<>0 then
    open "DrawTracing.bas" for output as #1
    
    'source code to draw using data statements
    print #1, " screenres 640,480,32"
    print #1, " color rgb(0,0,0),rgb(255,255,255):cls"
    print #1, " "
    print #1, " Sub drawLine(x1 as integer,y1 as integer,x2 as integer, y2 as integer,size as integer,c as uinteger)"
    print #1, "     Dim As Integer ax, ay, d, dx, dy, x, y"
    print #1, "     circle (x1,y1),size,c,,,,f"
    print #1, "     If x1 = x2 And y1 = y2 Then Exit Sub"
    print #1, "  "
    print #1, "     If x1 = x2 Then"
    print #1, "         x = x1"
    print #1, "         if y2>y1 then"
    print #1, "             For y as integer  = y1 To y2"
    print #1, "                 circle (x,y),size,c,,,,f"
    print #1, "             Next y"
    print #1, "         else"
    print #1, "             for y as integer = y2 to y1"
    print #1, "                 circle (x,y),size,c,,,,f"
    print #1, "             next y"
    print #1, "         end if"
    print #1, "      "
    print #1, "     Elseif y1 = y2 Then"
    print #1, "         y = y1"
    print #1, "         if x2>x1 then"
    print #1, "             For x as integer = x1 To x2"
    print #1, "                 circle (x,y),size,c,,,,f"
    print #1, "             next x"
    print #1, "         else"
    print #1, "             for x as integer = x2 to x1"
    print #1, "                 circle (x,y),size,c,,,,f"
    print #1, "             next x"
    print #1, "         end if"
    print #1, " "
    print #1, "     Else"
    print #1, "         dx = x2 - x1"
    print #1, "         dy = y2 - y1"
    print #1, "         ax = 1"
    print #1, "         ay = 1"
    print #1, "    "
    print #1, "         If dx < 0 Then"
    print #1, "             dx = -dx"
    print #1, "             ax = -1"
    print #1, "         End If"
    print #1, "    "
    print #1, "         If dy < 0 Then"
    print #1, "             dy = -dy"
    print #1, "             ay = -1"
    print #1, "         End If"
    print #1, "    "
    print #1, "         x = x1"
    print #1, "         y = y1"
    print #1, "    "
    print #1, "         dim as integer ii"
    print #1, "    "
    print #1, "         If dx >= dy Then"
    print #1, "             ii = dx + 1"
    print #1, "             dy Shl= 1"
    print #1, "             d = dy - dx"
    print #1, "             dx Shl= 1"
    print #1, "      "
    print #1, "             While ii > 0"
    print #1, "                 ii -= 1"
    print #1, "                 circle (x,y),size,c,,,,f"
    print #1, "        "
    print #1, "                 If d >= 0 Then"
    print #1, "                     y += ay"
    print #1, "                     d -= dx"
    print #1, "                  End If"
    print #1, "        "
    print #1, "                  d += dy"
    print #1, "                  x += ax"
    print #1, "               Wend"
    print #1, "           Else"
    print #1, "               ii = dy + 1"
    print #1, "               dx Shl= 1"
    print #1, "               d = dx - dy"
    print #1, "               dy Shl= 1"
    print #1, "               While ii > 0"
    print #1, "                   ii -= 1"
    print #1, "                   circle (x,y),size,c,,,,f"
    print #1, "        "
    print #1, "                   If d >= 0 Then"
    print #1, "                       x += ax"
    print #1, "                       d -= dy"
    print #1, "                   End If"
    print #1, "        "
    print #1, "                   d += dx"
    print #1, "                   y += ay"
    print #1, "               Wend"
    print #1, "           End If"
    print #1, "     End If"
    print #1, " End Sub"
    print #1, " "
    print #1, " dim shared as integer cmdCount"
    print #1, " read cmdCount"
    print #1, " dim shared as string  cmd(cmdCount)"
    print #1, " dim shared as integer px(cmdCount),py(cmdCount)"
    print #1, " "
    print #1, " sub DrawIt()"
    print #1, "     dim as integer prevX1,prevY1,penSize"
    print #1, "     dim as uinteger color1,color2"
    print #1, "     color1 = rgb(0,0,0)"
    print #1, "     color2 = rgb(255,255,255)"
    print #1, "    "
    print #1, "     penSize = 1 'default"
    print #1, "     'line canvas2,(0,0)-(640,480),rgb(255,0,255),bf  'clear canvas2"
    print #1, "     prevX1 = 0"
    print #1, "     prevY1 = 0"
    print #1, "     if cmdCount<>0 then"
    print #1, "         for i as integer = 0 to cmdCount-1"
    print #1, "             if cmd(i)=chr(77) then"
    print #1, "                 prevX1 = px(i)"
    print #1, "                 prevY1 = py(i)"
    print #1, "             end if"
    print #1, "             if cmd(i)=chr(68) then"
    print #1, "                 'line canvas2,(prevX1,prevY1)-(px(i),py(i)),rgb(0,0,0)"
    print #1, "                 drawLine(prevX1,prevY1,px(i),py(i),penSize,rgb(0,0,0))"
    print #1, "                 prevX1 = px(i)"
    print #1, "                 prevY1 = py(i)"
    print #1, "             end if"
    print #1, "             if cmd(i)=chr(80) then"
    print #1, "                 paint (px(i),py(i)),color2,rgb(0,0,0)"
    print #1, "             end if"
    print #1, "             if cmd(i)=chr(76) then"
    print #1, "                 penSize = px(i)"
    print #1, "             end if"
    print #1, "             if cmd(i)=chr(67) then"
    print #1, "                 color1 = px(i)"
    print #1, "                 color2 = py(i)"
    print #1, "             end if"
    print #1, "             sleep 10"
    print #1, "         next i"
    print #1, "     end if"
    print #1, " end sub"
    print #1, " "
    print #1, " 'READ DATA FOR DRAWIT"
    print #1, " "
    print #1, " for i as integer = 0 to cmdCount-1"
    print #1, "     read cmd(i),px(i),py(i)"
    print #1, " next i"
    print #1, " "
    print #1, " DrawIt()"
    print #1, " "
    print #1, " sleep"


    '==========================================
        print #1, "DATA " & str(cmdCount)
        print #1, "DATA ";
    for i as integer = 0 to cmdCount-2
            print #1, chr(34) & cmd(i) & chr(34) & "," & str(px(i)) & "," & str(py(i));
        count = count + 1
        if count < 6 then
                print #1, ",";
        else
                print #1,
                print #1, "DATA ";
            count = 0
        end if    
    next i
        print #1, chr(34) & cmd(cmdCount-1) & chr(34) & "," & str(px(cmdCount-1)) & "," & str(py(cmdCount-1))

        print #1,
    close #1
end if

'save any drawing for future editing

open "Edit.dat" for output as #1
for i as integer = 0 to cmdCount-1
    write #1, cmd(i),px(i),py(i)
next i
close #1


'QUARK PALETTE SET
ColorData:
'red
Data 60,0,0
Data 94,22,22
Data 125,8,8
Data 170,40,40
Data 255,35,35
Data 255,84,84
Data 255,130,130
Data 255,177,177
'yellow
Data 35,35,0
Data 60,60,3
Data 90,90,14
Data 145,145,20
Data 230,230,15
Data 245,245,100
Data 255,255,152
Data 255,255,190
'green
Data 0,40,0
Data 18,65,18
Data 20,95,20
Data 43,150,58
Data 75,220,110
Data 145,245,145
Data 184,255,184
Data 205,255,205
'cyan
Data 2,38,38
Data 20,55,55
Data 40,90,90
Data 68,135,135
Data 90,195,195
Data 115,220,220
Data 170,243,243
Data 205,255,255
'blue
Data 2,27,53
Data 12,38,78
Data 10,60,120
Data 45,100,200
Data 60,120,240
Data 75,145,245
Data 70,205,255
Data 130,235,255
'purple
Data 39,15,39
Data 60,20,60
Data 95,35,95
Data 156,65,156
Data 215,45,215
Data 248,90,248
Data 255,135,255
Data 255,185,255
'orange
Data 42,13,1
Data 65,20,14
Data 90,45,10
Data 170,85,42
Data 230,123,20
Data 250,170,55
Data 255,205,95
Data 255,225,160
'gray
Data 1,1,1
Data 25,25,25
Data 55,55,55
Data 95,95,95
Data 128,128,128
Data 160,160,160
Data 200,200,200
Data 255,255,255

DrawTracing.bas

Code: Select all

screenres 640,480,32
color rgb(0,0,0),rgb(255,255,255):cls

Sub drawLine(x1 as integer,y1 as integer,x2 as integer, y2 as integer,size as integer,c as uinteger)
    Dim As Integer ax, ay, d, dx, dy, x, y
    circle (x1,y1),size,c,,,,f
    If x1 = x2 And y1 = y2 Then Exit Sub
 
    If x1 = x2 Then
        x = x1
        if y2>y1 then
            For y as integer  = y1 To y2
                circle (x,y),size,c,,,,f
            Next y
        else
            for y as integer = y2 to y1
                circle (x,y),size,c,,,,f
            next y
        end if
     
    Elseif y1 = y2 Then
        y = y1
        if x2>x1 then
            For x as integer = x1 To x2
                circle (x,y),size,c,,,,f
            next x
        else
            for x as integer = x2 to x1
                circle (x,y),size,c,,,,f
            next x
        end if

    Else
        dx = x2 - x1
        dy = y2 - y1
        ax = 1
        ay = 1
   
        If dx < 0 Then
            dx = -dx
            ax = -1
        End If
   
        If dy < 0 Then
            dy = -dy
            ay = -1
        End If
   
        x = x1
        y = y1
   
        dim as integer ii
   
        If dx >= dy Then
            ii = dx + 1
            dy Shl= 1
            d = dy - dx
            dx Shl= 1
     
            While ii > 0
                ii -= 1
                circle (x,y),size,c,,,,f
       
                If d >= 0 Then
                    y += ay
                    d -= dx
                 End If
       
                 d += dy
                 x += ax
              Wend
          Else
              ii = dy + 1
              dx Shl= 1
              d = dx - dy
              dy Shl= 1
              While ii > 0
                  ii -= 1
                  circle (x,y),size,c,,,,f
       
                  If d >= 0 Then
                      x += ax
                      d -= dy
                  End If
       
                  d += dx
                  y += ay
              Wend
          End If
    End If
End Sub

dim shared as integer cmdCount
read cmdCount
dim shared as string  cmd(cmdCount)
dim shared as integer px(cmdCount),py(cmdCount)

sub DrawIt()
    dim as integer prevX1,prevY1,penSize
    dim as uinteger color1,color2
    color1 = rgb(0,0,0)
    color2 = rgb(255,255,255)
   
    penSize = 1 'default
    'line canvas2,(0,0)-(640,480),rgb(255,0,255),bf  'clear canvas2
    prevX1 = 0
    prevY1 = 0
    if cmdCount<>0 then
        for i as integer = 0 to cmdCount-1
            if cmd(i)="M" then
                prevX1 = px(i)
                prevY1 = py(i)
            end if
            if cmd(i)="D" then
                'line canvas2,(prevX1,prevY1)-(px(i),py(i)),rgb(0,0,0)
                drawLine(prevX1,prevY1,px(i),py(i),penSize,rgb(0,0,0))
                prevX1 = px(i)
                prevY1 = py(i)
            end if
            if cmd(i)="P" then
                paint (px(i),py(i)),color2,rgb(0,0,0)
            end if
            if cmd(i)="L" then
                penSize = px(i)
            end if
            if cmd(i)="C" then
                color1 = px(i)
                color2 = py(i)
            end if
            sleep 10
        next i
    end if
end sub

'READ DATA FOR DRAWIT

for i as integer = 0 to cmdCount-1
    read cmd(i),px(i),py(i)
next i

DrawIt()

sleep

DATA 124
DATA "L",2,160,"M",264,73,"D",295,63,"D",315,60,"D",330,64,"D",340,73
DATA "D",350,86,"D",358,106,"D",367,130,"D",376,155,"D",386,193,"D",391,224
DATA "D",390,246,"D",388,264,"D",383,261,"D",372,261,"D",374,272,"D",364,279
DATA "D",346,276,"D",327,285,"D",320,284,"D",311,278,"D",291,248,"D",275,196
DATA "D",273,155,"D",284,127,"D",293,114,"D",287,96,"D",264,74,"M",285,124
DATA "D",314,127,"D",323,118,"D",330,91,"D",341,73,"M",301,63,"D",289,84
DATA "D",287,95,"M",352,99,"D",338,111,"D",341,129,"D",347,140,"D",369,143
DATA "M",346,138,"D",319,135,"D",310,134,"D",291,135,"D",282,131,"M",379,171
DATA "D",365,197,"D",348,205,"D",325,210,"D",298,215,"D",277,202,"M",266,328
DATA "D",425,248,"D",433,275,"D",273,354,"D",267,326,"M",324,285,"D",335,293
DATA "M",351,316,"D",359,338,"D",368,334,"D",377,335,"D",377,302,"M",316,279
DATA "L",4,306,"M",314,278,"L",2,282,"M",314,278,"D",313,288,"D",302,297
DATA "D",296,309,"D",291,322,"D",291,342,"D",305,356,"D",294,337,"D",292,313
DATA "D",307,297,"D",319,284,"D",303,304,"D",308,320,"D",318,331,"M",376,265
DATA "D",376,281,"D",378,297,"M",380,260,"D",381,270,"D",384,287,"D",388,305
DATA "M",386,262,"D",388,277,"D",390,289,"M",304,84,"D",310,83,"D",313,87
DATA "D",310,93,"D",302,91,"D",299,86,"D",302,84,"D",308,87,"C",-16777216,-276301
DATA "P",281,73,"C",-16777216,-1284601,"P",331,74,"C",-16777216,-11749182,"P",343,97,"C",-16777216,-9268472
DATA "P",355,115,"C",-16777216,-9020790,"P",336,170,"C",-16777216,-1600253,"P",352,224,"C",-16777216,-7243461
DATA "P",340,282,"P",364,318,"C",-16777216,-2373588,"P",408,273,"P",370,286,"P",301,324
DATA "P",275,331,"C",-16777216,-11805586,"C",-16777216,-12560883,"P",435,392

Quick trace as an example:

srvaldez · Post by **srvaldez** » Dec 01, 2020 11:53

thanks BasicCoder2
you can use a file requester, place the requester code at top of tracer.bas

Code: Select all

#Include Once "windows.bi"
#Include Once "win\commdlg.bi"

'#define unicode

Function ChooseFile(Byval FileName As wstring Ptr) As Long
   Dim As OPENFILENAMEW ofn
   memset(@ofn, 0, Sizeof(ofn))
   ofn.lStructSize = Sizeof(ofn)
   ofn.hwndOwner = NULL
   ofn.hInstance = NULL
   ofn.lpstrFilter = @!"Bitmap Files\0*.bmp\0\0"
   ofn.lpstrFile = FileName
   ofn.nMaxFile = MAX_PATH
   ofn.lpstrTitle = @"Please Select A File To Open"
   ofn.Flags = ofn.Flags = OFN_NONETWORKBUTTON Or OFN_FILEMUSTEXIST Or OFN_FORCESHOWHIDDEN Or OFN_HIDEREADONLY
   If GetOpenFileNameW(@ofn) = 0 Then
      Return 0
   End If
   Return 1
End Function

and change

Code: Select all

sub loadImage()
    bload "finches.bmp",canvas1
end sub

to

Code: Select all

sub loadImage_()
	Dim As wstring Ptr fname=Callocate(1024)
	If ChooseFile(fname) Then
		bload *fname,canvas1
	end if
	Deallocate(fname)
end sub

you need to change all occurrences of loadImage to loadImage_, apparently loadImage is defined in one of the includes
<edit> you need to save the source with a BOM https://en.wikipedia.org/wiki/Byte_order_mark

srvaldez · Post by **srvaldez** » Dec 01, 2020 13:22

@BasicCoder2
you could get the dimension of the bitmap like this

Code: Select all

Dim As wstring Ptr fname=Callocate(1024)
dim as ulong W, H
If ChooseFile(fname) Then
	open *fname for binary as 1
	Get #1,19 , W
	Get #1,23 , H
	close 1
end if

you could then setup the canvas like this
canvas1 = imagecreate(W,H,rgb(255,0,255))
and change sub loadImage_ to

Code: Select all

sub loadImage_(byval fname as wstring Ptr)
	bload *fname,canvas1
end sub

and deallocate fname after imagedestroy(canvas1)

Code: Select all

Deallocate(fname)

of course you would then have to adjust your main form, this are only ideas

Dr_D · Post by **Dr_D** » Dec 06, 2020 5:42

This is pretty cool man. :)

BasicCoder2 · Post by **BasicCoder2** » Dec 06, 2020 5:52

@Dr_D
The tracer or srvaldez's suggestions?
In fact I have found more advanced versions which I had forgotten about ( it was 6 years ago I last played with this stuff) which can handle any sized image and can load a list of the images in the folder from which the user can select one using the mouse. I had moved onto other ideas using Bezier curves and ovals (circles for eyes or wheels) to make better line drawings from an image. These vector drawings could then be rotated or resized by another program.

Dr_D · Post by **Dr_D** » Dec 06, 2020 6:11

BasicCoder2 wrote:@Dr_D
The tracer or srvaldez's suggestions?
In fact I have found more advanced versions which I had forgotten about ( it was 6 years ago I last played with this stuff) which can handle any sized image and can load a list of the images in the folder from which the user can select one using the mouse. I had moved onto other ideas using Bezier curves and ovals (circles for eyes or wheels) to make better line drawings from an image. These vector drawings could then be rotated or resized by another program.

I just think the whole thing is cool man. It's fun to play around with, and I just think the results look cool. I can't draw for crap, but with this tracing I could fake it. lol

BasicCoder2 · Post by **BasicCoder2** » Dec 06, 2020 11:14

Dr_D wrote:I can't draw for crap, but with this tracing I could fake it. lol

Tracing is a perfectly legitimate way to learn to draw.

After a while you develop a motor memory (a kinetic melody) and drawing a 2D face becomes as easy as drawing your signature.

You can also trace frames from a video to make animated drawings.

In fact I have been motivated to work on an easier to use version which I will post if I feel it has reached a useful stage of development.

Tracer revisited

Tracer revisited

Re: Tracer revisited

Re: Tracer revisited

Re: Tracer revisited

Re: Tracer revisited

Re: Tracer revisited

Re: Tracer revisited