mousetrak

Game development specific discussions.
Post Reply
pr1mezr0
Posts: 6
Joined: Mar 16, 2023 2:42

mousetrak

Post by pr1mezr0 »

I posted this 2d racing game in 2006 but I'm necro-ing it because I recently updated it to be more user friendly and with gears and player ghosts.

You have to lay a track first and when you race it use the mouse buttons to change gear.
It creates directories and files in the exepath.

Code: Select all

const driver_t=32
const traklen=500
const pi = 3.1415926535859

type poz_type
    as integer x,y
    as single angle,mag
    as integer diameter
end type

type roadwriter_type
    as poz_type poz(traklen)
    as integer breadth
end type

type mouse_type
    as integer x, y,b,w
end type

type screen_type
    as integer x,y,hx,hy
end type

type storepos_type
    as integer x,y,b
end type

type driver_type
    as integer x,y,oldx,oldy,oldx2,oldy2, cp, storepos, klicker
    as uinteger cols(1 to 5)
    as single gearratio(5), wheelspin, angle, mag, actualmag
    as storepos_type store_pos(8000)
    as ubyte position, gear
end type

dim as roadwriter_type roadwriter
dim as mouse_type mouse
dim as screen_type scr
dim shared as driver_type driver(driver_t) 

dim as integer poz_n

dim as integer f

dim as ubyte tracks_t 
dim as ubyte driver_c, drivers

dim as single start, best
dim as byte quit

dim as ubyte traknum

dim as string pilot , filename, pathname

declare sub load_track (byref tracks_t as ubyte, f as integer, byref traknum as ubyte, filename as string, pathname as string, mouse as mouse_type, byref drivers as ubyte, byref poz_n as integer, roadwriter as roadwriter_type, scr as screen_type, byref quit as byte, byref best as single)
declare sub deletetrack (byref tracks_t as ubyte, f as integer, byref traknum as ubyte, filename as string, pathname as string)
declare sub lay_track (byref roadwriter as roadwriter_type, byref poz_n as integer, mouse as mouse_type, scr as screen_type, pathname as string, byref tracks_t as ubyte, byref traknum as ubyte, byref quit as byte, f as integer)
declare sub race_track ( mouse as mouse_type, scr as screen_type, driver_c as ubyte, byref quit as byte, byref start as single, roadwriter as roadwriter_type, byval drivers as ubyte, byval poz_n as integer, pathname as string, byval f as integer, byval traknum as ubyte, pilot as string, best as single)
declare sub racetrack_graphics (scr as screen_type, roadwriter as roadwriter_type, mouse as mouse_type, byval poz_n as integer, byval i as integer, byval driver_c as ubyte, byval drivers as ubyte)


randomize timer

scr.x=800
scr.y=600
screeninfo scr.x,scr.y
screenres scr.x,scr.y,32,,1
scr.hx=scr.x*.5
scr.hy=scr.y*.5

do while quit <> -1
    cls
    setmouse scr.hx,scr.hy,1
    
    pathname = exepath
    if chdir (pathname & "\tracks") = 0 then
        f = Freefile
        open "tracks.dat" for random as #f
            get #f, 1, tracks_t
        Close
    end if
    
    print "name of racer? (change your name to race your ghosts)"
    input pilot
    
    if len(pilot)=0 then pilot = "ABC"&int(rnd*90)+9
    
    drivers=1
    driver_c=1
    
    cls
    do
        color rgb (200,200,100)
        locate 1,1
        ? "load track"
        ? "lay track"
        getmouse mouse.x,mouse.y,,mouse.b
        if mouse.y < 9 then
            color rgb(200,200,200)
            locate 1,1
            ? "load track"
        elseif mouse.y <17 then
            color rgb(200,200,200)
            locate 2,1
            ? "lay track"
        end if
        if multikey(1) then quit=-1
        sleep 10
    loop until (mouse.b <>0 and mouse.y<17) or quit=-1
    
    if quit <> -1 then
        select case mouse.y
        case is < 9
            if tracks_t < 1 then
                print "there are no saved tracks, going to lay track"
                sleep 2000
                lay_track (roadwriter, poz_n, mouse, scr , pathname , tracks_t, traknum, quit, f)
            else
                load_track (tracks_t, f, traknum, filename, pathname, mouse, drivers, poz_n, roadwriter, scr, quit, best)
            end if
        case is < 17 
             lay_track (roadwriter, poz_n, mouse, scr , pathname , tracks_t, traknum, quit, f)
        end select
    end if    
    
    cls
    
    if quit<>-1 then
        race_track (mouse, scr, driver_c, quit, start, roadwriter, drivers, poz_n, pathname, f, traknum, pilot, best)
    end if

loop 

sub load_track (byref tracks_t as ubyte, f as integer, byref traknum as ubyte, filename as string, pathname as string, mouse as mouse_type, byref drivers as ubyte, byref poz_n as integer, roadwriter as roadwriter_type, scr as screen_type, byref quit as byte, byref best as single)
dim as single greatx,smallx,greaty,smally,xfactor,yfactor,midx,midy
dim as byte refreshtrack
dim as string sting
dim as integer i

    cls
    traknum=1
    refreshtrack=-1
    do
        color rgb(255,255,255)
        do while mouse.b <> 0
            getmouse mouse.x,mouse.y,,mouse.b
            sleep 1
            if multikey(1) then exit do
        loop 
        getmouse mouse.x,mouse.y,,mouse.b
        locate 1,1
        ? "press middle mouse button to confirm"
        sting= "track number"
        draw string (scr.x/2,0), sting
        sting = "< " & traknum & " >"
        draw string (scr.x/2,8), sting
        sting= "RACE"
        line (scr.x/2+48,8)-(scr.x/2+48+len(sting)*8,16),rgb(0,200,0),bf
        draw string (scr.x/2+48,8), sting
        sting = "delete"
        line (scr.x*.8,0)-(scr.x*.8+len(sting)*8,8),rgb(200,0,0),bf
        draw string (scr.x*.8,0), sting
        if mouse.b=1 and mouse.y<17 then
            if mouse.x >(scr.x/2) and mouse.x<(scr.x/2 +8) then 
                traknum-=1 
                line (scr.x/2+16,8)-(scr.x/2+32,16),0,bf
                refreshtrack=-1
            end if
            if mouse.x >(scr.x/2+32) and mouse.x<(scr.x/2+40) then 
                traknum+=1 
                line (scr.x/2+16,8)-(scr.x/2+32,16),0,bf
                refreshtrack=-1
            end if
            if mouse.x >(scr.x/2+48) and mouse.x<(scr.x/2+48+len("RACE")*8) and mouse.y > 8 then 
                mouse.b=4
            end if
            if mouse.x > (scr.x*.8) and mouse.x < (scr.x*.8+len(sting)*8) and mouse.y < 9 then
                if tracks_t > 1 then
                    deletetrack (tracks_t , f, traknum, filename, pathname)
                end if
                refreshtrack=-1

            end if
        end if
        
        if traknum>tracks_t then traknum=1
        if traknum<1 then traknum=tracks_t
        
        if refreshtrack=-1 then
            cls
            chdir (pathname & "\tracks")
            f=freefile
            open "track" &traknum &".dat" for random as #f
                get #f ,1, poz_n
                get #f ,, roadwriter.poz()
            close
            for i = 1 to poz_n
                if greatx < roadwriter.poz(i).x then greatx = roadwriter.poz(i).x
                if smallx > roadwriter.poz(i).x then smallx = roadwriter.poz(i).x
                if greaty < roadwriter.poz(i).y then greaty = roadwriter.poz(i).y
                if smally > roadwriter.poz(i).y then smally = roadwriter.poz(i).y
            next
            xfactor=scr.x/(greatx+abs(smallx))
            yfactor=scr.y/(greaty+abs(smally))
            midx=(greatx+smallx)/2*xfactor
            midy=(greaty+smally)/2*yfactor
            for i = 1 to poz_n
                color rgb(200,200,200)
                if i = poz_n then color rgb(255,0,0)
                if i = 1 then color rgb(0,255,0)
                line(scr.hx+roadwriter.poz(i).x*xfactor-midx,scr.hy+roadwriter.poz(i).y*yfactor-midy)-(scr.hx+roadwriter.poz(i-1).x*xfactor-midx,scr.hy+roadwriter.poz(i-1).y*yfactor-midy)
            next
            refreshtrack=0
        end if
        
        if multikey(1) then quit=-1
        sleep 1
        
    loop until mouse.b=4 or quit=-1
    
    chdir (pathname & "\tracks")
    f=freefile
    open "track" &traknum &".dat" for random as #f
        get #f ,1, poz_n
        get #f ,, roadwriter.poz()
    close
    
    
    chdir (pathname & "\times")
    if mid (curdir, len(curdir)-4, 5) <> "times" then
        ? mid (curdir, len(curdir)-4, 5)
        if chdir(exepath & "\times\") then 
            ? "change dir to times unsuccesful"
            chdir(pathname)
            mkdir("times")
            chdir(".\times")
            ? curdir & " current directory"
            sleep
        end if
    end if
    
    filename=dir("*.tym")
    if len(filename)> 0 then
        if val(mid(filename,1,1+abs(traknum>9))) = traknum then
            drivers+=1
            f=freefile
            open filename for random as #f
                get #f,1, best
                get #f,, driver(drivers).cols()
                get #f,, driver(drivers).store_pos()
            close
        end if
    end if
    
    do
        filename=dir()
        if val(mid(filename,1,1+abs(traknum>9))) = traknum then
            drivers+=1
            f=freefile
            open filename for random as #f
                get #f,1, best
                get #f,, driver(drivers).cols()
                get #f,, driver(drivers).store_pos()
            close
        end if
    loop until drivers > 31 or filename = "" or multikey(1)

end sub

sub deletetrack (byref tracks_t as ubyte, f as integer, byref traknum as ubyte, filename as string, pathname as string)
    dim as integer result
    chdir(pathname)
    chdir(".\tracks\")
    
    if curdir = pathname & "\tracks" then 
        kill "track" & traknum & ".dat"
    else
        print "unable to kill" & "track" & traknum & ".dat"
        print curdir
        sleep
    end if
    
    if tracks_t > traknum then
        for ii as integer = traknum to (tracks_t-1)
            result = name ("track" & (ii+1) & ".dat" , "track" & ii & ".dat")
            if result <> 0 then 
                print "error renaming file"
                sleep
            end if
            result =chdir(exepath & "\times")
            if result <> 0 then 
                print "change dir unsuccesful, not deleting old times"
                sleep
            else
                do
                    filename=dir( traknum & "*.tym")
                    if len(filename) > 0 then kill filename
                loop until len(filename) < 1 or multikey(1)
                do
                    filename=dir((ii+1)&"*.tym")
                    if len(filename) > 0 then
                        name (filename, ii & mid (filename,2, len(filename)))
                    end if
                loop until len(filename) < 1 or multikey(1)
            end if
        next
    else
        result = chdir(exepath & "\times")
        if result <> 0 then 
            print "change dir unsuccesful, not deleting old times (only 1 track)"
            sleep
        else
            do
                filename=dir( traknum & "*.tym")
                if len(filename) > 0 then kill filename
            loop until len(filename) < 1 or multikey(1)
        end if
    end if
    
    chdir (pathname & "\tracks")
    f=freefile
    open "tracks.dat" for random as #f
    get #f,1, tracks_t
    if tracks_t > 0 then tracks_t = (tracks_t-1)
    Put #f,1, tracks_t
    close
    
end sub

sub lay_track (byref roadwriter as roadwriter_type, byref poz_n as integer, mouse as mouse_type, scr as screen_type, pathname as string, byref tracks_t as ubyte, byref traknum as ubyte, byref quit as byte, f as integer)
dim as byte warmup =-1
dim as single x(1),y(1),x2(1),y2(1)
dim as integer i

    roadwriter.poz(0).x=scr.hx
    roadwriter.poz(0).y=scr.hy
    roadwriter.breadth=150
    poz_n=0
    
    setmouse roadwriter.poz(0).x,roadwriter.poz(0).y,0 :cls
    
    do
        
       if multikey(&h11) then 
           warmup=0
           poz_n=0
        end if
    
            
        getmouse mouse.x,mouse.y,mouse.w,mouse.b
        
        
        color rgb(240,150,155)
        locate 1,40
        ? "trak diameter (rmb < lmb)"
        if mouse.b=1 then roadwriter.breadth+=2
        if mouse.b=2 then roadwriter.breadth-=2
        locate 2,40
        ? roadwriter.breadth
    
        
        poz_n+=1
        
        with roadwriter
            
            .poz(poz_n).angle=atan2(mouse.y-scr.hy,mouse.x-scr.hx)
            .poz(poz_n).mag=sqr( (mouse.y-scr.hy)^2+(mouse.x-scr.hx)^2)
            .poz(poz_n).x=cos(.poz(poz_n).angle) *.poz(poz_n).mag +.poz(poz_n-1).x
            .poz(poz_n).y=sin(.poz(poz_n).angle) *.poz(poz_n).mag +.poz(poz_n-1).y
            .poz(poz_n).diameter=.breadth
            
            i=0
            line (0,scr.y*.02)-(scr.x,scr.y),0,bf
            
            if warmup then 
                draw string  (scr.x*.01, (scr.y-scr.y*.01)), "turn (w)armup off", rgb(255,250,140)
            end if
            
            do
                
                x(0)=scr.hx+(.poz(poz_n-i).x-.poz(poz_n).x)+cos(.poz(poz_n-i).angle-pi*.5)*.breadth '+(.poz(poz_n).x-.poz(poz_n-1).x)'+(.poz(poz_n-1).x-.poz(poz_n-2).x)
                y(0)=scr.hy+(.poz(poz_n-i).y-.poz(poz_n).y)+sin(.poz(poz_n-i).angle-pi*.5)*.breadth '+(.poz(poz_n).y-.poz(poz_n-1).y)'+(.poz(poz_n-1).y-.poz(poz_n-2).y)
                x2(0)=scr.hx+(.poz(poz_n-i).x-.poz(poz_n).x)+cos(.poz(poz_n-i).angle+pi*.5)*.breadth '+(.poz(poz_n).x-.poz(poz_n-1).x)'+(.poz(poz_n-1).x-.poz(poz_n-2).x)
                y2(0)=scr.hy+(.poz(poz_n-i).y-.poz(poz_n).y)+sin(.poz(poz_n-i).angle+pi*.5)*.breadth '+(.poz(poz_n).y-.poz(poz_n-1).y)'+(.poz(poz_n-1).y-.poz(poz_n-2).y)
                line (x(0)+1,y(0)+1)-(x(0)-1,y(0)-1),rgb(255,0,128),b
                line (x2(0)+1,y2(0)+1)-(x2(0)-1,y2(0)-1),rgb(0,255,128),b
                
                i+=1
            loop until i>poz_n or ((x(0)<0 or x(0)>scr.x) and (y(0)<0 or y(0)>scr.y))
        end with
        
        locate 1,1
        ? poz_n;" "
        
        sleep 40
    
    if multikey(1) then quit=-1
    loop until poz_n>=traklen or mouse.b = 7 or quit=-1
    
    if chdir (pathname & "\tracks") <> 0 then
        chdir (pathname)
        mkdir("tracks")
    end if
    
    chdir (pathname & "\tracks")
    f = Freefile
    open "tracks.dat" for random as #f
        get #f, 1, tracks_t
        tracks_t+=1
        Put #f, 1, tracks_t
    Close
    
    f = Freefile
    
    open "track" &tracks_t &".dat" for random as #f
        put #f ,1, poz_n
        put #f ,, roadwriter.poz()
    close
    
    traknum=tracks_t

end sub

sub race_track (mouse as mouse_type, scr as screen_type, driver_c as ubyte, byref quit as byte, byref start as single, roadwriter as roadwriter_type, byval drivers as ubyte, byval poz_n as integer, pathname as string, byval f as integer, byval traknum as ubyte, pilot as string, best as single)
dim as integer i, mem
dim as single cp_to_cp_half_x, cp_to_cp_half_y
dim as single cp_angle_right_angle, cp_angle_left_angle
dim as single mag_older_pos_to_old, mag_old_pos_to_new
dim as single cp_to_driver_x, cp_to_driver_y, this_cp_to_last_x, this_cp_to_last_y, cp_to_last_range
dim as integer tempmousex, tempmousey
dim as byte exitloop

    color rgb(100,255,100)
    print "get ready"
    color rgb(100,100,255)
    print drivers & " drivers"
    
    do
        sleep 1
        getmouse mouse.x,mouse.y,,mouse.b
    loop until mouse.b=0 or multikey(&h1)
    do
        sleep 1
        getmouse mouse.x,mouse.y,,mouse.b
    loop until mouse.b<>0 or multikey(&h1)

    setmouse scr.hx,scr.hy,0

   
    for driver_c = 1 to drivers
        driver(driver_c).x=roadwriter.poz(1).x
        driver(driver_c).y=roadwriter.poz(1).y
        driver(driver_c).oldx=driver(driver_c).x
        driver(driver_c).oldy=driver(driver_c).y
        driver(driver_c).gear=0
        driver(driver_c).actualmag=0
        driver(driver_c).cp=1
        driver(driver_c).storepos=0
        driver(driver_c).klicker=0
        for i = 0 to 5
            driver(driver_c).gearratio(i)=3-i*.5
        next
    next
    
    
    driver(1).cols(1)=rgb(100+rnd*(155),100+rnd*(155),100+rnd*(155))
    driver(1).cols(2)=rgb(100+rnd*(155),100+rnd*(155),100+rnd*(155))
    driver(1).cols(3)=rgb(100+rnd*(155),100+rnd*(155),100+rnd*(155))
    driver(1).cols(4)=rgb(100+rnd*(155),100+rnd*(155),100+rnd*(155))
    driver(1).cols(5)=rgb(100+rnd*(155),100+rnd*(155),100+rnd*(155))
    
    
    start = timer
    
    do
        
        cls
        
        'checkpoint tickover
        for driver_c=1 to drivers
            do
                if sqr( (driver(driver_c).x-roadwriter.poz(driver(driver_c).cp).x)^2 + (driver(driver_c).y-roadwriter.poz(driver(driver_c).cp).y)^2) < roadwriter.poz(driver(driver_c).cp).diameter*1.2 then
                    driver(driver_c).cp+=1
                else
                    exitloop=-1
               end if
            loop until exitloop=-1 or quit=-1
            exitloop=0
        next
      
        driver(1).position=drivers
        for driver_c=2 to drivers
            if driver(1).cp>driver(driver_c).cp then driver(1).position-=1
        next
        
        getmouse tempmousex, tempmousey
        if (tempmousex>=0) and (tempmousex <= scr.x) and (tempmousey>=0) and (tempmousey <= scr.y) then
            getmouse mouse.x,mouse.y,,mouse.b
        end if

        for driver_c=1 to drivers 
            if driver_c=1 then
                driver(driver_c).storepos+=1
                if driver(driver_c).storepos>0 and driver(driver_c).storepos< 8000 then
                    driver(driver_c).store_pos(driver(driver_c).storepos).x = mouse.x
                    driver(driver_c).store_pos(driver(driver_c).storepos).y = mouse.y
                    driver(driver_c).store_pos(driver(driver_c).storepos).b = mouse.b
                end if
            else
                driver(driver_c).storepos+=1
                if driver(driver_c).storepos>0 and driver(driver_c).storepos< 8000 then
                    mouse.x = driver(driver_c).store_pos(driver(driver_c).storepos).x
                    mouse.y = driver(driver_c).store_pos(driver(driver_c).storepos).y
                    mouse.b = driver(driver_c).store_pos(driver(driver_c).storepos).b
                end if
            end if
    
                
            if mouse.b=1 then 
                if driver(driver_c).klicker<1 and driver(driver_c).gear > 0 then driver(driver_c).gear-=1
                driver(driver_c).klicker+=2
            elseif mouse.b=2 then 
                if driver(driver_c).klicker<1 and driver(driver_c).gear < 5 then driver(driver_c).gear+=1
                driver(driver_c).klicker+=2
            end if
            if driver(driver_c).klicker > 0 then driver(driver_c).klicker-=1
           
            driver(driver_c).angle=atan2((mouse.y-scr.hy),(mouse.x-scr.hx))
            driver(driver_c).mag=sqr((mouse.y-scr.hy)^2+(mouse.x-scr.hx)^2)
            
'            driver(driver_c).oldx2 = driver(driver_c).oldx
'            driver(driver_c).oldy2 = driver(driver_c).oldy
            driver(driver_c).oldx = driver(driver_c).x
            driver(driver_c).oldy = driver(driver_c).y
            
                        
'            mag_older_pos_to_old=sqr( (driver(driver_c).oldx2 - driver(driver_c).oldx)^2  + (driver(driver_c).oldy2 - driver(driver_c).oldy)^2)
'            mag_old_pos_to_new=sqr((driver(driver_c).oldx - driver(driver_c).x)^2 + (driver(driver_c).oldy - driver(driver_c).y)^2)
            
'            driver(driver_c).wheelspin= _
'            iif (mag_old_pos_to_new < mag_older_pos_to_old, _ '(then)
'                 mag_old_pos_to_new/mag_older_pos_to_old, _   'or (else)
'                 mag_older_pos_to_old/mag_old_pos_to_new)
'            
'            if abs(driver(driver_c).wheelspin)>2 or (not driver(driver_c).wheelspin) then driver(driver_c).wheelspin = .1
            
            driver(driver_c).wheelspin=0
        
            'wheelspin on the grass increases
            if abs(sqr((roadwriter.poz(driver(driver_c).cp).x-driver(driver_c).x)^2+(roadwriter.poz(driver(driver_c).cp).y-driver(driver_c).y)^2) _
            * sin ( (roadwriter.poz(driver(driver_c).cp).angle - _
            atan2((roadwriter.poz(driver(driver_c).cp).y - driver(driver_c).y), _
            (roadwriter.poz(driver(driver_c).cp).x - driver(driver_c).x)) ))) _
            > _
            roadwriter.poz(driver(driver_c).cp).diameter then 
                driver(driver_c).wheelspin+=.34
                driver(driver_c).actualmag*=.98
                if driver_c=1 then circle (40,40),5, rgb(0,255,0)
            end if
            if driver(driver_c).actualmag < (driver(driver_c).mag/driver(driver_c).gearratio(driver(driver_c).gear)) then driver(driver_c).actualmag+=(driver(driver_c).gearratio(driver(driver_c).gear)+driver(driver_c).gearratio(5))*(1-driver(driver_c).wheelspin)
            if driver(driver_c).actualmag > (driver(driver_c).mag/driver(driver_c).gearratio(driver(driver_c).gear)) then driver(driver_c).actualmag-=driver(driver_c).gearratio(0)*2*(1-driver(driver_c).wheelspin)
            
            driver(driver_c).x+=((cos(driver(driver_c).angle)*driver(driver_c).actualmag*.4)*(1-driver(driver_c).wheelspin)+(driver(driver_c).x-driver(driver_c).oldx))*.5
            driver(driver_c).y+=((sin(driver(driver_c).angle)*driver(driver_c).actualmag*.4)*(1-driver(driver_c).wheelspin)+(driver(driver_c).y-driver(driver_c).oldy))*.5
            
        next
    
        driver_c=1
        if driver(driver_c).storepos>0 and driver(driver_c).storepos< 8000 then
            mouse.x = driver(1).store_pos(driver(1).storepos).x
            mouse.y = driver(1).store_pos(driver(1).storepos).y
            mouse.b = driver(1).store_pos(driver(1).storepos).b
        end if
        
        racetrack_graphics (scr, roadwriter, mouse, poz_n, i, driver_c, drivers)
 
        color rgb(0,250,0)
        locate 1,40
        print "postion " & driver(1).position 
        color rgb(255,255,0)
        locate 1,1
        ? driver(1).cp &"cp / " &traklen
        color rgb(150,150,255)
        locate 2,1
        ? int((timer-start)*100)*.01 ;"         "
    
        sleep 20
        
        if multikey(&h1) then quit=-1

    loop until (driver(1).cp > poz_n) or quit=-1
        
    start= timer-start

    if not quit then
        locate 40,40
        color rgb(155,155,255)
        
        chdir (pathname & "\times")
        if mid (curdir, len(curdir)-4, 5) <> "times" then
            if chdir(pathname & "\times") then 'change dir unsuccesful
                chdir (pathname)
                mkdir("times")
                chdir(pathname & "\times")
            end if
        end if
        
        f= freefile
        open traknum & pilot & ".tym" for random as #f
            get #f,1,best
            if best>start or not best then
                put #f,1, timer-start
                put #f,,driver(driver_c).cols()
                put #f,, driver(driver_c).store_pos()
            end if
        close
        
        do
            sleep 1
            if multikey(&h1) then quit=-1
            getmouse mouse.x,mouse.y,,mouse.b
        loop until mouse.b<>0 or quit=-1
    
    end if

end sub


sub racetrack_graphics (scr as screen_type, roadwriter as roadwriter_type, mouse as mouse_type, byval poz_n as integer, byval i as integer, byval driver_c as ubyte, byval drivers as ubyte)
dim as single carlinex, carliney
dim as single x(1),y(1),x2(1),y2(1)
dim as integer tempcircle

    'gear lights
    for i = 0 to driver(1).gear
        circle (scr.hx+(i-2)*scr.hx*.1, scr.hy*.25),15,rgb (255,0,0)
        circle (scr.hx+(i-2)*scr.hx*.1, scr.hy*.25),15*driver(driver_c).actualmag / (driver(driver_c).mag/driver(driver_c).gearratio(driver(driver_c).gear)),rgb (150,0,0),,,,f
    next
    
    carlinex=cos(driver(1).angle)*5
    carliney=sin(driver(1).angle)*5
    
    'driver colours
    line (scr.hx-carlinex,scr.hy-carliney)-(scr.hx+carlinex,scr.hy+carliney), driver(1).cols(5)
    line (scr.hx+1-carlinex,scr.hy-carliney)-(scr.hx+1+carlinex,scr.hy+carliney),driver(1).cols(1)
    line (scr.hx-1-carlinex,scr.hy-carliney)-(scr.hx-1+carlinex,scr.hy+carliney),driver(1).cols(2)
    line (scr.hx-carlinex,scr.hy+1-carliney)-(scr.hx+carlinex,scr.hy+1+carliney),driver(1).cols(3)
    line (scr.hx-carlinex,scr.hy-1-carliney)-(scr.hx+carlinex,scr.hy-1+carliney),driver(1).cols(4)
    
    for driver_c = 2 to drivers
        
        carlinex=cos(driver(driver_c).angle)*5
        carliney=sin(driver(driver_c).angle)*5
        
        line (scr.hx-(driver(1).x-driver(driver_c).x)-carlinex,scr.hy-(driver(1).y-driver(driver_c).y)-carliney)- _
            (scr.hx-(driver(1).x-driver(driver_c).x)+carlinex,scr.hy-(driver(1).y-driver(driver_c).y)+carliney), driver(driver_c).cols(5)
        line (scr.hx+1-(driver(1).x-driver(driver_c).x)-carlinex,scr.hy-(driver(1).y-driver(driver_c).y)-carliney)- _
            (scr.hx+1-(driver(1).x-driver(driver_c).x)+carlinex,scr.hy-(driver(1).y-driver(driver_c).y)+carliney), driver(driver_c).cols(1)
        line (scr.hx-1-(driver(1).x-driver(driver_c).x)-carlinex,scr.hy-(driver(1).y-driver(driver_c).y)-carliney)- _
            (scr.hx-1-(driver(1).x-driver(driver_c).x)+carlinex,scr.hy-(driver(1).y-driver(driver_c).y)+carliney), driver(driver_c).cols(2)
        line (scr.hx-(driver(1).x-driver(driver_c).x)-carlinex,scr.hy+1-(driver(1).y-driver(driver_c).y)-carliney)- _
            (scr.hx-(driver(1).x-driver(driver_c).x)+carlinex,scr.hy+1-(driver(1).y-driver(driver_c).y)+carliney), driver(driver_c).cols(3)
        line (scr.hx-(driver(1).x-driver(driver_c).x)-carlinex,scr.hy-1-(driver(1).y-driver(driver_c).y)-carliney)- _
            (scr.hx-(driver(1).x-driver(driver_c).x)+carlinex,scr.hy-1-(driver(1).y-driver(driver_c).y)+carliney), driver(driver_c).cols(4)
    next
    driver_c=1
    
    'never get lost line    
    if sqr((roadwriter.poz(driver(driver_c).cp).x-driver(driver_c).x)^2 + (roadwriter.poz(driver(driver_c).cp).y-driver(driver_c).y)^2) > scr.hx then 
        line (scr.hx,scr.hy)-( scr.hx+(roadwriter.poz(driver(driver_c).cp).x-driver(driver_c).x) , scr.hy+(roadwriter.poz(driver(driver_c).cp).y-driver(driver_c).y) ),rgb(180,220,255)
    end if
    'direction indicator
    pset (mouse.x,mouse.y),rgb(238,255,165)
    pset (mouse.x-1,mouse.y),rgb(238,255,165)
    pset (mouse.x+1,mouse.y),rgb(238,255,165)
    pset (mouse.x,mouse.y+1),rgb(238,255,165)
    
    i=driver(1).cp
    do
        
        x(0)=scr.hx+(roadwriter.poz(i).x-driver(driver_c).x)+cos(roadwriter.poz(i).angle)*sqr((roadwriter.poz(i).x-roadwriter.poz(i-1).x)^2+(roadwriter.poz(i).y-roadwriter.poz(i-1).y)^2)*.1
        y(0)=scr.hy+(roadwriter.poz(i).y-driver(driver_c).y)+sin(roadwriter.poz(i).angle)*sqr((roadwriter.poz(i).x-roadwriter.poz(i-1).x)^2+(roadwriter.poz(i).y-roadwriter.poz(i-1).y)^2)*.1
        x2(0)=scr.hx+(roadwriter.poz(i).x-driver(driver_c).x)-cos(roadwriter.poz(i).angle)*sqr((roadwriter.poz(i).x-roadwriter.poz(i-1).x)^2+(roadwriter.poz(i).y-roadwriter.poz(i-1).y)^2)*.1
        y2(0)=scr.hy+(roadwriter.poz(i).y-driver(driver_c).y)-sin(roadwriter.poz(i).angle)*sqr((roadwriter.poz(i).x-roadwriter.poz(i-1).x)^2+(roadwriter.poz(i).y-roadwriter.poz(i-1).y)^2)*.1
        'middle road markings
        line (x(0),y(0))-(x2(0),y2(0)),rgb(155,155,155)
        
        x(0)=scr.hx+(roadwriter.poz(i).x-driver(driver_c).x)+cos(roadwriter.poz(i).angle-pi*.5)*roadwriter.poz(i).diameter 
        y(0)=scr.hy+(roadwriter.poz(i).y-driver(driver_c).y)+sin(roadwriter.poz(i).angle-pi*.5)*roadwriter.poz(i).diameter 
        x2(0)=scr.hx+(roadwriter.poz(i).x-driver(driver_c).x)+cos(roadwriter.poz(i).angle+pi*.5)*roadwriter.poz(i).diameter 
        y2(0)=scr.hy+(roadwriter.poz(i).y-driver(driver_c).y)+sin(roadwriter.poz(i).angle+pi*.5)*roadwriter.poz(i).diameter 
        
        x(1)=scr.hx+(roadwriter.poz(i-1).x-driver(driver_c).x)+cos(roadwriter.poz(i-1).angle-pi*.5)*roadwriter.poz(i).diameter 
        y(1)=scr.hy+(roadwriter.poz(i-1).y-driver(driver_c).y)+sin(roadwriter.poz(i-1).angle-pi*.5)*roadwriter.poz(i).diameter 
        x2(1)=scr.hx+(roadwriter.poz(i-1).x-driver(driver_c).x)+cos(roadwriter.poz(i-1).angle +pi*.5)*roadwriter.poz(i).diameter 
        y2(1)=scr.hy+(roadwriter.poz(i-1).y-driver(driver_c).y)+sin(roadwriter.poz(i-1).angle +pi*.5)*roadwriter.poz(i).diameter 
        
        'tracklines
       line (x(0),y(0))-(x(1),y(1)),rgb(125,125,125)
       line (x2(0),y2(0))-(x2(1),y2(1)),rgb(125,125,125)
        
        
        'stripping
        line ( x(0)+roadwriter.poz(i).angle*((roadwriter.poz(i).x-roadwriter.poz(i-1).x)*.5) , _
               y(0)+roadwriter.poz(i).angle*((roadwriter.poz(i).y-roadwriter.poz(i-1).y)*.5)) - _
             ( x(0)+roadwriter.poz(i).angle*((roadwriter.poz(i).x-roadwriter.poz(i-1).x)*.5) + _
            cos(roadwriter.poz(i).angle+pi*.5)*roadwriter.poz(i).diameter*.25, _
               y(0)+roadwriter.poz(i).angle*((roadwriter.poz(i).y-roadwriter.poz(i-1).y)*.5) + _
            sin(roadwriter.poz(i).angle+pi*.5)*roadwriter.poz(i).diameter*.25 ),rgb(255,255,255)

        line ( x2(0)+roadwriter.poz(i).angle*((roadwriter.poz(i).x-roadwriter.poz(i-1).x)*.5) , _
               y2(0)+roadwriter.poz(i).angle*((roadwriter.poz(i).y-roadwriter.poz(i-1).y)*.5)) - _
             ( x2(0)+roadwriter.poz(i).angle*((roadwriter.poz(i).x-roadwriter.poz(i-1).x)*.5) + _
            cos(roadwriter.poz(i).angle-pi*.5)*roadwriter.poz(i).diameter*.25, _
               y2(0)+roadwriter.poz(i).angle*((roadwriter.poz(i).y-roadwriter.poz(i-1).y)*.5) + _
            sin(roadwriter.poz(i).angle-pi*.5)*roadwriter.poz(i).diameter*.25 ),rgb(255,255,255)

        
        if atan2(roadwriter.poz(i+2).y-roadwriter.poz(i+1).y,roadwriter.poz(i+2).x-roadwriter.poz(i+1).x)<_
        atan2(roadwriter.poz(i+1).y-roadwriter.poz(i).y,roadwriter.poz(i+1).x-roadwriter.poz(i).x) then
            tempcircle=roadwriter.poz(i).diameter * abs(atan2(roadwriter.poz(i+1).y-roadwriter.poz(i).y,roadwriter.poz(i+1).x-roadwriter.poz(i).x) - atan2(roadwriter.poz(i-0).y-roadwriter.poz(i-1).y,roadwriter.poz(i-0).x-roadwriter.poz(i-1).x))
            if tempcircle < roadwriter.poz(i).diameter then
                circle (x(0),y(0)),tempcircle,rgb(255,200,200)
                circle (x(1),y(1)),tempcircle,rgb(255,200,200)
                circle (x2(0),y2(0)),.4*tempcircle,rgb(255,255,100)
                circle (x2(1),y2(1)),.4*tempcircle,rgb(255,255,100)
            end if
            else
            tempcircle=roadwriter.poz(i).diameter * abs(atan2(roadwriter.poz(i+1).y-roadwriter.poz(i).y,roadwriter.poz(i+1).x-roadwriter.poz(i).x) - atan2(roadwriter.poz(i-0).y-roadwriter.poz(i-1).y,roadwriter.poz(i-0).x-roadwriter.poz(i-1).x))
            if tempcircle < roadwriter.poz(i).diameter then
                circle (x2(0),y2(0)),tempcircle,rgb(255,200,200)
                circle (x2(1),y2(1)),tempcircle,rgb(255,200,200)
                circle (x(0),y(0)),.4*tempcircle,rgb(255,255,100)
                circle (x(1),y(1)),.4*tempcircle,rgb(255,255,100)
            end if
        end if
        
        i+=1
        
    loop until i>poz_n or ((x(0)<0 or x(0)>scr.x) and (y(0)<0 or y(0)>scr.y))

end sub
Post Reply