Stock Car Racing

Just BASIC Games
NJames
Posts: 43
Joined: Tue Jul 14, 2009 2:55 pm

Stock Car Racing

Post by NJames » Sat Mar 10, 2018 4:43 pm

Code: Select all

    'RANDOMIZE .1
    GLOBAL cars, flicker, BMPList$
    cars = 30
    '----------
    DIM carX(cars)
    DIM carY(cars)
    DIM carSPD(cars)
    DIM laneChange(cars)
    DIM DEC(cars)
    DIM ACC(cars)
    DIM AIR(cars)
    DIM DRAG(cars)
    DIM HP(cars)
    DIM GRIP(cars)
    DIM MO(cars)
    '----------
    nomainwin
    WindowWidth = 200
    WindowHeight = 200
    open "Adjusting..." for graphics_nf_nsb as #1
    #1, "home ; down ; posxy w h"
    w=200-2*w : h = 200-2*h
    close #1

    WindowWidth  = 640+w
    WindowHeight = 840+h
    UpperLeftX   = (DisplayWidth-WindowWidth)/2
    UpperLeftY   = (DisplayHeight-WindowHeight)/2
    open "race" for graphics_nf_nsb as #g
    #g "trapclose quit"
    #g "down"

    call makeNumberSprites
    call makeTrack
    #g "background track1"
    call makeCarSprites
    #g "drawsprites"
    #g "setfocus"
    #g "when characterInput keyHandler key$"
    won = 0 : lost = 0
    finishLine = -1000 * 200
    timer 20, [tick]
    wait

    [tick]
        'timer 0
        speedFactor = 1.8 'a multiplier for the displayed speed
        driftWidth = 35
        driftLength = 400
        draftFromBehind = .10
        draftFromAhead = .15
        sideDraftFactor = .6
        bumpLoss = .6
        bumpGain = .5
        SCAN
        for c = 1 to cars
            AIR(c) = DRAG(c)
        next c
        if carY(1) < 400 then shiftBack = 1 else shiftBack = 0
        if carY(1) > 400 then shiftFore = 1 else shiftFore = 0
        position = cars
        for c = 1 to cars
            '-----------
            'SHOW CAR POSITIONS
            '-----------
            if shiftBack then carY(c) = carY(c) + 1
            if shiftFore then carY(c) = carY(c) - 1
            'carY(c) = carY(c) + carX(c) / 100000 * carSPD(c)
            carY(c) = carY(c) + (carSPD(1) - carSPD(c))
            #g "spritexy car"; c ; "x " ; carX(c) ; " " ; carY(c)
            '-----------
            'DRAFTING
            '-----------
            for cc = c + 1 to cars
                distX = abs( carX(c) - carX(cc) )
                if distX <= driftWidth then
                    distY = abs( carY(c) - carY(cc) )
                    if carY(c) > carY(cc) then
                        if distY < driftLength and AIR(c) > .8 then AIR(c) = AIR(c) - draftFromBehind + draftFromBehind * distY / driftLength
                        if distY < driftLength / 2 and AIR(cc) > .8 then AIR(cc) = AIR(cc) - draftFromAhead + draftFromAhead * distY / driftLength
                    else
                        if distY < driftLength and AIR(cc) > .8 then AIR(cc) = AIR(cc) - draftFromBehind + draftFromBehind * distY / driftLength
                        if distY < driftLength / 2 and AIR(c) > .8 then AIR(c) = AIR(c) - draftFromAhead + draftFromAhead * distY / driftLength
                    end if
                else
                    if distX <= 2 * driftWidth then
                        distY = abs( carY(c) - carY(cc) )
                        if carY(c) > carY(cc) then
                            if distY < driftLength and AIR(c) > .8 then AIR(c) = AIR(c) - draftFromBehind/sideDraftFactor + draftFromBehind/sideDraftFactor * distY / driftLength
                            if distY < driftLength / 2 and AIR(cc) > .8 then AIR(cc) = AIR(cc) - draftFromAhead/sideDraftFactor + draftFromAhead/sideDraftFactor * distY / driftLength
                        else
                            if distY < driftLength and AIR(cc) > .8 then AIR(cc) = AIR(cc) - draftFromBehind/sideDraftFactor + draftFromBehind/sideDraftFactor * distY / driftLength
                            if distY < driftLength / 2 and AIR(c) > .8 then AIR(c) = AIR(c) - draftFromAhead/sideDraftFactor + draftFromAhead/sideDraftFactor * distY / driftLength
                        end if
                    end if
                end if
            next cc
            'if MO(c) < AIR(c) then
            '    AIR(c) = MO(c) - .05
            '    MO(c) = MO(c) + .1
            'else
            '    MO(c) = AIR(c)
            'end if
            '-------------
            'COLLISION
            '-------------
            #g "spritecollides car" ; c ; "x collision$"
            if instr(collision$, "car") then
                w = 0
                DO
                    w = w + 1
                    w$ = word$(collision$, w)
                    if left$(w$, 3) = "car" then
                        L = len(w$)
                        cc = val(mid$(w$, 4, L-4))
                        select case
                        case carX(c) > carX(cc) + 40
                            carX(c) = carX(c) + 1
                            carX(cc) = carX(cc) - 1
                            laneChange(c) = 0
                            laneChange(cc) =0
                        case carX(c) < carX(cc) - 40
                            carX(c) = carX(c) - 1
                            carX(cc) = carX(cc) + 1
                            laneChange(c) = 0
                            laneChange(cc) = 0
                        case else
                        end select
                        diffSPD = abs(carSPD(c) - carSPD(cc))
                        select case
                        case carY(c) > carY(cc) + 80 AND abs(carX(c) - carX(cc)) < 45
                            carSPD(c) = carSPD(c) - diffSPD * bumpLoss
                            carSPD(cc) = carSPD(cc) + diffSPD * bumpGain
                            carY(c) = carY(c) + 1
                        case carY(c) < carY(cc) - 80 AND abs(carX(c) - carX(cc)) < 45
                            carSPD(c) = carSPD(c) + diffSPD * bumpGain
                            carSPD(cc) = carSPD(cc) - diffSPD * bumpLoss
                            carY(cc) = carY(cc) + 1
                        case else
                        end select
                    end if
                LOOP until w$ = ""
            end if
            '-----------
            'OFF ROADING :)
            '-----------
            if carX(c) < 90 or carX(c) > 450 then carSPD(c) = carSPD(c) - .1
            '-----------
            'ACCELERATION / DECELERATION
            '-----------
            if carSPD(c) > 0 then
                if DEC(c) > 0 then
                    DEC(c) = DEC(c) - 1
                    carSPD(c) = ( carSPD(c) * carSPD(c) - carSPD(c) / 1.2 ) / carSPD(c)
                    if carSPD(c) <= 0 then carSPD(c) = 0 : DEC(c) = 0
                else
                    carSPD(c) = carSPD(c) + (HP(c) / 500 / carSPD(c) * carSPD(c))
                end if
                carSPD(c) = carSPD(c) - (AIR(c) / 40000 * carSPD(c) * carSPD(c))
            else
                carSPD(c) = 1
            end if
            '-----------
            'DECISIONS
            '-----------
            if c > 1 then
                insideLane = 150
                laneWidth = 104
                select case
                case (carX(c) - insideLane) mod laneWidth = 0
                    if carX(c) > insideLane and laneChange(c) <= 0 and rnd(0) < .003 then laneChange(c) = laneChange(c) - laneWidth
                    if carX(c) < 640 - insideLane and laneChange(c) >= 0 and rnd(0) < .003 then laneChange(c) = laneChange(c) + laneWidth
                case (carX(c) - insideLane) mod laneWidth > laneWidth/2 and rnd(0) < .01
                    laneChange(c) = 0 - ((carX(c) - insideLane) mod laneWidth)
                case (carX(c) - insideLane) mod laneWidth < laneWidth/2 and rnd(0) < .01
                    laneChange(c) = ((carX(c) - insideLane) mod laneWidth)
                    'carX(c) = insideLane
                end select
                if carX(c) < 100 then laneChange(c) = 10
                if carX(c) > 440 then laneChange(c) = -10
            end if
            '-----------
            'LANE CHANGES
            '-----------
            select case
            case laneChange(c) > 0
                    carX(c) = carX(c) + 1
                    laneChange(c) = laneChange(c) - 1
                    carSPD(c) = carSPD(c) - .01
            case laneChange(c) < 0
                    carX(c) = carX(c) - 1
                    laneChange(c) = laneChange(c) + 1
                    carSPD(c) = carSPD(c) - .01
            end select
            '----------
            'FINISH LINE
            '----------
            if carY(c) < finishLine then
                timer 0
                carsPassed = 0
                for cc = 2 to cars
                    if carY(cc) > carY(1) then carsPassed = carsPassed + 1
                next cc
                if carsPassed = cars-1 then
                    if won = 0 then notice "You won!"
                    won = 1
                else
                    if lost = 0 then notice "The race is over."
                    lost = 1
                end if
            end if
            if carY(c) > carY(1) then position = position - 1
        next c
        finishLine = finishLine + carSPD(1)
        'SHOW POSITION COUNTER
        p1 = position mod 10
        p2 = int(position / 10)
        #g "spriteimage posDigit1 number" ; p1
        #g "spriteimage posDigit2 number" ; p2
        'SHOW AIR
        a1 = int(AIR(1)*100) mod 10
        a2 = int(AIR(1)*100 / 10)
        #g "spriteimage airDigit1 number" ; a1
        #g "spriteimage airDigit2 number" ; a2
        'MILES PER HOUR
        d1 = INT(carSPD(1)*speedFactor) mod 10
        d2 = int(( INT(carSPD(1)*speedFactor) mod 100) /10)
        d3 = INT(carSPD(1)*speedFactor/100)
        #g "spriteimage digit1 number" ; d1
        #g "spriteimage digit2 number" ; d2
        #g "spriteimage digit3 number" ; d3
        'LINES ON THE ROAD
        flicker = flicker + carSPD(1)/3 : if flicker >= 160 then flicker = 0
        #g "spritexy lineA 0 " ; -160 + flicker
        #g "spritexy lineB 0 " ; 0 + flicker
        #g "spritexy lineC 0 " ; 160 + flicker
        #g "spritexy lineD 0 " ; 320 + flicker
        #g "spritexy lineE 0 " ; 480 + flicker
        #g "spritexy lineF 0 " ; 640 + flicker
        #g "spritexy lineG 0 " ; 800 + flicker
        'DRAWSPRITES
        #g "drawsprites"
        'if not(won) and not(lost) then timer 20, [tick]
    wait


    sub keyHandler handle$, key$
        select case asc(right$(key$,1))
        case _VK_SHIFT
            notice AIR(1)
        case _VK_SPACE
            DEC(1) = DEC(1) + 4
            if DEC > 5 then DEC(1) = 5
        case _VK_UP
            ACC(1) = 1
        case _VK_DOWN, asc("s")
            DEC(1) = 1
        case _VK_LEFT, asc("a")
            if laneChange(1) > -20 then laneChange(1) = laneChange(1) - 10
        case _VK_RIGHT, asc("d")
            if laneChange(1) < 20 then laneChange(1) = laneChange(1) + 10
        case asc("q")
            if laneChange(1) > -60 then laneChange(1) = -60
        case asc("e")
            if laneChange(1) < 60 then laneChange(1) = 60
        end select
    end sub
    sub quit handle$
        timer 0
        close #g
        bitmap = 1
        while word$(BMPList$, bitmap) <> ""
            unloadbmp word$(BMPList$, bitmap)
            bitmap = bitmap + 1
        wend
        end
    end sub
    sub makeNumberSprites
        #g "fill lightgray"
        #g "font courier 12 bold"
        #g "place 0 0"
        #g "color black"
        #g "backcolor black"
        #g "boxfilled 20 20"
        #g "color black"
        #g "backcolor darkgray"
        for d = 0 to 9
            #g "place 2 35"
            #g "\";d
            #g "getbmp number";d;" 0 0 15 40"
            BMPList$ = BMPList$ ; "number" ; d ; " "
        next d
        #g "addsprite digit1 number0 number1 number2 number3 number4 number5 number6 number7 number8 number9"
        #g "spritexy digit1 28 1"
        #g "addsprite digit2 number0 number1 number2 number3 number4 number5 number6 number7 number8 number9"
        #g "spritexy digit2 14 1"
        #g "addsprite digit3 number0 number1 number2 number3 number4 number5 number6 number7 number8 number9"
        #g "spritexy digit3 0 1"
        #g "place 0 0"
        #g "addsprite posDigit1 number0 number1 number2 number3 number4 number5 number6 number7 number8 number9"
        #g "spritexy posDigit1 14 40"
        #g "addsprite posDigit2 number0 number1 number2 number3 number4 number5 number6 number7 number8 number9"
        #g "spritexy posDigit2 0 40"
        #g "addsprite airDigit1 number0 number1 number2 number3 number4 number5 number6 number7 number8 number9"
        #g "spritexy airDigit1 14 140"
        #g "addsprite airDigit2 number0 number1 number2 number3 number4 number5 number6 number7 number8 number9"
        #g "spritexy airDigit2 0 140"
    end sub
    sub makeCarSprites
        pos = int(rnd(0)*cars)+1
        'mask
        #g "color white"
        #g "backcolor black"
        #g "place 0 0"
        #g "boxfilled 50 100"
        colorList$ = "white red blue yellow cyan black brown darkred pink darkpink darkgray darkcyan darkgreen darkblue"
        colorList1$ = "yellow white blue red darkred black darkgray darkgreen cyan yellow blue darkblue black white"
        for c = 1 to cars
            windowColor$ = "180 180 230"
            c1x = 12 : c1y = 130
            c2x = 37 : c2y = 150
            color$ = word$(colorList$, (c mod 10) + 1)
            #g "place 0 100"
            #g "color black"
            #g "backcolor " ; color$
            #g "boxfilled 50 200"
            stripeColor$ =  word$(colorList1$, (c mod 10) + 1)
            #g "color " ; stripeColor$
            #g "backcolor " ; stripeColor$
            #g "place 15 100"
            select case (c mod 4)
            case 1
                #g "place 22 101"
                #g "boxfilled 36 199"
            case 2
                #g "place 26 101"
                #g "boxfilled 49 199"
            case 3
                #g "place 1 151"
                #g "boxfilled 49 199"
            end select
            #g "color " ; stripeColor$
            #g "backcolor " ; color$
            if c < 10 then
                #g "place 7 125"
            else
                #g "place 2 125"
            end if
            #g "\" ; c
            #g "color " ; windowColor$
            #g "backcolor " ; windowColor$
            #g "place " ; c1x ; " " ; c1y
            #g "boxfilled " ; c2x ; " " ; c2y
            #g "place " ; c1x ; " " ; c1y + 35
            #g "boxfilled " ; c2x ; " " ; c2y + 35
            for L = 0 to 4
                #g "line " ; c1x - L ; " " ; c1y ; " " ; c1x ; " " ; c2y
                #g "line " ; c2x + L ; " " ; c1y ; " " ; c2x ; " " ; c2y
                #g "line " ; c1x ; " " ; c1y + 35 ; " " ; c1x - L ; " " ; c2y + 35
                #g "line " ; c2x ; " " ; c1y + 35 ; " " ; c2x + L ; " " ; c2y + 35
            next L
            '#g "color black"
            for L = 1 to 5
                #g "line " ; c1x - 8 + L ; " " ; c1y + 5 + L*4 ; " " ; c1x - 8 + L ; " " ; c1y + 50 - L*4
                #g "line " ; c2x + 8 - L ; " " ; c1y + 5 + L*4 ; " " ; c2x + 8 - L ; " " ; c1y + 50 - L*4
            next L
            #g "getbmp car" ; c ; "Bmp 0 0 50 200"
            BMPList$ = BMPList$ ; "car" ; c ; "Bmp "
            #g "addsprite car" ; c ; "x car" ; c ; "Bmp"
            #g "spritexy car" ; c ; "x 10 100"
            if c < pos then x = c else x = c + 1
            carX(c) = 250 + (((x) mod 3)-1) * 100
            carY(c) = 400 + int((x)/3) * 200 - int(pos/3) * 200
            carSPD(c) = 60 + int(RND(0)*3)
            laneChange(c) = 0
            HP(c) = 100
            DRAG(c) = .99
            GRIP(c) = 1
        next c
        carX(1) = 250 + (((pos) mod 3)-1) * 100
        carY(1) = 400
        notice pos
        exit sub
    end sub
    sub makeTrack
        #g "fill lightgray"
        #g "color green"
        #g "backcolor green"
        #g "place 0 0"
        #g "boxfilled 100 640"
        #g "place 540 0"
        #g "boxfilled 640 640"
        #g "getbmp track1 0 0 640 640"
        BMPList$ = BMPList$ ; "track1 "
        'make lines
        'mask
        #g "fill white"
        #g "place 0 80"
        #g "color black"
        #g "backcolor black"
        #g "boxfilled 640 160"
        #g "place 210 0"
        #g "boxfilled 214 80"
        #g "place 320 0"
        #g "boxfilled 324 80"
        #g "place 430 0"
        #g "boxfilled 434 80"
        'draw lines
        #g "color white"
        #g "backcolor white"
        #g "place 210 80"
        #g "boxfilled 214 160"
        #g "place 320 80"
        #g "boxfilled 324 160"
        #g "place 430 80"
        #g "boxfilled 434 160"
        #g "getbmp lines 0 0 640 160"
        BMPList$ = BMPList$ ; "lines "
        #g "addsprite lineA lines"
        #g "spritexy lineA 0 0"
        #g "addsprite lineB lines"
        #g "spritexy lineB 0 160"
        #g "addsprite lineC lines"
        #g "spritexy lineC 0 320"
        #g "addsprite lineD lines"
        #g "spritexy lineD 0 480"
        #g "addsprite lineE lines"
        #g "spritexy lineE 0 640"
        #g "addsprite lineF lines"
        #g "spritexy lineF 0 800"
        #g "addsprite lineG lines"
        #g "spritexy lineG 0 960"
    end sub


CodeLite
Posts: 1
Joined: Fri Mar 30, 2018 3:34 am

Re: Stock Car Racing

Post by CodeLite » Mon Apr 02, 2018 5:41 am

NJames,

Very interesting. I still lack a great deal of understanding and skill as a player of this game. Once started catching a draft, but still am mostly clueless on this one. Tried to get a push. Not much success. Any tips?

Have not studied the code yet. Should eventually be able to understand it that way. Completely intrigued by the air effects. The basic 'feel' seems very right. Kudos.

Been working on a motorsports related project this year in JB myself. Very different from this. Recreates an actual race based on data generated from the race. Far from finished, but is doing the basic functions desired.

Is inspiring to see anything this 'fresh'--especially racing related--here in 2018!

CodeLite

NJames
Posts: 43
Joined: Tue Jul 14, 2009 2:55 pm

Re: Stock Car Racing

Post by NJames » Sun Apr 08, 2018 10:47 am

You can tweak the variables like draftFromBehind, draftLength, etc. to get a more realistic program. The values I posted were chosen mostly for entertainment value. Side drafting is the most effective, which allows cars to pass each other.

The three sets of numbers are MPH (at the top), race position (1st, 2nd, etc.), and wind resistance.

I'm glad you get a kick out of this program. Feel free (of course) to tweak it as much as you like.