'===========================================================================
' Subject: SPACE V1.9                         Date: 07-09-97 (15:55)       
'  Author: Bill McDonald                      Code: QB, QBasic, PDS        
'  Origin: bmcdonald@norstan.com            Packet: GAMES.ABC
'===========================================================================
DECLARE SUB PressAKey ()
DECLARE SUB Pause (D!)
DECLARE SUB VRetrace ()
DECLARE SUB Explosion (X%, Y%, R%, C%)
DECLARE SUB Convert (X1%, Y1%)
DECLARE SUB ReDraw ()
DECLARE SUB Info ()
DECLARE SUB NumLock ()
DECLARE SUB DrawSprites ()
DECLARE SUB StarField ()
DECLARE SUB InitScores ()
DECLARE SUB Menu ()
DECLARE SUB EndGame ()
DECLARE SUB Message (T$)
DECLARE SUB OutText (X%, Y%, T$)
DECLARE SUB LoadFont ()
DECLARE SUB Center (Y%, T$)
DEFINT A-Z
'Space V1.9  By Bill McDonald
'Font and Font Routines By the Creater of WetSpot
'Thanx to Dave Shea for the Easy Masking Code (Look in DrawSprites)
' Space V1.9 is (C) 1997 PyroElectric Software Ltd.
CLS
SCREEN 13
RANDOMIZE TIMER
DEFINT A-Z
DIM SHARED Lives, Score, HScore, Aim, B$, S, S$, Delay
DIM SHARED Enemy%(280), OldEnImg(374), Ship%(374), OldShImg(374)
DIM SHARED Shot%(12 * 7), OldShot%(12 * 7), EShot%(5 * 5), OldEShot%(5 * 5)
DIM SHARED ShotMsk%(12 * 7), EShotMsk%(5 * 5), EnemyMsk%(280), ShipMsk%(374)
DIM SHARED Aim%(10 * 10), OldAim%(10 * 10), AimMsk%(10 * 10)
DIM SHARED Char&(20 * 46), Box%(10000), Cx, Cy, StarNum

Aim = 0: B$ = "Off"
S = 1: S$ = "On "
Delay = 0
StarNum = 30

TYPE Star
   X AS INTEGER
   Y AS INTEGER
   D AS INTEGER
END TYPE
DIM SHARED Star(StarNum) AS Star

FOR I = 1 TO StarNum
 Star(I).X = INT(RND * 317) + 2
 Star(I).Y = INT(RND * 159) + 1
 Star(I).D = INT(RND * 3) + 1
NEXT I

COLOR 32: LOCATE 3, 40: PRINT "]": LOCATE 3, 1: PRINT "Loaded[";
LoadFont
LOCATE 1, 1: COLOR 32: PRINT "Drawing + Masking Sprites.."
DrawSprites
Top:
CLS
ShipX = 140: ShipY = 140: OldShipX = ShipX
Ey = 20: Ex = 120
Die = 0: Lives = 3
Fir = 0: Ef = 0
InitScores
Score = 0
Lev = 1
Menu
Message "WAVE " + STR$(Lev)

'Get the Background
GET (ShipX, ShipY)-(ShipX + 17, ShipY + 22), OldShImg
GET (Ex, Ey)-(Ex + 25, Ey + 25), OldEnImg
GET (ShotX, ShotY)-(ShotX + 12, ShotY + 7), OldShot%
GET (ShipX + 2, Ey)-(ShipX + 2 + 10, Ey + 10), OldAim%

'Make Border
LINE (0, 0)-(319, 170), 42, B
LINE (0, 170)-(319, 199), 42, B

DO
'AI for the Enemy * Very RANDOM *

'Forward/Backward
 X = INT(RND * 10) + 1
 Y = INT(RND * 2) + 1
 IF Y = 0 AND Lev = 1 THEN Y = 1
 IF Y = 1 THEN Ey = Ey - X
 IF Y = 2 THEN
  IF Ef = 1 THEN
   IF Ex + 25 + X < Efx THEN Ey = Ey + X
  ELSE
   Ey = Ey + X
  END IF
 END IF
 IF Ey <= 10 THEN Ey = 10
 IF Ey >= 80 THEN Ey = 80

'Left/Right
 IF ShipX > Ex THEN Dir = 2 ELSE Dir = 1
 IF Dir = 1 THEN Ex = Ex - 1
 IF Dir = 2 THEN Ex = Ex + 1
 IF Ex <= 10 THEN Ex = 10
 IF Ex >= 280 THEN Ex = 280
 
 'Should Enemy Shoot?
 A = INT(RND * 2) + 1
 IF Ex > ShipX - 20 AND Ex < ShipX + 20 THEN
  IF A = 2 AND Ef = 0 THEN Ef = 1: Efx = Ex + 6: Efy = Ey + 12
 END IF


'Check User Input
A$ = UCASE$(INKEY$)
SELECT CASE A$
     CASE CHR$(0) + "K", "4"   ' [LEFT]
       OldShipX = ShipX
       ShipX = ShipX - 12
       IF ShipX <= 8 THEN ShipX = OldShipX
     CASE CHR$(0) + "M", "6"   ' [RIGHT]
       OldShipX = ShipX
       ShipX = ShipX + 12
       IF ShipX >= 280 THEN ShipX = OldShipX
     CASE CHR$(0) + "H", "8"   ' [UP]
      ShipY = ShipY - 12
      IF ShipY < 15 THEN ShipY = 15
     CASE CHR$(0) + "P", "2"   ' [DOWN]
      ShipY = ShipY + 12
      IF ShipY > 140 THEN ShipY = 140
     CASE " ", "5"
       IF Fir = 0 THEN
        Fir = 1
        ShotX = ShipX + 3
        ShotY = ShipY + 2
        IF S = 1 THEN PLAY "mb l20 t255 n34 n32 n34 n32 n30 n32 n30"
       END IF
     CASE "P"
      Message "Paused!"
     CASE "H"
      A1x = 50
      A1y = 45
      A2x = 160
      A2y = 130
      LINE (A1x, A1y)-(A2x, A2y), , B
      OutText 60, 48, "Left - Left"
      OutText 60, 56, "Right - Right"
      OutText 60, 64, "Up - Up"
      OutText 60, 72, "Down - Down"
      OutText 60, 80, "Space - Shoot"
      OutText 60, 88, "P - Pause"
      OutText 60, 96, "H - Help"
      OutText 60, 104, "ESC - Quit"
      OutText 60, 122, "Press A Key"
      PressAKey
      LINE (A1x, A1y)-(A2x, A2y), 0, BF
END SELECT

'Check to see if firing if so Fire shot
IF Fir = 1 THEN
 ShotY = ShotY - 10
 IF ShotY <= 10 THEN
  ShotY = 10

 'Explode when shot hits wall
  FOR I = 1 TO 7
   Explosion ShotX, ShotY, I, I + 16
   Explosion ShotX + 17, ShotY, I, I + 16
  NEXT I
 
  'Play Sound If It's On
  IF S = 1 THEN PLAY "mb l20 t255 n32 n34 n32 n34 n36 n34 n36 n34 n36"
 
 'Erase Explosion
  FOR I = 7 TO 1 STEP -1
   Explosion ShotX, ShotY, I, 0
   Explosion ShotX + 17, ShotY, I, 0
  NEXT I

 Fir = 0 'Set Shooting = No
 END IF

 'Detect if Hit Enemy
  IF ShotX > Ex - 15 AND ShotY > Ey - 15 AND ShotY < Ey + 15 AND ShotX < Ex + 15 THEN
  
   'Explode Around Enemy
    FOR J = 1 TO 15
     Explosion Ex + 13, Ey + 13, J, J + 15 MOD 30
    NEXT J
   
    'Play Sound If It's On
    IF S = 1 THEN PLAY "MB t255 l20 n38 n36 n38 n34 n36 n34 n38 n32 n34"
   
    'Erase Explosion
    FOR J = 15 TO 1 STEP -1
      Explosion Ex + 13, Ey + 13, J, 0
    NEXT J
   
    'Reset Vars
    ShotX = 0
    ShotY = 0
    Ex = 120
    Ey = 20
    Fir = 0
    Score = Score + 10
   END IF
  END IF

 'Fire Enemy Shot
 IF Ef = 1 THEN
   Efy = Efy + 5
 
  'Check to see if enemy hit you
  IF Efx > ShipX AND Efy > ShipY AND Efy < ShipY + 22 AND Efx < ShipX + 17 THEN
   
    'Explode shot
    FOR I = 1 TO 15
     Explosion ShipX + 7, ShipY + 5, I, 27
    NEXT I

    'Play sound if it's on
    IF S = 1 THEN PLAY "mb t255 l20 n40 n38 n36 n34 n32 n30 n28"
   
    FOR I = 15 TO 1 STEP -1
     Explosion ShipX + 7, ShipY + 5, I, 0
    NEXT I
   
    'Reset Vars
    Efx = 0
    Efy = 0
    Ef = 0
    ShipX = 140
    ShipY = 140
    Lives = Lives - 1
    IF Lives < 0 THEN Die = 1
   END IF
  
   'If Enemy Shot hits wall then
   IF Efy >= 155 AND Ef = 1 THEN
   
    'Explode shot
   IF Explode = 0 THEN
    Explode = 1
    ExpRad = 7
    ExpC = 21
    ExpX = Efx
    ExpY = Efy
   END IF
    'Play Sound if it's on
    IF S = 1 THEN PLAY "mb t255 l20 n40 n42 n46 n44 n42 n40 n38"
    
    'Reset Var
    Ef = 0
   END IF
 END IF
 
   
IF Explode = 1 THEN
     Explosion ExpX, ExpY, Er, ExpC
     Er = Er + 1
     IF Er >= ExpRad THEN Explode = 0: ExpErase = 1
END IF

IF ExpErase = 1 THEN
    Explosion ExpX, ExpY, Er, 0
    Er = Er - 1
    IF Er < 0 THEN ExpErase = 0: Er = 0
END IF

'Put Ship
GET (ShipX, ShipY)-(ShipX + 17, ShipY + 22), OldShImg
PUT (ShipX, ShipY), ShipMsk%, AND
PUT (ShipX, ShipY), Ship%, OR

'Put Enemy
GET (Ex, Ey)-(Ex + 25, Ey + 25), OldEnImg
PUT (Ex, Ey), EnemyMsk%, AND
PUT (Ex, Ey), Enemy%, OR

'Put Aimer
IF Aim = 1 THEN
 GET (ShipX + 2, Ey)-(ShipX + 2 + 10, Ey + 10), OldAim%
 PUT (ShipX + 2, Ey), AimMsk%, AND
 PUT (ShipX + 2, Ey), Aim%, OR
END IF

IF Ef = 1 THEN
 GET (Efx, Efy)-(Efx + 2, Efy + 6), OldEShot%
 PUT (Efx, Efy), EShotMsk%, AND
 PUT (Efx, Efy), EShot%, OR
END IF

IF Fir = 1 THEN
 GET (ShotX, ShotY)-(ShotX + 12, ShotY + 7), OldShot%
 PUT (ShotX, ShotY), ShotMsk%, AND
 PUT (ShotX, ShotY), Shot%, OR
END IF

'VRetrace

 'Put Back Background
  PUT (Ex, Ey), OldEnImg, PSET
  PUT (ShipX, ShipY), OldShImg, PSET
  IF Fir = 1 THEN PUT (ShotX, ShotY), OldShot%, PSET
  IF Ef = 1 THEN PUT (Efx, Efy), OldEShot%, PSET
  IF Aim = 1 THEN PUT (ShipX + 2, Ey), OldAim%, PSET

'Move Stars
StarField

'Print Score and Lives
IF Score > OScore OR Lives <> OLives THEN
  OutText 32, 180, "Score:" + STR$(Score) + "     " + "Lives:" + STR$(Lives)
END IF
OScore = Score
OLives = Lives

'Check to see if Player Died or Pressed Escape
LOCATE 1, 1: PRINT Explode; Er
LOOP UNTIL A$ = CHR$(27) OR Die = 1

CLS
IF Die = 1 THEN
 
  'If Sound is on play Sound
  IF S = 1 THEN PLAY "mb t255 l10 n40 n38 n36 n34 n32 n30 n28 n26"
 
  'Tell Player his/her game is over
  Message "Game Over!"
  CLS
 
  'Check for High Score
  InitScores
END IF
GOTO Top:

SUB Center (Y, T$)
X% = (320 - (LEN(T$) * 7)) / 2 - 1
OutText X%, Y, T$
END SUB

SUB Convert (X1, Y1)
Cx = ((Y1 - 1) * 8)
Cy = (X1 * 8) - 4
END SUB

SUB DrawSprites
PALETTE
'Draw Ship
DRAW "BM 100,100 c30 u10 e1 f1 d10 l2 br2 bu3 r1 u1 r1 d1 r1 u15 e3 f3 d15 r1 u1"
DRAW "r1 d1 r1 d3 r2 u10 h1 g1 d6 l3 d2 l6 u12 br2 u3 e1 f1 d3 l1"
DRAW " u3 bl3 d15 r2 d3 r2 u10 l2 d10 r1 u10"

'Draw Aimer
LINE (0, 0 + 10)-(3, 3 + 10), 4
LINE (7, 7 + 10)-(10, 10 + 10), 4
LINE (0, 10 + 10)-(3, 7 + 10), 4
LINE (10, 0 + 10)-(7, 3 + 10), 4

'Draw Enemy
DRAW "BM 125,91 c2 u10 r6 d10 g3 h3 u2 h7 r7 u2 r6 d2 r7 g7 bl2 u2 l1"
DRAW "d2 l1 u2 r1 d4 u1 l1 r2"

'Draw Shot
FOR I = 1 TO 5
 PSET (14, 15 + I + 1), 4
 PSET (15, 15 + I), 12
 PSET (16, 15 + I + 1), 4
 PSET (24, 15 + I + 1), 4
 PSET (25, 15 + I), 12
 PSET (26, 15 + I + 1), 4
NEXT I

FOR I = 1 TO 5
 PSET (0 + 190, I + 100), 12
 PSET (1 + 190, I + 1 + 100), 14
 PSET (2 + 190, I + 100), 12
NEXT I

GET (190, 100)-(192, 106), EShot%
GET (0, 10)-(10, 20), Aim%
GET (14, 14)-(26, 21), Shot%
GET (100, 101)-(116, 79), Ship%
GET (118, 94)-(138, 79), Enemy%

FOR A% = 0 TO 320 STEP 2
 FOR z% = 9 TO 120
  IF POINT(A%, z%) = 0 THEN PSET (A%, z%), 255
  IF POINT(A%, z%) > 0 AND POINT(A%, z%) < 255 THEN PSET (A%, z%), 0
 NEXT
NEXT

GET (0, 10)-(10, 20), AimMsk%
GET (14, 14)-(26, 21), ShotMsk%
GET (190, 100)-(192, 106), EShotMsk%
GET (100, 101)-(116, 79), ShipMsk%
GET (118, 94)-(138, 79), EnemyMsk%

PALETTE
END SUB

SUB EndGame
CLS
SCREEN 0
WIDTH 80
COLOR 7
PRINT "Space V1.9"
PRINT "(C) 1997 PyroElectric Software Ltd."
END
END SUB

SUB Explosion (X, Y, R, C)
VRetrace
CIRCLE (X, Y), R, C
END SUB

SUB Info
CLS
OutText 4, 0, "Space Wars V1.9 Non Beta"
OutText 4, 8, "Was created by Bill McDonald"
OutText 4, 24, "The object is to shoot the enemy with"
OutText 4, 32, "your missiles to try to rack up a high"
OutText 4, 40, "score without losing your 3 lives"
OutText 4, 56, "Controlls:"
OutText 4, 64, "Up"
OutText 4, 72, "Down"
OutText 4, 80, "Right"
OutText 4, 88, "Left"
OutText 4, 96, "Shoot - Space"
OutText 4, 104, "Help - H"
OutText 4, 112, "Pause - P"
OutText 4, 120, "Quit - ESC"
A$ = INPUT$(1)
CLS
END SUB

SUB InitScores
SHARED HScore
'OPEN "C:\DOS\SCORES.HST" FOR INPUT AS #1

IF Score > HScore THEN
 CLOSE #1
 OPEN "C:\DOS\SCORES.HST" FOR OUTPUT AS #1
 CLS
 OutText 72, 76, "Its A New High Score!"
 SLEEP
 PRINT #1, Score
 HScore = Score
 CLOSE #1
 A$ = INPUT$(1)
 CLS
 Menu
ELSE
' INPUT #1, HScore
END IF
CLOSE #1
END SUB

SUB LoadFont
B = 8
COLOR 32
FOR I = 1 TO 31: PALETTE I, 0: NEXT I
OPEN "Font.dat" FOR INPUT AS #1
FOR I = 0 TO 314
 FOR J = 0 TO 55 - 48
  INPUT #1, A
  PSET (I, J), A
  IF I MOD 100 = 0 THEN PRINT ".";
 NEXT J
NEXT I
CLOSE #1
FOR I = 0 TO 44
 GET (I * 7, 0)-((I * 7) + 6, 55 - 48), Char&(I * 20)
NEXT I
I = 45
GET (I * 7, 100)-((I * 7) + 6, 107), Char&(I * 20)
CLS
END SUB

SUB Menu
ReDraw
M2 = 1
M3 = 11
DO
A$ = INKEY$
SELECT CASE A$
     CASE CHR$(0) + "P"    ' [DOWN]
      M2 = M3
      M3 = M3 + 2
      IF M3 > 21 THEN M3 = 11
    
     CASE CHR$(0) + "H"    ' [UP]
      M2 = M3
      M3 = M3 - 2
      IF M3 < 11 THEN M3 = 21
    
     CASE CHR$(0) + "K"    ' [LEFT]
      IF M3 = 19 THEN
        Delay = Delay - 50
        IF Delay < 0 THEN Delay = 0
        ReDraw
      END IF
     CASE CHR$(0) + "M"    ' [RIGHT]
      IF M3 = 19 THEN
        Delay = Delay + 50
        IF Delay > 900 THEN Delay = 900: BEEP
        ReDraw
      END IF
    
     CASE CHR$(13)
      IF M3 = 11 THEN EXIT DO
      IF M3 = 13 THEN Info: ReDraw
      IF M3 = 15 THEN
       IF R = 0 THEN
        OutText 0, 0, "Sorry You Need To Register For This Option.."
        BEEP
        Pause .3
        OutText 0, 0, "                                            "
       END IF
       IF Aim = 1 AND R = 1 THEN
        Aim = 0
        B$ = "Off"
        ReDraw
       ELSEIF Aim = 0 AND R = 1 THEN
        Aim = 1
        B$ = "On "
        ReDraw
       END IF
      END IF
      IF M3 = 17 THEN
       IF S = 1 THEN
        S = 0
        S$ = "Off"
        ReDraw
       ELSEIF S = 0 THEN
        S = 1
        S$ = "On "
        ReDraw
       END IF
      END IF
      IF M3 = 21 THEN EndGame
END SELECT
Convert M2, 11
OutText Cx, Cy, " "
Convert M3, 11
OutText Cx, Cy, "O"
LOOP
CLS
END SUB

SUB Message (T$)
FOR I = 192 TO 96 STEP -2
  GET (0, I)-(319, I + 7), Box%
  Center I, T$
  VRetrace
  Pause .0001
  PUT (0, I), Box%, PSET
NEXT I
GET (0, 96)-(319, 103), Box%
Center 96, T$
PressAKey
PUT (0, 96), Box%, PSET
FOR I = 96 TO 8 STEP -2
  GET (0, I)-(319, I + 7), Box%
  Center I, T$
  VRetrace
  Pause .0001
  PUT (0, I), Box%, PSET
NEXT I

END SUB

SUB OutText (X, Y, T$)
T$ = UCASE$(T$)
FOR I = 1 TO LEN(T$)
  ChCode = ASC(MID$(T$, I, 1))
  SELECT CASE ChCode
    CASE 65 TO 90: Ch = ChCode - 65
    CASE 48 TO 57: Ch = ChCode - 22
    CASE 46: Ch = 36
    CASE 58: Ch = 37
    CASE 44: Ch = 38
    CASE 59: Ch = 39
    CASE 33: Ch = 40
    CASE 63: Ch = 41
    CASE 45: Ch = 42
    CASE 43: Ch = 43
    CASE 95: Ch = 44
    CASE 32: Ch = 45
  END SELECT
  PUT (X%, Y%), Char&(Ch * 20), PSET
  X% = X% + 7
NEXT I

END SUB

SUB Pause (D!)
Tim! = TIMER
WHILE D! + Tim! > TIMER: WEND
END SUB

SUB PressAKey
Q$ = ""
WHILE Q$ = "": Q$ = INKEY$: WEND
END SUB

SUB ReDraw
X1 = 60
Y1 = 50
X2 = 220
Y2 = 175
X = 2
InitScores
LINE (X1, Y1)-(X2, Y2), 31, B
LINE (X2 + X, Y1 + X)-(X2 + X, Y2 + X), 25
LINE (X2 + X, Y2 + X)-(X1 + X, Y2 + X), 25
A = 15
OutText 80 + A, 20, "HighScore:" + STR$(HScore)
OutText 106, 60, "Space V1.9"
OutText 80 + A, 84, " - Start"
OutText 80 + A, 100, " - Info"
OutText 80 + A, 116, " - Aimer:" + B$
OutText 80 + A, 132, " - Sound:" + S$
OutText 80 + A, 148, " - Delay:" + STR$(Delay) + "  "
OutText 80 + A, 164, " - Quit"
OutText 32 + A, 180, "Score:" + STR$(Score) + "     " + "Lives:" + STR$(Lives)
END SUB

SUB StarField
 FOR I = 1 TO StarNum
  PSET (Star(I).X, Star(I).Y), 0
  Star(I).Y = Star(I).Y + 4 - Star(I).D
  IF Star(I).Y > 160 THEN
   Star(I).Y = 1
  END IF
  IF Star(I).D = 1 THEN C = 31
  IF Star(I).D = 2 THEN C = 27
  IF Star(I).D = 3 THEN C = 23
  PSET (Star(I).X, Star(I).Y), C
 NEXT I
END SUB

SUB VRetrace
'Wait For Vertical Retrace
'(Wait for the Laser in your monitor to finish it's pass)
WHILE (INP(&H3DA) AND 1) <> 0: WEND
WHILE (INP(&H3DA) AND 1) = 0: WEND
WHILE (INP(&H3DA) AND 8) = 0: WEND
WHILE (INP(&H3DA) AND 8) <> 0: WEND
END SUB