eRATication
#1
Asteroids reminded me of Shooter Game I made in SmallBasic, so here is Asteroids mixed with that
Code:
_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

Life 1, easy street, 1 point per rat

Life 2, start to sweat, 4 points per rat

Life 3, Ha! 27 points per rat!
B += x
Reply
#2
I ran your program (called it ratgame.bas) and defeated it by holding down UpArrow and Space and
let it run indefinitely and killed 100s of rats..

Erik.

(kinda jerked though)
dndbbs project:

Links to my MUD: (strictly 16-bit); AKA XP:

Dndbbs executables
http://www.filegate.net/pdn/pdnbasic/dnd50a1e.zip

Dndbbs source
http://www.filegate.net/pdn/pdnbasic/dnd50a1s.zip

Dndbbs upgrade
http://www.filegate.net/pdn/pdnbasic/dnd50a1u.zip

DNDDOOR - https://bit.ly/EriksDNDDoor DUNGEON - https://bit.ly/EriksDungeon
Interpreter - https://bit.ly/EriksSICK Hex Editor - https://bit.ly/EriksHexEditor Utilities - https://bit.ly/EriksUtils
QB45 files: - https://bit.ly/EriksQB45 QB64shell - https://bit.ly/QB64shell Some old QB64 versions: - https://bit.ly/OldQB64
Reply
#3
Hi Erik,

Very satisfying, isn't it? Like popping bubble wrap. Wink

You might not have gotten to life #2, or life #3 with your "cheat" but those are even better because of points increases.
B += x
Reply
#4
Trick to 'spinning' (holding up/space) did not work for life 2 and 3, they creep from the sides to fast..

Additions: colorized rats, store high score, fix jerk when rat removed..

Erik.
dndbbs project:

Links to my MUD: (strictly 16-bit); AKA XP:

Dndbbs executables
http://www.filegate.net/pdn/pdnbasic/dnd50a1e.zip

Dndbbs source
http://www.filegate.net/pdn/pdnbasic/dnd50a1s.zip

Dndbbs upgrade
http://www.filegate.net/pdn/pdnbasic/dnd50a1u.zip

DNDDOOR - https://bit.ly/EriksDNDDoor DUNGEON - https://bit.ly/EriksDungeon
Interpreter - https://bit.ly/EriksSICK Hex Editor - https://bit.ly/EriksHexEditor Utilities - https://bit.ly/EriksUtils
QB45 files: - https://bit.ly/EriksQB45 QB64shell - https://bit.ly/QB64shell Some old QB64 versions: - https://bit.ly/OldQB64
Reply
#5
Hi Erik,

I did start with variations of brown rats but too life like for me...

The jerk? (2nd mention now...) ?  Oh you might be referring to the short display of red when a rat gets hit, it does delay the action of the gun as well as everything else... hmm... could I suppose display that without interrupting the action but... is it worth the trouble?

What is NOT worth the trouble is saving high scores. For me, this is not a game of skill, it is a time killer which only useful function is to blow off steam. Frankly I don't want to reminded by how much time I am wasting. ;-))

OK let's review what to add:
1) A rat palette
2) Track the life and death of a rat, so as to make the mass annihilation as smooth as possible.
B += x
Reply
#6
eRATication #2, colorful rats, smoother gun action, and another change so even more impossible to stay alive in life #3! 

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

' 2018-07-13 modified from Asteroids game
' 2018-07-15 eRATication 2
' color rats, eliminate jerks when kill rat,
' decrease rat size as life progresses
' 2018-07-15 some minor changes since post of e #2

'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), rdead(nRats), rk(nRats) AS _UNSIGNED LONG
DIM SHARED shooterAngle, shooterX, shooterY, life, points, walk
'b prefix for bullet, x, y, dx, dy, a for active
DIM SHARED bx(nBullets), by(nBullets), bdx(nBullets), bdy(nBullets), ba(nBullets)

life = 1
rats = 5
points = 0
shooterAngle = 0
shooterX = xmax / 2
shooterY = ymax / 2
FOR i = 0 TO nRats - 1
    newRat i
NEXT
WHILE life <= 3
    CLS , _RGB32(188, 178, 168)
    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) THEN shooterAngle = shooterAngle - _PI(1 / 20)
    IF _KEYDOWN(20480) THEN shooterAngle = shooterAngle + _PI(1 / 20)
    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 rat
                FOR r = 0 TO rats * life
                    IF ((rx(r) - bx(i)) ^ 2 + (ry(r) - by(i)) ^ 2) ^ .5 < .75 * rr(r) THEN
                        IF rdead(r) = 0 THEN
                            rdead(r) = 1
                            points = points + life ^ life
                            _TITLE "Rat Points:" + STR$(points) + "   Life #" + STR$(life)
                            ba(i) = 0
                        END IF
                    ELSE
                        fcirc bx(i), by(i), 2, _RGB32(30, 60, 80)
                    END IF
                NEXT
            ELSE
                ba(i) = 0
            END IF
        END IF
    NEXT
    _DISPLAY
    _LIMIT 30
WEND
_DELAY 5 'so don't start printing spaces in the editor

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)
    IF rdead(i) = 0 THEN 'if rat not dead move it
        rx(i) = rx(i) + rs(i) * COS(rh(i)) + rand(-.1 * rr(i), .1 * rr(i))
        ry(i) = ry(i) + rs(i) * SIN(rh(i)) + rand(-.1 * rr(i), .1 * rr(i))
    END IF

    'rat collides with shooter?
    IF ((rx(i) - shooterX) ^ 2 + (ry(i) - shooterY) ^ 2) ^ .5 < rr(i) + 20 THEN
        FOR rad = 1 TO 350
            fcirc shooterX, shooterY, rad, _RGB32(255 - .25 * rad, 128 - .125 * rad, 0)
            _DISPLAY
            _LIMIT 300
        NEXT
        life = life + 1
        'new set o rats
        FOR i = 0 TO nRats - 1
            newRat i
        NEXT
        IF life <= 3 THEN
            _TITLE "Rats Points:" + STR$(points) + "   Life #" + STR$(life)
        ELSE
            _TITLE "Rat Points:" + STR$(points) + " THE END"
            _DELAY 5 'so don't start printing spaces in the editor
            END
        END IF
        _DISPLAY
        EXIT SUB
    END IF

    IF rx(i) > 0 AND rx(i) < xmax AND ry(i) > 0 AND ry(i) < ymax THEN 'inbounds
        IF rdead(i) THEN 'show the burn out until reaches rat radius
            rdead(i) = rdead(i) + 2
            IF rdead(i) < rr(i) THEN
                fcirc rx(i), ry(i), rr(i) - rdead(i), _RGB32(255 - rdead(i), 128 - rdead(i), 0)
                _DISPLAY
            ELSE
                newRat i
            END IF
        ELSE
            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)
        END IF
    ELSE 'out of bounds
        newRat i
    END IF
END SUB

SUB newRat (iRat)
    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 * 60 / life + 10
    rdead(iRat) = 0
    rk(iRat) = ratKolor~&
END SUB

FUNCTION ratKolor~& ()
    r% = INT(RND * 140)
    g% = rand(INT(.5 * r%), INT(.8 * r%))
    b% = rand(INT(.5 * g%), INT(.8 * g%))
    ratKolor~& = _RGB32(r%, g%, b%)
END FUNCTION

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)
    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

EDIT: a couple of minor changes since post, most important is more logical use of arrow keys for gun swinging.
B += x
Reply
#7
"stay alive in life #3?"... That's right! Rub it in! I barely made it to life #2 before being "smooshed"... Life #3. Pfft...
Don't get me wrong. The game is well made, although the Asteroids look a LOT like rodentia, but that's ok. I would be eager to see what the "enemy ship" looks like... assuming I survive long enough in the game that is... lol

J
May your journey be free of incident.

Live long and prosper.
Reply
#8
@bplus: LOTS smoother, neat colors, and I survived life#3 for 2 seconds...

Erik.

btw: if i set the following it makes the game a little more 'playable':

CONST nRats = 50
CONST nBullets = 2000
CONST bSpeed = 15

Here is the ratgame with a highscore:
  (also adds ratlifes overrides)..

Code:
_TITLE "eRATication no 2 by bplus 2018-07-16 -ejo"
'QB64 version 2017 1106/82 (the day before they switched to version 1.2)

' 2018-07-13 modified from Asteroids game
' 2018-07-15 eRATication 2
' color rats, eliminate jerks when kill rat,
' decrease rat size as life progresses
' 2018-07-15 some minor changes since post of e #2

' 2018-07-16 adds highscore -ejo
' 2018-07-16 overides ratlifes -ejo
' 2018-07-16 delineates output for commas - ejo

' 2018-07-17 solves ratlifes greater than 10 -ejo

'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 = 50
CONST nBullets = 2000
CONST bSpeed = 15

'r for rat prefix have x, y location, r for radius, h for heading, s for speed, k for kolor
DIM SHARED shooterAngle, shooterX, shooterY, life, walk
DIM SHARED points AS DOUBLE

'b prefix for bullet, x, y, dx, dy, a for active
DIM SHARED bx(nBullets), by(nBullets), bdx(nBullets), bdy(nBullets), ba(nBullets)

'override ratlifes
DIM SHARED ratlifes AS INTEGER

'get ratlifes
DO
    PRINT "Enter ratlifes(1-10)";: INPUT ratlifes
    ratlifes = INT(ratlifes)
    IF ratlifes > 0 AND ratlifes <= 10 THEN EXIT DO
LOOP

DIM SHARED rx(nRats * ratlifes) AS _UNSIGNED LONG
DIM SHARED ry(nRats * ratlifes) AS _UNSIGNED LONG
DIM SHARED rr(nRats * ratlifes) AS _UNSIGNED LONG
DIM SHARED rh(nRats * ratlifes) AS _UNSIGNED LONG
DIM SHARED rs(nRats * ratlifes) AS _UNSIGNED LONG
DIM SHARED rdead(nRats * ratlifes) AS _UNSIGNED LONG
DIM SHARED rk(nRats * ratlifes) AS _UNSIGNED LONG

'reset start directory
CHDIR _STARTDIR$

life = 1
rats = 5
points = 0
shooterAngle = 0
shooterX = xmax / 2
shooterY = ymax / 2
FOR i = 0 TO nRats - 1
    newRat i
NEXT
WHILE life <= ratlifes
    CLS , _RGB32(188, 178, 168)
    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) THEN shooterAngle = shooterAngle - _PI(1 / 20)
    IF _KEYDOWN(20480) THEN shooterAngle = shooterAngle + _PI(1 / 20)
    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 rat
                FOR r = 0 TO rats * life
                    IF ((rx(r) - bx(i)) ^ 2 + (ry(r) - by(i)) ^ 2) ^ .5 < .75 * rr(r) THEN
                        IF rdead(r) = 0 THEN
                            rdead(r) = 1
                            points = points + life ^ life
                            _TITLE "Rat Points: " + FormatString$(points) + "   Life #" + STR$(life)
                            ba(i) = 0
                        END IF
                    ELSE
                        fcirc bx(i), by(i), 2, _RGB32(30, 60, 80)
                    END IF
                NEXT
            ELSE
                ba(i) = 0
            END IF
        END IF
    NEXT
    _DISPLAY
    _LIMIT 30
WEND
_DELAY 5 'so don't start printing spaces in the editor
CALL HighScore
END

'store points
SUB HighScore
CLS
LOCATE 10, 40
Filename$ = "ratpoints.dat"
IF _FILEEXISTS(Filename$) = 0 THEN
    X = FREEFILE
    OPEN Filename$ FOR OUTPUT AS #X
    PRINT #X, points
    CLOSE #X
    PRINT "High score: "; FormatString$(points)
    END
END IF
'open highscore file
X = FREEFILE
OPEN Filename$ FOR INPUT AS #X
INPUT #X, score#
CLOSE #X
'new highscore
IF points > score# THEN
    X = FREEFILE
    OPEN Filename$ FOR OUTPUT AS #X
    PRINT #X, points
    CLOSE #X
    PRINT "New high score: "; FormatString$(points)
    END
END IF
PRINT "No new high score.."
END
END SUB

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)
IF rdead(i) = 0 THEN 'if rat not dead move it
    rx(i) = rx(i) + rs(i) * COS(rh(i)) + rand(-.1 * rr(i), .1 * rr(i))
    ry(i) = ry(i) + rs(i) * SIN(rh(i)) + rand(-.1 * rr(i), .1 * rr(i))
END IF

'rat collides with shooter?
IF ((rx(i) - shooterX) ^ 2 + (ry(i) - shooterY) ^ 2) ^ .5 < rr(i) + 20 THEN
    FOR rad = 1 TO 350
        fcirc shooterX, shooterY, rad, _RGB32(255 - .25 * rad, 128 - .125 * rad, 0)
        _DISPLAY
        _LIMIT 300
    NEXT
    life = life + 1
    'new set o rats
    FOR i = 0 TO nRats - 1
        newRat i
    NEXT
    IF life <= ratlifes THEN
        _TITLE "Rats Points: " + FormatString$(points) + " - Life #" + STR$(life)
    ELSE
        _TITLE "Rat Points: " + FormatString$(points) + " THE END"
        _DELAY 5 'so don't start printing spaces in the editor
        CALL HighScore
        END
    END IF
    _DISPLAY
    EXIT SUB
END IF

IF rx(i) > 0 AND rx(i) < xmax AND ry(i) > 0 AND ry(i) < ymax THEN 'inbounds
    IF rdead(i) THEN 'show the burn out until reaches rat radius
        rdead(i) = rdead(i) + 2
        IF rdead(i) < rr(i) THEN
            fcirc rx(i), ry(i), rr(i) - rdead(i), _RGB32(255 - rdead(i), 128 - rdead(i), 0)
            _DISPLAY
        ELSE
            newRat i
        END IF
    ELSE
        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)
    END IF
ELSE 'out of bounds
    newRat i
END IF
END SUB

SUB newRat (iRat)
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 * 60 / life + 10
rdead(iRat) = 0
rk(iRat) = ratKolor~&
END SUB

FUNCTION ratKolor~& ()
r% = INT(RND * 140)
g% = rand(INT(.5 * r%), INT(.8 * r%))
b% = rand(INT(.5 * g%), INT(.8 * g%))
ratKolor~& = _RGB32(r%, g%, b%)
END FUNCTION

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)
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

' formats a double numeric string
FUNCTION FormatString$ (s#)
x$ = ""
s$ = STR$(s#)
IF INSTR(s$, "D") THEN ' return string
    FormatString$ = s$
    EXIT FUNCTION
END IF
IF LEFT$(s$, 1) = "-" THEN ' store sign
    e$ = "-"
    s$ = MID$(s$, 2)
END IF
s$ = LTRIM$(s$) ' format string
IF INSTR(s$, ".") THEN
    q$ = MID$(s$, INSTR(s$, "."))
    s$ = LEFT$(s$, INSTR(s$, ".") - 1)
END IF
FOR l = LEN(s$) TO 3 STEP -3
    x$ = MID$(s$, l - 2, 3) + "," + x$
NEXT
IF l > 0 THEN
    x$ = MID$(s$, 1, l) + "," + x$
END IF
IF LEN(s$) < 3 THEN
    x$ = s$
END IF
IF RIGHT$(x$, 1) = "," THEN
    x$ = LEFT$(x$, LEN(x$) - 1)
END IF
x$ = e$ + x$ + q$ ' construct string
FormatString$ = x$
END FUNCTION
dndbbs project:

Links to my MUD: (strictly 16-bit); AKA XP:

Dndbbs executables
http://www.filegate.net/pdn/pdnbasic/dnd50a1e.zip

Dndbbs source
http://www.filegate.net/pdn/pdnbasic/dnd50a1s.zip

Dndbbs upgrade
http://www.filegate.net/pdn/pdnbasic/dnd50a1u.zip

DNDDOOR - https://bit.ly/EriksDNDDoor DUNGEON - https://bit.ly/EriksDungeon
Interpreter - https://bit.ly/EriksSICK Hex Editor - https://bit.ly/EriksHexEditor Utilities - https://bit.ly/EriksUtils
QB45 files: - https://bit.ly/EriksQB45 QB64shell - https://bit.ly/QB64shell Some old QB64 versions: - https://bit.ly/OldQB64
Reply
#9
Hi Erik,

Man you are getting into this! I have shared some thoughts on your latest mod here:
https://www.qb64.org/forum/index.php?topic=330.0
reply QB64 Spiro-Roses

I am surprised most by the slowing down of the bullet speed.
B += x
Reply
#10
I am definitely getting into it, so here's a version where I add the <esc> key to put it into  "autokill"
mode because I got tired of holding down arrow/space:

Code:
_TITLE "eRATication no 2 by bplus 2018-07-16 -ejo"
'QB64 version 2017 1106/82 (the day before they switched to version 1.2)

' 2018-07-13 modified from Asteroids game
' 2018-07-15 eRATication 2
' color rats, eliminate jerks when kill rat,
' decrease rat size as life progresses
' 2018-07-15 some minor changes since post of e #2

' 2018-07-16 adds highscore -ejo
' 2018-07-16 overides ratlifes -ejo
' 2018-07-16 delineates output for commas - ejo

' 2018-07-17 solves ratlifes greater than 10 -ejo

' 2018-07-18 adds <esc> key for autokill -ejo

'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 = 50
CONST nBullets = 2000
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 shooterAngle, shooterX, shooterY, life, walk, autokill
DIM SHARED points AS DOUBLE

'b prefix for bullet, x, y, dx, dy, a for active
DIM SHARED bx(nBullets), by(nBullets), bdx(nBullets), bdy(nBullets), ba(nBullets)

'override ratlifes
DIM SHARED ratlifes AS INTEGER

'get ratlifes
DO
    PRINT "Enter ratlifes(1-10)";: INPUT ratlifes
    ratlifes = INT(ratlifes)
    IF ratlifes > 0 AND ratlifes <= 10 THEN EXIT DO
LOOP

DIM SHARED rx(nRats * ratlifes) AS _UNSIGNED LONG
DIM SHARED ry(nRats * ratlifes) AS _UNSIGNED LONG
DIM SHARED rr(nRats * ratlifes) AS _UNSIGNED LONG
DIM SHARED rh(nRats * ratlifes) AS _UNSIGNED LONG
DIM SHARED rs(nRats * ratlifes) AS _UNSIGNED LONG
DIM SHARED rdead(nRats * ratlifes) AS _UNSIGNED LONG
DIM SHARED rk(nRats * ratlifes) AS _UNSIGNED LONG

'reset start directory
CHDIR _STARTDIR$

life = 1
rats = 5
points = 0
shooterAngle = 0
shooterX = xmax / 2
shooterY = ymax / 2
FOR i = 0 TO nRats - 1
    newRat i
NEXT
WHILE life <= ratlifes
    CLS , _RGB32(188, 178, 168)
    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) THEN shooterAngle = shooterAngle - _PI(1 / 20)
    IF _KEYDOWN(20480) THEN shooterAngle = shooterAngle + _PI(1 / 20)
    IF _KEYDOWN(32) THEN fire = 1 ELSE fire = 0
    IF _KEYDOWN(27) THEN autokill = NOT autokill

    IF autokill THEN shooterAngle = shooterAngle + _PI(1 / 20): fire = 1
    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 rat
                FOR r = 0 TO rats * life
                    IF ((rx(r) - bx(i)) ^ 2 + (ry(r) - by(i)) ^ 2) ^ .5 < .75 * rr(r) THEN
                        IF rdead(r) = 0 THEN
                            rdead(r) = 1
                            points = points + life ^ life
                            _TITLE "Rat Points: " + FormatString$(points) + "   Life #" + STR$(life)
                            ba(i) = 0
                        END IF
                    ELSE
                        fcirc bx(i), by(i), 2, _RGB32(30, 60, 80)
                    END IF
                NEXT
            ELSE
                ba(i) = 0
            END IF
        END IF
    NEXT
    _DISPLAY
    _LIMIT 30
WEND
_DELAY 5 'so don't start printing spaces in the editor
CALL HighScore
END

'store points
SUB HighScore
CLS
LOCATE 10, 40
Filename$ = "ratpoints.dat"
IF _FILEEXISTS(Filename$) = 0 THEN
    X = FREEFILE
    OPEN Filename$ FOR OUTPUT AS #X
    PRINT #X, points
    CLOSE #X
    PRINT "High score: "; FormatString$(points)
    END
END IF
'open highscore file
X = FREEFILE
OPEN Filename$ FOR INPUT AS #X
INPUT #X, score#
CLOSE #X
'new highscore
IF points > score# THEN
    X = FREEFILE
    OPEN Filename$ FOR OUTPUT AS #X
    PRINT #X, points
    CLOSE #X
    PRINT "New high score: "; FormatString$(points)
    END
END IF
PRINT "No new high score.."
END
END SUB

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)
IF rdead(i) = 0 THEN 'if rat not dead move it
    rx(i) = rx(i) + rs(i) * COS(rh(i)) + rand(-.1 * rr(i), .1 * rr(i))
    ry(i) = ry(i) + rs(i) * SIN(rh(i)) + rand(-.1 * rr(i), .1 * rr(i))
END IF

'rat collides with shooter?
IF ((rx(i) - shooterX) ^ 2 + (ry(i) - shooterY) ^ 2) ^ .5 < rr(i) + 20 THEN
    FOR rad = 1 TO 350
        fcirc shooterX, shooterY, rad, _RGB32(255 - .25 * rad, 128 - .125 * rad, 0)
        _DISPLAY
        _LIMIT 300
    NEXT
    life = life + 1
    'new set o rats
    FOR i = 0 TO nRats - 1
        newRat i
    NEXT
    IF life <= ratlifes THEN
        _TITLE "Rats Points: " + FormatString$(points) + " - Life #" + STR$(life)
    ELSE
        _TITLE "Rat Points: " + FormatString$(points) + " THE END"
        _DELAY 5 'so don't start printing spaces in the editor
        CALL HighScore
        END
    END IF
    _DISPLAY
    EXIT SUB
END IF

IF rx(i) > 0 AND rx(i) < xmax AND ry(i) > 0 AND ry(i) < ymax THEN 'inbounds
    IF rdead(i) THEN 'show the burn out until reaches rat radius
        rdead(i) = rdead(i) + 2
        IF rdead(i) < rr(i) THEN
            fcirc rx(i), ry(i), rr(i) - rdead(i), _RGB32(255 - rdead(i), 128 - rdead(i), 0)
            _DISPLAY
        ELSE
            newRat i
        END IF
    ELSE
        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)
    END IF
ELSE 'out of bounds
    newRat i
END IF
END SUB

SUB newRat (iRat)
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 * 60 / life + 10
rdead(iRat) = 0
rk(iRat) = ratKolor~&
END SUB

FUNCTION ratKolor~& ()
r% = INT(RND * 140)
g% = rand(INT(.5 * r%), INT(.8 * r%))
b% = rand(INT(.5 * g%), INT(.8 * g%))
ratKolor~& = _RGB32(r%, g%, b%)
END FUNCTION

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)
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

' formats a double numeric string
FUNCTION FormatString$ (s#)
x$ = ""
s$ = STR$(s#)
IF INSTR(s$, "D") THEN ' return string
    FormatString$ = s$
    EXIT FUNCTION
END IF
IF LEFT$(s$, 1) = "-" THEN ' store sign
    e$ = "-"
    s$ = MID$(s$, 2)
END IF
s$ = LTRIM$(s$) ' format string
IF INSTR(s$, ".") THEN
    q$ = MID$(s$, INSTR(s$, "."))
    s$ = LEFT$(s$, INSTR(s$, ".") - 1)
END IF
FOR l = LEN(s$) TO 3 STEP -3
    x$ = MID$(s$, l - 2, 3) + "," + x$
NEXT
IF l > 0 THEN
    x$ = MID$(s$, 1, l) + "," + x$
END IF
IF LEN(s$) < 3 THEN
    x$ = s$
END IF
IF RIGHT$(x$, 1) = "," THEN
    x$ = LEFT$(x$, LEN(x$) - 1)
END IF
x$ = e$ + x$ + q$ ' construct string
FormatString$ = x$
END FUNCTION
dndbbs project:

Links to my MUD: (strictly 16-bit); AKA XP:

Dndbbs executables
http://www.filegate.net/pdn/pdnbasic/dnd50a1e.zip

Dndbbs source
http://www.filegate.net/pdn/pdnbasic/dnd50a1s.zip

Dndbbs upgrade
http://www.filegate.net/pdn/pdnbasic/dnd50a1u.zip

DNDDOOR - https://bit.ly/EriksDNDDoor DUNGEON - https://bit.ly/EriksDungeon
Interpreter - https://bit.ly/EriksSICK Hex Editor - https://bit.ly/EriksHexEditor Utilities - https://bit.ly/EriksUtils
QB45 files: - https://bit.ly/EriksQB45 QB64shell - https://bit.ly/QB64shell Some old QB64 versions: - https://bit.ly/OldQB64
Reply