sync on : sync rate 0
 
type xy
 
    x as integer
    y as integer
 
endtype
 
type track
 
    start as xy
    finish as xy
    speed as boolean
    slow as boolean
    oneway as boolean
 
endtype
 
dim lines(-1) as track
linen = -1
 
#constant grav 0.05
#constant PRad 6
 
do
 
    if (abs(newx-oldx) > 5 or abs(newy-oldy) > 5) and shiftkey() = 0
        oldx = newx
        oldy = newy
    endif
    newx = mousex()
    newy = mousey()
    msc = mouseclick()
    msmx = mousemovex()
    msmy = mousemovey()
 
    if mode
        ink rgb(255,255,0),0
        circle newx,newy,PRad
    endif
 
    if msc = 1
        if mode
            for n = 0 to linen
                if Line_Intersect_Circle(lines(n).start.x,lines(n).start.y,lines(n).finish.x,lines(n).finish.y,newx-xoffset,newy-yoffset,PRad)
                    array delete element lines(n),n
                    dec linen
                    dec n
                endif
            next n
        else
            array insert at top lines(0)
            inc linen
            if controlkey()
                lines(0).finish.x = oldx-xoffset
                lines(0).finish.y = oldy-yoffset
                lines(0).start.x = newx-xoffset
                lines(0).start.y = newy-yoffset
            else
                lines(0).start.x = oldx-xoffset
                lines(0).start.y = oldy-yoffset
                lines(0).finish.x = newx-xoffset
                lines(0).finish.y = newy-yoffset
            endif
            select tool
                case 1
                    lines(0).oneway = 1
                endcase
                case 2
                    lines(0).speed = 1
                endcase
                case 3
                    lines(0).slow = 1
                endcase
            endselect
            oldx = newx
            oldy = newy
        endif
    endif
 
    if msc = 2
        inc xoffset,msmx
        inc yoffset,msmy
    endif
 
    for n = 0 to linen
        curcol = rgb(64,128,255)
        if lines(n).oneway
            curcol = rgb(255,0,0)
        endif
        if lines(n).speed
            curcol = rgb(0,255,0)
        endif
        if lines(n).slow
            curcol = rgb(255,255,0)
        endif
        ink curcol,0
        ang = int((wrapvalue(atanfull(lines(n).finish.x-lines(n).start.x,lines(n).finish.y-lines(n).start.y)+45))/90)
        if ang = 4 then ang = 0
        if ang = 0 then xo = -1 : yo = 0
        if ang = 1 then xo = 0 : yo = 1
        if ang = 2 then xo = 1 : yo = 0
        if ang = 3 then xo = 0 : yo = -1
        line lines(n).start.x+xoffset+xo,lines(n).start.y+yoffset+yo,lines(n).finish.x+xoffset+xo,lines(n).finish.y+yoffset+yo
        line lines(n).start.x+xoffset+xo*2,lines(n).start.y+yoffset+yo*2,lines(n).finish.x+xoffset+xo*2,lines(n).finish.y+yoffset+yo*2
    next n
 
    ink rgb(255,255,255),0
    for n = 0 to linen
        line lines(n).start.x+xoffset,lines(n).start.y+yoffset,lines(n).finish.x+xoffset,lines(n).finish.y+yoffset
    next n
 
    ink rgb(255,0,0),0
    circle startx+xoffset,starty+yoffset,6
    text startx+xoffset-3,starty+yoffset-7,"S"
 
    text 0,0,"Press 's' to position the starting point at the mouse position."
    text 0,18,"Press 'e' to toggle the erasor on and off."
    text 0,36,"Press '1','2','3' or '4' for: Normal, One-way, Speed up and Slow down lines."
    text 0,54,"Press shift when mouse is at start of line, and click when mouse is at the end of the line"
    text 0,72,"to draw straight lines. Keep shift held down to produce a series of straight lines."
    text 0,90,"Hold control while drawing to invert line."
    text 0,108,"R-click and drag to scroll around. L-Click draws."
    text 0,126,"Press 'p' to play."
 
    sync
 
    if inkey$() = "e"
        mode = (not mode)
        repeat
            sync
        until inkey$() = ""
    endif
 
    if inkey$() = "1"
        tool = 0
    endif
    if inkey$() = "2"
        tool = 1
    endif
    if inkey$() = "3"
        tool = 2
    endif
    if inkey$() = "4"
        tool = 3
    endif
 
    cls 0
 
    if inkey$() = "p"
        gosub play
    endif
 
    if inkey$() = "s"
        startx = newx-xoffset
        starty = newy-yoffset
    endif
 
loop
 
play:
 
repeat
    sync
until inkey$() = ""
 
xpos# = startx
ypos# = starty
 
do
 
    start = timer()
 
    ink rgb(255,255,255),0
    for n = 0 to linen
        line lines(n).start.x-xpos#+512,lines(n).start.y-ypos#+384,lines(n).finish.x-xpos#+512,lines(n).finish.y-ypos#+384
    next n
 
    text 0,0,str$(screen fps())
 
    ink rgb(0,255,255),0
`    circle xpos#+xpos#,ypos#+ypos#,PRad
    circle 512,384,PRad
 
    rem PHYSICS
    inc ymo#,grav
    oldxp# = xpos#
    oldyp# = ypos#
 
    phys = int(sqrt(xmo#*xmo#+ymo#*ymo#)/10)+1
    fraction# = 1.0/phys
 
    for phy = 1 to phys
        inc xpos#,xmo#*fraction#
        inc ypos#,ymo#*fraction#
        for n = 0 to linen
            if Line_Intersect_Circle(lines(n).start.x,lines(n).start.y,lines(n).finish.x,lines(n).finish.y,xpos#,ypos#,PRad)
                ang# = atanfull(lines(n).finish.x-lines(n).start.x,lines(n).finish.y-lines(n).start.y)
                if lines(n).oneway
                    inc xpos#,sin(ang#)*0.8
                    inc ypos#,cos(ang#)*0.8
                endif
                if lines(n).speed
                    inc xpos#,xmo#*0.2
                    inc ypos#,ymo#*0.2
                endif
                if lines(n).slow
                    dec xpos#,xmo#*0.2
                    dec ypos#,ymo#*0.2
                endif
                xoff# = sin(ang#-90)
                yoff# = cos(ang#-90)
     `           yoff# = abs(yoff#)
                repeat
                    dec xpos#,xoff#
                    dec ypos#,yoff#
                until Line_Intersect_Circle(lines(n).start.x,lines(n).start.y,lines(n).finish.x,lines(n).finish.y,xpos#,ypos#,PRad) = 0
            endif
        next n
    next phy
    xmo# = (xpos#-oldxp#)*0.997
    ymo# = (ypos#-oldyp#)*0.997
    rem Its safe to read again now!!!
 
    text 0,0,"Press 'p' to pause."
    text 0,18,"Press 'q' to return to editor."
 
    sync
 
    if inkey$() = "p"
        repeat
            sync
        until inkey$() = ""
        repeat
            sync
        until inkey$() = "p"
        repeat
            sync
        until inkey$() = ""
    endif
 
    cls 0
 
    if inkey$() = "q"
        xmo# = 0
        ymo# = 0
        exit
    endif
 
    while timer() < start+10
    endwhile
 
loop
 
return
 
Function Line_Intersect_Circle(x1#,y1#,x2#,y2#,cx#,cy#,Radius#)
 
      ` Calc Closest Point to circle center
 
       dx31#=cx#-x1#
      dx21#=x2#-x1#
 
      dy31#=cy#-y1#
        dy21#=y2#-y1#
 
      d#=((dx21#*dx21#)+(dy21#*dy21#))
 
      if d#<>0 then  d#=((dx31#*dx21#)+(dy31#*dy21#))/d#
 
      ` Clip to the line segments legal bounds
      if d#<0.0 then d#=0
      if d#>1.0 then d#=1
 
         dx#=cx#-(x1#+(dx21#*d#))
         dy#=cy#-(y1#+(dy21#*d#))
         if Radius#=>sqrt((dx#*dx#)+(dy#*dy#))
               ` Line intersects circle
               exitfunction 1
         endif
EndFunction 0