Author Topic: eRATication  (Read 71 times)

B+

  • Hero Member
  • *****
  • Posts: 534
    • View Profile
eRATication
« on: 14. July 2018, 05:26:55 »
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

  • Newcomer
  • *
  • Posts: 33
  • Logic is the beginning of Wisdom.
    • View Profile
Re: eRATication
« Reply #1 on: 14. July 2018, 08:33:25 »
What? No cheese?  :o

J
May your journey be free of incident.

Live long and prosper.

B+

  • Hero Member
  • *****
  • Posts: 534
    • View Profile

Rick3137

  • Full Member
  • ***
  • Posts: 115
    • View Profile
    • Rick's Programs
Re: eRATication
« Reply #3 on: 14. July 2018, 16:33:29 »
   Nice Demo

   I like that new qb64 version. I might spend some time with that one.
http://rb23.yolasite.com  Ricks Programs
http://rb27.synthasite.com   Sight and Sound

B+

  • Hero Member
  • *****
  • Posts: 534
    • View Profile
Re: eRATication
« Reply #4 on: 14. July 2018, 18:18:51 »
Thanks Rick, nice to hear from you again. I didn't know you have QB64.

B+

  • Hero Member
  • *****
  • Posts: 534
    • View Profile
Re: eRATication
« Reply #5 on: 20. July 2018, 19:09:48 »
A Naalaa version with much more satisfying shooter control:

John

  • Sr. Member
  • ****
  • Posts: 402
    • View Profile
Re: eRATication
« Reply #6 on: 20. July 2018, 20:32:55 »
Great too see your interest in NaaLaa. My goto language for basic graphics and gaming projects.

Thanks B+ for the examples!