eRATication

[B+]

Astroids  inspired this rework of the SmallBASIC version, now the shooter is the spacebar and the arrow keys turn the gun.

QB64

Code: [Select]

_TITLE "eRATication by bplus 2018-07-13"
'QB64 version 2017 1106/82 (the day before they switched to version 1.2)

' 2018-07-13 modified from Asteroids game

'screen dimensions
CONST xmax = 1200
CONST ymax = 700

DIM SHARED pi
pi = _PI

SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 100, 20
RANDOMIZE TIMER

CONST nRats = 100
CONST nBullets = 1000
CONST bSpeed = 20

'r for rat prefix have x, y location, r for radius, h for heading, s for speed, k for kolor
DIM SHARED rx(nRats), ry(nRats), rr(nRats), rh(nRats), rs(nRats), rk(nRats) AS _UNSIGNED LONG
DIM SHARED shooterAngle, shooterX, shooterY, life, points
'b prefix for bullet, x, y, dx, dy, a for active
DIM SHARED bx(nBullets), by(nBullets), bdx(nBullets), bdy(nBullets), ba(nBullets)
points = 0
FOR i = 1 TO 100
    newRat i
NEXT
life = 1
shooterX = xmax / 2: shooterY = ymax / 2
rats = 5
shooterAngle = 0
WHILE life <= 3
    CLS
    FOR i = 1 TO life * rats 'the rats
        drawRat i
    NEXT

    '    _KEYDOWN WORKS NICE!!!!
    'use arrow keys to swing shooter, spacebar to fire
    IF _KEYDOWN(19200) THEN shooterAngle = shooterAngle - _PI(1 / 60)
    IF _KEYDOWN(19712) THEN shooterAngle = shooterAngle + _PI(1 / 60)
    IF _KEYDOWN(18432) OR _KEYDOWN(20480) THEN shooterAngle = shooterAngle + _PI(1 / 30)
    IF _KEYDOWN(32) THEN fire = 1 ELSE fire = 0
    drawshooter xmax / 2, ymax / 2, shooterAngle

    'handle bullets
    FOR i = 0 TO nBullets
        IF ba(i) = 0 AND fire = 1 THEN 'have in active bullet index to use
            bx(i) = shooterX + 3 * bSpeed * COS(shooterAngle)
            by(i) = shooterY + 3 * bSpeed * SIN(shooterAngle)
            bdx(i) = bSpeed * COS(shooterAngle)
            bdy(i) = bSpeed * SIN(shooterAngle)
            ba(i) = 1
            fire = 0
        END IF
        IF ba(i) = 1 THEN 'new location
            bx(i) = bx(i) + bdx(i)
            by(i) = by(i) + bdy(i)
            IF bx(i) > 0 AND bx(i) < xmax AND by(i) > 0 AND by(i) < ymax THEN 'in bounds draw it
                'check for collision with rock
                FOR r = 1 TO rats * life
                    IF ((rx(r) - bx(i)) ^ 2 + (ry(r) - by(i)) ^ 2) ^ .5 < .75 * rr(r) THEN
                        FOR rad = 1 TO rr(r)
                            fcirc rx(r), ry(r), rad, _RGB32(255 - rad, 128 - rad, 0)
                            _DISPLAY
                        NEXT
                        points = points + life ^ life
                        _TITLE "Rats Hit:" + STR$(points) + "   Life #" + STR$(life)
                        _DISPLAY
                        newRat r
                        ba(i) = 0
                    ELSE
                        fcirc bx(i), by(i), 2, _RGB32(255, 255, 0)
                    END IF
                NEXT
            ELSE
                ba(i) = 0
            END IF
        END IF
    NEXT
    _DISPLAY
    _LIMIT 30
WEND
_DELAY 5

SUB drawshooter (x, y, radianAngle) 'simple red iso triangle pointed towards radianAngle
    'calculate 3 points of triangle shooter
    x1 = x + 60 * COS(radianAngle) 'main point of shooter according to heading
    y1 = y + 60 * SIN(radianAngle)
    x2 = x + 30 * COS(radianAngle + _PI(2 / 3)) 'next two points are 120 degrees off main point in direction
    y2 = y + 30 * SIN(radianAngle + _PI(2 / 3))
    x3 = x + 30 * COS(radianAngle - _PI(2 / 3))
    y3 = y + 30 * SIN(radianAngle - _PI(2 / 3))
    fTri x, y, x1, y1, x2, y2, _RGB(255, 0, 0)
    fTri x, y, x1, y1, x3, y3, _RGB(255, 0, 0)
    ln x1, y1, x2, y2, _RGB32(255, 255, 128)
    ln x1, y1, x3, y3, _RGB32(255, 255, 128)
    ln x1, y1, x, y, _RGB32(255, 255, 128)
END SUB

SUB drawRat (i)
    rx(i) = rx(i) + rs(i) * COS(rh(i) + RND * _PI(rand(-5, 5) / 10))
    ry(i) = ry(i) + rs(i) * SIN(rh(i) + RND * _PI(rand(-5, 5) / 10))
    'rat collides with shooter?
    IF ((rx(i) - shooterX) ^ 2 + (ry(i) - shooterY) ^ 2) ^ .5 < rr(i) + 20 THEN
        FOR rad = 1 TO 200
            fcirc shooterX, shooterY, rad, _RGB32(255 - rad, 255 - 2 * rad, 0)
            _DISPLAY
            _LIMIT 300
        NEXT
        life = life + 1
        IF life <= 3 THEN
            _TITLE "Rats Hit:" + STR$(points) + "   Life #" + STR$(life)
        ELSE
            _TITLE "Rats Hit:" + STR$(points) + " THE END"
        END IF
        _DISPLAY
        newRat i
        EXIT SUB
    END IF
    IF rx(i) > 0 AND rx(i) < xmax AND ry(i) > 0 AND ry(i) < ymax THEN
        noseX = rx(i) + 2 * rr(i) * COS(rh(i))
        noseY = ry(i) + 2 * rr(i) * SIN(rh(i))
        neckX = rx(i) + .75 * rr(i) * COS(rh(i))
        neckY = ry(i) + .75 * rr(i) * SIN(rh(i))
        tailX = rx(i) + 2 * rr(i) * COS(rh(i) + _PI)
        tailY = ry(i) + 2 * rr(i) * SIN(rh(i) + _PI)
        earLX = rx(i) + rr(i) * COS(rh(i) - _PI(1 / 12))
        earLY = ry(i) + rr(i) * SIN(rh(i) - _PI(1 / 12))
        earRX = rx(i) + rr(i) * COS(rh(i) + _PI(1 / 12))
        earRY = ry(i) + rr(i) * SIN(rh(i) + _PI(1 / 12))
        fcirc rx(i), ry(i), .65 * rr(i), rk(i)
        fcirc neckX, neckY, rr(i) * .3, rk(i)
        fTri noseX, noseY, earLX, earLY, earRX, earRY, rk(i)
        fcirc earLX, earLY, rr(i) * .3, rk(i)
        fcirc earRX, earRY, rr(i) * .3, rk(i)
        wX = .5 * rr(i) * COS(rh(i) - _PI(11 / 18))
        wY = .5 * rr(i) * SIN(rh(i) - _PI(11 / 18))
        ln noseX + wX, noseY + wY, noseX - wX, noseY - wY, rk(i)
        wX = .5 * rr(i) * COS(rh(i) - _PI(7 / 18))
        wY = .5 * rr(i) * SIN(rh(i) - _PI(7 / 18))
        ln noseX + wX, noseY + wY, noseX - wX, noseY - wY, rk(i)
        ln rx(i), ry(i), tailX, tailY, rk(i)
    ELSE
        newRat i
    END IF
END SUB

SUB newRat (iRat)
    'bring rock in from one side, need to set heading according to side
    'RANDOMIZE TIMER + RND
    side = rand(1, 4)
    SELECT CASE side
        CASE 1: rx(iRat) = 0: ry(iRat) = RND * ymax: rh(iRat) = 3 * pi / 2 + RND * pi
        CASE 2: rx(iRat) = xmax: ry(iRat) = RND * ymax: rh(iRat) = pi / 2 + RND * pi
        CASE 3: rx(iRat) = RND * xmax: ry(iRat) = 0: rh(iRat) = RND * pi
        CASE 4: rx(iRat) = RND * xmax: ry(iRat) = ymax: rh(iRat) = pi + RND * pi
    END SELECT
    'speed, angle, radius, gray coloring, spin, seed
    rs(iRat) = RND * 5 * life + 1
    rr(iRat) = RND * 55 + 15
    r = rand(60, 255)
    rk(iRat) = _RGB32(r, .9 * r, .8 * r)
END SUB

FUNCTION rand% (lo%, hi%)
    rand% = INT(RND * (hi% - lo% + 1)) + lo%
END FUNCTION

' found at QB64.net:    http://www.qb64.net/forum/index.php?topic=14425.0
SUB fTri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
    a& = _NEWIMAGE(1, 1, 32)
    _DEST a&
    PSET (0, 0), K
    _DEST 0
    _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
    _FREEIMAGE a& '<<< this is important!
END SUB

SUB ln (x1, y1, x2, y2, K AS _UNSIGNED LONG) 'box frame
    LINE (x1, y1)-(x2, y2), K
END SUB

'vince version
SUB fcirc (x AS LONG, y AS LONG, R AS LONG, C AS _UNSIGNED LONG)
    x0 = R
    y0 = 0
    e = 0
    DO WHILE y0 < x0
        IF e <= 0 THEN
            y0 = y0 + 1
            LINE (x - x0, y + y0)-(x + x0, y + y0), C, BF
            LINE (x - x0, y - y0)-(x + x0, y - y0), C, BF
            e = e + 2 * y0
        ELSE
            LINE (x - y0, y - x0)-(x + y0, y - x0), C, BF
            LINE (x - y0, y + x0)-(x + y0, y + x0), C, BF
            x0 = x0 - 1
            e = e - 2 * x0
        END IF
    LOOP
    LINE (x - R, y)-(x + R, y), C, BF
END SUB



[johnno56]

What? No cheese? 

J

[B+]

Please don't feed the rats. Bubonic plague and all...
https://www.google.com/search?q=bubonic+plague&client=opera&source=lnms&tbm=isch&sa=X&sqi=2&ved=0ahUKEwi2ovrIu57cAhWd14MKHSURB7YQ_AUICygC&biw=1285&bih=671

[Rick3137]

   Nice Demo

   I like that new qb64 version. I might spend some time with that one.

[B+]

Thanks Rick, nice to hear from you again. I didn't know you have QB64.

[B+]

A Naalaa version with much more satisfying shooter control:

[ScriptBasic]

Great too see your interest in NaaLaa. My goto language for basic graphics and gaming projects.

Thanks B+ for the examples!

[B+]

OK now I have caught up the QB64 version with a complete makeover using object arrays as in Naalaa and same excellent shooter control plus for something new, a modified point system that attempts to recognize and reward skillful shooting.

So points are no longer based on life# squared (although I must say that was a pretty good estimate), they are based on size and speed of target. So the longer you play the more points you rack up. But if you play in life #1 you will not rack up nearly the amount of points you would in life #2 for same amount of time, heck you could probably survive forever in life #1, it was just meant as warm up.

Also the amount of shots taken needs to be considered as racking up 100 points with 100 shots is way better than 100 points with 1 million shots! So a sort of efficiency percent is calculated = points / shots * 100 though I think it is possible to get over 100 % if you skip through life #1 and #2 and manage to survive in life #3 for some time.

There is a bit of a dilemma, do I give up the joy of hosing (machine gunning) rats off screen for a game of skillful shooting where every bullet should count.

This leads me to penalizing hitting targets that do not pose a threat to shooter's position.  Only if you hit a rat (or asteroid) that is coming right at you or where your present course is taking you, should you score big points and of course survive, Shots taken at the right target but miss are penalized as waste of time but shots taken at wrong target should penalized with minus number and shots taken at friendlies even more so, say with game over before all life#'s played out.