| 'Program : QB Invaders
|
| 'Version : Ver 1.1 for Qbasic
|
| 'Type : Shareware
|
| 'Revised : 4/29/97
|
| 'Author : Tim Truman
|
| 'Address : NET -TimTruman@aol.com, AOL-TimTruman
|
| '
|
| 'Copyright(c) 1997 Nocturnal Creations
|
| '
|
| 'Feel free to use any routines or code found this program in your own
|
| 'as long as you credit Tim Truman as the contributer. Graphics and sounds
|
| 'are property of Tim Truman and may not be used.
|
| '
|
| 'I just ask that you do not distribute this source code program or
|
| 'modify and recompile the program for reasons other than personal use.
|
| '
|
| 'You are not obligated... however if you like QB Invaders, or plan to use
|
| 'code from it, please register by sending a small amount of money to :
|
| 'Tim Truman
|
| '110 Homestead Ave.
|
| 'Springfield, MA 01151
|
| 'USA
|
| '
|
| '-------------------
|
| 'Info & Requirements
|
| '-------------------
|
| 'Graphics for this program were made using SPRITE 2.0.
|
| 'Adlib sound effects were made using FX.
|
| 'Requires a VGA.
|
| 'Recommend 386 or higher processor, and a sound card.
|
| '
|
| '-------------------
|
| 'Running QBInvaders * Important read this ! *
|
| '-------------------
|
| 'Playing under DOS:
|
| ' Type qbasic /run qbinvade.
|
| '
|
| 'Playing under WIN 3.1 and WIN 95 :
|
| ' Use the File Manager and double click on the MSDOS shortcut.
|
| ' Why?
|
| ' Some key combinations are reserved to windows like ALT-SPACE
|
| ' combo used by this program. Using the MSDOS shortcut realeases
|
| ' this key combo for Qbasic, preventing program errors.
|
| '
|
| '-------------------
|
| ' Program options
|
| '-------------------
|
| ' (1) Change the 'UseFX' variable to false for PC speaker sounds.
|
| ' (2) Change the 'Hard' variable to true for harder gameplay.
|
| ' (3) Two graphics set are available.
|
|
|
|
|
| DefInt A-Z
|
|
|
| Type hues ' define the type for hues
|
| red As Integer ' red component
|
| grn As Integer ' green component
|
| blu As Integer ' blue component
|
| End Type
|
|
|
| Type sprite
|
| x As Integer 'current alien location
|
| y As Integer '
|
| lx As Integer 'last alien location
|
| ly As Integer '
|
| w As Integer 'width of image
|
| h As Integer 'height of image
|
| dir As Integer 'referenced for movement
|
| health As Integer 'aliens well being
|
| sseg As Integer 'segment of alien char
|
| tile As Integer 'offset to frame
|
| ltile As Integer 'for erase
|
| hit As Integer 'check for a hit before moving
|
| End Type
|
|
|
| Type highscores 'type for highscores
|
| rank As String * 3 'rank
|
| dat As String * 8 'date
|
| nam As String * 25 'name
|
| lines As String * 4 'lines
|
| score As String * 6 'score
|
| End Type
|
|
|
| DECLARE SUB clearbuffer ()
|
| DECLARE SUB DoAliens ()
|
| DECLARE SUB DoAlienBombs ()
|
| DECLARE SUB DoCollisions ()
|
| DECLARE SUB DocommandShip ()
|
| DECLARE SUB EndToDos ()
|
|
|
| DECLARE SUB DoHighScores ()
|
| DECLARE SUB Dolevel ()
|
| DECLARE SUB DoScore (points)
|
| DECLARE SUB DoGunShot ()
|
| DECLARE SUB DoGunshot2 ()
|
| DECLARE SUB DoGunner ()
|
| DECLARE SUB DoGameEnd ()
|
| DECLARE SUB FadePal (fc%, lc%, level%, mode%)
|
| DECLARE SUB GetReady ()
|
|
|
| DECLARE SUB InitGameStart ()
|
| DECLARE SUB Initlevel ()
|
| DECLARE SUB Intro ()
|
| DECLARE SUB Mouse (argument)
|
| DECLARE SUB p5x7font (x, y, text$, colour)
|
| DECLARE SUB playsfx (fx&)
|
| DECLARE SUB PalRegInfo (reg, red, grn, blu, mode)
|
| DECLARE SUB Pfont (text$, x, y, colour)
|
| DECLARE SUB ShowHighScores (score() AS highscores, mode)
|
| DECLARE SUB soundfx (fx)
|
| DECLARE SUB stay (Millisecs!)
|
| DECLARE SUB TitleScreen ()
|
|
|
| DECLARE FUNCTION CheckFiles ()
|
| DECLARE FUNCTION DoExplode (x, y)
|
| DECLARE FUNCTION DropFileList (filename$)
|
| DECLARE FUNCTION Fileexists (filename$)
|
| DECLARE FUNCTION GetFileName$ (filespec$)
|
| DECLARE FUNCTION InputText$ (xcur%, ycur%, length%)
|
| DECLARE FUNCTION returnevent ()
|
| DECLARE FUNCTION TimeIsUp (n, tsecs!)
|
|
|
| 'mapped key values
|
| Const up = -72
|
| Const Down = -80
|
| Const Left = -75
|
| Const Right = -77
|
| Const Eight = 56
|
| Const Two = 50
|
| Const Enter = 13
|
| Const Esc = 27
|
| Const space = 32
|
| Const letterc = 99
|
| 'mouse
|
| Const leftclick = 1
|
| Const rightclick = 2
|
| 'other
|
| Const true = 1
|
| Const false = 0
|
|
|
| Common Shared Maxx, Maxy, event, font(), pal() As hues
|
| Common Shared sprites(), elmPerSpr, NewAlienFrame, spriteheight, spritewidth
|
| Common Shared alien() As sprite, numberofaliens, AliensInPLay, movealiens
|
| Common Shared AliensPerCol, AliensPerRow, alienvelx, AlienVely, TimeToStep!
|
| Common Shared AlienStartX, AlienStartY, AlienStepX, AlienStepY
|
| Common Shared abomb() As sprite, Numberofbombs, AbombInterval!, Abombvel
|
| Common Shared gunner As sprite, gunnerlives
|
| Common Shared gunner2 As sprite, gunnerlives2
|
| Common Shared gunnerMaxx, GunnerMinx, numplayers, gunnervel
|
|
|
| Common Shared gunshot As sprite, GunShotVel
|
| Common Shared cship As sprite, headisup
|
| Common Shared shield() As sprite, NumberofShields
|
| Common Shared Barrier() As sprite
|
| Common Shared level, gamescore&, UseFX, Hard
|
|
|
| Cls
|
|
|
| 'Dim Shared c$(8) 'FM register information for 9 channels
|
| 'c$(0) = "&hB0&h20&h23&h40&h43&h60&h63&h80&h83&hA0&HBD&HC0&HE0&HE3&hB0"
|
| 'c$(1) = "&hB1&h21&h24&h41&h44&h61&h64&h81&h84&hA1&HBD&HC1&HE1&HE4&hB1"
|
| 'c$(2) = "&hB2&h22&h25&h42&h45&h62&h65&h82&h85&hA2&HBD&HC2&HE2&HE5&hB2"
|
| 'c$(3) = "&hB3&h28&h2B&h48&h4B&h68&h6B&h88&h8B&hA3&HBD&HC3&HE8&HEB&hB3"
|
| 'c$(4) = "&hB4&h29&h2C&h49&h4C&h69&h6C&h89&h8C&hA4&HBD&HC4&HE9&HEC&hB4"
|
| 'c$(5) = "&hB5&h2A&h2D&h4A&h4D&h6A&h6D&h8A&h8D&hA5&HBD&HC5&HEA&HED&hB5"
|
| 'c$(6) = "&hB6&h30&h33&h50&h53&h70&h73&h90&h93&hA6&HBD&HC6&HF0&HF3&hB6"
|
| 'c$(7) = "&hB7&h31&h34&h51&h54&h71&h74&h91&h94&hA7&HBD&HC7&HF1&HF4&hB7"
|
| 'c$(8) = "&hB8&h32&h35&h52&h55&h72&h75&h92&h95&hA8&HBD&HC8&HF2&HF5&hB8"
|
|
|
| 'Dim Shared sfx$(25) 'dim array to hold 26 sounds
|
| 'Open ".\qbinvade.sfx" For Input As #1 'open the .SFX file
|
| 'For sfxnum% = 0 To 25 'first to last
|
| 'Input #1, sfx$(sfxnum%) 'load sound into string
|
| 'Next 'next sound
|
| 'Close #1 'close the file
|
| Common Shared sound1&, sound2&, sound3&, sound4&, sound5&, sound6&, sound7&, sound8&, sound9&
|
| 'Load Sound neu ============================
|
| Dim buffer As String: buffer = LoadSoundData1$
|
| sound1& = _SndOpen(buffer, "memory")
|
| buffer = LoadSoundData1$
|
| sound1 = _SndOpen(buffer, "memory")
|
| buffer = LoadSoundData2$
|
| sound2& = _SndOpen(buffer, "memory")
|
| buffer = LoadSoundData3$
|
| sound3& = _SndOpen(buffer, "memory")
|
| buffer = LoadSoundData4$
|
| sound4& = _SndOpen(buffer, "memory")
|
| buffer = LoadSoundData5$
|
| sound5& = _SndOpen(buffer, "memory")
|
| buffer = LoadSoundData6$
|
| sound6& = _SndOpen(buffer, "memory")
|
| buffer = LoadSoundData7$
|
| sound7& = _SndOpen(buffer, "memory")
|
| buffer = LoadSoundData8$
|
| sound8& = _SndOpen(buffer, "memory")
|
| buffer = LoadSoundData9$
|
| sound9& = _SndOpen(buffer, "memory")
|
| buffer = LoadSoundData10$
|
| sound10& = _SndOpen(buffer, "memory")
|
| Screen 13 'set video mode
|
| _FullScreen
|
| Maxx = 319 'store screen size
|
| Maxy = 199 'ditto
|
|
|
| Out &H60, &HF3 'inform keyboard port
|
| stay (500) 'let hardware settle
|
| Out &H60, 0 'fast typematic rate with min delay
|
|
|
| bucket = TimeIsUp(7, -1) 'set up timers
|
| stay (1) 'initilaize delay routine
|
|
|
| ReDim pal(255) As hues 'array for palette
|
| Def Seg = VarSeg(pal(0)) 'point to it
|
| BLoad ".\default.pal", 0 'load it
|
| Out &H3C8, 0 'inform VGA
|
| For c = 0 To 255 'entire palette
|
| Out &H3C9, pal(c).red 'send red component
|
| Out &H3C9, pal(c).grn 'send green component
|
| Out &H3C9, pal(c).blu 'send blue component
|
| Next 'next attribute
|
|
|
| Dim font(127, 4, 6) 'DIM array for fonts
|
| Def Seg = VarSeg(font(0, 0, 0)) 'Point to it
|
| BLoad ".\qbinvade.fnt", 0 'Load 'em in
|
|
|
| ' Unremark image file to load. ********** Choose graphics. *************
|
| 'filename$ = "atari.spr"
|
| filename$ = ".\qbinvade.spr"
|
|
|
| Cls
|
| Filesize& = 12877 'File size
|
| bytes = (Filesize& - 7) \ 2 - 1 'BSAVE & BLOAD use 7 bytes
|
| Dim sprites(bytes) 'dim the sprite array
|
| Def Seg = VarSeg(sprites(0)) 'point to it
|
| BLoad filename$, 0 'load the sprite file
|
| spritewidth = sprites(0) \ 8 'get image width
|
| spriteheight = sprites(1) 'get image height
|
| elmPerSpr = ((spritewidth * spriteheight) \ 2) + 3 ' elements in one image
|
|
|
|
|
| Randomize Timer 'seed randomizer
|
| UseFX = true 'true 'set to false for PC speaker
|
| Hard = false 'set to true for harder gameplay
|
| TitleScreen 'start intro
|
| InitGameStart 'init game varaibles/screen
|
|
|
|
|
| Do 'level loop
|
|
|
| level = level + 1 'increment level
|
| Initlevel 'display graphics
|
| GetReady 'tell user game is ready
|
|
|
| Do 'game loop
|
| event = returnevent 'get events
|
| If event = Esc Then EndToDos 'user wants out
|
| DoAlienBombs
|
| DoAliens
|
| If TimeIsUp(3, 15) Then cship.health = true 'time appearance of command ship
|
| DocommandShip
|
| DoCollisions
|
| DoGunner
|
| DoGunShot
|
| Loop Until AliensInPLay = 0
|
|
|
| Loop
|
|
|
|
|
|
|
| 'data to reconstruct qbinvader.scr in the event it is erased
|
| Data 1,4/11/97,Timothy Truman,2000
|
| Data 2,4/11/97,John Denesha,2000
|
| Data 3,4/11/97,David Pastore,2000
|
| Data 4,4/11/97,John Matias,2000
|
| Data 5,4/11/97,Mike Eberts,1500
|
| Data 6,4/11/97,Bonnie Soffan,1500
|
| Data 7,4/11/97,Patty Effilo,1500
|
| Data 8,4/11/97,Kelsi Donahue,1450
|
| Data 9,4/11/97,Sabrina McIntosh,1450
|
| Data 10,4/11/97,Colleen Wise,1450
|
| Data 11,4/11/97,Michelle Poules,1300
|
| Data 12,4/11/97,Dominic Amato,1300
|
| Data 13,4/11/97,Bobby Barkett,1300
|
| Data 14,4/11/97,Tracy Truman,1200
|
| Data 15,4/11/97,Chris Hitas,1200
|
|
|
|
|
| ' Visit this FTP for my latest programs and utilities :
|
| ' members.aol.com/TimTruman
|
|
|
| Sub clearbuffer 'clear keyboard buffer
|
| Def Seg = &H40 'point to low memory
|
| Poke &H1A, Peek(&H1C) 'point head to tail
|
| End Sub
|
|
|
| Sub DoAlienBombs
|
|
|
| For ab = 1 To Numberofbombs 'do alien bombs
|
| If abomb(ab).health = false Then 'new one set up
|
| If TimeIsUp(2, AbombInterval!) Then 'time has passed
|
| For a = 1 To numberofaliens
|
| If alien(a).health Then 'wide scan for gunner
|
| If alien(a).x < gunner.x Or alien(a).x > gunner.x - gunner.w Then
|
| AlienUnder = false 'assume alien under
|
| For m = 1 To AliensPerCol 'next row down
|
| lookunder = (a + (AliensPerRow * m)) 'calc down one
|
| If lookunder <= numberofaliens Then 'Alien there ?
|
| If alien(lookunder).health = 1 Then AlienUnder = true 'This one can't fire
|
| End If
|
| Next
|
| If AlienUnder = false Then
|
| maybe = Rnd * 12 'this one is possible
|
| If maybe > 1 And maybe < 6 Then 'use 'em
|
| abomb(ab).health = alien(a).health 'set up Bomp
|
| abomb(ab).x = alien(a).x + alien(a).w / 2 'ditto
|
| abomb(ab).y = alien(a).y + alien(a).h 'ditto
|
| abomb(ab).lx = abomb(ab).x 'ditto
|
| abomb(ab).ly = abomb(ab).y 'ditto
|
| Exit For 'Outa here
|
| End If
|
| 'narrow scan
|
| If alien(a).x >= gunner.x And alien(a).x < gunner.x + gunner.w Then
|
| If maybe <> 0 Then 'use 'em
|
| abomb(ab).health = alien(a).health 'set up Bomp
|
| abomb(ab).x = alien(a).x + alien(a).w / 2 'ditto
|
| abomb(ab).y = alien(a).y + alien(a).h 'ditto
|
| abomb(ab).lx = abomb(ab).x 'ditto
|
| abomb(ab).ly = abomb(ab).y 'ditto
|
| Exit For 'outa here
|
| End If
|
| End If
|
| End If
|
| End If
|
| End If
|
| Next 'check next alien
|
| End If
|
|
|
| ElseIf abomb(ab).health = true Then 'animate it
|
| Line (abomb(ab).lx, abomb(ab).ly)-(abomb(ab).lx, abomb(ab).ly + abomb(ab).h), 0
|
| abomb(ab).y = abomb(ab).y + Abombvel + Hard 'adjust bomb y
|
| If abomb(ab).y > Maxy Then 'it's off screen
|
| abomb(ab).health = 0 'Kill it
|
| Else 'still visible
|
| Line (abomb(ab).x, abomb(ab).y)-(abomb(ab).x, abomb(ab).y + abomb(ab).h), 138
|
| abomb(ab).lx = abomb(ab).x: abomb(ab).ly = abomb(ab).y 'for erase
|
| _Delay .005
|
| End If
|
| End If
|
|
|
| Next
|
|
|
|
|
|
|
| End Sub
|
|
|
| Sub DoAliens
|
|
|
| Static dir, ctr1
|
|
|
|
|
|
|
| If TimeIsUp(1, TimeToStep!) Then 'Move aliens ?
|
|
|
| For a = 1 To numberofaliens 'look for live aliens
|
| If alien(a).health Then 'got one
|
| CountEm = CountEm + 1 'count em in
|
| If dir = 1 Then 'going left
|
| alien(a).x = alien(a).x - alienvelx 'adjust x position
|
| If alien(a).x <= alienvelx Then dflag = true 'drop em ?
|
| If dflag And CountEm = AliensInPLay Then 'wait for every x adjust
|
| For b = 1 To numberofaliens 'drop em all at once
|
| If alien(b).health Then alien(b).y = alien(b).y + AlienVely
|
| Next 'next one
|
| dflag = false: dir = 0 'did drop; change direction
|
| End If
|
| ElseIf dir = 0 Then 'going right
|
| alien(a).x = alien(a).x + alienvelx 'adjust x position
|
| If alien(a).x > Maxx - alien(a).w - alienvelx Then dflag = true ' drop ?
|
| If dflag And CountEm = AliensInPLay Then 'wait for every x adjust
|
| For b = 1 To numberofaliens 'drop em all at once
|
| If alien(b).health Then alien(b).y = alien(b).y + AlienVely
|
| Next 'next
|
| dflag = false: dir = 1 'did drop; change direction
|
| End If
|
| End If
|
| End If
|
| Next
|
| CountEm = 0 'reset
|
| movealiens = true 'update screen
|
| End If
|
|
|
| Do: Loop Until (Inp(&H3DA) And 8) 'wait for VGA retrace
|
|
|
| If movealiens = true Then
|
| For a = numberofaliens To 1 Step -1 'start at bot
|
| If alien(a).health And (alien(a).hit = false) Then 'got a live one
|
| Put (alien(a).lx, alien(a).ly), sprites(elmPerSpr * 20), PSet 'erase last
|
| alien(a).tile = (alien(a).tile + elmPerSpr) Mod NewAlienFrame 'calc ani frame
|
| alien(a).tile = alien(a).tile + alien(a).sseg 'calc alien
|
| Put (alien(a).x, alien(a).y), sprites(alien(a).tile), PSet 'Put it
|
| alien(a).lx = alien(a).x: alien(a).ly = alien(a).y 'for erase
|
| alien(a).ltile = alien(a).tile 'ditto
|
| End If
|
| Next
|
|
|
| If UseFX = 1 Then
|
| ctr1 = (ctr1 + 1) Mod 2
|
| If ctr1 Then playsfx (sound2&) Else playsfx (sound8&)
|
| Else
|
| soundfx (1)
|
| End If
|
| movealiens = false 'done
|
|
|
| End If
|
|
|
| End Sub
|
|
|
| Sub DoCollisions
|
|
|
| '--* do collisions
|
| '--* check for collisions between aliens and gunshots using a bounding box
|
|
|
| For b = 1 To numberofaliens
|
| If alien(b).health = 1 And gunshot.health = 1 Then
|
| If gunshot.y >= alien(b).y And gunshot.y <= alien(b).y + alien(b).h Then
|
| If gunshot.x >= alien(b).x And gunshot.x <= alien(b).x + alien(b).w Then
|
| Put (alien(b).lx, alien(b).ly), sprites(alien(b).ltile) 'erase old
|
| Line (gunshot.lx, gunshot.ly)-(gunshot.lx, gunshot.ly + gunshot.h), 0
|
| 'soundfx (4)
|
| If UseFX = 1 Then
|
| playsfx (sound4&)
|
| Else
|
| soundfx (4)
|
| End If
|
|
|
| alien(b).health = 0
|
| gunshot.health = 0
|
| AliensInPLay = AliensInPLay - 1 'one less alien
|
| row = ((b - 1) \ (AliensPerRow)) + 1
|
| points = 5 * Abs(row - (AliensPerRow + 1))
|
| DoScore (points)
|
| Exit For
|
| End If
|
| End If
|
| End If
|
| Next
|
|
|
|
|
| '--* check for collisions between alien bombs and barriers
|
|
|
| For ab = 1 To Numberofbombs
|
| For b = 1 To 2
|
| If abomb(ab).health Then
|
| If abomb(ab).y > Barrier(b).y And abomb(ab).y < Barrier(b).y + spriteheight Then
|
| If abomb(ab).x >= Barrier(b).x And abomb(ab).x <= Barrier(b).x + spritewidth Then
|
| abomb(ab).health = 0
|
| Line (abomb(ab).lx, abomb(ab).ly)-(abomb(ab).lx, abomb(ab).ly + abomb(ab).h), 0
|
| End If
|
| End If
|
| End If
|
| Next
|
| Next
|
|
|
| '--* check for collisions between alien bombs and gunner
|
|
|
| For ab = 1 To Numberofbombs
|
| If abomb(ab).health = 1 Then
|
| If abomb(ab).x > (gunner.x + 4) And abomb(ab).x < (gunner.x + gunner.w - 4) Then
|
| If abomb(ab).y >= gunner.y And abomb(ab).y <= gunner.y Then
|
| abomb(ab).health = 0
|
| gunner.health = 0
|
| Line (abomb(ab).lx, abomb(ab).ly)-(abomb(ab).lx, abomb(ab).ly + abomb(ab).h), 0
|
| End If
|
| End If
|
| End If
|
| Next
|
|
|
|
|
|
|
| '--* bombs against gunshots
|
|
|
| For ab = 1 To Numberofbombs
|
| If abomb(ab).health = 1 And gunshot.health Then
|
| If abomb(ab).x = gunshot.x Then
|
| If abomb(ab).y >= gunshot.y And abomb(ab).y <= gunshot.y + gunshot.h Then
|
| abomb(ab).health = 0
|
| gunshot.health = 0
|
| Line (abomb(ab).lx, abomb(ab).ly)-(abomb(ab).lx, abomb(ab).ly + abomb(ab).h), 5
|
| Line (gunshot.x, gunshot.y)-(gunshot.x, gunshot.y + gunshot.h), 0, BF 'ditto
|
| '_Delay 1
|
| If UseFX = true Then
|
| playsfx (sound4&)
|
| Else
|
| soundfx (3)
|
| End If
|
| End If
|
| End If
|
| End If
|
| Next
|
|
|
| '--* alienbombs against shields
|
|
|
| For s = 1 To NumberofShields
|
| For ab = 1 To Numberofbombs
|
| If abomb(ab).x > shield(s).x And abomb(ab).x < shield(s).x + shield(s).w Then
|
| If abomb(ab).y >= shield(s).y And abomb(ab).y <= shield(s).y + shield(s).h Then
|
| If Point(abomb(ab).x, abomb(ab).y + abomb(ab).h + 1) > 0 Then
|
| Line (abomb(ab).x, abomb(ab).y)-(abomb(ab).x, abomb(ab).y + abomb(ab).h + 1), 0
|
| PSet (abomb(ab).x + (Rnd * -2), abomb(ab).y + abomb(ab).h + 1), 0
|
| PSet (abomb(ab).x + (Rnd * 2), abomb(ab).y + abomb(ab).h + 1), 0
|
| abomb(ab).health = 0
|
| End If
|
| End If
|
| End If
|
| Next
|
| Next
|
|
|
|
|
| '--* gunshots against shields
|
|
|
| For s = 1 To NumberofShields
|
| If gunshot.x > shield(s).x And gunshot.x < shield(s).x + shield(s).w Then
|
| If gunshot.y >= shield(s).y And gunshot.y <= shield(s).y + shield(s).h Then
|
| If Point(gunshot.x, gunshot.y - 1) > 0 Then
|
| Line (gunshot.x, gunshot.y - 1)-(gunshot.x, gunshot.y + gunshot.h), 0
|
| gunshot.health = 0
|
| End If
|
| End If
|
| End If
|
| Next
|
|
|
| '--* gunshots against command ship
|
|
|
| If cship.health And gunshot.health Then
|
| If gunshot.y < cship.y + spriteheight Then
|
| If gunshot.x > cship.x And gunshot.x < cship.x + spritewidth Then
|
|
|
| If headisup Then
|
| gunnerlives = gunnerlives + 1
|
| If UseFX = true Then
|
| playsfx (sound7&)
|
| Else
|
| soundfx (7)
|
| End If
|
| Else
|
| If UseFX = true Then
|
| playsfx (sound6&)
|
| Else
|
| soundfx (6)
|
| End If
|
| End If
|
|
|
| cship.health = 0
|
| gunshot.health = 0
|
| Line (gunshot.x, gunshot.y)-(gunshot.x, gunshot.y + gunshot.h), 0, BF 'ditto
|
| '_Delay 1
|
| DoScore (50)
|
| End If
|
| End If
|
| End If
|
|
|
|
|
| For a = 1 To numberofaliens
|
| If alien(a).y + alien(a).h >= gunner.y Then
|
| If UseFX = true Then
|
| playsfx (sound9&)
|
| Else
|
| soundfx (5)
|
| End If
|
| clearbuffer
|
| Do: Loop Until returnevent
|
| DoGameEnd
|
| End If
|
| Next
|
|
|
| End Sub
|
|
|
| Sub DocommandShip
|
|
|
| Static initialize, startframe, xstart, dir, frame, framedir, counter
|
|
|
|
|
|
|
| If cship.health Then
|
|
|
| If Not initialize Then
|
| startframe = (24 * elmPerSpr) 'calc start frame
|
| cship.x = 300 'set start coridinates
|
| cship.y = 1 'ditto
|
| For xerase = 1 To 300 Step 20 'clear top of screen
|
| Put (xerase, 1), sprites(20 * elmPerSpr), PSet
|
| Next
|
|
|
| ' soundfx (8) 'make command ship noise
|
| If UseFX = true Then
|
| playsfx (sound3&)
|
| Else
|
| soundfx (8)
|
| End If
|
|
|
| initialize = Not initialize 'don't do this again
|
| End If
|
| _Delay .005
|
| If TimeIsUp(5, 3) Then 'soundfx (8) 'time sound effect
|
| If UseFX = true Then
|
| playsfx (sound3&)
|
| Else
|
| soundfx (8)
|
| End If
|
| End If
|
|
|
| Put (cship.lx, cship.y), sprites(20 * elmPerSpr), PSet 'clear spot
|
| Put (cship.x, cship.y), sprites(startframe + (frame * elmPerSpr)), PSet
|
|
|
| If framedir = 0 Then 'add to last frame
|
| If TimeIsUp(4, 1.1) Then frame = (frame + 1) Mod 6 'time frames
|
| If frame = 5 Then 'extra life hitting this frame
|
| headisup = true 'raise flag
|
| framedir = 1 'reverse frame direction
|
| End If
|
| Else 'subtract from last frame
|
| If TimeIsUp(4, 1.1) Then
|
| frame = (frame - 1) 'time frames
|
| headisup = false 'drop flag
|
| End If
|
| If frame = 0 Then framedir = 0 'reverse frame direction
|
| End If
|
|
|
| cship.lx = cship.x 'save for erase
|
|
|
| counter = (counter + 1) Mod 3 'slow down ship movement
|
| If counter = 2 Then cship.x = cship.x - 1 'move ship
|
|
|
| If cship.x <= 1 Then cship.health = false 'ship reached left limit
|
|
|
| ElseIf cship.health = false Then 'ship has gone off screen
|
|
|
| If initialize Then
|
| Put (cship.x, 1), sprites(20 * elmPerSpr), PSet 'remove ship
|
| bitbucket = TimeIsUp(3, 0) 'reset timers
|
| bitbucket = TimeIsUp(4, 0) 'ditto
|
| bitbucket = TimeIsUp(5, 0) 'ditto
|
| initialize = Not initialize 'to re-initialize ship
|
| framedir = 0 'reset frame direction
|
| DoScore (0) 'redraw score and lives
|
| End If
|
| End If
|
|
|
| End Sub
|
|
|
| Function DoExplode (x, y)
|
|
|
| Static frame
|
|
|
| ExplodeFrame = elmPerSpr * 17 'point to Explosion frames
|
|
|
| DoExplode = false
|
|
|
| Put (x, y), sprites(ExplodeFrame + (frame * elmPerSpr)), PSet ' dislplay it
|
|
|
| If TimeIsUp(3, .4) Then 'time each frame
|
| Put (x, y), sprites(ExplodeFrame + ((frame + 1) * elmPerSpr)), PSet ' dislplay it
|
| frame = (frame + 1) Mod 3 'calc next frame
|
| If frame = 0 Then DoExplode = true 'Did all frames
|
| End If
|
|
|
|
|
|
|
|
|
|
|
|
|
| End Function
|
|
|
| Sub DoGameEnd
|
|
|
| FadePal 16, 255, 60, 1
|
|
|
| p5x7font 125, 90, "Game Over", 30
|
| 'Pfont "Game Over", 125, 90, 90
|
| 'playsfx (sfx$(10))
|
| FadePal 16, 255, 60, 0
|
| If UseFX = true Then 'make hit noise
|
| playsfx (sound9&)
|
| Else
|
| soundfx (9)
|
| End If
|
|
|
|
|
|
|
| _Delay .005
|
| Do: Loop Until returnevent
|
|
|
| DoHighScores
|
|
|
|
|
| 'CHAIN "qbinvade.exe"
|
|
|
| End
|
|
|
| End Sub
|
|
|
| Sub DoGunner
|
|
|
| If gunner.health Then
|
|
|
| 'kbyte3 = _KeyHit
|
| Def Seg = &H0 'point to low memory
|
| kbyte1 = Peek(&H417) 'get keyboard byte status
|
| kbyte2 = Peek(&H418) 'ditto
|
|
|
| 'If kbyte3 = 19712 Then
|
| If _KeyDown(19712) Then
|
| gunner.x = gunner.x + gunnervel 'move gunner
|
| End If
|
|
|
| If (kbyte1 And &H4) Then 'left ctrl key
|
| gunner.x = gunner.x + gunnervel 'move gunner 'check Ctrl key
|
| End If
|
|
|
| 'If kbyte3 = 19200 Then
|
| If _KeyDown(19200) Then
|
| gunner.x = gunner.x - gunnervel 'move gunner
|
| End If
|
|
|
| If (kbyte1 And &H8) Then 'alt key
|
| gunner.x = gunner.x - gunnervel 'move gunner
|
| End If
|
|
|
|
|
| If gunner.x > gunnerMaxx Then gunner.x = gunnerMaxx 'keep gunner in bounds
|
| If gunner.x < GunnerMinx Then gunner.x = GunnerMinx 'ditto
|
|
|
| If gunner.x <> gunner.lx Then 'gunner moved ?
|
| Put (gunner.lx, gunner.ly), sprites(gunner.ltile) 'erase old
|
| gunner.tile = ((gunner.tile + elmPerSpr) Mod NewAlienFrame) + gunner.sseg
|
| Put (gunner.x, gunner.y), sprites(gunner.tile), PSet 'draw new
|
| gunner.lx = gunner.x: gunner.ly = gunner.y 'for erase
|
| gunner.ltile = gunner.tile 'ditto
|
| End If
|
|
|
| Else 'gunner got hit
|
|
|
|
|
| If UseFX = true Then 'make hit noise
|
| playsfx (sound6&)
|
| Else
|
| soundfx (2)
|
| End If
|
|
|
| Do
|
| clearbuffer 'clear key buffer
|
| If DoExplode(gunner.x, gunner.y) Then 'show all frames ?
|
| Do: clearbuffer: Loop Until TimeIsUp(3, .7) 'wait a bit so user can get ready
|
| gunnerlives = gunnerlives - 1 'less one gun
|
| DoScore (0) 'redraw gun count
|
| If gunnerlives = 0 Then DoGameEnd 'any more guns ?
|
| For ab = 1 To Numberofbombs 'yes, then reset alien bombs
|
| abomb(ab).health = 0 'kill bomb and remove it from screen
|
| Line (abomb(ab).x, abomb(ab).y)-(abomb(ab).x, abomb(ab).y + abomb(ab).h), 0
|
| Next 'next alien bomb
|
| gunner.health = 1 'reset gunner health
|
| Put (gunner.x, gunner.y), sprites(gunner.tile), PSet 'put on screen
|
| End If
|
| Loop Until gunner.health = 1 ' all done
|
|
|
| End If
|
|
|
|
|
| End Sub
|
|
|
| Sub DoGunShot
|
|
|
| Static colour
|
|
|
| If gunshot.health = false Then 'Do gun shot
|
| If event = space Then 'fire shot ?
|
| gunshot.x = gunner.x + (gunner.w / 2) 'calc pos
|
| gunshot.y = gunner.y - 1
|
| gunshot.health = 1 'give it life
|
| gunshot.lx = gunner.x 'for erase
|
| gunshot.ly = gunner.y 'ditto
|
| If UseFX Then playsfx (sound1&)
|
| End If
|
| ElseIf gunshot.health = true Then 'animate it
|
| PSet (gunshot.lx, gunshot.ly), 0 'erase last
|
| Line -(gunshot.lx, gunshot.ly + gunshot.h), 0, BF 'ditto
|
| gunshot.y = gunshot.y - GunShotVel 'move shot
|
|
|
| If cship.health Then
|
| If gunshot.y < 1 Then gunshot.health = 0 'it's off screen
|
| Else
|
| If gunshot.y < spriteheight + 1 Then gunshot.health = 0
|
| End If
|
| If gunshot.health Then
|
| colour = ((colour + 1) Mod 16) + 48
|
| PSet (gunshot.x, gunshot.y), 0 'draw new
|
| Line -(gunshot.x, gunshot.y + gunshot.h), colour 'ditto
|
| gunshot.lx = gunshot.x: gunshot.ly = gunshot.y 'for erase
|
| _Delay .005
|
| End If
|
| End If
|
|
|
|
|
|
|
| End Sub
|
|
|
| Sub DoHighScores
|
|
|
| fc = 199
|
|
|
| Dim score(1 To 16) As highscores
|
|
|
| filespec$ = "qbvaders.scr"
|
|
|
| Open filespec$ For Random As #1 Len = 46 'open high score file
|
| For n = 1 To 15 'first to last
|
| Get #1, n, score(n) 'load it in
|
| Next n 'next entry
|
| Close #1 'close the file
|
|
|
| If Val(score(1).score) = 0 Then 'did file exist
|
| Open filespec$ For Random As #1 Len = 46 'create file
|
| For n = 1 To 15 'first to last
|
| Read a$, b$, c$, d$ 'read in data
|
| score(n).rank = a$ 'store it
|
| score(n).dat = b$ 'ditto
|
| score(n).nam = c$ 'ditto
|
| score(n).score = d$ 'ditto
|
| Put #1, n, score(n) 'write it
|
| Next n 'next entry
|
| Close #1 'close file
|
| End If
|
|
|
|
|
| Temp$ = LTrim$(Str$(gamescore&)) 'convert to clean string
|
| addpad = 6 - Len(Temp$) 'calc padding
|
| gamescor$ = Temp$ + String$(addpad, 32) 'add it
|
|
|
| For rank = 1 To 15 'find players rank
|
|
|
| If gamescore& > Val(score(rank).score) Then 'make the list ?
|
| madelist = true 'setflag
|
|
|
| For bump = 14 To rank Step -1 'sort it
|
| score(bump + 1).dat = score(bump).dat 'bump ahead
|
| score(bump + 1).nam = score(bump).nam 'ditto
|
| score(bump + 1).score = score(bump).score 'ditto
|
| Next 'bump next
|
| month$ = Mid$(Date$, 1, 2) 'get month
|
| day$ = Mid$(Date$, 4, 2) 'get day
|
| year$ = Mid$(Date$, 9, 2) 'get year
|
| format$ = month$ + "/" + day$ + "/" + year$ 'format the date
|
| score(rank).dat = format$ 'store it
|
| score(rank).nam = Space$(14) 'blank name
|
| score(rank).score = gamescor$ 'store gamescore
|
| ShowHighScores score(), 1 'print the list
|
| y = (rank * 10) + 26 'calc y
|
| score(rank).nam = InputText$(93 + 8, y, 199) 'enter name
|
| Open filespec$ For Random As #1 Len = 46 'open file to save
|
| For n = 1 To 15 'first to last
|
| Put #1, n, score(n) 'write entry
|
| Next 'next entry
|
| Close #1 'close file
|
| Exit For 'all done
|
| End If
|
| Next
|
|
|
| If madelist = false Then ShowHighScores score(), 0
|
|
|
|
|
|
|
|
|
| End Sub
|
|
|
| Sub Dolevel
|
|
|
|
|
| Select Case level
|
|
|
| Case 1 To 5
|
| AlienStartY = (level * 7) + 20
|
| alienvelx = 1
|
| TimeToStep! = .5
|
|
|
| Case 6 To 11
|
| AlienStartY = 18
|
| alienvelx = (level - 6) + 1
|
| TimeToStep! = .5
|
|
|
| Case 12
|
| AlienStartY = 21
|
| alienvelx = alienvelx - 2
|
|
|
| Case 13 To 17
|
| AlienStartY = ((level - 14) * 7) + 20
|
| alienvelx = ((level - 14) + 1)
|
| TimeToStep! = .5
|
|
|
| Case 18 To 24
|
| AlienStartY = ((level - 18) * 7) + 20
|
| alienvelx = ((level - 18) + 2)
|
| TimeToStep! = .5
|
|
|
| Case 25
|
| AlienStartY = ((level - 25) * 7) + 20
|
| alienvelx = 7
|
|
|
| Case 26
|
| AlienStartY = ((level - 26) * 7) + 20
|
| alienvelx = 1
|
| TimeToStep! = .5
|
| level = 1
|
|
|
| End Select
|
|
|
|
|
| End Sub
|
|
|
| Sub DoScore (points)
|
|
|
| Static lgunnerlives, lTimeToStep!
|
|
|
| Select Case AliensInPLay
|
| Case 1: TimeToStep! = .01: If level = 25 Then TimeToStep! = 0!
|
| Case 4: TimeToStep! = .09
|
| Case 5 To 8: TimeToStep! = .15
|
| Case 9 To 22: TimeToStep! = .25
|
| Case 23 To 42: TimeToStep! = .5
|
| End Select
|
|
|
| If lTimeToStep! <> TimeToStep! Then
|
| Select Case AliensInPLay
|
| Case 1: alienvelx = alienvelx + 4
|
| Case 4: alienvelx = alienvelx + 1
|
| Case 9 To 22: alienvelx = alienvelx + 1
|
| End Select
|
| End If
|
| lTimeToStep! = TimeToStep!
|
|
|
| startframe = (30 * elmPerSpr) 'point to start of score frames
|
| xscore = 1: yscore = 1
|
| xstep = 20
|
| gamescore& = gamescore& + points
|
|
|
|
|
| If cship.health = false Then
|
|
|
| onedigit = (gamescore& \ 1) Mod 10
|
| tendigit = (gamescore& \ 10) Mod 10
|
| hdigit = (gamescore& \ 100) Mod 10
|
| tdigit = (gamescore& \ 1000) Mod 10
|
| ttdigit = (gamescore& \ 10000) Mod 10
|
|
|
| Put (xscore, yscore), sprites(startframe + (ttdigit * elmPerSpr)), PSet
|
| Put (xscore + xstep, yscore), sprites(startframe + (tdigit * elmPerSpr)), PSet
|
| Put (xscore + (xstep * 2), yscore), sprites(startframe + (hdigit * elmPerSpr)), PSet
|
| Put (xscore + (xstep * 3), yscore), sprites(startframe + (tendigit * elmPerSpr)), PSet
|
| Put (xscore + (xstep * 4), yscore), sprites(startframe + (onedigit * elmPerSpr)), PSet
|
|
|
|
|
| 'gunnerlives = 10
|
| For lives = 1 To 10
|
| If lives >= gunnerlives Then
|
| Put (280 - gx, yscore), sprites(elmPerSpr * 20), PSet
|
| Else
|
| Put (280 - gx, yscore), sprites(gunner.tile), PSet
|
| End If
|
| gx = gx + xstep
|
| Next
|
|
|
|
|
|
|
| End If
|
|
|
|
|
| End Sub
|
|
|
| Sub EndToDos
|
|
|
| Dim buffer(1000)
|
|
|
| x1 = 130
|
| x2 = 190
|
| y1 = 90
|
| y2 = 102
|
|
|
| Get (x1, y1)-(x2, y2), buffer()
|
|
|
| Line (x1, y1)-(x2, y2), 120, BF
|
| Line (x1, y1)-(x2, y2), 123, B
|
| p5x7font x1 + 3, y1 + 3, "Quit? (y/n)", 1
|
| Do
|
| event = returnevent
|
|
|
| Select Case event
|
| Case 89, 121
|
| Exit Do
|
| Case 78, 110
|
| Put (x1, y1), buffer(), PSet
|
| Exit Sub
|
| End Select
|
| Loop
|
| 'zero out adlib regs incase of hanging sounds
|
| ' For sfx = 11 To 19 'sounds effects 11 through 19 zero out all channels
|
| ' If UesFX Then playsfx (sfx$(sfx))
|
| ' Next
|
|
|
|
|
| Width 80
|
| Screen 0, 0, 0
|
|
|
| End
|
|
|
| End Sub
|
|
|
| Sub FadePal (fc, lc, level, mode)
|
|
|
| 'Dim savepal(255) As hues
|
|
|
| 'For attrib = 0 To 255
|
| 'savepal(attrib).red = pal(attrib).red 'save pal to restore
|
| 'savepal(attrib).grn = pal(attrib).grn 'ditto
|
| 'savepal(attrib).blu = pal(attrib).blu 'ditto
|
| 'Next
|
|
|
| If mode Then 'fade in
|
|
|
| For value = 0 To level 'bring 'em all up
|
| Out &H3C8, fc 'tell video card to get ready
|
| For attrib = fc To lc 'first color to last color
|
|
|
| 'If pal(attrib).red >= savepal(attrib).red Then pal(attrib).red = pal(attrib).red + 1
|
| 'If pal(attrib).grn >= savepal(attrib).grn Then pal(attrib).grn = pal(attrib).grn + 1
|
| 'If pal(attrib).blu >= savepal(attrib).blu Then pal(attrib).blu = pal(attrib).blu + 1
|
|
|
| If pal(attrib).red < 255 Then pal(attrib).red = pal(attrib).red + 1
|
| If pal(attrib).grn < 255 Then pal(attrib).grn = pal(attrib).grn + 1
|
| If pal(attrib).blu < 255 Then pal(attrib).blu = pal(attrib).blu + 1
|
|
|
|
|
|
|
| 'If pal(attrib).red > 255 Then pal(attrib).red = 255
|
| 'If pal(attrib).grn > 255 Then pal(attrib).grn = 255
|
| 'If pal(attrib).blu > 255 Then pal(attrib).blu = 255
|
|
|
|
|
| Out &H3C9, pal(attrib).red 'send red component
|
| Out &H3C9, pal(attrib).grn 'send green component
|
| Out &H3C9, pal(attrib).blu 'send blue component
|
|
|
| Next attrib
|
| '_Delay .002
|
| stay (50)
|
| clearbuffer
|
| Next value
|
|
|
| Else 'fade out
|
|
|
| 'ReDim savepal(255) As hues
|
|
|
| 'For attrib = 0 To 255
|
| 'savepal(attrib).red = pal(attrib).red 'save pal to restore
|
| 'savepal(attrib).grn = pal(attrib).grn 'ditto
|
| 'savepal(attrib).blu = pal(attrib).blu 'ditto
|
| 'Next
|
|
|
| For value = 0 To level
|
| Out &H3C8, fc 'tell video card to get ready
|
|
|
| For attrib = fc To lc 'first color to last color
|
|
|
|
|
| If pal(attrib).red > 0 Then pal(attrib).red = pal(attrib).red - 1
|
| If pal(attrib).grn > 0 Then pal(attrib).grn = pal(attrib).grn - 1
|
| If pal(attrib).blu > 0 Then pal(attrib).blu = pal(attrib).blu - 1
|
|
|
| Out &H3C9, pal(attrib).red 'send red component
|
| Out &H3C9, pal(attrib).grn 'send green component
|
| Out &H3C9, pal(attrib).blu 'send blue component
|
|
|
| Next attrib
|
|
|
| '_Delay .002
|
| stay (50)
|
| clearbuffer
|
| Next value
|
|
|
| End If
|
|
|
| End Sub
|
|
|
| Sub GetReady
|
|
|
|
|
| Do
|
| clearbuffer
|
| Loop Until TimeIsUp(7, 1) 'wait a bit so user can get ready
|
| clearbuffer
|
|
|
| x1 = 130
|
| y1 = 80
|
|
|
| Do
|
|
|
| If TimeIsUp(5, .4) Then toggle = Not toggle
|
| If toggle Then
|
| p5x7font x1, y1, "Get Ready", 0
|
| p5x7font x1, y1 + 8, "Wave " + Str$(level), 0
|
|
|
|
|
| Else
|
| p5x7font x1, y1, "Get Ready", 90
|
| p5x7font x1, y1 + 8, "Wave " + Str$(level), 90
|
| End If
|
|
|
| If TimeIsUp(6, 4) Then Exit Do
|
|
|
| Loop Until returnevent = space
|
|
|
| p5x7font x1, y1, "Get Ready", 0
|
| p5x7font x1, y1 + 8, "Wave " + Str$(level), 0
|
|
|
| End Sub
|
|
|
| Sub InitGameStart
|
|
|
| '--* set up aliens
|
|
|
| AliensPerRow = 6 'eight max
|
| If Hard Then AliensPerRow = 8
|
| AliensPerCol = 6 'six max
|
| numberofaliens = (AliensPerRow * AliensPerCol)
|
| AliensInPLay = numberofaliens
|
| Dim alien(AliensInPLay) As sprite 'need storage
|
| AlienStepX = 35 'spaceing
|
| AlienStepY = 20 'ditto
|
| AlienStartX = 35 'position
|
| AlienStartY = 20
|
| alienvelx = 2 'velocity
|
| AlienVely = AlienStepY / 2 'ditto
|
| Cornerx = AlienStartX 'for adding steps
|
| Cornery = AlienStartY 'ditto
|
| AlienEndX = (AlienStepX * AliensPerRow) + AlienStartX 'calc end column
|
| NewAlienFrame = (elmPerSpr * 2) 'to skip animation frames
|
|
|
|
|
| '--*set up gunner 1
|
| gunnerlives = 6
|
| gunnerMaxx = Maxx - (20 * 4) 'set limits of movement
|
| GunnerMinx = (20 * 3) 'ditto
|
| GunnerY = Maxy - 14 'placement
|
| gunnervel = 1 'velocity
|
| gunner.x = gunnerMaxx - 18 'start position
|
| gunner.y = Maxy - 14 'ditto
|
| gunner.lx = gunner.x - 1 'force update
|
| gunner.ly = gunner.y 'ditto
|
| gunner.w = spritewidth 'gunner width
|
| gunner.h = spriteheight 'gunner height
|
| gunner.health = 1 'set health
|
| gunner.sseg = elmPerSpr * 14 'pointer to image
|
| gunner.tile = elmPerSpr * 14 'offset to frame
|
| gunner.ltile = elmPerSpr * 14 'for erase
|
|
|
| '--* set up gunshots
|
| gunshot.w = 1
|
| gunshot.h = 4
|
| gunshot.health = 0
|
| GunShotVel = 2
|
|
|
| '--* set up alien bombs
|
| Numberofbombs = 3
|
| Dim abomb(Numberofbombs) As sprite
|
| For ab = 1 To Numberofbombs
|
| abomb(ab).w = 1
|
| abomb(ab).h = 4
|
| abomb(ab).health = 0
|
| Next
|
| Abombvel = 1
|
| AbombInterval! = .2
|
|
|
| '--* set up shields
|
|
|
| NumberofShields = 3
|
| Dim shield(NumberofShields) As sprite
|
| shield(1).x = 80
|
| shield(1).y = 170
|
| shield(2).x = 150
|
| shield(2).y = 170
|
| shield(3).x = 220
|
| shield(3).y = 170
|
| For s = 1 To NumberofShields
|
| shield(s).w = 20
|
| shield(s).h = 14
|
| Next
|
|
|
| '--* set up barriers
|
|
|
| Dim Barrier(2) As sprite
|
| Barrier(1).x = GunnerMinx - spritewidth
|
| Barrier(1).y = GunnerY
|
| Barrier(1).tile = elmPerSpr * 12
|
| Barrier(2).x = gunnerMaxx + spritewidth
|
| Barrier(2).y = GunnerY
|
| Barrier(2).tile = elmPerSpr * 13
|
|
|
|
|
| Put (Barrier(1).x, Barrier(1).y), sprites(Barrier(1).tile), PSet
|
| Put (Barrier(2).x, Barrier(2).y), sprites(Barrier(2).tile), PSet
|
|
|
| DoScore (0) 'display score
|
|
|
|
|
| End Sub
|
|
|
| Sub Initlevel
|
|
|
| Dolevel
|
| '--* reset alien bombs
|
| For ab = 1 To Numberofbombs 'Do alien bombs
|
| abomb(ab).health = 0 'reset em
|
| Line (abomb(ab).lx, abomb(ab).ly)-(abomb(ab).lx, abomb(ab).ly + abomb(ab).h), 0
|
| Line (abomb(ab).x, abomb(ab).y)-(abomb(ab).x, abomb(ab).y + abomb(ab).h), 0
|
| Next
|
| '--* reset barriers
|
| Put (shield(1).x, shield(1).y), sprites(elmPerSpr * 21), PSet
|
| Put (shield(2).x, shield(2).y), sprites(elmPerSpr * 22), PSet
|
| Put (shield(3).x, shield(3).y), sprites(elmPerSpr * 23), PSet
|
| '--* reset gunner1
|
| Put (gunner.x, gunner.y), sprites(20 * elmPerSpr), PSet
|
| gunner.x = gunnerMaxx - 18
|
| gunner.lx = gunner.x
|
| Put (gunner.x, gunner.y), sprites(gunner.tile), PSet
|
| '--* reset aliens
|
| AliensInPLay = numberofaliens
|
| movealiens = true 'so aliens appear
|
| Cornerx = AlienStartX 'for adding steps
|
| Cornery = AlienStartY 'ditto
|
| AlienEndX = (AlienStepX * AliensPerRow) + AlienStartX 'calc end column
|
| NewAlienFrame = (elmPerSpr * 2) 'to skip animation frames
|
| NextChar = 0
|
| NextFrame = 0
|
| For a = 1 To numberofaliens 'initilaize aliens
|
| alien(a).x = Cornerx 'position
|
| alien(a).y = Cornery 'ditto
|
| alien(a).lx = Cornerx 'ditto
|
| alien(a).ly = Cornery 'ditto
|
| alien(a).w = spritewidth 'size
|
| alien(a).h = spriteheight 'ditto
|
| alien(a).dir = 1 'walk towards left
|
| alien(a).health = 1 'make alive
|
| alien(a).sseg = NextChar 'pointer to images
|
| alien(a).tile = NextChar 'offset to frame
|
| alien(a).ltile = NextChar 'for erase
|
| NextFrame = (NextFrame + elmPerSpr) Mod NewAlienFrame 'calc next frame
|
| Cornerx = Cornerx + AlienStepX 'next column
|
| If Cornerx = AlienEndX Then 'last in row
|
| Cornerx = AlienStartX 'reset column
|
| Cornery = Cornery + AlienStepY 'next row
|
| NextChar = NextChar + (NewAlienFrame) 'next char
|
| End If
|
| Next
|
|
|
|
|
| End Sub
|
|
|
| Function InputText$ (xcur, ycur, length)
|
|
|
| PalRegInfo 255, red, 0, 0, 1 'define cursor color
|
| Dim Edit$(length) 'DIM array to edit
|
| ele = 1 'set first element
|
| Dim background(35, length + 2) 'DIM array to save background
|
| Get (xcur, ycur)-(xcur + 6, ycur + 8), background(35, 1) 'GET background
|
| p5x7font xcur, ycur, "_", 255 'init curser
|
|
|
|
|
| clearbuffer 'clear the keybuffer
|
|
|
| Do
|
|
|
| Do 'event loop
|
| event = returnevent 'anything happen ?
|
| If dir = 0 Then 'strobe cursor
|
| red = red + 1: If red > 62 Then dir = 1 'ditto
|
| Else 'ditto
|
| red = red - 1: If red < 10 Then dir = 0 'ditto
|
| End If 'ditto
|
| Palette 255, (65536 * blu) + (256 * grn) + red 'ditto
|
| Loop Until event 'back for event
|
|
|
| Select Case event
|
|
|
| Case Esc: Exit Do 'do Esc
|
| Case Enter: Exit Do 'do enter
|
|
|
| Case 1 To 7, 9 To 126 'do regular keys
|
| event$ = Chr$(event) 'convert for printing
|
| If ele < length Then 'stay in bounds
|
| Put (xcur, ycur), background(35, ele), PSet
|
| p5x7font xcur, ycur, Chr$(event), 191 'print font
|
| Edit$(ele) = event$ 'in case of backspace
|
| Select Case event$ 'adjust kern
|
| Case "i": xcur = xcur + 2 'ditto
|
| Case "j": xcur = xcur + 5 'ditto
|
| Case "l": xcur = xcur + 2 'ditto
|
| Case "r": xcur = xcur + 5 'ditto
|
| Case ".": xcur = xcur + 3 'ditto
|
| Case "(": xcur = xcur + 3 'ditto
|
| Case ")": xcur = xcur + 3 'ditto
|
| Case "'": xcur = xcur + 2 'ditto
|
| Case "!": xcur = xcur + 2 'ditto
|
| Case Else: xcur = xcur + 6 'ditto
|
| End Select
|
| ele = ele + 1 'advance to next element
|
| Get (xcur, ycur)-(xcur + 6, ycur + 8), background(35, ele)
|
| p5x7font xcur, ycur, "_", 255 'print cursor
|
| End If
|
|
|
| Case Backspace, Left 'do backspace
|
|
|
| If ele > 1 Then
|
| Put (xcur, ycur), background(35, ele), PSet 'restore background
|
| ele = ele - 1 'move to previous element
|
| Select Case (Edit$(ele)) 'adjust kern
|
| Case "i": xcur = xcur - 2 'ditto
|
| Case "j": xcur = xcur - 5 'ditto
|
| Case "l": xcur = xcur - 2 'ditto
|
| Case "r": xcur = xcur - 5 'ditto
|
| Case ".": xcur = xcur - 3 'ditto
|
| Case "(": xcur = xcur - 3 'ditto
|
| Case ")": xcur = xcur - 3 'ditto
|
| Case "'": xcur = xcur - 2 'ditto
|
| Case "!": xcur = xcur - 2 'ditto
|
| Case Else: xcur = xcur - 6 'ditto
|
| End Select
|
| Put (xcur, ycur), background(35, ele), PSet
|
| p5x7font xcur, ycur, "_", 255 'print cursor
|
| Edit$(ele) = Chr$(space) 'clear element
|
| End If
|
| End Select
|
|
|
| Loop
|
|
|
| For n = 1 To length - 1 'put elements into a string
|
| If Edit$(n) = "" Then Edit$(n) = Chr$(space) 'replace nulls
|
| Temp$ = Temp$ + Edit$(n) 'create string
|
| Next n
|
|
|
| InputText$ = Temp$ 'return the string
|
|
|
| End Function
|
|
|
| Sub p5x7font (x, y, text$, colour)
|
|
|
| length = Len(text$) 'get characters to print
|
| If length = 0 Then Exit Sub 'check length
|
|
|
| For char = 0 To length - 1 'print loop
|
|
|
| piece$ = Mid$(text$, char + 1, 1) 'look at each piece of string
|
| aski = Asc(piece$) 'assign it's ASCII value
|
|
|
| Select Case (piece$) 'adjust lower case
|
| Case "g": kerny = kerny + 2 'ditto
|
| Case "j": kerny = kerny + 2 'ditto
|
| Case "p": kerny = kerny + 2 'ditto
|
| Case "q": kerny = kerny + 2 'ditto
|
| Case "y": kerny = kerny + 2 'ditto
|
| End Select
|
|
|
| For ybit = 0 To 6 'top to Bottom
|
| For xbit = 0 To 4 'left to right
|
| If font(aski, xbit, ybit) = 1 Then 'set bits only
|
| PSet (x + xbit + kernx, y + ybit + kerny), colour 'PSET data
|
| End If
|
| Next
|
| Next
|
|
|
| Select Case (piece$) 'kern adjusment
|
| Case "i": kernx = kernx + 2 'ditto
|
| Case "j": kernx = kernx + 5 'ditto
|
| Case "l": kernx = kernx + 2 'ditto
|
| Case "r": kernx = kernx + 5 'ditto
|
| Case ".": kernx = kernx + 3 'ditto
|
| Case "(": kernx = kernx + 3 'ditto
|
| Case ")": kernx = kernx + 3 'ditto
|
| Case "'": kernx = kernx + 2 'ditto
|
| Case "!": kernx = kernx + 2 'ditto
|
| Case Else: kernx = kernx + 6 'ditto
|
| End Select
|
|
|
| kerny = 0 'reset
|
|
|
| Next
|
|
|
| End Sub
|
|
|
| Sub PalRegInfo (reg, red, grn, blu, mode)
|
| Select Case mode
|
| Case 0 'get individual palette register
|
| Out &H3C7, reg 'tell video card which register
|
| red = Inp(&H3C9) 'get red component
|
| grn = Inp(&H3C9) 'get green component
|
| blu = Inp(&H3C9) 'get blue component
|
| Case 1 'set individual palette register
|
| Out &H3C8, reg 'tell video card which register to change
|
| Out &H3C9, red 'send red component
|
| Out &H3C9, grn 'send green component
|
| Out &H3C9, blu 'send blue component
|
| End Select
|
| End Sub
|
|
|
| Sub Pfont (text$, x, y, colour)
|
|
|
|
|
| Def Seg = &HFFA6
|
| For piece = 1 To Len(text$)
|
| address = (8 * Asc(Mid$(text$, piece))) + 14
|
| For hl = 0 To 7
|
| mask = Peek(address + hl) * 128
|
| Line (x + kernx, y + hl)-(x + 8 + kernx, y + hl), colour, , mask
|
| Next
|
| kernx = kernx + 8
|
| Next
|
| 'x = 0
|
| Def Seg
|
|
|
| End Sub
|
|
|
| Sub playsfx (sfx&)
|
|
|
| 'plays an sfx$ that is sent to it.
|
| 'sub expects the c$() array (channel info) to be global
|
|
|
| ' chan% = Val(Mid$(sfx$, 61, 4))
|
| ' For in = 1 To 60 Step 4
|
| ' reg$ = Mid$(c$(chan%), in, 4): reg% = Val(reg$)
|
| ' dat$ = Mid$(sfx$, in, 4): dat% = Val(dat$)
|
| ' Out &H388, reg%: For d% = 1 To 6: b% = Inp(&H388): Next
|
| ' Out &H389, dat%: For d% = 1 To 35: b% = Inp(&H388): Next
|
| ' Next
|
| _SndPlay sfx&
|
| End Sub
|
|
|
| Function returnevent
|
|
|
|
|
| kee$ = InKey$
|
| If kee$ <> "" Then
|
| If Len(kee$) = 1 Then
|
| keycode = Asc(kee$)
|
| Else
|
| keycode = -Asc(Right$(kee$, 1))
|
| End If
|
| End If
|
|
|
|
|
| returnevent = keycode
|
|
|
| End Function
|
|
|
| Sub ShowHighScores (score() As highscores, mode)
|
|
|
| fc = 199
|
| Cls
|
|
|
| FadePal 16, 255, 23, 1
|
|
|
|
|
| alien = Int(Rnd * 12)
|
|
|
| For x = 1 To 300 Step 20
|
| For y = 1 To 186 Step 14
|
| Put (x, y), sprites(elmPerSpr * alien), PSet
|
| Next
|
| Next
|
|
|
|
|
| FadePal 16, 255, 23, 0
|
| p5x7font 96, 17, "Invader Hall of Fame", 191
|
| p5x7font 96, 16, "Invader Hall of Fame", 29
|
|
|
| placey = 35
|
| shadow = 1
|
|
|
| For a = 1 To 15
|
| p5x7font 20 + 8 - shadow, placey + shadow, score(a).rank, 19
|
| p5x7font 38 + 8 - shadow, placey + shadow, score(a).dat, 19
|
| p5x7font 93 + 8 - shadow, placey + shadow, score(a).nam, 19
|
| p5x7font 240 + 8 - shadow, placey + shadow, score(a).score, 19
|
| p5x7font 20 + 8, placey, score(a).rank, 191
|
| p5x7font 38 + 8, placey, score(a).dat, 29
|
| p5x7font 93 + 8, placey, score(a).nam, 191
|
| p5x7font 240 + 8, placey, score(a).score, 29
|
| placey = placey + 10 ' drop y to a new line
|
| Next a
|
|
|
| If mode Then Exit Sub
|
|
|
|
|
| Do
|
|
|
| If TimeIsUp(6, 120) Then Exit Do
|
| event = returnevent
|
| Loop Until event
|
|
|
|
|
|
|
| End Sub
|
|
|
| Sub soundfx (fx)
|
|
|
| Select Case fx
|
|
|
| Case 1 'step sound
|
|
|
| Sound 60, .1
|
|
|
| Case 2 'gunner hit
|
|
|
| For freq! = 160 To 60 Step -10
|
| duration! = freq! / 100
|
| Sound freq!, duration!
|
| Next
|
|
|
| Case 3 'alien bomb hiting gunshot
|
|
|
| Sound 1160, .1
|
|
|
| Case 4 ' gunshot hit alien
|
|
|
| Play "MB" + "O0" + "L64" + "A" + "B" + "C" + "B" + "C" + "A"
|
|
|
| Case 5
|
|
|
| For freq! = 200 To 60 Step -8
|
| stay (10)
|
| Sound freq!, .1
|
| Next
|
|
|
| Case 6 'hit command ship
|
|
|
| Play "MB" + "O1" + "L20" + "G" + "G" + "G "
|
|
|
| Case 7
|
| 'hit command ship with head up
|
| Play "MB" + "O2" + "L30" + "C" + "D" + "E " + "F"
|
|
|
| Case 8
|
|
|
| play$ = "C" + "D" + "E" + "F" + "G" + "F" + "E" + "D"
|
| Play "MB" + "O0" + "L40" + play$
|
|
|
| Case 9
|
|
|
|
|
| For z% = -20 To 193
|
| Sound 425 - z% * 2, .2
|
| Next z%
|
|
|
|
|
| 'For z = 166 To 299 Step 6
|
| 'Sound 340 - z, 1
|
| 'Next z
|
|
|
|
|
| 'Play "MBO3T128MNL4C<G8>C<G8F8G8E16F16G16A16B16>C16D16C1"
|
| End Select
|
|
|
|
|
|
|
| End Sub
|
|
|
| DefSng A-Z
|
| Sub stay (Millisecs!)
|
|
|
| Static Syspeed&, Time2
|
|
|
| If Syspeed& Then ' First time here -get relative system speed
|
|
|
| If Millisecs Then ' Start Delay loop
|
|
|
| factor& = (Syspeed& * Millisecs) \ 55 'num of loops needed
|
|
|
| If factor& < 1 Then Exit Sub
|
| Do ' delay loop
|
| factor& = factor& - 1 ' Sub the num of loops
|
| Loop Until Time2 = Peek(&H6C) Or factor& = 0 ' make loop same as below
|
|
|
| End If
|
| Else ' Relative system speed processed here
|
|
|
| Def Seg = &H40
|
| Time1 = Peek(&H6C)
|
|
|
| Do
|
| Time2 = Peek(&H6C) ' get another
|
| Loop Until Time1 <> Time2 ' loop until new clock tick
|
|
|
|
|
| Do ' start here at new clock tick
|
| Syspeed& = Syspeed& - 1 ' Count the number of times looped
|
| Loop Until Time2 <> Peek(&H6C) Or Syspeed& = 0 'make same as loop above
|
| Time2 = 1255
|
| Syspeed& = Abs(Syspeed&) 'cant use this neg -reverse it
|
|
|
|
|
|
|
| End If
|
|
|
|
|
|
|
| End Sub
|
|
|
| DefInt A-Z
|
| Function TimeIsUp (n, tsecs!)
|
|
|
|
|
| ' Poll this function to check for passage of time. When the amount of
|
| ' time in tsecs has passed timeisup() returns TRUE, otherwise the function
|
| ' returns false.
|
| ' Initialize this routine with tsecs! = -1 and n = to the number
|
| ' of timers to set up.
|
|
|
| Static getclock(), oldtsecs!(), Time1!()
|
|
|
| If tsecs! = -1 Then ' initialize timers
|
| Dim getclock(n)
|
| Dim oldtsecs!(n)
|
| Dim Time1!(n)
|
| End If
|
|
|
|
|
| If tsecs! <> oldtsecs!(n) Then getclock(n) = 0
|
|
|
| If getclock(n) = 0 Then
|
| Time1!(n) = Timer
|
| getclock(n) = 1
|
| oldtsecs!(n) = tsecs!
|
| Else
|
| If Abs(Timer - Time1!(n)) >= tsecs! Then
|
| TimeIsUp = 1
|
| getclock(n) = 0
|
| Else
|
| TimeIsUp = 0
|
| End If
|
| End If
|
|
|
|
|
|
|
| End Function
|
|
|
| Sub TitleScreen
|
|
|
|
|
| text$ = "QB Invaders"
|
|
|
| For alien = 0 To 7 Step 2 'select alien to pull title
|
| If Int(Rnd * 11) = 5 Then Exit For
|
| Next
|
|
|
|
|
| For x = 300 To 95 Step -1
|
| counter = (counter + 1) Mod 6
|
| If counter = 2 Then frame = (frame + 1) Mod 2
|
| Put (lx, 90), sprites(elmPerSpr * 20), PSet 'erase last
|
| p5x7font lx + 20, 90, text$, 0
|
| event = returnevent
|
| If event Then Exit For
|
| Put (x, 90), sprites((alien + frame) * elmPerSpr), PSet
|
| p5x7font x + 20, 90, text$, 155
|
| lx = x
|
| _Delay .05
|
| Do: Loop Until Inp(&H3DA) And 8 'wait for VGA retrace
|
| Next
|
|
|
|
|
| Put (95, 90), sprites((alien + frame) * elmPerSpr), PSet
|
| _Delay 1
|
| event = 0
|
| If event = 0 Then FadePal 40, 200, 60, 1
|
| p5x7font 95 + 20, 90, text$ + " Ver 1.0", 155
|
| p5x7font 78, 120, "Atari graphics by John Denesha", 155
|
| p5x7font 69, 130, "Other graphics by Timothy Truman", 187
|
| p5x7font 79, 140, "Program Author Timothy Truman", 187
|
| p5x7font 59, 160, "Copyright (c) 1997 Nocturnal Creations", 170
|
| _Delay 1
|
| If event = 0 Then FadePal 40, 200, 60, 0
|
|
|
|
|
| If event = 0 Then FadePal 40, 200, 60, 1
|
| p5x7font 65, 40, "Use right and left keys to move", 154
|
| p5x7font 100, 50, "Use Space bar to fire", 154
|
| p5x7font 130, 60, "Esc to Quit", 154
|
|
|
| _Delay 1
|
|
|
| If event = 0 Then FadePal 40, 200, 60, 0
|
|
|
|
|
| Do
|
| Do: Loop Until Inp(&H3DA) And 8 'wait for VGA retrace
|
| If TimeIsUp(3, 1) Then cship.health = true
|
| DocommandShip
|
| event = returnevent
|
| If event = Esc Then
|
| EndToDos
|
| event = 0
|
| End If
|
| Loop Until event
|
|
|
| cship.health = false
|
| Cls
|
|
|
| End Sub
|
|
|
|
|
| '$INCLUDE: '.\Unbenannt1.bm'
|
| '$INCLUDE: '.\Unbenannt2.bm'
|
| '$INCLUDE: '.\Unbenannt3.bm'
|
| '$INCLUDE: '.\Unbenannt4.bm'
|
| '$INCLUDE: '.\Unbenannt5.bm'
|
| '$INCLUDE: '.\Unbenannt6.bm'
|
| '$INCLUDE: '.\Unbenannt7.bm'
|
| '$INCLUDE: '.\Unbenannt8.bm'
|
| '$INCLUDE: '.\Unbenannt9.bm'
|
| '$INCLUDE: '.\Unbenannt10.bm'
|
QB-Invader.7z (Size: 57.55 KB / Downloads: 121)
