'===========================================================================
' Subject: SPACESHIP SHOOTER GAME             Date: 08-23-98 (15:44)       
'  Author: Ross Harper                        Code: QB, QBasic, PDS        
'  Origin: Peachy512@yahoo.com              Packet: GAMES.ABC
'===========================================================================
'' Hello there.  Peachy here.  This was a little game I cooked up while being
'' bored to tears on an IT traineeship this summer ('98).  While writing it
'' I thought it was great.  THEN I came and saw what some other ABC
'' programmers had done!  Great work guys and gals.  It makes this game look
'' puny.  (Most things look this game look puny!)
'' Errr...e-mail me with critisism (please!): Peachy512@yahoo.com
'' or visit my message board with some kind remarks and some funny thoughts
'' http://www.insidetheweb.com/messageboard/mbs.cgi/mb101664
'' Thanks.
''
'' Peachy
'' 19 August '98
''
DECLARE SUB keys ()
DECLARE FUNCTION ask! ()
DECLARE SUB destroyed ()
DECLARE SUB box (q1!, a1!, q2!, a2!, col!)
DECLARE SUB bar (q1!, a1!, q2!, a2!, col!)
DECLARE SUB fancywipe ()
DECLARE SUB scrolltext (text$, Y!, col!)
DECLARE SUB title ()
DECLARE SUB mpause (zog!)
DECLARE SUB definestars ()
DECLARE SUB drawstars (col!)
DECLARE SUB defineemys ()
DECLARE SUB drawenemy (col!, n!)
DECLARE SUB ship (X!, Y!, col!)
DECLARE SUB movestars ()
DECLARE SUB moveenemies ()
DECLARE SUB explode (z1!)
DECLARE SUB subroutine ()
DECLARE SUB pause ()
DECLARE SUB win ()
DECLARE SUB ResetPal ()
DECLARE SUB Pal (Pn!, I!, C!)
DECLARE SUB GetOrigPal ()
DECLARE SUB RestorePal ()
DECLARE FUNCTION Bucket! (I!, C1!, C2!)
COMMON SHARED C1, C2, C3, C4
COMMON SHARED stars, X, Y, emys, scr, minrad, maxrad, str, firelim, snd, cheat1, cheat$
COMMON SHARED shots, killed, pstr, arseburgers
arseburgers = 0
title
SCREEN 9
CLS
X = 100: Y = 100: stars = 100: shots = 5: emys = 5: minrad = 20: maxrad = 50
sht = 1: str = 3: level = 1: firelim = 640: snd = 1: porig = 50
a = ask
IF a = 1 THEN pstr = 50
IF a = 2 THEN pstr = 20
IF a = 3 THEN pstr = 5
DIM SHARED starx(stars), stary(stars), starcol(stars)
DIM fire(shots), firex(shots), firey(shots)
DIM SHARED enemyx(emys), enemyy(emys), enemyr(emys), estr(emys), emyfire(emys)
DIM SHARED graph(6400)
starty:
CLS
definestars
defineemys
drawstars (15)
defineemys
FOR z1 = 1 TO emys
        CALL drawenemy(3, z1)
NEXT z1
CALL ship(X, Y, 15)
CALL bar(2, 307, pstr * 5, 323, 13)
CALL box(1, 306, porig * 5 + 1, 324, 12)
COLOR 15: LOCATE 21, 2: PRINT "Energy"
DO
        COLOR 15, 0
        LOCATE 1, 1: PRINT "Score "; scr
        LOCATE 2, 1: PRINT "Level "; level
        a$ = LCASE$(INKEY$)
        cheat$ = cheat$ + a$
        IF a$ = "m" AND snd = 1 THEN cheat$ = "": snd = 0
        IF a$ = "m" AND snd = 0 THEN cheat$ = "": snd = 1
        IF a$ = CHR$(0) + "d" THEN cheat$ = "": SHELL "cls": SHELL "command": CLS : CALL ship(X, Y, 15)
        IF a$ = CHR$(0) + "h" THEN cheat$ = "": CALL ship(X, Y, 0): Y = Y - 5: CALL ship(X, Y, 15)
        IF a$ = CHR$(0) + "p" THEN cheat$ = "": CALL ship(X, Y, 0): Y = Y + 5: CALL ship(X, Y, 15)
        IF a$ = CHR$(0) + "k" THEN cheat$ = "": CALL ship(X, Y, 0): X = X - 5: CALL ship(X, Y, 15)
        IF a$ = CHR$(0) + "m" THEN cheat$ = "": CALL ship(X, Y, 0): X = X + 5: CALL ship(X, Y, 15)
        IF a$ = " " AND fire(sht) = 0 THEN
                cheat$ = ""
                IF snd = 1 THEN SOUND 350, 1
                fire(sht) = 1: firey(sht) = Y + 20: firex(sht) = X + 100
                sht = sht + 1
                IF sht = shots THEN sht = 1
        END IF
        movestars
        moveenemies
        FOR z = 1 TO shots
                IF fire(z) = 1 THEN
                        COLOR 0
                        LINE (firex(z), firey(z))-(firex(z) + 20, firey(z))
                        firex(z) = firex(z) + 10
                        COLOR z
                        LINE (firex(z), firey(z))-(firex(z) + 20, firey(z))
                        IF firex(z) > X + firelim THEN
                                fire(z) = 0
                                COLOR 0
                                LINE (firex(z), firey(z))-(firex(z) + 20, firey(z))
                        END IF
                END IF
                ''checkhit
                FOR z1 = 1 TO emys
                        IF fire(z) = 1 THEN
                                IF firex(z) > enemyx(z1) - enemyr(z1) THEN
                                        IF firex(z) < enemyx(z1) + enemyr(z1) THEN
                                                IF firey(z) > enemyy(z1) - enemyr(z1) THEN
                                                        IF firey(z) < enemyy(z1) + enemyr(z1) THEN
                                                                estr(z1) = estr(z1) - 1
                                                                IF estr(z1) = 0 THEN explode (z1)
                                                                IF killed = emys THEN GOTO endybit
                                                                fire(z) = 0
                                                                COLOR 0
                                                                LINE (firex(z), firey(z))-(firex(z) + 20, firey(z))
                                                        END IF
                                                END IF
                                        END IF
                                END IF
                        END IF
                NEXT z1
        NEXT z
                ''check for ship hit
                FOR z1 = 1 TO emys
                        IF enemyx(z1) > X AND enemyx(z1) < X + 100 AND enemyy(z1) > Y AND enemyy(z1) < Y + 20 AND enemyr(z1) > 0 THEN
                                pstr = pstr - 1
                                CALL bar(pstr * 5, 307, porig * 5, 323, 0)
                        END IF
                NEXT z1
        subroutine
        IF cheat1 = 0 THEN pause
        a$ = ""
LOOP
endybit:
CALL ship(X, Y, 0)
FOR x1 = X TO 650 STEP 10
        CALL ship(x1, Y, 15)
        IF cheat1 = 0 THEN pause
        CALL ship(x1, Y, 0)
NEXT x1
IF level = 10 THEN win
maxrad = maxrad - 2
minrad = minrad - 2
killed = 0: str = str + 1
level = level + 1
firelim = firelim - 50
CLS
COLOR 15: PRINT "Press any key to enter next zone!"
SLEEP
GOTO starty

FUNCTION ask
CLS

PRINT "Difficulty Level?"
PRINT "1 - You call this a game?"
PRINT "2 - This could hurt!"
PRINT "3 - Kicking Bishop Brenan up the ass"
go:
INPUT a
IF a < 1 OR a > 3 THEN GOTO go
ask = a
END FUNCTION

SUB bar (q1, a1, q2, a2, col)
COLOR col
LINE (q1, a1)-(q2, a1)
LINE (q2, a1)-(q2, a2)
LINE (q2, a2)-(q1, a2)
LINE (q1, a2)-(q1, a1)
PAINT (q1 + 1, a1 + 1), col, col
END SUB

SUB box (q1, a1, q2, a2, col)
COLOR col
LINE (q1, a1)-(q2, a1)
LINE (q2, a1)-(q2, a2)
LINE (q2, a2)-(q1, a2)
LINE (q1, a2)-(q1, a1)
END SUB

SUB defineemys
FOR n = 1 TO emys
        enemyx(n) = INT(RND * 100) + 500
        enemyy(n) = INT(RND * 200) + 20
        enemyr(n) = INT(RND * maxrad) + minrad
        estr(n) = str
NEXT n
END SUB

SUB definestars
FOR n = 1 TO stars
        RANDOMIZE TIMER
        starx(n) = INT(RND * 640) + 1
        stary(n) = INT(RND * 290) + 1
        zog = INT(RND * 3) + 1
        IF zog = 1 THEN starcol(n) = 15
        IF zog = 2 THEN starcol(n) = 7
        IF zog = 3 THEN starcol(n) = 8
NEXT n
END SUB

SUB destroyed
CLS
COLOR 15
PRINT "Hmmmmm..."
PRINT "The Earth doesn't look too pretty now."
PRINT "And neither do you."
PRINT "You're final score was "; scr

END
END SUB

SUB drawenemy (col, n)
COLOR col
CIRCLE (enemyx(n), enemyy(n)), enemyr(n)
'LINE (enemyx(n) - enemyr(n), enemyy(n))-(enemyx(n) + enemyr(n), enemyy(n))
'LINE (enemyx(n), enemyy(n) - enemyr(n))-(enemyx(n), enemyy(n) + enemyr(n))
END SUB

SUB drawstars (col)
FOR n = 1 TO stars
        IF col = 0 THEN COLOR 0
        IF col <> 0 THEN COLOR starcol(n)
        PSET (starx(n), stary(n))
NEXT n
END SUB

SUB explode (z1)
RANDOMIZE TIMER
''define bits
bits = 250
DIM bitx(bits), bity(bits)
FOR n = 1 TO bits
        bitx(n) = enemyx(z1) - enemyr(z1) + INT(RND * (enemyr(z1) * 2))
        bity(n) = enemyy(z1) - enemyr(z1) + INT(RND * (enemyr(z1) * 2))
NEXT n
''draw bits
'FOR n = 1 TO bits
'        IF snd = 1 THEN SOUND INT(RND * 300) + 100, .1
'        COLOR INT(RND * 15) + 1
'        PSET (bitx(n), bity(n))
'NEXT n
'''erase bits
'FOR n = 1 TO bits
'        COLOR 0
'        PSET (bitx(n), bity(n))
'NEXT n
COLOR 4
FOR n = 1 TO enemyr(z1) + 10
        IF snd = 1 THEN SOUND INT(RND * 300) + 100, .1
        CIRCLE (enemyx(z1), enemyy(z1)), n
NEXT n
COLOR 0
FOR n = 1 TO enemyr(z1) + 10
        CIRCLE (enemyx(z1), enemyy(z1)), n
NEXT n

CALL drawenemy(0, z1)
enemyx(z1) = 0: enemyy(z1) = 0: enemyr(z1) = 0
scr = scr + 10: killed = killed + 1
END SUB

SUB keys
DO
a$ = INKEY$
LOOP UNTIL a$ <> ""
END SUB

SUB moveenemies
FOR n = 1 TO emys
        RANDOMIZE TIMER
        CALL drawenemy(0, n)
        enemyx(n) = enemyx(n) - 10
        ross = INT(RND * 5) + 1
        IF ross = 1 THEN enemyy(n) = enemyy(n) - 10
        IF ross = 2 THEN enemyy(n) = enemyy(n) + 10
        IF ross = 3 THEN emyfire(n) = 1
        CALL drawenemy(3, n)
        IF enemyx(n) < 1 THEN
                CALL drawenemy(0, n)
                enemyx(n) = 640: enemyy(n) = INT(RND * 300) + 20
        END IF
        IF enemyy(n) < 5 THEN
                CALL drawenemy(0, n)
                enemyy(n) = 5
        END IF
        IF enemyy(n) > 200 THEN
                CALL drawenemy(0, n)
                enemyy(n) = 200
        END IF
NEXT n
END SUB

SUB movestars
drawstars (0)
FOR n = 1 TO stars
        IF starcol(n) = 15 THEN starx(n) = starx(n) - 20
        IF starcol(n) = 7 THEN starx(n) = starx(n) - 5
        IF starcol(n) = 8 THEN starx(n) = starx(n) - 2
        IF starx(n) < 2 THEN starx(n) = 640: stary(n) = INT(RND * 290) + 1
NEXT n
drawstars (15)
END SUB

SUB mpause (zog)
FOR n = 1 TO zog
        pause
        a$ = INKEY$
        IF a$ <> "" THEN n = zog
NEXT n
EXIT SUB
END SUB

SUB pause
startime = (TIMER)
DO
LOOP UNTIL (TIMER) <> startime
END SUB

SUB scrolltext (text$, Y, col)
IF col <> 16 THEN COLOR col
'FOR n = 1 TO 40 - LEN(text$) / 2
n = 1
DO
        IF col = 16 THEN COLOR INT(RND * 15) + 1
        LOCATE Y, n: PRINT " " + text$ + " "
        pause
        n = n + 1
        IF n >= 40 - LEN(text$) / 2 THEN GOTO endybit1
        a$ = INKEY$
        IF a$ <> "" THEN arseburgers = 1: EXIT SUB
LOOP
'NEXT n
endybit1:
END SUB

SUB ship (X, Y, col)
COLOR col
'dorsal wing
LINE (X, Y)-(X + 20, Y)
LINE (X, Y)-(X, Y + 10)
LINE (X, Y + 10)-(X + 25, Y + 10)
LINE (X + 25, Y + 10)-(X + 20, Y)
'body
LINE (X, Y + 10)-(X - 5, Y + 10)
LINE (X - 5, Y + 10)-(X, Y + 20)
LINE (X, Y + 20)-(X + 50, Y + 20)
LINE (X + 50, Y + 20)-(X + 55, Y + 15)
LINE (X + 55, Y + 15)-(X + 25, Y + 10)
'wing
LINE (X + 5, Y + 20)-(X - 5, Y + 25)
LINE (X - 5, Y + 25)-(X + 35, Y + 25)
LINE (X + 35, Y + 25)-(X + 30, Y + 20)
'gun
LINE (X + 35, Y + 20)-(X + 100, Y + 20)
END SUB

SUB subroutine
IF X < 10 THEN CALL ship(X, Y, 0): X = 10: CALL ship(X, Y, 15)
IF X > 300 THEN CALL ship(X, Y, 0): X = 300: CALL ship(X, Y, 15)
IF Y < 20 THEN CALL ship(X, Y, 0): Y = 20: CALL ship(X, Y, 15)
IF Y > 250 THEN CALL ship(X, Y, 0): Y = 250: CALL ship(X, Y, 15)
IF cheat$ = "run" THEN BEEP: cheat$ = "": cheat1 = 1
IF cheat$ = "bang" THEN
        BEEP
        FOR n = 1 TO emys - 1
                explode (n)
        NEXT n
        cheat$ = ""
END IF
IF pstr < 0 THEN
        COLOR 14
        FOR n = 1 TO 100
                IF snd = 1 THEN SOUND INT(RND * 300) + 100, .1
                CIRCLE (X, Y), n
        NEXT n
        COLOR 0
        FOR n = 1 TO 100
                CIRCLE (X, Y), n
        NEXT n
destroyed
END IF
END SUB

SUB title
SCREEN 9
CALL scrolltext("Peachy's Perfectly Prestigious Productions Present", 12, 4): mpause (25)
IF arseburgers = 1 THEN EXIT SUB
CALL scrolltext("A Game", 14, 5): mpause (25)
IF arseburgers = 1 THEN EXIT SUB
CALL scrolltext("With funny blue asteroids and a wierd looking ship", 16, 6): mpause (25)
IF arseburgers = 1 THEN EXIT SUB
CALL scrolltext("P L A N E T  D E S T R O Y E R S", 19, 16): mpause (50)
IF arseburgers = 1 THEN EXIT SUB
CLS
COLOR 15
PRINT "S T O R Y"
'PRINT
PRINT "There you were out in deep space in your brand new KASUL-MINE 4X ship when"
PRINT "suddenly a strange never-before-seen light begins flashing on the display in"
PRINT "front of you.  Checking it out in the manual hidden under the seat, you "
PRINT "discover that the light is none other than the 'Blue-Asteroids-Approaching-"
PRINT "Earth-And-Will-Destroy-Planet-On-Contact' alarm."
PRINT "It's either charge up your guns and take on the asteroids yourself or find"
PRINT "another holdiay location."
PRINT "The way you see it, no-where is as good as Morcombe!"
PRINT
PRINT "I N S T R U C T I O N S"
'PRINT
PRINT "Use the arrow keys to move"
PRINT "Press space to fire"
PRINT "As the levels progress, the asteroids will take more hits to destroy "
PRINT "and will get smaller and more difficult to hit."
PRINT "If the asteroids make contact with your ship, you lose energy.  When"
PRINT "you have no energy left (see bar at bottom of play screen) your ship"
PRINT "will explode!"
PRINT "Also, as the levels progress, your fire distance will decrease, meaning"
PRINT "that you need to get closer to the asteroids to shoot them."
'PRINT
PRINT "The future of humanity is counting on you."
PRINT "No pressure!"
PRINT "Press a key to enter the fray."
SLEEP

END SUB

SUB win
SCREEN 9
CLS
COLOR 15
PRINT "You win with a score of "; scr; "!"
PRINT
PRINT "Press a key": SLEEP
CLS
PRINT "You have been playing Planet Destroyers by me (Peachy512@yahoo.com)."
PRINT "I didn't know QB could do so much until I went to the ABC archive "
PRINT "place.  Now, this pitiful little game looks terrible.  Never mind!"
PRINT "I'll learn."
PRINT
PRINT "Things that I was chuffed with:"
PRINT
PRINT "Multiple shots on screen at one time"
PRINT "Paralax starfield"
PRINT "Energy bar"
PRINT
PRINT "Press a key for a few acknowledgments...": keys
CLS
CALL scrolltext("Greetings and Thanks go to:", 1, 2): mpause (10)
CALL scrolltext("Juliet of ex-Padded Room", 3, 4): mpause (10)
CALL scrolltext("www.insidetheweb.com/messageboard/mbs.cgi/mb86780", 4, 4)
CALL scrolltext("Face of Warehouse", 6, 6): mpause (10)
CALL scrolltext("www.insidetheweb.com/messageboard/mbs.cgi/mb480", 7, 6)
CALL scrolltext("Jordan of House of Bull", 9, 10): mpause (10)
CALL scrolltext("www.insidetheweb.com/messageboard/mbs.cgi/mb92077", 10, 10)
CALL scrolltext("Swete Pete of Spamhaus", 12, 12): mpause (10)
CALL scrolltext("www.insidetheweb.com/messageboard/mbs.cgi/mb80190", 13, 12)
CALL scrolltext("Press a key to end", 20, 15)

END
END SUB