04-02-2023, 08:08 PM
Tagged: TerryRitchie, RokCoder, TempodiBasic, mnrvovrfc
I did a quick update to add the 4-way control option (called "directional thrust" in the code).
You can now use the arrow keys to move in a given direction (the standard controls also work).
I also changed the FPS to 10 per Tempodi (this can be changed at line 80).
(04-01-2023, 02:15 PM)TempodiBasic Wrote: I have not understood why do you scramble KeyLeft and KeyDown?
I did a quick update to add the 4-way control option (called "directional thrust" in the code).
You can now use the arrow keys to move in a given direction (the standard controls also work).
I also changed the FPS to 10 per Tempodi (this can be changed at line 80).
Code: (Select All)
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' QB64 Defender v0.28.00
' Updated by madscijr Mar-Apr 2023, to sort of work with QB64 & QB64PE.
' There is still a lot of work to be done to get this fully working,
' and be more faithful to the original arcade game by Williams Electronics.
'
' The original version of this game is from Tim Truman's AOL site
' backed up at archive.org at:
' https://web.archive.org/web/20050324100845/http://members.aol.com/Timtruman/Qbasic/Games/qbdefend.htm
'
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' Name : QBdefend.bas
' Author : Tim Truman
' Type : Freeware
' Date : 4/28/95
' Revised : 1/31/97
'
' Copyright (c) 1997 Tim Truman
'
' CompuServe - 74734,2203
' AOL - TimTruman
' NET - TimTruman@AOL.COM
'
' Visit my FTP site at :
' ftp.aol.members/TimTruman
'
' This program may be freely distributed providing no changes are
' made to the source code or it's support files. This program
' may not be distributed compiled.
'
' Feel free to rip out any code you may find of use.
'
' Thanks for downloading my program. This is dedicated to
' those who said it could not be done!
' This was one of my earlist Qbasic programs so the code may be
' a little crude. The adlib routines for instance have been
' replaced in later programs with playback routines that are
' much smaller. If you have my FX program you know these playback
' routines have come a long way.
'
' But after all these years it's I think it's still a good looking
' program. Enjoy!
'
' Notes:
' For best results run this program under dos mode in WIN 95 and
' have a gamepad handy.
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' All about Defender:
'
' The Defender bible?
' Defender: The Last Word by Doug Mahugh (Jan 21, 2013)
' https://www.dougmahugh.com/defender/
'
' The ARCade ARChive: Defender ROMs, sounds, images, etc.:
' https://arcarc.xmission.com/Arcade%20by%20Title/Defender/
'
' The ARCade ARChive: Stargate ROMs, sounds, images, etc:
' https://arcarc.xmission.com/Arcade%20by%20Title/Stargate/
'
' Defender arcade machine manual:
' https://www.gamesdatabase.org/Media/SYSTEM/Arcade//Manual/formated/Defender_-_1980_-_Williams,_Inc..pdf
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
DefInt A-Z
'NONEXISTING SUBS WHICH WERE DECLARED BUT NOT PRESENT OR CALLED IN THE CODE:
'DECLARE SUB printme ()
'DECLARE SUB herosprite () ' draw and initalize main sprite
'DECLARE SUB printtime () ' debbugger tool
'DECLARE SUB createimplode (x, y)
'DECLARE SUB newgame ()
' BOOLEAN VALUES
Const FALSE = 0
Const TRUE = Not FALSE
' SETTINGS
Const cFPS = 10
' SOUND EFFECTS
Const cMutantExplodeSound = 0
Const cHeroFiringSound = 1
Const cCallForHelpSound = 2
Const cMutantConvertedSound = 3
Const cMutantFiringSound = 4
Const cBomerSound = 5
Const cSwarmerSound = 6
Const cColonistDiedSound = 7
Type sprite
x As Integer ' virtual location
y As Integer '
oldx As Integer ' old location for erase
oldy As Integer '
px As Integer ' physical x
py As Integer ' physical y
cx As Integer ' counter
cy As Integer '
vx As Integer ' velocity
vy As Integer '
rx As Integer ' radar x
ry As Integer '
oldrx As Integer
oldry As Integer
dirx As Integer '
diry As Integer
h As Integer ' hight
w As Integer ' width
mem1 As Integer ' save something
mem2 As Integer '
eras As Integer ' erase
health As Integer ' alive
dir As Integer ' various, usually referenced for movement
thrust As Integer ' for hero ship
mode As Integer ' various
toplay As Integer ' how many to play
played As Integer ' how many have been played
End Type ' sprite
Type explode
set As Integer
x As Integer
y As Integer
size As Integer
colour As Integer
c1 As Integer
c2 As Integer
End Type ' explode
' GLOBAL VARIABLES
Common Shared speed, keyspeed, delay
Common Shared minx, miny, maxx, maxy, topy, boty, qtrx, thrdx
Common Shared fieldw, fieldh, fieldx
Common Shared radarx, radary, radarsx, radarsy, radarw, radarh, radarwrapx
Common Shared pickup
Common Shared level, newlevel
Common Shared maxaliensinplay, aliensinplay
Common Shared hero As sprite, heroimage() As Integer
Common Shared grabber() As sprite, maxgrabbers, numgrabbers
Common Shared chaser As sprite
Common Shared mutant() As sprite
Common Shared bomer() As sprite, maxbomers, numbomers
Common Shared bomb As sprite
Common Shared blocker As sprite, maxblockers
Common Shared spinner As sprite, maxspinners
Common Shared spinette As sprite
Common Shared col() As sprite, maxcolonists
Common Shared herolaser() As sprite, maxherolasers
Common Shared alienshot As sprite
Common Shared alienbolt() As sprite, maxalienbolts
Common Shared tracker As sprite
Common Shared chunk() As sprite, maxchunks
Common Shared exp1 As explode
' FOR (EVENTUALLY) CONFIGURABLE KEYBOARD MAPPING:
Common Shared INPUT_MOVE_UP%
Common Shared INPUT_MOVE_DOWN%
Common Shared INPUT_MOVE_LEFT%
Common Shared INPUT_MOVE_RIGHT%
Common Shared INPUT_UP%
Common Shared INPUT_DOWN%
Common Shared INPUT_THRUST%
Common Shared INPUT_REVERSE%
Common Shared INPUT_FIRE%
Common Shared INPUT_SMARTBOMB%
Common Shared INPUT_HYPERSPACE%
Common Shared INPUT_INVISIO%
Common Shared INPUT_FASTER%
Common Shared INPUT_SLOWER%
Common Shared INPUT_SKIP_LEVEL%
Common Shared INPUT_QUIT%
' FOR NON-REPEATABLE KEYS:
Common Shared bReverse%: bReverse% = FALSE
Common Shared bFire%: bFire% = FALSE
Common Shared bSmartBomb%: bSmartBomb% = FALSE
Common Shared bHyperspace%: bHyperspace% = FALSE
Common Shared bFaster%: bFaster% = FALSE
Common Shared bSlower%: bSlower% = FALSE
' FOR KICKING US OUT OF THE GAME LOOP WHEN THE PLAYER QUITS
Common Shared bIsPlaying%: bIsPlaying% = FALSE
' SET VARIABLES TO MAXIMUM ARRAY SIZES
maxaliensinplay = 10 ' most on playfield
maxherolasers = 3 '
maxalienbolts = 1
maxcolonists = 10
maxgrabbers = 15
maxbomers = 2
maxchunks = 20
' OTHER SETTINGS
speed = 1
keyspeed = 8
delay = 0
' MAP KEYBOARD
' up, down, thrust, reverse, fire, smart bomb, quit
' A Z K {space} M N {esc}
INPUT_MOVE_UP% = KeyCode_Up%
INPUT_MOVE_DOWN% = KeyCode_Down%
INPUT_MOVE_LEFT% = KeyCode_Left%
INPUT_MOVE_RIGHT% = KeyCode_Right%
INPUT_UP% = KeyCode_A%
INPUT_DOWN% = KeyCode_Z%
INPUT_THRUST% = KeyCode_K%
INPUT_REVERSE% = KeyCode_Spacebar%
INPUT_FIRE% = KeyCode_M%
INPUT_SMARTBOMB% = KeyCode_N%
INPUT_HYPERSPACE% = KeyCode_L%
INPUT_INVISIO% = KeyCode_Semicolon%
INPUT_FASTER% = KeyCode_Equal%
INPUT_SLOWER% = KeyCode_Minus%
INPUT_SKIP_LEVEL% = KeyCode_F1%
INPUT_QUIT% = KeyCode_Escape%
' MORE VARIABLES
Dim herolaser(maxherolasers) As sprite
Dim alienbolt(maxalienbolts) As sprite
Dim col(maxcolonists) As sprite
Dim grabber(maxgrabbers) As sprite
Dim mutant(maxcolonists) As sprite
Dim bomer(maxbomers) As sprite
Dim chunk(maxchunks) As sprite
' LOCAL VARIABLES
Dim in$
' MAIN OUTER LOOP
Do
Cls
' MENU INPUT LOOP
Do
Print "1. Start Game"
Print "2. Game Rules"
Print "3. Controls"
Print "4. Remap controls"
Print "5. Test keyboard"
Print "6. Quit"
Input "Selection"; in$
in$ = Left$(_Trim$(in$), 1)
If InStr(",1,2,3,4,5,6,", "," + in$ + ",") > 0 Then
Exit Do
Else
Print
Print "*** Please select 1, 2, 3, 4, 5 or 6. ***"
Print
End If
Loop ' MENU INPUT LOOP
If in$ = "1" Then
' PLAY GAME
Randomize Timer
' THIS STUFF CAN PROBABLY GO:
Out &H60, &HF3 ' fast typematic rate with min delay
Sleep (1) ' let hardware settle
Out &H60, 0
'GameControls
a = timepassed(20, 0) ' set up counters
setfxmode ' set screen mode and variables
p3x5numfnt -999, 0, 0, 0 ' load fonts
p5x7ascfnt -999, 0, "", 0
createhero
bIsPlaying% = TRUE
' MAIN GAME LOOP
Do
levels
endgame
starfield
processgpi
collision
movesprites
creategrabber
createbomer
createchaser
createspinner
createtracker
'For i = 1 To delay: Next
If bIsPlaying% = FALSE Then
Screen 0
Exit Do
End If
_Limit cFPS
Loop ' MAIN GAME LOOP
_KeyClear: '_Delay 1 ' CLEAR KEYBOARD BUFFER
ElseIf in$ = "2" Then
' DISPLAY GAME RULES
GameRules
ElseIf in$ = "3" Then
' DISPLAY CONTROLS
GameControls
ElseIf in$ = "4" Then
' REMAP CONTROLS
RemapControls
ElseIf in$ = "5" Then
' TEST KEYBOARD
KeyboardTest2
Else
' QUIT PROGRAM
Exit Do
End If
Loop ' MAIN OUTER LOOP
' EXIT
Screen 0
Print "Press any key to exit"
Sleep
System
' /////////////////////////////////////////////////////////////////////////////
' TEST ROUTINE
Sub DumpTextColors
Dim MyString$
Dim iLoop%
Dim NextChar$
Dim NextColor%
Screen 0
MyString$ = "0123456789ABCDEF"
Cls
For iLoop% = 1 To Len(MyString$)
NextChar$ = Mid$(MyString$, iLoop%, 1)
NextColor% = (iLoop% - 1) Mod 15 ' avoid color 16 (black) and any colors >16 (blinking, etc.)
' SHOW BLACK ON DIFFERENT COLOR BACKGROUND
If NextColor% <> cBlack% Then
Color NextColor%, cBlack%
Else
Color NextColor%, cLtGray%
End If
Print NextChar$;
Color cLtGray%, cBlack%
Print " " + Right$("00" + _Trim$(Str$(NextColor%)), 2)
Next iLoop%
Print
Color cLtGray%, cBlack%
'Print "PRESS ANY KEY TO EXIT"
'Sleep
End Sub 'DumpTextColors
' /////////////////////////////////////////////////////////////////////////////
' KEYBOARD INPUT TEST
Sub KeyboardTest2
Const cLeft = 0
Const cRight = 1
Dim pX%: pX% = 10
Dim pY%: pY% = 15
Dim oX%: oX% = 0
Dim oY%: oY% = 0
Dim yMin%: yMin% = 14
Dim yMax%: yMax% = 25
Dim xMin%: xMin% = 1
Dim xMax%: xMax% = 79
Dim pDir%: pDir% = cRight
Dim oDir%: oDir% = pDir%
Dim MyString$
Dim note%
Dim bReverse%: bReverse% = FALSE
Dim bFire%: bFire% = FALSE
Dim bSmartBomb%: bSmartBomb% = FALSE
Dim bRedraw%: bRedraw% = TRUE
Cls
Locate 1, 1
Color cCyan%, cBlack%
Print "------------------------------------------------------------------------------"
Color cYellow%, cBlack%: Print "DEFENDER KEYBOARD INPUT TEST:"
Color cWhite%, cBlue%: Print "A";: Color cPeriwinkle%, cBlack%: Print ".........up"
Color cWhite%, cRed%: Print "Z";: Color cPeriwinkle%, cBlack%: Print ".........down"
Color cWhite%, cBlue%: Print "K";: Color cPeriwinkle%, cBlack%: Print ".........thrust"
Color cWhite%, cRed%: Print "{space}";: Color cPeriwinkle%, cBlack%: Print "...reverse direction"
Color cWhite%, cBlue%: Print "M.";: Color cPeriwinkle%, cBlack%: Print "........fire"
Color cWhite%, cRed%: Print "N";: Color cPeriwinkle%, cBlack%: Print ".........smart bomb"
Color cWhite%, cBlue%: Print "{escape}";: Color cPeriwinkle%, cBlack%: Print "..quit"
Print
Color cWhite%, cBlack%
Print "oX%=?? oY%=?? MyString$=?" ' line=11
Print "pX%=?? pY%=?? pDir%=?" ' line=12
' 1234567890123456789012345678901234567890123456789012345678901234567890123456789
' 1111111111222222222233333333334444444444555555555566666666667777777777
Color cCyan%, cBlack%
Print "------------------------------------------------------------------------------"
Do
' GET DIRECTION
If pDir% = cRight Then
MyString$ = ">"
ElseIf pDir% = cLeft Then
MyString$ = "<"
Else
MyString$ = "?"
End If
' SHOW VALUES
Locate 11, 5: Color cLtBlue%, cBlack%:
Print Right$(" " + _Trim$(Str$(oX%)), 2);
Locate 11, 12: Color cLtBlue%, cBlack%:
Print Right$(" " + _Trim$(Str$(oY%)), 2);
Locate 11, 25: Color cLtBlue%, cBlack%:
Print MyString$;
Locate 12, 5: Color cLtRed%, cBlack%:
Print Right$(" " + _Trim$(Str$(pX%)), 2);
Locate 12, 12: Color cLtRed%, cBlack%:
Print Right$(" " + _Trim$(Str$(pY%)), 2);
Locate 12, 25: Color cLtRed%, cBlack%:
Print IIFSTR$(pDir% = cRight, "cRight", IIFSTR$(pDir% = cLeft, "cLeft", "?")) + " ";
' DRAW PLAYER
If bRedraw% Then
If oY% > 0 And oX% > 0 Then
Locate oY%, oX%
Color cLtBlue%, cBlack%: Print " ";
End If
Locate pY%, pX%
Color cLtBlue%, cBlack%: Print MyString$;
oX% = pX%
oY% = pY%
bRedraw% = FALSE
End If
' GET INPUT
While _DeviceInput(1): Wend ' clear and update the keyboard buffer
' UP/DOWN
If _Button(INPUT_UP%) Then
pY% = pY% - 1: If pY% < yMin% Then pY% = yMin%
iLastKey% = INPUT_UP%
If (pY% <> oY%) Then bRedraw% = TRUE
ElseIf _Button(INPUT_DOWN%) Then
pY% = pY% + 1: If pY% > yMax% Then pY% = yMax%
iLastKey% = INPUT_DOWN%
If (pY% <> oY%) Then bRedraw% = TRUE
End If
' THRUST
If _Button(INPUT_THRUST%) Then
If pDir% = cRight Then
pX% = pX% + 1: If pX% > xMax% Then pX% = xMin%
If (pX% <> oX%) Then bRedraw% = TRUE
ElseIf pDir% = cLeft Then
pX% = pX% - 1: If pX% < xMin% Then pX% = xMax%
If (pX% <> oX%) Then bRedraw% = TRUE
End If
iLastKey% = INPUT_THRUST%
End If
' REVERSE
If _Button(INPUT_REVERSE%) Then
If bReverse% = FALSE Then
If pDir% = cRight Then
pDir% = cLeft: bRedraw% = TRUE
Else
pDir% = cRight: bRedraw% = TRUE
End If
bReverse% = TRUE
End If
Else
bReverse% = FALSE
End If
' -----------------------------------------------------------------------------
' BEGIN ALSO SUPPORT STANDARD 4-DIRECTIONAL JOYSTICK!
' -----------------------------------------------------------------------------
' UP/DOWN
If _Button(INPUT_MOVE_UP%) Then
pY% = pY% - 1: If pY% < yMin% Then pY% = yMin%
'iLastKey% = INPUT_MOVE_UP%
If (pY% <> oY%) Then bRedraw% = TRUE
ElseIf _Button(INPUT_MOVE_DOWN%) Then
pY% = pY% + 1: If pY% > yMax% Then pY% = yMax%
'iLastKey% = INPUT_MOVE_DOWN%
If (pY% <> oY%) Then bRedraw% = TRUE
End If
' DIRECTIONAL THRUST = LEFT/RIGHT
If _Button(INPUT_MOVE_LEFT%) Then
' ARE WE ALREADY FACING LEFT?
If pDir% = cLeft Then
' THRUST
pX% = pX% - 1: If pX% < xMin% Then pX% = xMax%
Else
' REVERSE
pDir% = cLeft
End If
' ALWAYS REDRAW
bRedraw% = TRUE
ElseIf _Button(INPUT_MOVE_RIGHT%) Then
' ARE WE ALREADY FACING RIGHT?
If pDir% = cRight Then
' THRUST
pX% = pX% + 1: If pX% > xMax% Then pX% = xMin%
Else
' REVERSE
pDir% = cRight
End If
' ALWAYS REDRAW
bRedraw% = TRUE
End If
' -----------------------------------------------------------------------------
' END ALSO SUPPORT STANDARD 4-DIRECTIONAL JOYSTICK!
' -----------------------------------------------------------------------------
If _Button(INPUT_FIRE%) Then
If bFire% = FALSE Then
'note% = iPlayer * 100 + (iButton * 25)
note% = 3 * 100 + (2 * 25)
If note% > 4186 Then note% = 4186
Sound note%, .75
bFire% = TRUE
End If
Else
bFire% = FALSE
End If
If _Button(INPUT_SMARTBOMB%) Then
If bSmartBomb% = FALSE% Then
'note% = iPlayer * 100 + (iButton * 25)
note% = 2 * 100 + (3 * 25)
If note% > 4186 Then note% = 4186
Sound note%, .75
bSmartBomb% = TRUE
End If
Else
bSmartBomb% = FALSE
End If
' ALWAYS READY TO QUIT
If _Button(INPUT_QUIT%) Then
Exit Do
End If
' SET GAME SPEED IN FPS
_Limit cFPS
Loop 'UNTIL _KEYHIT = 27 ' ESCAPE to quit
'Locate 24, 1
_KeyClear: '_Delay 1 ' CLEAR KEYBOARD BUFFER
End Sub ' KeyboardTest2
' /////////////////////////////////////////////////////////////////////////////
' plays the sounds
' UNDER CONSTRUCTION
Sub PlaySound (num)
Select Case (num)
Case cMutantExplodeSound: ' mutant exploding
' (TBD)
Case cHeroFiringSound: ' hero firing
' (TBD)
Case cCallForHelpSound: ' colonist pick up warning
' (TBD)
Case cMutantConvertedSound: ' mutant converted
' (TBD)
Case cMutantFiringSound: ' mutant firing
' (TBD)
Case cBomerSound: ' bomer noise
' (TBD)
Case cSwarmerSound: ' create chunks
' (TBD)
End Select
End Sub ' PlaySound
' /////////////////////////////////////////////////////////////////////////////
' detect collisions
Sub collision
Shared collidex, collidey ' for chunks
Shared pickup
Static top(), left(), bottom(), right(), didthis
If didthis = 0 Then
Dim top(1)
Dim left(1)
Dim bottom(1)
Dim right(1)
didthis = 1
End If
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³ Check hero ship against grabbers. ³³³³³³³³³³³³³³³³³³³³³
For a = 0 To maxgrabbers
If Not (grabber(a).x < 0) Or (grabber(a).x > maxx) Then
'IF (grabber(a).y > hero.y + hero.h) THEN EXIT FOR
'IF (grabber(a).y + grabber(a).h < hero.y) THEN EXIT FOR
If (grabber(a).health > 0) And (hero.health > 0) Then
top(0) = hero.y
left(0) = hero.x
bottom(0) = hero.y + hero.h
right(0) = hero.x + hero.w
top(1) = grabber(a).y
left(1) = grabber(a).x
bottom(1) = grabber(a).y + grabber(a).h
right(1) = grabber(a).x + grabber(a).w
If (left(0) >= right(1)) Or (left(1) > right(0)) Or (top(0) > bottom(1)) Or (top(1) > bottom(0)) Then
' (DO NOTHING)
Else
grabber(a).health = grabber(a).health - 1
hero.health = hero.health - 1
End If
End If
End If
Next a
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³ Check hero ship against mutants. ³³³³³³³³³³³³³³³³³³³³³³
For a = 0 To maxcolonists
If Not (mutant(a).x < 0) Or (mutant(a).x > maxx) Then
'IF (mutant(a).y > hero.y + hero.h) THEN EXIT FOR
'IF (mutant(a).y + mutant(a).h < hero.y) THEN EXIT FOR
If mutant(a).health Then 'AND hero.health THEN
top(0) = hero.y
left(0) = hero.x
bottom(0) = hero.y + hero.h
right(0) = hero.x + hero.w
top(1) = mutant(a).y
left(1) = mutant(a).x
bottom(1) = mutant(a).y + mutant(a).h
right(1) = mutant(a).x + mutant(a).w
If (left(0) >= right(1)) Or (left(1) > right(0)) Or (top(0) > bottom(1)) Or (top(1) > bottom(0)) Then
' (DO NOTHING)
Else
mutant(a).health = mutant(a).health - 1
hero.health = hero.health - 1
createchunks hero.x, hero.y
End If
End If
End If
Next a
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³ Check hero ship against alienshots. ³³³³³³³³³³³³³³³³³³³
If alienshot.health Then
top(0) = hero.y
left(0) = hero.x
bottom(0) = hero.y + hero.h
right(0) = hero.x + hero.w
top(1) = alienshot.y
left(1) = alienshot.x
bottom(1) = alienshot.y + alienshot.h
right(1) = alienshot.x + alienshot.w
If (left(0) >= right(1)) Or (left(1) > right(0)) Or (top(0) > bottom(1)) Or (top(1) > bottom(0)) Then
' (DO NOTHING)
Else
alienshot.health = 0
If hero.mode = 1 Then ' holding coloinist
col(hero.mem1).health = 0 ' colonist takes shot
pickup = 0 ' another may be picked up
hero.mode = 0
Else
hero.health = hero.health - 1
End If
createchunks hero.x, hero.y
End If
End If
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³ Check hero ship against spinettes. ³³³³³³³³³³³³³³³³³³³³
If spinette.health Then
top(0) = hero.y
left(0) = hero.x
bottom(0) = hero.y + hero.h
right(0) = hero.x + hero.w
top(1) = spinette.y
left(1) = spinette.x
bottom(1) = spinette.y + spinette.h
right(1) = spinette.x + spinette.w
If (left(0) >= right(1)) Or (left(1) > right(0)) Or (top(0) > bottom(1)) Or (top(1) > bottom(0)) Then
' (DO NOTHING)
Else
spinette.health = 0
If hero.mode = 1 Then ' holding coloinist
col(hero.mem1).health = 0 ' colonist takes shot
pickup = 0 ' another may be picked up
hero.mode = 0
Else
hero.health = hero.health - 1
End If
createchunks hero.x, hero.y
End If
End If
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³ Check hero ship against colonists. ³³³³³³³³³³³³³³³³³³³³
For a = 0 To maxcolonists
If col(a).health And col(a).mode = 1 And col(a).dir = 0 Then
If (col(a).y > hero.y + hero.h) Then Exit For
If (col(a).y + col(a).h < hero.y) Then Exit For
top(0) = hero.y
left(0) = hero.x
bottom(0) = hero.y + hero.h
right(0) = hero.x + hero.w
top(1) = col(a).y
left(1) = col(a).x
bottom(1) = col(a).y + col(a).h
right(1) = col(a).x + col(a).w
If (left(0) >= right(1)) Or (left(1) > right(0)) Or (top(0) > bottom(1)) Or (top(1) > bottom(0)) Then
' (DO NOTHING)
Else
col(a).mode = 2
hero.mode = 1
hero.mem1 = a
End If
End If
Next a
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³ Check hero lasers against grabbers. ³³³³³³³³³³³³³³³³³³³
For a = 0 To maxherolasers
If herolaser(a).health Then ' don't bother if laser is dead
If herolaser(a).dir = 1 Then
top(0) = herolaser(a).y
left(0) = herolaser(a).x
bottom(0) = herolaser(a).y
right(0) = herolaser(a).x
ElseIf herolaser(a).dir = 0 Then
top(0) = herolaser(a).y
left(0) = herolaser(a).x
bottom(0) = herolaser(a).y
right(0) = herolaser(a).x
End If
For b = 0 To maxgrabbers
If (grabber(b).x > minx) Or (grabber(b).x < maxx) Then
If grabber(b).health Then ' don't bother if grabber is dead
top(1) = grabber(b).y
left(1) = grabber(b).x
bottom(1) = grabber(b).y + grabber(b).h
right(1) = grabber(b).x + grabber(b).w
If (left(0) >= right(1)) Or (left(1) > right(0)) Or (top(0) > bottom(1)) Or (top(1) > bottom(0)) Then
' (DO NOTHING)
Else
grabber(b).health = grabber(b).health - 1
herolaser(a).health = FALSE
If grabber(b).health = 0 Then
PlaySound cMutantExplodeSound
'PlaySound cSwarmerSound
If exp1.set = 0 Then
exp1.set = 1
exp1.x = herolaser(a).x
exp1.y = herolaser(a).y
exp1.size = 15
exp1.colour = 2
End If
End If
End If
End If
End If
Next b
End If
Next a
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³ Check hero lasers against mutants ³³³³³³³³³³³³³³³³³³³³³
For a = 0 To maxherolasers
If herolaser(a).health Then
top(0) = herolaser(a).y
left(0) = herolaser(a).x
bottom(0) = herolaser(a).y
right(0) = herolaser(a).x
For b = 0 To maxcolonists
If mutant(b).health Then ' don't bother if mutant is dead
top(1) = mutant(b).y
left(1) = mutant(b).x
bottom(1) = mutant(b).y + mutant(b).h
right(1) = mutant(b).x + mutant(b).w
If (left(0) >= right(1)) Or (left(1) > right(0)) Or (top(0) > bottom(1)) Or (top(1) > bottom(0)) Then
' (DO NOTHING)
Else
mutant(b).health = mutant(b).health - 1
herolaser(a).health = FALSE
PlaySound cMutantExplodeSound
If mutant(b).health = 0 Then
createchunks herolaser(a).x, herolaser(a).y
PlaySound cMutantExplodeSound
If exp1.set = 0 Then
exp1.set = 1
exp1.x = herolaser(a).x
exp1.y = herolaser(a).y
exp1.size = 15
exp1.colour = 4
End If
End If
End If
End If
Next b
End If
Next a
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³ Check hero lasers against bomers. ³³³³³³³³³³³³³³³³³³³³³
For a = 0 To maxherolasers
If herolaser(a).health Then
If herolaser(a).dir Then
top(0) = herolaser(a).y
left(0) = herolaser(a).x
bottom(0) = herolaser(a).y
right(0) = herolaser(a).x
Else
top(0) = herolaser(a).y
left(0) = herolaser(a).x
bottom(0) = herolaser(a).y
right(0) = herolaser(a).x
End If
For b = 0 To maxbomers
If (bomer(b).x > minx) And (bomer(b).x < maxx) Then
If bomer(b).health Then
top(1) = bomer(b).y
left(1) = bomer(b).x
bottom(1) = bomer(b).y + bomer(b).h
right(1) = bomer(b).x + bomer(b).w
If (left(0) >= right(1)) Or (left(1) > right(0)) Or (top(0) > bottom(1)) Or (top(1) > bottom(0)) Then
' (DO NOTHING)
Else
bomer(b).health = bomer(b).health - 1
herolaser(a).health = FALSE
PlaySound cMutantExplodeSound
If bomer(b).health = 0 Then
createchunks herolaser(a).x, herolaser(a).y
PlaySound cMutantExplodeSound
'PlaySound cSwarmerSound
If exp1.set = 0 Then
exp1.set = 1
exp1.x = herolaser(a).x
exp1.y = herolaser(a).y
exp1.size = 15
exp1.colour = 3
End If
End If
End If
End If
End If
Next b
End If
Next a
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³ Check hero lasers against blockers. ³³³³³³³³³³³³³³³³³³³
For a = 0 To maxherolasers
If herolaser(a).health Then ' don't bother if missle is dead
If herolaser(a).dir Then
top(0) = herolaser(a).y
left(0) = herolaser(a).x
bottom(0) = herolaser(a).y
right(0) = herolaser(a).x
Else
top(0) = herolaser(a).y
left(0) = herolaser(a).x
bottom(0) = herolaser(a).y
right(0) = herolaser(a).x
End If
If (blocker.x > minx) And (blocker.x < maxx) Then
If blocker.health Then ' don't bother if mutant is dead
top(1) = blocker.y
left(1) = blocker.x
bottom(1) = blocker.y + blocker.h
right(1) = blocker.x + blocker.w
If (left(0) >= right(1)) Or (left(1) > right(0)) Or (top(0) > bottom(1)) Or (top(1) > bottom(0)) Then
' (DO NOTHING)
Else
blocker.health = blocker.health - 1
createchunks herolaser(a).x, herolaser(a).y
blocker.vy = 0
If blocker.health = 0 Then
hero.vx = hero.mem2 ' restore hero x velocity
PlaySound cMutantExplodeSound
End If
End If
End If
End If
End If
Next a
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³ Check hero lasers against spinners ³³³³³³³³³³³³³³³³³³³³
For a = 0 To maxherolasers
If herolaser(a).health Then ' don't bother if laser is dead
top(0) = herolaser(a).y
left(0) = herolaser(a).x
bottom(0) = herolaser(a).y
right(0) = herolaser(a).x
If (spinner.x > minx) And (spinner.x < maxx) Then
If spinner.health Then ' don't bother if mutant is dead
top(1) = spinner.y - spinner.w
left(1) = spinner.x - spinner.w
bottom(1) = spinner.y + spinner.w
right(1) = spinner.x + spinner.w
If (left(0) >= right(1)) Or (left(1) > right(0)) Or (top(0) > bottom(1)) Or (top(1) > bottom(0)) Then
' (DO NOTHING)
Else
spinner.health = spinner.health - 1
createchunks herolaser(a).x, herolaser(a).y
herolaser(a).health = 0
If spinner.health = 0 Then
PlaySound cMutantExplodeSound
'PlaySound cSwarmerSound
If exp1.set = 0 Then
exp1.set = 1
exp1.x = herolaser(a).x
exp1.y = herolaser(a).y
exp1.size = 15
exp1.colour = 9
End If
End If
End If
End If
End If
End If
Next a
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³ Check hero ship against blockers. ³³³³³³³³³³³³³³³³³³³³³
If blocker.health Then
If (blocker.x > minx) And (blocker.x < maxx) Then
top(0) = hero.y
left(0) = hero.x
bottom(0) = hero.y + hero.h
right(0) = hero.x + hero.w
top(1) = blocker.y
left(1) = blocker.x
bottom(1) = blocker.y + blocker.h
right(1) = blocker.x + blocker.w
If (left(0) >= right(1)) Or (left(1) > right(0)) Or (top(0) > bottom(1)) Or (top(1) > bottom(0)) Then
' (DO NOTHING)
Else
If blocker.mem1 = hero.dir Then hero.vx = 0
hero.y = blocker.y
End If
End If
End If
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³ Check hero ship against chasers. ³³³³³³³³³³³³³³³³³³³³³³
If chaser.health Then
If (chaser.x > minx) And (chaser.x < maxx) Then
top(0) = hero.y
left(0) = hero.x
bottom(0) = hero.y + hero.h
right(0) = hero.x + hero.w
top(1) = chaser.y
left(1) = chaser.x
bottom(1) = chaser.y + chaser.h
right(1) = chaser.x + chaser.w
If (left(0) >= right(1)) Or (left(1) > right(0)) Or (top(0) > bottom(1)) Or (top(1) > bottom(0)) Then
' (DO NOTHING)
Else
'hero.health = hero.health - 1
chaser.health = 0
PlaySound cMutantExplodeSound
createchunks chaser.x, chaser.y
createchunks chaser.x, chaser.y
End If
End If
End If
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³ Check hero lasers against chasers. ³³³³³³³³³³³³³³³³³³³³
If chaser.health Then
If (chaser.x > minx) And (chaser.x < maxx) Then
If Not (chaser.y > hero.y + hero.h) And Not (chaser.y < hero.y) Then
For a = 0 To maxherolasers
top(0) = herolaser(a).y
left(0) = herolaser(a).x
bottom(0) = herolaser(a).y
right(0) = herolaser(a).x
top(1) = chaser.y
left(1) = chaser.x
bottom(1) = chaser.y + chaser.h
right(1) = chaser.x + chaser.w
If (left(0) >= right(1)) Or (left(1) > right(0)) Or (top(0) > bottom(1)) Or (top(1) > bottom(0)) Then
' (DO NOTHING)
Else
chaser.health = 0
createchunks chaser.x, chaser.y
'PlaySound cMutantExplodeSound
PlaySound cSwarmerSound
If exp1.set = 0 Then
exp1.set = 1
exp1.x = herolaser(a).x
exp1.y = herolaser(a).y
exp1.size = 15
exp1.colour = 15
End If
End If
Next a
End If
End If
End If
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³ Check hero ship against alienbombs. ³³³³³³³³³³³³³³³³³³³
If bomb.health Then
top(0) = hero.y
left(0) = hero.x
bottom(0) = hero.y + hero.h
right(0) = hero.x + hero.w
top(1) = bomb.y
left(1) = bomb.x
bottom(1) = bomb.y + bomb.h
right(1) = bomb.x + bomb.w
If (left(0) >= right(1)) Or (left(1) > right(0)) Or (top(0) > bottom(1)) Or (top(1) > bottom(0)) Then
' (DO NOTHING)
Else
bomb.health = 0
hero.health = hero.health - 1
createchunks bomb.x, bomb.y
createchunks bomb.x, bomb.y
createchunks bomb.x, bomb.y
End If
End If
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³ Check hero lasers against colonists. ³³³³³³³³³³³³³³³³³³
'For a = 0 To maxherolasers
' If col(a).y < maxy - col(a).h Then
' If (col(a).x > minx) And (col(a).x < maxx) Then
' If herolaser(a).health Then
' If herolaser(a).dir Then
' top(0) = herolaser(a).y
' left(0) = herolaser(a).x
' bottom(0) = herolaser(a).y
' right(0) = herolaser(a).x
' Else
' top(0) = herolaser(a).y
' left(0) = herolaser(a).x
' bottom(0) = herolaser(a).y
' right(0) = herolaser(a).x
' End If
'
' For b = 0 To maxcolonists
' If col(b).health Then
' top(1) = col(b).y
' left(1) = col(b).x
' bottom(1) = col(b).y + col(b).h
' right(1) = col(b).x + col(b).w
' If (left(0) >= right(1)) Or (left(1) > right(0)) Or (top(0) > bottom(1)) Or (top(1) > bottom(0)) Then
' ' (DO NOTHING)
' Else
' grabber(col(b).mem1).mode = 0
' col(b).mem1 = 0 ' clear memory
' col(b).mode = 0
' col(b).health = 0
' pickup = 0 ' set for another
' herolaser(a).health = FALSE
' createchunks herolaser(a).x, herolaser(a).y
' PlaySound cColonistDiedSound
' End If
' End If
' Next b
' End If
' End If
' End If
'Next a
End Sub ' collision
' /////////////////////////////////////////////////////////////////////////////
Sub createalienbolt (x, y)
For a = 0 To maxalienbolts
If alienbolt(a).health = 0 And alienbolt(a).eras = 0 Then ' empty spot
If timepassed(2, .6) = 0 Then Exit Sub
alienbolt(a).x = x + 5
alienbolt(a).y = y + 5
alienbolt(a).mem1 = x
alienbolt(a).mem2 = y
alienbolt(a).oldx = alienbolt(a).x
alienbolt(a).oldy = alienbolt(a).y
alienbolt(a).vx = hero.x
alienbolt(a).vy = hero.y
alienbolt(a).h = 1
alienbolt(a).w = 1
alienbolt(a).eras = 0
alienbolt(a).health = 20
alienbolt(a).thrust = 0
Exit For
End If
Next a
End Sub ' createalienbolt
' /////////////////////////////////////////////////////////////////////////////
' Finds an empty spot in the alienshot array and initalize it
' with a shot. Figures aim based on location of our hero.
' x = physical x location to shoot from
' y = physical y location to shot from
Sub createalienshot (x, y)
If alienshot.health = 0 And alienshot.eras = 0 Then
PlaySound cMutantFiringSound
alienshot.health = maxx
'x = x + RandomNum(-5)
'y = y + RandomNum(-5)
If x > hero.x Then alienshot.dirx = 0
If x < hero.x Then alienshot.dirx = 1
If y > hero.y Then alienshot.diry = 0
If y < hero.y Then alienshot.diry = 1
'IF hero.x < x THEN
' alienshot.dir = 1
'END IF
'IF hero.x > x THEN
' alienshot.dir = 0
'END IF
alienshot.vx = 6
alienshot.vy = 6
alienshot.x = x
alienshot.y = y
alienshot.oldx = alienshot.x
alienshot.oldy = alienshot.y
alienshot.mem2 = 0
alienshot.h = 2
alienshot.w = 2
alienshot.eras = 0
alienshot.thrust = 0
End If
End Sub ' createalienshot
' /////////////////////////////////////////////////////////////////////////////
Sub createblocker
If blocker.health = 0 And blocker.eras = 0 Then
blocker.vy = 1
blocker.px = 0
blocker.py = 0
blocker.dir = RandomNum(2)
blocker.h = 10
blocker.w = 10
blocker.eras = 0
blocker.health = 10
blocker.mem1 = 0
blocker.mem2 = 0
blocker.thrust = 0
blocker.x = RandomNum(fieldw)
blocker.y = 100
blocker.cy = 0
blocker.oldx = blocker.x
blocker.oldy = blocker.y
End If
End Sub ' createblocker
' /////////////////////////////////////////////////////////////////////////////
Sub createbomb (x, y)
If bomb.health = 0 And bomb.eras = 0 Then
If timepassed(10, .5) = 0 Then Exit Sub
PlaySound cBomerSound
bomb.health = (maxy * 5)
If hero.y < y Then
bomb.dir = 1
End If
If hero.y > y Then
bomb.dir = 0
End If
If x > hero.x Then
bomb.vx = 1
End If
If x < hero.x Then
bomb.vx = -1
End If
bomb.vy = 8
'bomb.cy = 10
bomb.x = x
bomb.y = y
bomb.oldx = bomb.x
bomb.oldy = bomb.y
bomb.mem2 = 0
bomb.h = 2
bomb.w = 2
bomb.eras = 0
bomb.thrust = 0
End If
End Sub ' createbomb
' /////////////////////////////////////////////////////////////////////////////
Sub createbomer
If bomer(0).played = bomer(0).toplay Then Exit Sub
If timepassed(3, .9) = 0 Then Exit Sub
For a = 0 To maxbomers
If bomer(a).health = 0 And bomer(a).eras = 0 Then
bomer(a).px = 0
bomer(a).py = 0
bomer(a).dir = RandomNum(2)
bomer(a).h = 6
bomer(a).w = 6
bomer(a).eras = 0
bomer(a).health = 1
bomer(a).mem1 = 0
bomer(a).mem2 = 0
bomer(a).thrust = 0
bomer(a).mode = 0
bomer(a).x = (RandomNum(fieldw - maxx)) + maxx
bomer(a).y = RandomNum(maxy - (25 + 35)) + 35
bomer(a).oldx = bomer(a).x
bomer(a).oldy = bomer(a).y
bomer(0).played = bomer(0).played + 1
Exit Sub
End If
Next a
End Sub ' createbomer
' /////////////////////////////////////////////////////////////////////////////
Sub createchaser
If timepassed(4, 1) = 0 Then Exit Sub
If chaser.toplay = chaser.played Then Exit Sub
If (chaser.health = 0 And chaser.eras = 0) Then
chaser.cx = 0
chaser.cy = 0
chaser.px = 0
chaser.py = 0
chaser.h = 3
chaser.w = 15
chaser.eras = 0
chaser.health = 1
chaser.mem1 = 0
chaser.mem2 = 0
chaser.thrust = 0
chaser.mode = 0
chaser.x = (RandomNum(fieldw - maxx)) + maxx
chaser.y = RandomNum(maxy - (25 + 35)) + 35
chaser.oldx = chaser.x
chaser.oldy = chaser.y
chaser.played = chaser.played + 1
Exit Sub
End If
End Sub ' createchaser
' /////////////////////////////////////////////////////////////////////////////
' Find an empty spot in the array and initalize it with a chunk
' Chunks fly out when things collide .
Sub createchunks (x, y)
For a = 0 To maxchunks
If chunk(a).health = 0 And chunk(a).eras = 0 Then ' empty spot
chunk(a).x = x
chunk(a).y = y
chunk(a).oldx = chunk(a).x
chunk(a).oldy = chunk(a).y
If RandomNum(2) Then ' randomly select velocitys
chunk(a).vx = RandomNum(2) + speed
Else
chunk(a).vx = RandomNum(-2) - speed
End If
If RandomNum(2) Then
chunk(a).vy = RandomNum(2) + speed
Else
chunk(a).vy = RandomNum(-2) - speed
End If
chunk(a).h = 1
chunk(a).w = 1
chunk(a).eras = 0 ' erase flag
chunk(a).health = 50 ' life of a chunk
chunk(a).thrust = 0
If ct = 5 Then Exit For ' found one
ct = ct + 1
End If
Next a
End Sub ' createchunks
' /////////////////////////////////////////////////////////////////////////////
Sub createcolonists
For a = 0 To maxcolonists
col(a).x = RandomNum(fieldw)
col(a).y = (fieldh - 5)
col(a).oldx = col(a).x
col(a).oldy = col(a).y
col(a).vx = 0
col(a).vy = 0
col(a).dir = 0
col(a).h = 5
col(a).w = 2
col(a).eras = 0
col(a).health = 1
col(a).mode = 0
col(a).mem1 = 0
col(a).mem2 = 0
Next a
End Sub ' createcolonists
' /////////////////////////////////////////////////////////////////////////////
' create grabber
Sub creategrabber
If grabber(0).played = grabber(0).toplay Then
If timepassed(0, 8) Then grabber(0).played = grabber(0).played - 1
Exit Sub
End If
If timepassed(1, .9) = 0 Then Exit Sub ' aliens appear about 1 per sec
For a = 0 To maxgrabbers
If (grabber(a).health = 0 And grabber(a).eras = 0 And grabber(a).mode = 0) Then
grabber(a).cx = 0
grabber(a).cy = 0
grabber(a).px = 0
grabber(a).py = 0
grabber(a).dirx = RandomNum(2)
grabber(a).h = 8
grabber(a).w = 8
grabber(a).eras = 0
grabber(a).health = 1
grabber(a).mem1 = 0 ' used when picking up colonist
grabber(a).mem2 = 0 ' used to determine if fired missle
grabber(a).thrust = 0
grabber(a).mode = 0
grabber(a).x = (RandomNum(fieldw - maxx)) + maxx
grabber(a).y = RandomNum(maxy - (25 + 35)) + 35
grabber(a).oldx = grabber(a).x
grabber(a).oldy = grabber(a).y
grabber(0).played = grabber(0).played + 1
Exit Sub
End If
Next a
End Sub ' creategrabber
DefSng A-Z
' /////////////////////////////////////////////////////////////////////////////
' hero ship is draw here and its variables initialized.
' This will possible be loaded from disk in the future
Sub createhero
DefInt A-Z
If hero.x = 0 Then
Dim heroimage(75, 1) As Integer
Line (0, 0)-(25, 15), 0, BF ' clear the area
PSet (0, 0), 0 ' set graphics cursor
Line -(10, 10), 0 ' move down and over a little
Line -(5, 15), 9 ' defender facing right
Line -(25, 15), 9
Line -(10, 10), 9
Paint Step(2, 2), 1, 9
Line (30, 0)-(55, 15), 0, BF ' clear the area
PSet (30, 0), 0 ' set graphics cursor
Line -(50, 10), 0 ' move down and over a little
Line -(55, 15), 9 ' defender facing left
Line -(35, 15), 9
Line (37, 15)-(49, 11), 9
Paint Step(2, 2), 1, 9
Get (5, 10)-(25, 15), heroimage(0, 0) ' get facing right
Get (35, 10)-(55, 15), heroimage(0, 1) ' get facing left
Put (5, 10), heroimage(0, 0) ' hide the evidence
Put (35, 10), heroimage(0, 1)
End If
hero.x = 130 ' set sprite variables for
hero.y = maxy / 2 ' starting location
hero.oldx = hero.x ' so old location can be erased
hero.oldy = hero.y
hero.vx = 5
hero.vy = 2
hero.mem2 = hero.vx
hero.h = 5 ' highth of image
hero.w = 20 ' width of image
hero.eras = 0 ' erase flag
hero.health = 4 ' sprite active
hero.thrust = 0
hero.cx = 10
End Sub ' createhero
' /////////////////////////////////////////////////////////////////////////////
' find an empty spot in the heromissle array and initalizes with a
' new missle.
Sub createherolaser
For a = 0 To maxherolasers
If herolaser(a).health = 0 And hero.health Then
If hero.dir Then ' firing left
herolaser(a).x = hero.x
herolaser(a).y = hero.y + hero.h
herolaser(a).dir = 1
Else ' firing right
herolaser(a).x = hero.x + hero.w
herolaser(a).y = hero.y + hero.h
herolaser(a).dir = 0
End If
herolaser(a).oldx = herolaser(a).x
herolaser(a).oldy = herolaser(a).y
herolaser(a).mem1 = herolaser(a).oldx
herolaser(a).mem2 = herolaser(a).oldy
herolaser(a).vx = 4 + speed
herolaser(a).vy = 0
herolaser(a).h = 1
herolaser(a).w = 50
herolaser(a).eras = 0
herolaser(a).health = 1
PlaySound cHeroFiringSound
Exit For
End If
Next a
End Sub ' createherolaser
' /////////////////////////////////////////////////////////////////////////////
' create mutant
Sub createmutant (x, y)
For a = 0 To maxcolonists
If mutant(a).health = 0 And mutant(a).eras = 0 Then
mutant(a).px = 0
mutant(a).py = 0
mutant(a).dir = 0
mutant(a).h = 8
mutant(a).w = 8
mutant(a).eras = 0
mutant(a).health = 1
mutant(a).mem1 = 0
mutant(a).mem2 = 0
mutant(a).thrust = 0
mutant(a).mode = 0
mutant(a).x = x
mutant(a).y = y
mutant(a).oldx = mutant(a).x
mutant(a).oldy = mutant(a).y
Exit For
End If
Next a
End Sub ' createmutant
' /////////////////////////////////////////////////////////////////////////////
Sub createspinette (x, y)
If spinette.health = 0 And spinette.eras = 0 Then
If timepassed(8, .5) = 0 Then Exit Sub
If x > hero.x Then spinette.dirx = 1
If x < hero.x Then spinette.dirx = 0
If y > hero.y Then spinette.diry = 0
If y < hero.y Then spinette.diry = 1
spinette.vx = 5
spinette.vy = 5
spinette.px = x
spinette.py = y
spinette.x = x
spinette.y = y
spinette.oldx = spinette.x
spinette.oldy = spinette.y
spinette.mem1 = 0
spinette.mem2 = 0
spinette.h = 2
spinette.w = 2
spinette.health = 1
End If
End Sub ' createspinette
' /////////////////////////////////////////////////////////////////////////////
Sub createspinner
If spinner.toplay = spinner.played Then Exit Sub
If (spinner.health = 0 And spinner.eras = 0) Then
If timepassed(5, 1) = 0 Then Exit Sub
spinner.cx = 0
spinner.cy = 0
spinner.px = 0
spinner.py = 0
spinner.h = 8
spinner.w = 8
spinner.eras = 0
spinner.health = 3
spinner.mem1 = -6
spinner.mem2 = -1
spinner.thrust = 0
spinner.mode = 0
spinner.x = (RandomNum(fieldw - maxx)) + maxx
spinner.y = RandomNum(maxy - topy) + topy
spinner.oldx = spinner.x
spinner.oldy = spinner.y
spinner.played = spinner.played + 1
End If
End Sub ' createspinner
' /////////////////////////////////////////////////////////////////////////////
Sub createtracker
If tracker.toplay = tracker.played Then Exit Sub
If (tracker.health = 0 And tracker.eras = 0) Then
'IF timepassed(5, 1) = 0 THEN EXIT SUB
tracker.cx = 0
tracker.cy = 0
tracker.px = 0
tracker.py = 0
tracker.h = 8
tracker.w = 8
tracker.eras = 0
tracker.health = 1
tracker.mem1 = 150
tracker.mem2 = 0
tracker.thrust = 0
tracker.mode = 0
tracker.x = (RandomNum(fieldw - maxx)) + maxx
tracker.y = RandomNum(maxy - topy) + topy
tracker.oldx = tracker.x
tracker.oldy = tracker.y
tracker.played = tracker.played + 1
End If
End Sub ' createtracker
' /////////////////////////////////////////////////////////////////////////////
Sub drawboundrys
Line (minx, maxy - 6)-(maxx, maxy - 6), 1
Line (minx, miny + 35)-(maxx, miny + 35), 1
End Sub ' drawboundrys
' /////////////////////////////////////////////////////////////////////////////
' draws stationary elements of the playscreen
Sub drawplayscreen
Line (radarx - 31, radary)-(radarx + radarw - 28, radary + radarh), 1, B
'LINE (radarx - (radarw / 2), radary)-(radarx + radarw - (radarw / 3), radary + radarh), 1, B
Line (radarx, radary + 1)-(radarx + 20, radary + 1), 1
Line (minx, topy - 1)-(maxx, topy - 1), 1
p5x7ascfnt 5, 5, "Level", 2
p5x7ascfnt 30, 5, Str$(level), 2
End Sub ' drawplayscreen
' /////////////////////////////////////////////////////////////////////////////
Sub endgame
Static a, b, c
If hero.health <= 1 Then
If a = 0 Then
If timepassed(6, 2) Then a = 1
createchunks hero.x + RandomNum(25), hero.y + RandomNum(10)
If exp1.set = 0 Then
exp1.set = 1
exp1.x = hero.x + RandomNum(25)
exp1.y = hero.y + RandomNum(25)
exp1.size = RandomNum(35)
exp1.colour = 14
End If
ElseIf a = 1 Then
exp1.set = 1
exp1.x = hero.x + RandomNum(25)
exp1.y = hero.y + RandomNum(10)
exp1.size = 100
exp1.colour = 14
hero.health = 0
a = 2
ElseIf a = 2 Then
If timepassed(7, 6) Then
Cls
a = 0
Color 7
Print "Play again (y,n) ?";
If usepages Then PCopy 1, 0
Do
a$ = InKey$
Loop While a$ = ""
If a$ = "n" Or a$ = "N" Then
'End
bIsPlaying% = FALSE
Exit Sub
End If
Cls
level = 0
hero.health = 4
End If
End If
End If
End Sub ' endgame
' /////////////////////////////////////////////////////////////////////////////
Sub killsprites
For a = 0 To maxcolonists
mutant(a).health = 0
Next a
For a = 0 To maxchunks
chunk(a).health = 0
Next a
For a = 0 To maxgrabbers
grabber(a).health = 0
Next a
grabber(0).played = 0
For a = 0 To maxcolonists
mutant(a).health = 0
Next a
For a = 0 To maxbomers
bomer(a).health = 0
Next a
blocker.health = 0
shot.health = 0
bomb.health = 0
chaser.health = 0
chaser.played = 0
bomer(0).played = 0
grabber(0).played = 0
exp1.set = 0
End Sub ' killsprites
' /////////////////////////////////////////////////////////////////////////////
' If all aliens have been killed next level is set up.
Sub levels
Static proceed
If (aliensinplay = 0 And timepassed(9, 4) = 1) Or level = 0 Then ' delay a little
Cls
If usepages Then PCopy 1, 0
Sleep (1) ' delay a little
killsprites ' reset sprites
Select Case (level)
Case 0
maxgrabbers = 3 ' on playfield at once
grabber(0).toplay = 5 ' amount to play
grabber(0).vx = 6: grabber(0).vy = 6 ' velocitys
alienshot.vx = 5
' tracker.toplay = 4
' tracker.vx = 6: tracker.vy = 6
mutant(0).vx = 12: mutant(0).vy = 6
'chaser.toplay = 2
'chaser.vx = 4: chaser.vy = 8
maxbomers = 0: bomer(0).toplay = 0
maxcolonists = 1
'spinner.toplay = 1
'spinner.vy = 40
maxbomers = 1
bomer(0).toplay = 3
bomer(0).vx = 10: bomer(0).vy = 10
'blocker.mode = 1
'createblocker
Case 1
maxgrabbers = 6 ' on playfield at once
grabber(0).toplay = 8 ' amount to play
grabber(0).vx = 6: grabber(0).vy = 6 ' velocitys
alienshot.vx = 5
mutant(0).vx = 6: mutant(0).vy = 6
' chaser.toplay = 2
' chaser.vx = 4: chaser.vy = 8
maxbomers = 1: bomer(0).toplay = 1
maxcolonists = 5
maxbomers = 1
bomer(0).toplay = 3
bomer(0).vx = 10: bomer(0).vy = 10
Case 2
maxgrabbers = 6 ' on playfield at once
grabber(0).toplay = 10 ' amount to play
grabber(0).vx = 5: grabber(0).vy = 5 ' velocitys
alienshot.vx = 4
mutant(0).vx = 5: mutant(0).vy = 5
maxcolonists = 5
maxbomers = 1
bomer(0).toplay = 3
bomer(0).vx = 8: bomer(0).vy = 8
Case 3
maxgrabbers = 8 ' on playfield at once
grabber(0).toplay = 12 ' amount to play
grabber(0).vx = 5: grabber(0).vy = 5 ' velocitys
alienshot.vx = 4
' tracker.toplay = 4
' tracker.vx = 6: tracker.vy = 6
mutant(0).vx = 5: mutant(0).vy = 5
'chaser.toplay = 2
'chaser.vx = 4: chaser.vy = 8
'spinner.toplay = 1
'spinner.vy = 40
maxbomers = 2
bomer(0).toplay = 4
bomer(0).vx = 8: bomer(0).vy = 8
'blocker.mode = 1
'createblocker
maxcolonists = 6
Case 4
maxgrabbers = 8 ' on playfield at once
grabber(0).toplay = 12 ' amount to play
grabber(0).vx = 5: grabber(0).vy = 5 ' velocitys
alienshot.vx = 4
' tracker.toplay = 4
' tracker.vx = 6: tracker.vy = 6
mutant(0).vx = 4: mutant(0).vy = 4
'chaser.toplay = 2
'chaser.vx = 4: chaser.vy = 8
'spinner.toplay = 1
'spinner.vy = 40
maxbomers = 2
bomer(0).toplay = 5
bomer(0).vx = 7: bomer(0).vy = 7
'blocker.mode = 1
'createblocker
maxcolonists = 7
Case 5
maxgrabbers = 8 ' on playfield at once
grabber(0).toplay = 16 ' amount to play
grabber(0).vx = 4: grabber(0).vy = 4 ' velocitys
alienshot.vx = 3
' tracker.toplay = 4
' tracker.vx = 6: tracker.vy = 6
mutant(0).vx = 4: mutant(0).vy = 4
'chaser.toplay = 2
'chaser.vx = 4: chaser.vy = 8
spinner.toplay = 1
spinner.vy = 40
maxbomers = 2
bomer(0).toplay = 5
bomer(0).vx = 6: bomer(0).vy = 6
maxcolonists = 7
Case 6
maxgrabbers = 8 ' on playfield at once
grabber(0).toplay = 18 ' amount to play
grabber(0).vx = 3: grabber(0).vy = 3 ' velocitys
alienshot.vx = 3
' tracker.toplay = 4
' tracker.vx = 6: tracker.vy = 6
mutant(0).vx = 3: mutant(0).vy = 3
chaser.toplay = 2
chaser.vx = 4: chaser.vy = 7
spinner.toplay = 3
spinner.vy = 20
maxbomers = 2
bomer(0).toplay = 5
bomer(0).vx = 5: bomer(0).vy = 5
maxcolonists = 7
Case 7
maxgrabbers = 8 ' on playfield at once
grabber(0).toplay = 18 ' amount to play
grabber(0).vx = 2: grabber(0).vy = 2 ' velocitys
alienshot.vx = 3
' tracker.toplay = 4
' tracker.vx = 6: tracker.vy = 6
mutant(0).vx = 3: mutant(0).vy = 3
chaser.toplay = 4
chaser.vx = 2: chaser.vy = 3
spinner.toplay = 3
spinner.vy = 4
maxbomers = 2
bomer(0).toplay = 5
bomer(0).vx = 3: bomer(0).vy = 3
maxcolonists = 8
Case 8
maxgrabbers = 8 ' on playfield at once
grabber(0).toplay = 18 ' amount to play
grabber(0).vx = 2: grabber(0).vy = 2 ' velocitys
alienshot.vx = 3
' tracker.toplay = 4
' tracker.vx = 6: tracker.vy = 6
mutant(0).vx = 2: mutant(0).vy = 2
chaser.toplay = 4
chaser.vx = 1: chaser.vy = 3
spinner.toplay = 3
spinner.vy = 4
maxbomers = 2
bomer(0).toplay = 5
bomer(0).vx = 2: bomer(0).vy = 2
maxcolonists = 8
Case 9
maxgrabbers = 8 ' on playfield at once
grabber(0).toplay = 18 ' amount to play
grabber(0).vx = 2: grabber(0).vy = 2 ' velocitys
alienshot.vx = 3
' tracker.toplay = 4
' tracker.vx = 6: tracker.vy = 6
mutant(0).vx = 2: mutant(0).vy = 2
chaser.toplay = 4
chaser.vx = 2: chaser.vy = 3
spinner.toplay = 5
spinner.vy = 1
maxbomers = 2
bomer(0).toplay = 6
bomer(0).vx = 1: bomer(0).vy = 1
maxcolonists = 8
Case 10
maxgrabbers = 8 ' on playfield at once
grabber(0).toplay = 18 ' amount to play
grabber(0).vx = 1: grabber(0).vy = 1 ' velocitys
alienshot.vx = 3
' tracker.toplay = 4
' tracker.vx = 6: tracker.vy = 6
mutant(0).vx = 2: mutant(0).vy = 2
chaser.toplay = 4
chaser.vx = 2: chaser.vy = 3
spinner.toplay = 5
spinner.vy = 1
maxbomers = 2
bomer(0).toplay = 6
bomer(0).vx = 1: bomer(0).vy = 1
maxcolonists = 8
Case Else
Cls
Screen 0
Width 80
Print " Thats all for now. "
Print " Hope to here from ya. "
Print " "
Print ""
Print " "
'End
bIsPlaying% = FALSE
Exit Sub
End Select
' cleanup variables
pickup = 0 ' allow colonist pickups
level = level + 1 ' advance level
drawplayscreen
createcolonists
End If
End Sub ' levels
' /////////////////////////////////////////////////////////////////////////////
' Handle movement of all sprites based on user input or there movement
' algorithms. Sprites are drawn and removed here .Radar positions
' are calculated and placed on screen
Sub movesprites
Static c1
aliensinplay = 0 ' reset grabber body count
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³ grabber ³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
For a = 0 To maxgrabbers
PSet (grabber(a).oldrx, grabber(a).oldry), 0
If Not ((grabber(a).x < -10) Or (grabber(a).x > maxx)) Then ' Colonist on screen
If grabber(a).eras Then
Line (grabber(a).oldx, grabber(a).y)-(grabber(a).oldx + grabber(a).w, grabber(a).y + grabber(a).h), 0, BF
End If
End If
grabber(a).eras = FALSE
' Shot while desending ?
If grabber(a).health = 0 And grabber(a).mode = 1 Then
pickup = 0 ' reset pickup
grabber(a).mode = 0 ' reset grabber
End If
If grabber(a).health Then
aliensinplay = aliensinplay + 1
traitsgrabber a ' personality and movement
grabber(a).rx = (grabber(a).x / radarsx) + radarx ' radar location
grabber(a).ry = grabber(a).y / radarsy + radary
If grabber(a).rx > (radarwrapx + radarx) Then grabber(a).rx = grabber(a).rx - radarw
grabber(a).oldrx = grabber(a).rx
grabber(a).oldry = grabber(a).ry
grabber(a).oldx = grabber(a).x
grabber(a).eras = TRUE
If Not ((grabber(a).x < -10) Or (grabber(a).x > maxx)) Then ' visable ?
Line (grabber(a).x, grabber(a).y)-(grabber(a).x + grabber(a).w, grabber(a).y + grabber(a).h), 2, BF
'p3x5nfnt grabber(a).x, grabber(a).y, a, 2
grabber(a).px = Point(0)
grabber(a).py = Point(1)
End If
PSet (grabber(a).rx, grabber(a).ry), 2
End If
Next a
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³ mutant ³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
For a = 0 To maxcolonists
PSet (mutant(a).oldrx, mutant(a).oldry), 0
If (mutant(a).x > -10) And (mutant(a).x < maxx) Then
If mutant(a).eras Then
Line (mutant(a).oldx, mutant(a).y)-(mutant(a).oldx + mutant(a).w, mutant(a).y + mutant(a).h), 0, BF
End If
End If
mutant(a).eras = FALSE
If mutant(a).health Then
aliensinplay = aliensinplay + 1
traitsmutant a ' personality and movement
mutant(a).rx = (mutant(a).x / radarsx) + radarx ' radar location
mutant(a).ry = mutant(a).y / radarsy + radary
If mutant(a).rx > (radarwrapx + radarx) Then mutant(a).rx = mutant(a).rx - radarw
mutant(a).oldrx = mutant(a).rx
mutant(a).oldry = mutant(a).ry
mutant(a).oldx = mutant(a).x
mutant(a).oldy = mutant(a).y
If (mutant(a).x > miny) And (mutant(a).x < maxx) Then
Line (mutant(a).x, mutant(a).y)-(mutant(a).x + mutant(a).w, mutant(a).y + mutant(a).h), 4, BF
mutant(a).px = Point(0)
mutant(a).py = Point(1)
End If
PSet (mutant(a).rx, mutant(a).ry), 4
mutant(a).eras = TRUE
End If
Next a
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³ chaser ³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
PSet (chaser.oldrx, chaser.oldry), 0
If (chaser.x > -10) And (chaser.x < maxx) Then
If chaser.eras Then
Line (chaser.oldx, chaser.y)-(chaser.oldx + chaser.w, chaser.y + chaser.h), 0, BF
End If
End If
chaser.eras = FALSE
If chaser.health Then
aliensinplay = aliensinplay + 1
traitschaser a ' personality and movement
chaser.rx = (chaser.x / radarsx) + radarx ' radar location
chaser.ry = chaser.y / radarsy + radary
If chaser.rx > (radarwrapx + radarx) Then chaser.rx = chaser.rx - radarw
chaser.oldrx = chaser.rx
chaser.oldry = chaser.ry
chaser.oldx = chaser.x
chaser.oldy = chaser.y
If (chaser.x > miny) And (chaser.x < maxx) Then
Line (chaser.x, chaser.y)-(chaser.x + chaser.w, chaser.y + chaser.h), 15, B
chaser.px = Point(0)
chaser.py = Point(1)
End If
PSet (chaser.rx, chaser.ry), 15
chaser.eras = TRUE
End If
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³ bomer ³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
For a = 0 To maxbomers
PSet (bomer(a).oldrx, bomer(a).oldry), 0
If Not ((bomer(a).x < -10) Or (bomer(a).x > maxx)) Then
If bomer(a).eras Then
Line (bomer(a).oldx, bomer(a).y)-(bomer(a).oldx + bomer(a).w, bomer(a).y + bomer(a).h), 0, BF
Line (bomer(a).oldx + bomer(a).w, bomer(a).oldy + bomer(a).h)-(bomer(a).oldx + bomer(a).w + bomer(a).w, bomer(a).oldy + bomer(a).h + bomer(a).h), 0, B
End If
End If
bomer(a).eras = FALSE
If bomer(a).health Then
aliensinplay = aliensinplay + 1
traitsbomer a ' personality and movement
bomer(a).rx = (bomer(a).x / radarsx) + radarx ' radar location
bomer(a).ry = bomer(a).y / radarsy + radary
If bomer(a).rx > (radarwrapx + radarx) Then bomer(a).rx = bomer(a).rx - radarw
bomer(a).oldrx = bomer(a).rx
bomer(a).oldry = bomer(a).ry
bomer(a).oldx = bomer(a).x
bomer(a).oldy = bomer(a).y
bomer(a).eras = TRUE
If Not ((bomer(a).x < -10) Or (bomer(a).x > maxx)) Then ' visable ?
Line (bomer(a).x, bomer(a).y)-(bomer(a).x + bomer(a).w, bomer(a).y + bomer(a).h), 3, B
Line (bomer(a).x + bomer(a).w, bomer(a).y + bomer(a).h)-(bomer(a).x + bomer(a).w + bomer(a).w, bomer(a).y + bomer(a).h + bomer(a).h), 3, B
bomer(a).px = Point(0)
bomer(a).py = Point(1)
End If
PSet (bomer(a).rx, bomer(a).ry), 3
End If
Next a
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³ spinner ³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
PSet (spinner.oldrx, spinner.oldry), 0
If Not ((spinner.x < -10) Or (spinner.x > maxx)) Then
If spinner.eras Then
Circle (spinner.oldx, spinner.oldy), spinner.w, 0, spinner.mem1, spinner.mem2
'p5x7ascfnt spinner.oldx, spinner.oldy, "", 0
End If
End If
spinner.eras = FALSE
If spinner.health Then
aliensinplay = aliensinplay + 1
traitsspinner a ' personality and movement
spinner.rx = (spinner.x / radarsx) + radarx ' radar location
spinner.ry = spinner.y / radarsy + radary
If spinner.rx > (radarwrapx + radarx) Then spinner.rx = spinner.rx - radarw
spinner.oldrx = spinner.rx
spinner.oldry = spinner.ry
spinner.oldx = spinner.x
spinner.oldy = spinner.y
spinner.eras = TRUE
If Not ((spinner.x < -10) Or (spinner.x > maxx)) Then ' visable ?
c1 = (c1 + 1) Mod 16
If c1 = 15 Then
spinner.mem1 = spinner.mem1 + 1
spinner.mem2 = spinner.mem2 + 1
If spinner.mem1 = 0 Then spinner.mem1 = -6
If spinner.mem2 = 0 Then spinner.mem2 = -6
End If
Circle (spinner.x, spinner.y), spinner.w, 9, spinner.mem1, spinner.mem2
'p5x7ascfnt spinner.x, spinner.y, "", 9
spinner.px = Point(0)
spinner.py = Point(1)
End If
PSet (spinner.rx, spinner.ry), 9
End If
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³ spinette ³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
' (spinners weapon)
If Not ((spinette.x < minx - spinette.w) Or (spinette.x > maxx + spinette.w)) Then
If spinette.eras Then
Circle (spinette.oldx, spinette.oldy), spinette.w, 0
PSet (spinette.x, spinette.y), 0
End If
End If
spinette.eras = FALSE
If spinette.health Then
aliensinplay = aliensinplay + 1
traitsspinette ' movement
spinette.eras = TRUE
spinette.oldx = spinette.x
spinette.oldy = spinette.y
If Not ((spinette.x < minx - spinette.w) Or (spinette.x > maxx + spinette.w)) Then
Circle (spinette.x, spinette.y), spinette.w, 9
PSet (spinette.x, spinette.y), strobe
End If
End If
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³ tracker ³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
If Not ((tracker.x < -10) Or (tracker.x > maxx)) Then
If tracker.eras Then
p5x7ascfnt tracker.oldx, tracker.oldy, "", 0
End If
End If
tracker.eras = FALSE
If tracker.health Then
aliensinplay = aliensinplay + 1
traitstracker a ' personality and movement
If tracker.rx > (radarwrapx + radarx) Then tracker.rx = tracker.rx - radarw
tracker.oldx = tracker.x
tracker.oldy = tracker.y
tracker.eras = TRUE
If Not ((tracker.x < -10) Or (tracker.x > maxx)) Then ' visable ?
p5x7ascfnt tracker.x, tracker.y, "", 9
End If
End If
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³ blocker ³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
PSet (blocker.oldrx, blocker.oldry), 0
If Not ((blocker.x < -10) Or (blocker.x > maxx)) Then
If blocker.eras Then
Line (blocker.oldx, blocker.y)-(blocker.oldx + blocker.w, blocker.y + blocker.h), 0, BF
End If
End If
blocker.eras = FALSE
If blocker.health Then
traitsblocker ' personality and movement
blocker.rx = (blocker.x / radarsx) + radarx ' radar location
blocker.ry = blocker.y / radarsy + radary
If blocker.rx > (radarwrapx + radarx) Then blocker.rx = blocker.rx - radarw
blocker.oldrx = blocker.rx
blocker.oldry = blocker.ry
blocker.oldx = blocker.x
blocker.oldy = blocker.y
blocker.eras = TRUE
If Not ((blocker.x < -10) Or (blocker.x > maxx)) Then ' visable ?
'LINE (blocker(a).x, blocker(a).y)-(blocker(a).x + blocker(a).w, blocker(a).y + blocker(a).h), 3, BF
PSet (blocker.x, blocker.y), 3
Line -(blocker.x + blocker.w, blocker.y), 3
Line -(blocker.x + (blocker.w) / 2, blocker.y + blocker.h), 3
Line -(blocker.x, blocker.y), 2
'blocker(a).px = POINT(0)
'blocker(a).py = POINT(1)
End If
PSet (blocker.rx, blocker.ry), 3
End If
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³ hero lasers ³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
For a = 0 To maxherolasers
If herolaser(a).eras Then ' erase old location
Line (herolaser(a).oldx, herolaser(a).oldy)-(herolaser(a).mem1, herolaser(a).mem2), 0
herolaser(a).eras = FALSE
End If
If herolaser(a).health Then
herolaser(a).oldx = herolaser(a).x ' save old location
herolaser(a).oldy = herolaser(a).y
Select Case herolaser(a).dir
Case 1 ' fired left
If herolaser(a).x > minx Then
herolaser(a).x = herolaser(a).x - herolaser(a).vx
If herolaser(a).mem1 > herolaser(a).x + herolaser(a).w Then
herolaser(a).mem1 = herolaser(a).mem1 - herolaser(a).vx
End If
Else
herolaser(a).mem1 = herolaser(a).mem1 - herolaser(a).vx
End If
Line (herolaser(a).x, herolaser(a).y)-(herolaser(a).mem1, herolaser(a).mem2), 7
herolaser(a).eras = TRUE ' set erase flag
If herolaser(a).mem1 < minx Then
herolaser(a).health = FALSE ' restore array element
End If
Case 0 ' fired right
If herolaser(a).x < maxx Then
herolaser(a).x = herolaser(a).x + herolaser(a).vx
If herolaser(a).mem1 < herolaser(a).x - herolaser(a).w Then
herolaser(a).mem1 = herolaser(a).mem1 + herolaser(a).vx
End If
Else
herolaser(a).mem1 = herolaser(a).mem1 + herolaser(a).vx
End If
Line (herolaser(a).x, herolaser(a).y)-(herolaser(a).mem1, herolaser(a).mem2), 7
If herolaser(a).mem1 > maxx Then
herolaser(a).health = FALSE ' restore array element
End If
End Select
herolaser(a).eras = TRUE ' set erase flag
End If
Next a
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³ chunks ³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
For a = 0 To maxchunks
If chunk(a).eras Then ' erase old location
PSet (chunk(a).oldx, chunk(a).oldy), 0
chunk(a).eras = FALSE
End If
If chunk(a).health Then ' dead chunk ?
chunk(a).oldx = chunk(a).x ' save old location
chunk(a).oldy = chunk(a).y
aliensinplay = aliensinplay + 1
If chunk(a).y > topy And chunk(a).y < boty Then ' bounds check
PSet (chunk(a).x, chunk(a).y), strobe ' draw chunks
chunk(a).thrust = chunk(a).thrust + 1
If chunk(a).thrust = 4 Then ' slow movement
chunk(a).x = chunk(a).x + chunk(a).vx
chunk(a).y = chunk(a).y + chunk(a).vy ' move chunk
chunk(a).eras = TRUE ' erase later
chunk(a).health = chunk(a).health - 1 ' shorten life
chunk(a).thrust = 0
End If
Else
chunk(a).health = FALSE ' open array element
End If
End If
Next a
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³ explosion 1 ³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
If exp1.set Then
If exp1.size > exp1.y - topy Then exp1.size = exp1.y - topy
If exp1.x < maxx Then
exp1.c1 = exp1.c1 + 1
If exp1.c1 < exp1.size Then
Circle (exp1.x, exp1.y), exp1.c1, exp1.colour
Paint (exp1.x, exp1.y), exp1.colour, exp1.colour
exp1.c2 = Abs(exp1.c1 - 2)
Circle (exp1.x, exp1.y), exp1.c2, 0
Paint (exp1.x, exp1.y), 0, 0
ElseIf exp1.c1 >= exp1.size Then
Circle (exp1.x, exp1.y), exp1.size, 13
Paint (exp1.x, exp1.y), 1, 13
Circle (exp1.x, exp1.y), exp1.size, 0
Paint (exp1.x, exp1.y), 0, 0
createchunks exp1.x, exp1.y
createchunks exp1.x, exp1.y
exp1.c1 = 0
exp1.set = 0
End If
End If
End If
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³ hero ³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
If hero.eras Then
Line (hero.oldx, hero.oldy)-(hero.oldx + hero.w, hero.oldy + hero.h), 0, BF
hero.eras = FALSE
End If
PSet (hero.oldrx, hero.oldry), 0
If hero.health > 0 Then
hero.oldrx = hero.rx: hero.oldry = hero.ry ' radar
hero.rx = (hero.x / radarsx) + radarx
hero.ry = hero.y / radarsy + radary
If hero.rx > (radarwrapx + radarx) Then col(a).rx = col(a).rx - radarw
PSet (hero.rx, hero.ry), 7
'traitshero ' controled user input
processgpi
If hero.dir Then ' facing left
If hero.x <= thrdx Then ' fall back ?
hero.x = hero.x + speed ' fall to left
hero.thrust = hero.thrust - speed
End If
Put (hero.x, hero.y), heroimage(0, 1), PSet
Line (hero.x + hero.w - 3, hero.y)-(hero.x + hero.w, hero.y + 3), strobe
Else ' facing right
If hero.x >= qtrx Then ' fall back ?
hero.x = hero.x - speed ' fall to left
hero.thrust = hero.thrust + speed
End If
Put (hero.x, hero.y), heroimage(0, 0), PSet
Line (hero.x + 3, hero.y)-(hero.x, hero.y + 3), strobe
End If
End If
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³ alien shots ³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
If alienshot.eras Then ' erase old location
Line (alienshot.x, alienshot.y)-(alienshot.x + alienshot.w, alienshot.y + alienshot.h), 0, B
alienshot.eras = FALSE
End If
If alienshot.health Then
traitsalienshot
alienshot.oldx = alienshot.x ' save old location
alienshot.oldy = alienshot.y
Line (alienshot.x, alienshot.y)-(alienshot.x + alienshot.w, alienshot.y + alienshot.h), 14, B
alienshot.eras = TRUE
End If
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³ alien bombs ³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
If bomb.eras Then ' erase old location
Line (bomb.x, bomb.y)-(bomb.x + bomb.w, bomb.y + bomb.h), 0, BF
bomb.eras = FALSE
End If
If bomb.health Then
If (bomb.x > minx) And (bomb.x < maxx) And (bomb.y > topy) And (bomb.y < boty) Then
bomb.x = bomb.x - hero.thrust
If bomb.dir = 1 Then
bomb.cy = bomb.cy + 1
If bomb.cy = bomb.vy Then
bomb.y = bomb.y - speed
bomb.x = bomb.x - speed - bomb.vx
bomb.cy = 0
End If
ElseIf bomb.dir = 0 Then
bomb.cy = bomb.cy + 1
If bomb.cy = bomb.vy Then
bomb.y = bomb.y + speed
bomb.x = bomb.x + speed + bomb.vx
bomb.cy = 0
End If
End If
bomb.oldx = bomb.x ' save old location
bomb.oldy = bomb.y
colour = strobe
Line (bomb.x, bomb.y)-(bomb.x + bomb.w, bomb.y + bomb.h), colour, BF
bomb.health = bomb.health - 1 ' shorten life
bomb.eras = TRUE
Else
bomb.health = 0
End If
End If
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
'³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³ colonists ³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³³
For a = 0 To maxcolonists
PSet (col(a).oldrx, col(a).oldry), 0
If Not ((col(a).x < -10) Or (col(a).x > maxx)) Then ' Colonist on screen
If col(a).eras Then
Line (col(a).oldx, col(a).y)-(col(a).oldx + col(a).w, col(a).y + col(a).h), 0, BF
End If
End If
col(a).eras = FALSE
If col(a).health Then ' sprite is alive
traitscolonist a
col(a).rx = (col(a).x / radarsx) + radarx ' radar location
col(a).ry = col(a).y / radarsy + radary
If col(a).rx > (radarwrapx + radarx) Then col(a).rx = col(a).rx - radarw
col(a).oldrx = col(a).rx ' save old spot
col(a).oldry = col(a).ry
col(a).oldx = col(a).x ' save old spot
col(a).oldy = col(a).y
col(a).eras = TRUE ' erase it later
If Not ((col(a).x < -10) Or (col(a).x > maxx)) Then ' Colonist on screen
Line (col(a).x, col(a).y)-(col(a).x + col(a).w, col(a).y + col(a).h), 14, BF
'col(a).px = POINT(0)
'col(a).py = POINT(1)
'p3x5numfnt col(a).px - col(a).w, col(a).py - col(a).h, a, 4
End If
PSet (col(a).rx, col(a).ry), 14
End If
Next a
End Sub ' movesprites
' /////////////////////////////////////////////////////////////////////////////
' fonts
' Print num at location (x,y) in attribute colour.
Sub p3x5numfnt (x, y, num, colour)
Static a3x5numfnt()
If x = -999 Then
Dim a3x5numfnt(9, 2, 4)
Def Seg = VarSeg(a3x5numfnt(0, 0, 0)) ' load in image file
BLoad "NUM3X5.FNT", 0
Def Seg
End If
text$ = LTrim$(Str$(num))
length = Len(text$) - 1
For ptr = 0 To length
n = Asc(Mid$(text$, ptr + 1, 1)) - 48
For h = 0 To 4
For w = 0 To 2
If a3x5numfnt(n, w, h) = 1 Then PSet (w + x + kernx, y + h), colour
Next w
Next h
kernx = kernx + 4
Next ptr
End Sub ' p3x5numfnt
' /////////////////////////////////////////////////////////////////////////////
' x and y set screen location to start printing contents of text$.
' Text$ can contain any valid ascii character between 0 and 127.
' colour is the color you would like
Sub p5x7ascfnt (x, y, text$, colour)
Static a5x7ascfnt()
If x = -999 Then
Dim a5x7ascfnt(127, 4, 6)
Def Seg = VarSeg(a5x7ascfnt(0, 0, 0)) ' load in image file
BLoad "ASCII5X7.FNT", 0
Def Seg
End If
l = Len(text$) ' How many times to loop?
If l = 0 Then Exit Sub ' Nothing to do.
For ptr = 0 To l - 1 ' -1 is for Mid$ unability to deal with a zero
piece$ = Mid$(text$, ptr + 1, 1) ' look at each piece of string
n = Asc(piece$) ' assign it's ascii value
Select Case (piece$) ' adjust lower case letter down where nessesary
' looks nice
Case "g"
kerny = kerny + 2
Case "j"
kerny = kerny + 2
Case "p"
kerny = kerny + 2
Case "q"
kerny = kerny + 2
Case "y"
kerny = kerny + 2
End Select
' write the character
For h = 0 To 6
For w = 0 To 4
If a5x7ascfnt(n, w, h) = 1 Then
PSet (x + w + kernx, y + h + kerny), colour
End If
Next
Next h
Select Case (piece$) ' Kern adjusment
' adjust x value for even spacing
Case "i"
kernx = kernx + 2
Case "j"
kernx = kernx + 5
Case "l"
kernx = kernx + 2
Case "r"
kernx = kernx + 5
Case "."
kernx = kernx + 3
Case "("
kernx = kernx + 3
Case ")"
kernx = kernx + 3
Case "'"
kernx = kernx + 2
Case "!"
kernx = kernx + 2
Case Else
kernx = kernx + 6
End Select
kerny = 0
Next ptr
End Sub ' p5x7ascfnt
' /////////////////////////////////////////////////////////////////////////////
Sub GameRules
Cls
Color cYellow: Print "DEFENDER"
Print
Color cLtGray%
Print "Blast Alien Ships"
Print "Blast landers carrying humanoids"
Print "before they mutate. Catch falling"
Print "Humanoids - 500 points; Return"
Print "them to surface - 500 points."
Print "Bonus for surviving humanoids"
Print "after each alien wave."
Print "Hyperspace - Warp To Another"
Print "Quadrant - Caution"
Print "Smart Bomb - Destroys Enemies"
Print "On Screen"
Print "Bonus Ship and Smart Bomb"
Print "every 10,000 Points"
Print
Color cYellow%: Print "Press any key to continue."
Do: Loop While InKey$ = ""
End Sub ' GameRules
' /////////////////////////////////////////////////////////////////////////////
Sub GameControls
Cls
Color cYellow: Print "DEFENDER"
Print
Color cWhite%: Print "Controls:"
Color cLtGray%: Print "Up..................";: Color cCyan%: Print KeyDescription$(INPUT_UP%)
Color cLtGray%: Print "Down................";: Color cCyan%: Print KeyDescription$(INPUT_DOWN%)
Color cLtGray%: Print "Thrust..............";: Color cCyan%: Print KeyDescription$(INPUT_THRUST%)
Color cLtGray%: Print "Reverse Direction...";: Color cCyan%: Print KeyDescription$(INPUT_REVERSE%)
Color cLtGray%: Print "Fire................";: Color cCyan%: Print KeyDescription$(INPUT_FIRE%)
Color cLtGray%: Print "Smart Bomb..........";: Color cCyan%: Print KeyDescription$(INPUT_SMARTBOMB%)
Color cLtGray%: Print "Hyperspace..........";: Color cCyan%: Print KeyDescription$(INPUT_HYPERSPACE%)
Color cLtGray%: Print "Invisio.............";: Color cCyan%: Print KeyDescription$(INPUT_INVISIO%)
'Print
Color cWhite%: Print "Alternate Controls:"
Color cLtGray%: Print "Up..................";: Color cCyan%: Print KeyDescription$(INPUT_MOVE_UP%)
Color cLtGray%: Print "Down................";: Color cCyan%: Print KeyDescription$(INPUT_MOVE_DOWN%)
Color cLtGray%: Print "Left................";: Color cCyan%: Print KeyDescription$(INPUT_MOVE_LEFT%)
Color cLtGray%: Print "Right...............";: Color cCyan%: Print KeyDescription$(INPUT_MOVE_RIGHT%)
'Print
Color cWhite%: Print "Special Keys:"
Color cLtGray%: Print "Quit Current Game...";: Color cCyan%: Print KeyDescription$(INPUT_MOVE_DOWN%) + " or " + KeyDescription$(INPUT_DOWN%)
Color cLtGray%: Print "Slow Down Game......";: Color cCyan%: Print KeyDescription$(INPUT_MOVE_DOWN%) + " or " + KeyDescription$(INPUT_DOWN%)
Color cLtGray%: Print "Speed Up game.......";: Color cCyan%: Print KeyDescription$(INPUT_MOVE_DOWN%) + " or " + KeyDescription$(INPUT_DOWN%)
'Print
Color cWhite%: Print "Cheat Keys:"
Color cLtGray%: Print "Skip to next level..";: Color cCyan%: Print KeyDescription$(INPUT_MOVE_DOWN%) + " or " + KeyDescription$(INPUT_DOWN%)
'Print
Color cYellow%: Print "Press any key to continue."
Do: Loop While InKey$ = ""
End Sub ' GameControls
' /////////////////////////////////////////////////////////////////////////////
Sub RemapControls
Print "UNDER CONSTRUCTION"
Print "Press any key to continue"
Sleep
_KeyClear: '_Delay 1 ' CLEAR KEYBOARD BUFFER
End Sub ' RemapControls
' /////////////////////////////////////////////////////////////////////////////
' process game play input
' NEW VERSION USES QB64 KEYBOARD INPUT
Sub processgpi
' GET INPUT
While _DeviceInput(1): Wend ' clear and update the keyboard buffer
' QUIT?
If _Button(INPUT_QUIT%) Then
'End
bIsPlaying% = FALSE
Exit Sub
End If
' UP/DOWN
If _Button(INPUT_UP%) Or _Button(INPUT_MOVE_UP%) Then
hero.y = hero.y - speed - keyspeed
ElseIf _Button(INPUT_DOWN%) Or _Button(INPUT_MOVE_DOWN%) Then
hero.y = hero.y + speed + keyspeed
hero.cy = 0
End If
' THRUST
If _Button(INPUT_THRUST%) Then
'If hero.dir Then ' facing left
If hero.dir = 1 Then ' facing left
hero.thrust = -speed - keyspeed
Else ' facing right
hero.thrust = speed + keyspeed
End If
End If
' DIRECTIONAL THRUST:
If _Button(INPUT_MOVE_LEFT%) Then
' ARE WE ALREADY FACING LEFT?
If hero.dir = 1 Then
' THRUST
hero.thrust = -speed - keyspeed
Else
' REVERSE
hero.dir = 1
End If
' ALWAYS REDRAW
bRedraw% = TRUE
ElseIf _Button(INPUT_MOVE_RIGHT%) Then
' ARE WE ALREADY FACING RIGHT?
If hero.dir = 0 Then
' THRUST
hero.thrust = speed + keyspeed
Else
' REVERSE
hero.dir = 0
End If
' ALWAYS REDRAW
bRedraw% = TRUE
End If
' REVERSE
If _Button(INPUT_REVERSE%) Then
If bReverse% = FALSE Then
If hero.dir = 1 Then ' facing left
hero.dir = 0
Else ' facing right
hero.dir = 1
End If
bReverse% = TRUE
Else
bReverse% = FALSE
End If
End If
' FIRE
If _Button(INPUT_FIRE%) Then
If bFire% = FALSE Then
createherolaser
bFire% = TRUE
End If
Else
bFire% = FALSE
End If
If _Button(INPUT_SMARTBOMB%) Then
If bSmartBomb% = FALSE% Then
' (TBD)
bSmartBomb% = TRUE
End If
Else
bSmartBomb% = FALSE
End If
' SLOW DOWN GAME
' + , =
'If _Button(INPUT_SKIP_LEVEL%) Then
' delay = delay - 100
' If delay < 0 Then
' delay = 0
' speed = speed + 1
' If speed > 6 Then speed = 6
' End If
'End If
' SPEED UP GAME
' - , _
'If _Button(INPUT_SKIP_LEVEL%) Then
' speed = speed - 1
' If speed < 1 Then speed = 1
' delay = delay + 100
'End If
' CHEAT KEY: SKIP TO NEXT LEVEL
' Function key 1
'If _Button(INPUT_SKIP_LEVEL%) Then
' level = level + 1
'End If
' CHECK VALUES
If hero.y < topy Then
hero.y = topy
End If
If hero.y > maxy - col(0).h - hero.h - 2 Then
hero.y = maxy - col(0).h - hero.h - 2
End If
If hero.x < 0 Then
hero.x = minx
End If
If hero.x > (maxx - hero.vx - hero.w) Then
hero.x = maxx - hero.w - 1
End If
End Sub ' processgpi
' /////////////////////////////////////////////////////////////////////////////
' setscreen and scales relavent varables
Sub setfxmode
Screen 13
minx = 0 ' actual physical coordinates of screen mode
miny = 0
'maxx = 649
'maxy = 199
maxx = 319
maxy = 199
qtrx = maxx / 4
thrdx = qtrx * 3
topy = miny + (maxy / 7) ' + 28 ' top and bottom physical boundrys
boty = maxy - 5
fieldw = maxx * 4 ' virtual play field
fieldh = maxy
radarsx = 16 ' radar scale down
radarsy = 8
radarw = fieldw / radarsx ' physical radar size
radarh = fieldh / radarsy
radarx = (maxx / 2) - 10 ' physical radar location
radary = 1
radarwrapx = (radarw / 2) + (radarw / 9) ' for radar wrap
radar2thrd = radar1thrd * 2
End Sub ' setfxmode
' /////////////////////////////////////////////////////////////////////////////
Sub starfield
Shared maxx, maxy
Static first, oldstarx() As Integer, oldstary() As Integer
Static starx() As Integer, stary() As Integer, starspeed() As Integer
Static starvx() As Integer, ns
If ns = 0 Then ' First time here initialize values
ns = 25 ' Number of stars
Dim oldstarx(ns) As Integer
Dim oldstary(ns) As Integer
Dim starx(ns) As Integer
Dim stary(ns) As Integer
Dim starspeed(ns) As Integer
Dim starvx(ns) As Integer
For c = 0 To ns
stary(c) = RandomNum(maxy - (25 + 35)) + 35
starx(c) = RandomNum(maxx)
starspeed(c) = 1 'RandomNum(2) + 1
Next c
End If
For c = 0 To ns ' erase old points
PSet (starx(c), stary(c)), 0
Next c
' ** use a delay here if you dont use page switching **
'FOR x! = 0 TO 1000: NEXT
'IF hero.thrust THEN LOCATE 1, 1: PRINT hero.dir; hero.thrust
If (hero.dir = 1) And hero.thrust Then
For c = 0 To ns
oldstary(c) = stary(c) ' save position to erase oldstar
oldstarx(c) = starx(c)
If oldstary(c) = 0 Then
stary(c) = RandomNum(maxy - (topy + 35)) + 35
starspeed(c) = 1 'RandomNum(2) + 1
oldstary(c) = stary(c)
End If
'starvx(c) = ((starvx(c) + 1) MOD 4)
'IF starvx(c) = 3 THEN starx(c) = starx(c) + starspeed(c)
starx(c) = starx(c) - hero.thrust
If starx(c) > maxx Then
stary(c) = 0
starx(c) = 0
End If
Next c
End If
If hero.dir = 0 And hero.thrust Then
For c = 0 To ns
oldstary(c) = stary(c) ' save position to erase oldstar
oldstarx(c) = starx(c)
If oldstary(c) = maxy Then
stary(c) = RandomNum(maxy - (topy + 35)) + 35
starspeed(c) = 1 ' RandomNum(2) + 1
oldstary(c) = stary(c)
End If
'starvx(c) = ((starvx(c) + 1) MOD 4)
'IF starvx(c) = 3 THEN starx(c) = starx(c) - starspeed(c)
starx(c) = starx(c) - hero.thrust
If starx(c) < 1 Then
stary(c) = maxy
starx(c) = maxx
End If
Next c
End If
For c = 0 To ns
PSet (starx(c), stary(c)), 7
Next c
End Sub ' starfield
' /////////////////////////////////////////////////////////////////////////////
' returns next color
' returns color
Function strobe
Static colour
colour = (colour + 1) Mod 16
strobe = colour
End Function ' strobe
' /////////////////////////////////////////////////////////////////////////////
' check for passage of time
Function timepassed (n, tsecs!)
Static getclock(), oldtsecs!(), time1!()
If tsecs! = 0 Then
Dim getclock(n)
Dim oldtsecs!(n)
Dim time1!(n)
End If
If tsecs! <> oldtsecs!(n) Then getclock(n) = 0 ' reset
If getclock(n) = 0 Then
time1!(n) = Timer
getclock(n) = 1
oldtsecs!(n) = tsecs!
Else
If Abs(Timer - time1!(n)) >= tsecs! Then
timepassed = 1
getclock(n) = 0
Else
timepassed = 0
End If
End If
End Function ' timepassed
' /////////////////////////////////////////////////////////////////////////////
Sub traitsalienshot
'IF (alienshot.x > minx) AND (alienshot.x < maxx) AND (alienshot.y > topy) AND (alienshot.y < boty) THEN
' alienshot.x = alienshot.x - hero.thrust
' IF alienshot.dir = 1 THEN
' alienshot.cx = alienshot.cx + 1
' IF alienshot.cx = alienshot.vx THEN
' alienshot.x = alienshot.x - speed
' alienshot.cx = 0
' END IF
' ELSEIF alienshot.dir = 0 THEN
' alienshot.cx = alienshot.cx + 1
' IF alienshot.cx = alienshot.vx THEN
' alienshot.x = alienshot.x + speed
' alienshot.cx = 0
' END IF
' END IF
' alienshot.y = alienshot.y + alienshot.vy
If hero.thrust Then alienshot.x = alienshot.x - hero.thrust
If alienshot.dirx = 0 Then
alienshot.cx = alienshot.cx + 1
If alienshot.cx > alienshot.vx Then
alienshot.x = alienshot.x - speed
alienshot.cx = 0
End If
End If
If alienshot.dirx = 1 Then
alienshot.cx = alienshot.cx + 1
If alienshot.cx > alienshot.vx Then
alienshot.x = alienshot.x + speed
alienshot.cx = 0
End If
End If
If alienshot.diry = 0 Then
alienshot.cy = alienshot.cy + 1
If alienshot.cy > alienshot.vy Then
alienshot.y = alienshot.y - speed
alienshot.cy = 0
End If
End If
If alienshot.diry = 1 Then
alienshot.cy = alienshot.cy + 1
If alienshot.cy > alienshot.vy Then
alienshot.y = alienshot.y + speed
alienshot.cy = 0
End If
End If
If alienshot.x > maxx Or alienshot.x < minx Then alienshot.health = 0
If alienshot.x > fieldw Then alienshot.x = 0 ' bounds check
If alienshot.x < 0 Then alienshot.x = fieldw
If alienshot.y < topy + alienshot.h Then
alienshot.health = 0
'PRINT "ahloha"
End If
If alienshot.y > boty - alienshot.h Then
alienshot.health = 0
End If
End Sub ' traitsalienshot
' /////////////////////////////////////////////////////////////////////////////
Sub traitsblocker
If hero.thrust Then blocker.x = blocker.x - hero.thrust
blocker.cy = blocker.cy + 1
If blocker.cy = blocker.vy Then
If blocker.dir Then
blocker.y = blocker.y + speed
Else
blocker.y = blocker.y - speed
End If
blocker.cy = 0
End If
If blocker.x > fieldw Then blocker.x = 0 ' bounds check
If blocker.x < 0 Then blocker.x = fieldw
If blocker.y > boty - blocker.h Then ' bounds check
'IF blocker.mode = 0 THEN
' blocker.y = topy
'ELSEIF blocker.mode = 1 THEN
blocker.dir = 0
'END IF
End If
If blocker.y < topy + blocker.vy Then
'IF blocker.mode = 0 THEN
' blocker.y = boty - blocker.h
'ELSEIF blocker.mode = 1 THEN
blocker.dir = 1
'END IF
End If
End Sub ' traitsblocker
' /////////////////////////////////////////////////////////////////////////////
Sub traitsbomer (a)
If hero.thrust Then bomer(a).x = bomer(a).x - hero.thrust
If (bomer(a).x > minx) And (bomer(a).x < maxx - bomer(a).w) Then ' Shoot at hero.
createbomb bomer(a).px, bomer(a).py
End If
bomer(a).cx = bomer(a).cx + 1
If bomer(0).vx < bomer(a).cx Then
If bomer(a).dir Then
bomer(a).x = bomer(a).x + speed
Else
bomer(a).x = bomer(a).x - speed
End If
bomer(a).cx = 0
End If
bomer(a).cy = bomer(a).cy + 1
If bomer(0).vy < bomer(a).cy Then
If bomer(a).dir Then
bomer(a).y = bomer(a).y + speed
Else
bomer(a).y = bomer(a).y - speed
End If
bomer(a).cy = 0
End If
If bomer(a).x > fieldw Then bomer(a).x = 0 ' bounds check
If bomer(a).x < 0 Then bomer(a).x = fieldw
If bomer(a).y > boty - bomer(a).h Then bomer(a).y = topy + bomer(a).h ' bounds check
If bomer(a).y < topy + bomer(a).h Then bomer(a).y = boty - bomer(a).h
End Sub ' traitsbomer
' /////////////////////////////////////////////////////////////////////////////
Sub traitschaser (a)
If hero.thrust Then chaser.x = chaser.x - hero.thrust
' match hero.y when on screen
If chaser.x > minx And chaser.x < maxx Then
If chaser.y < hero.y Then
chaser.cy = chaser.cy + 1
If chaser.vy = chaser.cy Then
chaser.y = chaser.y + speed
chaser.cy = 0
End If
End If
If chaser.y > hero.y Then
chaser.cy = chaser.cy + 1
If chaser.vy = chaser.cy Then
chaser.y = chaser.y - speed
chaser.cy = 0
End If
End If
chaser.mem1 = 1
End If
' find hero.x after being found
If chaser.mem1 = 1 Then
If chaser.x < minx Or chaser.px > maxx Then speedier = 1 Else speedier = 0
chaser.cx = chaser.cx + 1
If chaser.x > hero.x Then
If chaser.vx <= chaser.cx Then
chaser.x = chaser.x - speed - speedier
chaser.cx = 0
End If
ElseIf chaser.x < hero.x Then
If chaser.vx <= chaser.cx Then
chaser.x = chaser.x + speed + speedier
chaser.cx = 0
End If
End If
End If
If chaser.x > fieldw Then chaser.x = 0 ' bounds check
If chaser.x < 0 Then chaser.x = fieldw
If chaser.y < topy Then chaser.y = topy
If chaser.y > boty - chaser.h Then chaser.y = boty - chaser.h
End Sub ' traitschaser
' /////////////////////////////////////////////////////////////////////////////
Sub traitscolonist (a)
'IF hero.thrust THEN ' move according to hero
col(a).x = col(a).x - hero.thrust
If col(a).x > fieldw Then col(a).x = 0
If col(a).x < 0 Then col(a).x = fieldw
col(a).eras = TRUE
'END IF
If col(a).mode = 1 Then ' grabber has colonist
If (grabber(col(a).mem1).health > 0) Then
col(a).cx = col(a).cx + 1
If col(a).cx >= grabber(0).vy Then
col(a).y = col(a).y - speed
col(a).cx = 0
End If
col(a).mem2 = col(a).y ' in case grabber gets shot
Else ' grabber was shot
col(a).cx = ((col(a).cx + 1) Mod 8)
If col(a).vy >= col(a).cx Then ' slow down the drop
col(a).y = col(a).y + speed
If col(a).y > maxy - 6 Then
grabber(col(a).mem1).mode = 0 ' reset variables
col(a).mem1 = 0
col(a).mode = 0
col(a).dir = 0
pickup = 0
b = timepassed(11, 1) ' reset timer 11
If col(a).mem2 < maxy - 75 Then
createchunks col(a).x, col(a).y - 10
col(a).health = 0
End If
End If
End If
End If
ElseIf col(a).mode = 2 Then ' hero got em
col(a).x = hero.x: col(a).y = hero.y
col(a).dir = 1
col(a).mem2 = col(a).y
If timepassed(11, 3) Then col(a).mode = 1
If hero.y > boty - 10 Then col(a).mode = 1
End If
End Sub ' traitscolonist
' /////////////////////////////////////////////////////////////////////////////
' Grabber personality defined here.
' inteligence for aliens
Sub traitsgrabber (a)
Shared pickup
Static ctr1, ctr2, ctr3
'IF hero.thrust THEN
grabber(a).x = grabber(a).x - hero.thrust
If (grabber(a).x > minx) And (grabber(a).x < maxx) Then ' Shoot at hero.
createalienshot grabber(a).px, grabber(a).py
End If
Select Case grabber(a).mode
Case 0 ' looking for colonist
grabber(a).cx = grabber(a).cx + 1
If grabber(0).vx <= grabber(a).cx Then
If grabber(a).dirx = 0 Then
grabber(a).x = grabber(a).x + speed
ElseIf grabber(a).dirx = 1 Then
grabber(a).x = grabber(a).x - speed
End If
'ctr1 = ctr1 + 1
grabber(a).cx = 0
End If
If level < 5 Then
If ctr1 > 200 Then grabber(a).diry = 1
If ctr1 > 310 Then grabber(a).diry = 3
If ctr1 > 400 Then grabber(a).diry = 0
If ctr1 > 490 Then ctr1 = 0
If ctr1 > 200 And ctr1 < 490 Then
grabber(a).cy = grabber(a).cy + 1
If grabber(0).vy = grabber(a).cy Then
If grabber(a).diry = 0 Then
grabber(a).y = grabber(a).y + speed
ElseIf grabber(a).diry = 1 Then
grabber(a).y = grabber(a).y - speed
End If
grabber(a).cy = 0
End If
End If
Else
' (DO NOTHING)
End If
If pickup = 0 Then
' COLOR strobe
' LOCATE 1, 1: PRINT "looking"
For b = 0 To maxcolonists ' pick up only when visible
' IF (col(b).x > 0) AND (col(b).x < maxx) AND col(b).health THEN
If col(b).health Then
If grabber(a).x = col(b).x Then ' got that sucker
If RandomNum(2) = 0 Then ' pick at random
grabber(a).mode = 1 ' pick up mode
grabber(a).mem1 = b ' remember the colonist
col(b).mem1 = a ' remember the grabber
pickup = 1
End If
End If
End If
' END IF
Next b
End If
Case 1 ' desend over victom ;)
'COLOR strobe
'LOCATE 1, 10: PRINT "desending"
grabber(a).cy = grabber(a).cy + 1
If grabber(a).cy = grabber(0).vy Then
grabber(a).y = grabber(a).y + speed
grabber(a).cy = 0
End If
If grabber(a).y > maxy - grabber(a).h - 5 Then
grabber(a).y = maxy - grabber(a).h - 5
grabber(a).mode = 2
PlaySound cCallForHelpSound
End If
Case 2 ' pick up victom
'COLOR strobe
'LOCATE 1, 20: PRINT "Picking up"
grabber(a).cy = grabber(a).cy + 1
If grabber(a).cy = grabber(0).vy Then
grabber(a).y = grabber(a).y - speed
col(grabber(a).mem1).mode = 1
grabber(a).cy = 0
End If
If grabber(a).y < topy Then ' did grabber reach top ?
grabber(a).y = topy
grabber(a).mode = 3
End If
' convert to mental grabber
Case 3
'COLOR strobe
'LOCATE 1, 31: PRINT "Mental "
col(grabber(a).mem1).health = 0
col(grabber(a).mem1).mode = 0
grabber(a).mode = 0
grabber(a).mem1 = 0
grabber(a).health = 0
pickup = 0
PlaySound cMutantConvertedSound
createmutant grabber(a).x, grabber(a).y
End Select
If grabber(a).y > boty - grabber(a).h Then grabber(a).y = topy ' bounds check
If grabber(a).y < topy Then grabber(a).y = boty - grabber(a).h
If grabber(a).x > fieldw Then grabber(a).x = 0 ' bounds check
If grabber(a).x < 0 Then grabber(a).x = fieldw
End Sub ' traitsgrabber
' /////////////////////////////////////////////////////////////////////////////
' OLD GAMEPAD CODE:
' hero controled by user input
'
'Sub traitshero
' hero.oldy = hero.y
' hero.oldx = hero.x
' hero.eras = TRUE
' degrees = joystick
' hero.thrust = FALSE
'
' 'IF hero.x <= thrdx THEN' fall back ?
' ' hero.x = hero.x + speed ' fall to left
' ' hero.thrust = hero.thrust - speed
' ' degrees = 270
' 'END IF
' 'IF hero.x >= qtrx THEN ' fall back ?
' ' hero.x = hero.x - speed ' fall to left
' ' hero.thrust = hero.thrust + speed
' ' degrees = 90
' 'END IF
'
' Select Case (degrees)
' Case 1 ' north
' hero.cy = hero.cy + 1
' If hero.cy >= hero.vy Then
' hero.y = hero.y - speed
' hero.cy = 0
' End If
' Case 45 ' north east
' 'hero.y = hero.y - hero.vy
' hero.cy = hero.cy + 1
' If hero.cy >= hero.vy Then
' hero.y = hero.y - speed
' hero.cy = 0
' End If
'
' hero.thrust = speed
' hero.dir = 0
' Case 90 ' east
' hero.thrust = speed
' hero.dir = 0
' Case 135 ' south east
' hero.cy = hero.cy + 1
' If hero.cy >= hero.vy Then
' hero.y = hero.y + speed
' hero.cy = 0
' End If
' hero.thrust = speed
' hero.dir = 0
' Case 180 ' south
' 'hero.y = hero.y + hero.vy
' hero.cy = hero.cy + 1
' If hero.cy >= hero.vy Then
' hero.y = hero.y + speed
' hero.cy = 0
' End If
' Case 225 ' south west
' hero.cy = hero.cy + 1
' If hero.cy >= hero.vy Then
' hero.y = hero.y + speed
' hero.cy = 0
' End If
' hero.thrust = -speed
' hero.dir = 1
' Case 270 ' west
' hero.thrust = -speed
' hero.dir = 1
' Case 315 ' north west
' 'hero.y = hero.y - hero.vy
' hero.cy = hero.cy + 1
' If hero.cy >= hero.vy Then
' hero.y = hero.y - speed
' hero.cy = 0
' End If
' hero.thrust = -speed
' hero.dir = 1
' End Select
'
' ' joystick buttons
' Select Case (joybutt)
' Case (1)
' createherolaser
' Case (2)
' createherolaser
' End Select
'
' If hero.y < topy Then hero.y = topy
' If hero.y > maxy - col(0).h - hero.h - 2 Then hero.y = maxy - col(0).h - hero.h - 2
'
' If hero.x < 0 Then hero.x = minx
' If hero.x > (maxx - hero.vx - hero.w) Then hero.x = maxx - hero.w - 1
'End Sub ' traitshero
'
' /////////////////////////////////////////////////////////////////////////////
' mutant is aggresive and pissed off
Sub traitsmutant (a)
If hero.thrust Then mutant(a).x = mutant(a).x - hero.thrust
If mutant(a).x > minx And mutant(a).x < maxx Then ' mutant on screen
'createalienbolt mutant(a).x, mutant(a).y
'createalienshot mutant(a).px, mutant(a).py
End If
mutant(a).cx = (mutant(a).cx + 1) Mod (mutant(0).vx + 1)
If mutant(0).vx = mutant(a).cx Then
If mutant(a).px > hero.x Then mutant(a).x = mutant(a).x - RandomNum(speed + 1)
If mutant(a).px < hero.x Then mutant(a).x = mutant(a).x + RandomNum(speed + 1)
End If
mutant(a).cy = (mutant(a).cy + 1) Mod (mutant(0).vy + 1)
If mutant(0).vy = mutant(a).cy Then
If mutant(a).y > hero.y Then mutant(a).y = mutant(a).y - RandomNum(speed + 1)
If mutant(a).y < hero.y Then mutant(a).y = mutant(a).y + RandomNum(speed + 1)
End If
If RandomNum(2) Then
mutant(a).y = mutant(a).y + RandomNum(speed + 1)
Else
mutant(a).y = mutant(a).y - RandomNum(speed + 1)
End If
If RandomNum(2) Then
mutant(a).x = mutant(a).x + RandomNum(speed + 1)
Else
mutant(a).x = mutant(a).x - RandomNum(speed + 1)
End If
If mutant(a).x > fieldw Then mutant(a).x = 0 ' bounds check
If mutant(a).x < 0 Then mutant(a).x = fieldw
If mutant(a).y < topy Then mutant(a).y = topy
If mutant(a).y > boty - mutant(a).h Then mutant(a).y = boty - mutant(a).h
End Sub ' traitsmutant
' /////////////////////////////////////////////////////////////////////////////
Sub traitsspinette
If hero.thrust Then spinette.x = spinette.x - hero.thrust
If spinette.dirx = 0 Then
spinette.cx = spinette.cx + 1
If spinette.cx > spinette.vx Then
spinette.x = spinette.x - speed
spinette.cx = 0
End If
End If
If spinette.dirx = 1 Then
spinette.cx = spinette.cx + 1
If spinette.cx > spinette.vx Then
spinette.x = spinette.x + speed
spinette.cx = 0
End If
End If
If spinette.diry = 0 Then
spinette.cy = spinette.cy + 1
If spinette.cy > spinette.vy Then
spinette.y = spinette.y - speed
spinette.cy = 0
End If
End If
If spinette.diry = 1 Then
spinette.cy = spinette.cy + 1
If spinette.cy > spinette.vy Then
spinette.y = spinette.y + speed
spinette.cy = 0
End If
End If
If spinette.x > maxx Or spinette.x < minx Then spinette.health = 0
If spinette.x > fieldw Then spinette.x = 0 ' bounds check
If spinette.x < 0 Then spinette.x = fieldw
If spinette.y < topy + spinette.h + spinette.h Then spinette.health = 0 'spinette.y = boty - spinette.h
If spinette.y > boty - spinette.h Then spinette.health = 0 'spinette.y = topy + spinette.h
End Sub ' traitsspinette
' /////////////////////////////////////////////////////////////////////////////
Sub traitsspinner (a)
Static c1
If hero.thrust Then spinner.x = spinner.x - hero.thrust
If (spinner.x > minx) And (spinner.x < maxx) Then ' Shoot at hero.
createspinette spinner.x, spinner.y
End If
spinner.cy = spinner.cy + 1
If spinner.dir = 0 Then
If spinner.cy >= spinner.vy Then
spinner.y = spinner.y + speed
spinner.cy = 0
c1 = (c1 + 1) Mod 20: If c1 = 0 Then spinner.dir = 1
End If
ElseIf spinner.dir = 1 Then
If spinner.cy >= spinner.vy Then
spinner.y = spinner.y - speed
spinner.cy = 0
c1 = (c1 + 1) Mod 20: If c1 = 0 Then spinner.dir = 0
End If
End If
If spinner.x > fieldw Then spinner.x = 0 ' bounds check
If spinner.x < 0 Then spinner.x = fieldw
If spinner.y < topy + spinner.h Then spinner.y = boty - spinner.h
If spinner.y > boty - spinner.h Then spinner.y = topy + spinner.h
End Sub ' traitsspinner
' /////////////////////////////////////////////////////////////////////////////
Sub traitstracker (a)
Locate 1, 1: Print tracker.x
If hero.thrust Then tracker.x = tracker.x - hero.thrust
If (tracker.x > minx) And (tracker.x < maxx) Then ' Shoot at hero.
'createalienshot tracker.x, tracker.y
End If
If tracker.x > hero.x + (tracker.mem1) Then
'tracker.x = tracker.x + 1
End If
If tracker.x < hero.x - (tracker.mem1) Then
'tracker.x = tracker.x - 1
End If
If tracker.x > fieldw Then tracker.x = 0 ' bounds check
If tracker.x < 0 Then tracker.x = fieldw
If tracker.y < topy + tracker.h Then tracker.y = boty - tracker.h
If tracker.y > boty - tracker.h Then tracker.y = topy + tracker.h
End Sub ' traitstracker
' ################################################################################################################################################################
' BEGIN GENERAL PURPOSE ROUTINES
' ################################################################################################################################################################
' /////////////////////////////////////////////////////////////////////////////
' IIF function for QB for integers
Function IIF (Condition, IfTrue, IfFALSE)
If Condition Then IIF = IfTrue Else IIF = IfFALSE
End Function
' /////////////////////////////////////////////////////////////////////////////
' IIF function for QB for strings
Function IIFSTR$ (Condition, IfTrue$, IfFALSE$)
If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFALSE$
End Function
' /////////////////////////////////////////////////////////////////////////////
' returns random number
Function RandomNum (num)
RandomNum = Int(Rnd * num)
End Function 'RandomNum
' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max.
Function RandomNumber% (Min%, Max%)
Dim NumSpread%
' SET RANDOM SEED
'Randomize ' Initialize random-number generator.
Randomize Timer
' GET RANDOM # Min%-Max%
'RandomNumber = Int((Max * Rnd) + Min) ' generate number
NumSpread% = (Max% - Min%) + 1
RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
End Function ' RandomNumber%
' /////////////////////////////////////////////////////////////////////////////
Function StrPadLeft$ (sValue As String, iWidth As Integer)
StrPadLeft$ = Right$(String$(iWidth, " ") + sValue, iWidth)
End Function ' StrPadLeft$
' /////////////////////////////////////////////////////////////////////////////
Function StrPadRight$ (sValue As String, iWidth As Integer)
StrPadRight$ = Left$(sValue + String$(iWidth, " "), iWidth)
End Function ' StrPadRight$
' ################################################################################################################################################################
' END GENERAL PURPOSE ROUTINES
' ################################################################################################################################################################
' ################################################################################################################################################################
' BEGIN KEYBOARD CODE FUNCTIONS
' NOTE: ALL CODES ARE FOR _BUTTON, EXCEPT:
' cF10 (_KEYDOWN)
' cAltLeft (_KEYHIT)
' cAltRight (_KEYHIT)
' cPrintScreen (_KEYHIT) <- may slow down pc?
' cPauseBreak (_KEYHIT) <- may not work?
' ################################################################################################################################################################
Function KeyCode_Escape% ()
KeyCode_Escape% = 2
End Function
Function KeyCode_F1% ()
KeyCode_F1% = 60
End Function
Function KeyCode_F2% ()
KeyCode_F2% = 61
End Function
Function KeyCode_F3% ()
KeyCode_F3% = 62
End Function
Function KeyCode_F4% ()
KeyCode_F4% = 63
End Function
Function KeyCode_F5% ()
KeyCode_F5% = 64
End Function
Function KeyCode_F6% ()
KeyCode_F6% = 65
End Function
Function KeyCode_F7% ()
KeyCode_F7% = 66
End Function
Function KeyCode_F8% ()
KeyCode_F8% = 67
End Function
Function KeyCode_F9% ()
KeyCode_F9% = 68
End Function
'_KEYDOWN CODE, NOT _BUTTON CODE
Function KeyCode_F10% ()
KeyCode_F10% = 17408
End Function
Function KeyCode_F11% ()
KeyCode_F11% = 88
End Function
Function KeyCode_F12% ()
KeyCode_F12% = 89
End Function
'_KEYHIT CODE, NOT _BUTTON CODE
Function KeyCode_PrintScreen% ()
KeyCode_PrintScreen% = -44
End Function
Function KeyCode_ScrollLock% ()
KeyCode_ScrollLock% = 71
End Function
'_KEYHIT CODE, NOT _BUTTON CODE
Function KeyCode_PauseBreak% ()
KeyCode_PauseBreak% = 31053
End Function
Function KeyCode_Tilde% ()
KeyCode_Tilde% = 42
End Function
Function KeyCode_1% ()
KeyCode_1% = 3
End Function
Function KeyCode_2% ()
KeyCode_2% = 4
End Function
Function KeyCode_3% ()
KeyCode_3% = 5
End Function
Function KeyCode_4% ()
KeyCode_4% = 6
End Function
Function KeyCode_5% ()
KeyCode_5% = 7
End Function
Function KeyCode_6% ()
KeyCode_6% = 8
End Function
Function KeyCode_7% ()
KeyCode_7% = 9
End Function
Function KeyCode_8% ()
KeyCode_8% = 10
End Function
Function KeyCode_9% ()
KeyCode_9% = 11
End Function
Function KeyCode_0% ()
KeyCode_0% = 12
End Function
Function KeyCode_Minus% ()
KeyCode_Minus% = 13
End Function
Function KeyCode_Equal% ()
KeyCode_Equal% = 14
End Function
Function KeyCode_BkSp% ()
KeyCode_BkSp% = 15
End Function
Function KeyCode_Ins% ()
KeyCode_Ins% = 339
End Function
Function KeyCode_Home% ()
KeyCode_Home% = 328
End Function
Function KeyCode_PgUp% ()
KeyCode_PgUp% = 330
End Function
Function KeyCode_Del% ()
KeyCode_Del% = 340
End Function
Function KeyCode_End% ()
KeyCode_End% = 336
End Function
Function KeyCode_PgDn% ()
KeyCode_PgDn% = 338
End Function
Function KeyCode_NumLock% ()
KeyCode_NumLock% = 326
End Function
Function KeyCode_KeypadSlash% ()
KeyCode_KeypadSlash% = 310
End Function
Function KeyCode_KeypadMultiply% ()
KeyCode_KeypadMultiply% = 56
End Function
Function KeyCode_KeypadMinus% ()
KeyCode_KeypadMinus% = 75
End Function
Function KeyCode_Keypad7Home% ()
KeyCode_Keypad7Home% = 72
End Function
Function KeyCode_Keypad8Up% ()
KeyCode_Keypad8Up% = 73
End Function
Function KeyCode_Keypad9PgUp% ()
KeyCode_Keypad9PgUp% = 74
End Function
Function KeyCode_KeypadPlus% ()
KeyCode_KeypadPlus% = 79
End Function
Function KeyCode_Keypad4Left% ()
KeyCode_Keypad4Left% = 76
End Function
Function KeyCode_Keypad5% ()
KeyCode_Keypad5% = 77
End Function
Function KeyCode_Keypad6Right% ()
KeyCode_Keypad6Right% = 78
End Function
Function KeyCode_Keypad1End% ()
KeyCode_Keypad1End% = 80
End Function
Function KeyCode_Keypad2Down% ()
KeyCode_Keypad2Down% = 81
End Function
Function KeyCode_Keypad3PgDn% ()
KeyCode_Keypad3PgDn% = 82
End Function
Function KeyCode_KeypadEnter% ()
KeyCode_KeypadEnter% = 285
End Function
Function KeyCode_Keypad0Ins% ()
KeyCode_Keypad0Ins% = 83
End Function
Function KeyCode_KeypadPeriodDel% ()
KeyCode_KeypadPeriodDel% = 84
End Function
Function KeyCode_Tab% ()
KeyCode_Tab% = 16
End Function
Function KeyCode_Q% ()
KeyCode_Q% = 17
End Function
Function KeyCode_W% ()
KeyCode_W% = 18
End Function
Function KeyCode_E% ()
KeyCode_E% = 19
End Function
Function KeyCode_R% ()
KeyCode_R% = 20
End Function
Function KeyCode_T% ()
KeyCode_T% = 21
End Function
Function KeyCode_Y% ()
KeyCode_Y% = 22
End Function
Function KeyCode_U% ()
KeyCode_U% = 23
End Function
Function KeyCode_I% ()
KeyCode_I% = 24
End Function
Function KeyCode_O% ()
KeyCode_O% = 25
End Function
Function KeyCode_P% ()
KeyCode_P% = 26
End Function
Function KeyCode_BracketLeft% ()
KeyCode_BracketLeft% = 27
End Function
Function KeyCode_BracketRight% ()
KeyCode_BracketRight% = 28
End Function
Function KeyCode_Backslash% ()
KeyCode_Backslash% = 44
End Function
Function KeyCode_CapsLock% ()
KeyCode_CapsLock% = 59
End Function
Function KeyCode_A% ()
KeyCode_A% = 31
End Function
Function KeyCode_S% ()
KeyCode_S% = 32
End Function
Function KeyCode_D% ()
KeyCode_D% = 33
End Function
Function KeyCode_F% ()
KeyCode_F% = 34
End Function
Function KeyCode_G% ()
KeyCode_G% = 35
End Function
Function KeyCode_H% ()
KeyCode_H% = 36
End Function
Function KeyCode_J% ()
KeyCode_J% = 37
End Function
Function KeyCode_K% ()
KeyCode_K% = 38
End Function
Function KeyCode_L% ()
KeyCode_L% = 39
End Function
Function KeyCode_Semicolon% ()
KeyCode_Semicolon% = 40
End Function
Function KeyCode_Apostrophe% ()
KeyCode_Apostrophe% = 41
End Function
Function KeyCode_Enter% ()
KeyCode_Enter% = 29
End Function
Function KeyCode_ShiftLeft% ()
KeyCode_ShiftLeft% = 43
End Function
Function KeyCode_Z% ()
KeyCode_Z% = 45
End Function
Function KeyCode_X% ()
KeyCode_X% = 46
End Function
Function KeyCode_C% ()
KeyCode_C% = 47
End Function
Function KeyCode_V% ()
KeyCode_V% = 48
End Function
Function KeyCode_B% ()
KeyCode_B% = 49
End Function
Function KeyCode_N% ()
KeyCode_N% = 50
End Function
Function KeyCode_M% ()
KeyCode_M% = 51
End Function
Function KeyCode_Comma% ()
KeyCode_Comma% = 52
End Function
Function KeyCode_Period% ()
KeyCode_Period% = 53
End Function
Function KeyCode_Slash% ()
KeyCode_Slash% = 54
End Function
Function KeyCode_ShiftRight% ()
KeyCode_ShiftRight% = 55
End Function
Function KeyCode_Up% ()
KeyCode_Up% = 329
End Function
Function KeyCode_Left% ()
KeyCode_Left% = 332
End Function
Function KeyCode_Down% ()
KeyCode_Down% = 337
End Function
Function KeyCode_Right% ()
KeyCode_Right% = 334
End Function
Function KeyCode_CtrlLeft% ()
KeyCode_CtrlLeft% = 30
End Function
Function KeyCode_WinLeft% ()
KeyCode_WinLeft% = 348
End Function
' _KEYHIT CODE NOT _BUTTON CODE
Function KeyCode_AltLeft% ()
KeyCode_AltLeft% = -30764
End Function
Function KeyCode_Spacebar% ()
KeyCode_Spacebar% = 58
End Function
' _KEYHIT CODE NOT _BUTTON CODE
Function KeyCode_AltRight% ()
KeyCode_AltRight% = -30765
End Function
Function KeyCode_WinRight% ()
KeyCode_WinRight% = 349
End Function
Function KeyCode_Menu% ()
KeyCode_Menu% = 350
End Function
Function KeyCode_CtrlRight% ()
KeyCode_CtrlRight% = 286
End Function
' /////////////////////////////////////////////////////////////////////////////
' Receives
' KeyCode% = the key code to get the description for
Function KeyDescription$ (KeyCode%)
Dim MyString As String
Select Case (KeyCode%)
Case KeyCode_Escape%:
MyString = "Escape"
Case KeyCode_F1%:
MyString = "F1"
Case KeyCode_F2%:
MyString = "F2"
Case KeyCode_F3%:
MyString = "F3"
Case KeyCode_F4%:
MyString = "F4"
Case KeyCode_F5%:
MyString = "F5"
Case KeyCode_F6%:
MyString = "F6"
Case KeyCode_F7%:
MyString = "F7"
Case KeyCode_F8%:
MyString = "F8"
Case KeyCode_F9%:
MyString = "F9"
Case KeyCode_F10%: ' 17408 = _KEYDOWN CODE, NOT _BUTTON CODE
MyString = "F10"
Case KeyCode_F11%:
MyString = "F11"
Case KeyCode_F12%:
MyString = "F12"
Case KeyCode_PrintScreen%: ' -44 = _KEYHIT CODE, NOT _BUTTON CODE
MyString = "Print Screen"
Case KeyCode_ScrollLock%:
MyString = "Scroll Lock"
Case KeyCode_PauseBreak%: ' 31053 = _KEYHIT CODE, NOT _BUTTON CODE
MyString = "Pause/Break"
Case KeyCode_Tilde%:
MyString = "`"
Case KeyCode_1%:
MyString = "1"
Case KeyCode_2%:
MyString = "2"
Case KeyCode_3%:
MyString = "3"
Case KeyCode_4%:
MyString = "4"
Case KeyCode_5%:
MyString = "5"
Case KeyCode_6%:
MyString = "6"
Case KeyCode_7%:
MyString = "7"
Case KeyCode_8%:
MyString = "8"
Case KeyCode_9%:
MyString = "9"
Case KeyCode_0%:
MyString = "0"
Case KeyCode_Minus%:
MyString = "-"
Case KeyCode_Equal%:
MyString = "="
Case KeyCode_BkSp%:
MyString = "Backspace"
Case KeyCode_Ins%:
MyString = "Insert"
Case KeyCode_Home%:
MyString = "Home"
Case KeyCode_PgUp%:
MyString = "Page Up"
Case KeyCode_Del%:
MyString = "Delete"
Case KeyCode_End%:
MyString = "End"
Case KeyCode_PgDn%:
MyString = "Page Down"
Case KeyCode_NumLock%:
MyString = "Num Lock"
Case KeyCode_KeypadSlash%:
MyString = "[keypad] /"
Case KeyCode_KeypadMultiply%:
MyString = "[keypad] *"
Case KeyCode_KeypadMinus%:
MyString = "[keypad] -"
Case KeyCode_Keypad7Home%:
MyString = "[keypad] 7/Home"
Case KeyCode_Keypad8Up%:
MyString = "[keypad] 8"
Case KeyCode_Keypad9PgUp%:
MyString = "[keypad] 9/PgUp"
Case KeyCode_KeypadPlus%:
MyString = "[keypad] +"
Case KeyCode_Keypad4Left%:
MyString = "[keypad] 4/Left"
Case KeyCode_Keypad5%:
MyString = "[keypad] 5"
Case KeyCode_Keypad6Right%:
MyString = "[keypad] 6/Right"
Case KeyCode_Keypad1End%:
MyString = "[keypad] 1/End"
Case KeyCode_Keypad2Down%:
MyString = "[keypad] 2/Down"
Case KeyCode_Keypad3PgDn%:
MyString = "[keypad] 3/PgDn"
Case KeyCode_KeypadEnter%:
MyString = "[keypad] Enter"
Case KeyCode_Keypad0Ins%:
MyString = "[keypad] 0/Ins"
Case KeyCode_KeypadPeriodDel%:
MyString = "[keypad] ./Del"
Case KeyCode_Tab%:
MyString = "Tab"
Case KeyCode_Q%:
MyString = "Q"
Case KeyCode_W%:
MyString = "W"
Case KeyCode_E%:
MyString = "E"
Case KeyCode_R%:
MyString = "R"
Case KeyCode_T%:
MyString = "T"
Case KeyCode_Y%:
MyString = "Y"
Case KeyCode_U%:
MyString = "U"
Case KeyCode_I%:
MyString = "I"
Case KeyCode_O%:
MyString = "O"
Case KeyCode_P%:
MyString = "P"
Case KeyCode_BracketLeft%:
MyString = "["
Case KeyCode_BracketRight%:
MyString = "]"
Case KeyCode_Backslash%:
MyString = "\"
Case KeyCode_CapsLock%:
MyString = "Caps Lock"
Case KeyCode_A%:
MyString = "A"
Case KeyCode_S%:
MyString = "S"
Case KeyCode_D%:
MyString = "D"
Case KeyCode_F%:
MyString = "F"
Case KeyCode_G%:
MyString = "G"
Case KeyCode_H%:
MyString = "H"
Case KeyCode_J%:
MyString = "J"
Case KeyCode_K%:
MyString = "K"
Case KeyCode_L%:
MyString = "L"
Case KeyCode_Semicolon%:
MyString = ";"
Case KeyCode_Apostrophe%:
MyString = "'"
Case KeyCode_Enter%:
MyString = "Enter"
Case KeyCode_ShiftLeft%:
MyString = "Shift Left"
Case KeyCode_Z%:
MyString = "Z"
Case KeyCode_X%:
MyString = "X"
Case KeyCode_C%:
MyString = "C"
Case KeyCode_V%:
MyString = "V"
Case KeyCode_B%:
MyString = "B"
Case KeyCode_N%:
MyString = "N"
Case KeyCode_M%:
MyString = "M"
Case KeyCode_Comma%:
MyString = ","
Case KeyCode_Period%:
MyString = "."
Case KeyCode_Slash%:
MyString = "/"
Case KeyCode_ShiftRight%:
MyString = "Shift Right"
Case KeyCode_Up%:
MyString = "Up"
Case KeyCode_Left%:
MyString = "Left"
Case KeyCode_Down%:
MyString = "Down"
Case KeyCode_Right%:
MyString = "Right"
Case KeyCode_CtrlLeft%:
MyString = "Ctrl Left"
Case KeyCode_WinLeft%:
MyString = "Win Left"
Case KeyCode_AltLeft%: ' -30764 = _KEYHIT CODE NOT _BUTTON CODE
MyString = "Alt Left"
Case KeyCode_Spacebar%:
MyString = "Spacebar"
Case KeyCode_AltRight%: ' -30765 = _KEYHIT CODE NOT _BUTTON CODE
MyString = "Alt Right"
Case KeyCode_WinRight%:
MyString = "Win Right"
Case KeyCode_Menu%:
MyString = "Menu"
Case KeyCode_CtrlRight%:
MyString = "Ctrl Right"
Case Else:
' UNKNOWN VALUE
MyString = "_BUTTON(" + _Trim$(Str$(KeyCode%)) + ")"
End Select ' KeyCode%
KeyDescription$ = MyString
End Function ' KeyDescription$
' ################################################################################################################################################################
' END KEYBOARD CODE FUNCTIONS
' ################################################################################################################################################################
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' BEGIN COLOR CODE FUNCTIONS
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
Function cBlack%
cBlack% = 0
End Function
Function cBlue%
cBlue% = 1
End Function
Function cGreen%
cGreen% = 2
End Function
Function cLtBlue%
cLtBlue% = 3
End Function
Function cRed%
cRed% = 4
End Function
Function cPurple%
cPurple% = 5
End Function
Function cOrange%
cOrange% = 6
End Function
Function cWhite%
cWhite% = 7
End Function
Function cGray%
cGray% = 8
End Function
Function cPeriwinkle%
cPeriwinkle% = 9
End Function
Function cLtGreen%
cLtGreen% = 10
End Function
Function cCyan%
cCyan% = 11
End Function
Function cLtRed%
cLtRed% = 12
End Function
Function cPink%
cPink% = 13
End Function
Function cYellow%
cYellow% = 14
End Function
Function cLtGray%
cLtGray% = 15
End Function
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------
' END COLOR CODE FUNCTIONS
' ----------------------------------------------------------------------------------------------------------------------------------------------------------------