Skip to content

Instantly share code, notes, and snippets.

@jlong
Created May 4, 2015
Embed
What would you like to do?
' $DYNAMIC
DEFINT A-Z
DECLARE SUB GLoad (FileName AS STRING, GLoadArray() AS INTEGER)
DECLARE SUB GSave (x1 AS SINGLE, y1 AS SINGLE, x2 AS SINGLE, y2 AS SINGLE, FileName AS STRING)
DECLARE SUB DoWarHead ()
DECLARE SUB DrawWarHead (X AS INTEGER, Y AS INTEGER)
DECLARE SUB DoLasers ()
DECLARE SUB AddLaser (X AS INTEGER, Y AS INTEGER, Speed AS INTEGER, typ AS INTEGER, c AS INTEGER)
DECLARE SUB KillLaser (ID AS LONG)
DECLARE SUB PlayGame ()
DECLARE SUB DrawPurpleStealth (X AS SINGLE, Y AS SINGLE)
DECLARE SUB DoEnemy ()
DECLARE SUB EndGame ()
DECLARE SUB DrawShieldBar ()
DECLARE SUB DoIntro ()
DECLARE SUB FadeInStars ()
DECLARE SUB FadeInText (col AS INTEGER, row AS INTEGER, text AS STRING)
DECLARE SUB FadeOutText (col AS INTEGER, row AS INTEGER, text AS STRING)
DECLARE SUB DrawStars ()
DECLARE SUB EraseSlowType (col AS INTEGER, row AS INTEGER, text AS STRING)
DECLARE SUB Intro ()
DECLARE SUB SlowType (col AS INTEGER, row AS INTEGER, text AS STRING)
DECLARE SUB CLPrint (c AS INTEGER, col AS INTEGER, row AS INTEGER, text AS STRING)
DECLARE SUB Mouse (cx, dx, bx)
DECLARE SUB MousePointer (SW)
DECLARE SUB DrawStealth (X AS INTEGER, Y AS INTEGER)
'Mouse Setup
DIM SHARED a(9) 'Set up array for code
DEF SEG = VARSEG(a(0)) 'Get array segment (nnnn: )
' (two 8 bit)
FOR i = 0 TO 17 'length of DATA to
READ r 'read
POKE VARPTR(a(0)) + i, r 'into array/2 (nnnn:iiii) (one 8 bit)
NEXT i 'until 17
DATA &HB8,&H00,&H00 : ' mov AX,[n] [Swap code-(L),(H)] in AX
DATA &H55 : ' push BP Save BP
DATA &H8B,&HEC : ' mov BP,SP Get BP to c Seg
DATA &HCD,&H33 : ' int 33 Interrupt 33
DATA &H92 : ' xchg AX,[reg] [Swap code-reg] in AX
DATA &H8B,&H5E,&H06 : ' mov BX,[BP+6] Point to (variable)
DATA &H89,&H07 : ' mov [BX],AX Put AX in (variable)
DATA &H5D : ' pop BP Restore BP
DATA &HCA,&H02,&H00 : ' ret 2 Far return
CALL MousePointer(0) 'Reset mouse and
CALL MousePointer(1) 'turn pointer on
CALL MousePointer(3) 'Get coordinates
'****************************************************************************
' Program
'****************************************************************************
TYPE aStar
X AS INTEGER
Y AS SINGLE
c AS INTEGER
END TYPE
TYPE Stlth
X AS INTEGER
Y AS INTEGER
ReTime AS INTEGER
END TYPE
TYPE Enmy
X AS SINGLE
Y AS SINGLE
ReTime AS INTEGER
END TYPE
TYPE Lazer
X AS SINGLE
Y AS SINGLE
Speed AS SINGLE
typ AS INTEGER
c AS INTEGER
ID AS LONG
END TYPE
TYPE WarH
X AS INTEGER
Y AS INTEGER
ReTime AS INTEGER
END TYPE
CONST LeftButton = 1
CONST RightButton = 2
CONST CompSpeed = 2
CONST NumLevels = 10
CONST EnemyLaser = 1
CONST StealthLaser = 2
CONST NormalMode = 0
CONST WarHeadMode = 1
CONST WarHeadExplodingMode = 2
CONST AppDir = "A:\"
DIM SHARED Key$
DIM SHARED Star(1 TO 100) AS aStar
DIM SHARED Enemy(1 TO NumLevels) AS Enmy
DIM SHARED Laser(0) AS Lazer
DIM SHARED Shields AS INTEGER
DIM SHARED Stealth AS Stlth
DIM SHARED NoIntro AS INTEGER
DIM SHARED NumKilled AS INTEGER
DIM SHARED Level AS INTEGER
DIM SHARED NumLasers AS INTEGER
DIM SHARED WarHead AS WarH
DIM SHARED NumWarHeads AS INTEGER
DIM SHARED GameMode AS INTEGER
DEF fnRan (X) = INT(RND * X) + 1
Shields = 100
NoIntro = 0
NumWarHeads = 5
WarHead.ReTime = 5
SCREEN 13
CLS
RANDOMIZE TIMER
FOR i = 1 TO 100
Star(i).X = fnRan(320)
Star(i).Y = fnRan(200)
NEXT i
IF NoIntro = 1 THEN
SLEEP 2
FadeInStars
ELSE
DoIntro
END IF
FOR e = 1 TO NumLevels
Enemy(e).X = fnRan(300)
Enemy(e).Y = -100
NEXT e
PlayGame
EndGame
REM $STATIC
SUB AddLaser (X AS INTEGER, Y AS INTEGER, Speed AS INTEGER, typ AS INTEGER, c AS INTEGER)
STATIC NewID AS LONG
IF NewID = 10000 THEN NewID = 0
IF NumLasers <> 0 THEN
DIM CopyLaser(1 TO NumLasers) AS Lazer
FOR i = 1 TO NumLasers
CopyLaser(i).X = Laser(i).X
CopyLaser(i).Y = Laser(i).Y
CopyLaser(i).Speed = Laser(i).Speed
CopyLaser(i).typ = Laser(i).typ
CopyLaser(i).c = Laser(i).c
CopyLaser(i).ID = Laser(i).ID
NEXT i
ERASE Laser
REDIM Laser(1 TO NumLasers + 1)
FOR i = 1 TO NumLasers
Laser(i).X = CopyLaser(i).X
Laser(i).Y = CopyLaser(i).Y
Laser(i).Speed = CopyLaser(i).Speed
Laser(i).typ = CopyLaser(i).typ
Laser(i).c = CopyLaser(i).c
Laser(i).ID = CopyLaser(i).ID
NEXT i
Laser(NumLasers + 1).X = X
Laser(NumLasers + 1).Y = Y
Laser(NumLasers + 1).Speed = Speed
Laser(NumLasers + 1).typ = typ
Laser(NumLasers + 1).c = c
Laser(NumLasers + 1).ID = NewID
ELSE
ERASE Laser
REDIM Laser(1 TO 1)
Laser(NumLasers + 1).X = X
Laser(NumLasers + 1).Y = Y
Laser(NumLasers + 1).Speed = Speed
Laser(NumLasers + 1).typ = typ
Laser(NumLasers + 1).c = c
Laser(NumLasers + 1).ID = NewID
END IF
NumLasers = NumLasers + 1
END SUB
DEFSNG A-Z
SUB CLPrint (c AS INTEGER, col AS INTEGER, row AS INTEGER, text AS STRING)
COLOR c
LOCATE col, row
PRINT text
END SUB
DEFINT A-Z
SUB DoEnemy
STATIC Initialized AS INTEGER
STATIC eTime AS INTEGER
STATIC RechargeLaser AS INTEGER
FOR e = 1 TO Level
LINE (Enemy(e).X - 20, Enemy(e).Y + 10)-(Enemy(e).X + 20, Enemy(e).Y - 15), 0, BF
NEXT e
FOR e = 1 TO Level
Enemy(e).Y = Enemy(e).Y + (.5 * CompSpeed)
IF Enemy(e).Y > 300 THEN
Enemy(e).X = fnRan(320 \ Level) + ((320 \ Level) * (e - 1))
Enemy(e).Y = fnRan(-400)
END IF
Enemy(e).X = Enemy(e).X + (fnRan(10) - 5)
IF Enemy(e).X > 300 THEN Enemy(e).X = 300
IF Enemy(e).X < 20 THEN Enemy(e).X = 20
DrawPurpleStealth Enemy(e).X, Enemy(e).Y
NEXT e
FOR e = 1 TO Level
IF Enemy(e).X < Stealth.X + 20 AND Enemy(e).X > Stealth.X - 20 AND Enemy(e).Y < Stealth.Y - 20 AND Enemy(e).Y > 20 AND Stealth.Y <> 300 THEN
IF RechargeLaser >= (100 \ Level) THEN
SOUND 700, 1
SOUND 1000, 1
AddLaser INT(Enemy(e).X), INT(Enemy(e).Y + 14), 16, EnemyLaser, 57
RechargeLaser = 0
END IF
IF RechargeLaser < (100 \ Level) THEN RechargeLaser = RechargeLaser + 1
END IF
IF Enemy(e).X < Stealth.X + 20 AND Enemy(e).X > Stealth.X - 20 AND Enemy(e).Y > Stealth.Y - 20 AND Enemy(e).Y < Stealth.Y + 20 THEN
Enemy(e).Y = 300
EndGame
END IF
NEXT e
END SUB
SUB DoIntro
SLEEP 2
FadeInText 11, 12, "JWL PRODUCTIONS"
FadeInText 13, 14, "Presents..."
SLEEP 2
FadeOutText 11, 12, "JWL PRODUCTIONS"
FadeOutText 13, 14, "Presents..."
SLEEP 2
SlowType 12, 11, " STEALTH FIGHTER "
SLEEP 2
FadeInStars
DO
Key$ = INKEY$
DrawStars
Mouse cx, dx, bx
IF bx = LeftButton THEN
Key$ = " "
END IF
LOOP UNTIL Key$ <> ""
EraseSlowType 12, 11, " STEALTH FIGHTER "
END SUB
SUB DoLasers
IF NumLasers = 0 THEN EXIT SUB
FOR i = 1 TO NumLasers
LINE (Laser(i).X, Laser(i).Y - 4)-(Laser(i).X, Laser(i).Y + 4), 0
NEXT i
FOR i = NumLasers TO 1 STEP -1
10 Laser(i).Y = Laser(i).Y + Laser(i).Speed
IF Laser(i).typ = EnemyLaser THEN
IF Laser(i).X > Stealth.X - 20 AND Laser(i).X < Stealth.X + 20 THEN
IF (Laser(i).Y - 4) > (Stealth.Y - 10) AND (Laser(i).Y + 4) < (Stealth.Y + 10) THEN
PLAY "MF"
FOR s = 1 TO 10
CIRCLE (Stealth.X, Stealth.Y), s * 2, s + 35
CIRCLE (Stealth.X, Stealth.Y), s * 2 - 1, s + 35
SOUND (200 - (s * 10)), .5
NEXT s
PLAY "MB"
KillLaser Laser(i).ID
Shields = Shields - 10
IF Shields = 0 THEN EndGame
LINE (Stealth.X - 30, Stealth.Y + 25)-(Stealth.X + 30, Stealth.Y - 20), 0, BF
DrawStealth Stealth.X, Stealth.Y
EXIT FOR
END IF
END IF
ELSEIF Laser(i).typ = StealthLaser THEN
FOR e = 1 TO Level
IF Laser(i).X > Enemy(e).X - 20 AND Laser(i).X < Enemy(e).X + 20 THEN
IF Laser(i).Y > Enemy(e).Y - 10 AND Laser(i).Y < Enemy(e).Y + 10 THEN
IF Enemy(e).Y > -5 THEN
PLAY "MF"
FOR s = 1 TO 10
CIRCLE (Enemy(e).X, Enemy(e).Y), s * 2, s + 35
CIRCLE (Enemy(e).X, Enemy(e).Y), s * 2 - 1, s + 35
SOUND (200 - (s * 10)), .05
NEXT s
FOR s = 10 TO 1 STEP -1
CIRCLE (Enemy(e).X, Enemy(e).Y), s * 2, 0
CIRCLE (Enemy(e).X, Enemy(e).Y), s * 2 - 1, 0
SOUND (200 - (s * 10)), .25
NEXT s
PLAY "MB"
KillLaser Laser(i).ID
LINE (Enemy(e).X - 20, Enemy(e).Y + 10)-(Enemy(e).X + 20, Enemy(e).Y - 15), 0, BF
DrawStealth Stealth.X, Stealth.Y
Enemy(e).X = fnRan(320 \ Level) + ((320 \ Level) * (e - 1))
Enemy(e).Y = fnRan(-400)
NumKilled = NumKilled + 1
IF NumKilled MOD 10 = 0 THEN
Level = Level + 1
IF Level > NumLevels THEN
SlowType 12, 16, "You Win!"
SLEEP 2
EraseSlowType 12, 16, "You Win!"
SLEEP 2
EndGame
END IF
END IF
EXIT FOR
END IF
END IF
END IF
NEXT e
END IF
NEXT i
FOR i = NumLasers TO 1 STEP -1
IF Laser(i).Y > 200 OR Laser(i).Y < -5 THEN
KillLaser Laser(i).ID
ELSE
LINE (Laser(i).X, Laser(i).Y - 4)-(Laser(i).X, Laser(i).Y + 4), Laser(i).c
END IF
NEXT i
END SUB
SUB DoWarHead
PLAY "MF"
IF GameMode = WarHeadMode THEN
LINE (WarHead.X - 3, WarHead.Y - 3)-(WarHead.X + 3, WarHead.Y + 9), 0, BF
WarHead.Y = WarHead.Y - 4
DrawWarHead WarHead.X, WarHead.Y
IF WarHead.Y < -10 THEN
GameMode = NormalMode
END IF
ELSEIF GameMode = WarHeadExplodingMode THEN
GameMode = NormalMode
FOR s = 1 TO 10
FOR i = 0 TO 6
CIRCLE (WarHead.X, WarHead.Y), s * 7 - i, 35 + s
NEXT i
SOUND (200 - (s * 10)), 1
NEXT s
FOR e = 1 TO Level
IF SQR(((Enemy(e).X - WarHead.X) * (Enemy(e).X - WarHead.X)) + ((Enemy(e).Y - WarHead.Y) * (Enemy(e).Y - WarHead.Y))) <= 70 THEN
'LINE (Enemy(e).X - 30, Enemy(e).Y + 20)-(Enemy(e).X + 30, Enemy(e).Y - 25), 0, BF
COLOR 15
LINE (Enemy(e).X - 20, Enemy(e).Y - 10)-(Enemy(e).X, Enemy(e).Y + 10)
LINE (Enemy(e).X, Enemy(e).Y + 10)-(Enemy(e).X + 20, Enemy(e).Y - 10)
LINE (Enemy(e).X - 20, Enemy(e).Y - 10)-(Enemy(e).X + 20, Enemy(e).Y - 10)
PAINT (Enemy(e).X, Enemy(e).Y)
LINE (Enemy(e).X - 3, Enemy(e).Y - 10)-(Enemy(e).X, Enemy(e).Y - 15)
LINE (Enemy(e).X + 3, Enemy(e).Y - 10)-(Enemy(e).X, Enemy(e).Y - 15)
LINE (Enemy(e).X - 3, Enemy(e).Y - 10)-(Enemy(e).X + 3, Enemy(e).Y - 10)
PAINT (Enemy(e).X, Enemy(e).Y - 11)
COLOR 0
LINE (Enemy(e).X - 20, Enemy(e).Y - 10)-(Enemy(e).X, Enemy(e).Y + 10)
LINE (Enemy(e).X, Enemy(e).Y + 10)-(Enemy(e).X + 20, Enemy(e).Y - 10)
LINE (Enemy(e).X - 20, Enemy(e).Y - 10)-(Enemy(e).X + 20, Enemy(e).Y - 10)
PAINT (Enemy(e).X, Enemy(e).Y)
LINE (Enemy(e).X - 3, Enemy(e).Y - 10)-(Enemy(e).X, Enemy(e).Y - 15)
LINE (Enemy(e).X + 3, Enemy(e).Y - 10)-(Enemy(e).X, Enemy(e).Y - 15)
LINE (Enemy(e).X - 3, Enemy(e).Y - 10)-(Enemy(e).X + 3, Enemy(e).Y - 10)
PAINT (Enemy(e).X, Enemy(e).Y - 11)
Enemy(e).X = fnRan(320 \ Level) + ((320 \ Level) * (e - 1))
Enemy(e).Y = fnRan(-400)
NumKilled = NumKilled + 1
IF NumKilled MOD 10 = 0 THEN Level = Level + 1
END IF
NEXT e
FOR s = 1 TO 10
FOR i = 0 TO 6
CIRCLE (WarHead.X, WarHead.Y), s * 7 - i, 0
NEXT i
SOUND (100 + (s * 10)), 1
NEXT s
LINE (WarHead.X - 3, WarHead.Y - 3)-(WarHead.X + 3, WarHead.Y + 9), 0, BF
END IF
PLAY "MB"
END SUB
SUB DrawPurpleStealth (X AS SINGLE, Y AS SINGLE)
COLOR 180
LINE (X - 20, Y - 10)-(X, Y + 10)
LINE (X, Y + 10)-(X + 20, Y - 10)
LINE (X - 20, Y - 10)-(X + 20, Y - 10)
PAINT (X, Y)
COLOR 178
LINE (X, Y + 10)-(X + 20, Y - 10)
LINE (X - 20, Y - 10)-(X + 20, Y - 10)
COLOR 179
LINE (X + 18, Y - 9)-(X, Y + 9)
LINE (X + 18, Y - 9)-(X - 18, Y - 9)
LINE (X - 8, Y)-(X - 4, Y - 9)
LINE (X + 8, Y)-(X + 4, Y - 9)
LINE (X - 2, Y - 8)-(X + 3, Y - 8)
' Draw WindShield
COLOR 16
PSET (X, Y + 6)
LINE (X - 1, Y + 5)-(X + 1, Y + 5)
CIRCLE (X, Y + 2), 3
LINE (X - 1, Y - 1)-(X + 1, Y - 1)
PSET (X, Y - 2)
PAINT (X, Y + 2)
' Draw Highlights
COLOR 82
LINE (X - 18, Y - 9)-(X, Y + 9)
LINE (X, Y)-(X - 1, Y + 1)
' Draw fire
COLOR 5
LINE (X - 3, Y - 10)-(X, Y - 15)
LINE (X + 3, Y - 10)-(X, Y - 15)
LINE (X - 3, Y - 10)-(X + 3, Y - 10)
PAINT (X, Y - 11), 13, 5
END SUB
SUB DrawShieldBar
FOR i = 1 TO 20
IF i <= (Shields \ 5) THEN c = 55 ELSE c = 176
LINE (1, 199 - (i * 2))-(11, 199 - (i * 2)), c
NEXT i
END SUB
SUB DrawStars
FOR i = 1 TO 100
IF POINT(Star(i).X, Star(i).Y) = Star(i).c THEN PSET (Star(i).X, Star(i).Y), 0
SELECT CASE (i + 5) MOD 5
CASE 0
Star(i).Y = Star(i).Y + (CompSpeed * .1)
CASE 1
Star(i).Y = Star(i).Y + (CompSpeed * .2)
CASE 2
Star(i).Y = Star(i).Y + (CompSpeed * .3)
CASE 3
Star(i).Y = Star(i).Y + (CompSpeed * .4)
CASE 4
Star(i).Y = Star(i).Y + (CompSpeed * .5)
END SELECT
IF Star(i).Y > 200 THEN
Star(i).X = fnRan(320)
Star(i).Y = 0
END IF
IF POINT(Star(i).X, Star(i).Y) = 0 THEN PSET (Star(i).X, Star(i).Y), Star(i).c
NEXT i
END SUB
SUB DrawStealth (X AS INTEGER, Y AS INTEGER)
COLOR 55
LINE (X - 20, Y + 10)-(X, Y - 10)
LINE (X, Y - 10)-(X + 20, Y + 10)
LINE (X - 20, Y + 10)-(X + 20, Y + 10)
PAINT (X, Y)
COLOR 105
LINE (X, Y - 10)-(X + 20, Y + 10)
LINE (X - 20, Y + 10)-(X + 20, Y + 10)
COLOR 1
LINE (X + 18, Y + 9)-(X, Y - 9)
LINE (X + 18, Y + 9)-(X - 18, Y + 9)
LINE (X - 8, Y)-(X - 4, Y + 9)
LINE (X + 8, Y)-(X + 4, Y + 9)
LINE (X - 2, Y + 8)-(X + 3, Y + 8)
' Draw WindShield
COLOR 176
PSET (X, Y - 6)
LINE (X - 1, Y - 5)-(X + 1, Y - 5)
CIRCLE (X, Y - 2), 3
LINE (X - 1, Y + 1)-(X + 1, Y + 1)
PSET (X, Y + 2)
PAINT (X, Y - 2)
' Draw Highlights
COLOR 101
LINE (X - 18, Y + 9)-(X, Y - 9)
LINE (X - 1, Y - 4)-(X - 2, Y - 3)
' Draw fire
COLOR 34
LINE (X - 3, Y + 10)-(X, Y + 15)
LINE (X + 3, Y + 10)-(X, Y + 15)
LINE (X - 3, Y + 10)-(X + 3, Y + 10)
PAINT (X, Y + 11), 35, 34
END SUB
SUB DrawWarHead (X AS INTEGER, Y AS INTEGER)
COLOR 15
LINE (X, Y - 3)-(X - 3, Y)
LINE (X, Y - 3)-(X, Y + 8)
LINE (X - 3, Y + 1)-(X, Y + 8)
PSET (X + 3, Y + 1)
PAINT (X - 1, Y), 15
COLOR 8
LINE (X + 1, Y + 4)-(X + 1, Y + 6)
LINE (X + 2, Y + 2)-(X + 2, Y + 3)
LINE (X + 3, Y)-(X + 3, Y + 1)
COLOR 24
LINE (X + 2, Y - 1)-(X + 2, Y + 1)
COLOR 7
LINE (X, Y + 4)-(X, Y + 6)
LINE (X + 1, Y - 2)-(X + 1, Y + 3)
COLOR 29
LINE (X, Y)-(X, Y + 1)
COLOR 4
LINE (X, Y + 6)-(X, Y + 9)
LINE (X - 2, Y + 6)-(X - 2, Y + 8), 40
LINE (X - 3, Y + 7)-(X - 3, Y + 9), 40
LINE (X + 2, Y + 6)-(X + 2, Y + 8), 185
LINE (X + 3, Y + 7)-(X + 3, Y + 9), 185
END SUB
SUB EndGame
PLAY "MF"
FOR i = 1 TO 20
CIRCLE (Stealth.X, Stealth.Y), i, i + 35
SOUND (200 - (i * 5)), .5
NEXT i
PLAY "MB"
CLS
FOR i = 1 TO 10
DrawStars
NEXT i
SlowType 12, 12, "G A M E O V E R"
SLEEP 2
X = (40 - LEN("You killed" + STR$(NumKilled) + " of the Enemy!")) \ 2
SlowType 12, X, "You killed" + STR$(NumKilled) + " of the Enemy!"
SLEEP 2
SlowType 12, 4, " Play Again? (y/n) "
DO
Key$ = UCASE$(INKEY$)
IF Key$ = CHR$(27) THEN Key$ = "N"
CALL Mouse(cx, dx, bx)
IF bx = LeftButton THEN Key$ = "Y"
IF bx = RightButton THEN Key$ = "N"
LOOP UNTIL Key$ = "Y" OR Key$ = "N"
IF Key$ = "Y" THEN
Level = 1
Shields = 100
FOR e = 1 TO NumLevels
Enemy(e).Y = -100
NEXT e
NumKilled = 0
GameMode = NormalMode
NumWarHeads = 5
EraseSlowType 12, 4, " Play Again? (y/n) "
PlayGame
END IF
CLS
CALL MousePointer(2) 'Turn mouse off
DEF SEG
END
END SUB
SUB EraseSlowType (col AS INTEGER, row AS INTEGER, text AS STRING)
FOR i = 1 TO LEN(text) + 3
CLPrint 54, col, row + i - 1, MID$(text, i, 1)
IF i > 1 THEN CLPrint 15, col, row + i - 2, MID$(text, i - 1, 1)
IF i > 2 THEN CLPrint 8, col, row - 3 + i, MID$(text, i - 2, 1)
IF i > 3 THEN CLPrint 0, col, row - 4 + i, MID$(text, i - 3, 1)
FOR pause = 1 TO INT(CompSpeed * .5)
FOR j = 1 TO 10000: NEXT
NEXT pause
NEXT i
CLPrint 0, col, row, text
END SUB
SUB FadeInStars
FOR i = 1 TO 100
Star(i).c = 16
IF POINT(Star(i).X, Star(i).Y) = 0 THEN PSET (Star(i).X, Star(i).Y), 16
NEXT i
FOR c = 16 TO 30
FOR i = 1 TO 100
IF POINT(Star(i).X, Star(i).Y) = Star(i).c THEN PSET (Star(i).X, Star(i).Y), 0
SELECT CASE (i + 5) MOD 5
CASE 0
Star(i).Y = Star(i).Y + (CompSpeed * .2)
IF c < 18 THEN Star(i).c = Star(i).c + 1
CASE 1
Star(i).Y = Star(i).Y + (CompSpeed * .4)
IF c < 21 THEN Star(i).c = Star(i).c + 1
CASE 2
Star(i).Y = Star(i).Y + (CompSpeed * .6)
IF c < 24 THEN Star(i).c = Star(i).c + 1
CASE 3
Star(i).Y = Star(i).Y + (CompSpeed * .8)
IF c < 27 THEN Star(i).c = Star(i).c + 1
CASE 4
Star(i).Y = Star(i).Y + (CompSpeed)
IF c < 30 THEN Star(i).c = Star(i).c + 1
END SELECT
IF POINT(Star(i).X, Star(i).Y) = 0 THEN PSET (Star(i).X, Star(i).Y), Star(i).c
IF Star(i).Y > 200 THEN
Star(i).X = fnRan(320)
Star(i).Y = 0
END IF
NEXT i
FOR pause = 1 TO INT(CompSpeed * .25)
FOR j = 1 TO 10000: NEXT
NEXT pause
NEXT c
END SUB
SUB FadeInText (col AS INTEGER, row AS INTEGER, text AS STRING)
FOR i = 16 TO 31
CLPrint i, col, row, text
FOR pause = 1 TO INT(CompSpeed * .5)
FOR j = 1 TO 10000: NEXT
NEXT pause
CALL Mouse(cx, dx, bx)
IF bx = LeftButton OR INKEY$ <> "" THEN EXIT FOR
NEXT i
CLPrint 31, col, row, text
END SUB
SUB FadeOutText (col AS INTEGER, row AS INTEGER, text AS STRING)
FOR i = 31 TO 16 STEP -1
CLPrint i, col, row, text
FOR pause = 1 TO INT(CompSpeed * .5)
FOR j = 1 TO 10000: NEXT
NEXT pause
CALL Mouse(cx, dx, bx)
IF bx = LeftButton OR INKEY$ <> "" THEN EXIT FOR
NEXT i
CLPrint 0, col, row, text
END SUB
SUB GLoad (FileName AS STRING, GLoadArray() AS INTEGER)
DIM FileNum AS INTEGER
FileNum = FREEFILE
OPEN FileName FOR BINARY AS #FileNum
GET #1, , size%
REDIM GLoadArray(size%) AS INTEGER
FOR i = 0 TO size%
GET #1, , GLoadArray(i)
NEXT i
CLOSE #FileNum
END SUB
SUB GSave (x1 AS SINGLE, y1 AS SINGLE, x2 AS SINGLE, y2 AS SINGLE, FileName AS STRING)
size% = 4 + INT(((PMAP(x2, 0) - PMAP(x1, 0) + 1) * 8 + 7) / 8) * 1 * (PMAP(y2, 1) - PMAP(y1, 1) + 1)
DIM GSaveArray(size%) AS INTEGER
DIM FileNum AS INTEGER
FileNum = FREEFILE
GET (x1!, y1!)-(x2!, y2!), GSaveArray(0)
OPEN FileName FOR BINARY AS #FileNum
PUT FileNum, , size%
FOR i = 0 TO size%
PUT #1, , GSaveArray(i)
NEXT i
CLOSE #FileNum
END SUB
SUB KillLaser (ID AS LONG)
NumLasers = NumLasers - 1
IF NumLasers = 0 THEN
REDIM Lasers(0)
EXIT SUB
END IF
DIM CopyLaser(1 TO NumLasers) AS Lazer
FOR i = 1 TO NumLasers + 1
LaserToDelete = i
IF Laser(i).ID = ID THEN EXIT FOR
NEXT i
IF LaserToDelete <> 1 THEN
FOR i = 1 TO LaserToDelete - 1
CopyLaser(i).X = Laser(i).X
CopyLaser(i).Y = Laser(i).Y
CopyLaser(i).Speed = Laser(i).Speed
CopyLaser(i).typ = Laser(i).typ
CopyLaser(i).c = Laser(i).c
CopyLaser(i).ID = Laser(i).ID
NEXT i
END IF
IF LaserToDelete <> NumLasers + 1 THEN
FOR i = (LaserToDelete + 1) TO NumLasers + 1
CopyLaser(i - 1).X = Laser(i).X
CopyLaser(i - 1).Y = Laser(i).Y
CopyLaser(i - 1).Speed = Laser(i).Speed
CopyLaser(i - 1).typ = Laser(i).typ
CopyLaser(i - 1).c = Laser(i).c
CopyLaser(i - 1).ID = Laser(i).ID
NEXT i
END IF
REDIM Laser(1 TO NumLasers)
FOR i = 1 TO NumLasers
Laser(i).X = CopyLaser(i).X
Laser(i).Y = CopyLaser(i).Y
Laser(i).Speed = CopyLaser(i).Speed
Laser(i).typ = CopyLaser(i).typ
Laser(i).c = CopyLaser(i).c
Laser(i).ID = CopyLaser(i).ID
NEXT i
END SUB
SUB Mouse (cx, dx, bx)
POKE VARPTR(a(4)), &H92 'Swap code,Get CX setup
CALL absolute(cx, VARPTR(a(0))) 'Run Code
cx = cx 'Adjust 25x80
POKE VARPTR(a(4)), &H91 'Swap code,Get DX setup
CALL absolute(dx, VARPTR(a(0))) 'Run Code
dx = dx / 1.5 'Adjust 25x80
POKE VARPTR(a(4)), &H93 'Swap code,Get BX setup
CALL absolute(bx, VARPTR(a(0))) 'Run Code
'Note :
'Remove the /8
'for graphics modes.
END SUB
SUB MousePointer (SW)
POKE VARPTR(a(0)) + 1, SW 'Swap code,Set AX = (SW)
CALL absolute(c, VARPTR(a(0))) 'Run Code
'Note:
'SW = 0-reset
'SW = 1-on
'SW = 2-off
'SW = 3-coordinates
END SUB
SUB PlayGame
DIM X AS INTEGER, Y AS INTEGER, OldLevel AS INTEGER
Level = 1
DO WHILE Key$ <> CHR$(27)
Key$ = INKEY$
Stealth.ReTime = Stealth.ReTime + 1
WarHead.ReTime = WarHead.ReTime + 1
IF OldLevel <> Level THEN
OldLevel = Level
CLS
IF Level <= NumLevels THEN
SlowType 12, 16, "Level" + STR$(Level)
SLEEP 2
EraseSlowType 12, 16, "Level" + STR$(Level)
FadeInStars
DrawStealth Stealth.X, Stealth.Y
FOR i = NumLasers TO 1 STEP -1
KillLaser Laser(i).ID
NEXT i
FOR e = 1 TO Level
Enemy(e).X = fnRan(320 \ Level) + ((320 \ Level) * (e - 1))
Enemy(e).Y = fnRan(-400)
NEXT e
END IF
END IF
' Get the mouse coordinates
CALL Mouse(cx, dx, bx)
IF dx > 299 THEN dx = 299
IF dx < 20 THEN dx = 20
IF cx > 184 THEN cx = 184
IF cx < 10 THEN cx = 10
DoEnemy
' If our stealth's position has changed then
' redraw it.
IF dx = Stealth.X AND cx = Stealth.Y THEN
ELSE
LINE (Stealth.X - 20, Stealth.Y - 10)-(Stealth.X + 20, Stealth.Y + 15), 0, BF
Stealth.X = dx
Stealth.Y = cx
DrawStealth Stealth.X, Stealth.Y
END IF
IF GameMode = WarHeadMode THEN
DrawStealth Stealth.X, Stealth.Y
DoWarHead
ELSEIF GameMode = WarHeadExplodingMode THEN
DoWarHead
DrawStealth Stealth.X, Stealth.Y
END IF
' Laser
IF bx = LeftButton THEN 'Laser Fire
IF Stealth.ReTime >= 5 THEN
PLAY "L64 MS T255 MB gfedcba"
AddLaser Stealth.X, Stealth.Y - 14, -12, StealthLaser, 39
'END IF
Stealth.ReTime = 0
END IF
ELSEIF bx = RightButton THEN 'WarHead
IF WarHead.ReTime >= 5 THEN
IF GameMode = NormalMode THEN
IF NumWarHeads <> 0 THEN
GameMode = WarHeadMode
WarHead.X = Stealth.X
WarHead.Y = Stealth.Y - 11
DrawWarHead WarHead.X, WarHead.Y
DrawStealth Stealth.X, Stealth.Y
SOUND 100, .5
WarHead.ReTime = 0
NumWarHeads = NumWarHeads - 1
END IF
ELSEIF GameMode = WarHeadMode THEN
GameMode = WarHeadExplodingMode
DoWarHead
END IF
END IF
END IF
IF Stealth.ReTime > 5 THEN Stealth.ReTime = 5
IF WarHead.ReTime > 5 THEN WarHead.ReTime = 5
DoLasers
DrawShieldBar
DrawStars
LOOP
END SUB
SUB SlowType (col AS INTEGER, row AS INTEGER, text AS STRING)
FOR i = 1 TO LEN(text) + 3
CLPrint 8, col, row + i - 1, MID$(text, i, 1)
IF i > 1 THEN CLPrint 7, col, row + i - 2, MID$(text, i - 1, 1)
IF i > 2 THEN CLPrint 15, col, row - 3 + i, MID$(text, i - 2, 1)
IF i > 3 THEN CLPrint 54, col, row - 4 + i, MID$(text, i - 3, 1)
FOR pause = 1 TO INT(CompSpeed * .5)
FOR j = 1 TO 10000: NEXT
NEXT pause
CALL Mouse(cx, dx, bx)
IF bx = LeftButton OR INKEY$ <> "" THEN EXIT FOR
NEXT i
CLPrint 54, col, row, text
END SUB
@sweenist

This comment has been minimized.

Copy link

@sweenist sweenist commented Sep 22, 2015

I haven't seen QBASIC in 16 years! This brings back (fond?) memories

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment