Back in 2011 or so I wrote QB64 Space Invaders which was a sad attempt at Space Invaders. In 2013 I rewrote it to clone the original as much as possible. However, it was buggy and I never released it. I rediscovered the code recently when rewriting the tutorial web site and decided it was time to do this code justice. I completely rewrote the code and I present to you a QB64 Space Invaders game that clones the original 99%. I spent the last 3 weeks working on this (and playing WAY TOO MANY games of Space Invaders working the kinks out. Give it a whirl and let me know what you think.
The ZIP file below contains the source code and all assets (sound files and graphics). The game does create a file upon startup called "si.sav" that is used to save the game options and high score. It only contains two text lines so will never exceed 1KB in size.
You can turn the bezel image on/off, the background image on/off, resize the screen 1x, 2x, 3x, or full screen. Just like the original you can choose the number of shields (3 to 6), the extra ship score (1000 or 1500), and coin required or free play through the use of DIP switches in the options screen (just like found on the motherboard of the original arcade systems). The game is capable of playing 1 or 2 players exactly like the original was as well.
Code: (Select All)
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'
' ÛÛÛÛ ÛÛÛÛÛÛÛ ÛÛÛ ÛÛÛÛ ÛÛÛÛÛÛÛ This software has been written for educational purposes only. Under no circumstances is this source
' ÛÛÛÛÛÛÛ ÛÛÛÛÛÛÛÛ ÛÛÛ ÛÛÛÛÛÛ ÛÛÛÛÛÛÛ code or compiled EXE to be sold or otherwise used for a profitable purpose.
' ÛÛÛÛÛÛÛÛ ÛÛÛÛÛÛÛÛÛ ÛÛÛÛÛ ÛÛÛÛÛÛÛ ÛÛÛÛÛÛÛ
' ÛÛÛÛÛÛÛÛ ÛÛÛÛÛÛÛÛÛ ÛÛÛÛÛ ÛÛÛÛÛÛÛÛ ÛÛÛÛÛÛÛ Space Invaders was designed by Tomohiro Nishikado and is Copyright Taito Corporation with a license
' ÛÛÛÛÛÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛÛÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ to the Midway division of Bally Corporation for production. This software was written to pay homage
' ÛÛ ÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛÛÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ to Mr. Nishikado's outstanding game.
' ÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛÛÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ
' ÛÛÛ ÛÛÛ ÛÛÛ ÛÛ Û ÛÛ ÛÛÛ ÛÛÛ This source code has been released as open source which means you are free to use this source code
' ÛÛÛÛ ÛÛÛÛÛÛÛÛÛ ÛÛ Û ÛÛ ÛÛÛ ÛÛÛÛÛ to learn from and modify without prior consent from the original author. It is requested, however,
' ÛÛÛÛÛ ÛÛÛÛÛÛÛÛ ÛÛÛÛÛÛÛ ÛÛÛ ÛÛÛÛÛÛ that if you do make modifications to this source code that the author, version, and any
' ÛÛÛÛÛÛ ÛÛÛÛÛÛ ÛÛÛÛÛ ÛÛÛ ÛÛÛÛÛÛ modifications be noted in the area provided below if you plan to redistribute the source code with
' ÛÛÛÛÛ ÛÛÛÛÛÛ ÛÛÛÛÛ ÛÛÛ ÛÛ your modifications.
' ÛÛÛ ÛÛÛ ÛÛ ÛÛ ÛÛÛ ÛÛ
' ÛÛ ÛÛ ÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ ÛÛ Author Version Date Modifications
' ÛÛ ÛÛ ÛÛÛ ÛÛ ÛÛ ÛÛÛ ÛÛÛ ÛÛÛ ---------------- ------- -------- ------------------------------------------------------------------
' ÛÛÛÛÛÛ ÛÛÛ ÛÛÛÛ ÛÛÛÛ ÛÛÛÛÛÛÛ ÛÛÛÛÛÛ Terry Ritchie 1.0 06/24/13 Original version written in QB64 v0.954 SDL never released (buggy)
' ÛÛÛÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛ ÛÛÛÛÛ ÛÛÛÛÛÛ ---------------- ------- -------- ------------------------------------------------------------------
' ÛÛÛÛÛ ÛÛÛ ÛÛ ÛÛ ÛÛÛ ÛÛÛÛÛÛ Terry Ritchie 2.0 10/31/22 Complete rewrite of code to support QB64PE v.3.3.0
' ÛÛÛ ÛÛÛ ÛÛ ÛÛ ÛÛÛ ÛÛÛÛÛÛ This source code should compile with versions of QB64 2.1 and up
' The QB64PE logo was created by Pwillard at the QB64PE forum
' ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛÛ ÛÛÛÛ ÛÛÛÛÛ ÛÛÛ ÛÛÛ ---------------- ------- -------- ------------------------------------------------------------------
' ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛÛÛÛ ÛÛÛÛÛ ÛÛ ÛÛÛÛÛ ÛÛ ÛÛ
' ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛÛÛÛ ÛÛ ÛÛ ÛÛ ÛÛÛÛÛ ÛÛ
' ÛÛ ÛÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ
' ÛÛ ÛÛÛÛÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ
' ÛÛ ÛÛÛÛÛÛ ÛÛÛÛ ÛÛÛÛÛ ÛÛ ÛÛ ÛÛÛÛÛ ÛÛÛÛ ÛÛÛ
' ÛÛ ÛÛ ÛÛÛ ÛÛÛÛ ÛÛÛÛÛ ÛÛ ÛÛ ÛÛ ÛÛÛÛÛ ÛÛ
' ÛÛ ÛÛ ÛÛ ÛÛÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ
' ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛÛÛ ÛÛ ÛÛ ÛÛ ÛÛÛ
' ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛ ÛÛÛÛ ÛÛÛÛÛ ÛÛ ÛÛ ÛÛÛ
'
' QB64 adaptation
' by
' Terry Ritchie
' (quickbasic64@gmail.com)
' 06/24/13
' Updated 10/31/22
'
'
' I tried to clone the original space invaders game as closely as possible. The deviations from the original are noted below:
' ---------------------------------------------------------------------------------------------------------------------------
' - Centered the high score.
' - UFO intervals are 23 to 27 seconds. Sources I found state every 25 seconds give or take a few seconds but nothing firm.
' - player keyboard instructions on screen for inserting coins, setting options, and exiting the game.
' - An options screen simulating DIP switch settings on the motherboard of arcade machine.
' - Ability to turn the background image on and off (set in options).
' - Ability to display cabinet bezel around the screen (set in options).
' - Ability to change the screen resolution from native 224x248 to 2x, 3x, and full screen (set in options).
' - QB64 and author credit screen added to demo loop.
' - Invader beat sounds are slightly longer in length than the original.
' - Scores are five digits instead of the four found in the original game.
' - Extra ship sound is not exact to the original.
' - The high score is saved between program executions with the ability to reset the high score if desired (reset in options).
' - There is no demo play yet between the different intro screens at startup. Coming in next version.
'
' What I found about the original that was emulated in the game.
' --------------------------------------------------------------
' - The invaders update in a wave pattern like the original due to the slow microprocessor.
' - As the invaders are destroyed the wave pattern increases in speed.
' - The UFO scoring is not random. After 23 shots the UFO will always be 300 points and every 15 shots after that.
' - DIP switch options for setting the number of shields (3 to 6), coin or free play, and extra ship score (1000 or 1500).
' - The player's laser will always be destroyed when hit by a bomb. The bomb will randomly survive the encounter.
' - The demo screen will alternate between spelling PLAY correctly and with an upside down Y. The upside down Y will be carried off and corrected by an invader.
' - The demo screen will alternative between spelling COIN correctly or adding an extra C. The extra C will be destroyed by an invader.
'
' Bug or easter egg?
' ------------------
' There was a "bug" in the original Space Invaders that some considered to be an "Easter Egg". Mr. Nishikado never confirmed this either way. When the invaders are in the row
' directly above the player the player is immune to bombs. I consider this to be a "bug" because the bottom of the bomb was used to detect a collision with the player's ship.
' Since the bomb moves down one pixel before the collision check is done the player's ship becomes immune. Since this was a bug in my view this behavior has not been emulated
' in this version of the game. However, this behavior would be very easy to emulate if desired.
'
' Coding today is easier!
' -----------------------
' Of all the games I've emulated this was surprisingly one of the most difficult to write. It makes me appreciate the complexity of writing software for the late 70's to early
' 80's microprocessors used in arcade games of the time. Those were true programmers crafting excellent games in Assembler on very limited processors with 2K to 4K of RAM and ROM!
'
' Known issues with this version of the game.
' -------------------------------------------
' - When selecting a different screen size or adding/removing the bezel image in options upon exit from the options screen the game window will not recenter on the desktop.
' I've tried every method I can think of to get this to work. Upon game exit and restart the centering will work fine.
'
' Files included with the game:
' -----------------------------
' File created by the game - si.sav - saved options and high score
' Support files - sibeat1.ogg - heart beat 1 sound
' - sibeat2.ogg - heart beat 2 sound
' - sibeat3.ogg - heart beat 3 sound
' - sibeat4.ogg - heart beat 4 soound
' - sicoin.ogg - coin inserted sound
' - siextra.ogg - extra ship sound
' - siidead.ogg - invader explosion sound
' - silaser.ogg - laser sound
' - sipdead.ogg - ship explosion sound
' - siudead.ogg - UFO explosion sound
' - siufofly.ogg - UFO flying sound
' - siicon.bmp - window icon image
' - sisprites.png - game graphics
' - invaders.bas - QB64 source code
' +--------------+
' | METACOMMANDS |
'------------------------------------------------------------------------------------------------------------------------------------------------------------------+--------------+
'
OPTION _EXPLICIT ' force declaration of all variables
$VERSIONINFO:CompanyName=RitchCraft Creations
$VERSIONINFO:FileDescription=QB64 Space Invaders
$VERSIONINFO:InternalName=invaders.exe
$VERSIONINFO:ProductName=QB64 Space Invaders
$VERSIONINFO:OriginalFilename=invaders.exe
$VERSIONINFO:LegalCopyright=(c)2022 RitchCraft Creations
$VERSIONINFO:FILEVERSION#=2,0,0,0
$VERSIONINFO:PRODUCTVERSION#=2,0,0,0
' +-----------+
' | CONSTANTS |
'---------------------------------------------------------------------------------------------------------------------------------------------------------------------+-----------+
'
CONST FALSE = 0, TRUE = NOT FALSE ' boolean truth detecors
CONST PLAYER1 = 1 ' player 1 value
CONST PLAYER2 = 2 ' player 2 value
CONST BOTHPLAYERS = 3 ' both players value
CONST BLACK = _RGB32(0, 0, 0) ' color constants
CONST WHITE = _RGB32(255, 255, 255)
CONST INGAME = 5 ' mode settings
CONST INOPTIONS = 1
CONST INCOIN = 2
CONST INSELECT = 3
CONST NEWGAME = -1
CONST NEWLEVEL = 0
CONST CLEARVARIABLES = -1
CONST GODMODE = FALSE ' developer option
' +-------------------+
' | TYPE DECLARATIONS |
'-------------------------------------------------------------------------------------------------------------------------------------------------------------+-------------------+
TYPE RECT ' rectangle definition | RECT |
x1 AS INTEGER ' rectagular coordinates for objects and collision detection +------+
y1 AS INTEGER
x2 AS INTEGER ' x1,y1 = upper left x2,y2 = lower right
y2 AS INTEGER
END TYPE
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------------+-------+
TYPE PAUSE ' pause conditions | PAUSE |
Level AS INTEGER ' between levels pause +-------+
Die AS INTEGER ' after player death pause
END TYPE
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------+----------+
TYPE LASERHIT ' laser hitting objects properties | LASERHIT |
Count AS INTEGER ' number of invaders player has hit
Invader AS INTEGER ' countdown timer after invader hit by laser +----------+
InvaderX AS INTEGER ' invader hit coordinates for explosion
InvaderY AS INTEGER
UFO AS INTEGER ' countdown timer after UFO hit by laser
UFOX AS INTEGER ' UFO hit coordinate for score text
Shield AS INTEGER ' countdown timer after shield hit by laser
ShieldX AS INTEGER ' shield hit coordinates for explosion (mask)
ShieldY AS INTEGER
Bomb AS INTEGER ' countdown timer after bomb hit by laser
BombX AS INTEGER ' bomb hit coordinates for explosion
BombY AS INTEGER
END TYPE
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------+---------+
TYPE BOMBHIT ' bomb hitting objects properties | BOMBHIT |
Shield AS INTEGER ' countdown timer after shield hit by bomb
ShieldX AS INTEGER ' shield hit coordinates for explosion (mask)
ShieldY AS INTEGER
END TYPE
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------------+-------+
TYPE LASER ' laser properties | LASER |
rect AS RECT ' laser coordinates +-------+
Active AS INTEGER ' laser active (t/f)
Hit AS LASERHIT ' laser hit something
Miss AS INTEGER ' laser hit top of screen
ShotsFired AS INTEGER ' number of laser shots fired (for UFO scoring)
END TYPE
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------+------+
TYPE SHIP ' player ship properties | SHIP |
rect AS RECT ' player ship coordinates +------+
Remain AS INTEGER ' player ships remain
Dead AS INTEGER ' player ship is dead
DeadX AS INTEGER ' player ship death location
DeadImage AS INTEGER ' player ship exploding images indicator (-1 or 1)
Extra AS INTEGER ' extra ship awarded to player (t/f)
END TYPE
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------+--------+
TYPE SOUNDS ' sounds | SOUNDS |
InvaderHit AS LONG ' invader hit sound snd.invaderhit +--------+
PlayerHit AS LONG ' player hit sound snd.playerhit
UFOHit AS LONG ' UFO hit sound snd.ufohit
UFOFlying AS LONG ' UFO slying sound snd.ufoflying
Laser AS LONG ' laser firing sound snd.laser
Coin AS LONG ' coin dropping sound snd.coin
Beat1 AS LONG ' heartbeat sounds snd.beat1
Beat2 AS LONG ' snd.beat2
Beat3 AS LONG ' snd.beat3
Beat4 AS LONG ' snd.beat4
Extra AS LONG ' extra ship sound snd.extra
END TYPE
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------+--------+
TYPE IMAGES ' images | IMAGES |
UFO AS LONG ' UFO image img.ufo +--------+
InvaderHit AS LONG ' invader explosion img.invaderhit
BombHit AS LONG ' bomb explosion (bottom of screen and shields) img.bombhit
BombHitMask AS LONG ' destroy shields image img.bombhitmask
LaserHit AS LONG ' laser hit explosion (top of screen and shields) img.laserhit
LaserHitMask AS LONG ' destroy shields image img.laserhitmask
Shield AS LONG ' shield img.shield
QB64PE AS LONG ' QB64 Phoenix Edition logo img.qb64pe
DipSwitch AS LONG ' single DIP switch image img.dipswitch
END TYPE
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------+---------+
TYPE OPTIONS ' game options | OPTIONS |
ScreenSize AS INTEGER ' screen size (1 to 4) options.screensize +---------+
Shields AS INTEGER ' number of shields (3 to 6) options.shields
ExtraShip AS INTEGER ' extra ship score (1000 or 1500) options.extraship
FreePlay AS INTEGER ' free play (t/f) options.freeplay
Background AS INTEGER ' show background (t/f) options.background
Bezel AS INTEGER ' show bezel (t/f) options.bezel
Switches AS INTEGER ' DIP switch settings options.switches
FullScreen AS INTEGER ' full screen (t/f) options.fullscreen
END TYPE
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------+---------+
TYPE DISPLAY ' screens | DISPLAY |
WorkScreen AS LONG ' 224x248 game work screen display.workscreen +---------+
Screen AS LONG ' screen to stretch work screen onto display.screen
OptionScreen AS LONG ' options (dip switch) screen display.optionscreen
ColorMask AS LONG ' color mask to lay over display.colormask
WorkMask AS LONG ' work mask screen display.workmask
Bezel AS LONG ' bezel image display.bezel
Background AS LONG ' background image display.background
Bez AS RECT ' display screen coordinates within bezel display.bez
WithY AS LONG ' Images for intro animations display.withy
WithoutY AS LONG ' display.withouty
CorrectY AS LONG ' display.correcty
AddedC AS LONG ' display.addedc
NormalC AS LONG ' display.normalc
END TYPE
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------+------+
TYPE GAME ' game in progress settings | GAME |
Player AS INTEGER ' current player playing game game.player +------+
Players AS INTEGER ' number of players playing game game.players
Credits AS INTEGER ' credits inserted into machine game.credits
Pause AS PAUSE ' pause needed between levels game.pause.level (count down timer 120 frames or 2 seconds - PlayGame)
' pause needed between player deaths game.pause.die (count down timer 180 frames or 3 seconds - PlayGame)
Frame AS INTEGER ' master frame counter game.frame
HighScore AS LONG ' game high score game.highscore
Landed AS INTEGER ' invaders landed (t/f) game.landed
END TYPE
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------+------+
TYPE BOMB ' bomb properties | BOMB |
rect AS RECT ' bomb coordinates bomb().rect +------+
Hit AS BOMBHIT ' indicates bomb hit a shield bomb().hit.shield (count down timer 5 frames - DrawShields)
' where the bomb hit the shield bomb().hit.shieldx
' bomb().hit.shieldy
Image AS INTEGER ' bomb image (1 to 3) bomb().image
Cell AS INTEGER ' bomb image animation cell (1 to 4) bomb().cell
Active AS INTEGER ' bomb currently dropping (t/f) bomb().active
Miss AS INTEGER ' bomb hit bottom of screen bomb().miss (count down timer 5 frames - DrawBombs)
END TYPE
'---------------------------------------------------------------------------------------------------------------------------------------------------------------------------+-----+
TYPE UFO ' UFO properties | UFO |
rect AS RECT ' UFO coordinates ufo.rect +-----+
Dir AS INTEGER ' UFO direction ufo.dir
Active AS INTEGER ' UFO active ufo.active
Score AS INTEGER ' UFO score ufo.score
Pause AS INTEGER ' Time to wait for next UFO ufo.pause (count down timer 1500 frames +/- 120 - DrawUFO)
END TYPE
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------+--------+
TYPE PLAYER ' player properties | PLAYER |
Ship AS SHIP ' player ship coordinates player().ship.rect +--------+
' player ships remaining player().ship.remain
' indicates the player's ship was hit player().ship.dead
' where on screen the ship was hit player().ship.deadx
' player ship exploding images indicator (-1 or 1) player().ship.deadimage
' indicates if player was awarded extra ship (t/f) player().ship.extra
Level AS INTEGER ' player level player().level
Score AS LONG ' player score player().score
GameOver AS INTEGER ' player game over (t/f) player().gameover
Laser AS LASER ' player laser coordinates player().laser.rect
' indicates if laser if currently flying (t/f) player().laser.active
' indicates laser hit top of screen player().laser.miss (count down timer 10 frames - DrawLaser)
' indictaes laser hit an invader player().laser.hit.invader (count down timer 5 frames - DrawInvaders)
' location on screen where invader was hit player().laser.hit.invaderx
' player().laser.hit.invadery
' number of invaders killed (1 to 55) player().laser.hit.count
' indicates if laser hit a UFO player().laser.hit.ufo (count down timer 60 frames or 1 second - DrawUFO)
' location on screen where UFO was hit player().laser.hit.ufox
' indicates that laser hit a shield player().laser.hit.shield (count down timer 5 frames - DrawShields)
' location on shield where laser hit player().laser.hit.shieldx
' player().laser.hit.shieldy
' indicates that laser hit a bomb player().laser.hit.bomb (count down timer 5 frames - DrawLaser)
' location on screen where laser hit bomb player().laser.hit.bombx
' player().laser.hit.bomby
' number of lasers fired by player (for UFO score) player().laser.shotsfired
idir AS INTEGER ' invader direction (-2 or 2) player().idir
MaxBombs AS INTEGER ' maximum number of invader bombs allowed (1 to 3) player().maxbombs
UFO AS UFO ' UFO saved state in multiplayer game player().ufo.rect
' direction of UFO (-1 or 1) player().ufo.dir
' indicates if UFO currently flying (t/f) player().ufo.active
' score of UFO if hit player().ufo.score
' time to wait in between UFO showings (23 to 27 sec) player().ufo.pause
Keydown AS INTEGER ' player is holding a key down (t/f) player().keydown
END TYPE
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------+---------+
TYPE SHIELDS ' shield properties | SHIELDS |
rect AS RECT ' shield coordinates shield(player,x).rect +---------+
Image AS LONG ' damaged shield image shield(player,x).image
END TYPE
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------+----------+
TYPE INVADERS ' invader properties | INVADERS |
rect AS RECT ' invader coordinates invader(player,column,row).rect +----------+
Active AS INTEGER ' invader active (t/f) invader(player,column,row).active
cell AS INTEGER ' invader image animation cell invader(player,column,row).cell
Image AS INTEGER ' invader image ' invader(player,column,row).image
Width AS INTEGER ' invader width invader(player,column,row).width
Score AS INTEGER ' invader score invader(player,column,row).score
END TYPE
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------+------------+
TYPE DROPCOLUMN ' bomb column properties | DROPCOLUMN |
Pause AS INTEGER ' time to wait before dropping bomb in column dropcolumn().pause (count down timer) +------------+
Row AS INTEGER ' row that contains bottom invader (0 for none) dropcolumn().row
END TYPE
'------------------------------------------------------------------------------------------------------------------------------------------------------------+--------------------+
DIM Player(2) AS PLAYER ' player settings | Declared Variables |
DIM Invader(2, 11, 5) AS INVADERS ' 55 invaders (player,column,row) +--------------------+
DIM DropColumn(11) AS DROPCOLUMN ' 11 columns for bomb drops
DIM Bomb(3) AS BOMB ' invader bombs dropping
DIM UFO(2) AS UFO ' UFO settings
DIM IMG AS IMAGES ' images
DIM SND AS SOUNDS ' sounds
DIM Display AS DISPLAY ' display screens
DIM Options AS OPTIONS ' player selectable options
DIM Game AS GAME ' current game settings
DIM Font(255) AS LONG ' game font characters
DIM IMG_Invader(3, 1) AS LONG ' invader images and animation cells (image, cell)
DIM IMG_Bomb(3, 3) AS LONG ' bomb images and animation cells (image, cell)
DIM IMG_Ship(-1 TO 1) AS LONG ' images of player ship (-1,1 explosion, 0 intact)
DIM Shield(2, 6) AS SHIELDS ' player shield images (player, shield)
' +-------------------+
' | MAIN CODE SECTION |
'-------------------------------------------------------------------------------------------------------------------------------------------------------------+-------------------+
LoadAssets ' load the games graphic and sound files | MAIN GAME LOOP |
LoadOptions ' load the saved game options +-------------------+
Initialize ' initialize all game variables
DO ' begin game play loop
IF Options.FreePlay THEN Game.Credits = 99 ' fill the game with coins if set to free play
InsertCoin ' allow the player to insert coins (skipped if free play)
SelectPlayers ' select the number of players and play a game
LOOP ' loop back forever
' +---------------------------+
' | END MAIN GAME LOOP |
'-----------------------------------------------------------------------------------------------------------------------------------------------------+---------------------------+
' | SUBROUTINES AND FUNCTIONS |
' +---------------------------+
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------+----------+
SUB PlayGame (Players AS INTEGER) ' | PlayGame |
'+-----------------------------------------------------------------------------------------------------------------------------------------------------------------+----------+
'| Plays a 1 or 2 player game of Space Invaders |
'| Players - number of players (1 or 2) |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Player() AS PLAYER ' need access to shared variables
SHARED Game AS GAME
SHARED UFO() AS UFO
SHARED SND AS SOUNDS
DIM KeyPress AS INTEGER ' keypress in slow text
DIM p AS INTEGER ' current player
StartNewGame ' reset variables to start a new game
Game.Players = Players ' record the number of players passed in
p = Game.Player ' get the current player
IF Players = 1 THEN Player(2).GameOver = TRUE ' kill off player 2 if a one player game
GetReady ' inform player 1 to get ready
DO ' begin main game loop
DO ' begin game level loop
_LIMIT 60 ' game runs at 60 frames per second
ClearDisplay INGAME ' clear the display
IF Game.Pause.Level THEN ' is game paused for a level change?
Game.Pause.Level = Game.Pause.Level - 1 ' yes, decrement pause count down timer
IF Game.Pause.Level = 0 THEN ' has the count down finished?
ResetBombs ' yes, reset the bombs
DrawShields NEWLEVEL ' restore player shields for next level
END IF
END IF
IF Players = 2 THEN ' is this a 2 player game?
DrawScore BOTHPLAYERS, INGAME ' yes, display both scores on screen
ELSE ' no, this is a 1 player game
DrawScore PLAYER1, INGAME ' display just player 1's score
END IF
MoveInvaders p, INGAME ' move the invaders
DrawInvaders ' draw the invaders to the screen
DrawShields INGAME ' draw the player's shields
DrawUFO ' draw the UFO when active
DrawShip ' draw the player's ship
DrawLaser ' draw the player's laser when active
DrawBombs ' draw the invader bombs when active
DrawShipsRemaining ' draw the number of ships the player has remaining
UpdateDisplay INGAME ' update the display with all the changes
IF _KEYDOWN(27) OR _EXIT THEN ExitGame ' exit the game if the player presses ESC
LOOP UNTIL Player(p).Laser.Hit.Count = 55 OR Player(p).Ship.Dead OR Game.Landed ' leave when level finished or player dead
IF Game.Landed THEN ' did the invaders land?
Player(p).Ship.Dead = TRUE ' yes, the player is dead
Player(p).Ship.DeadX = Player(p).Ship.rect.x1 ' the player died at this location
_SNDPLAY SND.PlayerHit ' play the player death sound
Player(p).Ship.Remain = 1 ' take all ships away from player
Game.Landed = FALSE ' reset for 2nd player if needed
END IF
IF Player(p).Laser.Hit.Count = 55 THEN ' did the player shoot all of the invaders?
Game.Pause.Level = 120 ' yes, pause for 2 seconds between levels
StartNewLevel ' reset variables for a new level
ELSEIF Player(p).Ship.Dead THEN ' no, is the player dead?
ResetBombs ' yes, reset the bombs
IF Game.Pause.Level THEN ' did the player die between level changes?
Game.Pause.Level = 0 ' yes, stop the level pause count down
DrawShields NEWLEVEL ' restore the player's shields for the new level
END IF
Player(p).Ship.Remain = Player(p).Ship.Remain - 1 ' take a ship away from player
Game.Pause.Die = 180 ' 3 second pause after player dies
Player(p).Laser.Active = FALSE ' deactivate the player's laser
Player(p).UFO = UFO(p) ' save the player's UFO state
IF UFO(p).Active AND Players = 2 THEN ' is the UFO still active in a 2 player game?
UFO(p).Active = FALSE ' yes, deactivate the UFO
_SNDSTOP SND.UFOFlying ' stop the UFO sound
END IF
DO ' begin player death pause loop
_LIMIT 60 ' sequence will run at 60 frames per second
ClearDisplay INGAME ' clear the display
IF Players = 1 THEN ' is this a 1 player game?
DrawScore PLAYER1, INGAME ' yes, just draw player 1's score
IF Player(1).Ship.Remain > 0 THEN ' does the player have any ships remaining?
DrawUFO ' yes, keep the UFO flying during pause
ELSE ' no, player 1's game is about to end
_SNDSTOP SND.UFOFlying ' stop the UFO sound if it happens to be playing
END IF
ELSE ' no, this is a 2 player game
DrawScore BOTHPLAYERS, INGAME ' draw both player's scores to the screen
END IF
DrawInvaders ' draw the invaders without moving
DrawShields INGAME ' draw the player's current shields
DrawShipsRemaining ' draw the number of ships the player has remaining
IF Game.Pause.Die = 1 THEN ' is this the last frame of the death pause?
IF Player(p).Ship.Remain = 0 THEN ' yes, is the player out of ships?
IF Players = 1 THEN ' yes, is this a 1 player game?
DrawScore PLAYER1, INGAME ' yes, draw player 1's score
SlowText 6, 9, "GAME OVER", INGAME, KeyPress ' slowly tell player 1 that the game is over
ELSE ' no, this is a 2 player game
DrawScore BOTHPLAYERS, INGAME ' draw both player scores to the screen
SlowText 6, 5, "GAME OVER PLAYER<" + _TRIM$(STR$(p)) + ">", INGAME, KeyPress ' slowly tell the current player that the game is over
END IF
Player(p).GameOver = TRUE ' the player's game is over
SLEEP 2 ' pause for 2 seconds to let it sink in
ELSE ' no, the player has at least 1 ship remaining
Player(p).Ship.Dead = FALSE ' bring the player back to life
END IF
END IF
DrawShip ' draw the player's ship blowing up
UpdateDisplay INGAME ' update the display with all the changes made
Game.Pause.Die = Game.Pause.Die - 1 ' decrement the death pause count down timer
IF _KEYDOWN(27) OR _EXIT THEN ExitGame ' leave the game if the player presses ESC
LOOP UNTIL Game.Pause.Die = 0 ' leave the death loop when the count down has completed
IF Players = 2 AND (Player(1).GameOver = FALSE OR Player(2).GameOver = FALSE) THEN ' is this a 2 player game with at least 1 player still active?
DO ' yes, begin next player search loop
p = p + 1 ' increment the player number
IF p > 2 THEN p = 1 ' return back to player 1 if needed
LOOP UNTIL Player(p).Ship.Dead = FALSE ' leave the loop when a live player is found
Game.Player = p ' record the new current player
GetReady ' tell the player to get ready
UFO(p) = Player(p).UFO ' restore the UFO settings
IF UFO(p).Active THEN _SNDLOOP SND.UFOFlying ' restart the UFO sound if the UFO happens to be flying
END IF
END IF
LOOP UNTIL Player(1).GameOver AND Player(2).GameOver ' leave when both players have exhaused their ships
_KEYCLEAR ' clear all keyboard buffers
KeyPress = GetKey(NEWGAME) ' clear getkey buffer
SaveOptions ' save the options in case a new high score was achieved
END SUB
'--------------------------------------------------------------------------------------------------------------------------------+---------------------------------+--+-----------+
SUB DrawBombs () ' | COLLISION: Bomb and Player Ship | | DrawBombs |
'+---------------------------------------------------------------------------------------------------------------------------+---------------------------------+--+-----------+
'| Manages invader bombs and collisions between bombs and the player's ship |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Invader() AS INVADERS ' need access to shared variables
SHARED Bomb() AS BOMB
SHARED IMG_Bomb() AS LONG
SHARED DropColumn() AS DROPCOLUMN
SHARED IMG AS IMAGES
SHARED Game AS GAME
SHARED Player() AS PLAYER
SHARED Shield() AS SHIELDS
SHARED SND AS SOUNDS
DIM b AS INTEGER ' bomb counter
DIM c AS INTEGER ' column counter
DIM p AS INTEGER ' current player
p = Game.Player ' get current player
DO ' begin active bomb loop
b = b + 1 ' increment bomb counter
IF Bomb(b).Active THEN ' is this bomb falling?
IF Bomb(b).Hit.Shield THEN ' yes, has the bomb hit a shield?
Bomb(b).Hit.Shield = Bomb(b).Hit.Shield - 1 ' yes, decrement count down timer
_PUTIMAGE (Bomb(b).Hit.ShieldX, Bomb(b).Hit.ShieldY), IMG.BombHit ' show bomb explosion
IF Bomb(b).Hit.Shield = 0 THEN Bomb(b).Active = FALSE
ELSEIF Bomb(b).Miss THEN ' did bomb miss and hit top of screen?
Bomb(b).Miss = Bomb(b).Miss - 1 ' yes, decrement count down timer
_PUTIMAGE (Bomb(b).rect.x1 - 1, Bomb(b).rect.y1), IMG.BombHit ' show bomb explosion image
IF Bomb(b).Miss = 0 THEN Bomb(b).Active = FALSE ' deactivate bomb when count down complete
ELSE ' no, bomb is stil falling
Bomb(b).rect.y1 = Bomb(b).rect.y1 + 1 + Game.Frame MOD 2 ' drop bomb at 90 FPS
Bomb(b).rect.y2 = Bomb(b).rect.y2 + 1 + Game.Frame MOD 2
Bomb(b).Cell = Bomb(b).Cell + 1 ' increment animation cell
IF Bomb(b).Cell = 4 THEN Bomb(b).Cell = 1 ' reset animation cell when needed
_PUTIMAGE (Bomb(b).rect.x1, Bomb(b).rect.y1), IMG_Bomb(Bomb(b).Image, Bomb(b).Cell) ' show bomb on screen
IF Bomb(b).rect.y1 >= 228 THEN ' has bomb hit bottom of screen?
Bomb(b).Miss = 5 ' yes, set count down timer
ELSE ' no, bomb is still on the sceen
'******************************************************
'** Check for collision between bomb and player ship **
'******************************************************
IF NOT GODMODE THEN ' is developer in god mode?
IF Player(p).Ship.Dead = FALSE THEN ' no, is the player ship active?
IF RectCollide(Player(p).Ship.rect, Bomb(b).rect) THEN ' yes, has the bomb hit the player's ship?
Player(p).Ship.Dead = TRUE ' yes, player is dead
Player(p).Ship.DeadX = Player(p).Ship.rect.x1 ' record where on screen ship was hit
_SNDPLAY SND.PlayerHit ' play ship explosion sound
END IF
END IF
END IF
END IF
END IF
END IF
LOOP UNTIL b = Player(p).MaxBombs ' leave when all bombs checked
IF Game.Pause.Level THEN EXIT SUB ' leave subroutine if game is paused between levels
DO ' begin bomb drop column loop
c = c + 1 ' increment column counter
IF DropColumn(c).Pause THEN ' is this column ready to have a bomb dropped?
DropColumn(c).Pause = DropColumn(c).Pause - 1 ' no, decrement pause timer
ELSE ' yes, the pause period has ended
IF DropColumn(c).Row THEN ' is there an invader in this column?
IF INT(RND * 11) = 1 THEN ' yes, should a bomb be randomly dropped?
b = 0 ' yes, reset bomb counter
DO ' begin inactive bomb search
b = b + 1 ' increment bomb counter
LOOP UNTIL Bomb(b).Active = FALSE OR b = Player(p).MaxBombs ' leave when inactive bomb found or no inactive bombs
IF Bomb(b).Active = FALSE THEN ' is this bomb inactive?
Bomb(b).Active = TRUE ' yes, activate the bomb
Bomb(b).Image = INT(RND * 3) + 1 ' set a random bomb image
Bomb(b).Cell = 1 ' reset the animation cell
Bomb(b).rect.x1 = Invader(p, c, DropColumn(c).Row).rect.x1 + Invader(p, c, DropColumn(c).Row).Width / 2 - 1 ' calculate bomb location on screen
Bomb(b).rect.y1 = Invader(p, c, DropColumn(c).Row).rect.y2 - 2
Bomb(b).rect.x2 = Bomb(b).rect.x1 + 2
Bomb(b).rect.y2 = Bomb(b).rect.y1 + 7
DropColumn(c).Pause = INT(RND * 15) + 55 - Player(p).Laser.Hit.Count ' reset the pause timer for this column
END IF
END IF
END IF
END IF
LOOP UNTIL c = 11 ' leave when all columns checked
END SUB
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------+------------+
SUB ResetBombs () ' | ResetBombs |
'+---------------------------------------------------------------------------------------------------------------------------------------------------------------+------------+
'| Resets the bombs and columns status |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED DropColumn() AS DROPCOLUMN ' need access to shared variables
SHARED Bomb() AS BOMB
DIM c AS INTEGER ' column counter
DO ' begin column loop
c = c + 1 ' increment column counter
DropColumn(c).Pause = 60 + INT(RND * 240) ' reset column pause timer
IF c < 4 THEN Bomb(c) = Bomb(0) ' reset status of bomb
LOOP UNTIL c = 11 ' leave when all columns processed
END SUB
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------+-------------+
FUNCTION RectCollide (Rect1 AS RECT, Rect2 AS RECT) ' | RectCollide |
'+--------------------------------------------------------------------------------------------------------------------------------------------------------------+-------------+
'| Detects a collision between two rectangular objects |
'| Rect1 - the first set of rectangular coordinates |
'| Rect2 - the second set of rectangular coordinates |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
RectCollide = FALSE ' assume no collision
IF Rect1.x2 >= Rect2.x1 THEN
IF Rect1.x1 <= Rect2.x2 THEN
IF Rect1.y2 >= Rect2.y1 THEN
IF Rect1.y1 <= Rect2.y2 THEN
RectCollide = TRUE ' a collision has occurred
END IF
END IF
END IF
END IF
END FUNCTION
'--------------------------------------------------------------------------------------------------------------------------------------+---------------------------+--+-----------+
SUB DrawLaser () ' | COLLISION: Laser and Bomb | | DrawLaser |
'+---------------------------------------------------------------------------------------------------------------------------------+---------------------------+--+-----------+
'| Manages the player's laser and collisions between the laser and bombs |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Player() AS PLAYER ' need access to shared variables
SHARED SND AS SOUNDS
SHARED IMG AS IMAGES
SHARED Bomb() AS BOMB
SHARED Game AS GAME
DIM b AS INTEGER ' bomb counter
DIM p AS INTEGER ' current player
p = Game.Player ' get current player
IF NOT _KEYDOWN(32) THEN Player(p).Keydown = FALSE ' remember when player releases space bar
IF Player(p).Laser.Active = FALSE THEN ' is the player's laser flying?
IF _KEYDOWN(32) AND Player(p).Keydown = FALSE THEN ' no, did the player press the space bar after releasing it?
Player(p).Laser.Active = TRUE ' yes, activate the laser
Player(p).Laser.ShotsFired = Player(p).Laser.ShotsFired + 1 ' increment the shots fired counter
Player(p).Keydown = TRUE ' remember that player is holding the space bar down
Player(p).Laser.rect.x1 = Player(p).Ship.rect.x1 + 6 ' calculate the position of the laser
Player(p).Laser.rect.x2 = Player(p).Laser.rect.x1
Player(p).Laser.rect.y1 = 216
Player(p).Laser.rect.y2 = 219
_SNDPLAY SND.Laser ' play the laser fired sound
END IF
ELSE ' yes, the player's laser is active
IF Player(p).Laser.Miss THEN ' did the player's laser hit the top of screen?
Player(p).Laser.Miss = Player(p).Laser.Miss - 1 ' yes, decrement count down timer
_PUTIMAGE (Player(p).Laser.rect.x1 - 4, 24), IMG.LaserHit ' show the laser explosion
IF Player(p).Laser.Miss = 0 THEN Player(p).Laser.Active = FALSE ' deactivate the laser when count down complete
ELSEIF Player(p).Laser.Hit.Invader THEN ' no, did the laser hit an invader?
Player(p).Laser.Hit.Invader = Player(p).Laser.Hit.Invader - 1 ' yes, decrement the count down timer
_PUTIMAGE (Player(p).Laser.Hit.InvaderX, Player(p).Laser.Hit.InvaderY), IMG.InvaderHit ' show invader explosion
IF Player(p).Laser.Hit.Invader = 0 THEN Player(p).Laser.Active = FALSE ' deactivate the laser whn count down complete
ELSEIF Player(p).Laser.Hit.Bomb THEN ' no, did the laser hit a bomb?
Player(p).Laser.Hit.Bomb = Player(p).Laser.Hit.Bomb - 1 ' yes, decrement the count down timer
_PUTIMAGE (Player(p).Laser.Hit.BombX, Player(p).Laser.Hit.BombY), IMG.BombHit ' show bomb explosion
IF Player(p).Laser.Hit.Bomb = 0 THEN ' has the count down timer ended?
Player(p).Laser.Active = FALSE ' yes, deactivate the player's laser
END IF
ELSEIF Player(p).Laser.Hit.Shield THEN ' no, did the laser hit a shield?
Player(p).Laser.Hit.Shield = Player(p).Laser.Hit.Shield - 1 ' yes, decrement the count down timer
_PUTIMAGE (Player(p).Laser.Hit.ShieldX, Player(p).Laser.Hit.ShieldY), IMG.LaserHit ' show laser explosion
IF Player(p).Laser.Hit.Shield = 0 THEN Player(p).Laser.Active = FALSE ' deactivate the laser when count down complete
ELSE ' no, laser is still flying
Player(p).Laser.rect.y1 = Player(p).Laser.rect.y1 - 4 ' move the laser upward
Player(p).Laser.rect.y2 = Player(p).Laser.rect.y2 - 4
LINE (Player(p).Laser.rect.x1, Player(p).Laser.rect.y1)-(Player(p).Laser.rect.x2, Player(p).Laser.rect.y2 + 3), WHITE ' draw the laser
IF Player(p).Laser.rect.y1 = 24 THEN ' did the laser hit the top of screen?
Player(p).Laser.Miss = 10 ' yes, set the count down timer
ELSE ' no, laser still on sreen
'************************************************
'** Check for collision between laser and bomb **
'************************************************
DO ' begin bomb check loop
b = b + 1 ' increment bomb counter
IF Bomb(b).Active AND Player(p).Laser.Active THEN ' is this bomb falling and player laser active?
IF RectCollide(Player(p).Laser.rect, Bomb(b).rect) THEN ' yes, did the bomb hit the laser?
Player(p).Laser.Hit.Bomb = 5 ' yes, set the count down timer
Player(p).Laser.Hit.BombX = Bomb(b).rect.x1 - 2 ' record the location of the collision
Player(p).Laser.Hit.BombY = Bomb(b).rect.y1 + 5
IF INT(RND * 2) = 1 THEN Bomb(b).Active = FALSE ' randomly deactivate the bomb
END IF
END IF
LOOP UNTIL b = Player(p).MaxBombs OR Player(p).Laser.Hit.Bomb ' leave when all bombs checked
END IF
END IF
END IF
END SUB
'-----------------------------------------------------------------------------------------------------------------------+---------------------------------------+--+--------------+
SUB DrawInvaders () ' | COLLISION:Invader and Laser or Shield | | DrawInvaders |
'+------------------------------------------------------------------------------------------------------------------+---------------------------------------+--+--------------+
'| Draws the active invaders to the screen and handles collisions between invaders and the player's laser and invaders and shields |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Invader() AS INVADERS ' need access to shared variables
SHARED DropColumn() AS DROPCOLUMN
SHARED IMG_Invader() AS LONG
SHARED Shield() AS SHIELDS
SHARED Display AS DISPLAY
SHARED Options AS OPTIONS
SHARED Player() AS PLAYER
SHARED SND AS SOUNDS
SHARED Game AS GAME
DIM x AS INTEGER ' invader column counter
DIM y AS INTEGER ' invader row counter
DIM s AS INTEGER ' shield counter
DIM shx AS INTEGER ' location of invader and shield collision
DIM shy AS INTEGER
DIM p AS INTEGER ' current player
IF Game.Pause.Level THEN EXIT SUB ' leave subroutine if game paused between levels
p = Game.Player ' get current player
DO ' begin invader column loop
x = x + 1 ' increment column counter
y = 0 ' reset row counter
DropColumn(x).Row = 0 ' assume no invaders in this column
DO ' begin invader row loop
y = y + 1 ' increment row counter
IF Invader(p, x, y).Active THEN ' is this invader active?
_PUTIMAGE (Invader(p, x, y).rect.x1, Invader(p, x, y).rect.y1), IMG_Invader(Invader(p, x, y).Image, Invader(p, x, y).cell) ' yes, draw the invader
IF y > DropColumn(x).Row THEN DropColumn(x).Row = y ' record the lowest invader in the column
'********************************************
'** Check for invader and shield collision **
'********************************************
IF Invader(p, x, y).rect.y1 > 191 AND Invader(p, x, y).rect.y1 < 209 THEN ' is the invader in the shield area?
s = 0 ' yes, reset shield counter
DO ' begin shield loop
s = s + 1 ' increment shield counter
IF RectCollide(Invader(p, x, y).rect, Shield(p, s).rect) THEN ' is the invader colliding with a shield?
shx = Invader(p, x, y).rect.x1 - Shield(p, s).rect.x1 ' yes, record the location of the collision
shy = Invader(p, x, y).rect.y1 - 192
_DEST Shield(p, s).Image ' draw on the shield image
LINE (shx, shy)-(shx + Invader(p, x, y).Width - 1, shy + 7), BLACK, BF ' remove portion of shield where collision occurring
_DEST Display.WorkScreen ' return to drawing on work display
END IF
LOOP UNTIL s = Options.Shields ' leave when all shields have been checked
ELSEIF Invader(p, x, y).rect.y1 = 216 THEN ' has the invader landed at ship location?
'**************************************
'** Invader reached bottom of screen **
'**************************************
Game.Landed = TRUE ' yes, remember that invader has landed
END IF
'*******************************************
'** Check for invader and laser collision **
'*******************************************
IF Player(p).Laser.Active THEN ' is the player's laser flying?
IF RectCollide(Player(p).Laser.rect, Invader(p, x, y).rect) THEN ' yes, has the laser collided with an invader?
Player(p).Score = Player(p).Score + Invader(p, x, y).Score ' yes, add the invader's score to the player's score
Player(p).Laser.Hit.Count = Player(p).Laser.Hit.Count + 1 ' increment the player's invader hit counter
IF Player(p).Laser.Hit.Count = 27 THEN ' have half the invaders been destroyed?
IF Player(p).MaxBombs < 3 THEN ' yes, are the maximum number of bombs dropping?
Player(p).MaxBombs = Player(p).MaxBombs + 1 ' no, increase the amount of bombs invaders allowed to drop
END IF
END IF
Player(p).Laser.Hit.Invader = 5 ' set count down timer
Player(p).Laser.Hit.InvaderX = Invader(p, x, y).rect.x1 - ((14 - Invader(p, x, y).Width) \ 2) ' record where the collision occurred
Player(p).Laser.Hit.InvaderY = Invader(p, x, y).rect.y1
Invader(p, x, y).Active = FALSE ' deactivate this invader
_SNDPLAY SND.InvaderHit ' play the invader explosion sound
END IF
END IF
END IF
LOOP UNTIL y = 5 ' leave when all rows checked
LOOP UNTIL x = 11 ' leave whan all columns checked
END SUB
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------+----------+
SUB DrawShip () ' | DrawShip |
'+-----------------------------------------------------------------------------------------------------------------------------------------------------------------+----------+
'| Manages the player's ship |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED IMG_Ship() AS LONG ' need access to shared variables
SHARED Player() AS PLAYER
SHARED Game AS GAME
DIM p AS INTEGER ' current player
p = Game.Player ' get current player
IF Game.Pause.Die THEN ' is a death pause happening?
IF Game.Frame MOD 5 = 0 THEN Player(p).Ship.DeadImage = -Player(p).Ship.DeadImage ' yes, toggle the death image every 5 frames
_PUTIMAGE (Player(p).Ship.DeadX, Player(p).Ship.rect.y1), IMG_Ship(Player(p).Ship.DeadImage) ' draw the ship death image
IF Game.Pause.Die = 1 THEN ' is this the last frame of the death pause?
Player(p).Ship.rect.x1 = 15 ' yes, reset player's ship location
Player(p).Ship.rect.x2 = 27
END IF
ELSE ' no, player is still alive
IF _KEYDOWN(19712) THEN ' is player pressing the right arrow key?
Player(p).Ship.rect.x1 = Player(p).Ship.rect.x1 + 1 ' yes, move ship to the right
Player(p).Ship.rect.x2 = Player(p).Ship.rect.x2 + 1
END IF
IF _KEYDOWN(19200) THEN ' is player pressing the left arrow key?
Player(p).Ship.rect.x1 = Player(p).Ship.rect.x1 - 1 ' yes, move ship to the left
Player(p).Ship.rect.x2 = Player(p).Ship.rect.x2 - 1
END IF
IF Player(p).Ship.rect.x1 < 15 THEN ' is the ship moving too far left?
Player(p).Ship.rect.x1 = 15 ' yes, hold ship at left side of screen
Player(p).Ship.rect.x2 = 27
END IF
IF Player(p).Ship.rect.x2 > 207 THEN ' is the ship moving too far right?
Player(p).Ship.rect.x1 = 194 ' yes, hold ship at right side of screen
Player(p).Ship.rect.x2 = 207
END IF
_PUTIMAGE (Player(p).Ship.rect.x1, Player(p).Ship.rect.y1), IMG_Ship(0) ' draw player ship
END IF
END SUB
'-----------------------------------------------------------------------------------------------------------------------------------------+--------------------------+--+---------+
SUB DrawUFO () ' | COLLISION: Laser and UFO | | DrawUFO |
'+------------------------------------------------------------------------------------------------------------------------------------+--------------------------+--+---------+
'| Manages the UFO and collisions between the UFO and player's laser |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Player() AS PLAYER ' need access to shared variables
SHARED UFO() AS UFO
SHARED Game AS GAME
SHARED IMG AS IMAGES
SHARED SND AS SOUNDS
DIM p AS INTEGER ' current player
p = Game.Player ' get current player
IF Player(p).Laser.Hit.UFO THEN ' did the player's laser hit the UFO?
Player(p).Laser.Hit.UFO = Player(p).Laser.Hit.UFO - 1 ' yes, decrement count down timer
Text Player(p).Laser.Hit.UFOX, 32, _TRIM$(STR$(UFO(p).Score)) ' display the UFO score where UFO was hit
END IF
IF UFO(p).Active THEN ' is the UFO flying across the screen?
IF Game.Frame MOD 4 THEN ' yes, skip every 4th frame
UFO(p).rect.x1 = UFO(p).rect.x1 + UFO(p).Dir ' move UFO at 45 FPS
UFO(p).rect.x2 = UFO(p).rect.x1 + 15
END IF
IF UFO(p).rect.x1 > 199 OR UFO(p).rect.x1 < 8 THEN ' has the UFO reached the edge of screen?
_SNDSTOP SND.UFOFlying ' yes, stop the UFO sound
UFO(p).Active = FALSE ' deactivate the UFO
ELSE ' no, UFO is still flying
_PUTIMAGE (UFO(p).rect.x1, UFO(p).rect.y1), IMG.UFO ' draw the UFO
'***********************************************
'** Check for collision between laser and UFO **
'***********************************************
IF Player(p).Laser.Active THEN ' is the player's laser active?
IF RectCollide(Player(p).Laser.rect, UFO(p).rect) THEN ' has the player's laser hit the UFO?
SELECT CASE INT(RND * 3) + 1 ' yes, set a random score value
CASE 1
UFO(p).Score = 50 ' 50 points
CASE 2
UFO(p).Score = 100 ' 100 points
CASE 3
UFO(p).Score = 200 ' 200 points
END SELECT
IF Player(p).Laser.ShotsFired = 23 THEN UFO(p).Score = 300 ' 300 points if the player has fired 23 lasers
IF Player(p).Laser.ShotsFired > 23 THEN ' has the player fired more than 23 lasers?
IF (Player(p).Laser.ShotsFired - 23) MOD 15 = 0 THEN ' every 15 laser firings afterwards?
UFO(p).Score = 300 ' yes, UFO score is again 300 points
END IF
END IF
Player(p).Score = Player(p).Score + UFO(p).Score ' add the UFO score to the player's score
Player(p).Laser.Hit.UFO = 60 ' set the count down timer
Player(p).Laser.Hit.UFOX = UFO(p).rect.x1 + 32 ' record where the UFO was hit
UFO(p).Active = FALSE ' deactivate the UFO
Player(p).Laser.Active = FALSE ' deactivate the player's laser
_SNDSTOP SND.UFOFlying ' stop the UFO sound
_SNDPLAY SND.UFOHit ' play the UFO explosion sound
END IF
END IF
END IF
ELSE ' no, UFO is currently inactive
UFO(p).Pause = UFO(p).Pause - 1 ' decrement the UFO pause timer
IF UFO(p).Pause = 0 THEN ' has the timer ended?
_SNDLOOP SND.UFOFlying ' yes, play the UFO flying sound
UFO(p).Active = TRUE ' activate the UFO
UFO(p).Pause = 1500 + INT(RND * 120) - INT(RND * 120) ' reset the UFO pause for 23 to 27 seconds
IF INT(RND * 2) = 1 THEN ' which direction should UFO come from?
UFO(p).Dir = 1 ' UFO will travel left to right
UFO(p).rect.x1 = 8 ' position UFO at left of screen
ELSE
UFO(p).Dir = -1 ' UFO will travel right to left
UFO(p).rect.x1 = 199 ' position UFO at right of screen
END IF
END IF
END IF
END SUB
'------------------------------------------------------------------------------------------------------------------------------------------------------------------+--------------+
SUB MoveInvaders (p AS INTEGER, Mode AS INTEGER) STATIC ' | MoveInvaders |
'+-------------------------------------------------------------------------------------------------------------------------------------------------------------+--------------+
'| Manages the wave motion of invaders across the screen |
'| p - current player |
'| Mode - signal to clear variables for a movement reset (CLEARVARIABLES or -1) |
'| NOTE: This subroutine retains values between calls (STATIC) |
'| |
'| Moves the invaders across the screen by simulating the "strobing" effect of an Intel 8080 barely able to keep up with the graphics. Only one invader is updated per frame |
'| of the game to achieve the slow CPU effect. As fewer invaders are alive this subroutine will simulate the speeding up effect of the invaders as if an 8080 CPU has less |
'| work to do. |
'| |
'| From: https://en.wikipedia.org/wiki/Space_Invaders |
'| |
'| "While programming the game, Nishikado discovered that the processor was able to render the alien graphics faster the fewer were on screen. Rather than design the game to |
'| compensate for the speed increase, he decided to keep it as a challenging gameplay mechanic." |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Invader() AS INVADERS ' need access to shared variables
SHARED Player() AS PLAYER
SHARED SND AS SOUNDS
SHARED Game AS GAME
DIM c(2) AS INTEGER ' column counter
DIM r(2) AS INTEGER ' row counter
DIM Down(2) AS INTEGER ' invader to move down flag
DIM Edge(2) AS INTEGER ' invader hit edge of screen flag
DIM Beat(2) AS INTEGER ' current heart throb sound to play
IF Mode = CLEARVARIABLES OR Game.Pause.Level THEN ' time to reset the movement variables?
c(p) = 0 ' yes, reset all movement variables
r(p) = 0
Down(p) = FALSE
Edge(p) = FALSE
Beat(p) = 0
EXIT SUB ' leave the subroutine
END IF
DO ' begin active invader search loop
c(p) = c(p) + 1 ' increment column counter
IF c(p) = 12 THEN ' has the last column been reached?
c(p) = 1 ' yes, reset the column counter
r(p) = r(p) - 1 ' decrement the row counter
END IF
IF r(p) = 0 THEN ' has the top row been reached?
r(p) = 5 ' yes, reset the row counter
IF Edge(p) THEN ' has the invader reached the edge of the screen?
Down(p) = TRUE ' yes, flag the invader for a downward movement
Edge(p) = FALSE ' reset the edge detection flag
ELSEIF Down(p) THEN ' no, has the invader been flagged for a downward movement?
Down(p) = FALSE ' yes, reset the downward movement flag
Player(p).idir = -Player(p).idir ' reverse the direction of the invaders
END IF
Beat(p) = Beat(p) + 1 ' increment the heart throb sound counter
IF Beat(p) = 5 THEN Beat(p) = 1 ' reset the counter when needed
SELECT CASE Beat(p) ' which sound to play?
CASE 1
_SNDPLAY SND.Beat1
CASE 2
_SNDPLAY SND.Beat2
CASE 3
_SNDPLAY SND.Beat3
CASE 4
_SNDPLAY SND.Beat4
END SELECT
END IF
LOOP UNTIL Invader(p, c(p), r(p)).Active ' leave when an active invader found
Invader(p, c(p), r(p)).cell = 1 - Invader(p, c(p), r(p)).cell ' toggle the invader animation cell
IF Down(p) THEN ' is this invader flagged for downward movement?
Invader(p, c(p), r(p)).rect.y1 = Invader(p, c(p), r(p)).rect.y1 + 8 ' yes, move the invader down one row
Invader(p, c(p), r(p)).rect.y2 = Invader(p, c(p), r(p)).rect.y2 + 8
ELSE ' no, move the invader right or left
Invader(p, c(p), r(p)).rect.x1 = Invader(p, c(p), r(p)).rect.x1 + Player(p).idir ' move the invader horizontally across screen
Invader(p, c(p), r(p)).rect.x2 = Invader(p, c(p), r(p)).rect.x2 + Player(p).idir
IF Invader(p, c(p), r(p)).rect.x1 <= 8 OR Invader(p, c(p), r(p)).rect.x2 >= 215 THEN Edge(p) = TRUE ' set the edge flag when an invader reaches side of screen
END IF
END SUB
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------+---------------+
SUB ResetInvaders (p AS INTEGER) ' | ResetInvaders |
'+------------------------------------------------------------------------------------------------------------------------------------------------------------+---------------+
'| Resets the invader start positions for the current level of the player |
'| p - player to reset invaders for |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Invader() AS INVADERS ' need access to shared variables
SHARED Player() AS PLAYER
DIM r AS INTEGER ' row counter
DIM c AS INTEGER ' column counter
DIM Level AS INTEGER ' current player level
Level = Player(p).Level ' get current player level
IF Level > 5 THEN Level = 5 ' keep the level at 5
DO ' begin invader row loop
r = r + 1 ' increment row counter
c = 0 ' reset column counter
DO ' begin invader column loop
c = c + 1 ' increment column counter
Invader(p, c, r).Active = TRUE ' activate this invader
Invader(p, c, r).rect.x1 = (16 * c) + 8 - Invader(p, c, r).Width \ 2 ' calculate position of invader on screen
Invader(p, c, r).rect.x2 = Invader(p, c, r).rect.x1 + Invader(p, c, r).Width - 1
Invader(p, c, r).rect.y1 = (32 + (r * 16)) + Level * 16
Invader(p, c, r).rect.y2 = Invader(p, c, r).rect.y1 + 7
Invader(p, c, r).cell = 0 ' reset invader animation cell
LOOP UNTIL c = 11 ' leave when all columns checked
LOOP UNTIL r = 5 ' leave when all rows checked
END SUB
'--------------------------------------------------------------------------------------------------------------------------+-------------------------------------+--+-------------+
SUB DrawShields (Mode AS INTEGER) ' | COLLISION: Shield and Laser or Bomb | | DrawShields |
'+---------------------------------------------------------------------------------------------------------------------+-------------------------------------+--+-------------+
'| Draws the player's shields to the screen and handles collisions between the shields and lasers or bombs |
'| Mode - How to handle drawing of the shields |
'| -1 (NEWGAME) - reset the shields for both players |
'| 0 (NEWLEVEL) - reset the shields for the current player |
'| 5 (INGAME) - manage the shields during game play |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Options AS OPTIONS ' need access to shared variables
SHARED IMG AS IMAGES
SHARED Shield() AS SHIELDS
SHARED Player() AS PLAYER
SHARED Display AS DISPLAY
SHARED Bomb() AS BOMB
SHARED Game AS GAME
DIM x AS INTEGER ' shield counter
DIM p AS INTEGER ' current player
DIM lx AS INTEGER ' location of laser hitting shield
DIM ly AS INTEGER
DIM scan AS INTEGER ' pixel perfect scanner
DIM rndx AS INTEGER ' random variance added to hit locations
DIM rndy AS INTEGER
DIM b AS INTEGER ' bomb counter
DIM shx AS INTEGER ' location of hit on shield
DIM shy AS INTEGER
p = Game.Player ' get current player
x = 1 ' set shield counter
DO ' begin shield loop
SELECT CASE Mode ' which mode was requested?
CASE NEWGAME ' a new game is beginning
_PUTIMAGE , IMG.Shield, Shield(PLAYER1, x).Image ' reset the shield images with undamaged images
_PUTIMAGE , IMG.Shield, Shield(PLAYER2, x).Image
CASE NEWLEVEL ' a new level is beginning for the current player
_PUTIMAGE , IMG.Shield, Shield(p, x).Image ' reset the shield images with undamaged images
CASE INGAME ' a game level is currently being played
_SETALPHA 0, BLACK, Shield(p, x).Image ' set the transparency color of shields
_PUTIMAGE (Shield(p, x).rect.x1, 192), Shield(p, x).Image ' draw the player's shield to the screen
'******************************************
'** Check for laser and shield collision **
'******************************************
IF Player(p).Laser.Active AND Player(p).Laser.Hit.Shield = 0 THEN ' if the player's laser flying and didn't hit a shield?
IF RectCollide(Player(p).Laser.rect, Shield(p, x).rect) THEN ' yes, did the laser hit the shield?
lx = Player(p).Laser.rect.x1 - Shield(p, x).rect.x1 ' yes, remember location of collision
ly = Player(p).Laser.rect.y1 - 192
scan = 0 ' reset pixel perfect scanner
_SOURCE Shield(p, x).Image ' work with shield image
_DEST Shield(p, x).Image
DO ' begin pixel perfect collision loop
IF POINT(lx, ly + scan) = WHITE THEN ' did this part of laser hit the shiled?
rndx = INT(RND * 2) - INT(RND * 2) ' yes, set some random variance in collision location
rndy = INT(RND * 2)
Player(p).Laser.Hit.ShieldX = Player(p).Laser.rect.x1 - 4 + rndx ' record location of collision on screen
Player(p).Laser.Hit.ShieldY = Player(p).Laser.rect.y1 - 3 + scan + rndy '
_PUTIMAGE (lx - 4 + rndx, ly - 3 + scan + rndy), IMG.LaserHitMask ' damage the shields
Player(p).Laser.Hit.Shield = 5 ' set count down timer
END IF
scan = scan + 1 ' move to next pixel location on laser
LOOP UNTIL scan = 4 OR Player(p).Laser.Hit.Shield ' leave when laser length scanned or a hit on shield occurred
_SOURCE Display.WorkScreen ' return back to the work display
_DEST Display.WorkScreen
END IF
END IF
'*****************************************
'** Check for bomb and shield collision **
'*****************************************
b = 0 ' reset bomb counter
DO ' begin bomb loop
b = b + 1 ' increment bomb counter
IF Bomb(b).Active AND Bomb(b).Hit.Shield = 0 THEN ' is this bomb dropping and not hit a shield?
IF RectCollide(Bomb(b).rect, Shield(p, x).rect) THEN ' yes, has the bomb hit a shield?
shx = Bomb(b).rect.x1 - Shield(p, x).rect.x1 ' yes, record location of collision
shy = Bomb(b).rect.y1 - 192
_SOURCE Shield(p, x).Image ' work with shield image
_DEST Shield(p, x).Image
scan = -1 ' reset pixel perfect scanner
DO ' begin pixel perfect collision loop
IF POINT(shx + scan, shy) = WHITE THEN ' did this part of bomb hit the shield?
rndy = INT(RND * 3) ' yes, set som random variance in collision location
Bomb(b).Hit.ShieldX = Bomb(b).rect.x1 - 2 ' record screen location of collision
Bomb(b).Hit.ShieldY = Bomb(b).rect.y1 - 4 + scan + rndy
_PUTIMAGE (shx - 2, shy - 4 + scan + rndy), IMG.BombHitMask ' damage the shields
Bomb(b).Hit.Shield = 5 ' set countdown timer
END IF
scan = scan + 1 ' move to next pixel location on bomb
LOOP UNTIL scan = 2 OR Bomb(b).Hit.Shield ' leave when bomb scanned or a hit on shield occurred
_SOURCE Display.WorkScreen ' return back to work display
_DEST Display.WorkScreen
END IF
END IF
LOOP UNTIL b = Player(p).MaxBombs ' leave when all bombs checked
END SELECT
x = x + 1 ' increment shield counter
LOOP UNTIL x > Options.Shields ' leave when all shields checked
END SUB
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------+---------------+
SUB StartNewLevel () ' | StartNewLevel |
'+------------------------------------------------------------------------------------------------------------------------------------------------------------+---------------+
'| Resets the variables in preparation for a new player level |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Player() AS PLAYER ' need access to shared variables
SHARED DropColumn() AS DROPCOLUMN
SHARED Game AS GAME
DIM p AS INTEGER ' current player
p = Game.Player ' get current player
Player(p).Level = Player(p).Level + 1 ' increment player level
IF Player(p).Level = 11 THEN Player(p).Level = 1 ' reset player level when level 11 reached
Player(p).idir = 2 ' reset invader movement
Player(p).Laser.Hit.Count = 0 ' reset invader hit count
Player(p).MaxBombs = Player(p).Level ' calculate maximum number of invader bombs allowed
IF Player(p).MaxBombs > 3 THEN Player(p).MaxBombs = 3 ' no more than 3 bombs allowed
MoveInvaders p, CLEARVARIABLES ' clear the invader movement variables
ResetInvaders p ' reset invader locations
END SUB
'------------------------------------------------------------------------------------------------------------------------------------------------------------------+--------------+
SUB StartNewGame () ' | StartNewGame |
'+-------------------------------------------------------------------------------------------------------------------------------------------------------------+--------------+
'| Resets the variables in preparation for a new game |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED DropColumn() AS DROPCOLUMN ' need access to shared variables
SHARED Player() AS PLAYER
SHARED UFO() AS UFO
SHARED Game AS GAME
RANDOMIZE TIMER ' seed the RND generator
Game.Player = 1 ' set the current player to player 1
Game.Landed = FALSE ' reset the invader landed flag
Player(1) = Player(0) ' reset player variables
Player(2) = Player(0)
UFO(1) = UFO(0) ' reset UFO variables
UFO(2) = UFO(0)
DrawShields NEWGAME ' restore the shield images
ResetInvaders PLAYER1 ' reset invader locations
ResetInvaders PLAYER2
MoveInvaders PLAYER1, CLEARVARIABLES ' clear the invader movement variables
MoveInvaders PLAYER2, CLEARVARIABLES
ResetBombs
' reset the bombs and drop columns
END SUB
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------+------------+
SUB Initialize () ' | Initialize |
'+---------------------------------------------------------------------------------------------------------------------------------------------------------------+------------+
'+ Initializes all variables upon power up |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Player() AS PLAYER ' need access to shared variables
SHARED Invader() AS INVADERS
SHARED Shield() AS SHIELDS
SHARED UFO() AS UFO
SHARED Bomb() AS BOMB
SHARED Options AS OPTIONS
SHARED Game AS GAME
DIM p AS INTEGER ' player counter
DIM c AS INTEGER ' column counter
DIM r AS INTEGER ' row counter
Game.Credits = 0 ' set in game settings
Game.Player = 1
Game.Players = 1
Game.Pause.Level = 0
Game.Pause.Die = 0
Game.Landed = FALSE
Bomb(0).rect.x1 = 0 ' set default bomb settings
Bomb(0).rect.y1 = 0
Bomb(0).rect.x2 = 0
Bomb(0).rect.y2 = 0
Bomb(0).Hit.Shield = 0
Bomb(0).Hit.ShieldX = 0
Bomb(0).Hit.ShieldY = 0
Bomb(0).Image = 1
Bomb(0).Cell = 1
Bomb(0).Active = FALSE
Bomb(0).Miss = 0
Bomb(1) = Bomb(0) ' set bomb settings to default
Bomb(2) = Bomb(0)
Bomb(3) = Bomb(0)
UFO(0).Score = 0 ' set default UFO settings
UFO(0).Pause = 1500
UFO(0).Active = FALSE
UFO(0).Dir = 1
UFO(0).rect.x1 = 8
UFO(0).rect.y1 = 32
UFO(0).rect.y2 = 39
UFO(1) = UFO(0) ' set UFO settings to default
UFO(2) = UFO(0)
Player(0).Ship.rect.y1 = 216 ' set default player settings
Player(0).Ship.rect.y2 = 223
Player(0).Ship.Dead = FALSE
Player(0).Ship.DeadX = 0
Player(0).Ship.DeadImage = 1
Player(0).Ship.Extra = FALSE
Player(0).Score = 0
Player(0).Ship.Remain = 3
Player(0).idir = 2
Player(0).Level = 1
Player(0).GameOver = FALSE
Player(0).MaxBombs = 1
Player(0).Laser.Active = FALSE
Player(0).Laser.ShotsFired = 0
Player(0).Laser.Hit.Count = 0
Player(0).Laser.Miss = 0
Player(0).Laser.Hit.Invader = 0
Player(0).Laser.Hit.InvaderX = 0
Player(0).Laser.Hit.InvaderY = 0
Player(0).Laser.Hit.Shield = 0
Player(0).Laser.Hit.ShieldX = 0
Player(0).Laser.Hit.ShieldY = 0
Player(0).Laser.Hit.Bomb = 0
Player(0).Laser.Hit.BombX = 0
Player(0).Laser.Hit.BombY = 0
Player(0).UFO = UFO(0)
Player(1) = Player(0) ' set player settings to default
Player(2) = Player(0)
RANDOMIZE TIMER ' seed the RND generator
DO ' begin player loop
p = p + 1 ' increment player counter
r = 0 ' reset row counter
DO ' begin invader row loop
r = r + 1 ' increment row counter
c = 0 ' reset column counter
DO ' begin invader column loop
c = c + 1 ' increment column counter
SELECT CASE r ' which row?
CASE 1 ' row 1 (top row)
Invader(p, c, r).Image = 1 ' set invader image
Invader(p, c, r).Width = 8 ' set invader width
Invader(p, c, r).Score = 30 ' set invader score
CASE 2 TO 3 ' rows 2 and 3
Invader(p, c, r).Image = 2
Invader(p, c, r).Width = 11
Invader(p, c, r).Score = 20
CASE 4 TO 5 ' rows 4 and 5 (bottom row)
Invader(p, c, r).Image = 3
Invader(p, c, r).Width = 12
Invader(p, c, r).Score = 10
END SELECT
LOOP UNTIL c = 11 ' leave when all columns processed
LOOP UNTIL r = 5 ' leave when all rows processed
Shield(p, 1).rect.x1 = 32 ' set first shield screen location
Shield(p, 1).rect.x2 = 57
SELECT CASE Options.Shields ' how many shields set in options?
CASE 3 ' 3 shields
Shield(p, 2).rect.x1 = 99 ' 2nd shield location
Shield(p, 2).rect.x2 = 124
Shield(p, 3).rect.x1 = 166 ' 3rd shield location
Shield(p, 3).rect.x2 = 191
CASE 4 ' 4 shields (default)
Shield(p, 2).rect.x1 = 77 ' 2nd shield location
Shield(p, 2).rect.x2 = 102
Shield(p, 3).rect.x1 = 121 ' 3rd shield location
Shield(p, 3).rect.x2 = 146
Shield(p, 4).rect.x1 = 166 ' 4th shield location
Shield(p, 4).rect.x2 = 191
CASE 5 ' 5 shields
Shield(p, 2).rect.x1 = 66 ' 2nd shield location
Shield(p, 2).rect.x2 = 91
Shield(p, 3).rect.x1 = 99 ' 3rd shield location
Shield(p, 3).rect.x2 = 124
Shield(p, 4).rect.x1 = 132 ' 4th shield location
Shield(p, 4).rect.x2 = 157
Shield(p, 5).rect.x1 = 166 ' 5th shield location
Shield(p, 5).rect.x2 = 191
CASE 6 ' 6 shields
Shield(p, 2).rect.x1 = 59 ' 2nd shield location
Shield(p, 2).rect.x2 = 84
Shield(p, 3).rect.x1 = 86 ' 3rd shield location
Shield(p, 3).rect.x2 = 111
Shield(p, 4).rect.x1 = 113 ' 4th shield location
Shield(p, 4).rect.x2 = 138
Shield(p, 5).rect.x1 = 140 ' 5th shield location
Shield(p, 5).rect.x2 = 165
Shield(p, 6).rect.x1 = 167 ' 6th shield location
Shield(p, 6).rect.x2 = 192
END SELECT
Shield(p, 1).rect.y1 = 192 ' set all shield Y locations
Shield(p, 1).rect.y2 = 207
Shield(p, 2).rect.y1 = 192
Shield(p, 2).rect.y2 = 207
Shield(p, 3).rect.y1 = 192
Shield(p, 3).rect.y2 = 207
Shield(p, 4).rect.y1 = 192
Shield(p, 4).rect.y2 = 207
Shield(p, 5).rect.y1 = 192
Shield(p, 5).rect.y2 = 207
Shield(p, 6).rect.y1 = 192
Shield(p, 6).rect.y2 = 207
LOOP UNTIL p = 2 ' leave when both players processed
END SUB
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------+----------+
SUB GetReady () ' | GetReady |
'+-----------------------------------------------------------------------------------------------------------------------------------------------------------------+----------+
'| Informs the player to get ready to play a game or take turns in a 2 player game |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Game AS GAME ' need access to shared variables
DIM Blink AS INTEGER ' blink toggle
DIM Pause AS INTEGER ' pause counter
Pause = 180 ' set 3 second pause
DO ' begin pause loop
_LIMIT 60 ' 60 frames per second
ClearDisplay INCOIN ' clear the display
IF Game.Frame MOD 5 = 0 THEN Blink = NOT Blink ' toggle blink flag every 5 frames
Text 13, 7, "PLAY PLAYER<" + _TRIM$(STR$(Game.Player)) + ">" ' print player notice
IF Blink THEN DrawScore Game.Player, INCOIN ' draw the score when flag set
IF Game.Players = 2 THEN ' is this a 2 player game?
IF Game.Player = 1 THEN DrawScore PLAYER2, INCOIN ELSE DrawScore PLAYER1, INCOIN ' yes, draw the other player's score non-blinking
END IF
UpdateDisplay INCOIN ' update the display with changes
Pause = Pause - 1 ' decrement count down timer
LOOP UNTIL Pause = 0 ' leave when timer ended
END SUB
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------+---------------+
SUB SelectPlayers () ' | SelectPlayers |
'+------------------------------------------------------------------------------------------------------------------------------------------------------------+---------------+
'| Allows the player to choose the number of players when a coin has been inserted into the game |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Game AS GAME ' need access to shared variables
DIM KeyPress AS INTEGER ' any key pressed
DO ' begin select loop
_LIMIT 30 ' 30 frames per second
ClearDisplay INSELECT ' clear the display
DrawScore BOTHPLAYERS, INSELECT ' draw the score of both players
DrawCredits ' draw number of credits in machine
DrawShipsRemaining ' draw the number of ships remaining for player 1
Text 12, 12, "PUSH" ' display text
IF Game.Credits = 1 THEN ' only 1 coin inserted?
Text 14, 4, "ONLY <1>PLAYER BUTTON" ' yes, display appropriate text
ELSE ' no, more than 1 coin
Text 14, 2, "<1> OR <2>PLAYERS BUTTON" ' display appropriate text
END IF
UpdateDisplay INSELECT ' update the display with changes
KeyPress = GetKey(INSELECT) ' get any key that may have been pressed
IF KeyPress = 49 THEN ' did player press the 1 key?
Game.Players = 1 ' yes, set the number of players
Game.Credits = Game.Credits - 1 ' subtract a credit from the game
PlayGame PLAYER1 ' player a 1 player game
ELSEIF KeyPress = 50 THEN ' no, did player press the 2 key?
IF Game.Credits > 1 THEN ' yes, is there more than 1 credit in game?
Game.Players = 2 ' yes, set number of players
Game.Credits = Game.Credits - 2 ' subtract 2 credits from game
PlayGame PLAYER2 ' play a two player game
END IF
ELSEIF KeyPress = 79 THEN ' did player press the O key?
SetOptions ' yes, go to set options screen
END IF
LOOP UNTIL Game.Credits = 0 ' leave when all credits have been used
END SUB
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------+----------+
SUB SlowText (Row AS INTEGER, Column AS INTEGER, Txt AS STRING, Mode AS INTEGER, KeyPress AS INTEGER) ' | SlowText |
'+-----------------------------------------------------------------------------------------------------------------------------------------------------------------+----------+
'| Displays text on screen slowly at 1/10th second per letter |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Font() AS LONG ' need access to shared variables
SHARED Game AS GAME
DIM c AS INTEGER ' column counter
DIM r AS INTEGER ' row counter
DIM p AS INTEGER ' text character position counter
r = Row * 8 ' yes, calculate text row
c = Column * 8 ' calculate text column
p = 0 ' reset character position counter
DO ' begin text loop
_LIMIT 60 ' 60 frames per second
KeyPress = GetKey(Mode) ' get any key pressed
IF Game.Frame MOD 6 = 0 THEN ' have 6 frames gone by? (1/10th second)
p = p + 1 ' yes, increment character position counter
_PUTIMAGE (c, r), Font(ASC(MID$(Txt, p, 1))) ' draw font character onto screen
c = c + 8 ' move to next text column
END IF
UpdateDisplay Mode ' update the display with changes
LOOP UNTIL p = LEN(Txt) OR KeyPress ' leave when text finished or a valid key pressed
END SUB
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------+------------+
SUB InsertCoin () ' | InsertCoin |
'+---------------------------------------------------------------------------------------------------------------------------------------------------------------+------------+
'| Plays the various intro screens while waiting for a coin to be inserted |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Font() AS LONG ' need access to shared variables
SHARED IMG AS IMAGES
SHARED IMG_Invader() AS LONG
SHARED IMG_Bomb() AS LONG
SHARED Display AS DISPLAY
SHARED Game AS GAME
DIM FlippedY AS INTEGER ' toggle used to flip between normal Y and flipped Y screens
DIM AddedC AS INTEGER ' toggle used to flip between normal C and added C screens
DIM KeyPress AS INTEGER ' contains any key pressed by player
DIM Bcycle AS INTEGER ' bomb animation cycler
DIM ShowQB64 AS INTEGER ' toogle used to flip showing QB64 screen or not
DIM x AS INTEGER ' generic counter
DIM Flip AS INTEGER ' invader animation cycler
DO ' begin key check loop
FlippedY = TRUE ' set initial state of toggles
AddedC = TRUE
ShowQB64 = FALSE
DO ' begin insert coin animation loop
FlippedY = NOT FlippedY ' toggle flipped Y screen
ClearDisplay INCOIN ' clear the display
DrawScore BOTHPLAYERS, INCOIN ' draw the score of both players
DrawCredits ' draw number of credits in machine
DrawShipsRemaining ' draw the number of ships remaining
IF NOT FlippedY THEN ' show the flipped Y screen?
SlowText 8, 12, "PLAY", INCOIN, KeyPress: IF KeyPress THEN EXIT DO ' no, display text and exit if key pressed
_PUTIMAGE , Display.WorkScreen, Display.CorrectY, (0, 64)-(223, 71) ' get an image of non-flipped Y
ELSE ' yes, show the slipped Y screen
SlowText 8, 12, "PLA ", INCOIN, KeyPress: IF KeyPress THEN EXIT DO ' display text and exit if key pressed
_PUTIMAGE , Display.WorkScreen, Display.WithoutY, (0, 64)-(223, 71) ' get an image of the Y missing
_PUTIMAGE (127, 70)-(120, 63), Font(89) ' draw an upside down Y
_PUTIMAGE , Display.WorkScreen, Display.WithY, (0, 64)-(223, 71) ' get an image of the upside down Y
END IF
SlowText 11, 7, "SPACE INVADERS", INCOIN, KeyPress: IF KeyPress THEN EXIT DO ' display text and exit if key pressed
SLEEP 1 ' pause for 1 second
Text 15, 4, "*SCORE ADVANCE TABLE*" ' display text
_PUTIMAGE (64, 136), IMG.UFO: Text 17, 10, "=" ' display UFO=
_PUTIMAGE (68, 152), IMG_Invader(1, 1): Text 19, 10, "=" ' display invaders and =
_PUTIMAGE (67, 168), IMG_Invader(2, 0): Text 21, 10, "="
_PUTIMAGE (66, 184), IMG_Invader(3, 1): Text 23, 10, "="
SlowText 17, 11, "? MYSTERY", INCOIN, KeyPress: IF KeyPress THEN EXIT DO ' display point values and exit if key pressed
SlowText 19, 11, "30 POINTS", INCOIN, KeyPress: IF KeyPress THEN EXIT DO
SlowText 21, 11, "20 POINTS", INCOIN, KeyPress: IF KeyPress THEN EXIT DO
SlowText 23, 11, "10 POINTS", INCOIN, KeyPress: IF KeyPress THEN EXIT DO
IF FlippedY THEN ' has the Y been flipped?
FOR x = 240 TO 124 STEP -2 ' yes, cycle from right of screen to left
_LIMIT 30 ' loop will run at 30 frames per second
_PUTIMAGE (0, 64), Display.WithY ' show image with flipped Y
_PUTIMAGE (x + 4, 64), IMG_Invader(1, Flip) ' show invader on screen at x coordinate
Flip = 1 - Flip ' flip between invader images (0 to 1)
DrawScore BOTHPLAYERS, INCOIN ' draw the score of both players
DrawCredits ' draw number of credits in machine
DrawShipsRemaining ' draw the number of ships remaining
UpdateDisplay INCOIN ' show results on display screen
KeyPress = GetKey(INCOIN): IF KeyPress THEN EXIT DO ' leave if a key has been pressed
NEXT x
FOR x = 124 TO 240 STEP 2 ' cycle back to the right of screen
_LIMIT 30 ' loop will run at 30 frames per second
_PUTIMAGE (0, 64), Display.WithoutY ' show image without a Y
_PUTIMAGE (x + 4, 64), IMG_Invader(1, Flip) ' place invader at x location
_PUTIMAGE (x + 3, 70)-(x - 4, 63), Font(89) ' place flipped Y behind invader
Flip = 1 - Flip ' flip between invader images (0 to 1)
DrawScore BOTHPLAYERS, INCOIN ' draw the score of both players
DrawCredits ' draw number of credits in machine
DrawShipsRemaining ' draw the number of ships remaining
UpdateDisplay INCOIN ' show results on display screen
KeyPress = GetKey(INCOIN): IF KeyPress THEN EXIT DO ' leave if a key has been pressed
NEXT x
FOR x = 240 TO 124 STEP -2 ' cycle from right of screen to left
_LIMIT 30 ' loop will run at 30 frames per second
_PUTIMAGE (0, 64), Display.WithoutY ' show image without a Y
_PUTIMAGE (x + 4, 64), IMG_Invader(1, Flip) ' place invader at x location
_PUTIMAGE (x - 4, 64), Font(89) ' place regular Y in front of invader
Flip = 1 - Flip ' flip between invader images (0 to 1)
DrawScore BOTHPLAYERS, INCOIN ' draw the score of both players
DrawCredits ' draw number of credits in machine
DrawShipsRemaining ' draw the number of ships remaining
UpdateDisplay INCOIN ' show results on display screen
KeyPress = GetKey(INCOIN): IF KeyPress THEN EXIT DO ' leave if a key has been pressed
NEXT x
_PUTIMAGE (0, 64), Display.CorrectY ' show image with correct Y
SLEEP 1 ' pause for 1 second
UpdateDisplay INCOIN ' show result on display screen
END IF
SLEEP 2 ' pause for 2 seconds
'** PLAY DEMO **
AddedC = NOT AddedC ' toggle added C screen
ClearDisplay INCOIN ' clear the display
DrawScore BOTHPLAYERS, INCOIN ' draw the score of both players
DrawCredits ' draw number of credits in machine
DrawShipsRemaining ' draw the number of ships remaining
Text 14, 8, "INSERT COIN" ' display text
_PUTIMAGE , Display.WorkScreen, Display.NormalC, (0, 32)-(223, 119) ' get an image without an extra C
IF AddedC THEN ' time to add an extra C?
Text 14, 15, "C" ' yes, display another C
_PUTIMAGE , Display.WorkScreen, Display.AddedC, (0, 32)-(223, 119) ' get an image with the extra C
END IF
SlowText 18, 6, "<1 OR 2 PLAYERS>", INCOIN, KeyPress: IF KeyPress THEN EXIT DO ' display text and exit if key pressed
SlowText 21, 6, "*1 PLAYER 1 COIN", INCOIN, KeyPress: IF KeyPress THEN EXIT DO
SlowText 24, 6, "*2 PLAYERS 2 COINS", INCOIN, KeyPress: IF KeyPress THEN EXIT DO
IF AddedC THEN ' has an extra C been added?
Flip = 1 ' yes, reset invader image flip
FOR x = -16 TO 120 STEP 2 ' start from left side of screen to right
_LIMIT 30 ' limit loop to 30 frames per second
_PUTIMAGE (0, 32), Display.AddedC ' show image with the extra C
_PUTIMAGE (x, 32), IMG_Invader(1, Flip) ' place moving invader on screen
Flip = 1 - Flip ' flip between invader images (0 to 1)
UpdateDisplay INCOIN ' show results on display screen
KeyPress = GetKey(INCOIN): IF KeyPress THEN EXIT DO ' leave if a key has been pressed
NEXT x
_DELAY .125 ' pause for 1/8th second
Bcycle = 1 ' reset bomb image cycler
FOR x = 40 TO 108 STEP 2 ' cycle from under invader to letter C
_LIMIT 30 ' limit loop to 30 frames per second
_PUTIMAGE (0, 32), Display.AddedC ' show image with the extra C
_PUTIMAGE (120, 32), IMG_Invader(1, Flip) ' place stationary invader on screen
_PUTIMAGE (123, x), IMG_Bomb(1, Bcycle) ' place moving bomb on screen
Bcycle = Bcycle + 1 ' cycle to next bomb image
IF Bcycle = 4 THEN Bcycle = 0 ' cycle back to 1 if needed
UpdateDisplay INCOIN ' show results on display screen
KeyPress = GetKey(INCOIN): IF KeyPress THEN EXIT DO ' leave if a key has been pressed
NEXT x
_PUTIMAGE (0, 32), Display.NormalC ' show image without the extra C
_PUTIMAGE (122, 112), IMG.BombHit ' place bomb hit explosion over C
_PUTIMAGE (120, 32), IMG_Invader(1, Flip) ' place stationary invader on screen
UpdateDisplay INCOIN ' show results on display screen
_DELAY .0625 ' pause for 1/16th second
_PUTIMAGE (0, 32), Display.NormalC ' show image without the extra C
_PUTIMAGE (120, 32), IMG_Invader(1, Flip) ' place stationary invader on screen
UpdateDisplay INCOIN ' show results on display screen
END IF
SLEEP 2 ' pause for 2 seconds
ShowQB64 = NOT ShowQB64 ' toggle QB64 screen
IF ShowQB64 THEN ' time to show QB64 screen?
ClearDisplay INCOIN ' yes, clear the display
DrawScore BOTHPLAYERS, INCOIN ' draw the score of both players
DrawCredits ' draw number of credits in machine
DrawShipsRemaining ' draw the number of ships remaining
_PUTIMAGE (75, 71), IMG.QB64PE ' show QB64PE image
SlowText 5, 8, "Created With", INCOIN, KeyPress: IF KeyPress THEN EXIT DO ' draw credits and leave if a key pressed
SlowText 7, 11, "QB64PE", INCOIN, KeyPress: IF KeyPress THEN EXIT DO
SlowText 19, 4, "www.qb64phoenix.com", INCOIN, KeyPress: IF KeyPress THEN EXIT DO
SlowText 21, 7, "QB64 remake by", INCOIN, KeyPress: IF KeyPress THEN EXIT DO
SlowText 23, 7, "TERRY RITCHIE", INCOIN, KeyPress: IF KeyPress THEN EXIT DO
SlowText 25, 3, "quickbasic64@gmail.com", INCOIN, KeyPress: IF KeyPress THEN EXIT DO
SLEEP 4 ' pause for 4 seconds
KeyPress = GetKey(INCOIN): IF KeyPress THEN EXIT DO ' leave if a key has been pressed
END IF
LOOP
IF KeyPress = 79 THEN SetOptions ' go to options screen if O key pressed
LOOP UNTIL KeyPress = 67 ' leave when C key pressed
END SUB
'------------------------------------------------------------------------------------------------------------------------------------------------------------------+--------------+
SUB SetupDisplay () ' | SetupDisplay |
'+-------------------------------------------------------------------------------------------------------------------------------------------------------------+--------------+
'+ Sets up the display screen according to options selected |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Options AS OPTIONS ' need access to shared variables
SHARED Display AS DISPLAY
SHARED IMG AS IMAGES
DIM TmpScreen AS LONG ' temporary screen image if needed
DIM IMG_Icon AS LONG ' window icon image
DIM Xclicked AS INTEGER ' window X close trap
IF _FULLSCREEN THEN _FULLSCREEN _OFF ' leave full screen if currently enabled
IF Display.Screen THEN ' has a window already been created?
TmpScreen = _NEWIMAGE(1, 1, 32) ' yes, create a temporary new window
SCREEN TmpScreen ' change to the new window
_FREEIMAGE Display.Screen ' remove old window image from RAM
END IF
IF Options.Bezel THEN ' is the bezel selected to display?
Display.Screen = _NEWIMAGE(640 * Options.ScreenSize, 360 * Options.ScreenSize, 32) ' yes, make the display screen the size of the bezel
_PUTIMAGE , Display.Bezel, Display.Screen ' place the bezel image onto the display screen
Display.Bez.x1 = 208 * Options.ScreenSize ' calculate the location of the work screen coordinates within the bezel image
Display.Bez.y1 = 74 * Options.ScreenSize
Display.Bez.x2 = Display.Bez.x1 + 224 * Options.ScreenSize
Display.Bez.y2 = Display.Bez.y1 + 248 * Options.ScreenSize
ELSE ' no, no bezel image to be used
Display.Screen = _NEWIMAGE(224 * Options.ScreenSize, 248 * Options.ScreenSize, 32) ' create player display screen based on size of game screen
END IF
SCREEN Display.Screen ' create game window
_DELAY .5
_SCREENMOVE _MIDDLE ' move game screen to center of desktop
IMG_Icon = _LOADIMAGE("siicon.bmp", 32) ' load window icon
_ICON IMG_Icon ' set window icon
_FREEIMAGE IMG_Icon ' icon image no longer needed
_TITLE "QB64 Space Invaders" ' set window title
IF TmpScreen THEN _FREEIMAGE TmpScreen ' remove temporary image if created
IF Options.FullScreen THEN _FULLSCREEN _SQUAREPIXELS , _SMOOTH ' go full screen if option set
_DEST Display.WorkScreen ' game updates take place on this screen
_SOURCE Display.WorkScreen ' game updates take place on this screen
CLS , BLACK ' clear the screen with black background
Xclicked = _EXIT ' trap the window X close button
END SUB
'------------------------------------------------------------------------------------------------------------------------------------------------------------------+--------------+
SUB ClearDisplay (Mode AS INTEGER) ' | ClearDisplay |
'+-------------------------------------------------------------------------------------------------------------------------------------------------------------+--------------+
'| Clears the display according to mode requested |
'| Mode - 5 (INGAME), 2 (INCOIN), 3 (INSELECT) - clear with background or colored foil |
'| 1 (INOPTIONS) - clear completely to black |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Options AS OPTIONS ' need access to shared variables
SHARED Display AS DISPLAY
SELECT CASE Mode ' which type of screen clear needs to be done?
CASE INGAME, INCOIN, INSELECT ' game screen is currently showing
IF Options.Background THEN ' is the option to show a background image set?
_PUTIMAGE , Display.Background ' yes, clear the working screen with the background image
ELSE ' no, no background image is to be used
CLS , BLACK ' clear the working screen with solid black
LINE (0, 24)-(223, 55), _RGB32(255, 0, 0, 20), BF ' simulate the foil strips that were placed over
LINE (0, 184)-(223, 239), _RGB32(0, 255, 0, 15), BF ' the screen in arcades to give the illusion that
LINE (16, 240)-(135, 247), _RGB32(0, 255, 0, 15), BF ' the game was in color
END IF
CASE INOPTIONS ' options screen is currently showing
CLS , BLACK ' clear the screen in black
_PUTIMAGE , Display.OptionScreen, Display.WorkScreen ' place the option screen onto the work screen
END SELECT
END SUB
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------+---------------+
SUB UpdateDisplay (Mode AS INTEGER) ' | UpdateDisplay |
'+------------------------------------------------------------------------------------------------------------------------------------------------------------+---------------+
'| Updates the display with changes according to mode requested |
'| Mode - 5 (INGAME), 2 (INCOIN), 3 (INSELECT) - display high score, line under player, and apply color strips |
'| 1 (INOPTIONS) - just copy work screen to work mask, no changes |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Game AS GAME ' need access to shared variables
SHARED Display AS DISPLAY
SHARED Options AS OPTIONS
Game.Frame = Game.Frame + 1 ' increment master game frame counter
IF Game.Frame = 32761 THEN Game.Frame = 1 ' reset master game frame counter when needed
SELECT CASE Mode ' which type of screen update needs to be done?
CASE INGAME, INCOIN, INSELECT ' game screen is currently showing
Text 0, 1, "SCORE<1> HI-SCORE SCORE<2>" ' draw high score text
Text 2, 11, RIGHT$("00000" + _TRIM$(STR$(Game.HighScore)), 5)
LINE (0, 237)-(223, 237), WHITE ' draw line under player
_PUTIMAGE , Display.ColorMask, Display.WorkMask ' place color strips onto a temporary image
_SETALPHA 0, WHITE, Display.WorkScreen ' make white the transparent color of the working screen
_PUTIMAGE , Display.WorkScreen, Display.WorkMask ' place the working screen onto the color strips
CASE INOPTIONS ' options screen is currently showing
_PUTIMAGE , Display.WorkScreen, Display.WorkMask ' place the working screen onto a temporary image
END SELECT
IF Options.Bezel THEN ' is the bezel selected to be displayed?
_PUTIMAGE (Display.Bez.x1, Display.Bez.y1)-(Display.Bez.x2, Display.Bez.y2), Display.WorkMask, Display.Screen ' yes, place screen inside bezel image
ELSE ' no, no bezel image is to be shown
_PUTIMAGE , Display.WorkMask, Display.Screen ' place the temporary image onto the player's view screen
END IF
_DISPLAY ' update the player's display screen with changes
END SUB
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------+------------+
SUB LoadAssets () ' | LoadAssets |
'+---------------------------------------------------------------------------------------------------------------------------------------------------------------+------------+
'| Load the game's graphics and sound files |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED IMG AS IMAGES ' need access to shared variables
SHARED SND AS SOUNDS
SHARED Font() AS LONG
SHARED IMG_Invader() AS LONG
SHARED IMG_Bomb() AS LONG
SHARED IMG_Ship() AS LONG
SHARED Shield() AS SHIELDS
SHARED Display AS DISPLAY
DIM IMG_SpriteSheet AS LONG ' image sprite sheet
DIM x AS INTEGER ' generic counter
DIM y AS INTEGER ' generic counter
SND.Beat1 = _SNDOPEN("sibeat1.ogg") ' beat 1 sound
SND.Beat2 = _SNDOPEN("sibeat2.ogg") ' beat 2 sound
SND.Beat3 = _SNDOPEN("sibeat3.ogg") ' beat 3 sound
SND.Beat4 = _SNDOPEN("sibeat4.ogg") ' beat 4 sound
SND.InvaderHit = _SNDOPEN("siidead.ogg") ' invader explosion sound
SND.PlayerHit = _SNDOPEN("sipdead.ogg") ' player explosion sound
SND.UFOHit = _SNDOPEN("siudead.ogg") ' ufo explosion sound
SND.UFOFlying = _SNDOPEN("siufofly.ogg") ' ufo flying sound
SND.Laser = _SNDOPEN("silaser.ogg") ' player shooting sound
SND.Coin = _SNDOPEN("sicoin.ogg") ' coin dropping sound
SND.Extra = _SNDOPEN("siextra.ogg") ' extra ship sound
IMG.QB64PE = _NEWIMAGE(73, 73, 32) ' create image containers
IMG.DipSwitch = _NEWIMAGE(16, 36, 32)
IMG.UFO = _NEWIMAGE(16, 8, 32)
IMG.InvaderHit = _NEWIMAGE(14, 8, 32)
IMG.BombHit = _NEWIMAGE(6, 8, 32)
IMG.BombHitMask = _NEWIMAGE(6, 8, 32)
IMG.LaserHit = _NEWIMAGE(8, 8, 32)
IMG.LaserHitMask = _NEWIMAGE(8, 8, 32)
IMG.Shield = _NEWIMAGE(26, 16, 32)
IMG_Ship(-1) = _NEWIMAGE(16, 8, 32)
IMG_Ship(0) = _NEWIMAGE(13, 8, 32)
IMG_Ship(1) = _NEWIMAGE(16, 8, 32)
IMG_Invader(1, 0) = _NEWIMAGE(8, 8, 32)
IMG_Invader(1, 1) = _NEWIMAGE(8, 8, 32)
IMG_Invader(2, 0) = _NEWIMAGE(11, 8, 32)
IMG_Invader(2, 1) = _NEWIMAGE(11, 8, 32)
IMG_Invader(3, 0) = _NEWIMAGE(12, 8, 32)
IMG_Invader(3, 1) = _NEWIMAGE(12, 8, 32)
Display.Bezel = _NEWIMAGE(1920, 1080, 32)
Display.Screen = _NEWIMAGE(224, 248, 32)
Display.WorkScreen = _NEWIMAGE(224, 248, 32)
Display.WorkMask = _NEWIMAGE(224, 248, 32)
Display.ColorMask = _NEWIMAGE(224, 248, 32)
Display.Background = _NEWIMAGE(896, 992, 32)
Display.OptionScreen = _NEWIMAGE(224, 248, 32)
Display.WithY = _NEWIMAGE(224, 8, 32)
Display.WithoutY = _NEWIMAGE(224, 8, 32)
Display.CorrectY = _NEWIMAGE(224, 8, 32)
Display.AddedC = _NEWIMAGE(224, 88, 32)
Display.NormalC = _NEWIMAGE(224, 88, 32)
FOR x = PLAYER1 TO PLAYER2
FOR y = 1 TO 6
Shield(x, y).Image = _NEWIMAGE(26, 16, 32) ' 6 shield image containers
NEXT y
NEXT x
IMG_Bomb(1, 0) = _NEWIMAGE(3, 8, 32)
IMG_Bomb(1, 1) = _NEWIMAGE(3, 8, 32)
IMG_Bomb(1, 2) = _NEWIMAGE(3, 8, 32)
IMG_Bomb(1, 3) = _NEWIMAGE(3, 8, 32)
IMG_Bomb(2, 0) = _NEWIMAGE(3, 8, 32)
IMG_Bomb(2, 1) = _NEWIMAGE(3, 8, 32)
IMG_Bomb(2, 2) = _NEWIMAGE(3, 8, 32)
IMG_Bomb(2, 3) = _NEWIMAGE(3, 8, 32)
IMG_Bomb(3, 0) = _NEWIMAGE(3, 8, 32)
IMG_SpriteSheet = _LOADIMAGE("sisprites.png", 32) ' load the sprite sheet
_SETALPHA 0, BLACK, IMG_SpriteSheet ' make black transparent
_PUTIMAGE , IMG_SpriteSheet, IMG.QB64PE, (848, 200)-(920, 272) ' get qb64pe logo
_PUTIMAGE , IMG_SpriteSheet, Display.ColorMask, (400, 200)-(623, 447) ' get color mask
_PUTIMAGE , IMG_SpriteSheet, Display.OptionScreen, (624, 200)-(847, 447) ' get dip switch screen
_DEST IMG_SpriteSheet ' draw on sprite sheet
LINE (400, 200)-(920, 447), BLACK, BF ' remove images from inside of bezel
_PUTIMAGE , IMG_SpriteSheet, Display.Bezel, (0, 8)-(1919, 1087) ' get bezel image
_PUTIMAGE , IMG_SpriteSheet, Display.Background, (1920, 8)-(2815, 999) ' get background image
_PUTIMAGE , Display.OptionScreen, IMG.DipSwitch, (16, 32)-(31, 67) ' get single dip switch
_PUTIMAGE , IMG_SpriteSheet, IMG_Invader(1, 0), (0, 0)-(7, 7) ' get invader 1 image cell 1
_PUTIMAGE , IMG_SpriteSheet, IMG_Invader(1, 1), (8, 0)-(15, 7) ' get invader 1 image cell 2
_PUTIMAGE , IMG_SpriteSheet, IMG_Invader(2, 0), (16, 0)-(26, 7) ' get invader 2 image cell 1
_PUTIMAGE , IMG_SpriteSheet, IMG_Invader(2, 1), (27, 0)-(37, 7) ' get invader 2 image cell 2
_PUTIMAGE , IMG_SpriteSheet, IMG_Invader(3, 0), (38, 0)-(49, 7) ' get invader 3 image cell 1
_PUTIMAGE , IMG_SpriteSheet, IMG_Invader(3, 1), (50, 0)-(61, 7) ' get invader 3 image cell 2
_PUTIMAGE , IMG_SpriteSheet, IMG.UFO, (62, 0)-(77, 7) ' get UFO image
_PUTIMAGE , IMG_SpriteSheet, IMG_Ship(-1), (91, 0)-(106, 7) ' get exploding player ship image cell 1
_PUTIMAGE , IMG_SpriteSheet, IMG_Ship(0), (78, 0)-(90, 7) ' get player ship image
_PUTIMAGE , IMG_SpriteSheet, IMG_Ship(1), (107, 0)-(122, 7) ' get exploding player ship image cell 2
_PUTIMAGE , IMG_SpriteSheet, IMG.InvaderHit, (123, 0)-(136, 7) ' get exploding invader image
_PUTIMAGE , IMG_SpriteSheet, IMG.BombHit, (137, 0)-(142, 7) ' get laser/bomb exploding hit image
_SOURCE IMG.BombHit ' image used on display screen
_DEST IMG.BombHitMask ' image used to destroy shields
CLS , BLACK ' clear image in black
FOR x = 0 TO 5 ' cycle through columns
FOR y = 0 TO 7 ' cycle through rows
IF POINT(x, y) <> WHITE THEN ' is pixel at x,y white?
PSET (x, y), WHITE ' no, draw white pixel on mask
END IF ' (this creates a "negative" or mask
NEXT y ' of the IMG.bombhit image)
NEXT x
_SETALPHA 0, WHITE, IMG.BombHitMask ' make white transparent
_PUTIMAGE , IMG_SpriteSheet, IMG.LaserHit, (143, 0)-(150, 7) ' get laser exploding miss image
_SOURCE IMG.LaserHit ' image used on display screen
_DEST IMG.LaserHitMask ' image used to destroy shields
CLS , BLACK ' clear image in black
FOR x = 0 TO 7 ' cycle through columns
FOR y = 0 TO 7 ' cycle through rows
IF POINT(x, y) <> WHITE THEN ' is pixel at x,y white?
PSET (x, y), WHITE ' no, draw white pixel on mask
END IF ' (this creates a "negative" or mask
NEXT y ' of the IMG.laserhit image)
NEXT x
_SETALPHA 0, WHITE, IMG.LaserHitMask ' set white as transparent
_PUTIMAGE (0, 0), IMG_SpriteSheet, IMG.Shield, (154, 0)-(166, 7) ' get upper left shield image
_PUTIMAGE (13, 0), IMG_SpriteSheet, IMG.Shield, (167, 0)-(179, 7) ' get upper right shield image
_PUTIMAGE (0, 8), IMG_SpriteSheet, IMG.Shield, (186, 0)-(198, 7) ' get lower left shield image
_PUTIMAGE (13, 8), IMG_SpriteSheet, IMG.Shield, (199, 0)-(211, 7) ' get lower right shield image
_SETALPHA 0, BLACK, IMG.Shield ' add transparency to shield image
_PUTIMAGE , IMG_SpriteSheet, IMG_Bomb(1, 0), (215, 0)-(217, 7) ' get bomb 1 image cell 1
_PUTIMAGE , IMG_SpriteSheet, IMG_Bomb(1, 1), (218, 0)-(220, 7) ' get bomb 1 image cell 2
_PUTIMAGE , IMG_SpriteSheet, IMG_Bomb(1, 2), (221, 0)-(223, 7) ' get bomb 1 image cell 3
_PUTIMAGE , IMG_SpriteSheet, IMG_Bomb(1, 3), (224, 0)-(226, 7) ' get bomb 1 image cell 4
_PUTIMAGE , IMG_SpriteSheet, IMG_Bomb(2, 0), (227, 0)-(229, 7) ' get bomb 2 image cell 1
_PUTIMAGE , IMG_SpriteSheet, IMG_Bomb(2, 1), (230, 0)-(232, 7) ' get bomb 2 image cell 2
_PUTIMAGE , IMG_SpriteSheet, IMG_Bomb(2, 2), (233, 0)-(235, 7) ' get bomb 2 image cell 3
_PUTIMAGE , IMG_SpriteSheet, IMG_Bomb(2, 3), (236, 0)-(238, 7) ' get bomb 2 image cell 4
_PUTIMAGE , IMG_SpriteSheet, IMG_Bomb(3, 0), (239, 0)-(241, 7) ' get bomb 3 image cell 1
IMG_Bomb(3, 1) = _COPYIMAGE(IMG_Bomb(1, 0)) ' copy bomb 3 image cell 2
IMG_Bomb(3, 2) = _COPYIMAGE(IMG_Bomb(3, 0)) ' copy bomb 3 image cell 3
IMG_Bomb(3, 3) = _COPYIMAGE(IMG_Bomb(1, 2)) ' copy bomb 3 image cell 4
FOR x = 1 TO 255 ' cycle through 255 font images
Font(x) = _NEWIMAGE(8, 8, 32) ' create font image container
_PUTIMAGE (0, 0), IMG_SpriteSheet, Font(x), ((x - 1) * 8 + 242, 0)-(((x - 1) * 8 + 242) + 7, 7)
NEXT x ' get font character fron sprite sheet
_FREEIMAGE IMG_SpriteSheet ' remove spritesheet from RAM
END SUB
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------+-------------+
SUB LoadOptions () ' | LoadOptions |
'+--------------------------------------------------------------------------------------------------------------------------------------------------------------+-------------+
'| Load the game options from the options file. If the file does not exist create one with default settings. |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Options AS OPTIONS ' need access to shared variables
SHARED Game AS GAME
IF _FILEEXISTS("si.sav") THEN ' does the options file exist?
OPEN "si.sav" FOR INPUT AS #1 ' yes, open the file for reading
INPUT #1, Options.Switches ' get the saved DIP switch settings
INPUT #1, Game.HighScore ' get the save high score
CLOSE #1 ' close the options file
ELSE ' no, the options file does not exist
Options.Switches = 215 ' set DIP switches to default settings
SaveOptions ' save the options
END IF
IF Options.Switches AND 128 THEN Options.FreePlay = FALSE ELSE Options.FreePlay = TRUE ' set free play according to DIP switch setting
IF Options.Switches AND 64 THEN Options.ExtraShip = 1500 ELSE Options.ExtraShip = 1000 ' set extra ship value according to DIP switch setting
IF (Options.Switches AND 48) = 48 THEN ' are DIP switches 3 and 4 on?
Options.Shields = 6 ' yes, 6 shields will be used
ELSEIF Options.Switches AND 32 THEN ' no, is DIP switch 3 on?
Options.Shields = 5 ' yes, 5 shields will be used
ELSEIF Options.Switches AND 16 THEN ' no, is DIP switch 4 on?
Options.Shields = 4 ' yes, 4 shields will be used
ELSE ' no, neither DIP switch 3 or 4 is on
Options.Shields = 3 ' 3 shields will be used
END IF
Options.FullScreen = FALSE ' assume full screen mode is disabled
IF (Options.Switches AND 12) = 12 THEN ' are DIP switches 5 and 6 on?
Options.FullScreen = TRUE ' yes, full screen mode activated
Options.ScreenSize = 3 ' game screen will be 3X size full screen
ELSEIF Options.Switches AND 8 THEN ' no, is DIP switch 5 on?
Options.ScreenSize = 3 ' yes, game screen will be 3X size windowed
ELSEIF Options.Switches AND 4 THEN ' no, is DIP switch 6 on?
Options.ScreenSize = 2 ' yes, game screen will be 2X size windowed
ELSE ' no, neither DIP switch 5 or 6 is on
Options.ScreenSize = 1 ' game screen will be 1X size windowed
END IF
IF Options.Switches AND 2 THEN Options.Background = TRUE ELSE Options.Background = FALSE ' set background image according to DIP switch setting
IF Options.Switches AND 1 THEN Options.Bezel = TRUE ELSE Options.Bezel = FALSE ' set bezel image according to DIP switch setting
IF (Options.Bezel = FALSE) AND Options.FullScreen THEN Options.ScreenSize = 4 ' use a 4x screen size for full screen without the bezel
SetupDisplay ' set the dsiplay according to chosen options
END SUB
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------+-------------+
SUB SaveOptions () ' | SaveOptions |
'+--------------------------------------------------------------------------------------------------------------------------------------------------------------+-------------+
'| Save the game's options and high score to the options file |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Options AS OPTIONS ' need access to shared variables
SHARED Game AS GAME
OPEN "si.sav" FOR OUTPUT AS #1 ' create a file to write to
PRINT #1, Options.Switches ' write the current options to the file
PRINT #1, Game.HighScore ' write the high score to the file
CLOSE #1 ' close the file
END SUB
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------+------------+
SUB SetOptions () ' | SetOptions |
'+---------------------------------------------------------------------------------------------------------------------------------------------------------------+------------+
'| Displays the options screen allowing the player to select options |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Options AS OPTIONS ' need access to shared variables
SHARED IMG AS IMAGES
SHARED Game AS GAME
SHARED SND AS SOUNDS
DIM KeyPress AS INTEGER ' a key that was pressed
DO ' begin display loop
_LIMIT 30 ' limit to 30 frames per second
ClearDisplay INOPTIONS ' clear the screen
IF Options.Switches AND 128 THEN ' is switch 1 on?
Text 14, 1, "1: COIN REQUIRED TO PLAY" ' yes, display text
_PUTIMAGE (31, 67)-(16, 32), IMG.DipSwitch ' flip switch 1 to on position
ELSE ' no, switch 1 is off
Text 14, 1, "1: GAME SET TO FREE PLAY" ' display text
END IF
IF Options.Switches AND 64 THEN ' is switch 2 on?
Text 16, 1, "2: EXTRA SHIP AT 1500" ' yes, display text
_PUTIMAGE (57, 67)-(42, 32), IMG.DipSwitch ' flip switch 2 to on position
ELSE ' no, switch 2 is off
Text 16, 1, "2: EXTRA SHIP AT 1000" ' display text
END IF
IF (Options.Switches AND 48) = 48 THEN ' are switches 3 and 4 on?
Text 18, 1, "3: SIX BASES DURING PLAY" ' yes, display text
Text 19, 1, "4: HELP MOMMY - 6 BASES"
ELSEIF Options.Switches AND 32 THEN ' no, is switch 3 on?
Text 18, 1, "3: FIVE BASES DURING PLAY" ' yes, display text
Text 19, 1, "4: EASY - 5 BASES"
ELSEIF Options.Switches AND 16 THEN ' no, is switch 4 on?
Text 18, 1, "3: FOUR BASES DURING PLAY" ' yes, display text
Text 19, 1, "4: DEFAULT - 4 BASES"
ELSE ' no, both switches 3 and 4 are off
Text 18, 1, "3: THREE BASES DURING PLAY" ' display text
Text 19, 1, "4: HARD - 3 BASES"
END IF
IF Options.Switches AND 32 THEN _PUTIMAGE (83, 67)-(68, 32), IMG.DipSwitch ' if switch 3 is on flip it to the on position
IF Options.Switches AND 16 THEN _PUTIMAGE (109, 67)-(94, 32), IMG.DipSwitch ' if switch 4 is on flip it to the on position
IF (Options.Switches AND 12) = 12 THEN ' are switches 5 and 6 on?
Text 21, 1, "5: FULL SCREEN" ' yes, display text
Text 22, 1, "6: (3X ORIGINAL SIZE)"
ELSEIF Options.Switches AND 8 THEN ' no, is switch 5 on?
Text 21, 1, "5: LARGE 672x744 WINDOW" ' yes, display text
Text 22, 1, "6: (3X ORIGINAL SIZE)"
ELSEIF Options.Switches AND 4 THEN ' no, is switch 6 on?
Text 21, 1, "5: MEDIUM 448x496 WINDOW" ' yes, display text
Text 22, 1, "6: (2X ORIGINAL SIZE)"
ELSE ' no, both switches 5 and 6 are off
Text 21, 1, "5: SMALL 224x248 WINDOW" ' display text
Text 22, 1, "6: (ORIGINAL SIZE)"
END IF
IF Options.Switches AND 8 THEN _PUTIMAGE (135, 67)-(120, 32), IMG.DipSwitch ' if switch 5 is on flip it to the on position
IF Options.Switches AND 4 THEN _PUTIMAGE (161, 67)-(146, 32), IMG.DipSwitch ' if switch 6 is on flip it to the on position
IF Options.Switches AND 2 THEN ' is switch 7 on?
Text 24, 1, "7: SHOW BACKGROUND IMAGE" ' yes, display text
_PUTIMAGE (187, 67)-(172, 32), IMG.DipSwitch ' flip switch 7 to on position
ELSE ' no, switch 7 is off
Text 24, 1, "7: NO BACKGROUND IMAGE" ' display text
END IF
IF Options.Switches AND 1 THEN ' is switch 8 on?
Text 26, 1, "8: SHOW BEZEL IMAGE" ' yes, display text
_PUTIMAGE (213, 67)-(198, 32), IMG.DipSwitch ' flip switch 8 to the on position
ELSE ' no, switch 8 is off
Text 26, 1, "8: NO BEZEL IMAGE" ' display text
END IF
Text 28, 2, " <R> RESET HIGH SCORE" ' display input options
Text 29, 2, " <S> SAVE SETTINGS"
Text 30, 2, "<1-8> TOGGLE DIP SWITCH"
UpdateDisplay INOPTIONS ' update display with changes
DO ' begin keyboard input loop
_LIMIT 30 ' limit to 30 frames per second
KeyPress = GetKey(INOPTIONS) ' get a valid keyboard input
LOOP UNTIL KeyPress ' leave when valid keyboard input received
IF KeyPress = 82 THEN ' was the R key pressed?
Game.HighScore = 0 ' yes, reset the high score
_SNDPLAY SND.Extra ' play sound to acknowledge
END IF
IF KeyPress <> 83 THEN ' was the S key pressed?
KeyPress = ABS(KeyPress - 56) ' no, convert keypress vale to 7 through 0
Options.Switches = Options.Switches XOR 2 ^ KeyPress ' flip appropriate switch setting
END IF
LOOP UNTIL KeyPress = 83 ' leave when S keyboard input received
SaveOptions ' save game options
LoadOptions ' load game options to make any changes take effect
END SUB
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------+------+
SUB Text (Row AS INTEGER, Column AS INTEGER, Txt AS STRING) ' | Text |
'+---------------------------------------------------------------------------------------------------------------------------------------------------------------------+------+
'| Displays text instantly at the requested location |
'| Row - row where text is to printed (if row > 31 then actual screen coordinates are used. This is for the UFO text) |
'| Column - column where text is to be printed |
'| Txt - text string to be printed |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Font() AS LONG ' need access to shared variables
DIM c AS INTEGER ' column counter
DIM r AS INTEGER ' row counter
DIM p AS INTEGER ' text character position counter
IF Row < 31 THEN ' text on an 8x8 grid?
r = Row * 8 ' yes, calculate text row
c = Column * 8 ' calculate text column
ELSE ' no, use actual coordinates on screen for UFO text
r = Column ' convert row to X screen coordinate
c = Row - 32 ' convert column to Y screen coordinate
END IF
DO ' begin text print loop
p = p + 1 ' increment character position counter
_PUTIMAGE (c, r), Font(ASC(MID$(Txt, p, 1))) ' draw font character onto screen
c = c + 8 ' move to next text column
LOOP UNTIL p = LEN(Txt) ' leave when all characters printed
END SUB
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------+--------+
FUNCTION GetKey (Mode AS INTEGER) ' | GetKey |
'+-------------------------------------------------------------------------------------------------------------------------------------------------------------------+--------+
'| Get key presses from the player |
'| Mode - 1 (INOPTIONS) S, 1-8, and R keys only are returned |
'| 2 (INCOIN) O key (letter O) is the only one returned |
'| 3 (INSELECT) 1, 2, and O (letter O) keys are only returned |
'| -1 (NEWGMAE) clears the buffer and exits |
'| The C key is always monitored and returned. Additionaly when C is pressed a credit is added to the game. |
'| The ESC key is always monitored and the game exited if pressed. |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Game AS GAME ' need access to shared variables
SHARED SND AS SOUNDS
STATIC Buffer AS INTEGER ' buffer to hold last key pressed (retains value between calls)
DIM KeyPress AS INTEGER ' last key that was pressed
IF _EXIT THEN ExitGame ' leave game if player closes window with X button
IF Mode = NEWGAME THEN Buffer = 0: EXIT FUNCTION 'clear the buffer and exit
KeyPress = _KEYHIT ' get a key if pressed
IF KeyPress = 0 THEN EXIT FUNCTION ' leave function if no key pressed
IF KeyPress < 0 THEN Buffer = 0: EXIT FUNCTION ' if a key was released then clear the buffer and leave function
IF Buffer THEN GetKey = 0: EXIT FUNCTION ' if a key is being held down return nothing and leave function
IF KeyPress = 27 THEN ExitGame ' exit the game if the ESC key pressed
Buffer = KeyPress ' put the key into the buffer
IF KeyPress = 67 OR KeyPress = 99 THEN ' was the C key pressed?
Game.Credits = Game.Credits + 1 ' yes, insert a coin
IF Game.Credits > 99 THEN Game.Credits = 99 ' limit amount of coins in game
_SNDPLAY SND.Coin ' play the coin dropping sound
GetKey = 67 ' return the key to the insert coin screen
EXIT FUNCTION ' leave the function
END IF
SELECT CASE Mode ' which mode is the game in?
CASE INOPTIONS ' the options screen is showing
IF KeyPress = 83 OR KeyPress = 115 THEN ' was the S key pressed?
GetKey = 83 ' yes, return the key to the options screen
END IF
IF KeyPress > 48 AND KeyPress < 57 THEN ' was the 1 through 8 key pressed?
GetKey = KeyPress ' yes, return the key to the options screen
END IF
IF KeyPress = 82 OR KeyPress = 114 THEN ' was the R key pressed?
GetKey = 82 ' yes, return the key to the options screen
END IF
CASE INCOIN ' the insert coin screen is showing
IF KeyPress = 79 OR KeyPress = 111 THEN ' was the O key pressed?
GetKey = 79 ' yes, return the key to the insert coin screen
END IF
CASE INSELECT ' the select players screen is showing
IF KeyPress = 49 OR KeyPress = 50 THEN ' was the 1 or 2 key pressed?
GetKey = KeyPress ' yes, return the key to the select players screen
END IF
IF KeyPress = 79 OR KeyPress = 111 THEN ' was the O key pressed?
GetKey = 79 ' yes, return the key to the insert coin screen
END IF
END SELECT
END FUNCTION
'---------------------------------------------------------------------------------------------------------------------------------------------------------------------+-----------+
SUB DrawScore (p AS INTEGER, Mode AS INTEGER) ' | DrawScore |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------+-----------+
'| Draws the given player's score in the mode requested |
'| p - player 1 or 2 - 3 (BOTHPLAYERS) to have both players high scores drawn at same time |
'| Mode - 5 (INGAME) - update the high score if it has been surpassed |
'| any other value is ignored |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Player() AS PLAYER ' need access to shared variables
SHARED Game AS GAME
SHARED Options AS OPTIONS
SHARED SND AS SOUNDS
IF p = PLAYER1 OR p = BOTHPLAYERS THEN ' player 1 selected?
Text 2, 2, RIGHT$("00000" + _TRIM$(STR$(Player(1).Score)), 5) ' yes, print palyer 1's score
END IF
IF p = PLAYER2 OR p = BOTHPLAYERS THEN ' player 2 selected?
Text 2, 20, RIGHT$("00000" + _TRIM$(STR$(Player(2).Score)), 5) ' yes, print player 2's score
END IF
IF Player(Game.Player).Ship.Extra = FALSE THEN ' has the current player been awarded an extra ship?
IF Player(Game.Player).Score >= Options.ExtraShip THEN ' no, is the current player's score high enough for an extra ship?
Player(Game.Player).Ship.Remain = Player(Game.Player).Ship.Remain + 1 ' yes, award the player another ship
Player(Game.Player).Ship.Extra = TRUE ' remember that an extra ship was awarded
_SNDPLAY SND.Extra
END IF
END IF
IF Mode = INGAME THEN ' is a game currently in progress?
IF Player(Game.Player).Score > Game.HighScore THEN Game.HighScore = Player(Game.Player).Score ' yes, update the high score is a player exceeds it
END IF
END SUB
'------------------------------------------------------------------------------------------------------------------------------------------------------------+--------------------+
SUB DrawShipsRemaining () ' | DrawShipsRemaining |
'+-------------------------------------------------------------------------------------------------------------------------------------------------------+--------------------+
'| Draws the player's remaining ships |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Player() AS PLAYER ' need access to shared variables
SHARED IMG_Ship() AS LONG
SHARED Game AS GAME
DIM s AS INTEGER ' ship counter
DIM p AS INTEGER ' curent player
p = Game.Player ' get current player
Text 30, 1, _TRIM$(STR$(Player(p).Ship.Remain)) ' print number of total ships
s = 1 ' reset ship counter
WHILE s <= Player(p).Ship.Remain - 1 ' display a ship?
_PUTIMAGE (8 + (s * 16), 239), IMG_Ship(0) ' yes, draw ship
s = s + 1 ' increment ship counter
WEND ' leave when no more ships to draw
END SUB
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------+-------------+
SUB DrawCredits () ' | DrawCredits |
'+--------------------------------------------------------------------------------------------------------------------------------------------------------------+-------------+
'| Draw the number of credits in the game |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED Game AS GAME ' ned access to shared variables
Text 28, 1, "<C>OIN <O>PTIONS <ESC>EXIT" ' print the options text
Text 30, 17, "CREDIT-" + RIGHT$("00" + _TRIM$(STR$(Game.Credits)), 2) ' print the number of credits inserted
END SUB
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------+----------+
SUB ExitGame () ' | ExitGame |
'+-----------------------------------------------------------------------------------------------------------------------------------------------------------------+----------+
'| Frees all game assets from RAM and exits the game |
'+----------------------------------------------------------------------------------------------------------------------------------------------------------------------------+
SHARED SND AS SOUNDS ' need access to shared variables
SHARED IMG AS IMAGES
SHARED IMG_Ship() AS LONG
SHARED IMG_Invader() AS LONG
SHARED IMG_Bomb() AS LONG
SHARED Display AS DISPLAY
SHARED Shield() AS SHIELDS
SHARED Font() AS LONG
DIM x AS INTEGER ' generic counter
DIM y AS INTEGER ' generic counter
IF _FULLSCREEN THEN _FULLSCREEN _OFF ' leave full screen if enabled
SCREEN 0, 0, 0, 0 ' switch to a pure text screen
_SNDCLOSE SND.Beat1 ' remove sounds from RAM
_SNDCLOSE SND.Beat2
_SNDCLOSE SND.Beat3
_SNDCLOSE SND.Beat4
_SNDCLOSE SND.InvaderHit
_SNDCLOSE SND.PlayerHit
_SNDCLOSE SND.UFOHit
_SNDCLOSE SND.UFOFlying
_SNDCLOSE SND.Laser
_SNDCLOSE SND.Coin
_SNDCLOSE SND.Extra
_FREEIMAGE IMG.QB64PE ' remove images from RAM
_FREEIMAGE IMG.DipSwitch
_FREEIMAGE IMG.UFO
_FREEIMAGE IMG.InvaderHit
_FREEIMAGE IMG.BombHit
_FREEIMAGE IMG.BombHitMask
_FREEIMAGE IMG.LaserHit
_FREEIMAGE IMG.LaserHitMask
_FREEIMAGE IMG.Shield
_FREEIMAGE IMG_Ship(-1)
_FREEIMAGE IMG_Ship(0)
_FREEIMAGE IMG_Ship(1)
_FREEIMAGE IMG_Invader(1, 0)
_FREEIMAGE IMG_Invader(1, 1)
_FREEIMAGE IMG_Invader(2, 0)
_FREEIMAGE IMG_Invader(2, 1)
_FREEIMAGE IMG_Invader(3, 0)
_FREEIMAGE IMG_Invader(3, 1)
_FREEIMAGE Display.Bezel
_FREEIMAGE Display.Screen
_FREEIMAGE Display.WorkScreen
_FREEIMAGE Display.WorkMask
_FREEIMAGE Display.ColorMask
_FREEIMAGE Display.Background
_FREEIMAGE Display.OptionScreen
_FREEIMAGE Display.WithY
_FREEIMAGE Display.WithoutY
_FREEIMAGE Display.CorrectY
_FREEIMAGE Display.AddedC
_FREEIMAGE Display.NormalC
_FREEIMAGE IMG_Bomb(1, 0)
_FREEIMAGE IMG_Bomb(1, 1)
_FREEIMAGE IMG_Bomb(1, 2)
_FREEIMAGE IMG_Bomb(1, 3)
_FREEIMAGE IMG_Bomb(2, 0)
_FREEIMAGE IMG_Bomb(2, 1)
_FREEIMAGE IMG_Bomb(2, 2)
_FREEIMAGE IMG_Bomb(2, 3)
_FREEIMAGE IMG_Bomb(3, 0)
_FREEIMAGE IMG_Bomb(3, 1)
_FREEIMAGE IMG_Bomb(3, 2)
_FREEIMAGE IMG_Bomb(3, 3)
FOR x = 1 TO 2
FOR y = 1 TO 6
_FREEIMAGE Shield(x, y).Image
NEXT y
NEXT x
FOR x = 1 TO 255
_FREEIMAGE Font(x)
NEXT x
SYSTEM ' return to the operating system
END SUB
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Hi,
I am having a problem using QB64-CHAIN on an Windows XP-x86-system.
From QB 4.5 , Original, Sources. I am copying and using COM1_EX.bas and COM2_EX.bas.
The CHAIN command in COM1_EX is supposed to copy via COMMON a 1-dim-array() into COM2_EX - where however it's array-contents never arrive.
I did create COM2_EX.exe to be chained.
I also tried it with COMMON SHARED , and by using the identical variable names in both programs - no effect.
While using QB 4.5 the two programs chainig work ok.
Any ideas what may create that behavior?
Udix
So what I thought should be doable with thee two commands cannot be accomplished.
Here is what the code demonstrates.
1) Sets the program screen to the top left corner of the desktop.
2) Make a screen click, which places the mouse at 0, 0 of your desktop.
3) Now carefully move the mouse around in the program screen, and after a bit, carefully move it back to the upper right corner.
Well it should be back to 0, 0, right? Well, far from it. I mean provided the mouse isn't moved past the borders of the desktop, I would think the relative coordinates should be the same at the same points the mouse originated from: 0, 0 when back at the top left side of the desktop.
Code: (Select All)
_SCREENMOVE 0, 0
_DELAY .1
_SCREENCLICK 0, 0
DO
_LIMIT 30
WHILE _MOUSEINPUT
x = x + _MOUSEMOVEMENTX
y = y + _MOUSEMOVEMENTY
WEND
LOCATE 1, 1: PRINT y; x; " ";
IF LEN(INKEY$) THEN
EXIT DO
END IF
LOOP
END
I'm wondering if someone can advise on solution for a problem I'm having.
I am writing a program and would like to make it as a standalone/self-contained .exe, without any extra files being required.
I have been looking at Dav's embedded data routine to embed WAV sound files and play them back.
I have had playback success using the WINMM API method PlaySoundA& but this only works with Windows.
The _SNDPLAY command needs a filehandle to work meaning the file must be loaded creating a filehandle.
I've seen RhoSigmas embed method but this extracts the data to files which are then read back it. I'd like to avoid this if possible.
When I saw Steve's post about MEMFILEs I thought I'd hit the jackpot but alas I didn't, unless I misunderstood it, always a possibility.
So, is what I am asking even possible?
Can embedded data be used as a source for _SNPLAY or _SNDOPEN without actual files being used?
Is there another method for me to consider?
NOTE: This is literally a copy/paste. I just posted the same thing in the "Official" Discord.
You know, a year ago I found out my wife had cancer.
The last person I spoke to here and in the (now old) forums at the time - as a new/old programmer returning after years - was Fellipe Heitor. I had a half-baked UI running in InForm and he was helping me so much (everyone had).
My wife is better now, and I come back to find that horrible things have happened. I will not be speaking with Fellipe today, it would seem. What a shame. I have no dog in this current fight, so let me share what this looks like from the outside looking in:
I see division.
I see good developers not only not talking to each other - but talking poorly about one another. Yet you are all titans to we newcomers.
Legends of the community such as you all should not be divided. I was so *excited* to come back to programming after a year-long, intense battle only to find something I cared about has been decimated with disagreement.
Keybone here and Spriggsy there. Cory on one side, Steve on another? ***WHAT?*** Do you have *any idea* how much I have learned from you folks?!?!?! And now you're hardly on **speaking** terms? Nonsense!
It has always wanted to make a game in QB64, and was happily following Terry Ritchie's tutorial when we got the worst news. Now I can't. Now I have to **choose** which QB64 to use?!?! Not in the "FOSS" sense, but in the "*pick a side*" sense? The two QB64s have already diverged in different directions! Soon libraries won't even be compatible, and then we **really **lose.
The reason anyone is upset to begin with is you're all *passionate*. The dark side of passion can sometimes create divisions (as is clearly the case).
The worst part is that **none** of you did this. **All** of you have done nothing but fight to **SAVE **QB64. And yes, I've been on the PE forums too scratching my head trying to figure out what the hell is going on. I will make a similar appeal there as soon as I post this here.
Don't make me choose. Life is short. Unite QB64 again!
This is my remake of the TRS-80 text adventure game. I posted this game on GB64.org site a while back, but I don't know if any of my games got ported here. I did some touchups to the game since then and will continue making updates. I'm posting it here for the Halloween theme.
The game mostly uses two word commands like "GET KEY" or "KILL GHOST". Use N (north), S (south), E (east) and W (west) to maneuver through the house. INVENT will bring up the list of items you are carrying.
If at any point in the game you die, you will need to restart the game.
Donald
Code: (Select All)
_TITLE "TRS-80 MODEL I & III - HAUNTED HOUSE - TEXT ADVENTURE GAME IN QB64"
PRINT
PRINT "HAUNTED HOUSE is a very simple game. There are no treasures to"
PRINT "find. There are no scores to keep. There is no time limit. You only have"
PRINT "one task - GET OUT OF THE HOUSE ALIVE!!"
PRESSAKEY: A$ = INKEY$: IF A$ = "" GOTO PRESSAKEY
CLS
PRINT
PRINT "Haunted House"
PRINT
PRINT "Generations have passed since the McDaniel family mysteriously"
PRINT "disappeared. It is said that a stranger came to visit on that cold,"
PRINT "Autumn day many years ago, but no one knows for sure."
PRINT
PRINT "Their house has been vacant for decades now. It's two story image is"
PRINT "forlorn and looming, visible only from the narrow, winding road that"
PRINT "distorted by vegetation from the surrounding forest. The"
PRINT "stone wall that encompasses the house is discolor and broken from"
PRINT "years of neglect, it's iron gate rusty and worn by angry seasons. The"
PRINT "windows are boaded - the house is quiet and contented, not"
PRINT "accustomed to visitors. The wind is restless today, blowing fallen"
PRINT "leaves in all directions. As you walk towards the entrance of the house,"
PRINT "the wind grows distant and weak. Suddenly, the calm and silence is"
PRINT "broken by sounds from within the house!"
PRINT
PRINT "Do you have the courage to enter?"
GETYINPUT: A$ = UCASE$(INKEY$): IF A$ <> "Y" GOTO GETYINPUT
CLS: COLOR 2, 0
MESSAGE$ = "HAUNTED HOUSE!!": GOSUB MESSAGE
PRESSANYKEY: A$ = INKEY$: IF A$ = "" THEN GOTO PRESSANYKEY
OUTSIDEOFHOUSE: ' OUTSIDE OF HOUSE
MESSAGE$ = "YOU ARE AT THE OUTSIDE OF THE HOUSE.^THERE IS A CRUMPLED PIECE OF PAPER ON THE GROUND.^THE FRONT DOOR IS CLOSED.": GOSUB MESSAGE
INPUT0: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "YOU MATERIALIZE INSIDE THE DOOR.": GOSUB MESSAGE: GOTO FOYER
IF INPUTT$ = "GET PAPER" THEN PAPER = 1: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT0
IF INPUTT$ = "READ PAPER" AND PAPER = 1 THEN MESSAGE$ = "IT SAYS, %MAGIC WORD - PLUGH.%": GOSUB MESSAGE: GOTO INPUT0
IF INPUTT$ = "READ PAPER" AND PAPER = 0 THEN MESSAGE$ = "YOU AREN'T CARRYING IT.": GOSUB MESSAGE: GOTO INPUT0
IF INPUTT$ = "OPEN DOOR" THEN MESSAGE$ = "DOOR CAN'T BE OPENED.": GOSUB MESSAGE: GOTO INPUT0
IF INPUTT$ = "DOOR" OR INPUTT$ = "PAPER" OR INPUTT$ = "EXAMINE PAPER" THEN MESSAGE$ = "WHAT SHOULD I DO WITH IT?": GOSUB MESSAGE: GOTO INPUT0
IF INPUTT$ = "LOOK" OR INPUTT$ = "LOOK PAPER" OR INPUTT$ = "N" OR INPUTT$ = "S" OR INPUTT$ = "E" OR INPUTT$ = "W" THEN GOTO OUTSIDEOFHOUSE
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT0
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT0
FOYER: ' FOYER
MESSAGE$ = "YOU ARE AT THE FOYER.": GOSUB MESSAGE
INPUT1: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO FOYER
IF INPUTT$ = "DROP PAPER" THEN PAPER = 0: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO FOYER
IF INPUTT$ = "E" THEN GOTO LIVING_ROOM
IF INPUTT$ = "S" THEN GOTO DEN
IF INPUTT$ = "W" THEN GOTO EAST_END_HALL
IF INPUTT$ = "DOOR" OR INPUTT$ = "PAPER" THEN MESSAGE$ = "WHAT SHOULD I DO WITH IT?": GOSUB MESSAGE: GOTO INPUT1
IF INPUTT$ = "LOOK" OR INPUTT$ = "N" THEN GOTO FOYER
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT1
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT1
LIVING_ROOM: ' LIVING ROOM
MESSAGE$ = "YOU ARE AT THE LIVING ROOM.": GOSUB MESSAGE
IF KNIFE = 0 THEN MESSAGE$ = "A KNIFE IS LEVITATING IN THE MIDDLE OF THE ROOM.": GOSUB MESSAGE
IF SCROLL = 0 THEN MESSAGE$ = "THERE IS A MYSTERIOUS SCROLL ON THE GROUND.": GOSUB MESSAGE
INPUT2: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO LIVING_ROOM
IF INPUTT$ = "E" THEN GOTO DINING_ROOM
IF INPUTT$ = "W" THEN GOTO FOYER
IF INPUTT$ = "GET SCROLL" THEN SCROLL = 1: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT2
IF INPUTT$ = "READ SCROLL" AND SCROLL = 0 THEN MESSAGE$ = "YOU AREN'T CARRYING IT.": GOSUB MESSAGE: GOTO INPUT2
IF INPUTT$ = "READ SCROLL" AND SCROLL = 1 THEN MESSAGE$ = "IT SAYS, %THERE IS ESCAPE FROM THE SECOND FLOOR!%": GOSUB MESSAGE: GOTO INPUT2
IF INPUTT$ = "GET KNIFE" AND PAPER = 0 THEN MESSAGE$ = "THE KNIFE FLOATS OUT OF YOUR REACH.": GOSUB MESSAGE: GOTO INPUT2
IF INPUTT$ = "GET KNIFE" AND PAPER = 1 THEN KNIFE = 1: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT2
IF INPUTT$ = "N" OR INPUTT$ = "S" THEN MESSAGE$ = "SUDDENLY THE KNIFE WHOOSHES DOWN AND SLITS YOUR THROAT! YOU ARE DEAD.": GOSUB MESSAGE: END
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT2
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT2
DINING_ROOM: ' DINING ROOM
MESSAGE$ = "YOU ARE AT THE DINING ROOM.": GOSUB MESSAGE
INPUT3: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO DINING_ROOM
IF INPUTT$ = "S" THEN GOTO KITCHEN
IF INPUTT$ = "W" THEN GOTO LIVING_ROOM
IF INPUTT$ = "LOOK" OR INPUTT$ = "N" OR INPUTT$ = "E" THEN GOTO DINING_ROOM
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT3
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT3
KITCHEN: ' KITCHEN
MESSAGE$ = "YOU ARE AT THE KITCHEN.": GOSUB MESSAGE
IF BUCKET = 0 THEN MESSAGE$ = "A BUCKET OF WATER IS ON THE FLOOR.": GOSUB MESSAGE
INPUT4: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO KITCHEN
IF INPUTT$ = "N" THEN GOTO DINING_ROOM
IF INPUTT$ = "W" THEN GOTO DEN
IF INPUTT$ = "S" AND KNIFE = 1 THEN MESSAGE$ = "A SUIT OF ARMOUR HERE FLEES WHEN IT SPOTS YOUR KNIFE.": GOSUB MESSAGE: GOTO BREAKFAST_ROOM
IF INPUTT$ = "S" AND KNIFE = 0 THEN MESSAGE$ = "YOU ARE IN THE BREAKFAST ROOM.^AN ANIMATED ARMOUR SUIT THROWS YOU OUT!": GOSUB MESSAGE: GOTO KITCHEN
IF INPUTT$ = "GET BUCKET" THEN BUCKET = 1: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT4
IF INPUTT$ = "POUR WATER" OR INPUTT$ = "POUR BUCKET" THEN MESSAGE$ = "THE GROUND IS WET. THE BUCKET MAGICALLY REFILLS.": GOSUB MESSAGE: GOTO INPUT4
IF INPUTT$ = "DRINK WATER" AND BUCKET = 0 THEN MESSAGE$ = "YOU AREN'T CARRYING IT.": GOSUB MESSAGE: GOTO INPUT4
IF INPUTT$ = "DRINK WATER" AND BUCKET = 1 THEN MESSAGE$ = "YOU FEEL SICK. IN FACT, YOU JUST DIED! IT WAS POSION.": GOSUB MESSAGE: END
IF INPUTT$ = "LOOK" OR INPUTT$ = "E" THEN GOTO KITCHEN
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT4
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT4
BREAKFAST_ROOM: ' BREAKFAST ROOM
MESSAGE$ = "YOU ARE AT THE BREAKFAST ROOM.": GOSUB MESSAGE
INPUT5: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO BREAKFAST_ROOM
IF INPUTT$ = "N" THEN GOTO KITCHEN
IF INPUTT$ = "E" THEN GOTO SERVANTS_QUARTERS1
IF INPUTT$ = "LOOK" OR INPUTT$ = "S" OR INPUTT$ = "W" THEN GOTO BREAKFAST_ROOM
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT5
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT5
SERVANTS_QUARTERS1: ' SERVANTS QUARTERS
MESSAGE$ = "YOU ARE AT THE SERVANTS QUARTERS.^THERE IS A CABINET ON ONE WALL.": GOSUB MESSAGE
INPUT6: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO SERVANTS_QUARTERS1
IF INPUTT$ = "N" THEN GOTO SERVANTS_QUARTERS2
IF INPUTT$ = "W" THEN GOTO BREAKFAST_ROOM
IF INPUTT$ = "OPEN CABINET" THEN MESSAGE$ = "IT'S EMPTY.": GOSUB MESSAGE: GOTO INPUT6
IF INPUTT$ = "GET CABINET" THEN MESSAGE$ = "DON'T BE RIDICULOUS!": GOSUB MESSAGE: GOTO INPUT6
IF INPUTT$ = "LOOK" OR INPUTT$ = "S" OR INPUTT$ = "E" THEN GOTO SERVANTS_QUARTERS1
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT6
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT6
SERVANTS_QUARTERS2: ' SERVANTS QUARTERS
MESSAGE$ = "YOU ARE AT THE SERVANTS QUARTERS.^THERE IS A CABINET ON ONE WALL.": GOSUB MESSAGE
INPUT7: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO SERVANTS_QUARTERS2
IF INPUTT$ = "S" THEN GOTO SERVANTS_QUARTERS1
IF INPUTT$ = "OPEN CABINET" THEN MESSAGE$ = "THERE IS A KEY IN IT.": GOSUB MESSAGE: GOTO INPUT7
IF INPUTT$ = "GET KEY" THEN KEYY = 1: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT7
IF INPUTT$ = "LOOK" OR INPUTT$ = "N" OR INPUTT$ = "E" OR INPUTT$ = "W" THEN GOTO SERVANTS_QUARTERS2
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT7
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT7
DEN: ' DEN
MESSAGE$ = "YOU ARE AT THE DEN.": GOSUB MESSAGE
INPUT8: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO DEN
IF INPUTT$ = "N" THEN GOTO FOYER
IF INPUTT$ = "E" THEN GOTO KITCHEN
IF INPUTT$ = "LOOK" OR INPUTT$ = "S" OR INPUTT$ = "W" THEN GOTO DEN
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT8
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT8
EAST_END_HALL: ' EAST END OF THE HALL
MESSAGE$ = "YOU ARE AT THE EAST END OF THE HALL.": GOSUB MESSAGE
INPUT9: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO EAST_END_HALL
IF INPUTT$ = "N" THEN GOTO GREEN_BEDROOM
IF INPUTT$ = "E" THEN GOTO FOYER
IF INPUTT$ = "W" THEN GOTO WEST_END_HALL
IF INPUTT$ = "LOOK" OR INPUTT$ = "S" THEN GOTO EAST_END_HALL
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT9
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT9
WEST_END_HALL: ' WEST END OF THE HALL
MESSAGE$ = "YOU ARE AT THE WEST END OF THE HALL.^A LOCKED DOOR BARS THE WAY SOUTH.": GOSUB MESSAGE
INPUT10: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO WEST_END_HALL
IF INPUTT$ = "N" THEN GOTO BLUE_BEDROOM
IF INPUTT$ = "E" THEN GOTO EAST_END_HALL
IF (INPUTT$ = "S" OR INPUTT$ = "OPEN DOOR") AND KEYY = 1 THEN GOTO MASTER_BEDROOM
IF (INPUTT$ = "S" OR INPUTT$ = "OPEN DOOR") AND KEYY = 0 THEN MESSAGE$ = "YOU'LL NEED A KEY TO GET THROUGH THAT DOOR.": GOSUB MESSAGE: GOTO INPUT10
IF INPUTT$ = "LOOK" OR INPUTT$ = "W" THEN GOTO WEST_END_HALL
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT10
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT10
GREEN_BEDROOM: ' GREEN BEDROOM
MESSAGE$ = "YOU ARE AT THE GREEN BEDROOM. THERE'S A PANEL ON THE WEST WALL.": GOSUB MESSAGE
INPUT11: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO GREEN_BEDROOM
IF INPUTT$ = "S" THEN GOTO EAST_END_HALL
IF INPUTT$ = "PANEL" OR INPUTT$ = "OPEN PANEL" OR INPUTT$ = "GO PANEL" THEN GOTO SECRET_PASSAGE
IF INPUTT$ = "LOOK" OR INPUTT$ = "N" OR INPUTT$ = "E" OR INPUTT$ = "W" THEN GOTO GREEN_BEDROOM
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT11
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT11
SECRET_PASSAGE: ' SECRET PASSAGE
MESSAGE$ = "YOU ARE AT THE SECRET PASSAGE.": GOSUB MESSAGE
IF ROPE = 0 THEN MESSAGE$ = "A ROPE IS NEARBY.": GOSUB MESSAGE
INPUT12: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO SECRET_PASSAGE
IF INPUTT$ = "E" THEN GOTO GREEN_BEDROOM
IF INPUTT$ = "W" THEN GOTO BLUE_BEDROOM
IF INPUTT$ = "GET ROPE" THEN ROPE = 1: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT12
IF INPUTT$ = "LOOK" OR INPUTT$ = "N" OR INPUTT$ = "S" THEN GOTO SECRET_PASSAGE
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT12
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT12
BLUE_BEDROOM: ' BLUE BEDROOM
MESSAGE$ = "YOU ARE AT THE BLUE BEDROOM.^THERE'S A PANEL ON THE WEST WALL.": GOSUB MESSAGE
INPUT13: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO BLUE_BEDROOM
IF INPUTT$ = "S" THEN GOTO WEST_END_HALL
IF INPUTT$ = "PANEL" OR INPUTT$ = "OPEN PANEL" OR INPUTT$ = "GO PANEL" THEN GOTO SECRET_PASSAGE
IF INPUTT$ = "LOOK" OR INPUTT$ = "N" OR INPUTT$ = "E" OR INPUTT$ = "W" THEN GOTO BLUE_BEDROOM
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT13
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT13
MASTER_BEDROOM: ' MASTER BEDROOM
MESSAGE$ = "YOU ARE IN THE MASTER BEDROOM.^A WALL OF RAGING FIRE BLOCKS THE WAY EAST.": GOSUB MESSAGE
INPUT14: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO MASTER_BEDROOM
IF INPUTT$ = "N" THEN GOTO GREEN_BEDROOM
IF INPUTT$ = "E" THEN MESSAGE$ = "ARE YOU JUST GOING TO WALK RIGHT THROUGH THAT RANGING FIRE?": GOSUB MESSAGE: GOTO INPUT14
IF INPUTT$ = "YES" THEN MESSAGE$ = "OK": GOSUB MESSAGE: GOTO LIBRARY
IF INPUTT$ = "NO" THEN MESSAGE$ = "A WISE DECISION.": GOSUB MESSAGE: GOTO INPUT14
IF INPUTT$ = "LOOK" OR INPUTT$ = "W" OR INPUTT$ = "S" THEN GOTO MASTER_BEDROOM
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT14
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT14
LIBRARY: ' LIBRARY
MESSAGE$ = "YOU ARE AT THE LIBRARY. THERE IS A HOLE IN THE CEILING.": GOSUB MESSAGE
INPUT15: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO LIBRARY
IF INPUTT$ = "W" THEN GOTO BLUE_BEDROOM
IF INPUTT$ = "DROP ROPE" THEN ROPE = 0: ROPECEILING = 1: MESSAGE$ = "INSTANTLY THE ROPE UNWINDS AND LEVITATES TO THE HOLE IN THE CEILING!": GOSUB MESSAGE: GOTO INPUT15
IF (INPUTT$ = "CLIMB ROPE" OR INPUTT$ = "JUMP ROPE") AND ROPECEILING = 1 THEN MESSAGE$ = "YOU DROP EVERYTHING YOU HAD TO CLIMB THE ROPE. YOU REACH THE SECOND FLOOR.": GOSUB MESSAGE: PAPER = 0: KEYY = 0: KNIFE = 0: ROPE = 0: ARMOUR = 0: CABINET = 0: SCROLL = 0: GOTO DIMLY_ROOM_SWORD
IF INPUTT$ = "LOOK" OR INPUTT$ = "N" OR INPUTT$ = "E" OR INPUTT$ = "S" THEN GOTO LIBRARY
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT15
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT15
DIMLY_ROOM_SWORD: ' DIMLY LIT ROOM WITH SWORD
MESSAGE$ = "YOU ARE IN A DIMLY LIT ROOM. THERE IS A HOLE IN THE FLOOR.": GOSUB MESSAGE
IF SWORD = 0 THEN MESSAGE$ = "THERE IS A MAGIC SWORD ON THE FLOOR.": GOSUB MESSAGE
INPUT16: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO DIMLY_ROOM_SWORD
IF INPUTT$ = "E" THEN GOTO DIMLY_ROOM_GHOST1
IF INPUTT$ = "W" THEN GOTO DIMLY_ROOM_GHOST3
IF INPUTT$ = "S" THEN GOTO DIMLY_ROOM_GHOST2
IF INPUTT$ = "GET SWORD" THEN SWORD = 1: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT16
IF INPUTT$ = "READ SWORD" THEN MESSAGE$ = "AN INCRIPTION READS, %GHOST KILLER.%": GOSUB MESSAGE: GOTO INPUT16
IF INPUTT$ = "DROP SWORD" AND SWORD = 1 THEN SWORD = 0: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT16
IF INPUTT$ = "DROP SWORD" AND SWORD = 0 THEN MESSAGE$ = "YOU'RE NOT CARRYING IT.": GOSUB MESSAGE: GOTO INPUT16
IF INPUTT$ = "CLIMB ROPE" THEN MESSAGE$ = "YOU FALL THROUGH THE HOLE AND BREAK YOUR NECK! YOU ARE DEAD.": GOSUB MESSAGE: END
IF INPUTT$ = "LOOK" OR INPUTT$ = "N" THEN GOTO DIMLY_ROOM_SWORD
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT16
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT16
DIMLY_ROOM_GHOST1: ' DIMLY LIT ROOM WITH GHOST
MESSAGE$ = "YOU ARE IN A DIMLY LIT ROOM.": GOSUB MESSAGE
IF GHOST1 = 1 THEN MESSAGE$ = "THERE IS A GHOST HERE.": GOSUB MESSAGE
IF GHOST5 = 1 THEN MESSAGE$ = "THE BODY OF A DEAD GHOST IS ON THE FLOOR.": GOSUB MESSAGE
INPUT17: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "KILL GHOST" AND GHOST1 = 1 AND SWORD = 1 THEN GHOST1 = 0: GHOST5 = 1: MESSAGE$ = "YOUR MAGIC SWORD ENABLES YOU TO KILL THE GHOST!": GOSUB MESSAGE: GOTO INPUT17
IF INPUTT$ = "KILL GHOST" AND GHOST1 = 1 AND SWORD = 0 THEN MESSAGE$ = "YOU CAN'T KILL A GHOST WITH YOUR BARE HANDS.": GOSUB MESSAGE: GOTO INPUT17
IF INPUTT$ = "KILL GHOST" AND GHOST5 = 1 THEN MESSAGE$ = "THE POOR THING'S ALREADY DEAD.": GOSUB MESSAGE: GOTO INPUT17
IF INPUTT$ = "KILL SWORD" THEN MESSAGE$ = "OUCH! YOU HURT YOUR HAND.": GOSUB MESSAGE: GOTO INPUT17
IF INPUTT$ = "DROP SWORD" AND SWORD = 1 THEN SWORD = 0: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT17
IF INPUTT$ = "DROP SWORD" AND SWORD = 0 THEN MESSAGE$ = "YOU'RE NOT CARRYING IT.": GOSUB MESSAGE: GOTO INPUT17
IF INPUTT$ = "W" THEN GOTO DIMLY_ROOM_SWORD
IF (INPUTT$ = "N" OR INPUTT$ = "E" OR INPUTT$ = "S") AND GHOST5 = 1 THEN GOTO DIMLY_ROOM_GHOST1
IF (INPUTT$ = "N" OR INPUTT$ = "E" OR INPUTT$ = "S") AND GHOST1 = 1 THEN MESSAGE$ = "THE GHOST WILL NOT LET YOU PASS!": GOSUB MESSAGE: GOTO INPUT17
IF INPUTT$ = "LOOK" THEN GOTO DIMLY_ROOM_GHOST1
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT17
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT17
DIMLY_ROOM_GHOST2: ' DIMLY LIT ROOM WITH GHOST
MESSAGE$ = "YOU ARE IN A DIMLY LIT ROOM.": GOSUB MESSAGE
IF GHOST2 = 1 THEN MESSAGE$ = "THERE IS A GHOST HERE.": GOSUB MESSAGE
IF GHOST6 = 1 THEN MESSAGE$ = "THE BODY OF A DEAD GHOST IS ON THE FLOOR.": GOSUB MESSAGE
INPUT18: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "KILL GHOST" AND GHOST2 = 1 AND SWORD = 1 THEN GHOST2 = 0: GHOST6 = 1: MESSAGE$ = "YOUR MAGIC SWORD ENABLES YOU TO KILL THE GHOST!": GOSUB MESSAGE: GOTO INPUT18
IF INPUTT$ = "KILL GHOST" AND GHOST2 = 1 AND SWORD = 0 THEN MESSAGE$ = "YOU CAN'T KILL A GHOST WITH YOUR BARE HANDS.": GOSUB MESSAGE: GOTO INPUT18
IF INPUTT$ = "KILL GHOST" AND GHOST6 = 1 THEN MESSAGE$ = "THE POOR THING'S ALREADY DEAD.": GOSUB MESSAGE: GOTO INPUT18
IF INPUTT$ = "KILL SWORD" THEN MESSAGE$ = "OUCH! YOU HURT YOUR HAND.": GOSUB MESSAGE: GOTO INPUT18
IF INPUTT$ = "DROP SWORD" AND SWORD = 1 THEN SWORD = 0: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT18
IF INPUTT$ = "DROP SWORD" AND SWORD = 0 THEN MESSAGE$ = "YOU'RE NOT CARRYING IT.": GOSUB MESSAGE: GOTO INPUT18
IF INPUTT$ = "N" THEN GOTO DIMLY_ROOM_SWORD
IF (INPUTT$ = "W" OR INPUTT$ = "E" OR INPUTT$ = "S") AND GHOST6 = 1 THEN GOTO DIMLY_ROOM_GHOST2
IF (INPUTT$ = "W" OR INPUTT$ = "E" OR INPUTT$ = "S") AND GHOST2 = 1 THEN MESSAGE$ = "THE GHOST WILL NOT LET YOU PASS!": GOSUB MESSAGE: GOTO INPUT18
IF INPUTT$ = "LOOK" THEN GOTO DIMLY_ROOM_GHOST2
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT18
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT18
DIMLY_ROOM_GHOST3: ' DIMLY LIT ROOM WITH GHOST
MESSAGE$ = "YOU ARE IN A DIMLY LIT ROOM.": GOSUB MESSAGE
IF GHOST3 = 1 THEN MESSAGE$ = "THERE IS A GHOST HERE.": GOSUB MESSAGE
IF GHOST7 = 1 THEN MESSAGE$ = "THE BODY OF A DEAD GHOST IS ON THE FLOOR.": GOSUB MESSAGE
INPUT19: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "KILL GHOST" AND GHOST3 = 1 AND SWORD = 1 THEN GHOST3 = 0: GHOST7 = 1: MESSAGE$ = "YOUR MAGIC SWORD ENABLES YOU TO KILL THE GHOST!": GOSUB MESSAGE: GOTO INPUT19
IF INPUTT$ = "KILL GHOST" AND GHOST3 = 1 AND SWORD = 0 THEN MESSAGE$ = "YOU CAN'T KILL A GHOST WITH YOUR BARE HANDS.": GOSUB MESSAGE: GOTO INPUT19
IF INPUTT$ = "KILL GHOST" AND GHOST7 = 1 THEN MESSAGE$ = "THE POOR THING'S ALREADY DEAD.": GOSUB MESSAGE: GOTO INPUT19
IF INPUTT$ = "KILL SWORD" THEN MESSAGE$ = "OUCH! YOU HURT YOUR HAND.": GOSUB MESSAGE: GOTO INPUT19
IF INPUTT$ = "DROP SWORD" AND SWORD = 1 THEN SWORD = 0: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT19
IF INPUTT$ = "DROP SWORD" AND SWORD = 0 THEN MESSAGE$ = "YOU'RE NOT CARRYING IT.": GOSUB MESSAGE: GOTO INPUT19
IF INPUTT$ = "E" THEN GOTO DIMLY_ROOM_SWORD
IF INPUTT$ = "W" AND GHOST7 = 1 THEN GOTO DIMLY_ROOM_UNKILL1
IF (INPUTT$ = "N" OR INPUTT$ = "W" OR INPUTT$ = "S") AND GHOST7 = 1 THEN GOTO DIMLY_ROOM_GHOST3
IF (INPUTT$ = "N" OR INPUTT$ = "W" OR INPUTT$ = "S") AND GHOST3 = 1 THEN MESSAGE$ = "THE GHOST WILL NOT LET YOU PASS!": GOSUB MESSAGE: GOTO INPUT19
IF INPUTT$ = "LOOK" THEN GOTO DIMLY_ROOM_GHOST3
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT19
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT19
DIMLY_ROOM_UNKILL1: ' DIMLY LIT ROOM WITH UNKILLABLE GHOST
MESSAGE$ = "YOU ARE IN A DIMLY LIT ROOM.^THERE IS A GHOST HERE.": GOSUB MESSAGE
INPUT20: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "KILL GHOST" AND SWORD = 1 THEN GHOST4 = 0: GHOST8 = 1: MESSAGE$ = "YOUR MAGIC SWORD ENABLES YOU TO KILL THE GHOST!": GOSUB MESSAGE: GOTO INPUT20
IF INPUTT$ = "KILL GHOST" AND SWORD = 0 THEN MESSAGE$ = "YOU CAN'T KILL A GHOST WITH YOUR BARE HANDS.": GOSUB MESSAGE: GOTO INPUT20
IF INPUTT$ = "KILL SWORD" THEN MESSAGE$ = "OUCH! YOU HURT YOUR HAND.": GOSUB MESSAGE: GOTO INPUT20
IF INPUTT$ = "DROP SWORD" AND SWORD = 1 THEN SWORD = 0: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT20
IF INPUTT$ = "DROP SWORD" AND SWORD = 0 THEN MESSAGE$ = "YOU'RE NOT CARRYING IT.": GOSUB MESSAGE: GOTO INPUT20
IF INPUTT$ = "E" THEN GOTO DIMLY_ROOM_GHOST3
IF INPUTT$ = "N" AND SWORD = 0 AND SOUTH = 1 THEN GOTO DIMLY_ROOM_UNKILL2
IF INPUTT$ = "S" AND SWORD = 0 THEN SOUTH = 1: GOTO DIMLY_ROOM_UNKILL1
IF (INPUTT$ = "N" OR INPUTT$ = "S" OR INPUTT$ = "W") AND SWORD = 1 THEN MESSAGE$ = "THE GHOST WILL NOT LET YOU PASS!": GOSUB MESSAGE: GOTO INPUT20
IF INPUTT$ = "LOOK" THEN GOTO DIMLY_ROOM_UNKILL1
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT20
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT20
DIMLY_ROOM_UNKILL2: ' DIMLY LIT ROOM WITH UNKILLABLE GHOST
MESSAGE$ = "YOU ARE IN A DIMLY LIT ROOM.^THERE IS A GHOST HERE.": GOSUB MESSAGE
INPUT21: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "DROP SWORD" AND SWORD = 0 THEN MESSAGE$ = "YOU'RE NOT CARRYING IT.": GOSUB MESSAGE: GOTO INPUT21
IF INPUTT$ = "KILL SWORD" THEN MESSAGE$ = "OUCH! YOU HURT YOUR HAND.": GOSUB MESSAGE: GOTO INPUT21
IF INPUTT$ = "KILL GHOST" AND SWORD = 0 THEN MESSAGE$ = "YOU CAN'T KILL A GHOST WITH YOUR BARE HANDS.": GOSUB MESSAGE: GOTO INPUT21
IF INPUTT$ = "E" THEN GOTO DIMLY_ROOM_GHOST3
IF INPUTT$ = "W" THEN GOTO DIMLY_ROOM_UNKILL3
IF INPUTT$ = "S" THEN GOTO DIMLY_ROOM_UNKILL1
IF INPUTT$ = "LOOK" OR INPUTT$ = "N" THEN GOTO DIMLY_ROOM_UNKILL2
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT21
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT21
DIMLY_ROOM_UNKILL3: ' DIMLY LIT ROOM WITH UNKILLABLE GHOST
MESSAGE$ = "YOU ARE IN A DIMLY LIT ROOM.^THERE IS A GHOST HERE.": GOSUB MESSAGE
INPUT22: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "DROP SWORD" AND SWORD = 0 THEN MESSAGE$ = "YOU'RE NOT CARRYING IT.": GOSUB MESSAGE: GOTO INPUT22
IF INPUTT$ = "KILL SWORD" THEN MESSAGE$ = "OUCH! YOU HURT YOUR HAND.": GOSUB MESSAGE: GOTO INPUT22
IF INPUTT$ = "KILL GHOST" AND SWORD = 0 THEN MESSAGE$ = "YOU CAN'T KILL A GHOST WITH YOUR BARE HANDS.": GOSUB MESSAGE: GOTO INPUT22
IF INPUTT$ = "E" THEN GOTO DIMLY_ROOM_UNKILL2
IF INPUTT$ = "S" THEN GOTO DIMLY_ROOM_ENDGAME
IF INPUTT$ = "LOOK" OR INPUTT$ = "N" OR INPUTT$ = "W" THEN GOTO DIMLY_ROOM_UNKILL3
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT22
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT22
DIMLY_ROOM_ENDGAME: ' DIMLY LIT ROOM, END OF GAME
MESSAGE$ = "YOU ARE IN A DIMLY LIT ROOM.^THERE IS A RUSTY OLD SIGN LAYING ON THE GROUND.": GOSUB MESSAGE
INPUT23: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "GET SIGN" THEN SIGN = 1: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT23
IF INPUTT$ = "READ SIGN" AND SIGN = 0 THEN MESSAGE$ = "YOU ARE NOT CARRYING IT.": GOTO INPUT23
IF INPUTT$ = "READ SIGN" AND SIGN = 1 THEN READSIGN = 1: MESSAGE$ = "THE SIGN SAYS, %THERE ARE THREE EXITS FROM THIS ROOM. ONLY ONE IS TRUE...^YOU MUST KNOW, BUT NOT BE BURDENED BY THIS CLUE!.%": GOSUB MESSAGE: GOTO INPUT23
IF INPUTT$ = "DROP SIGN" THEN SIGN = 0: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT23
IF INPUTT$ = "N" THEN GOTO DIMLY_ROOM_UNKILL2
IF INPUTT$ = "E" OR INPUTT$ = "W" OR INPUTT$ = "S" THEN
IF SIGN = 1 OR READSIGN = 0 THEN
MESSAGE$ = "YOU FALL THROUGH A TRAP DOOR TO YOUR DEATH!": GOSUB MESSAGE: END
ELSE MESSAGE$ = "YOU WALK THROUGH A DOOR AND FIND YOURSELF ON A BALCONY.^YOU CLIMB DOWN A TREE AND ESCAPE TO SAFETY!^CONGRATULATIONS! YOU MADE IT!": GOSUB MESSAGE: END
END IF
END IF
IF INPUTT$ = "LOOK" THEN GOTO DIMLY_ROOM_ENDGAME
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT23
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT23
CAPITOLS:
FOR Z = 1 TO LEN(INPUTT$)
Y = ASC(MID$(INPUTT$, Z, 1))
IF Y > 96 AND Y < 123 THEN MID$(INPUTT$, Z, 1) = CHR$(Y - 32)
NEXT
RETURN
MESSAGE:
FOR Z = 1 TO LEN(MESSAGE$)
CHAR$ = MID$(MESSAGE$, Z, 1)
IF CHAR$ = "^" THEN PRINT: CHAR$ = ""
IF CHAR$ = "%" THEN PRINT CHR$(34); ELSE PRINT CHAR$;
_DELAY .03
NEXT: PRINT
RETURN
INVENTORY:
IF PAPER = 1 THEN MESSAGE$ = "CRUMPLED PAPER": GOSUB MESSAGE
IF KEYY = 1 THEN MESSAGE$ = "KEY": GOSUB MESSAGE
IF KNIFE = 1 THEN MESSAGE$ = "KNIFE": GOSUB MESSAGE
IF ROPE = 1 THEN MESSAGE$ = "ROPE": GOSUB MESSAGE
IF BUCKET = 1 THEN MESSAGE$ = "WATER BUCKET": GOSUB MESSAGE
IF SCROLL = 1 THEN MESSAGE$ = "SCROLL": GOSUB MESSAGE
IF SWORD = 1 THEN MESSAGE$ = "MAGIC SWORD": GOSUB MESSAGE
IF SIGN = 1 THEN MESSAGE$ = "RUSTY SIGN": GOSUB MESSAGE
RETURN
A few years ago a friend of mine and I were talking about epicycles, which had been used in an attempt to explain planetary motion (yes, we are both nerds.) I had decided to experiment with animating epicycle orbits. The original version of this program was written in FreeBASIC, this is my QB64PE translation of that program as an exercise to learn about the graphics capability of QB64PE. (interestingly, the two BASICs have fairly similar graphics facilities.)
Hopefully the comments in the code provide enough explanation of how I approached the problem.
Code: (Select All)
'Program: Epicycles.bas
'Purpose: A QB64PE version of Epicycles
'Version: 0.1
'Create Date: 09/23/2022
'Rev Date: 10/28/2022
OPTION _EXPLICIT
CONST PI2 = 6.2831853
TYPE ScreenPoint
x AS LONG
y AS LONG
END TYPE
DIM AS INTEGER ix 'general purpose use
DIM AS STRING sx 'general purpose use
DIM SHARED AS LONG lw, lh 'desktop width and height
DIM AS LONG MinX, MinY, MaxX, MaxY 'Cartesian limits of the images
DIM AS LONG r1, r2, r3 'radii of the epicycle circles
DIM AS LONG rot1, rot2, rot3 'rotation direction
DIM AS LONG step1, step2, step3 'rotation speed
DIM AS ScreenPoint sp1, sp2, sp3 'center points of the epicycle circles
DIM AS DOUBLE Angle1, Angle2, Angle3, AngleStep(1 TO 3)
DIM AS LONG lWin1, lWin2, lWin3 'handles for the three images
' The first image is the visible one. The second image plots each successive
' endpoint of the epicycle to build the pattern. The third image is where the
' epicycles are plotted. Put the second image on the third image, draw the
' epicycle on the third image, put the third image on the first image.
'Get the user input
CLS
COLOR _RGB(255, 0, 255): PRINT "EPICYCLES DEMONSTRATION"
COLOR _RGB(0, 255, 255)
PRINT "Screen resolution is "; lw; " wide x "; lh; " high."
DO
LOCATE 3, 1: PRINT " "
LOCATE 3, 1: COLOR _RGB(0, 255, 255)
PRINT "Number of epicycles (1 or 2)";: INPUT ix
IF ix = 1 OR ix = 2 THEN EXIT DO
COLOR _RGB(255, 0, 0): PRINT "Try again please."
LOOP
' show how this works
DrawExamples ix
DO
LOCATE 5, 1: COLOR _RGB(0, 255, 255)
PRINT "Enter a value for the main circle radius (1 to "; STR$(MaxY * 0.5); " )"
PRINT "or 0 to quit:"
INPUT r1
IF r1 = 0 THEN END
IF r1 > 0 AND r1 <= MaxY * 0.5 THEN EXIT DO
LOCATE 7, 1: PRINT " " 'clear the input
COLOR _RGB(255, 0, 0): PRINT "Try again please.";
LOOP
DO
LOCATE 8, 1: COLOR _RGB(0, 255, 255)
PRINT "Rotate clockwise (CW) or counterclockwise (CCW)"
INPUT sx
SELECT CASE sx
CASE "CW", "cw"
rot1 = -1
EXIT DO
CASE "CCW", "ccw"
rot1 = 1
EXIT DO
CASE ELSE
LOCATE 9, 1: PRINT " "
COLOR _RGB(255, 0, 0): PRINT "Try again please."
END SELECT
LOOP
DO
LOCATE 10, 1: COLOR _RGB(0, 255, 255): PRINT "Rotational speed (1, 2 or 3)?"
INPUT sx
SELECT CASE sx
CASE "1"
step1 = 1
EXIT DO
CASE "2"
step1 = 2
EXIT DO
CASE "3"
step1 = 3
EXIT DO
CASE ELSE
LOCATE 11, 1: PRINT " " 'clear the input
COLOR _RGB(255, 0, 0): PRINT "Try again please."
END SELECT
LOOP
DO
LOCATE 12, 1: COLOR _RGB(0, 255, 255): PRINT "Enter a value for the orbiting circle radius r2 (0 to "; STR$(MaxY * 0.50); ")"
INPUT r2
IF r2 > 0 AND r2 <= (MaxY * 0.50) THEN EXIT DO
LOCATE 13, 1: PRINT " "
COLOR _RGB(255, 0, 0): PRINT "Try again please."
LOOP
DO
LOCATE 14, 1: COLOR _RGB(0, 255, 255): PRINT "Rotate clockwise (CW) or counterclockwise (CCW)"
INPUT sx
SELECT CASE sx
CASE "CW", "cw":
rot2 = -1
EXIT DO
CASE "CCW", "ccw"
rot2 = 1
EXIT DO
CASE ELSE
LOCATE 15, 1: PRINT " " 'clear the input
COLOR _RGB(255, 0, 0): PRINT "Try again please."
END SELECT
LOOP
DO
LOCATE 16, 1: COLOR _RGB(0, 255, 255): PRINT "Rotational speed (1, 2 or 3)?"
INPUT sx
SELECT CASE sx
CASE "1"
step2 = 1
EXIT DO
CASE "2"
step2 = 2
EXIT DO
CASE "3"
step2 = 3
EXIT DO
CASE ELSE
LOCATE 17, 1: PRINT " " 'clear the input
COLOR _RGB(255, 0, 0): PRINT "Try again please."
END SELECT
LOOP
step3 = step1 'set a default value
IF (ix = 2) THEN
DO
LOCATE 18, 1: COLOR _RGB(0, 255, 255)
PRINT "Enter a value for the orbiting circle radius r2 (0 to "; STR$(MaxY * 0.25); ")"
INPUT r3
IF r3 > 0 AND r3 <= (MaxY * 0.25) THEN EXIT DO
LOCATE 19, 1: PRINT " "
COLOR _RGB(255, 0, 0): PRINT "Try again please."
LOOP
DO
LOCATE 20, 1: COLOR _RGB(0, 255, 255): PRINT "Rotate clockwise (CW) or counterclockwise (CCW)"
INPUT sx
SELECT CASE sx
CASE "CW", "cw":
rot3 = -1
EXIT DO
CASE "CCW", "ccw"
rot3 = 1
EXIT DO
CASE ELSE
LOCATE 21, 1: PRINT " " 'clear the input
COLOR _RGB(255, 0, 0): PRINT "Try again please."
END SELECT
LOOP
DO
LOCATE 22, 1: COLOR _RGB(0, 255, 255): PRINT "Rotational speed (1, 2 or 3)?"
INPUT sx
SELECT CASE sx
CASE "1"
step3 = 1
EXIT DO
CASE "2"
step3 = 2
EXIT DO
CASE "3"
step3 = 3
EXIT DO
CASE ELSE
LOCATE 23, 1: PRINT " " 'clear the input
COLOR _RGB(255, 0, 0): PRINT "Try again please."
END SELECT
LOOP
END IF
PRINT "Press any key to begin."
SLEEP
'-- now the fun stuff
'Use the horizontal screen size as the step size to orbit the satellite.
'use the vertical screen size to orbit the epicycle
AngleStep(1) = PI2 / lw
AngleStep(2) = PI2 / lh
AngleStep(3) = AngleStep(1) * 3
Angle1 = Angle2 = Angle3 = 0
_LIMIT 100
'Screen lWin2 tracks the epicycle points, make sure it is cleared
_DEST lWin2: CLS
'Draw a couple axes
LINE (MinX, 0)-(MaxX, 0), _RGB(64, 64, 64)
LINE (0, MinY)-(0, MaxY), _RGB(64, 64, 64)
COLOR _RGB(0, 255, 255): LOCATE 1, 1: PRINT "Press any key to exit."
DO
WHILE INKEY$ <> "": WEND 'clear the key buffer
Angle1 = Angle1 + AngleStep(step1) * rot1
IF Angle1 > PI2 THEN Angle1 = 0 'gone around one full revolution
FindCirclePoint r1, Angle1, sp1
Angle2 = Angle2 + AngleStep(step2) * rot2
IF Angle2 > PI2 THEN Angle2 = 0 'gone around one full revolution
FindCirclePoint r2, Angle2, sp2
sp2.x = sp2.x + sp1.x: sp2.y = sp2.y + sp1.y
Angle3 = Angle3 + AngleStep(step3) * rot3
IF Angle3 > PI2 THEN Angle3 = 0 'gone around one full revolution
FindCirclePoint r3, Angle3, sp3
sp3.x = sp3.x + sp2.x: sp3.y = sp3.y + sp2.y
END
'-------------------------- end of program -----------------------------------
SUB DrawExamples (num AS INTEGER)
DIM AS ScreenPoint sp1, sp2, sp3
DIM AS INTEGER ix, iy
'-- draw the example circles
CIRCLE (0, 0), 2, _RGB(255, 255, 255) 'center of main circle
CIRCLE (0, 0), lh \ 4, _RGB(255, 0, 0) 'main circle
ix = (lh \ 4) * COS(PI2 \ 8)
sp1.x = ix: sp1.y = ix
CIRCLE (sp1.x, sp1.y), 2, _RGB(255, 255, 255) 'center of orbiting circle
CIRCLE (sp1.x, sp1.y), lh \ 6, _RGB(255, 0, 0) 'orbiting circle
sp2.x = sp1.x + lh \ 6
sp2.y = sp1.y
CIRCLE (sp2.x, sp2.y), 2, _RGB(255, 255, 255)
LINE (0, 0)-(sp1.x, sp1.y), _RGB(255, 0, 255) 'main circle radius
LINE (sp1.x, sp1.y)-(sp2.x, sp2.y), _RGB(255, 255, 0) 'orbiting circle radius
IF (num = 2) THEN
ix = (lh \ 10) * COS(PI2 \ 8)
sp3.x = sp2.x + ix
sp3.y = sp2.y - ix
CIRCLE (sp2.x, sp2.y), _HYPOT(sp3.x - sp2.x, sp3.y - sp2.y), _RGB(255, 0, 0) 'orbiting circle
CIRCLE (sp3.x, sp3.y), 2, _RGB(255, 255, 255) 'center of orbiting circle
LINE (sp2.x, sp2.y)-(sp3.x, sp3.y), _RGB(255, 255, 0) 'orbiting circle radius
ix = (sp3.x \ 8): iy = sp3.y \ 8
COLOR _RGB(255, 255, 255)
END IF
END SUB
'-----------------------------------------------------------------------------
SUB FindCirclePoint (r AS INTEGER, a AS DOUBLE, st AS ScreenPoint)
' calculate the offset X and Y of a point given a radius and angle
' Assume the offset is from 0,0. Add the returned offsets to the previous point.
' Angle must be in radians
st.x = INT(r * COS(a)): st.y = INT(r * SIN(a))
END SUB
Firstly, I'm not dumb, I'm old and easily confused, so please try to keep any response simple and unencumbered.
I understand that 2^2 means 2*2, and 2^3 means 2*2*2. But I just can't get my head around 2^2.5 and similar. It's obviously not 2*2*half of 2, which is 2*2*1. Can someone explain (clearly) what the term means? My calculator tell me it's about 5.6568 but I can't see where this comes from.
