Posts: 2,160
Threads: 222
Joined: Apr 2022
Reputation:
103
So now the little alien dudes have sensors, and can keep from flying into one another. No collisions, so no sound effects needed for this demo. For fun, this demo runs 15 multi-color space ships. I guess it's Pride month on Alpha Centauri, but whatever...
The ships can now go off screen and return at some point near the exit. That's a nice escape feature for further development plans. Remember you can use left Ctlr to speed things up and left Alt to slow things down. Oh, and I made the bottom of the screen to be the surface of the planet, so the alien ships were taught to just bounce back up if they near the surface.
Stage 6)
Code: (Select All) DIM SHARED top, bottom, left, right, s_delay
a = 120: b = 42
WIDTH a, b
_SCREENMOVE 0, 0
top = 3: bottom = _HEIGHT: left = 0: right = _WIDTH
msg$ = "Alien space ship movement demo."
LOCATE 1, (right - left) \ 2 - LEN(msg$) \ 2
PRINT msg$;
LOCATE 1, 2: PRINT STRING$(_WIDTH, "_");
s_delay = 100
DO
_LIMIT 30
k$ = INKEY$
IF _KEYDOWN(100306) THEN IF s_delay - 5 > 0 THEN s_delay = s_delay - 5: LOCATE 1, 2: PRINT "Speed delay ="; s_delay / 100; " ";
IF _KEYDOWN(100308) THEN IF s_delay < 500 THEN s_delay = s_delay + 5: LOCATE 1, 2: PRINT "Speed delay ="; s_delay / 100; " ";
IF LEN(k$) THEN SOUND 1000, .1
IF k$ = CHR$(27) THEN END
alien_move
LOOP
offscreen:
IF ERR = 5 THEN er = -1: RESUME NEXT
PRINT "Opps, you have an error"; ERR
END
SUB alien_move:
STATIC alien$, a_y(15), a_x(15), olda_y(15), olda_x(15), inertia(15), ran(15), ran_y(15), ran_x(15), oldran(15), z5, z6, itr, alien_ship_max
IF alien$ = "" THEN
alien$ = "-<>-": alien_ship_max = 15 ' Sets number of space ships and initiates attack.
CALL explosion ' Loads sound files on first call.
END IF
IF ABS(z5 - TIMER) > s_delay / 1000 THEN ' Time delay.
DO
itr = itr + 1: IF itr > alien_ship_max THEN itr = 1 ' Needed to offset the EXIT DO hover event, which on exit does not affect the itr variable.
y_restore = CSRLIN: x_restore = POS(0) ' Restore column and row upon exit.
IF olda_y(itr) <> 0 AND olda_x(itr) <> 0 THEN ' If alien ship on screen then mask old image.
LOCATE olda_y(itr), olda_x(itr): PRINT SPACE$(LEN(alien$));
END IF
IF inertia(itr) = 0 THEN ' Determine how many moves in one direction.
inertia(itr) = INT(RND * (bottom - top) / 2) + 1 ' How many moves to go in any one direction.
ran(itr) = INT(RND * 8) + 1 ' Choose 1 of 8 possible directions.
IF ran(itr) = oldran(itr) OR olda_y(itr) = 0 AND olda_x(itr) = 0 AND ran = 1 OR olda_y(itr) = 0 AND olda_x(itr) = 0 AND ran = 5 THEN
EXIT DO ' Just hover if direction was not changed on existing alien space ship or if a new alien space ship is entering from the sides and up or down was generated.
END IF
SELECT CASE ran(itr) ' Get changes in column and row coordinates.
CASE 1: ran_y(itr) = -1: ran_x(itr) = 0 ' Up.
CASE 2: ran_y(itr) = -1: ran_x(itr) = 2 ' Up and right.
CASE 3: ran_y(itr) = 0: ran_x(itr) = 2 ' Right.
CASE 4: ran_y(itr) = 1: ran_x(itr) = 2 ' Down and right.
CASE 5: ran_y(itr) = 1: ran_x(itr) = 0 ' Down.
CASE 6: ran_y(itr) = 1: ran_x(itr) = -2 ' Down and left.
CASE 7: ran_y(itr) = 0: ran_x(itr) = -2 ' Left.
CASE 8: ran_y(itr) = -1: ran_x(itr) = -2 ' Up and left.
END SELECT
IF olda_y(itr) = 0 AND olda_x(itr) = 0 THEN ' New alien space ship enters the screen.
i = RND * (bottom - top) \ 4
a_y(itr) = (bottom - top) \ 4 + i
IF ran(itr) < 5 THEN ' Determine side of entry from initial direction.
IF SCREEN(a_y(itr), left + LEN(alien$)) = 32 THEN
a_x(itr) = left + 1 ' Enter from the left side and go right.
ELSE
GOSUB a_erase ' Cancel and wait because space is occupied.
EXIT DO
END IF
ELSE
IF SCREEN(a_y(itr), right - LEN(alien$) + 1) = 32 THEN
a_x(itr) = right - LEN(alien$) ' Enter from the right side and go left.
ELSE
GOSUB a_erase: ' Cancel and wait because space is occupied.
EXIT DO
END IF
END IF
END IF
oldran(itr) = ran(itr) ' Remember last direction. Another line uses this to disallow any RND that chooses the same direction twice.
ELSE
inertia(itr) = inertia(itr) - 1 ' Count down the number of moves in any one direction. When zero, switch direction.
END IF
FOR i = 1 TO alien_ship_max
IF i <> itr AND a_y(i) <> 0 THEN
IF a_y(itr) + ran_y(itr) = a_y(i) THEN
IF a_x(itr) + ran_x(itr) + LEN(alien$) > a_x(i) AND a_x(itr) + ran_x(itr) < a_x(i) + LEN(alien$) THEN
collide = 1
EXIT FOR
END IF
END IF
END IF
NEXT
IF collide = 1 THEN
j = a_y(itr): k = a_x(itr)
ran_y(itr) = 0: ran_x(itr) = 0: inertia(itr) = 0
collide = 0 ' Collision detection off. Collision detected and avoided.
ELSE
j = a_y(itr) + ran_y(itr): k = a_x(itr) + ran_x(itr)
END IF
IF j <= top OR k <= left OR k + LEN(alien$) > right THEN ' Alien ship out of range.
inertia(itr) = 0 ' These two lines keep the out of range ship(s) reasonably nearby.
IF j > -3 AND k < right + 3 AND k > -3 THEN a_y(itr) = j: a_x(itr) = k
ELSE
' Check for collisions and reverse course if detected.
IF j >= bottom THEN collide = -1
COLOR itr
IF collide THEN
ran_y(itr) = -ran_y(itr): ran_x(itr) = -ran_x(itr)
collide = 0
LOCATE olda_y(itr), olda_x(itr): PRINT alien$;
ELSE
a_y(itr) = j: a_x(itr) = k ' Next move coordinates.
LOCATE j, k: PRINT alien$; ' Move alien space ship.
olda_y(itr) = j: olda_x(itr) = k ' Remember these coordinates to erase alien space ship on next loop.
END IF
COLOR 7
END IF
IF itr = alien_ship_max THEN itr = 0: EXIT DO
IF ABS(z6 - TIMER) > s_delay / 2 THEN skipz5 = -1: EXIT DO
LOOP
IF skipz5 = 0 THEN z5 = TIMER
z6 = TIMER
LOCATE y_restore, x_restore ' Restore entry column and row positions.
END IF
EXIT SUB
a_erase:
a_y(itr) = 0: a_x(itr) = 0: olda_y(itr) = 0: olda_x(itr) = 0: inertia(itr) = 0: ran(itr) = 0: ran_y(itr) = 0: ran_x(itr) = 0: oldran(itr) = 0
RETURN
END SUB
SUB explosion
STATIC sound_check, soundfile%, t1&, t6&, t7&, t8&
IF sound_check = 0 THEN
IF _FILEEXISTS("Thunder1.ogg") AND _FILEEXISTS("Thunder1.ogg") AND _FILEEXISTS("Thunder1.ogg") AND _FILEEXISTS("Thunder1.ogg") THEN soundfile% = -1
IF soundfile% THEN
t1& = _SNDOPEN("Thunder1.ogg", "SYNC")
t6& = _SNDOPEN("Thunder6.ogg", "SYNC")
t7& = _SNDOPEN("Thunder7.ogg", "SYNC")
t8& = _SNDOPEN("Thunder8.ogg", "SYNC")
END IF
sound_check = -1
EXIT SUB
END IF
VIEW PRINT top TO bottom ' Needed to set print error parameters.
b_y1 = CSRLIN: b_x1 = POS(0)
h = 0
ON ERROR GOTO offscreen
DO
IF h = 1 THEN burst$ = " " ELSE burst$ = CHR$(249)
h = h + 1
GOSUB flash
FOR i = 1 TO 5
SELECT CASE i
CASE 1
COLOR 15
LOCATE b_y1, b_x1: PRINT burst$;
_DELAY .1
CASE 2
IF burst$ = CHR$(249) THEN burst$ = CHR$(250)
COLOR 14, 0
LOCATE b_y1 - 1, b_x1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1 - 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1 + 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1 + 1, b_x1
IF er = 0 THEN PRINT burst$; ELSE er = 0
_DELAY .1
CASE 3
LOCATE b_y1 - 1, b_x1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 - 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 + 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1 + 1, b_x1
IF er = 0 THEN PRINT " "; ELSE er = 0
CASE 4
COLOR 4
LOCATE b_y1 - 1, b_x1 - 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1 - 1, b_x1 + 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1 - 2
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1 + 2
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1 + 1, b_x1 - 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1 + 1, b_x1 + 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
_DELAY .3
CASE 5
LOCATE b_y1 - 1, b_x1 - 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1 - 1, b_x1 + 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 - 2
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 - 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 + 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 + 2
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1 + 1, b_x1 - 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1 + 1, b_x1 + 1
IF er = 0 THEN PRINT " "; ELSE er = 0
END SELECT
NEXT
IF h = 1 THEN h = 0: EXIT DO
LOOP
VIEW PRINT
ON ERROR GOTO 0
COLOR 7
LOCATE b_y1, b_x1
EXIT SUB
flash:
IF eflag THEN
IF ABS(z7 - TIMER) > .1 THEN
eflag = 0
PALETTE 0, 0
z7 = TIMER
ELSE
j = -j * -1
IF j = 0 THEN
PALETTE 0, 63
_DELAY .05
ELSE
PALETTE 0, 0
_DELAY .05
END IF
END IF
END IF
IF eflag = 0 THEN
PALETTE 0, 36
IF soundfile% THEN
_SNDPLAY t1&
_DELAY .05
PALETTE 0, 0
_SNDPLAY t7&
ELSE
_DELAY .075
END IF
eflag = -1
z7 = TIMER
END IF
PALETTE 0, 0
RETURN
END SUB
So what's next? Well, at some point it becomes time to see what was needed to get this far, and consider if converting to TYPE variables would be adventitious to the project.
Pete
Posts: 2,160
Threads: 222
Joined: Apr 2022
Reputation:
103
10-08-2022, 01:53 AM
(This post was last modified: 10-08-2022, 01:53 AM by Pete.)
Well, boring as it is, here is the code as TYPE variables with a certain amount of name changes to improve the naming conformity. Naming things is just not my strong suit. I used to say if I was the first man on earth, and asked to name all the lesser creations, you know, fish, foul, and Democrats, etc., I'd just name them all widgets. Hey, that widget just flew right into head. Ouch, that widget just swam up my fig leaf and bit me in the what-u-ma-call-it! So with that in mind...
Code: (Select All) TYPE gen_var
nol AS INTEGER ' Number of game levels.
level AS INTEGER ' Current game level.
level_up AS INTEGER ' Routes code to next game level.
top AS INTEGER ' Top boundary. (Changeable).
bottom AS INTEGER ' Bottom boundary. (Changeable).
left AS INTEGER ' Left boundary. (Changeable).
right AS INTEGER ' Right boundary. (Changeable).
kb_router AS INTEGER ' Routes code to either Guardian/Alien or general keyboard routine. -1 Guardian/Alien, 0 keyboard.
snd1 AS LONG ' Explosion sound effect.
snd2 AS LONG ' Explosion sound effect.
END TYPE
DIM SHARED v AS gen_var
TYPE guardian
num AS INTEGER ' Number of Guardians aka lives.
diry AS INTEGER ' Guardian row move. +1, 0, -1.
dirx AS INTEGER ' Guardian column move. +2, 0, -2. Equals vertical pixel movement. 16x8.
y AS INTEGER ' Guardian coordinates row.
x AS INTEGER ' Guardian coordinates column.
speed AS INTEGER ' Guardian speed. (User Determined).
m_max AS INTEGER ' Restricts # of missiles fired in one direction.
m_status AS INTEGER ' Missile status. -1 when fired, 1 while moving.
m_fired AS INTEGER ' The number of missile deployed and still active.
m_n AS INTEGER ' Missile number. 1 to m_max. (Counter).
m_d AS INTEGER ' Missile direction. (1-8).
m_y AS INTEGER ' Missile row advancement increment: +1, 0, -1 Note: Missile row and column coordinates are defined in arrays.
m_x AS INTEGER ' Missile column advancement increment: +2, 0, -2. Equals vertical pixel movement. 16x8.
m_asc AS INTEGER ' ASCII charater representing a fired missile.
icon AS STRING
END TYPE
DIM SHARED g AS guardian
TYPE alien
max AS INTEGER ' Maximum # of alien ships on screen.
count AS INTEGER ' Number of alien ships. (Counter).
itr AS INTEGER ' Iteration array number to cycle through the active alien ships. (Counter).
cycle_delay AS SINGLE ' Timer cycle controls how fast alien ships move.
ship AS STRING ' Alien ship ASCII design.
END TYPE
DIM SHARED a AS alien
CALL set_up ' Loads sound files and some starting variables.
DO
v.level = v.level + 1
g.y = (v.bottom - v.top) \ 2 + v.top: g.x = (v.right - v.left) \ 2 + v.left ' Set initial column and row for Guardian craft.
LOCATE g.y, g.x: PRINT "*"; ' Show Guardian.
i = 15 ' Default max setting for number of alien ships used here to intially dim arrays.
REDIM SHARED a_y(i), a_x(i), a_mask_y(i), a_mask_x(i), a_inertia(i) ' Alien movement.
REDIM SHARED a_ran(i), a_olda_ran(i), a_y_loc(i), a_x_loc(i) ' Alien motvement.
REDIM SHARED m_n(g.m_max), m_x(g.m_max, 8), m_y(g.m_max, 8) ' Guardian missiles.
' Array descriptions and actions.
' a_y() , a_x() Alien ship postions rows and columns.
' a_mask_y(), a_mask_x() Alien ship last position. Masked on next move.
' a_inertia(i) Number of moves in one direction selected by random for an alien ship.
' a_ran(i), a_olda_ran(i) Determines the direction in which the inertia will travel and the prior direction is kept to disallow the same direction twice.
' a_y_loc(i), a_x_loc(i) The row and column cordinates of the aliens ships.
' m_n(g.m_max), m_x(g.m_max, 8), m_y(g.m_max, 8) Missile number and Missile index 1 to g.m_max for position. 8 is the fixed number of 8 different directions.
CALL game
' Zero variables.
g.diry = 0: g.dirx = 0: g.m_status = 0: g.m_fired = 0: g.m_n = 0: g.m_d = 0: g.m_y = 0: g.m_x = 0
g.m_asc = 0: a.count = 0: a.itr = 0: a.cycle_delay = 0: a.ship = "": v.level_up = 0
LOOP
What's interesting with TYPE variables is they are a bit safer to use, because they are usually more unique, which means it's harder to create a duplicate and unrelated variable in some other sub, when we are using DIM SHARED instead of passing variables by reference or value.
So next up will be combining a player move and fire routine to confront the alien ships. Stay tuned for the debut of: ASCII Guardian
Pete
Posts: 2,160
Threads: 222
Joined: Apr 2022
Reputation:
103
10-14-2022, 10:43 PM
(This post was last modified: 10-15-2022, 04:24 AM by Pete.)
Here is GUARDIAN V1.0, the first version of a playable space shooter game...
Code: (Select All) DEFINT H-K
$RESIZE:ON
_RESIZE OFF
RANDOMIZE TIMER
' Note: timer is not adjusted for stroke of midnight event, so don't stay up late playing this.
REM Main
f1 = 22 ' Sets font size to 22 and calculates the max screen height and width for your desktop.
h = (_DESKTOPHEIGHT - 60) \ f1
w = _DESKTOPWIDTH \ (f1 / 1.66)
WIDTH w, h
_SCREENMOVE 0, 0
fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.
font& = _LOADFONT(fontpath$, f1, "monospace")
_FONT font&
_DELAY .25
_RESIZE ON , _SMOOTH ' Allows resizing. Note: this is for slight adjustments. As of this version there is no compensatory function to change the font size during screen size changes.
TYPE gen_var
intro AS INTEGER ' Runs a protion of the alien subroutine as part of the intro.
nol AS INTEGER ' Number of game levels.
level AS INTEGER ' Current game level.
level_up AS INTEGER ' Routes code to next game level.
top AS INTEGER ' Top boundary. (Changeable).
bottom AS INTEGER ' Bottom boundary. (Changeable).
left AS INTEGER ' Left boundary. (Changeable).
right AS INTEGER ' Right boundary. (Changeable).
kb_access AS INTEGER ' Routes code to either Guardian/Alien or general keyboard routine. -1 Guardian/Alien, 0 keyboard.
mouse_or_key_move AS INTEGER
mouse_get_screen AS INTEGER
play AS INTEGER
snd1 AS LONG ' Explosion sound effect.
snd2 AS LONG ' Explosion sound effect.
END TYPE
DIM SHARED v AS gen_var
TYPE guardian
num AS INTEGER ' Number of Guardians aka lives.
diry AS INTEGER ' Guardian row move. +1, 0, -1.
dirx AS INTEGER ' Guardian column move. +2, 0, -2. Equals vertical pixel movement. 16x8.
y AS INTEGER ' Guardian coordinates row.
x AS INTEGER ' Guardian coordinates column.
thrusters AS INTEGER ' Guardian speed. (User Determined).
m_max AS INTEGER ' Restricts # of missiles fired in one direction.
m_status AS INTEGER ' Missile status. -1 when fired, 1 while moving.
m_fired AS INTEGER ' The number of missile deployed and still active.
m_n AS INTEGER ' FOR/NEXT counter variable shared by other routines to index through the number of missiles fired in a specific direction.
m_d AS INTEGER ' Missile direction. (1-8).
m_y AS INTEGER ' Missile row advancement increment: +1, 0, -1 Note: Missile row and column coordinates are defined in arrays.
m_x AS INTEGER ' Missile column advancement increment: +2, 0, -2. Equals vertical pixel movement. 16x8.
m_asc AS INTEGER ' ASCII character representing a fired missile.
m_launcher AS STRING
icon AS STRING ' Guardian comm icon. For this edition, it is the same as the flagship: "*"
flagship AS STRING ' Guardian ascii character.
END TYPE
DIM SHARED g AS guardian
TYPE alien
max AS INTEGER ' Maximum # of alien ships on screen.
count AS INTEGER ' Number of alien ships. (Counter).
itr AS INTEGER ' Iteration array number to cycle through the active alien ships. (Counter).
cycle_delay AS SINGLE ' Timer cycle controls how fast alien ships move.
ship AS STRING ' Alien ship ASCII design.
END TYPE
DIM SHARED a AS alien
DO
GOSUB set_arrays
SELECT CASE v.play
CASE 0
CALL set_up
CALL comm
CALL intro
v.intro = 0: a.max = 0
GOSUB set_arrays
v.level = -1: CALL game_level: v.level_up = 0 ' This variable is canceled here so game will play instead of go another level up.
CASE 1
CALL set_up
CALL comm
END SELECT
g.y = (v.bottom - v.top) \ 2 + v.top: g.x = (v.right - v.left + 1) \ 2 + v.left ' Set initial column and row for Guardian craft.
CALL game
GOSUB zero_variables
LOOP
set_arrays:
ii = 15 ' Default max setting for number of alien ships used here to initially dim arrays.
g.m_max = 8 ' * missiles max per direction.
REDIM SHARED a_y(ii), a_x(ii), a_mask_y(ii), a_mask_x(ii), a_inertia(ii) ' Alien movement.
REDIM SHARED a_ran(ii), a_olda_ran(ii), a_y_loc(ii), a_x_loc(ii), a_offscrn(ii) ' Alien movement.
REDIM SHARED m_n(g.m_max), m_x(g.m_max, 8), m_y(g.m_max, 8) ' Guardian missiles.
' Array descriptions and actions.
' a_y() , a_x() Alien ship positions rows and columns.
' a_mask_y(), a_mask_x() Alien ship last position. Masked on next move.
' a_inertia(ii) Number of moves in one direction selected by random for an alien ship.
' a_ran(ii), a_olda_ran(ii) Determines the direction in which the inertia will travel and the prior direction is kept to disallow the same direction twice.
' a_y_loc(ii), a_x_loc(ii) The row and column coordinates of the aliens ships.
' m_n(g.m_max), m_x(g.m_max, 8), m_y(g.m_max, 8) Missile number and Missile index 1 to g.m_max for position. 8 is the fixed number of 8 different directions.
RETURN
zero_variables:
' Zero variables.
g.diry = 0: g.dirx = 0: g.m_status = 0: g.m_fired = 0: g.m_d = 0: g.m_y = 0: g.m_x = 0
a.count = 0: a.itr = 0: a.cycle_delay = 0: v.level_up = 0: v.mouse_or_key_move = 0: g.m_launcher = ""
RETURN
skipintro:
v.intro = 999
BEEP: BEEP
VIEW PRINT v.top TO v.bottom
CLS 2
VIEW PRINT
_DELAY .5
RETURN
' Error handler.
offscreen: ' Prevents error if blast particles row and column are off-screen. Effect is a partial blast on side of screen.
IF ERR = 5 THEN er = -1: RESUME NEXT
PRINT "Opps, unexpected error"; ERR
END
SUB intro
v.mouse_get_screen = 1 ' Allows skip intro by mouse selection.
LOCATE _HEIGHT, _WIDTH - 15
PRINT "[S]kip Intro"; ' Option to skip the intro using the "S" key with ONKEY statement.
KEY 15, CHR$(0) + CHR$(31) 'scancode for S
ON KEY(15) GOSUB skipintro
KEY(15) ON 'turn ON [S]kip intro event trapping.
j = (v.bottom - v.top) \ 2 + v.top
k = (v.right - v.left) \ 2 + v.left
z1 = TIMER
DO
CALL mouse(mouse_event1, mouse_event2)
IF v.intro = 999 THEN KEY(15) OFF: EXIT SUB
LOOP UNTIL ABS(z1 - TIMER) > .33
SOUND 1000, .3
msg$ = " GUARDIAN "
LOCATE j, k - LEN(msg$) \ 2: COLOR 14: PRINT msg$;: COLOR 7
LOCATE , k
z1 = TIMER
DO
CALL mouse(mouse_event1, mouse_event2)
IF v.intro = 999 THEN KEY(15) OFF: EXIT SUB
LOOP UNTIL ABS(z1 - TIMER) > .66
msg$ = SPACE$(LEN(msg$))
LOCATE j, k - LEN(msg$) \ 2: COLOR 7: PRINT msg$;
LOCATE j, k
IF v.intro = 999 THEN KEY(15) OFF: EXIT SUB ELSE CALL explosion
LOCATE j, k: COLOR 15 + 16: PRINT g.flagship;
z1 = TIMER
DO
CALL mouse(mouse_event1, mouse_event2)
IF v.intro = 999 THEN KEY(15) OFF: EXIT SUB
LOOP UNTIL ABS(z1 - TIMER) > .75
v.intro = -1: a.max = 10
FOR i = 1 TO 90
CALL mouse(mouse_event1, mouse_event2)
IF v.intro = 999 THEN KEY(15) OFF: EXIT SUB
SOUND 900, .05
CALL alien_move
LOCATE j, k: COLOR 15: PRINT g.flagship;: COLOR 7
_DELAY .07
NEXT
z1 = TIMER
DO
CALL mouse(mouse_event1, mouse_event2)
IF v.intro = 999 THEN KEY(15) OFF: EXIT SUB
LOOP UNTIL ABS(z1 - TIMER) > 1
LOCATE j, k: PRINT " ";
CALL guardian_abduction
a.max = 0
z1 = TIMER
DO
CALL mouse(mouse_event1, mouse_event2)
IF v.intro = 999 THEN KEY(15) OFF: EXIT SUB
LOOP UNTIL ABS(z1 - TIMER) > .5
KEY(15) OFF
LOCATE v.bottom, _WIDTH - 20: PRINT SPACE$(20);
' Playing Instructions.
REDIM msg$(13)
msg$(1) = CHR$(249) + " " + "Look towards the top of your screen for Guardian ship status."
msg$(2) = CHR$(249) + " " + "Hold arrow keys up/dn/lt/rt or in combination to move diagonally."
msg$(3) = CHR$(249) + " " + "Missiles can be fired simultaneously in 8 different directions."
msg$(4) = CHR$(249) + " " + "Press Tab to fire 1-8 missiles in the direction of movement."
msg$(5) = CHR$(249) + " " + "Press Rt Ctrl to increase thrust, or Rt Alt to reduce thrust."
msg$(6) = ""
msg$(7) = CHR$(249) + " " + "Mouse alternative: "
msg$(8) = CHR$(249) + " " + "Hold right mouse button to move toward mouse pointer."
msg$(9) = CHR$(249) + " " + "Click left mouse button to fire 1-8 missiles in direction of mouse pointer."
msg$(10) = CHR$(249) + " " + "Mouse wheel up for more thrust, wheel down for less."
msg$(11) = CHR$(249) + " " + "Note: Tab and left mouse button cannot be used simultaneously."
msg$(12) = ""
msg$(13) = CHR$(249) + " " + "If you come in contact with an alien ship, your ship and crew get abducted."
j = 0
FOR i = 1 TO UBOUND(msg$)
IF LEN(msg$(i)) > j THEN j = LEN(msg$(i))
NEXT
i = ((v.right - v.left) - j) \ 2
t_mrgn = 6: b_mrgn = _HEIGHT - 4: l_mrgn = i + 1: r_mrgn = v.right - i
LOCATE t_mrgn - 2, l_mrgn - 2: PRINT STRING$(r_mrgn - l_mrgn + 4, CHR$(196));
LOCATE b_mrgn + 2, l_mrgn - 2: PRINT STRING$(r_mrgn - l_mrgn + 4, CHR$(196));
FOR i = 1 TO b_mrgn - t_mrgn + 3
LOCATE t_mrgn - 2 + i, l_mrgn - 2
PRINT CHR$(179);
LOCATE , r_mrgn + 2: PRINT CHR$(179);
NEXT
LOCATE t_mrgn - 2, l_mrgn - 2: PRINT CHR$(218);
LOCATE t_mrgn - 2, r_mrgn + 2: PRINT CHR$(191);
LOCATE b_mrgn + 2, l_mrgn - 2: PRINT CHR$(192);
LOCATE b_mrgn + 2, r_mrgn + 2: PRINT CHR$(217);
msg$ = "<Intro>"
LOCATE t_mrgn - 2, l_mrgn + (r_mrgn - l_mrgn) \ 2 - LEN(msg$) \ 2
PRINT msg$;
msg$ = "You are the Captain of the Guardian, an elite battle cruiser commissioned to protect our planet against alien invaders. You have 3 lives. Every time you are abducted by an alien ship, you lose a life. If you survive, and wipe out all 3 flights of alien attacks, your mission is completed. You saved Earth!"
j = r_mrgn - l_mrgn
LOCATE t_mrgn, l_mrgn
msg$ = RTRIM$(msg$) + " " ' Simple word parser routine.--------
DO
x$ = MID$(msg$, 1, j)
x$ = MID$(x$, 1, _INSTRREV(x$, " ") - 1)
msg$ = LTRIM$(MID$(msg$, LEN(x$) + 1))
LOCATE , l_mrgn: PRINT x$
LOOP UNTIL msg$ = "" '-----------------------------------------
PRINT
FOR i = 1 TO UBOUND(msg$)
LOCATE , l_mrgn
IF LEN(msg$(i)) THEN PRINT msg$(i) ELSE PRINT
NEXT
PRINT: IF CSRLIN < b_mrgn - 1 THEN PRINT
msg$ = "Good luck, Captain! Press any key to begin."
LOCATE , l_mrgn + (r_mrgn - l_mrgn) \ 2 - LEN(msg$) \ 2
PRINT msg$;
DO
_LIMIT 10
WHILE _MOUSEINPUT: WEND
IF _MOUSEBUTTON(1) THEN SOUND 1000, .1: EXIT DO
ky$ = INKEY$
IF ky$ = CHR$(27) THEN SYSTEM
IF LEN(ky$) THEN EXIT DO
LOOP
VIEW PRINT v.top TO v.bottom: CLS 2: VIEW PRINT
END SUB
SUB set_up
v.top = 3: v.bottom = _HEIGHT: v.left = 1: v.right = _WIDTH ' Boundaries.
g.flagship = CHR$(15)
a.ship = "-<>-"
g.num = 3 ' 3 Guardian (lives) to start.
g.thrusters = 10 ' Shows 1/2 thrust at start up on comm.
g.icon = g.flagship
g.m_asc = 250: g.diry = -1: ' Initiate missile ASCII character. g.diry = -1 initiates fire upwards if unmoved.
IF _FILEEXISTS("Thunder1.ogg") AND _FILEEXISTS("Thunder1.ogg") AND _FILEEXISTS("Thunder1.ogg") AND _FILEEXISTS("Thunder1.ogg") THEN ' Sound effects provided by TheBOB, Bob Seguin, from The QBasic Forum.
v.snd1 = _SNDOPEN("Thunder1.ogg", "SYNC")
v.snd2 = _SNDOPEN("Thunder7.ogg", "SYNC")
END IF
v.play = -1 ' Skip into on replay.
LOCATE 2, 1: PRINT STRING$(_WIDTH, CHR$(196));
_KEYCLEAR ' Clear any previous key presses in buffer.
END SUB
SUB game
STATIC mouse_event1, mouse_event2
REM Set mouse_event2 = 0 here to produce constant motion with directional changes.
'Press single or arrow key combo to move. Rt Ctrl = faster / Rt Alt = slower. Tab to fire missles.
g.thrusters = 10 ' Guardian movement delay. (1 to 20). Rt Ctrl = faster / Rt Alt = slower.
SELECT CASE v.level
CASE 1: a.max = 5 ' Sets number of space ships and initiates attack.
CASE 2: a.max = 10
CASE 3: a.max = 15
END SELECT
a.count = a.max
IF a.max < 6 THEN
a.cycle_delay = .005
ELSEIF a.max < 11 THEN a.cycle_delay = .003
ELSE a.cycle_delay = .001
END IF
CALL comm
DO
_LIMIT 60 ' Display at 60 frames per second.
CALL comm
IF g.m_status THEN CALL Guardian_missiles ' g.m_status determines Guardian or alien turn. 1 = Guardian, -1 = alien.
IF a.count = 0 THEN EXIT SUB ' Moving on to next level.
CALL alien_move
' To change thrusters only when guardian moves, remove the timer and move this routine to: IF v.kb_access = -1 THEN
IF ABS(z3 - TIMER) > .1 THEN ' z3 is a keypress delay timer for Guardian thrusters. Check every .1 seconds for a speed change.
IF _KEYDOWN(100307) AND g.thrusters < 20 THEN g.thrusters = g.thrusters + 1 ' Rt Ctrl key. Slows down Guardian ship down.
IF _KEYDOWN(100305) AND g.thrusters > 0 THEN g.thrusters = g.thrusters - 1 ' Rt Alt key. Speeds up Guardian ship.
z3 = TIMER
END IF
IF ABS(z2 - TIMER) > g.thrusters / 100 THEN ' z2 is delay for Guardian movement cycle. Note: Division needed because computer math can't add decimal numbers correctly.
IF v.kb_access = 0 THEN
IF _KEYDOWN(18432) OR _KEYDOWN(19200) OR _KEYDOWN(19712) OR _KEYDOWN(20480) OR mouse_event2 = -1 THEN ' Arrow keys.
v.kb_access = -1 ' Routes code to guardian move. When zero, Guardian move gets bypassed.
z1 = TIMER ' Delay timer for key lag effect in Guardian move routine.
END IF
END IF
END IF
IF v.kb_access = -1 THEN ' Guardian move routine.-----------------------------------------------------------------------------------------------------------------------------
IF ABS(z1 - TIMER) > .05 THEN ' z1 is a key lag time delay to allow guardian to press two keys together within a reasonable amount of time.
DO ' Faux loop added to throw out illegal key combos like up + down.
IF mouse_event2 = 0 THEN ' Bypass this keyboard routine if the right mouse button is in use.
IF mouse_event1 = 0 THEN g.m_x = 0: g.m_y = 0 ' Variables to control length and direction of Guardian movement. Must be reset to zero each cycle so diagonal moves are possible.
IF g.m_x = 0 AND g.m_y = 0 THEN
' Eliminate illegal combos.
IF _KEYDOWN(18432) AND _KEYDOWN(20480) THEN v.kb_access = 0: z2 = TIMER: EXIT DO ' Up + down
IF _KEYDOWN(19712) AND _KEYDOWN(19200) THEN v.kb_access = 0: z2 = TIMER: EXIT DO ' Left + right.
' IF female THEN STOP AND GET #1, directions. Keys that control movement.
IF _KEYDOWN(18432) THEN ' Up-arrow.
g.m_y = -1 ' To move 1-row up.
END IF
IF _KEYDOWN(19712) THEN ' Right-arrow.
g.m_x = 1 ' To move 1-column right.
END IF
IF _KEYDOWN(20480) THEN ' Down-arrow.
g.m_y = 1 ' To move 1-row down.
END IF
IF _KEYDOWN(19200) THEN ' Left-arrow.
g.m_x = -1 ' To move 1-column left.
END IF
IF g.m_x AND g.m_y THEN ' Double key hold. Routine to cancel keys when double hold is lifted. Compensates for both keys not being released at exactly the same time.
combo = -1 ' Double key hold in progress.
ELSE
IF combo THEN combo = 0: v.kb_access = 0: EXIT DO ' Double key hold was just removed, so skip Guardian move and exit.
END IF
END IF
END IF
' Move Guardian. *****************************************************************************************************
IF g.y + g.m_y > v.top AND g.y + g.m_y <= v.bottom AND g.x + 2 * g.m_x > v.left AND g.x + 2 * g.m_x < v.right THEN
LOCATE g.y, g.x
PRINT " ";
g.y = g.y + g.m_y: g.x = g.x + 2 * g.m_x
IF SCREEN(g.y, g.x) <> 32 AND SCREEN(g.y, g.x) <> g.m_asc THEN ' Guardian abducted by bad move. Ignore if you run into your own missile.
CALL guardian_abduction: EXIT SUB
ELSE
LOCATE g.y, g.x
PRINT g.flagship;
END IF
ELSE
BEEP ' Hit boundary.
END IF
v.kb_access = 0 ' Guardian move completed. Returns control to general keyboard next cycle.
z2 = TIMER ' Timer for moving. Lag regulated by "g.thrusters" variable.
EXIT DO ' ************************************************************************************************************
LOOP
END IF '
ELSE ' If you want additional key routines, put them here...------------------------------------------------------------------------------------------------------------------
CALL mouse(mouse_event1, mouse_event2)
ky$ = INKEY$
IF mouse_event1 = -1 THEN ky$ = CHR$(9)
IF LEN(ky$) = 1 THEN ' For demo, exclude keys that start with chr$(0). Note without this arrow keys would still register here.
SELECT CASE ky$
CASE CHR$(9) ' Tab key. Bug note: Space bar will not register with arrow up + arrow v.left.
IF ABS(z8 - TIMER) > .25 THEN
SELECT CASE g.m_launcher
CASE ""
IF mouse_event1 = -1 THEN g.m_launcher = "mouse" ELSE g.m_launcher = "keyboard" ' Initiate.
CASE "keyboard"
IF mouse_event1 = -1 THEN
IF g.m_fired = 0 THEN
g.m_launcher = "mouse" ' Switch.
ELSE
ky$ = ""
END IF
END IF
CASE "mouse"
IF mouse_event1 = 0 THEN ' Tab key was used.
IF g.m_fired = 0 THEN
g.m_launcher = "keyboard" ' Switch
ELSE
ky$ = ""
END IF
END IF
END SELECT
IF LEN(ky$) THEN
g.m_status = -1 ' -1 indicates missile just fired.
IF mouse_event1 = 0 THEN v.mouse_or_key_move = 0: ' Key pressed missile fire clears any previous mouse button missile fire.
END IF
mouse_event1 = 0 ' Completes left mouse missile firing cycle.
z8 = TIMER ' Missile firing delay reset.
END IF
CASE CHR$(27) ' Esc
_DELAY 1: SYSTEM
CASE ELSE
REM PRINT "You pressed key: "; ky$;
END SELECT
END IF
END IF '----------------------------------------------------------------------------------------------------------------------------------------------------------------------
LOOP
END SUB
SUB comm
STATIC middle% ' Local variable.
IF middle% = 0 THEN middle% = v.left + (v.right - v.left) \ 2
msg$ = " Thrusters = " + LTRIM$(STR$(5 * (20 - g.thrusters))) + "% Fired = " + LTRIM$(STR$(g.m_fired)) + " Alien ships = " + LTRIM$(STR$(a.count)) + " Level = " + LTRIM$(STR$(v.level)) + " Guardians: "
LOCATE 1, v.left + middle% - ((LEN(msg$) + 8) \ 2): PRINT msg$;
SELECT CASE g.num
CASE 3
PRINT g.icon; " "; g.icon; " "; g.icon;
CASE 2
PRINT g.icon; " "; g.icon; " ";: COLOR 8, 0: PRINT g.icon;: COLOR 7, 0
CASE 1
PRINT g.icon; " ";: COLOR 8, 0: PRINT g.icon; " "; g.icon;: COLOR 7, 0
CASE 0
COLOR 8, 0: PRINT g.icon; " "; g.icon; " "; g.icon; " ";: COLOR 7, 0
END SELECT
PRINT " "; ' Cut off any former printing caused by length changes in comm report like when numbers change from double to single digits.
END SUB
SUB Guardian_missiles
STATIC z4
DIM direction AS INTEGER ' 8 possible directions. local variable.
IF ABS(z4 - TIMER) > .03 THEN
z4 = TIMER
IF v.mouse_or_key_move = 0 THEN ' GAME OPTION: Remove this first IF/THEN to make it necessary to move Guardian in a direction to fire in that direction.
IF g.m_y <> 0 OR g.m_x <> 0 THEN g.diry = g.m_y: g.dirx = g.m_x ' Initiate by setting row and column missile direction to last column and row movement direction of Guardian location.
END IF
IF g.m_status = -1 THEN
IF g.diry = -1 AND g.dirx = 0 THEN
direction = 1
ELSEIF g.diry = -1 AND g.dirx = 1 THEN
direction = 2
ELSEIF g.diry = 0 AND g.dirx = 1 THEN
direction = 3
ELSEIF g.diry = 1 AND g.dirx = 1 THEN
direction = 4
ELSEIF g.diry = 1 AND g.dirx = 0 THEN
direction = 5
ELSEIF g.diry = 1 AND g.dirx = -1 THEN
direction = 6
ELSEIF g.diry = 0 AND g.dirx = -1 THEN
direction = 7
ELSEIF g.diry = -1 AND g.dirx = -1 THEN
direction = 8
END IF
IF m_n(direction) + 1 <= g.m_max THEN ' Don't fire if out of missiles.
IF g.y > v.top + 1 AND g.y < v.bottom AND g.x > v.left + 1 AND g.x < v.right - 1 THEN ' Don't fire if at a border.
m_n(direction) = m_n(direction) + 1
m_y(m_n(direction), direction) = g.y
m_x(m_n(direction), direction) = g.x
g.m_fired = g.m_fired + 1
SOUND 900, .1
END IF
END IF
g.m_status = 1 ' Code will now execute missile launch.
END IF
IF g.m_status = 1 THEN
FOR g.m_d = 1 TO 8 ' Check all directions.
IF m_n(g.m_d) > 0 THEN
j = m_n(g.m_d)
FOR g.m_n = 1 TO j
IF m_y(g.m_n, g.m_d) = g.y AND m_x(g.m_n, g.m_d) = g.x THEN
ELSE
LOCATE m_y(g.m_n, g.m_d), m_x(g.m_n, g.m_d): PRINT " ";
END IF
SELECT CASE g.m_d ' Missile direction.
CASE 1
IF m_y(g.m_n, g.m_d) - 1 > v.top THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) - 1
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR ' Missile off screen.
END IF
CASE 2
IF m_y(g.m_n, g.m_d) - 1 > v.top AND m_x(g.m_n, g.m_d) + 2 < v.right THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) - 1
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) + 2
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 3
IF m_x(g.m_n, g.m_d) + 2 < v.right THEN
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) + 2
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 4
IF m_y(g.m_n, g.m_d) + 1 < v.bottom AND m_x(g.m_n, g.m_d) + 2 < v.right THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) + 1
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) + 2
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 5
IF m_y(g.m_n, g.m_d) + 1 < v.bottom THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) + 1
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 6
IF m_y(g.m_n, g.m_d) + 1 < v.bottom AND m_x(g.m_n, g.m_d) - 2 > v.left THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) + 1
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) - 2
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 7
IF m_x(g.m_n, g.m_d) - 2 > v.left THEN
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) - 2
LOCATE m_y(g.m_n, g.m_d), m_x(g.m_n, g.m_d)
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 8
IF m_y(g.m_n, g.m_d) - 1 > v.top AND m_x(g.m_n, g.m_d) - 2 > v.left THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) - 1
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) - 2
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
END SELECT
NEXT
IF a.count = 0 THEN EXIT SUB
END IF
NEXT
IF g.m_fired <= 0 THEN g.m_fired = 0: g.m_status = 0 ' All missiles cleared.
END IF
END IF
END SUB
SUB missile_check (k)
LOCATE m_y(g.m_n, g.m_d), m_x(g.m_n, g.m_d) ' Place cursor at current missile position.
k = SCREEN(m_y(g.m_n, g.m_d), m_x(g.m_n, g.m_d)) ' Read the screen.
id_by_color = SCREEN(m_y(g.m_n, g.m_d), m_x(g.m_n, g.m_d), 1)
IF k <> 32 AND k <> g.m_asc AND k <> ASC(g.flagship) THEN ' If screen space is occupied by alien ship then explosion.
CALL remove_missile
CALL explosion
CALL remove_ship(id_by_color)
k = -1 ' A flag to exit the FOR/NEXT loop upon return.
ELSE
COLOR 14: PRINT CHR$(g.m_asc);: COLOR 7 ' Print missile on the screen. Missile advances here. Only place a missile is printed to the screen.
END IF
END SUB
SUB remove_missile
m_n(g.m_d) = m_n(g.m_d) - 1 ' Counter. Reduce the number of missiles fired, in a specific direction, by 1.
FOR k = g.m_n TO m_n(g.m_d) ' Re-stack arrays.
m_y(k, g.m_d) = m_y(k + 1, g.m_d)
m_x(k, g.m_d) = m_x(k + 1, g.m_d)
NEXT
m_y(k, g.m_d) = 0: m_x(k, g.m_d) = 0 'Zero out location variables of the missile removed. A zero removes unnecessary loop checking for other routines.
g.m_fired = g.m_fired - 1 ' Count of number of missiles fired is reduce by 1.
END SUB
SUB mask_missiles
FOR i = 1 TO g.m_max
FOR j = 1 TO 8
IF m_y(i, j) <> 0 THEN LOCATE m_y(i, j), m_x(i, j): PRINT " "; ' Mask missile.
NEXT j, i
m_status = 0: m_fired = 0: m_n = 0: m_d = 0: m_y = 0: m_x = 0
REDIM m_n(g.m_max), m_x(g.m_max, 8), m_y(g.m_max, 8)
END SUB
SUB explosion
soundfile% = 1 ' Local variable turns sound on.
b_y1 = CSRLIN: b_x1 = POS(0)
VIEW PRINT v.top TO v.bottom ' Needed to set print error parameters.
h = 0
ON ERROR GOTO offscreen
DO
IF h = 1 THEN burst$ = " " ELSE burst$ = CHR$(249)
IF v.intro THEN burst$ = "" ' No fireworks, just flash and sound.
h = h + 1
' Flash
IF eflag THEN
IF ABS(z7 - TIMER) > .1 THEN
eflag = 0
PALETTE 0, 0
z7 = TIMER
ELSE
j = -j * -1
IF j = 0 THEN
PALETTE 0, 63
_DELAY .05
ELSE
PALETTE 0, 0
_DELAY .05
END IF
END IF
END IF
IF eflag = 0 THEN
PALETTE 0, 36
IF soundfile% THEN
_SNDPLAY v.snd1
_DELAY .05
PALETTE 0, 0
_SNDPLAY v.snd2
ELSE
_DELAY .075
END IF
eflag = -1
z7 = TIMER
END IF
PALETTE 0, 0 ' End flash.
FOR i = 1 TO 5
SELECT CASE i
CASE 1
COLOR 15
LOCATE b_y1, b_x1: PRINT burst$;
_DELAY .1
CASE 2
IF burst$ = CHR$(249) THEN burst$ = CHR$(250)
COLOR 14, 0
LOCATE b_y1 - 1, b_x1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1 - 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1 + 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1 + 1, b_x1
IF er = 0 THEN PRINT burst$; ELSE er = 0
_DELAY .1
CASE 3
LOCATE b_y1 - 1, b_x1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 - 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 + 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1 + 1, b_x1
IF er = 0 THEN PRINT " "; ELSE er = 0
CASE 4
COLOR 4
LOCATE b_y1 - 1, b_x1 - 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1 - 1, b_x1 + 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1 - 2
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1 + 2
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1 + 1, b_x1 - 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1 + 1, b_x1 + 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
_DELAY .3
CASE 5
LOCATE b_y1 - 1, b_x1 - 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1 - 1, b_x1 + 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 - 2
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 - 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 + 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 + 2
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1 + 1, b_x1 - 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1 + 1, b_x1 + 1
IF er = 0 THEN PRINT " "; ELSE er = 0
END SELECT
NEXT
IF h = 1 THEN h = 0: EXIT DO
LOOP
VIEW PRINT
ON ERROR GOTO 0
COLOR 7
IF a.count = 1 THEN CALL mask_missiles ' Clear unexploded missiles off the screen when changing levels. Game Option: Remove variable to mask missiles after every explosion.
LOCATE b_y1, b_x1
END SUB
SUB remove_ship (id_by_color) ' Removes ship by color identification.
i = a.itr
ON ERROR GOTO offscreen
LOCATE a_mask_y(id_by_color), a_mask_x(id_by_color): PRINT SPACE$(LEN(a.ship));
LOCATE a_y(id_by_color), a_x(id_by_color): PRINT SPACE$(LEN(a.ship));
ON ERROR GOTO 0
a.itr = id_by_color: CALL a_erase
a_ran(id_by_color) = -1 ' Denotes alien ship was destroyed and removed from battle.
a.itr = i
a.count = a.count - 1 ' a.count = 0 will cause program to exit any unneeded subs/loops after the game level sub is completed.
CALL comm
' Restore any alien ships in blast zone.
FOR i = 1 TO a.max
IF a_ran(i) > 0 THEN
IF a_y(i) > v.top AND a_x(i) > v.left AND a_x(i) + LEN(a.ship) < v.right THEN LOCATE a_y(i), a_x(i): COLOR i: PRINT a.ship;
END IF
NEXT
COLOR 7
LOCATE g.y, g.x: PRINT g.flagship; ' Re-display Guardian.
IF a.count = 0 THEN ' All alien ships destroyed.
IF v.level < 3 THEN
CALL game_level ' Advance to next level.
ELSE
CALL game_over ' Guardian wins! IMPORTANT: Must now exit sub without other conditions.
END IF
END IF
END SUB
SUB alien_move
STATIC z5
y_restore = CSRLIN: x_restore = POS(0) ' Restore column and row upon exit.
IF ABS(z5 - TIMER) > a.cycle_delay OR v.intro THEN ' z5 is a time delay for alien space ship maneuvers. It can be altered in the "game" subroutine.
IF v.intro = 0 THEN h_alien_nom = INT(RND * a.max) + 1 ELSE h_alien_nom = 15
FOR h = 1 TO h_alien_nom ' Local counting variable for alien number of moves in this cycle.
a.itr = a.itr + 1: IF a.itr > a.max THEN a.itr = 1 ' Needed to offset the EXIT DO hover event, which on exit does not affect the a.itr variable.
IF a_ran(a.itr) <> -1 THEN ' This is how a destroyed ship is bypassed. -1 is a destroyed alien ship. Code moves to end of DO:LOOP.
IF a_inertia(a.itr) = 0 THEN ' Determine how many moves in one direction.
a_inertia(a.itr) = INT(RND * (v.bottom - v.top) / 2) + 1 ' How many moves to go in any one direction.
a_ran(a.itr) = INT(RND * 8) + 1 ' Choose 1 of 8 possible directions.
IF a_ran(a.itr) = a_olda_ran(a.itr) OR a_mask_y(a.itr) = 0 AND a_mask_x(a.itr) = 0 AND ran = 1 OR a_mask_y(a.itr) = 0 AND a_mask_x(a.itr) = 0 AND ran = 5 THEN
EXIT FOR ' Just hover if direction was not changed on existing alien space ship or if a new alien space ship is entering from the sides and up or down was generated.
END IF
SELECT CASE a_ran(a.itr) ' Get changes in column and row coordinates.
CASE 1: a_y_loc(a.itr) = -1: a_x_loc(a.itr) = 0 ' Up.
CASE 2: a_y_loc(a.itr) = -1: a_x_loc(a.itr) = 2 ' Up and right.
CASE 3: a_y_loc(a.itr) = 0: a_x_loc(a.itr) = 2 ' Right.
CASE 4: a_y_loc(a.itr) = 1: a_x_loc(a.itr) = 2 ' Down and right.
CASE 5: a_y_loc(a.itr) = 1: a_x_loc(a.itr) = 0 ' Down.
CASE 6: a_y_loc(a.itr) = 1: a_x_loc(a.itr) = -2 ' Down and left.
CASE 7: a_y_loc(a.itr) = 0: a_x_loc(a.itr) = -2 ' Left.
CASE 8: a_y_loc(a.itr) = -1: a_x_loc(a.itr) = -2 ' Up and left.
END SELECT
IF a_y(a.itr) = 0 AND a_x(a.itr) = 0 AND a_ran(a.itr) <> -1 THEN ' New alien space ship enters the screen.
i = RND * (v.bottom - v.top) \ 4
a_y(a.itr) = (v.bottom - v.top) \ 4 + i + v.top
IF a_ran(a.itr) < 5 THEN ' Determine side of entry from initial direction.
IF SCREEN(a_y(a.itr), v.left + LEN(a.ship)) = 32 THEN
a_x(a.itr) = v.left + 1 ' Enter from the left side and go right.
ELSE
CALL a_erase
EXIT FOR
END IF
ELSE
IF SCREEN(a_y(a.itr), v.right - LEN(a.ship) + 1) = 32 THEN
a_x(a.itr) = v.right - LEN(a.ship) ' Enter from the right side and go left.
ELSE
CALL a_erase
EXIT FOR
END IF
END IF
END IF
a_olda_ran(a.itr) = a_ran(a.itr) ' Remember last direction. Another line uses this to disallow any RND that chooses the same direction twice.
ELSE
a_inertia(a.itr) = a_inertia(a.itr) - 1 ' Count down the number of moves in any one direction. When zero, switch direction.
END IF
FOR i = 1 TO a.max
IF i <> a.itr AND a_y(i) <> 0 THEN
IF a_y(a.itr) + a_y_loc(a.itr) = a_y(i) THEN
IF a_x(a.itr) + a_x_loc(a.itr) + LEN(a.ship) > a_x(i) AND a_x(a.itr) + a_x_loc(a.itr) < a_x(i) + LEN(a.ship) THEN
collide = 1
EXIT FOR
END IF
END IF
END IF
NEXT
IF collide = 1 THEN
j = a_y(a.itr): k = a_x(a.itr)
a_y_loc(a.itr) = 0: a_x_loc(a.itr) = 0: a_inertia(a.itr) = 0
collide = 0 ' Collision detection off. Collision was detected and avoided.
ELSE
j = a_y(a.itr) + a_y_loc(a.itr): k = a_x(a.itr) + a_x_loc(a.itr)
END IF
IF j <= v.top OR k <= v.left OR k + LEN(a.ship) > v.right THEN ' Alien ship out of range, off screen.
a_inertia(a.itr) = 0 ' These two lines keep the out of range ship(s) reasonably nearby.
IF j > v.top - 4 AND k < v.right + 3 AND k > v.left - 4 THEN a_y(a.itr) = j: a_x(a.itr) = k
IF a_mask_y(a.itr) <> 0 AND a_mask_x(a.itr) <> 0 THEN
LOCATE a_mask_y(a.itr), a_mask_x(a.itr)
PRINT SPACE$(LEN(a.ship)); ' Mask old position here because the show part of the mask-and-show routine cannot be used when out of range.
END IF
IF a_offscrn(a.itr) > 25 THEN a_y(a.itr) = 0: a_x(a.itr) = 0: a_inertia(a.itr) = 0: a_offscrn(a.itr) = 0
a_mask_y(a.itr) = 0: a_mask_x(a.itr) = 0: a_offscrn(a.itr) = a_offscrn(a.itr) + 1
ELSE
' Check for v.bottom collision and reverse course if detected.
COLOR a.itr
IF j >= v.bottom THEN
a_y_loc(a.itr) = -a_y_loc(a.itr): a_x_loc(a.itr) = -a_x_loc(a.itr)
ELSE
a_y(a.itr) = j: a_x(a.itr) = k ' Next move coordinates.
ii = 0
kk = ASC(g.flagship)
FOR i = 0 TO LEN(a.ship) - 1 ' Check area through width of ship. Remember all or parts of ship are still present on screen.
SELECT CASE SCREEN(j, k + i)
CASE kk
ii = 1 ' Indicates contact with flagship and evokes call abduction routine a few lines down.
EXIT FOR
CASE g.m_asc
ii = 2 ' Indicates ship into missile collision.
EXIT FOR 'Okay to exit as a missile and Guardian craft cannot be present in the same location.
END SELECT
NEXT
IF ii <> 2 THEN ' This will make a move unless a ship into missile event would occur.
'--------------------------------------------Move alien ship-------------------------------------------------
IF a_mask_y(a.itr) <> 0 AND a_mask_x(a.itr) <> 0 THEN LOCATE a_mask_y(a.itr), a_mask_x(a.itr): PRINT SPACE$(LEN(a.ship));
LOCATE j, k: PRINT a.ship;
a_mask_y(a.itr) = j: a_mask_x(a.itr) = k ' Remember these coordinates to erase alien space ship on next loop.
'------------------------------------------------------------------------------------------------------------
END IF
IF ii = 1 THEN CALL guardian_abduction: EXIT FOR ' Exit loop.
END IF
COLOR 7
END IF
END IF ' a_ran(a.itr) > -1 exit point.
IF a.itr = a.max THEN a.itr = 0: EXIT FOR ' Finished loop. Keep this outside the IF/THEN statement.
NEXT h
z5 = TIMER
LOCATE y_restore, x_restore ' Restore entry column and row positions.
END IF ' End time event.
END SUB
SUB guardian_abduction
IF v.intro = 0 THEN
CALL mask_missiles ' Clear unexploded missiles off the screen after alien abduction.
msg$ = "[GUARDIAN ABDUCTED]"
SOUND 500, .4: SOUND 1000, .3: SOUND 1500, .2
PCOPY 0, 1
SCREEN 0, 0, 1, 1
LOCATE (v.bottom - v.top) \ 2 + v.top, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14 + 16: PRINT msg$;
_DELAY 2
SCREEN 0, 0, 0, 0
END IF
DO
j = 0
FOR i = 1 TO a.max
IF a_y(i) >= v.top AND a_x(i) >= v.left AND a_x(i) <= v.right - LEN(a.ship) THEN
SOUND 500, .04
LOCATE a_y(i), a_x(i): PRINT SPACE$(LEN(a.ship));
IF a_y(i) <> v.top THEN a_y(i) = a_y(i) - 1: LOCATE a_y(i), a_x(i): COLOR i: PRINT a.ship;: _DELAY .02: j = 1
END IF
NEXT
LOOP WHILE j
COLOR 7
IF v.intro THEN EXIT SUB
g.num = g.num - 1
CALL comm
IF g.num = 0 THEN ' Game Over.
CALL comm
CALL game_over
END IF
v.level = -v.level ' Satisfies two conditions. 1) Puts game back to beginning level. 2) Bypasses the part of the game_level routine that reprints the guardian craft.
CALL game_level
_DELAY .75
a.count = 0 ' Needed to exit subs back to main game loop.
END SUB
SUB game_level ' Evaluates both alien defeated on a level and Guardian abduction.
IF v.level > -1 THEN ' Bypass if abducted (v.level = -1) Make a new variable for this if the game is modified to not go back to the starting level.
LOCATE g.y, g.x
PRINT g.flagship;
_DELAY .5
LOCATE g.y, g.x
PRINT " "; ' Mask Guardian craft.
END IF
_DELAY 1
VIEW PRINT v.top TO v.bottom: CLS 2: VIEW PRINT
IF v.level < 0 THEN v.level = ABS(v.level) ELSE v.level = v.level + 1 ' Less than zero if abducted.
msg$ = "[LEVEL " + LTRIM$(STR$(v.level)) + "]"
LOCATE (v.bottom - v.top) \ 2 + v.top, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14 + 16: PRINT msg$;
j = 0: k = 0
DO
IF ABS(z0 - TIMER) > .15 THEN
IF j = 0 THEN j = 1: SOUND 750, .3: k = k + 1 ELSE j = 0: _DELAY .1
z0 = TIMER
END IF
LOOP UNTIL k = 6
COLOR 7
LOCATE , v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
PRINT msg$;
VIEW PRINT v.top TO v.bottom: CLS 2: VIEW PRINT
_DELAY .75
g.y = (v.bottom - v.top) \ 2 + v.top: g.x = (v.right - v.left + 1) \ 2 + v.left ' Reset column and row for Guardian craft.
LOCATE g.y, g.x
COLOR 15 + 16: PRINT g.flagship;
_DELAY 1.5
COLOR 7: LOCATE g.y, g.x: PRINT g.flagship;
v.level_up = -1
CALL mouse(0, 0) ' Clears the mouse_events.
END SUB
SUB a_erase
a_y(a.itr) = 0: a_x(a.itr) = 0: a_mask_y(a.itr) = 0: a_mask_x(a.itr) = 0: a_inertia(a.itr) = 0: a_ran(a.itr) = 0: a_y_loc(a.itr) = 0: a_x_loc(a.itr) = 0: a_olda_ran(a.itr) = 0
END SUB
SUB mouse (mouse_event1, mouse_event2)
STATIC z9, z10, lb, lb_status ' lb_status keeps track of press/release.
WHILE _MOUSEINPUT
IF ABS(z10 - TIMER) > .1 THEN
z10 = TIMER
IF _MOUSEWHEEL > 0 THEN ' Down
IF g.thrusters < 20 THEN g.thrusters = g.thrusters + 1
ELSEIF _MOUSEWHEEL < 0 THEN ' Up
IF g.thrusters > 0 THEN g.thrusters = g.thrusters - 1
END IF
END IF
WEND
mx = _MOUSEX
my = _MOUSEY
lb = _MOUSEBUTTON(1)
rb = _MOUSEBUTTON(2)
IF lb THEN
IF lb_status = 0 THEN
IF ABS(z9 - TIMER) > .33 THEN
z9 = TIMER
mouse_event1 = -1: lb_status = -1: ' Left button down
END IF
END IF
ELSE
IF lb_status THEN lb_status = 0 ' Left button was released.
END IF
IF v.mouse_get_screen THEN
IF lb_status = -1 THEN
x$ = CHR$(SCREEN(my, mx))
SELECT CASE v.mouse_get_screen
CASE 1 ' Skip intro.
IF x$ = "S" THEN v.intro = 999: SOUND 1000, .3: EXIT SUB
CASE 2 ' Replay
IF x$ = "Y" THEN v.play = 999: SOUND 1000, .1: EXIT SUB
IF x$ = "N" THEN v.play = -999: SOUND 1000, .1: EXIT SUB
END SELECT
END IF
END IF
cx = g.x: cy = g.y ' Angular calculations provided by bplus from the QB64 Phoenix Forum.
stepX = ABS(cx - mx): stepY = ABS(cy - my)
dAng = INT(_R2D(_ATAN2(my - cy, mx - cx)) + .5)
IF dAng < 0 THEN dAng = dAng + 360
IF dAng <= 90 THEN
startA = 0: endA = dAng: ra = dAng
ELSEIF dAng <= 180 THEN
startA = dAng: endA = 180: ra = 90 - (dAng - 90)
ELSEIF dAng <= 270 THEN
startA = 180: endA = dAng: ra = dAng - 180
ELSEIF dAng <= 360 THEN
startA = dAng: endA = 360: ra = 90 - (dAng - 270)
END IF
m_y = 0: m_x = 0
IF ra <= 90 AND ra >= 50 THEN
IF my > g.y THEN
x$ = "down": m_y = 1: m_x = 0 ' Down.
ELSE
x$ = "up": m_y = -1: m_x = 0 ' Up.
END IF
ELSEIF ra < 50 AND ra >= 15 THEN
IF mx > g.x AND my > g.y THEN
x$ = "down right": m_y = 1: m_x = 2 ' Down and right.
ELSEIF mx < g.x AND my > g.y THEN
x$ = "down left": m_y = 1: m_x = -2 ' Down an left.
ELSEIF mx > g.x AND my < g.y THEN
x$ = "up right": m_y = -1: m_x = 2 ' Up and right.
ELSEIF mx < g.x AND my < g.y THEN
x$ = "up left": m_y = -1: m_x = -2 ' Up and left.
END IF
ELSEIF ra < 15 AND ra >= 0 THEN
IF mx > g.x THEN
x$ = "right": m_y = 0: m_x = 2 ' Right
ELSE
x$ = "left": m_y = 0: m_x = -2 ' Left
END IF
END IF
IF rb AND mouse_event2 = 0 THEN
mouse_event2 = -1
g.m_y = m_y: g.m_x = m_x / 2
v.mouse_or_key_move = 1 ' Right mouse button to move.
ELSE
IF mouse_event2 THEN mouse_event2 = 0
END IF
IF mouse_event1 THEN
g.diry = m_y: g.dirx = m_x / 2
v.mouse_or_key_move = -1
END IF
END SUB
SUB game_over
v.mouse_get_screen = 2 ' Allows mouse to select replay options.
_DELAY .5
CALL comm
IF a.count = 0 THEN SOUND 1000, .75: SOUND 500, .75: SOUND 1000, 1.5 ELSE SOUND 1000, .75: SOUND 700, .75: SOUND 500, 1.5
_DELAY .5
VIEW PRINT v.top TO v.bottom: CLS 2: VIEW PRINT
IF a.count = 0 THEN msg$ = "[GUARDIAN WINS]" ELSE msg$ = "[Game Over]"
LOCATE (v.bottom - v.top) \ 2 + v.top - 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14 + 16
PRINT msg$;
_DELAY 2
LOCATE (v.bottom - v.top) \ 2 + v.top - 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14: PRINT msg$;
msg$ = "Replay? Y/N"
_DELAY 1
LOCATE (v.bottom - v.top) \ 2 + v.top + 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 8
PRINT msg$;
COLOR 7
DO
_LIMIT 30
CALL mouse(mouse_event1, mouse_event2)
ky$ = INKEY$
IF LEN(ky$) OR v.play = 999 OR v.play = -999 THEN
IF v.play = 999 OR UCASE$(ky$) = "Y" OR ky$ = CHR$(13) THEN v.play = 1: v.level = 0: VIEW PRINT v.top TO v.bottom: CLS 2: VIEW PRINT: EXIT DO
IF v.play = -999 OR UCASE$(ky$) = "N" OR ky$ = CHR$(27) THEN
msg$ = " [Bye Bye] "
LOCATE (v.bottom - v.top) \ 2 + v.top - 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14 + 16: PRINT msg$;
_DELAY 1
LOCATE (v.bottom - v.top) \ 2 + v.top - 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14: PRINT msg$;
_DELAY .5
SYSTEM
END IF
END IF
LOOP
END SUB
Note 1: I coded it to adjust to your desktop size. It works well on mine, but let me know if it doesn't seem to be a good fit on yours. You can always press Alt + Enter, to run it full screen, too.
Note 2: Alien's can run off the screen, and come back. What I need to work on now is a method so the last one doesn't run off the screen for too long. Normally it's just a few seconds, but I have had a handful of time it has taken a few minutes, and that's way too long. But that, and a little more A.I. is for another day... after my egg facial wears off from another discussion thread.
Pete
Don't forget, download the soud effects file below, and save it in the same folder.
ASCII Invaders Sound.7z (Size: 1.45 MB / Downloads: 62)
Posts: 1,277
Threads: 120
Joined: Apr 2022
Reputation:
100
I just got done playing a few rounds of Guardians. It's amazing how much can be done on a giant ASCII screen. I see no reason why this game couldn't be converted to graphics easily.
The game play is difficult. It took me a few times to beat level 3 "Guardian Wins". It's difficult to aim the bullets at the enemy since you really have no indication of where the enemy ships are heading. There's no "front end" of the ship so to speak. The game play reminds me of a cross between Asteroids and Phoenix.
https://en.wikipedia.org/wiki/Phoenix_(video_game)
Converting this to graphics would allow:
- Rotating the player ship in more than 8 positions allowing for finer missile aiming
- The player and enemy ships could have front ends showing which direction they are heading
- The enemy ships could be made to turn around in tight circles showing they are changing direction
- Explosion effects (although your ASCII explosions are really cool)
- Allow the player ship to be thrusted around like the ship in Asteroids. That gets intuitive pretty quickly and allows "sliding" around enemies.
When converting I would suggest:
- use sprites that have the same odd dimensions: 129x129, 65x65, 31x31, etc..
This gives the sprite a definitive center point for _MAPTRIANGLE rotation. Over the years I've found this to work best with _MAPTRIANGLE.
- Use a combination of rectangular collision and line intersect collision. Rectangular for proximity and then line intersection to see if a bullet crosses the rotated bounding box surrounding the enemy ship. Basically a box rotating inside of another box. The inner box will always maintain the same dimension while the outer box changes in size.
(As you rotate a sprite it changes size. The overall rectangle grows and shrinks. This is where rectangular collision comes into play for proximity. The four points of rotation are used to create a bounding box of four lines that line detection can then use to see if the actual sprite was hit. Line detection eliminates the effect of "bullet pass through" where an enemy is heading straight for a bullet and the bullet passes through because of the speed of the bullet and enemy combined causes the bullet to skip over. I had to do this in Widescreen Asteroids because of small fast moving asteroids. An imaginary line is drawn from the previous bullet location to the next and that imaginary line is used for line intersection with the four bounding box lines. This also gives you a precise coordinate of collision allowing for accurate explosion placement.)
Some suggestions to add:
- A limited number of "smart" missiles per level that lock on to an enemy and chase it down.
- As the enemy ships get closer to the player they get "smarter" and home in on the player.
As the player gets "braver" they'll get closer to the enemy ships for better aiming knowing the risks of doing that.
- Every once in a while the enemy ships could group into small attack formations and swoop toward the player.
- As the levels progress the enemy ships gain skills: shooting, better attack formations, the "smart" home in distance gets greater, etc..
This is a concept for a game that graphics would really enhance. all of the above suggestions could easily be put into the ASCII version as well.
Terry
Posts: 2,160
Threads: 222
Joined: Apr 2022
Reputation:
103
Question, did you use the keyboard or the mouse to control Guardian? I like the mouse. I would have programmed a joystick, if I had one, but the mouse is a close second, as it can cause Guardian to move and fire in any direction (based on where the pointer is in relation to the ship (relationship) and the mouse wheel controls the thrust speed.
Yeah, with just randomization, it's hard to win for a bit,and I'm actually continuing work on an AI "hunting" routine as we speak. I started that routine last night. The next effect I want to explore is a reduction of power so if you explode an enemy ship too close (within the animated blast zone.) it results in slower speed, fewer missiles, etc. Of course these two modifications benefit the aliens, and at some point, it might get too difficult to play to win, which could be balanced with something like your suggestion of using smart missiles.
One game aspect I' torn between is there are three ways this game could be coded to play. 1) No motion. 2) Motion with no stopping. 3) The combo of 1 and 2 that it currently is. Each has a different playing strategy.
I've got a list of other ideas for the game. Surprise factors, like that swarming idea you posted (hadn't thought of that one, thanks!) a mother ship, etc. all make games more unpredictable and exciting.
I feel the trick is to never over-complicate things. For instance 10 keys to control all sorts of player choices is over-kill! Oh, and remember Defender? It granted the player smart bombs for good play. That was cool, but what the developers failed to address was a player could camp out safely at the bottom of the screen, build up smart bombs, and then just keep using them. Took forever playing tit that way, but once I rolled the counter over on the Atari version using that method.
What I haven't had a good feel for is a good way to make a "high score" in this game. It's a bit like Star Master. You win or lose. The way that game determined score was by how fast you were able to win, minus the number of times you were hit. That's the best I can come up with for this game, as well.
Thanks a ton for all the graphics mechanics "how to's.". Bob mentioned he had something worked up for a rotating Guardian sprite. I don't know how much difference there would be in a SCREEN 12 version vs using _NEWMAGE. I don't think Bob has ever worked using _NEWIMAGE, but I guess a sprite is a sprite in either case.
Thanks for giving it a spin,
Pete
Posts: 2,160
Threads: 222
Joined: Apr 2022
Reputation:
103
10-15-2022, 08:01 PM
(This post was last modified: 10-15-2022, 11:42 PM by Pete.)
Okay, if you ever get really good at my first version, I made the aliens even tougher to beat...
GUARDIAN V 1.1 (Don't forget to download the sound files in the other post if this is new to you.)
Code: (Select All) DEFINT H-K
$RESIZE:ON
_RESIZE OFF
RANDOMIZE TIMER
' Note: timer is not adjusted for stroke of midnight event, so don't stay up late playing this.
REM Main
f1 = 22 ' Sets font size to 22 and calculates the max screen height and width for your desktop.
h = (_DESKTOPHEIGHT - 60) \ f1
w = _DESKTOPWIDTH \ (f1 / 1.66)
WIDTH w, h
_SCREENMOVE 0, 0
fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.
font& = _LOADFONT(fontpath$, f1, "monospace")
_FONT font&
_DELAY .25
_RESIZE ON , _SMOOTH ' Allows resizing. Note: this is for slight adjustments. As of this version there is no compensatory function to change the font size during screen size changes.
TYPE gen_var
intro AS INTEGER ' Runs a protion of the alien subroutine as part of the intro.
nol AS INTEGER ' Number of game levels.
redo_level AS INTEGER ' Alien abdution results in redo level.
level AS INTEGER ' Current game level.
level_up AS INTEGER ' Routes code to next game level.
top AS INTEGER ' Top boundary. (Changeable).
bottom AS INTEGER ' Bottom boundary. (Changeable).
left AS INTEGER ' Left boundary. (Changeable).
right AS INTEGER ' Right boundary. (Changeable).
kb_access AS INTEGER ' Routes code to either Guardian/Alien or general keyboard routine. -1 Guardian/Alien, 0 keyboard.
mouse_or_key_move AS INTEGER
mouse_get_screen AS INTEGER
play AS INTEGER
snd1 AS LONG ' Explosion sound effect.
snd2 AS LONG ' Explosion sound effect.
END TYPE
DIM SHARED v AS gen_var
TYPE guardian
num AS INTEGER ' Number of Guardians aka lives.
diry AS INTEGER ' Guardian row move. +1, 0, -1.
dirx AS INTEGER ' Guardian column move. +2, 0, -2. Equals vertical pixel movement. 16x8.
y AS INTEGER ' Guardian coordinates row.
x AS INTEGER ' Guardian coordinates column.
thrusters AS INTEGER ' Guardian speed. (User Determined).
m_max AS INTEGER ' Restricts # of missiles fired in one direction.
m_status AS INTEGER ' Missile status. -1 when fired, 1 while moving.
m_fired AS INTEGER ' The number of missile deployed and still active.
m_n AS INTEGER ' FOR/NEXT counter variable shared by other routines to index through the number of missiles fired in a specific direction.
m_d AS INTEGER ' Missile direction. (1-8).
m_y AS INTEGER ' Missile row advancement increment: +1, 0, -1 Note: Missile row and column coordinates are defined in arrays.
m_x AS INTEGER ' Missile column advancement increment: +2, 0, -2. Equals vertical pixel movement. 16x8.
m_asc AS INTEGER ' ASCII character representing a fired missile.
m_launcher AS STRING
icon AS STRING ' Guardian comm icon. For this edition, it is the same as the flagship: "*"
flagship AS STRING ' Guardian ascii character.
END TYPE
DIM SHARED g AS guardian
TYPE alien
max AS INTEGER ' Maximum # of alien ships on screen.
count AS INTEGER ' Number of alien ships. (Counter).
itr AS INTEGER ' Iteration array number to cycle through the active alien ships. (Counter).
cycle_delay AS SINGLE ' Timer cycle controls how fast alien ships move.
ship AS STRING ' Alien ship ASCII design.
END TYPE
DIM SHARED a AS alien
DO
GOSUB set_arrays
SELECT CASE v.play
CASE 0
CALL set_up
CALL comm
CALL intro
GOSUB set_arrays: GOSUB zero_variables ' Reset arrays and zero variables after intro.
CALL level_up
CASE 1
CALL set_up
CALL comm
END SELECT
CALL game_level ' Display level.
g.y = (v.bottom - v.top) \ 2 + v.top: g.x = (v.right - v.left + 1) \ 2 + v.left ' Set initial column and row for Guardian craft.
CALL game
IF v.level < v.nol AND g.num > 0 THEN
IF v.redo_level = 0 THEN CALL level_up
ELSE
CALL game_over
v.level = 1 ' Reinitiate if player chooses to replay.
END IF
GOSUB zero_variables
LOOP
set_arrays:
ii = 15 ' Default max setting for number of alien ships used here to initially dim arrays.
g.m_max = 8 ' * missiles max per direction.
REDIM SHARED a_y(ii), a_x(ii), a_mask_y(ii), a_mask_x(ii), a_inertia(ii) ' Alien movement.
REDIM SHARED a_ran(ii), a_olda_ran(ii), a_y_loc(ii), a_x_loc(ii), a_offscrn(ii) ' Alien movement.
REDIM SHARED m_n(g.m_max), m_x(g.m_max, 8), m_y(g.m_max, 8) ' Guardian missiles.
' Array descriptions and actions.
' a_y() , a_x() Alien ship positions rows and columns.
' a_mask_y(), a_mask_x() Alien ship last position. Masked on next move.
' a_inertia(ii) Number of moves in one direction selected by random for an alien ship.
' a_ran(ii), a_olda_ran(ii) Determines the direction in which the inertia will travel and the prior direction is kept to disallow the same direction twice.
' a_y_loc(ii), a_x_loc(ii) The row and column coordinates of the aliens ships.
' m_n(g.m_max), m_x(g.m_max, 8), m_y(g.m_max, 8) Missile number and Missile index 1 to g.m_max for position. 8 is the fixed number of 8 different directions.
RETURN
zero_variables:
' Zero variables.
g.diry = 0: g.dirx = 0: g.m_status = 0: g.m_fired = 0: g.m_d = 0: g.m_y = 0: g.m_x = 0: v.redo_level = 0: a.max = 0: v.intro = 0
a.count = 0: a.itr = 0: a.cycle_delay = 0: v.level_up = 0: v.mouse_or_key_move = 0: g.m_launcher = ""
RETURN
skipintro:
v.intro = 999
BEEP: BEEP
VIEW PRINT v.top TO v.bottom
CLS 2
VIEW PRINT
_DELAY .5
RETURN
' Error handler.
offscreen: ' Prevents error if blast particles row and column are off-screen. Effect is a partial blast on side of screen.
IF ERR = 5 THEN er = -1: RESUME NEXT
PRINT "Opps, unexpected error"; ERR
END
SUB intro
v.mouse_get_screen = 1 ' Allows skip intro by mouse selection.
LOCATE _HEIGHT, _WIDTH - 15
PRINT "[S]kip Intro"; ' Option to skip the intro using the "S" key with ONKEY statement.
KEY 15, CHR$(0) + CHR$(31) 'scancode for S
ON KEY(15) GOSUB skipintro
KEY(15) ON 'turn ON [S]kip intro event trapping.
j = (v.bottom - v.top) \ 2 + v.top
k = (v.right - v.left) \ 2 + v.left
z1 = TIMER
DO
CALL mouse(mouse_event1, mouse_event2)
IF v.intro = 999 THEN KEY(15) OFF: EXIT SUB
LOOP UNTIL ABS(z1 - TIMER) > .33
SOUND 1000, .3
msg$ = " GUARDIAN "
LOCATE j, k - LEN(msg$) \ 2: COLOR 14: PRINT msg$;: COLOR 7
LOCATE , k
z1 = TIMER
DO
CALL mouse(mouse_event1, mouse_event2)
IF v.intro = 999 THEN KEY(15) OFF: EXIT SUB
LOOP UNTIL ABS(z1 - TIMER) > .66
msg$ = SPACE$(LEN(msg$))
LOCATE j, k - LEN(msg$) \ 2: COLOR 7: PRINT msg$;
LOCATE j, k
IF v.intro = 999 THEN KEY(15) OFF: EXIT SUB ELSE CALL explosion
LOCATE j, k: COLOR 15 + 16: PRINT g.flagship;
z1 = TIMER
DO
CALL mouse(mouse_event1, mouse_event2)
IF v.intro = 999 THEN KEY(15) OFF: EXIT SUB
LOOP UNTIL ABS(z1 - TIMER) > .75
v.intro = -1: a.max = 10
FOR i = 1 TO 90
CALL mouse(mouse_event1, mouse_event2)
IF v.intro = 999 THEN KEY(15) OFF: EXIT SUB
SOUND 900, .05
CALL alien_move
LOCATE j, k: COLOR 15: PRINT g.flagship;: COLOR 7
_DELAY .07
NEXT
z1 = TIMER
DO
CALL mouse(mouse_event1, mouse_event2)
IF v.intro = 999 THEN KEY(15) OFF: EXIT SUB
LOOP UNTIL ABS(z1 - TIMER) > 1
LOCATE j, k: PRINT " ";
CALL guardian_abduction
a.max = 0
z1 = TIMER
DO
CALL mouse(mouse_event1, mouse_event2)
IF v.intro = 999 THEN KEY(15) OFF: EXIT SUB
LOOP UNTIL ABS(z1 - TIMER) > .5
KEY(15) OFF
LOCATE v.bottom, _WIDTH - 20: PRINT SPACE$(20);
' Playing Instructions.
REDIM msg$(13)
msg$(1) = CHR$(249) + " " + "Look towards the top of your screen for Guardian ship status."
msg$(2) = CHR$(249) + " " + "Hold arrow keys up/dn/lt/rt or in combination to move diagonally."
msg$(3) = CHR$(249) + " " + "Missiles can be fired simultaneously in 8 different directions."
msg$(4) = CHR$(249) + " " + "Press Tab to fire 1-8 missiles in the direction of movement."
msg$(5) = CHR$(249) + " " + "Press Rt Ctrl to increase thrust, or Rt Alt to reduce thrust."
msg$(6) = ""
msg$(7) = CHR$(249) + " " + "Mouse alternative: "
msg$(8) = CHR$(249) + " " + "Hold right mouse button to move toward mouse pointer."
msg$(9) = CHR$(249) + " " + "Click left mouse button to fire 1-8 missiles in direction of mouse pointer."
msg$(10) = CHR$(249) + " " + "Mouse wheel up for more thrust, wheel down for less."
msg$(11) = CHR$(249) + " " + "Note: Tab and left mouse button cannot be used simultaneously."
msg$(12) = ""
msg$(13) = CHR$(249) + " " + "If you come in contact with an alien ship, your ship and crew get abducted."
j = 0
FOR i = 1 TO UBOUND(msg$)
IF LEN(msg$(i)) > j THEN j = LEN(msg$(i))
NEXT
i = ((v.right - v.left) - j) \ 2
t_mrgn = 6: b_mrgn = _HEIGHT - 4: l_mrgn = i + 1: r_mrgn = v.right - i
LOCATE t_mrgn - 2, l_mrgn - 2: PRINT STRING$(r_mrgn - l_mrgn + 4, CHR$(196));
LOCATE b_mrgn + 2, l_mrgn - 2: PRINT STRING$(r_mrgn - l_mrgn + 4, CHR$(196));
FOR i = 1 TO b_mrgn - t_mrgn + 3
LOCATE t_mrgn - 2 + i, l_mrgn - 2
PRINT CHR$(179);
LOCATE , r_mrgn + 2: PRINT CHR$(179);
NEXT
LOCATE t_mrgn - 2, l_mrgn - 2: PRINT CHR$(218);
LOCATE t_mrgn - 2, r_mrgn + 2: PRINT CHR$(191);
LOCATE b_mrgn + 2, l_mrgn - 2: PRINT CHR$(192);
LOCATE b_mrgn + 2, r_mrgn + 2: PRINT CHR$(217);
msg$ = "<Intro>"
LOCATE t_mrgn - 2, l_mrgn + (r_mrgn - l_mrgn) \ 2 - LEN(msg$) \ 2
PRINT msg$;
msg$ = "You are the Captain of the Guardian, an elite battle cruiser commissioned to protect our planet against alien invaders. You have 3 lives. Every time you are abducted by an alien ship, you lose a life. If you survive, and wipe out all 3 flights of alien attacks, your mission is completed. You saved Earth!"
j = r_mrgn - l_mrgn
LOCATE t_mrgn, l_mrgn
msg$ = RTRIM$(msg$) + " " ' Simple word parser routine.--------
DO
x$ = MID$(msg$, 1, j)
x$ = MID$(x$, 1, _INSTRREV(x$, " ") - 1)
msg$ = LTRIM$(MID$(msg$, LEN(x$) + 1))
LOCATE , l_mrgn: PRINT x$
LOOP UNTIL msg$ = "" '-----------------------------------------
PRINT
FOR i = 1 TO UBOUND(msg$)
LOCATE , l_mrgn
IF LEN(msg$(i)) THEN PRINT msg$(i) ELSE PRINT
NEXT
PRINT: IF CSRLIN < b_mrgn - 1 THEN PRINT
msg$ = "Good luck, Captain! Press any key to begin."
LOCATE , l_mrgn + (r_mrgn - l_mrgn) \ 2 - LEN(msg$) \ 2
PRINT msg$;
DO
_LIMIT 10
WHILE _MOUSEINPUT: WEND
IF _MOUSEBUTTON(1) THEN SOUND 1000, .1: EXIT DO
ky$ = INKEY$
IF ky$ = CHR$(27) THEN SYSTEM
IF LEN(ky$) THEN EXIT DO
LOOP
VIEW PRINT v.top TO v.bottom: CLS 2: VIEW PRINT
END SUB
SUB set_up
v.top = 3: v.bottom = _HEIGHT: v.left = 1: v.right = _WIDTH ' Boundaries.
LOCATE v.top - 1, 1: PRINT STRING$(_WIDTH, CHR$(196));
v.nol = 3
g.flagship = CHR$(15)
a.ship = "-<>-"
g.num = 3 ' 3 Guardian (lives) to start.
g.thrusters = 10 ' Shows 1/2 thrust at start up on comm.
g.icon = g.flagship
g.m_asc = 250: g.diry = -1: ' Initiate missile ASCII character. g.diry = -1 initiates fire upwards if unmoved.
IF _FILEEXISTS("Thunder1.ogg") AND _FILEEXISTS("Thunder1.ogg") AND _FILEEXISTS("Thunder1.ogg") AND _FILEEXISTS("Thunder1.ogg") THEN ' Sound effects provided by TheBOB, Bob Seguin, from The QBasic Forum.
v.snd1 = _SNDOPEN("Thunder1.ogg", "SYNC")
v.snd2 = _SNDOPEN("Thunder7.ogg", "SYNC")
END IF
v.play = -1 ' Skip into on replay.
END SUB
SUB game
STATIC mouse_event1, mouse_event2
REM Set mouse_event2 = 0 here to produce constant motion with directional changes.
'Press single or arrow key combo to move. Rt Ctrl = faster / Rt Alt = slower. Tab to fire missles.
g.thrusters = 10 ' Guardian movement delay. (1 to 20). Rt Ctrl = faster / Rt Alt = slower.
SELECT CASE v.level
CASE 1: a.max = 1 ' Sets number of space ships and initiates attack.
CASE 2: a.max = 1
CASE 3: a.max = 1
END SELECT
a.count = a.max
IF a.max < 6 THEN
a.cycle_delay = 1.005
ELSEIF a.max < 11 THEN a.cycle_delay = .003
ELSE a.cycle_delay = .001
END IF
_KEYCLEAR ' Clear any previous key presses in buffer.
CALL mouse(0, 0) ' Clear mouse.
CALL comm
DO
_LIMIT 60 ' Display at 60 frames per second.
CALL comm
IF g.m_status THEN CALL Guardian_missiles ' g.m_status determines Guardian or alien turn. 1 = Guardian, -1 = alien.
IF a.count = 0 THEN EXIT SUB ' Moving on to next level.
CALL alien_move
' To change thrusters only when guardian moves, remove the timer and move this routine to: IF v.kb_access = -1 THEN
IF ABS(z3 - TIMER) > .1 THEN ' z3 is a keypress delay timer for Guardian thrusters. Check every .1 seconds for a speed change.
IF _KEYDOWN(100307) AND g.thrusters < 20 THEN g.thrusters = g.thrusters + 1 ' Rt Ctrl key. Slows down Guardian ship down.
IF _KEYDOWN(100305) AND g.thrusters > 0 THEN g.thrusters = g.thrusters - 1 ' Rt Alt key. Speeds up Guardian ship.
z3 = TIMER
END IF
IF ABS(z2 - TIMER) > g.thrusters / 100 THEN ' z2 is delay for Guardian movement cycle. Note: Division needed because computer math can't add decimal numbers correctly.
IF v.kb_access = 0 THEN
IF _KEYDOWN(18432) OR _KEYDOWN(19200) OR _KEYDOWN(19712) OR _KEYDOWN(20480) OR mouse_event2 = -1 THEN ' Arrow keys.
v.kb_access = -1 ' Routes code to guardian move. When zero, Guardian move gets bypassed.
z1 = TIMER ' Delay timer for key lag effect in Guardian move routine.
END IF
END IF
END IF
IF v.kb_access = -1 THEN ' Guardian move routine.-----------------------------------------------------------------------------------------------------------------------------
IF ABS(z1 - TIMER) > .05 THEN ' z1 is a key lag time delay to allow guardian to press two keys together within a reasonable amount of time.
DO ' Faux loop added to throw out illegal key combos like up + down.
IF mouse_event2 = 0 THEN ' Bypass this keyboard routine if the right mouse button is in use.
IF mouse_event1 = 0 THEN g.m_x = 0: g.m_y = 0 ' Variables to control length and direction of Guardian movement. Must be reset to zero each cycle so diagonal moves are possible.
IF g.m_x = 0 AND g.m_y = 0 THEN
' Eliminate illegal combos.
IF _KEYDOWN(18432) AND _KEYDOWN(20480) THEN v.kb_access = 0: z2 = TIMER: EXIT DO ' Up + down
IF _KEYDOWN(19712) AND _KEYDOWN(19200) THEN v.kb_access = 0: z2 = TIMER: EXIT DO ' Left + right.
' IF female THEN STOP AND GET #1, directions. Keys that control movement.
IF _KEYDOWN(18432) THEN ' Up-arrow.
g.m_y = -1 ' To move 1-row up.
END IF
IF _KEYDOWN(19712) THEN ' Right-arrow.
g.m_x = 1 ' To move 1-column right.
END IF
IF _KEYDOWN(20480) THEN ' Down-arrow.
g.m_y = 1 ' To move 1-row down.
END IF
IF _KEYDOWN(19200) THEN ' Left-arrow.
g.m_x = -1 ' To move 1-column left.
END IF
IF g.m_x AND g.m_y THEN ' Double key hold. Routine to cancel keys when double hold is lifted. Compensates for both keys not being released at exactly the same time.
combo = -1 ' Double key hold in progress.
ELSE
IF combo THEN combo = 0: v.kb_access = 0: EXIT DO ' Double key hold was just removed, so skip Guardian move and exit.
END IF
END IF
END IF
' Move Guardian. *****************************************************************************************************
IF g.y + g.m_y > v.top AND g.y + g.m_y <= v.bottom AND g.x + 2 * g.m_x > v.left AND g.x + 2 * g.m_x < v.right THEN
LOCATE g.y, g.x
PRINT " ";
g.y = g.y + g.m_y: g.x = g.x + 2 * g.m_x
IF SCREEN(g.y, g.x) <> 32 AND SCREEN(g.y, g.x) <> g.m_asc THEN ' Guardian abducted by bad move. Ignore if you run into your own missile.
CALL guardian_abduction: EXIT SUB
ELSE
LOCATE g.y, g.x
PRINT g.flagship;
END IF
ELSE
BEEP ' Hit boundary.
END IF
v.kb_access = 0 ' Guardian move completed. Returns control to general keyboard next cycle.
z2 = TIMER ' Timer for moving. Lag regulated by "g.thrusters" variable.
EXIT DO ' ************************************************************************************************************
LOOP
END IF '
ELSE ' If you want additional key routines, put them here...------------------------------------------------------------------------------------------------------------------
CALL mouse(mouse_event1, mouse_event2)
ky$ = INKEY$
IF mouse_event1 = -1 THEN ky$ = CHR$(9)
IF LEN(ky$) = 1 THEN ' For demo, exclude keys that start with chr$(0). Note without this arrow keys would still register here.
SELECT CASE ky$
CASE CHR$(9) ' Tab key. Bug note: Space bar will not register with arrow up + arrow v.left.
IF ABS(z8 - TIMER) > .25 THEN
SELECT CASE g.m_launcher
CASE ""
IF mouse_event1 = -1 THEN g.m_launcher = "mouse" ELSE g.m_launcher = "keyboard" ' Initiate.
CASE "keyboard"
IF mouse_event1 = -1 THEN
IF g.m_fired = 0 THEN
g.m_launcher = "mouse" ' Switch.
ELSE
ky$ = ""
END IF
END IF
CASE "mouse"
IF mouse_event1 = 0 THEN ' Tab key was used.
IF g.m_fired = 0 THEN
g.m_launcher = "keyboard" ' Switch
ELSE
ky$ = ""
END IF
END IF
END SELECT
IF LEN(ky$) THEN
g.m_status = -1 ' -1 indicates missile just fired.
IF mouse_event1 = 0 THEN v.mouse_or_key_move = 0: ' Key pressed missile fire clears any previous mouse button missile fire.
END IF
mouse_event1 = 0 ' Completes left mouse missile firing cycle.
z8 = TIMER ' Missile firing delay reset.
END IF
CASE CHR$(27) ' Esc
_DELAY 1: SYSTEM
CASE ELSE
REM PRINT "You pressed key: "; ky$;
END SELECT
END IF
END IF '----------------------------------------------------------------------------------------------------------------------------------------------------------------------
LOOP
END SUB
SUB comm
STATIC middle% ' Local variable.
IF middle% = 0 THEN middle% = v.left + (v.right - v.left) \ 2
msg$ = " Thrusters = " + LTRIM$(STR$(5 * (20 - g.thrusters))) + "% Fired = " + LTRIM$(STR$(g.m_fired)) + " Alien ships = " + LTRIM$(STR$(a.count)) + " Level = " + LTRIM$(STR$(v.level)) + " Guardians: "
LOCATE 1, v.left + middle% - ((LEN(msg$) + 8) \ 2): PRINT msg$;
SELECT CASE g.num
CASE 3
PRINT g.icon; " "; g.icon; " "; g.icon;
CASE 2
PRINT g.icon; " "; g.icon; " ";: COLOR 8, 0: PRINT g.icon;: COLOR 7, 0
CASE 1
PRINT g.icon; " ";: COLOR 8, 0: PRINT g.icon; " "; g.icon;: COLOR 7, 0
CASE 0
COLOR 8, 0: PRINT g.icon; " "; g.icon; " "; g.icon; " ";: COLOR 7, 0
END SELECT
PRINT " "; ' Cut off any former printing caused by length changes in comm report like when numbers change from double to single digits.
END SUB
SUB Guardian_missiles
STATIC z4
DIM direction AS INTEGER ' 8 possible directions. local variable.
IF ABS(z4 - TIMER) > .03 THEN
z4 = TIMER
IF v.mouse_or_key_move = 0 THEN ' GAME OPTION: Remove this first IF/THEN to make it necessary to move Guardian in a direction to fire in that direction.
IF g.m_y <> 0 OR g.m_x <> 0 THEN g.diry = g.m_y: g.dirx = g.m_x ' Initiate by setting row and column missile direction to last column and row movement direction of Guardian location.
END IF
IF g.m_status = -1 THEN
IF g.diry = -1 AND g.dirx = 0 THEN
direction = 1
ELSEIF g.diry = -1 AND g.dirx = 1 THEN
direction = 2
ELSEIF g.diry = 0 AND g.dirx = 1 THEN
direction = 3
ELSEIF g.diry = 1 AND g.dirx = 1 THEN
direction = 4
ELSEIF g.diry = 1 AND g.dirx = 0 THEN
direction = 5
ELSEIF g.diry = 1 AND g.dirx = -1 THEN
direction = 6
ELSEIF g.diry = 0 AND g.dirx = -1 THEN
direction = 7
ELSEIF g.diry = -1 AND g.dirx = -1 THEN
direction = 8
END IF
IF m_n(direction) + 1 <= g.m_max THEN ' Don't fire if out of missiles.
IF g.y > v.top + 1 AND g.y < v.bottom AND g.x > v.left + 1 AND g.x < v.right - 1 THEN ' Don't fire if at a border.
m_n(direction) = m_n(direction) + 1
m_y(m_n(direction), direction) = g.y
m_x(m_n(direction), direction) = g.x
g.m_fired = g.m_fired + 1
SOUND 900, .1
END IF
END IF
g.m_status = 1 ' Code will now execute missile launch.
END IF
IF g.m_status = 1 THEN
FOR g.m_d = 1 TO 8 ' Check all directions.
IF m_n(g.m_d) > 0 THEN
j = m_n(g.m_d)
FOR g.m_n = 1 TO j
IF m_y(g.m_n, g.m_d) = g.y AND m_x(g.m_n, g.m_d) = g.x THEN
ELSE
LOCATE m_y(g.m_n, g.m_d), m_x(g.m_n, g.m_d): PRINT " ";
END IF
SELECT CASE g.m_d ' Missile direction.
CASE 1
IF m_y(g.m_n, g.m_d) - 1 > v.top THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) - 1
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR ' Missile off screen.
END IF
CASE 2
IF m_y(g.m_n, g.m_d) - 1 > v.top AND m_x(g.m_n, g.m_d) + 2 < v.right THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) - 1
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) + 2
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 3
IF m_x(g.m_n, g.m_d) + 2 < v.right THEN
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) + 2
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 4
IF m_y(g.m_n, g.m_d) + 1 < v.bottom AND m_x(g.m_n, g.m_d) + 2 < v.right THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) + 1
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) + 2
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 5
IF m_y(g.m_n, g.m_d) + 1 < v.bottom THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) + 1
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 6
IF m_y(g.m_n, g.m_d) + 1 < v.bottom AND m_x(g.m_n, g.m_d) - 2 > v.left THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) + 1
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) - 2
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 7
IF m_x(g.m_n, g.m_d) - 2 > v.left THEN
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) - 2
LOCATE m_y(g.m_n, g.m_d), m_x(g.m_n, g.m_d)
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 8
IF m_y(g.m_n, g.m_d) - 1 > v.top AND m_x(g.m_n, g.m_d) - 2 > v.left THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) - 1
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) - 2
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
END SELECT
NEXT
IF a.count = 0 THEN EXIT SUB
END IF
NEXT
IF g.m_fired <= 0 THEN g.m_fired = 0: g.m_status = 0 ' All missiles cleared.
END IF
END IF
END SUB
SUB missile_check (k)
LOCATE m_y(g.m_n, g.m_d), m_x(g.m_n, g.m_d) ' Place cursor at current missile position.
k = SCREEN(m_y(g.m_n, g.m_d), m_x(g.m_n, g.m_d)) ' Read the screen.
id_by_color = SCREEN(m_y(g.m_n, g.m_d), m_x(g.m_n, g.m_d), 1)
IF k <> 32 AND k <> g.m_asc AND k <> ASC(g.flagship) THEN ' If screen space is occupied by alien ship then explosion.
CALL remove_missile
CALL explosion
CALL remove_ship(id_by_color)
k = -1 ' A flag to exit the FOR/NEXT loop upon return.
ELSE
COLOR 14: PRINT CHR$(g.m_asc);: COLOR 7 ' Print missile on the screen. Missile advances here. Only place a missile is printed to the screen.
END IF
END SUB
SUB remove_missile
m_n(g.m_d) = m_n(g.m_d) - 1 ' Counter. Reduce the number of missiles fired, in a specific direction, by 1.
FOR k = g.m_n TO m_n(g.m_d) ' Re-stack arrays.
m_y(k, g.m_d) = m_y(k + 1, g.m_d)
m_x(k, g.m_d) = m_x(k + 1, g.m_d)
NEXT
m_y(k, g.m_d) = 0: m_x(k, g.m_d) = 0 'Zero out location variables of the missile removed. A zero removes unnecessary loop checking for other routines.
g.m_fired = g.m_fired - 1 ' Count of number of missiles fired is reduce by 1.
END SUB
SUB mask_missiles
FOR i = 1 TO g.m_max
FOR j = 1 TO 8
IF m_y(i, j) <> 0 THEN LOCATE m_y(i, j), m_x(i, j): PRINT " "; ' Mask missile.
NEXT j, i
m_status = 0: m_fired = 0: m_n = 0: m_d = 0: m_y = 0: m_x = 0
REDIM m_n(g.m_max), m_x(g.m_max, 8), m_y(g.m_max, 8)
END SUB
SUB explosion
soundfile% = 1 ' Local variable turns sound on.
b_y1 = CSRLIN: b_x1 = POS(0)
VIEW PRINT v.top TO v.bottom ' Needed to set print error parameters.
h = 0
ON ERROR GOTO offscreen
DO
IF h = 1 THEN burst$ = " " ELSE burst$ = CHR$(249)
IF v.intro THEN burst$ = "" ' No fireworks, just flash and sound.
h = h + 1
' Flash
IF eflag THEN
IF ABS(z7 - TIMER) > .1 THEN
eflag = 0
PALETTE 0, 0
z7 = TIMER
ELSE
j = -j * -1
IF j = 0 THEN
PALETTE 0, 63
_DELAY .05
ELSE
PALETTE 0, 0
_DELAY .05
END IF
END IF
END IF
IF eflag = 0 THEN
PALETTE 0, 36
IF soundfile% THEN
_SNDPLAY v.snd1
_DELAY .05
PALETTE 0, 0
_SNDPLAY v.snd2
ELSE
_DELAY .075
END IF
eflag = -1
z7 = TIMER
END IF
PALETTE 0, 0 ' End flash.
FOR i = 1 TO 5
SELECT CASE i
CASE 1
COLOR 15
LOCATE b_y1, b_x1: PRINT burst$;
_DELAY .1
CASE 2
IF burst$ = CHR$(249) THEN burst$ = CHR$(250)
COLOR 14, 0
LOCATE b_y1 - 1, b_x1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1 - 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1 + 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1 + 1, b_x1
IF er = 0 THEN PRINT burst$; ELSE er = 0
_DELAY .1
CASE 3
LOCATE b_y1 - 1, b_x1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 - 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 + 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1 + 1, b_x1
IF er = 0 THEN PRINT " "; ELSE er = 0
CASE 4
COLOR 4
LOCATE b_y1 - 1, b_x1 - 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1 - 1, b_x1 + 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1 - 2
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1 + 2
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1 + 1, b_x1 - 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1 + 1, b_x1 + 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
_DELAY .3
CASE 5
LOCATE b_y1 - 1, b_x1 - 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1 - 1, b_x1 + 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 - 2
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 - 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 + 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 + 2
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1 + 1, b_x1 - 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1 + 1, b_x1 + 1
IF er = 0 THEN PRINT " "; ELSE er = 0
END SELECT
NEXT
IF h = 1 THEN h = 0: EXIT DO
LOOP
VIEW PRINT
ON ERROR GOTO 0
COLOR 7
IF a.count = 1 THEN CALL mask_missiles ' Clear unexploded missiles off the screen when changing levels. Game Option: Remove variable to mask missiles after every explosion.
LOCATE b_y1, b_x1
END SUB
SUB remove_ship (id_by_color) ' Removes ship by color identification.
i = a.itr
ON ERROR GOTO offscreen
LOCATE a_mask_y(id_by_color), a_mask_x(id_by_color): PRINT SPACE$(LEN(a.ship));
LOCATE a_y(id_by_color), a_x(id_by_color): PRINT SPACE$(LEN(a.ship));
ON ERROR GOTO 0
a.itr = id_by_color: CALL a_erase
a_ran(id_by_color) = -1 ' Denotes alien ship was destroyed and removed from battle.
a.itr = i
a.count = a.count - 1 ' a.count = 0 will cause program to exit any unneeded subs/loops after the game level sub is completed.
LOCATE g.y, g.x: PRINT g.flagship; ' Re-display Guardian.
' Restore any alien ships in blast zone.
FOR i = 1 TO a.max
IF a_ran(i) > 0 THEN
IF a_y(i) > v.top AND a_x(i) > v.left AND a_x(i) + LEN(a.ship) < v.right THEN LOCATE a_y(i), a_x(i): COLOR i: PRINT a.ship;
END IF
NEXT
COLOR 7
CALL comm
END SUB
SUB alien_move
STATIC z5
y_restore = CSRLIN: x_restore = POS(0) ' Restore column and row upon exit.
IF ABS(z5 - TIMER) > a.cycle_delay OR v.intro THEN ' z5 is a time delay for alien space ship maneuvers. It can be altered in the "game" subroutine.
IF v.intro = 0 THEN h_alien_nom = INT(RND * a.max) + 1 ELSE h_alien_nom = 15
FOR h = 1 TO h_alien_nom ' Local counting variable for alien number of moves in this cycle.
a.itr = a.itr + 1: IF a.itr > a.max THEN a.itr = 1 ' Needed to offset the EXIT DO hover event, which on exit does not affect the a.itr variable.
IF a_ran(a.itr) <> -1 THEN ' This is how a destroyed ship is bypassed. -1 is a destroyed alien ship. Code moves to end of DO:LOOP.
IF a_inertia(a.itr) = 0 THEN ' Determine how many moves in one direction.
a_inertia(a.itr) = INT(RND * (v.bottom - v.top) / 2) + 1 ' How many moves to go in any one direction.
a_ran(a.itr) = INT(RND * 8) + 1 ' Choose 1 of 8 possible directions.
IF a_ran(a.itr) = a_olda_ran(a.itr) OR a_mask_y(a.itr) = 0 AND a_mask_x(a.itr) = 0 AND ran = 1 OR a_mask_y(a.itr) = 0 AND a_mask_x(a.itr) = 0 AND ran = 5 THEN
EXIT FOR ' Just hover if direction was not changed on existing alien space ship or if a new alien space ship is entering from the sides and up or down was generated.
END IF
SELECT CASE a_ran(a.itr) ' Get changes in column and row coordinates.
CASE 1: a_y_loc(a.itr) = -1: a_x_loc(a.itr) = 0 ' Up.
CASE 2: a_y_loc(a.itr) = -1: a_x_loc(a.itr) = 2 ' Up and right.
CASE 3: a_y_loc(a.itr) = 0: a_x_loc(a.itr) = 2 ' Right.
CASE 4: a_y_loc(a.itr) = 1: a_x_loc(a.itr) = 2 ' Down and right.
CASE 5: a_y_loc(a.itr) = 1: a_x_loc(a.itr) = 0 ' Down.
CASE 6: a_y_loc(a.itr) = 1: a_x_loc(a.itr) = -2 ' Down and left.
CASE 7: a_y_loc(a.itr) = 0: a_x_loc(a.itr) = -2 ' Left.
CASE 8: a_y_loc(a.itr) = -1: a_x_loc(a.itr) = -2 ' Up and left.
END SELECT
IF a_y(a.itr) = 0 AND a_x(a.itr) = 0 AND a_ran(a.itr) <> -1 THEN ' New alien space ship enters the screen.
i = RND * (v.bottom - v.top) \ 4
a_y(a.itr) = (v.bottom - v.top) \ 4 + i + v.top
IF a_ran(a.itr) < 5 THEN ' Determine side of entry from initial direction.
IF SCREEN(a_y(a.itr), v.left + LEN(a.ship)) = 32 THEN
a_x(a.itr) = v.left + 1 ' Enter from the left side and go right.
ELSE
CALL a_erase
EXIT FOR
END IF
ELSE
IF SCREEN(a_y(a.itr), v.right - LEN(a.ship) + 1) = 32 THEN
a_x(a.itr) = v.right - LEN(a.ship) ' Enter from the right side and go left.
ELSE
CALL a_erase
EXIT FOR
END IF
END IF
END IF
a_olda_ran(a.itr) = a_ran(a.itr) ' Remember last direction. Another line uses this to disallow any RND that chooses the same direction twice.
ELSE
a_inertia(a.itr) = a_inertia(a.itr) - 1 ' Count down the number of moves in any one direction. When zero, switch direction.
END IF
FOR i = 1 TO a.max
IF i <> a.itr AND a_y(i) <> 0 THEN
IF a_y(a.itr) + a_y_loc(a.itr) = a_y(i) THEN
IF a_x(a.itr) + a_x_loc(a.itr) + LEN(a.ship) > a_x(i) AND a_x(a.itr) + a_x_loc(a.itr) < a_x(i) + LEN(a.ship) THEN
collide = 1
EXIT FOR
END IF
END IF
END IF
NEXT
IF collide = 1 THEN
j = a_y(a.itr): k = a_x(a.itr)
a_y_loc(a.itr) = 0: a_x_loc(a.itr) = 0: a_inertia(a.itr) = 0
collide = 0 ' Collision detection off. Collision was detected and avoided.
ELSE
j = a_y(a.itr) + a_y_loc(a.itr): k = a_x(a.itr) + a_x_loc(a.itr)
END IF
IF j <= v.top OR k <= v.left OR k + LEN(a.ship) > v.right THEN ' Alien ship out of range, off screen.
a_inertia(a.itr) = 0 ' These two lines keep the out of range ship(s) reasonably nearby.
IF j > v.top - 4 AND k < v.right + 3 AND k > v.left - 4 THEN a_y(a.itr) = j: a_x(a.itr) = k
IF a_mask_y(a.itr) <> 0 AND a_mask_x(a.itr) <> 0 THEN
LOCATE a_mask_y(a.itr), a_mask_x(a.itr)
PRINT SPACE$(LEN(a.ship)); ' Mask old position here because the show part of the mask-and-show routine cannot be used when out of range.
END IF
IF a_offscrn(a.itr) > 25 THEN a_y(a.itr) = 0: a_x(a.itr) = 0: a_inertia(a.itr) = 0: a_offscrn(a.itr) = 0
a_mask_y(a.itr) = 0: a_mask_x(a.itr) = 0: a_offscrn(a.itr) = a_offscrn(a.itr) + 1
ELSE
' Check for v.bottom collision and reverse course if detected.
COLOR a.itr
IF j >= v.bottom THEN
a_y_loc(a.itr) = -a_y_loc(a.itr): a_x_loc(a.itr) = -a_x_loc(a.itr)
ELSE
a_y(a.itr) = j: a_x(a.itr) = k ' Next move coordinates.
ii = 0
kk = ASC(g.flagship)
FOR i = 0 TO LEN(a.ship) - 1 ' Check area through width of ship. Remember all or parts of ship are still present on screen.
SELECT CASE SCREEN(j, k + i)
CASE kk
ii = 1 ' Indicates contact with flagship and evokes call abduction routine a few lines down.
EXIT FOR
CASE g.m_asc
ii = 2 ' Indicates ship into missile collision.
EXIT FOR 'Okay to exit as a missile and Guardian craft cannot be present in the same location.
END SELECT
NEXT
IF ii <> 2 THEN ' This will make a move unless a ship into missile event would occur.
'--------------------------------------------Move alien ship-------------------------------------------------
IF a_mask_y(a.itr) <> 0 AND a_mask_x(a.itr) <> 0 THEN LOCATE a_mask_y(a.itr), a_mask_x(a.itr): PRINT SPACE$(LEN(a.ship));
LOCATE j, k: PRINT a.ship;
a_mask_y(a.itr) = j: a_mask_x(a.itr) = k ' Remember these coordinates to erase alien space ship on next loop.
'------------------------------------------------------------------------------------------------------------
END IF
IF ii = 1 THEN CALL guardian_abduction: EXIT FOR ' Exit loop.
j = j - g.y: k = k - g.x + LEN(a.ship) / 2
IF ABS(j) < 3 AND ABS(k) < 8 THEN CALL a_hunt(j, k)
END IF
COLOR 7
END IF
END IF ' a_ran(a.itr) > -1 exit point.
IF a.itr = a.max THEN a.itr = 0: EXIT FOR ' Finished loop. Keep this outside the IF/THEN statement.
NEXT h
z5 = TIMER
LOCATE y_restore, x_restore ' Restore entry column and row positions.
END IF ' End time event.
END SUB
SUB guardian_abduction
IF v.intro = 0 THEN
CALL mask_missiles ' Clear unexploded missiles off the screen after alien abduction.
msg$ = "[GUARDIAN ABDUCTED]"
SOUND 500, .4: SOUND 1000, .3: SOUND 1500, .2
PCOPY 0, 1
SCREEN 0, 0, 1, 1
LOCATE (v.bottom - v.top) \ 2 + v.top, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14 + 16: PRINT msg$;
_DELAY 2
SCREEN 0, 0, 0, 0
END IF
DO
j = 0
FOR i = 1 TO a.max
IF a_y(i) >= v.top AND a_x(i) >= v.left AND a_x(i) <= v.right - LEN(a.ship) THEN
SOUND 500, .04
LOCATE a_y(i), a_x(i): PRINT SPACE$(LEN(a.ship));
IF a_y(i) <> v.top THEN a_y(i) = a_y(i) - 1: LOCATE a_y(i), a_x(i): COLOR i: PRINT a.ship;: _DELAY .02: j = 1
END IF
NEXT
LOOP WHILE j
COLOR 7
IF v.intro THEN EXIT SUB
g.num = g.num - 1
CALL comm
_DELAY .75
v.redo_level = -1
a.count = 0 ' Zero to exit subs back to main game loop.
END SUB
SUB game_level ' Evaluates both alien defeated on a level and Guardian abduction.
_DELAY 1: VIEW PRINT v.top TO v.bottom: CLS 2: VIEW PRINT ' Slight delay then clear playng screen.
msg$ = "[LEVEL " + LTRIM$(STR$(v.level)) + "]"
LOCATE (v.bottom - v.top) \ 2 + v.top, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14 + 16: PRINT msg$;
j = 0: k = 0
DO
IF ABS(z0 - TIMER) > .15 THEN
IF j = 0 THEN j = 1: SOUND 750, .3: k = k + 1 ELSE j = 0: _DELAY .1
z0 = TIMER
END IF
LOOP UNTIL k = 6
COLOR 7
LOCATE , v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
PRINT msg$;
VIEW PRINT v.top TO v.bottom: CLS 2: VIEW PRINT
_DELAY .75
g.y = (v.bottom - v.top) \ 2 + v.top: g.x = (v.right - v.left + 1) \ 2 + v.left ' Reset column and row for Guardian craft.
LOCATE g.y, g.x
COLOR 15 + 16: PRINT g.flagship;
_DELAY 1.5
COLOR 7: LOCATE g.y, g.x: PRINT g.flagship;
v.level_up = -1
END SUB
SUB level_up
v.level = v.level + 1
END SUB
SUB a_erase
a_y(a.itr) = 0: a_x(a.itr) = 0: a_mask_y(a.itr) = 0: a_mask_x(a.itr) = 0: a_inertia(a.itr) = 0: a_ran(a.itr) = 0: a_y_loc(a.itr) = 0: a_x_loc(a.itr) = 0: a_olda_ran(a.itr) = 0
END SUB
SUB mouse (mouse_event1, mouse_event2)
STATIC z9, z10, lb, lb_status ' lb_status keeps track of press/release.
WHILE _MOUSEINPUT
IF ABS(z10 - TIMER) > .1 THEN
z10 = TIMER
IF _MOUSEWHEEL > 0 THEN ' Down
IF g.thrusters < 20 THEN g.thrusters = g.thrusters + 1
ELSEIF _MOUSEWHEEL < 0 THEN ' Up
IF g.thrusters > 0 THEN g.thrusters = g.thrusters - 1
END IF
END IF
WEND
mx = _MOUSEX
my = _MOUSEY
lb = _MOUSEBUTTON(1)
rb = _MOUSEBUTTON(2)
IF lb THEN
IF lb_status = 0 THEN
IF ABS(z9 - TIMER) > .33 THEN
z9 = TIMER
mouse_event1 = -1: lb_status = -1: ' Left button down
END IF
END IF
ELSE
IF lb_status THEN lb_status = 0 ' Left button was released.
END IF
IF v.mouse_get_screen THEN
IF lb_status = -1 THEN
x$ = CHR$(SCREEN(my, mx))
SELECT CASE v.mouse_get_screen
CASE 1 ' Skip intro.
IF x$ = "S" THEN v.intro = 999: SOUND 1000, .3: EXIT SUB
CASE 2 ' Replay
IF x$ = "Y" THEN v.play = 999: SOUND 1000, .1: EXIT SUB
IF x$ = "N" THEN v.play = -999: SOUND 1000, .1: EXIT SUB
END SELECT
END IF
END IF
cx = g.x: cy = g.y ' Angular calculations provided by bplus from the QB64 Phoenix Forum.
stepX = ABS(cx - mx): stepY = ABS(cy - my)
dAng = INT(_R2D(_ATAN2(my - cy, mx - cx)) + .5)
IF dAng < 0 THEN dAng = dAng + 360
IF dAng <= 90 THEN
startA = 0: endA = dAng: ra = dAng
ELSEIF dAng <= 180 THEN
startA = dAng: endA = 180: ra = 90 - (dAng - 90)
ELSEIF dAng <= 270 THEN
startA = 180: endA = dAng: ra = dAng - 180
ELSEIF dAng <= 360 THEN
startA = dAng: endA = 360: ra = 90 - (dAng - 270)
END IF
m_y = 0: m_x = 0
IF ra <= 90 AND ra >= 50 THEN
IF my > g.y THEN
x$ = "down": m_y = 1: m_x = 0 ' Down.
ELSE
x$ = "up": m_y = -1: m_x = 0 ' Up.
END IF
ELSEIF ra < 50 AND ra >= 15 THEN
IF mx > g.x AND my > g.y THEN
x$ = "down right": m_y = 1: m_x = 2 ' Down and right.
ELSEIF mx < g.x AND my > g.y THEN
x$ = "down left": m_y = 1: m_x = -2 ' Down an left.
ELSEIF mx > g.x AND my < g.y THEN
x$ = "up right": m_y = -1: m_x = 2 ' Up and right.
ELSEIF mx < g.x AND my < g.y THEN
x$ = "up left": m_y = -1: m_x = -2 ' Up and left.
END IF
ELSEIF ra < 15 AND ra >= 0 THEN
IF mx > g.x THEN
x$ = "right": m_y = 0: m_x = 2 ' Right
ELSE
x$ = "left": m_y = 0: m_x = -2 ' Left
END IF
END IF
IF rb AND mouse_event2 = 0 THEN
mouse_event2 = -1
g.m_y = m_y: g.m_x = m_x / 2
v.mouse_or_key_move = 1 ' Right mouse button to move.
ELSE
IF mouse_event2 THEN mouse_event2 = 0
END IF
IF mouse_event1 THEN
g.diry = m_y: g.dirx = m_x / 2
v.mouse_or_key_move = -1
END IF
END SUB
SUB game_over
v.mouse_get_screen = 2 ' Allows mouse to select replay options.
_DELAY .5
CALL comm
IF g.num THEN SOUND 1000, .75: SOUND 500, .75: SOUND 1000, 1.5 ELSE SOUND 1000, .75: SOUND 700, .75: SOUND 500, 1.5
_DELAY .5
VIEW PRINT v.top TO v.bottom: CLS 2: VIEW PRINT
IF g.num THEN msg$ = "[GUARDIAN WINS]" ELSE msg$ = "[Game Over]"
LOCATE (v.bottom - v.top) \ 2 + v.top - 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14 + 16
PRINT msg$;
_DELAY 2
LOCATE (v.bottom - v.top) \ 2 + v.top - 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14: PRINT msg$;
msg$ = "Replay? Y/N"
_DELAY 1
LOCATE (v.bottom - v.top) \ 2 + v.top + 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 8
PRINT msg$;
COLOR 7
DO
_LIMIT 30
CALL mouse(mouse_event1, mouse_event2)
ky$ = INKEY$
IF LEN(ky$) OR ABS(v.play) = 999 THEN
IF v.play = 999 OR UCASE$(ky$) = "Y" OR ky$ = CHR$(13) THEN v.play = 1: VIEW PRINT v.top TO v.bottom: CLS 2: VIEW PRINT: EXIT DO
IF v.play = -999 OR UCASE$(ky$) = "N" OR ky$ = CHR$(27) THEN
msg$ = " [Bye Bye] "
LOCATE (v.bottom - v.top) \ 2 + v.top - 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14 + 16: PRINT msg$;
_DELAY 1
LOCATE (v.bottom - v.top) \ 2 + v.top - 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14: PRINT msg$;
_DELAY .5
SYSTEM
END IF
END IF
LOOP
END SUB
SUB a_hunt (j, k)
LOCATE 3, 1
a_inertia(a.itr) = 4
h = j / ABS(j): i = k / ABS(k)
SELECT CASE h
CASE IS < 0 ' Ship above Guardian.
SELECT CASE i
CASE IS < 0 ' Ship to left of Guardian.
a_y_loc(a.itr) = 1: a_x_loc(a.itr) = 1
CASE 0 ' Ship same column as Guardian.
a_y_loc(a.itr) = 1: a_x_loc(a.itr) = 0
CASE IS > 0 ' Ship to right of Guardian.
a_y_loc(a.itr) = 1: a_x_loc(a.itr) = -1
END SELECT
CASE 0 ' Ship same row as Guardian.
SELECT CASE i
CASE IS < 0 ' Ship to left of Guardian.
a_y_loc(a.itr) = 0: a_x_loc(a.itr) = 1
CASE IS > 0 ' Ship to right of Guardian.
a_y_loc(a.itr) = 0: a_x_loc(a.itr) = -1
END SELECT
CASE IS > 0 ' Ship below Guardian.
SELECT CASE i
CASE IS < 0 ' Ship to left of Guardian.
a_y_loc(a.itr) = -1: a_x_loc(a.itr) = 1
CASE 0 ' Ship same column as Guardian.
a_y_loc(a.itr) = -1: a_x_loc(a.itr) = 0
CASE IS > 0 ' Ship to right of Guardian.
a_y_loc(a.itr) = -1: a_x_loc(a.itr) = -1
END SELECT
END SELECT
END SUB
Pete
Posts: 2,160
Threads: 222
Joined: Apr 2022
Reputation:
103
10-16-2022, 05:21 PM
(This post was last modified: 10-16-2022, 07:31 PM by Pete.)
Added 3 "Difficulty Levels" to the last version.
GUARDIAN V 1.2
Code: (Select All) DEFINT H-K
$RESIZE:ON
_RESIZE OFF
RANDOMIZE TIMER
' Note: timer is not adjusted for stroke of midnight event, so don't stay up late playing this.
REM Main
f1 = 22 ' Sets font size to 22 and calculates the max screen height and width for your desktop.
h = (_DESKTOPHEIGHT - 60) \ f1
w = _DESKTOPWIDTH \ (f1 / 1.66)
WIDTH w, h
_SCREENMOVE 0, 0
fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.
font& = _LOADFONT(fontpath$, f1, "monospace")
_FONT font&
_DELAY .25
_RESIZE ON , _SMOOTH ' Allows resizing. Note: this is for slight adjustments. As of this version there is no compensatory function to change the font size during screen size changes.
TYPE gen_var
intro AS INTEGER ' Runs a protion of the alien subroutine as part of the intro.
nol AS INTEGER ' Number of game levels.
redo_level AS INTEGER ' Alien abdution results in redo level.
level AS INTEGER ' Current game level.
level_up AS INTEGER ' Routes code to next game level.
top AS INTEGER ' Top boundary. (Changeable).
bottom AS INTEGER ' Bottom boundary. (Changeable).
left AS INTEGER ' Left boundary. (Changeable).
right AS INTEGER ' Right boundary. (Changeable).
kb_access AS INTEGER ' Routes code to either Guardian/Alien or general keyboard routine. -1 Guardian/Alien, 0 keyboard.
mouse_or_key_move AS INTEGER
mouse_get_screen AS INTEGER
play AS INTEGER
snd1 AS LONG ' Explosion sound effect.
snd2 AS LONG ' Explosion sound effect.
END TYPE
DIM SHARED v AS gen_var
TYPE guardian
difficulty AS INTEGER
num AS INTEGER ' Number of Guardians aka lives.
diry AS INTEGER ' Guardian row move. +1, 0, -1.
dirx AS INTEGER ' Guardian column move. +2, 0, -2. Equals vertical pixel movement. 16x8.
y AS INTEGER ' Guardian coordinates row.
x AS INTEGER ' Guardian coordinates column.
thrusters AS INTEGER ' Guardian speed. (User Determined).
m_max AS INTEGER ' Restricts # of missiles fired in one direction.
m_status AS INTEGER ' Missile status. -1 when fired, 1 while moving.
m_fired AS INTEGER ' The number of missile deployed and still active.
m_n AS INTEGER ' FOR/NEXT counter variable shared by other routines to index through the number of missiles fired in a specific direction.
m_d AS INTEGER ' Missile direction. (1-8).
m_y AS INTEGER ' Missile row advancement increment: +1, 0, -1 Note: Missile row and column coordinates are defined in arrays.
m_x AS INTEGER ' Missile column advancement increment: +2, 0, -2. Equals vertical pixel movement. 16x8.
m_asc AS INTEGER ' ASCII character representing a fired missile.
m_launcher AS STRING
icon AS STRING ' Guardian comm icon. For this edition, it is the same as the flagship: "*"
flagship AS STRING ' Guardian ascii character.
END TYPE
DIM SHARED g AS guardian
TYPE alien
max AS INTEGER ' Maximum # of alien ships on screen.
count AS INTEGER ' Number of alien ships. (Counter).
itr AS INTEGER ' Iteration array number to cycle through the active alien ships. (Counter).
cycle_delay AS SINGLE ' Timer cycle controls how fast alien ships move.
ai AS INTEGER ' Degree of artificial intelligence. (0-2)
ship AS STRING ' Alien ship ASCII design.
END TYPE
DIM SHARED a AS alien
DO
GOSUB set_arrays
SELECT CASE v.play
CASE 0
CALL set_up
CALL comm
CALL intro
GOSUB set_arrays: GOSUB zero_variables ' Reset arrays and zero variables after intro.
CALL level_up
CASE 1
CALL set_up
CALL comm
END SELECT
CALL game_level ' Display level.
g.y = (v.bottom - v.top) \ 2 + v.top: g.x = (v.right - v.left + 1) \ 2 + v.left ' Set initial column and row for Guardian craft.
CALL game
IF g.num = 0 OR v.level = v.nol AND v.redo_level = 0 THEN
CALL game_over ' Determines win or lose.
v.level = 1 ' Reinitiate if player chooses to replay.
ELSE
IF v.redo_level = 0 THEN CALL level_up
END IF
GOSUB zero_variables
LOOP
set_arrays:
ii = 15 ' Default max setting for number of alien ships used here to initially dim arrays.
g.m_max = 8 ' * missiles max per direction.
REDIM SHARED a_y(ii), a_x(ii), a_mask_y(ii), a_mask_x(ii), a_inertia(ii) ' Alien movement.
REDIM SHARED a_ran(ii), a_olda_ran(ii), a_y_loc(ii), a_x_loc(ii), a_offscrn(ii) ' Alien movement.
REDIM SHARED m_n(8), m_x(g.m_max, 8), m_y(g.m_max, 8) ' Guardian missiles. 8 represents 8 possible diretions of movement and missile fire.
' Array descriptions and actions.
' a_y() , a_x() Alien ship positions rows and columns.
' a_mask_y(), a_mask_x() Alien ship last position. Masked on next move.
' a_inertia(ii) Number of moves in one direction selected by random for an alien ship.
' a_ran(ii), a_olda_ran(ii) Determines the direction in which the inertia will travel and the prior direction is kept to disallow the same direction twice.
' a_y_loc(ii), a_x_loc(ii) The row and column coordinates of the aliens ships.
' m_n(8), m_x(g.m_max, 8), m_y(g.m_max, 8) Missile number and Missile index 1 to g.m_max for position. 8 is the fixed number of 8 different directions.
RETURN
zero_variables:
' Zero variables.
g.diry = 0: g.dirx = 0: g.m_status = 0: g.m_fired = 0: g.m_d = 0: g.m_y = 0: g.m_x = 0: v.redo_level = 0: a.max = 0: v.intro = 0
a.count = 0: a.itr = 0: a.cycle_delay = 0: v.level_up = 0: v.mouse_or_key_move = 0: g.m_launcher = ""
RETURN
skipintro: ' ONKEY 15.
v.intro = 999
KEY(15) OFF
RETURN
' Error handler.
offscreen: ' Prevents error if blast particles row and column are off-screen. Effect is a partial blast on side of screen.
IF ERR = 5 THEN er = -1: RESUME NEXT
PRINT "Opps, unexpected error"; ERR
END
SUB intro
WHILE -1 ' Faux loop.
v.mouse_get_screen = 1 ' Allows skip intro by mouse selection.
LOCATE _HEIGHT, _WIDTH - 15
PRINT "[S]kip Intro"; ' Option to skip the intro using the "S" key with ONKEY statement.
KEY 15, CHR$(0) + CHR$(31) 'scancode for S
ON KEY(15) GOSUB skipintro
KEY(15) ON 'turn ON [S]kip intro event trapping.
j = (v.bottom - v.top) \ 2 + v.top
k = (v.right - v.left) \ 2 + v.left
z1 = TIMER
DO
CALL mouse(0, 0)
IF v.intro = 999 THEN CALL skip_intro: EXIT WHILE
LOOP UNTIL ABS(z1 - TIMER) > .33
SOUND 1000, .3
msg$ = " GUARDIAN "
LOCATE j, k - LEN(msg$) \ 2: COLOR 14: PRINT msg$;: COLOR 7
LOCATE , k
z1 = TIMER
DO
CALL mouse(0, 0)
IF v.intro = 999 THEN CALL skip_intro: EXIT WHILE
LOOP UNTIL ABS(z1 - TIMER) > .66
msg$ = SPACE$(LEN(msg$))
LOCATE j, k - LEN(msg$) \ 2: COLOR 7: PRINT msg$;
LOCATE j, k
IF v.intro = 999 THEN CALL skip_intro: EXIT WHILE ELSE CALL explosion
LOCATE j, k: COLOR 15 + 16: PRINT g.flagship;
z1 = TIMER
DO
CALL mouse(0, 0)
IF v.intro = 999 THEN CALL skip_intro: EXIT WHILE
LOOP UNTIL ABS(z1 - TIMER) > .75
v.intro = -1: a.max = 10
FOR i = 1 TO 90
CALL mouse(0, 0)
IF v.intro = 999 THEN CALL skip_intro: EXIT WHILE
SOUND 900, .05
CALL alien_move
LOCATE j, k: COLOR 15: PRINT g.flagship;: COLOR 7
_DELAY .07
NEXT
z1 = TIMER
DO
CALL mouse(0, 0)
IF v.intro = 999 THEN CALL skip_intro: EXIT WHILE
LOOP UNTIL ABS(z1 - TIMER) > 1
LOCATE j, k: PRINT " ";
CALL guardian_abduction
a.max = 0
z1 = TIMER
DO
CALL mouse(0, 0)
IF v.intro = 999 THEN CALL skip_intro: EXIT WHILE
LOOP UNTIL ABS(z1 - TIMER) > .5
EXIT WHILE
WEND
LOCATE v.bottom, _WIDTH - 20: PRINT SPACE$(20);
' Playing Instructions.
REDIM msg$(13)
msg$(1) = CHR$(249) + " " + "Look towards the top of your screen for Guardian ship status."
msg$(2) = CHR$(249) + " " + "Hold arrow keys up/dn/lt/rt or in combination to move diagonally."
msg$(3) = CHR$(249) + " " + "Missiles can be fired simultaneously in 8 different directions."
msg$(4) = CHR$(249) + " " + "Press Tab to fire 1-8 missiles in the direction of movement."
msg$(5) = CHR$(249) + " " + "Press Rt Ctrl to increase thrust, or Rt Alt to reduce thrust."
msg$(6) = ""
msg$(7) = CHR$(249) + " " + "Mouse alternative: "
msg$(8) = CHR$(249) + " " + "Hold right mouse button to move toward mouse pointer."
msg$(9) = CHR$(249) + " " + "Click left mouse button to fire 1-8 missiles in direction of mouse pointer."
msg$(10) = CHR$(249) + " " + "Mouse wheel up for more thrust, wheel down for less."
msg$(11) = CHR$(249) + " " + "Note: Tab and left mouse button cannot be used simultaneously."
msg$(12) = ""
msg$(13) = CHR$(249) + " " + "If you come in contact with an alien ship, your ship and crew get abducted."
j = 0
FOR i = 1 TO UBOUND(msg$)
IF LEN(msg$(i)) > j THEN j = LEN(msg$(i))
NEXT
i = ((v.right - v.left) - j) \ 2
t_mrgn = 6: b_mrgn = _HEIGHT - 4: l_mrgn = i + 1: r_mrgn = v.right - i
LOCATE t_mrgn - 2, l_mrgn - 2: PRINT STRING$(r_mrgn - l_mrgn + 4, CHR$(196));
LOCATE b_mrgn + 2, l_mrgn - 2: PRINT STRING$(r_mrgn - l_mrgn + 4, CHR$(196));
FOR i = 1 TO b_mrgn - t_mrgn + 3
LOCATE t_mrgn - 2 + i, l_mrgn - 2
PRINT CHR$(179);
LOCATE , r_mrgn + 2: PRINT CHR$(179);
NEXT
LOCATE t_mrgn - 2, l_mrgn - 2: PRINT CHR$(218);
LOCATE t_mrgn - 2, r_mrgn + 2: PRINT CHR$(191);
LOCATE b_mrgn + 2, l_mrgn - 2: PRINT CHR$(192);
LOCATE b_mrgn + 2, r_mrgn + 2: PRINT CHR$(217);
msg$ = "<Intro>"
LOCATE t_mrgn - 2, l_mrgn + (r_mrgn - l_mrgn) \ 2 - LEN(msg$) \ 2
PRINT msg$;
msg$ = "You are the Captain of the Guardian, an elite battle cruiser commissioned to protect our planet against alien invaders. You have 3 lives. Every time you are abducted by an alien ship, you lose a life. If you survive, and wipe out all 3 flights of alien attacks, your mission is completed. You saved Earth!"
j = r_mrgn - l_mrgn
LOCATE t_mrgn, l_mrgn
msg$ = RTRIM$(msg$) + " " ' Simple word parser routine.--------
DO
x$ = MID$(msg$, 1, j)
x$ = MID$(x$, 1, _INSTRREV(x$, " ") - 1)
msg$ = LTRIM$(MID$(msg$, LEN(x$) + 1))
LOCATE , l_mrgn: PRINT x$
LOOP UNTIL msg$ = "" '-----------------------------------------
PRINT
FOR i = 1 TO UBOUND(msg$)
LOCATE , l_mrgn
IF LEN(msg$(i)) THEN PRINT msg$(i) ELSE PRINT
NEXT
PRINT: IF CSRLIN < b_mrgn - 1 THEN PRINT
msg$ = "Select Player Level: [1] Beginner [2] Intermediate [3] Advanced"
LOCATE , l_mrgn + (r_mrgn - l_mrgn) \ 2 - LEN(msg$) \ 2
PRINT msg$;
DO
_LIMIT 10
CALL mouse(0, 0)
ky$ = INKEY$
IF LEN(ky$) OR g.difficulty THEN
IF ky$ = CHR$(27) THEN SYSTEM
SELECT CASE ky$
CASE "1": g.difficulty = 1
CASE "2": g.difficulty = 2
CASE "3": g.difficulty = 3
END SELECT
IF g.difficulty THEN EXIT DO
END IF
LOOP
VIEW PRINT v.top TO v.bottom: CLS 2: VIEW PRINT
END SUB
SUB skip_intro
KEY(15) OFF
v.intro = 0
BEEP: _DELAY .3: BEEP
VIEW PRINT v.top TO v.bottom
COLOR 7
CLS 2
VIEW PRINT
_DELAY .5
END SUB
SUB set_up
v.top = 3: v.bottom = _HEIGHT: v.left = 1: v.right = _WIDTH ' Boundaries.
LOCATE v.top - 1, 1: PRINT STRING$(_WIDTH, CHR$(196));
v.nol = 3
g.flagship = CHR$(15)
a.ship = "-<>-"
g.num = 3 ' 3 Guardian (lives) to start.
g.thrusters = 10 ' Shows 1/2 thrust at start up on comm.
g.icon = g.flagship
g.m_asc = 250: g.diry = -1: ' Initiate missile ASCII character. g.diry = -1 initiates fire upwards if unmoved.
IF _FILEEXISTS("Thunder1.ogg") AND _FILEEXISTS("Thunder1.ogg") AND _FILEEXISTS("Thunder1.ogg") AND _FILEEXISTS("Thunder1.ogg") THEN ' Sound effects provided by TheBOB, Bob Seguin, from The QBasic Forum.
v.snd1 = _SNDOPEN("Thunder1.ogg", "SYNC")
v.snd2 = _SNDOPEN("Thunder7.ogg", "SYNC")
END IF
v.play = -1 ' Skip into on replay.
END SUB
SUB game
STATIC mouse_event1, mouse_event2
REM Set mouse_event2 = 0 here to produce constant motion with directional changes.
'Press single or arrow key combo to move. Rt Ctrl = faster / Rt Alt = slower. Tab to fire missles.
g.thrusters = 10 ' Guardian movement delay. (1 to 20). Rt Ctrl = faster / Rt Alt = slower.
SELECT CASE v.level
CASE 1: a.max = 5 ' Sets number of space ships and initiates attack.
CASE 2: a.max = 10
CASE 3: a.max = 15
END SELECT
a.count = a.max
IF a.max < 6 THEN
SELECT CASE g.difficulty
CASE 1: a.cycle_delay = .15: a.ai = 0
CASE 2: a.cycle_delay = .05: a.ai = 1
CASE 3: a.cycle_delay = 0: a.ai = 2
END SELECT
ELSEIF a.max < 11 THEN
SELECT CASE g.difficulty
CASE 1: a.cycle_delay = .125: a.ai = 0
CASE 2: a.cycle_delay = .05: a.ai = 1
CASE 3: a.cycle_delay = .003: a.ai = 2
END SELECT
ELSE
SELECT CASE g.difficulty
CASE 1: a.cycle_delay = .1: a.ai = 0
CASE 2: a.cycle_delay = .03: a.ai = 1
CASE 3: a.cycle_delay = .001: a.ai = 2
END SELECT
END IF
_KEYCLEAR ' Clear any previous key presses in buffer.
CALL mouse(0, 0) ' Clear mouse.
CALL comm
DO
_LIMIT 60 ' Display at 60 frames per second.
CALL comm
IF g.m_status THEN CALL Guardian_missiles ' g.m_status determines Guardian or alien turn. 1 = Guardian, -1 = alien.
IF a.count = 0 THEN EXIT SUB ' Moving on to next level.
CALL alien_move
' To change thrusters only when guardian moves, remove the timer and move this routine to: IF v.kb_access = -1 THEN
IF ABS(z3 - TIMER) > .1 THEN ' z3 is a keypress delay timer for Guardian thrusters. Check every .1 seconds for a speed change.
IF _KEYDOWN(100307) AND g.thrusters < 20 THEN g.thrusters = g.thrusters + 1 ' Rt Ctrl key. Slows down Guardian ship down.
IF _KEYDOWN(100305) AND g.thrusters > 0 THEN g.thrusters = g.thrusters - 1 ' Rt Alt key. Speeds up Guardian ship.
z3 = TIMER
END IF
IF ABS(z2 - TIMER) > g.thrusters / 100 THEN ' z2 is delay for Guardian movement cycle. Note: Division needed because computer math can't add decimal numbers correctly.
IF v.kb_access = 0 THEN
IF _KEYDOWN(18432) OR _KEYDOWN(19200) OR _KEYDOWN(19712) OR _KEYDOWN(20480) OR mouse_event2 = -1 THEN ' Arrow keys.
v.kb_access = -1 ' Routes code to guardian move. When zero, Guardian move gets bypassed.
z1 = TIMER ' Delay timer for key lag effect in Guardian move routine.
END IF
END IF
END IF
IF v.kb_access = -1 THEN ' Guardian move routine.-----------------------------------------------------------------------------------------------------------------------------
IF ABS(z1 - TIMER) > .05 THEN ' z1 is a key lag time delay to allow guardian to press two keys together within a reasonable amount of time.
DO ' Faux loop added to throw out illegal key combos like up + down.
IF mouse_event2 = 0 THEN ' Bypass this keyboard routine if the right mouse button is in use.
IF mouse_event1 = 0 THEN g.m_x = 0: g.m_y = 0 ' Variables to control length and direction of Guardian movement. Must be reset to zero each cycle so diagonal moves are possible.
IF g.m_x = 0 AND g.m_y = 0 THEN
' Eliminate illegal combos.
IF _KEYDOWN(18432) AND _KEYDOWN(20480) THEN v.kb_access = 0: z2 = TIMER: EXIT DO ' Up + down
IF _KEYDOWN(19712) AND _KEYDOWN(19200) THEN v.kb_access = 0: z2 = TIMER: EXIT DO ' Left + right.
' IF female THEN STOP AND GET #1, directions. Keys that control movement.
IF _KEYDOWN(18432) THEN ' Up-arrow.
g.m_y = -1 ' To move 1-row up.
END IF
IF _KEYDOWN(19712) THEN ' Right-arrow.
g.m_x = 1 ' To move 1-column right.
END IF
IF _KEYDOWN(20480) THEN ' Down-arrow.
g.m_y = 1 ' To move 1-row down.
END IF
IF _KEYDOWN(19200) THEN ' Left-arrow.
g.m_x = -1 ' To move 1-column left.
END IF
IF g.m_x AND g.m_y THEN ' Double key hold. Routine to cancel keys when double hold is lifted. Compensates for both keys not being released at exactly the same time.
combo = -1 ' Double key hold in progress.
ELSE
IF combo THEN combo = 0: v.kb_access = 0: EXIT DO ' Double key hold was just removed, so skip Guardian move and exit.
END IF
END IF
END IF
' Move Guardian. *****************************************************************************************************
IF g.y + g.m_y > v.top AND g.y + g.m_y <= v.bottom AND g.x + 2 * g.m_x > v.left AND g.x + 2 * g.m_x < v.right THEN
LOCATE g.y, g.x
PRINT " ";
g.y = g.y + g.m_y: g.x = g.x + 2 * g.m_x
IF SCREEN(g.y, g.x) <> 32 AND SCREEN(g.y, g.x) <> g.m_asc THEN ' Guardian abducted by bad move. Ignore if you run into your own missile.
CALL guardian_abduction: EXIT SUB
ELSE
LOCATE g.y, g.x: PRINT g.flagship;
END IF
ELSE
' Hit boundary.
END IF
v.kb_access = 0 ' Guardian move completed. Returns control to general keyboard next cycle.
z2 = TIMER ' Timer for moving. Lag regulated by "g.thrusters" variable.
EXIT DO ' ************************************************************************************************************
LOOP
END IF '
ELSE ' If you want additional key routines, put them here...------------------------------------------------------------------------------------------------------------------
CALL mouse(mouse_event1, mouse_event2)
ky$ = INKEY$
IF mouse_event1 = -1 THEN ky$ = CHR$(9)
IF LEN(ky$) = 1 THEN ' For demo, exclude keys that start with chr$(0). Note without this arrow keys would still register here.
SELECT CASE ky$
CASE CHR$(9) ' Tab key. Bug note: Space bar will not register with arrow up + arrow v.left.
IF ABS(z8 - TIMER) > .25 THEN
SELECT CASE g.m_launcher
CASE ""
IF mouse_event1 = -1 THEN g.m_launcher = "mouse" ELSE g.m_launcher = "keyboard" ' Initiate.
CASE "keyboard"
IF mouse_event1 = -1 THEN
IF g.m_fired = 0 THEN
g.m_launcher = "mouse" ' Switch.
ELSE
ky$ = ""
END IF
END IF
CASE "mouse"
IF mouse_event1 = 0 THEN ' Tab key was used.
IF g.m_fired = 0 THEN
g.m_launcher = "keyboard" ' Switch
ELSE
ky$ = ""
END IF
END IF
END SELECT
IF LEN(ky$) THEN
g.m_status = -1 ' -1 indicates missile just fired.
IF mouse_event1 = 0 THEN v.mouse_or_key_move = 0: ' Key pressed missile fire clears any previous mouse button missile fire.
END IF
mouse_event1 = 0 ' Completes left mouse missile firing cycle.
z8 = TIMER ' Missile firing delay reset.
END IF
CASE CHR$(27) ' Esc
_DELAY 1: SYSTEM
CASE ELSE
REM PRINT "You pressed key: "; ky$;
END SELECT
END IF
END IF '----------------------------------------------------------------------------------------------------------------------------------------------------------------------
LOOP
END SUB
SUB comm
STATIC middle% ' Local variable.
IF middle% = 0 THEN middle% = v.left + (v.right - v.left) \ 2
msg$ = " Thrusters = " + LTRIM$(STR$(5 * (20 - g.thrusters))) + "% Fired = " + LTRIM$(STR$(g.m_fired)) + " Alien ships = " + LTRIM$(STR$(a.count)) + " Level = " + LTRIM$(STR$(v.level)) + "-" + LTRIM$(STR$(g.difficulty)) + " Guardians: "
LOCATE 1, v.left + middle% - ((LEN(msg$) + 8) \ 2): PRINT msg$;
SELECT CASE g.num
CASE 3
PRINT g.icon; " "; g.icon; " "; g.icon;
CASE 2
PRINT g.icon; " "; g.icon; " ";: COLOR 8, 0: PRINT g.icon;: COLOR 7, 0
CASE 1
PRINT g.icon; " ";: COLOR 8, 0: PRINT g.icon; " "; g.icon;: COLOR 7, 0
CASE 0
COLOR 8, 0: PRINT g.icon; " "; g.icon; " "; g.icon; " ";: COLOR 7, 0
END SELECT
PRINT " "; ' Cut off any former printing caused by length changes in comm report like when numbers change from double to single digits.
END SUB
SUB Guardian_missiles
STATIC z4
DIM direction AS INTEGER ' 8 possible directions. local variable.
IF ABS(z4 - TIMER) > .03 THEN
z4 = TIMER
IF v.mouse_or_key_move = 0 THEN ' GAME OPTION: Remove this first IF/THEN to make it necessary to move Guardian in a direction to fire in that direction.
IF g.m_y <> 0 OR g.m_x <> 0 THEN g.diry = g.m_y: g.dirx = g.m_x ' Initiate by setting row and column missile direction to last column and row movement direction of Guardian location.
END IF
IF g.m_status = -1 THEN
IF g.diry = -1 AND g.dirx = 0 THEN
direction = 1
ELSEIF g.diry = -1 AND g.dirx = 1 THEN
direction = 2
ELSEIF g.diry = 0 AND g.dirx = 1 THEN
direction = 3
ELSEIF g.diry = 1 AND g.dirx = 1 THEN
direction = 4
ELSEIF g.diry = 1 AND g.dirx = 0 THEN
direction = 5
ELSEIF g.diry = 1 AND g.dirx = -1 THEN
direction = 6
ELSEIF g.diry = 0 AND g.dirx = -1 THEN
direction = 7
ELSEIF g.diry = -1 AND g.dirx = -1 THEN
direction = 8
END IF
IF m_n(direction) + 1 <= g.m_max THEN ' Don't fire if out of missiles.
IF g.y > v.top + 1 AND g.y < v.bottom AND g.x > v.left + 1 AND g.x < v.right - 1 THEN ' Don't fire if at a border.
m_n(direction) = m_n(direction) + 1
m_y(m_n(direction), direction) = g.y
m_x(m_n(direction), direction) = g.x
g.m_fired = g.m_fired + 1
SOUND 900, .1
END IF
END IF
g.m_status = 1 ' Code will now execute missile launch.
END IF
IF g.m_status = 1 THEN
FOR g.m_d = 1 TO 8 ' Check all directions.
IF m_n(g.m_d) > 0 THEN
j = m_n(g.m_d)
FOR g.m_n = 1 TO j
IF m_y(g.m_n, g.m_d) = g.y AND m_x(g.m_n, g.m_d) = g.x THEN
ELSE
LOCATE m_y(g.m_n, g.m_d), m_x(g.m_n, g.m_d): PRINT " ";
END IF
SELECT CASE g.m_d ' Missile direction.
CASE 1
IF m_y(g.m_n, g.m_d) - 1 > v.top THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) - 1
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR ' Missile off screen.
END IF
CASE 2
IF m_y(g.m_n, g.m_d) - 1 > v.top AND m_x(g.m_n, g.m_d) + 2 < v.right THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) - 1
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) + 2
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 3
IF m_x(g.m_n, g.m_d) + 2 < v.right THEN
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) + 2
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 4
IF m_y(g.m_n, g.m_d) + 1 < v.bottom AND m_x(g.m_n, g.m_d) + 2 < v.right THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) + 1
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) + 2
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 5
IF m_y(g.m_n, g.m_d) + 1 < v.bottom THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) + 1
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 6
IF m_y(g.m_n, g.m_d) + 1 < v.bottom AND m_x(g.m_n, g.m_d) - 2 > v.left THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) + 1
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) - 2
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 7
IF m_x(g.m_n, g.m_d) - 2 > v.left THEN
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) - 2
LOCATE m_y(g.m_n, g.m_d), m_x(g.m_n, g.m_d)
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 8
IF m_y(g.m_n, g.m_d) - 1 > v.top AND m_x(g.m_n, g.m_d) - 2 > v.left THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) - 1
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) - 2
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
END SELECT
NEXT
IF a.count = 0 THEN EXIT SUB
END IF
NEXT
IF g.m_fired <= 0 THEN g.m_fired = 0: g.m_status = 0 ' All missiles cleared.
END IF
END IF
END SUB
SUB missile_check (k)
LOCATE m_y(g.m_n, g.m_d), m_x(g.m_n, g.m_d) ' Place cursor at current missile position.
k = SCREEN(m_y(g.m_n, g.m_d), m_x(g.m_n, g.m_d)) ' Read the screen.
id_by_color = SCREEN(m_y(g.m_n, g.m_d), m_x(g.m_n, g.m_d), 1)
IF k <> 32 AND k <> g.m_asc AND k <> ASC(g.flagship) THEN ' If screen space is occupied by alien ship then explosion.
CALL remove_missile
CALL explosion
REM Game Option - IF SCREEN(g.y, g.x) <> ASC(g.flagship) THEN BEEP: BEEP: BEEP
CALL remove_ship(id_by_color)
k = -1 ' A flag to exit the FOR/NEXT loop upon return.
ELSE
COLOR 14: PRINT CHR$(g.m_asc);: COLOR 7 ' Print missile on the screen. Missile advances here. Only place a missile is printed to the screen.
END IF
END SUB
SUB remove_missile
m_n(g.m_d) = m_n(g.m_d) - 1 ' Counter. Reduce the number of missiles fired, in a specific direction, by 1.
FOR k = g.m_n TO m_n(g.m_d) ' Re-stack arrays.
m_y(k, g.m_d) = m_y(k + 1, g.m_d)
m_x(k, g.m_d) = m_x(k + 1, g.m_d)
NEXT
m_y(k, g.m_d) = 0: m_x(k, g.m_d) = 0 'Zero out location variables of the missile removed. A zero removes unnecessary loop checking for other routines.
g.m_fired = g.m_fired - 1 ' Count of number of missiles fired is reduce by 1.
END SUB
SUB mask_missiles
FOR i = 1 TO g.m_max
FOR j = 1 TO 8
IF m_y(i, j) <> 0 THEN LOCATE m_y(i, j), m_x(i, j): PRINT " "; ' Mask missile.
NEXT j, i
m_status = 0: m_fired = 0: m_n = 0: m_d = 0: m_y = 0: m_x = 0
REDIM m_n(8), m_x(g.m_max, 8), m_y(g.m_max, 8)
END SUB
SUB explosion
soundfile% = 1 ' Local variable turns sound on.
b_y1 = CSRLIN: b_x1 = POS(0)
VIEW PRINT v.top TO v.bottom ' Needed to set print error parameters.
h = 0
ON ERROR GOTO offscreen
DO
IF h = 1 THEN burst$ = " " ELSE burst$ = CHR$(249)
IF v.intro THEN burst$ = "" ' No fireworks, just flash and sound.
h = h + 1
' Flash
IF eflag THEN
IF ABS(z7 - TIMER) > .1 THEN
eflag = 0
PALETTE 0, 0
z7 = TIMER
ELSE
j = -j * -1
IF j = 0 THEN
PALETTE 0, 63
_DELAY .05
ELSE
PALETTE 0, 0
_DELAY .05
END IF
END IF
END IF
IF eflag = 0 THEN
PALETTE 0, 36
IF soundfile% THEN
_SNDPLAY v.snd1
_DELAY .05
PALETTE 0, 0
_SNDPLAY v.snd2
ELSE
_DELAY .075
END IF
eflag = -1
z7 = TIMER
END IF
PALETTE 0, 0 ' End flash.
FOR i = 1 TO 5
SELECT CASE i
CASE 1
COLOR 15
LOCATE b_y1, b_x1: PRINT burst$;
_DELAY .1
CASE 2
IF burst$ = CHR$(249) THEN burst$ = CHR$(250)
COLOR 14, 0
LOCATE b_y1 - 1, b_x1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1 - 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1 + 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1 + 1, b_x1
IF er = 0 THEN PRINT burst$; ELSE er = 0
_DELAY .1
CASE 3
LOCATE b_y1 - 1, b_x1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 - 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 + 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1 + 1, b_x1
IF er = 0 THEN PRINT " "; ELSE er = 0
CASE 4
COLOR 4
LOCATE b_y1 - 1, b_x1 - 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1 - 1, b_x1 + 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1 - 2
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1 + 2
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1 + 1, b_x1 - 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1 + 1, b_x1 + 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
_DELAY .3
CASE 5
LOCATE b_y1 - 1, b_x1 - 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1 - 1, b_x1 + 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 - 2
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 - 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 + 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 + 2
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1 + 1, b_x1 - 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1 + 1, b_x1 + 1
IF er = 0 THEN PRINT " "; ELSE er = 0
END SELECT
NEXT
IF h = 1 THEN h = 0: EXIT DO
LOOP
VIEW PRINT
ON ERROR GOTO 0
COLOR 7
IF a.count = 1 THEN CALL mask_missiles ' Clear unexploded missiles off the screen when changing levels. Game Option: Remove variable to mask missiles after every explosion.
LOCATE b_y1, b_x1
END SUB
SUB remove_ship (id_by_color) ' Removes ship by color identification.
i = a.itr
ON ERROR GOTO offscreen
LOCATE a_mask_y(id_by_color), a_mask_x(id_by_color): PRINT SPACE$(LEN(a.ship));
LOCATE a_y(id_by_color), a_x(id_by_color): PRINT SPACE$(LEN(a.ship));
ON ERROR GOTO 0
a.itr = id_by_color: CALL a_erase
a_ran(id_by_color) = -1 ' Denotes alien ship was destroyed and removed from battle.
a.itr = i
a.count = a.count - 1 ' a.count = 0 will cause program to exit any unneeded subs/loops after the game level sub is completed.
LOCATE g.y, g.x: PRINT g.flagship; ' Re-display Guardian.
' Restore any alien ships in blast zone.
FOR i = 1 TO a.max
IF a_ran(i) > 0 THEN
IF a_y(i) > v.top AND a_x(i) > v.left AND a_x(i) + LEN(a.ship) < v.right THEN LOCATE a_y(i), a_x(i): COLOR i: PRINT a.ship;
END IF
NEXT
COLOR 7
CALL comm
END SUB
SUB alien_move
STATIC z5
y_restore = CSRLIN: x_restore = POS(0) ' Restore column and row upon exit.
IF ABS(z5 - TIMER) > a.cycle_delay OR v.intro THEN ' z5 is a time delay for alien space ship maneuvers. It can be altered in the "game" subroutine.
IF v.intro = 0 THEN h_alien_nom = INT(RND * a.max) + 1 ELSE h_alien_nom = 15
FOR h = 1 TO h_alien_nom ' Local counting variable for alien number of moves in this cycle.
a.itr = a.itr + 1: IF a.itr > a.max THEN a.itr = 1 ' Needed to offset the EXIT DO hover event, which on exit does not affect the a.itr variable.
IF a_ran(a.itr) <> -1 THEN ' This is how a destroyed ship is bypassed. -1 is a destroyed alien ship. Code moves to end of DO:LOOP.
IF a_inertia(a.itr) = 0 THEN ' Determine how many moves in one direction.
a_inertia(a.itr) = INT(RND * (v.bottom - v.top) / 2) + 1 ' How many moves to go in any one direction.
a_ran(a.itr) = INT(RND * 8) + 1 ' Choose 1 of 8 possible directions.
IF a_ran(a.itr) = a_olda_ran(a.itr) OR a_mask_y(a.itr) = 0 AND a_mask_x(a.itr) = 0 AND ran = 1 OR a_mask_y(a.itr) = 0 AND a_mask_x(a.itr) = 0 AND ran = 5 THEN
EXIT FOR ' Just hover if direction was not changed on existing alien space ship or if a new alien space ship is entering from the sides and up or down was generated.
END IF
SELECT CASE a_ran(a.itr) ' Get changes in column and row coordinates.
CASE 1: a_y_loc(a.itr) = -1: a_x_loc(a.itr) = 0 ' Up.
CASE 2: a_y_loc(a.itr) = -1: a_x_loc(a.itr) = 2 ' Up and right.
CASE 3: a_y_loc(a.itr) = 0: a_x_loc(a.itr) = 2 ' Right.
CASE 4: a_y_loc(a.itr) = 1: a_x_loc(a.itr) = 2 ' Down and right.
CASE 5: a_y_loc(a.itr) = 1: a_x_loc(a.itr) = 0 ' Down.
CASE 6: a_y_loc(a.itr) = 1: a_x_loc(a.itr) = -2 ' Down and left.
CASE 7: a_y_loc(a.itr) = 0: a_x_loc(a.itr) = -2 ' Left.
CASE 8: a_y_loc(a.itr) = -1: a_x_loc(a.itr) = -2 ' Up and left.
END SELECT
IF a_y(a.itr) = 0 AND a_x(a.itr) = 0 AND a_ran(a.itr) <> -1 THEN ' New alien space ship enters the screen.
i = RND * (v.bottom - v.top) \ 4
a_y(a.itr) = (v.bottom - v.top) \ 4 + i + v.top
IF a_ran(a.itr) < 5 THEN ' Determine side of entry from initial direction.
IF SCREEN(a_y(a.itr), v.left + LEN(a.ship)) = 32 THEN
a_x(a.itr) = v.left + 1 ' Enter from the left side and go right.
ELSE
CALL a_erase
EXIT FOR
END IF
ELSE
IF SCREEN(a_y(a.itr), v.right - LEN(a.ship) + 1) = 32 THEN
a_x(a.itr) = v.right - LEN(a.ship) ' Enter from the right side and go left.
ELSE
CALL a_erase
EXIT FOR
END IF
END IF
END IF
a_olda_ran(a.itr) = a_ran(a.itr) ' Remember last direction. Another line uses this to disallow any RND that chooses the same direction twice.
ELSE
a_inertia(a.itr) = a_inertia(a.itr) - 1 ' Count down the number of moves in any one direction. When zero, switch direction.
END IF
FOR i = 1 TO a.max
IF i <> a.itr AND a_y(i) <> 0 THEN
IF a_y(a.itr) + a_y_loc(a.itr) = a_y(i) THEN
IF a_x(a.itr) + a_x_loc(a.itr) + LEN(a.ship) > a_x(i) AND a_x(a.itr) + a_x_loc(a.itr) < a_x(i) + LEN(a.ship) THEN
collide = 1
EXIT FOR
END IF
END IF
END IF
NEXT
IF collide = 1 THEN
j = a_y(a.itr): k = a_x(a.itr)
a_y_loc(a.itr) = 0: a_x_loc(a.itr) = 0: a_inertia(a.itr) = 0
collide = 0 ' Collision detection off. Collision was detected and avoided.
ELSE
j = a_y(a.itr) + a_y_loc(a.itr): k = a_x(a.itr) + a_x_loc(a.itr)
END IF
IF j <= v.top OR k <= v.left OR k + LEN(a.ship) > v.right THEN ' Alien ship out of range, off screen.
a_inertia(a.itr) = 0 ' These two lines keep the out of range ship(s) reasonably nearby.
IF j > v.top - 4 AND k < v.right + 3 AND k > v.left - 4 THEN a_y(a.itr) = j: a_x(a.itr) = k
IF a_mask_y(a.itr) <> 0 AND a_mask_x(a.itr) <> 0 THEN
LOCATE a_mask_y(a.itr), a_mask_x(a.itr)
PRINT SPACE$(LEN(a.ship)); ' Mask old position here because the show part of the mask-and-show routine cannot be used when out of range.
END IF
IF a_offscrn(a.itr) > 25 THEN a_y(a.itr) = 0: a_x(a.itr) = 0: a_inertia(a.itr) = 0: a_offscrn(a.itr) = 0
a_mask_y(a.itr) = 0: a_mask_x(a.itr) = 0: a_offscrn(a.itr) = a_offscrn(a.itr) + 1
ELSE
' Check for v.bottom collision and reverse course if detected.
COLOR a.itr
IF j >= v.bottom THEN
a_y_loc(a.itr) = -a_y_loc(a.itr): a_x_loc(a.itr) = -a_x_loc(a.itr)
ELSE
a_y(a.itr) = j: a_x(a.itr) = k ' Next move coordinates.
ii = 0
kk = ASC(g.flagship)
FOR i = 0 TO LEN(a.ship) - 1 ' Check area through width of ship. Remember all or parts of ship are still present on screen.
SELECT CASE SCREEN(j, k + i)
CASE kk
ii = 1 ' Indicates contact with flagship and evokes call abduction routine a few lines down.
EXIT FOR
CASE g.m_asc
ii = 2 ' Indicates ship into missile collision.
EXIT FOR 'Okay to exit as a missile and Guardian craft cannot be present in the same location.
END SELECT
NEXT
IF ii <> 2 THEN ' This will make a move unless a ship into missile event would occur.
'--------------------------------------------Move alien ship-------------------------------------------------
IF a_mask_y(a.itr) <> 0 AND a_mask_x(a.itr) <> 0 THEN LOCATE a_mask_y(a.itr), a_mask_x(a.itr): PRINT SPACE$(LEN(a.ship));
LOCATE j, k: PRINT a.ship;
a_mask_y(a.itr) = j: a_mask_x(a.itr) = k ' Remember these coordinates to erase alien space ship on next loop.
'------------------------------------------------------------------------------------------------------------
END IF
IF ii = 1 THEN CALL guardian_abduction: EXIT FOR ' Exit loop.
j = j - g.y: k = k - g.x + LEN(a.ship) / 2
IF ABS(j) < 3 AND ABS(k) < 8 THEN CALL a_hunt(j, k)
END IF
COLOR 7
END IF
END IF ' a_ran(a.itr) > -1 exit point.
IF a.itr = a.max THEN a.itr = 0: EXIT FOR ' Finished loop. Keep this outside the IF/THEN statement.
NEXT h
z5 = TIMER
LOCATE y_restore, x_restore ' Restore entry column and row positions.
END IF ' End time event.
END SUB
SUB guardian_abduction
IF v.intro = 0 THEN
CALL mask_missiles ' Clear unexploded missiles off the screen after alien abduction.
msg$ = "[GUARDIAN ABDUCTED]"
SOUND 500, .4: SOUND 1000, .3: SOUND 1500, .2
PCOPY 0, 1
SCREEN 0, 0, 1, 1
LOCATE (v.bottom - v.top) \ 2 + v.top, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14 + 16: PRINT msg$;
_DELAY 2
SCREEN 0, 0, 0, 0
END IF
DO
j = 0
FOR i = 1 TO a.max
IF a_y(i) >= v.top AND a_x(i) >= v.left AND a_x(i) <= v.right - LEN(a.ship) THEN
SOUND 500, .04
LOCATE a_y(i), a_x(i): PRINT SPACE$(LEN(a.ship));
IF a_y(i) <> v.top THEN a_y(i) = a_y(i) - 1: LOCATE a_y(i), a_x(i): COLOR i: PRINT a.ship;: _DELAY .02: j = 1
END IF
NEXT
LOOP WHILE j
COLOR 7
IF v.intro THEN EXIT SUB
g.num = g.num - 1
CALL comm
_DELAY .75
v.redo_level = -1
a.count = 0 ' Zero to exit subs back to main game loop.
END SUB
SUB game_level ' Evaluates both alien defeated on a level and Guardian abduction.
_DELAY .5
VIEW PRINT v.top TO v.bottom: CLS 2: VIEW PRINT
_DELAY .5
msg$ = "[LEVEL " + LTRIM$(STR$(v.level)) + "]"
LOCATE (v.bottom - v.top) \ 2 + v.top, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14 + 16: PRINT msg$;
j = 0: k = 0
DO
IF ABS(z0 - TIMER) > .15 THEN
IF j = 0 THEN j = 1: SOUND 750, .3: k = k + 1 ELSE j = 0: _DELAY .1
z0 = TIMER
END IF
LOOP UNTIL k = 6
COLOR 7
LOCATE , v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
PRINT msg$;
VIEW PRINT v.top TO v.bottom: CLS 2: VIEW PRINT
_DELAY .75
g.y = (v.bottom - v.top) \ 2 + v.top: g.x = (v.right - v.left + 1) \ 2 + v.left ' Reset column and row for Guardian craft.
LOCATE g.y, g.x
COLOR 15 + 16: PRINT g.flagship;
_DELAY 1.5
COLOR 7: LOCATE g.y, g.x: PRINT g.flagship;
v.level_up = -1
END SUB
SUB level_up
v.level = v.level + 1
CALL comm
END SUB
SUB a_erase
a_y(a.itr) = 0: a_x(a.itr) = 0: a_mask_y(a.itr) = 0: a_mask_x(a.itr) = 0: a_inertia(a.itr) = 0: a_ran(a.itr) = 0: a_y_loc(a.itr) = 0: a_x_loc(a.itr) = 0: a_olda_ran(a.itr) = 0
END SUB
SUB mouse (mouse_event1, mouse_event2)
STATIC z9, z10, lb, lb_status ' lb_status keeps track of press/release.
WHILE _MOUSEINPUT
IF ABS(z10 - TIMER) > .1 THEN
z10 = TIMER
IF _MOUSEWHEEL > 0 THEN ' Down
IF g.thrusters < 20 THEN g.thrusters = g.thrusters + 1
ELSEIF _MOUSEWHEEL < 0 THEN ' Up
IF g.thrusters > 0 THEN g.thrusters = g.thrusters - 1
END IF
END IF
WEND
mx = _MOUSEX
my = _MOUSEY
lb = _MOUSEBUTTON(1)
rb = _MOUSEBUTTON(2)
IF lb THEN
IF lb_status = 0 THEN
IF ABS(z9 - TIMER) > .33 THEN
z9 = TIMER
mouse_event1 = -1: lb_status = -1: ' Left button down
END IF
END IF
ELSE
IF lb_status THEN lb_status = 0 ' Left button was released.
END IF
IF v.mouse_get_screen THEN
IF lb_status = -1 THEN
x$ = CHR$(SCREEN(my, mx))
SELECT CASE v.mouse_get_screen
CASE 1 ' Select difficulty.
SELECT CASE x$
CASE "1"
g.difficulty = 1
CASE "2"
g.difficulty = 2
CASE "3"
g.difficulty = 3
CASE "S" ' Skip intro.
IF x$ = "S" THEN v.intro = 999: SOUND 1000, .3: EXIT SUB
END SELECT
CASE 2 ' Replay
IF x$ = "Y" THEN v.play = 999: SOUND 1000, .1: EXIT SUB
IF x$ = "N" THEN v.play = -999: SOUND 1000, .1: EXIT SUB
END SELECT
END IF
END IF
cx = g.x: cy = g.y ' Angular calculations provided by bplus from the QB64 Phoenix Forum.
stepX = ABS(cx - mx): stepY = ABS(cy - my)
dAng = INT(_R2D(_ATAN2(my - cy, mx - cx)) + .5)
IF dAng < 0 THEN dAng = dAng + 360
IF dAng <= 90 THEN
startA = 0: endA = dAng: ra = dAng
ELSEIF dAng <= 180 THEN
startA = dAng: endA = 180: ra = 90 - (dAng - 90)
ELSEIF dAng <= 270 THEN
startA = 180: endA = dAng: ra = dAng - 180
ELSEIF dAng <= 360 THEN
startA = dAng: endA = 360: ra = 90 - (dAng - 270)
END IF
m_y = 0: m_x = 0
IF ra <= 90 AND ra >= 50 THEN
IF my > g.y THEN
x$ = "down": m_y = 1: m_x = 0 ' Down.
ELSE
x$ = "up": m_y = -1: m_x = 0 ' Up.
END IF
ELSEIF ra < 50 AND ra >= 15 THEN
IF mx > g.x AND my > g.y THEN
x$ = "down right": m_y = 1: m_x = 2 ' Down and right.
ELSEIF mx < g.x AND my > g.y THEN
x$ = "down left": m_y = 1: m_x = -2 ' Down an left.
ELSEIF mx > g.x AND my < g.y THEN
x$ = "up right": m_y = -1: m_x = 2 ' Up and right.
ELSEIF mx < g.x AND my < g.y THEN
x$ = "up left": m_y = -1: m_x = -2 ' Up and left.
END IF
ELSEIF ra < 15 AND ra >= 0 THEN
IF mx > g.x THEN
x$ = "right": m_y = 0: m_x = 2 ' Right
ELSE
x$ = "left": m_y = 0: m_x = -2 ' Left
END IF
END IF
IF rb AND mouse_event2 = 0 THEN
mouse_event2 = -1
g.m_y = m_y: g.m_x = m_x / 2
v.mouse_or_key_move = 1 ' Right mouse button to move.
ELSE
IF mouse_event2 THEN mouse_event2 = 0
END IF
IF mouse_event1 THEN
g.diry = m_y: g.dirx = m_x / 2
v.mouse_or_key_move = -1
END IF
END SUB
SUB game_over
v.mouse_get_screen = 2 ' Allows mouse to select replay options.
_DELAY .5
CALL comm
IF g.num THEN SOUND 1000, .75: SOUND 500, .75: SOUND 1000, 1.5 ELSE SOUND 1000, .75: SOUND 700, .75: SOUND 500, 1.5
_DELAY .5
VIEW PRINT v.top TO v.bottom: CLS 2: VIEW PRINT
IF g.num THEN msg$ = "[GUARDIAN WINS]" ELSE msg$ = "[Game Over]"
LOCATE (v.bottom - v.top) \ 2 + v.top - 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14 + 16
PRINT msg$;
_DELAY 2
LOCATE (v.bottom - v.top) \ 2 + v.top - 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14: PRINT msg$;
msg$ = "Replay? Y/N"
_DELAY 1
LOCATE (v.bottom - v.top) \ 2 + v.top + 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 8
PRINT msg$;
COLOR 7
DO
_LIMIT 30
CALL mouse(mouse_event1, mouse_event2)
ky$ = INKEY$
IF LEN(ky$) OR ABS(v.play) = 999 THEN
IF v.play = 999 OR UCASE$(ky$) = "Y" OR ky$ = CHR$(13) THEN v.play = 1: VIEW PRINT v.top TO v.bottom: CLS 2: VIEW PRINT: EXIT DO
IF v.play = -999 OR UCASE$(ky$) = "N" OR ky$ = CHR$(27) THEN
msg$ = " [Bye Bye] "
LOCATE (v.bottom - v.top) \ 2 + v.top - 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14 + 16: PRINT msg$;
_DELAY 1
LOCATE (v.bottom - v.top) \ 2 + v.top - 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14: PRINT msg$;
_DELAY .5
SYSTEM
END IF
END IF
LOOP
END SUB
SUB a_hunt (j, k)
SELECT CASE a.ai
CASE 0: EXIT SUB ' No hunting for level 1.
CASE 1: IF RND * 99 < 33 THEN EXIT SUB ' Reduces chances of abduction for level 2.
END SELECT
LOCATE 3, 1
a_inertia(a.itr) = 4
h = j / ABS(j): i = k / ABS(k)
SELECT CASE h
CASE IS < 0 ' Ship above Guardian.
SELECT CASE i
CASE IS < 0 ' Ship to left of Guardian.
a_y_loc(a.itr) = 1: a_x_loc(a.itr) = 1
CASE 0 ' Ship same column as Guardian.
a_y_loc(a.itr) = 1: a_x_loc(a.itr) = 0
CASE IS > 0 ' Ship to right of Guardian.
a_y_loc(a.itr) = 1: a_x_loc(a.itr) = -1
END SELECT
CASE 0 ' Ship same row as Guardian.
SELECT CASE i
CASE IS < 0 ' Ship to left of Guardian.
a_y_loc(a.itr) = 0: a_x_loc(a.itr) = 1
CASE IS > 0 ' Ship to right of Guardian.
a_y_loc(a.itr) = 0: a_x_loc(a.itr) = -1
END SELECT
CASE IS > 0 ' Ship below Guardian.
SELECT CASE i
CASE IS < 0 ' Ship to left of Guardian.
a_y_loc(a.itr) = -1: a_x_loc(a.itr) = 1
CASE 0 ' Ship same column as Guardian.
a_y_loc(a.itr) = -1: a_x_loc(a.itr) = 0
CASE IS > 0 ' Ship to right of Guardian.
a_y_loc(a.itr) = -1: a_x_loc(a.itr) = -1
END SELECT
END SELECT
REM Game Option - Shields as a_y_loc(a.itr) = -a_y_loc(a.itr) : a_x_loc(a.itr) = -a_x_loc(a.itr)
END SUB
Again, if you don't have the sounds effects, get them from post #13.
Pete
Posts: 2,160
Threads: 222
Joined: Apr 2022
Reputation:
103
10-17-2022, 07:58 PM
(This post was last modified: 10-17-2022, 09:54 PM by Pete.)
Added ASCII city below where alien abductions are -500 points per incident and a "High Score" board if you win and have a top 5 score.
GUARDIAN V 1.3
Code: (Select All) DEFINT H-K
$RESIZE:ON
$COLOR:32
_RESIZE OFF
RANDOMIZE TIMER
' Note: timer is not adjusted for stroke of midnight event, so don't stay up late playing this.
REM Main
f1 = 22 ' Sets font size to 22 and calculates the max screen height and width for your desktop.
h = (_DESKTOPHEIGHT - 60) \ f1
w = _DESKTOPWIDTH \ (f1 / 1.66)
WIDTH w, h
_SCREENMOVE 0, 0
fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.
font& = _LOADFONT(fontpath$, f1, "monospace")
_FONT font&
_DELAY .25
_RESIZE ON , _SMOOTH ' Allows resizing. Note: this is for slight adjustments. As of this version there is no compensatory function to change the font size during screen size changes.
TYPE gen_var
intro AS INTEGER ' Runs a protion of the alien subroutine as part of the intro.
nol AS INTEGER ' Number of game levels.
redo_level AS INTEGER ' Alien abdution results in redo level.
level AS INTEGER ' Current game level.
level_up AS INTEGER ' Routes code to next game level.
top AS INTEGER ' Top boundary. (Changeable).
bottom AS INTEGER ' Bottom boundary. (Changeable).
left AS INTEGER ' Left boundary. (Changeable).
right AS INTEGER ' Right boundary. (Changeable).
kb_access AS INTEGER ' Routes code to either Guardian/Alien or general keyboard routine. -1 Guardian/Alien, 0 keyboard.
mouse_or_key_move AS INTEGER
mouse_get_screen AS INTEGER
play AS INTEGER
snd1 AS LONG ' Explosion sound effect.
snd2 AS LONG ' Explosion sound effect.
END TYPE
DIM SHARED v AS gen_var
TYPE guardian
difficulty AS INTEGER
population AS _INTEGER64
num AS INTEGER ' Number of Guardians aka lives.
diry AS INTEGER ' Guardian row move. +1, 0, -1.
dirx AS INTEGER ' Guardian column move. +2, 0, -2. Equals vertical pixel movement. 16x8.
y AS INTEGER ' Guardian coordinates row.
x AS INTEGER ' Guardian coordinates column.
thrusters AS INTEGER ' Guardian speed. (User Determined).
m_max AS INTEGER ' Restricts # of missiles fired in one direction.
m_status AS INTEGER ' Missile status. -1 when fired, 1 while moving.
m_fired AS INTEGER ' The number of missile deployed and still active.
m_n AS INTEGER ' FOR/NEXT counter variable shared by other routines to index through the number of missiles fired in a specific direction.
m_d AS INTEGER ' Missile direction. (1-8).
m_y AS INTEGER ' Missile row advancement increment: +1, 0, -1 Note: Missile row and column coordinates are defined in arrays.
m_x AS INTEGER ' Missile column advancement increment: +2, 0, -2. Equals vertical pixel movement. 16x8.
m_asc AS INTEGER ' ASCII character representing a fired missile.
m_launcher AS STRING
icon AS STRING ' Guardian comm icon. For this edition, it is the same as the flagship: "*"
flagship AS STRING ' Guardian ascii character.
END TYPE
DIM SHARED g AS guardian
TYPE alien
max AS INTEGER ' Maximum # of alien ships on screen.
count AS INTEGER ' Number of alien ships. (Counter).
itr AS INTEGER ' Iteration array number to cycle through the active alien ships. (Counter).
cycle_delay AS SINGLE ' Timer cycle controls how fast alien ships move.
ai AS INTEGER ' Degree of artificial intelligence. (0-2)
ship AS STRING ' Alien ship ASCII design.
END TYPE
DIM SHARED a AS alien
DIM SHARED Overlay
DO
GOSUB set_arrays
SELECT CASE v.play
CASE 0
CALL set_up
CALL city
v.level = 1
CALL comm
CALL intro
v.level = 0: g.population = 100000 ' Reset from intro demo.
GOSUB set_arrays: GOSUB zero_variables ' Reset arrays and zero variables after intro.
CALL level_up
CALL comm
CASE 1
CALL set_up
CALL city
CALL comm
END SELECT
CALL game_level ' Display level.
g.y = (v.bottom - v.top) \ 2 + v.top: g.x = (v.right - v.left + 1) \ 2 + v.left ' Set initial column and row for Guardian craft.
CALL game
IF g.num = 0 OR v.level = v.nol AND v.redo_level = 0 THEN
CALL game_over ' Determines win or lose.
v.level = 1 ' Reinitiate if player chooses to replay.
ELSE
IF v.redo_level = 0 THEN CALL level_up
END IF
GOSUB zero_variables
LOOP
set_arrays:
ii = 15 ' Default max setting for number of alien ships used here to initially dim arrays.
g.m_max = 8 ' * missiles max per direction.
REDIM SHARED a_y(ii), a_x(ii), a_mask_y(ii), a_mask_x(ii), a_inertia(ii) ' Alien movement.
REDIM SHARED a_ran(ii), a_olda_ran(ii), a_y_loc(ii), a_x_loc(ii), a_offscrn(ii) ' Alien movement.
REDIM SHARED m_n(8), m_x(g.m_max, 8), m_y(g.m_max, 8) ' Guardian missiles. 8 represents 8 possible diretions of movement and missile fire.
' Array descriptions and actions.
' a_y() , a_x() Alien ship positions rows and columns.
' a_mask_y(), a_mask_x() Alien ship last position. Masked on next move.
' a_inertia(ii) Number of moves in one direction selected by random for an alien ship.
' a_ran(ii), a_olda_ran(ii) Determines the direction in which the inertia will travel and the prior direction is kept to disallow the same direction twice.
' a_y_loc(ii), a_x_loc(ii) The row and column coordinates of the aliens ships.
' m_n(8), m_x(g.m_max, 8), m_y(g.m_max, 8) Missile number and Missile index 1 to g.m_max for position. 8 is the fixed number of 8 different directions.
RETURN
zero_variables:
' Zero variables.
g.diry = 0: g.dirx = 0: g.m_status = 0: g.m_fired = 0: g.m_d = 0: g.m_y = 0: g.m_x = 0: v.redo_level = 0: a.max = 0: v.intro = 0
a.count = 0: a.itr = 0: a.cycle_delay = 0: v.level_up = 0: v.mouse_or_key_move = 0: g.m_launcher = ""
RETURN
skipintro: ' ONKEY 15.
v.intro = 999
KEY(15) OFF
RETURN
' Error handler.
offscreen: ' Prevents error if blast particles row and column are off-screen. Effect is a partial blast on side of screen.
IF ERR = 5 THEN er = -1: RESUME NEXT
PRINT "Opps, unexpected error"; ERR
END
SUB intro
WHILE -1 ' Faux loop.
v.mouse_get_screen = 1 ' Allows skip intro by mouse selection.
LOCATE _HEIGHT - 1, _WIDTH - 15
COLOR 8: PRINT "[S]kip Intro";: COLOR 7 ' Option to skip the intro using the "S" key with ONKEY statement.
KEY 15, CHR$(0) + CHR$(31) 'scancode for S
ON KEY(15) GOSUB skipintro
KEY(15) ON 'turn ON [S]kip intro event trapping.
j = (v.bottom - v.top) \ 2 + v.top
k = (v.right - v.left) \ 2 + v.left
z1 = TIMER
DO
CALL mouse(0, 0)
IF v.intro = 999 THEN CALL skip_intro: EXIT WHILE
LOOP UNTIL ABS(z1 - TIMER) > .33
SOUND 1000, .3
msg$ = " GUARDIAN "
LOCATE j, k - LEN(msg$) \ 2: COLOR 14: PRINT msg$;: COLOR 7
LOCATE , k
z1 = TIMER
DO
CALL mouse(0, 0)
IF v.intro = 999 THEN CALL skip_intro: EXIT WHILE
LOOP UNTIL ABS(z1 - TIMER) > .66
msg$ = SPACE$(LEN(msg$))
LOCATE j, k - LEN(msg$) \ 2: COLOR 7: PRINT msg$;
LOCATE j, k
IF v.intro = 999 THEN CALL skip_intro: EXIT WHILE ELSE CALL explosion
LOCATE j, k: COLOR 15 + 16: PRINT g.flagship;
z1 = TIMER
DO
CALL mouse(0, 0)
IF v.intro = 999 THEN CALL skip_intro: EXIT WHILE
LOOP UNTIL ABS(z1 - TIMER) > .75
v.intro = -1: a.max = 10
FOR i = 1 TO 90
CALL mouse(0, 0)
IF v.intro = 999 THEN CALL skip_intro: EXIT WHILE
SOUND 900, .05
CALL alien_move
LOCATE j, k: COLOR 15: PRINT g.flagship;: COLOR 7
_DELAY .07
NEXT
z1 = TIMER
DO
CALL mouse(0, 0)
IF v.intro = 999 THEN CALL skip_intro: EXIT WHILE
LOOP UNTIL ABS(z1 - TIMER) > 1
LOCATE j, k: PRINT " ";
CALL guardian_abduction
a.max = 0
z1 = TIMER
DO
CALL mouse(0, 0)
IF v.intro = 999 THEN CALL skip_intro: EXIT WHILE
LOOP UNTIL ABS(z1 - TIMER) > .5
EXIT WHILE
WEND
LOCATE v.bottom, _WIDTH - 20: PRINT SPACE$(20);
' Playing Instructions.
REDIM msg$(13)
msg$(1) = CHR$(249) + " " + "Look towards the top of your screen for Guardian ship status."
msg$(2) = CHR$(249) + " " + "Hold arrow keys up/dn/lt/rt or in combination to move diagonally."
msg$(3) = CHR$(249) + " " + "Missiles can be fired simultaneously in 8 different directions."
msg$(4) = CHR$(249) + " " + "Press Tab to fire 1-8 missiles in the direction of movement."
msg$(5) = CHR$(249) + " " + "Press Rt Ctrl to increase thrust, or Rt Alt to reduce thrust."
msg$(6) = ""
msg$(7) = CHR$(249) + " " + "Mouse alternative: "
msg$(8) = CHR$(249) + " " + "Hold right mouse button to move toward mouse pointer."
msg$(9) = CHR$(249) + " " + "Click left mouse button to fire 1-8 missiles in direction of mouse pointer."
msg$(10) = CHR$(249) + " " + "Mouse wheel up for more thrust, wheel down for less."
msg$(11) = CHR$(249) + " " + "Note: Tab and left mouse button cannot be used simultaneously."
msg$(12) = ""
msg$(13) = CHR$(249) + " " + "If you come in contact with an alien ship, your ship and crew get abducted."
j = 0
FOR i = 1 TO UBOUND(msg$)
IF LEN(msg$(i)) > j THEN j = LEN(msg$(i))
NEXT
i = ((v.right - v.left) - j) \ 2
t_mrgn = 6: b_mrgn = _HEIGHT - 4: l_mrgn = i + 1: r_mrgn = v.right - i
LOCATE t_mrgn - 2, l_mrgn - 2: PRINT STRING$(r_mrgn - l_mrgn + 4, CHR$(196));
LOCATE b_mrgn + 2, l_mrgn - 2: PRINT STRING$(r_mrgn - l_mrgn + 4, CHR$(196));
FOR i = 1 TO b_mrgn - t_mrgn + 3
LOCATE t_mrgn - 2 + i, l_mrgn - 2
PRINT CHR$(179);
LOCATE , r_mrgn + 2: PRINT CHR$(179);
NEXT
LOCATE t_mrgn - 2, l_mrgn - 2: PRINT CHR$(218);
LOCATE t_mrgn - 2, r_mrgn + 2: PRINT CHR$(191);
LOCATE b_mrgn + 2, l_mrgn - 2: PRINT CHR$(192);
LOCATE b_mrgn + 2, r_mrgn + 2: PRINT CHR$(217);
msg$ = "<Intro>"
LOCATE t_mrgn - 2, l_mrgn + (r_mrgn - l_mrgn) \ 2 - LEN(msg$) \ 2
PRINT msg$;
msg$ = "You are the Captain of the Guardian, an elite battle cruiser commissioned to protect our planet against alien invaders. You have 3 lives. Every time you are abducted by an alien ship, you lose a life. If you survive, and wipe out all 3 flights of alien attacks, your mission is completed. You saved Earth!"
j = r_mrgn - l_mrgn
LOCATE t_mrgn, l_mrgn
msg$ = RTRIM$(msg$) + " " ' Simple word parser routine.--------
DO
x$ = MID$(msg$, 1, j)
x$ = MID$(x$, 1, _INSTRREV(x$, " ") - 1)
msg$ = LTRIM$(MID$(msg$, LEN(x$) + 1))
LOCATE , l_mrgn: PRINT x$
LOOP UNTIL msg$ = "" '-----------------------------------------
PRINT
FOR i = 1 TO UBOUND(msg$)
LOCATE , l_mrgn
IF LEN(msg$(i)) THEN PRINT msg$(i) ELSE PRINT
NEXT
PRINT: IF CSRLIN < b_mrgn - 1 THEN PRINT
msg$ = "Select Player Level: [1] Beginner [2] Intermediate [3] Advanced"
LOCATE , l_mrgn + (r_mrgn - l_mrgn) \ 2 - LEN(msg$) \ 2
PRINT msg$;
DO
_LIMIT 10
CALL mouse(0, 0)
ky$ = INKEY$
IF LEN(ky$) OR g.difficulty THEN
IF ky$ = CHR$(27) THEN SYSTEM
SELECT CASE ky$
CASE "1": g.difficulty = 1
CASE "2": g.difficulty = 2
CASE "3": g.difficulty = 3
END SELECT
IF g.difficulty THEN EXIT DO
END IF
LOOP
VIEW PRINT v.top TO v.bottom: CLS 2: VIEW PRINT
END SUB
SUB skip_intro
KEY(15) OFF
v.intro = 0
BEEP: _DELAY .3: BEEP
VIEW PRINT v.top TO v.bottom
COLOR 7
CLS 2
VIEW PRINT
_DELAY .5
END SUB
SUB set_up
v.top = 3: v.bottom = _HEIGHT - 1: v.left = 1: v.right = _WIDTH ' Boundaries.
LOCATE v.top - 1, 1: PRINT STRING$(_WIDTH, CHR$(196));
v.nol = 3
g.population = 100000
g.flagship = CHR$(15)
a.ship = "-<>-"
g.num = 3 ' 3 Guardian (lives) to start.
g.thrusters = 10 ' Shows 1/2 thrust at start up on comm.
g.icon = g.flagship
g.m_asc = 250: g.diry = -1: ' Initiate missile ASCII character. g.diry = -1 initiates fire upwards if unmoved.
IF _FILEEXISTS("Thunder1.ogg") AND _FILEEXISTS("Thunder1.ogg") AND _FILEEXISTS("Thunder1.ogg") AND _FILEEXISTS("Thunder1.ogg") THEN ' Sound effects provided by TheBOB, Bob Seguin, from The QBasic Forum.
v.snd1 = _SNDOPEN("Thunder1.ogg", "SYNC")
v.snd2 = _SNDOPEN("Thunder7.ogg", "SYNC")
END IF
v.play = -1 ' Skip into on replay.
END SUB
SUB game
STATIC mouse_event1, mouse_event2
REM Set mouse_event2 = 0 here to produce constant motion with directional changes.
'Press single or arrow key combo to move. Rt Ctrl = faster / Rt Alt = slower. Tab to fire missles.
g.thrusters = 10 ' Guardian movement delay. (1 to 20). Rt Ctrl = faster / Rt Alt = slower.
SELECT CASE v.level
CASE 1: a.max = 5 ' Sets number of space ships and initiates attack.
CASE 2: a.max = 10
CASE 3: a.max = 15
END SELECT
a.count = a.max
IF a.max < 6 THEN
SELECT CASE g.difficulty
CASE 1: a.cycle_delay = .15: a.ai = 0
CASE 2: a.cycle_delay = .05: a.ai = 1
CASE 3: a.cycle_delay = 0: a.ai = 2
END SELECT
ELSEIF a.max < 11 THEN
SELECT CASE g.difficulty
CASE 1: a.cycle_delay = .125: a.ai = 0
CASE 2: a.cycle_delay = .05: a.ai = 1
CASE 3: a.cycle_delay = .003: a.ai = 2
END SELECT
ELSE
SELECT CASE g.difficulty
CASE 1: a.cycle_delay = .1: a.ai = 0
CASE 2: a.cycle_delay = .03: a.ai = 1
CASE 3: a.cycle_delay = .001: a.ai = 2
END SELECT
END IF
_KEYCLEAR ' Clear any previous key presses in buffer.
CALL mouse(0, 0) ' Clear mouse.
DO
_LIMIT 60 ' Display at 60 frames per second.
CALL comm
IF g.m_status THEN CALL Guardian_missiles ' g.m_status determines Guardian or alien turn. 1 = Guardian, -1 = alien.
IF a.count = 0 THEN EXIT SUB ' Moving on to next level.
CALL alien_move
' To change thrusters only when guardian moves, remove the timer and move this routine to: IF v.kb_access = -1 THEN
IF ABS(z3 - TIMER) > .1 THEN ' z3 is a keypress delay timer for Guardian thrusters. Check every .1 seconds for a speed change.
IF _KEYDOWN(100307) AND g.thrusters < 20 THEN g.thrusters = g.thrusters + 1 ' Rt Ctrl key. Slows down Guardian ship down.
IF _KEYDOWN(100305) AND g.thrusters > 0 THEN g.thrusters = g.thrusters - 1 ' Rt Alt key. Speeds up Guardian ship.
z3 = TIMER
END IF
IF ABS(z2 - TIMER) > g.thrusters / 100 THEN ' z2 is delay for Guardian movement cycle. Note: Division needed because computer math can't add decimal numbers correctly.
IF v.kb_access = 0 THEN
IF _KEYDOWN(18432) OR _KEYDOWN(19200) OR _KEYDOWN(19712) OR _KEYDOWN(20480) OR mouse_event2 = -1 THEN ' Arrow keys.
v.kb_access = -1 ' Routes code to guardian move. When zero, Guardian move gets bypassed.
z1 = TIMER ' Delay timer for key lag effect in Guardian move routine.
END IF
END IF
END IF
IF v.kb_access = -1 THEN ' Guardian move routine.-----------------------------------------------------------------------------------------------------------------------------
IF ABS(z1 - TIMER) > .05 THEN ' z1 is a key lag time delay to allow guardian to press two keys together within a reasonable amount of time.
DO ' Faux loop added to throw out illegal key combos like up + down.
IF mouse_event2 = 0 THEN ' Bypass this keyboard routine if the right mouse button is in use.
IF mouse_event1 = 0 THEN g.m_x = 0: g.m_y = 0 ' Variables to control length and direction of Guardian movement. Must be reset to zero each cycle so diagonal moves are possible.
IF g.m_x = 0 AND g.m_y = 0 THEN
' Eliminate illegal combos.
IF _KEYDOWN(18432) AND _KEYDOWN(20480) THEN v.kb_access = 0: z2 = TIMER: EXIT DO ' Up + down
IF _KEYDOWN(19712) AND _KEYDOWN(19200) THEN v.kb_access = 0: z2 = TIMER: EXIT DO ' Left + right.
' IF female THEN STOP AND GET #1, directions. Keys that control movement.
IF _KEYDOWN(18432) THEN ' Up-arrow.
g.m_y = -1 ' To move 1-row up.
END IF
IF _KEYDOWN(19712) THEN ' Right-arrow.
g.m_x = 1 ' To move 1-column right.
END IF
IF _KEYDOWN(20480) THEN ' Down-arrow.
g.m_y = 1 ' To move 1-row down.
END IF
IF _KEYDOWN(19200) THEN ' Left-arrow.
g.m_x = -1 ' To move 1-column left.
END IF
IF g.m_x AND g.m_y THEN ' Double key hold. Routine to cancel keys when double hold is lifted. Compensates for both keys not being released at exactly the same time.
combo = -1 ' Double key hold in progress.
ELSE
IF combo THEN combo = 0: v.kb_access = 0: EXIT DO ' Double key hold was just removed, so skip Guardian move and exit.
END IF
END IF
END IF
' Move Guardian. *****************************************************************************************************
IF g.y + g.m_y > v.top AND g.y + g.m_y <= v.bottom AND g.x + 2 * g.m_x > v.left AND g.x + 2 * g.m_x < v.right THEN
LOCATE g.y, g.x
PRINT " ";
g.y = g.y + g.m_y: g.x = g.x + 2 * g.m_x
IF SCREEN(g.y, g.x) <> 32 AND SCREEN(g.y, g.x) <> g.m_asc THEN ' Guardian abducted by bad move. Ignore if you run into your own missile.
CALL guardian_abduction: EXIT SUB
ELSE
LOCATE g.y, g.x: PRINT g.flagship;
END IF
ELSE
' Hit boundary.
END IF
v.kb_access = 0 ' Guardian move completed. Returns control to general keyboard next cycle.
z2 = TIMER ' Timer for moving. Lag regulated by "g.thrusters" variable.
EXIT DO ' ************************************************************************************************************
LOOP
END IF '
ELSE ' If you want additional key routines, put them here...------------------------------------------------------------------------------------------------------------------
CALL mouse(mouse_event1, mouse_event2)
ky$ = INKEY$
IF mouse_event1 = -1 THEN ky$ = CHR$(9)
IF LEN(ky$) = 1 THEN ' For demo, exclude keys that start with chr$(0). Note without this arrow keys would still register here.
SELECT CASE ky$
CASE CHR$(9) ' Tab key. Bug note: Space bar will not register with arrow up + arrow v.left.
IF ABS(z8 - TIMER) > .25 THEN
SELECT CASE g.m_launcher
CASE ""
IF mouse_event1 = -1 THEN g.m_launcher = "mouse" ELSE g.m_launcher = "keyboard" ' Initiate.
CASE "keyboard"
IF mouse_event1 = -1 THEN
IF g.m_fired = 0 THEN
g.m_launcher = "mouse" ' Switch.
ELSE
ky$ = ""
END IF
END IF
CASE "mouse"
IF mouse_event1 = 0 THEN ' Tab key was used.
IF g.m_fired = 0 THEN
g.m_launcher = "keyboard" ' Switch
ELSE
ky$ = ""
END IF
END IF
END SELECT
IF LEN(ky$) THEN
g.m_status = -1 ' -1 indicates missile just fired.
IF mouse_event1 = 0 THEN v.mouse_or_key_move = 0: ' Key pressed missile fire clears any previous mouse button missile fire.
END IF
mouse_event1 = 0 ' Completes left mouse missile firing cycle.
z8 = TIMER ' Missile firing delay reset.
END IF
CASE CHR$(27) ' Esc
_DELAY 1: SYSTEM
CASE ELSE
REM PRINT "You pressed key: "; ky$;
END SELECT
END IF
END IF '----------------------------------------------------------------------------------------------------------------------------------------------------------------------
LOOP
END SUB
SUB comm
STATIC middle% ' Local variable.
IF middle% = 0 THEN middle% = v.left + (v.right - v.left) \ 2
REM msg$ = " Thrusters = " + LTRIM$(STR$(5 * (20 - g.thrusters))) + "% Fired = " + LTRIM$(STR$(g.m_fired)) + " Alien ships = " + LTRIM$(STR$(a.count)) + " Level = " + LTRIM$(STR$(v.level)) + "-" + LTRIM$(STR$(g.difficulty)) + " Guardians: "
msg$ = " Population = " + LTRIM$(STR$(g.population)) + " Thrusters = " + LTRIM$(STR$(5 * (20 - g.thrusters))) + "% Fired = " + LTRIM$(STR$(g.m_fired)) + " Alien ships = " + LTRIM$(STR$(a.count)) + " Level = " + LTRIM$(STR$(v.level)) + "-" + LTRIM$(STR$(g.difficulty)) + " Guardians: "
LOCATE 1, v.left + middle% - ((LEN(msg$) + 8) \ 2): PRINT msg$;
SELECT CASE g.num
CASE 3
PRINT g.icon; " "; g.icon; " "; g.icon;
CASE 2
PRINT g.icon; " "; g.icon; " ";: COLOR 8, 0: PRINT g.icon;: COLOR 7, 0
CASE 1
PRINT g.icon; " ";: COLOR 8, 0: PRINT g.icon; " "; g.icon;: COLOR 7, 0
CASE 0
COLOR 8, 0: PRINT g.icon; " "; g.icon; " "; g.icon; " ";: COLOR 7, 0
END SELECT
PRINT " "; ' Cut off any former printing caused by length changes in comm report like when numbers change from double to single digits.
END SUB
SUB Guardian_missiles
STATIC z4
DIM direction AS INTEGER ' 8 possible directions. local variable.
IF ABS(z4 - TIMER) > .03 THEN
z4 = TIMER
IF v.mouse_or_key_move = 0 THEN ' GAME OPTION: Remove this first IF/THEN to make it necessary to move Guardian in a direction to fire in that direction.
IF g.m_y <> 0 OR g.m_x <> 0 THEN g.diry = g.m_y: g.dirx = g.m_x ' Initiate by setting row and column missile direction to last column and row movement direction of Guardian location.
END IF
IF g.m_status = -1 THEN
IF g.diry = -1 AND g.dirx = 0 THEN
direction = 1
ELSEIF g.diry = -1 AND g.dirx = 1 THEN
direction = 2
ELSEIF g.diry = 0 AND g.dirx = 1 THEN
direction = 3
ELSEIF g.diry = 1 AND g.dirx = 1 THEN
direction = 4
ELSEIF g.diry = 1 AND g.dirx = 0 THEN
direction = 5
ELSEIF g.diry = 1 AND g.dirx = -1 THEN
direction = 6
ELSEIF g.diry = 0 AND g.dirx = -1 THEN
direction = 7
ELSEIF g.diry = -1 AND g.dirx = -1 THEN
direction = 8
END IF
IF m_n(direction) + 1 <= g.m_max THEN ' Don't fire if out of missiles.
IF g.y > v.top + 1 AND g.y < v.bottom AND g.x > v.left + 1 AND g.x < v.right - 1 THEN ' Don't fire if at a border.
m_n(direction) = m_n(direction) + 1
m_y(m_n(direction), direction) = g.y
m_x(m_n(direction), direction) = g.x
g.m_fired = g.m_fired + 1
SOUND 900, .1
END IF
END IF
g.m_status = 1 ' Code will now execute missile launch.
END IF
IF g.m_status = 1 THEN
FOR g.m_d = 1 TO 8 ' Check all directions.
IF m_n(g.m_d) > 0 THEN
j = m_n(g.m_d)
FOR g.m_n = 1 TO j
IF m_y(g.m_n, g.m_d) = g.y AND m_x(g.m_n, g.m_d) = g.x THEN
ELSE
LOCATE m_y(g.m_n, g.m_d), m_x(g.m_n, g.m_d): PRINT " ";
END IF
SELECT CASE g.m_d ' Missile direction.
CASE 1
IF m_y(g.m_n, g.m_d) - 1 > v.top THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) - 1
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR ' Missile off screen.
END IF
CASE 2
IF m_y(g.m_n, g.m_d) - 1 > v.top AND m_x(g.m_n, g.m_d) + 2 < v.right THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) - 1
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) + 2
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 3
IF m_x(g.m_n, g.m_d) + 2 < v.right THEN
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) + 2
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 4
IF m_y(g.m_n, g.m_d) + 1 < v.bottom AND m_x(g.m_n, g.m_d) + 2 < v.right THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) + 1
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) + 2
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 5
IF m_y(g.m_n, g.m_d) + 1 < v.bottom THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) + 1
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 6
IF m_y(g.m_n, g.m_d) + 1 < v.bottom AND m_x(g.m_n, g.m_d) - 2 > v.left THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) + 1
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) - 2
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 7
IF m_x(g.m_n, g.m_d) - 2 > v.left THEN
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) - 2
LOCATE m_y(g.m_n, g.m_d), m_x(g.m_n, g.m_d)
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
CASE 8
IF m_y(g.m_n, g.m_d) - 1 > v.top AND m_x(g.m_n, g.m_d) - 2 > v.left THEN
m_y(g.m_n, g.m_d) = m_y(g.m_n, g.m_d) - 1
m_x(g.m_n, g.m_d) = m_x(g.m_n, g.m_d) - 2
CALL missile_check(k): IF k = -1 THEN EXIT FOR
ELSE
CALL remove_missile: EXIT FOR
END IF
END SELECT
NEXT
IF a.count = 0 THEN EXIT SUB
END IF
NEXT
IF g.m_fired <= 0 THEN g.m_fired = 0: g.m_status = 0 ' All missiles cleared.
END IF
END IF
END SUB
SUB missile_check (k)
LOCATE m_y(g.m_n, g.m_d), m_x(g.m_n, g.m_d) ' Place cursor at current missile position.
k = SCREEN(m_y(g.m_n, g.m_d), m_x(g.m_n, g.m_d)) ' Read the screen.
id_by_color = SCREEN(m_y(g.m_n, g.m_d), m_x(g.m_n, g.m_d), 1)
IF k <> 32 AND k <> g.m_asc AND k <> ASC(g.flagship) THEN ' If screen space is occupied by alien ship then explosion.
CALL remove_missile
CALL explosion
REM Game Option - IF SCREEN(g.y, g.x) <> ASC(g.flagship) THEN BEEP: BEEP: BEEP
CALL remove_ship(id_by_color)
k = -1 ' A flag to exit the FOR/NEXT loop upon return.
ELSE
COLOR 14: PRINT CHR$(g.m_asc);: COLOR 7 ' Print missile on the screen. Missile advances here. Only place a missile is printed to the screen.
END IF
END SUB
SUB remove_missile
m_n(g.m_d) = m_n(g.m_d) - 1 ' Counter. Reduce the number of missiles fired, in a specific direction, by 1.
FOR k = g.m_n TO m_n(g.m_d) ' Re-stack arrays.
m_y(k, g.m_d) = m_y(k + 1, g.m_d)
m_x(k, g.m_d) = m_x(k + 1, g.m_d)
NEXT
m_y(k, g.m_d) = 0: m_x(k, g.m_d) = 0 'Zero out location variables of the missile removed. A zero removes unnecessary loop checking for other routines.
g.m_fired = g.m_fired - 1 ' Count of number of missiles fired is reduce by 1.
END SUB
SUB mask_missiles
FOR i = 1 TO g.m_max
FOR j = 1 TO 8
IF m_y(i, j) <> 0 THEN LOCATE m_y(i, j), m_x(i, j): PRINT " "; ' Mask missile.
NEXT j, i
m_status = 0: m_fired = 0: m_n = 0: m_d = 0: m_y = 0: m_x = 0
REDIM m_n(8), m_x(g.m_max, 8), m_y(g.m_max, 8)
END SUB
SUB explosion
soundfile% = 1 ' Local variable turns sound on.
b_y1 = CSRLIN: b_x1 = POS(0)
VIEW PRINT v.top TO v.bottom ' Needed to set print error parameters.
h = 0
ON ERROR GOTO offscreen
DO
IF h = 1 THEN burst$ = " " ELSE burst$ = CHR$(249)
IF v.intro THEN burst$ = "" ' No fireworks, just flash and sound.
h = h + 1
' Flash
IF eflag THEN
IF ABS(z7 - TIMER) > .1 THEN
eflag = 0
PALETTE 0, 0
z7 = TIMER
ELSE
j = -j * -1
IF j = 0 THEN
PALETTE 0, 63
_DELAY .05
ELSE
PALETTE 0, 0
_DELAY .05
END IF
END IF
END IF
IF eflag = 0 THEN
PALETTE 0, 36
IF soundfile% THEN
_SNDPLAY v.snd1
_DELAY .05
PALETTE 0, 0
_SNDPLAY v.snd2
ELSE
_DELAY .075
END IF
eflag = -1
z7 = TIMER
END IF
PALETTE 0, 0 ' End flash.
FOR i = 1 TO 5
SELECT CASE i
CASE 1
COLOR 15
LOCATE b_y1, b_x1: PRINT burst$;
_DELAY .1
CASE 2
IF burst$ = CHR$(249) THEN burst$ = CHR$(250)
COLOR 14, 0
LOCATE b_y1 - 1, b_x1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1 - 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1 + 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1 + 1, b_x1
IF er = 0 THEN PRINT burst$; ELSE er = 0
_DELAY .1
CASE 3
LOCATE b_y1 - 1, b_x1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 - 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 + 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1 + 1, b_x1
IF er = 0 THEN PRINT " "; ELSE er = 0
CASE 4
COLOR 4
LOCATE b_y1 - 1, b_x1 - 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1 - 1, b_x1 + 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1 - 2
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1, b_x1 + 2
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1 + 1, b_x1 - 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
LOCATE b_y1 + 1, b_x1 + 1
IF er = 0 THEN PRINT burst$; ELSE er = 0
_DELAY .3
CASE 5
LOCATE b_y1 - 1, b_x1 - 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1 - 1, b_x1 + 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 - 2
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 - 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 + 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1, b_x1 + 2
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1 + 1, b_x1 - 1
IF er = 0 THEN PRINT " "; ELSE er = 0
LOCATE b_y1 + 1, b_x1 + 1
IF er = 0 THEN PRINT " "; ELSE er = 0
END SELECT
NEXT
IF h = 1 THEN h = 0: EXIT DO
LOOP
VIEW PRINT
ON ERROR GOTO 0
COLOR 7
IF a.count = 1 THEN CALL mask_missiles ' Clear unexploded missiles off the screen when changing levels. Game Option: Remove variable to mask missiles after every explosion.
LOCATE b_y1, b_x1
END SUB
SUB remove_ship (id_by_color) ' Removes ship by color identification.
i = a.itr
ON ERROR GOTO offscreen
LOCATE a_mask_y(id_by_color), a_mask_x(id_by_color): PRINT SPACE$(LEN(a.ship));
LOCATE a_y(id_by_color), a_x(id_by_color): PRINT SPACE$(LEN(a.ship));
ON ERROR GOTO 0
a.itr = id_by_color: CALL a_erase
a_ran(id_by_color) = -1 ' Denotes alien ship was destroyed and removed from battle.
a.itr = i
a.count = a.count - 1 ' a.count = 0 will cause program to exit any unneeded subs/loops after the game level sub is completed.
LOCATE g.y, g.x: PRINT g.flagship; ' Re-display Guardian.
' Restore any alien ships in blast zone.
FOR i = 1 TO a.max
IF a_ran(i) > 0 THEN
IF a_y(i) > v.top AND a_x(i) > v.left AND a_x(i) + LEN(a.ship) < v.right THEN LOCATE a_y(i), a_x(i): COLOR i: PRINT a.ship;
END IF
NEXT
COLOR 7
CALL comm
END SUB
SUB alien_move
STATIC z5
y_restore = CSRLIN: x_restore = POS(0) ' Restore column and row upon exit.
IF ABS(z5 - TIMER) > a.cycle_delay OR v.intro THEN ' z5 is a time delay for alien space ship maneuvers. It can be altered in the "game" subroutine.
IF v.intro = 0 THEN h_alien_nom = INT(RND * a.max) + 1 ELSE h_alien_nom = 15
FOR h = 1 TO h_alien_nom ' Local counting variable for alien number of moves in this cycle.
a.itr = a.itr + 1: IF a.itr > a.max THEN a.itr = 1 ' Needed to offset the EXIT DO hover event, which on exit does not affect the a.itr variable.
IF a_ran(a.itr) <> -1 THEN ' This is how a destroyed ship is bypassed. -1 is a destroyed alien ship. Code moves to end of DO:LOOP.
IF a_inertia(a.itr) = 0 THEN ' Determine how many moves in one direction.
a_inertia(a.itr) = INT(RND * (v.bottom - v.top) / 2) + 1 ' How many moves to go in any one direction.
a_ran(a.itr) = INT(RND * 8) + 1 ' Choose 1 of 8 possible directions.
IF a_ran(a.itr) = a_olda_ran(a.itr) OR a_mask_y(a.itr) = 0 AND a_mask_x(a.itr) = 0 AND ran = 1 OR a_mask_y(a.itr) = 0 AND a_mask_x(a.itr) = 0 AND ran = 5 THEN
EXIT FOR ' Just hover if direction was not changed on existing alien space ship or if a new alien space ship is entering from the sides and up or down was generated.
END IF
SELECT CASE a_ran(a.itr) ' Get changes in column and row coordinates.
CASE 1: a_y_loc(a.itr) = -1: a_x_loc(a.itr) = 0 ' Up.
CASE 2: a_y_loc(a.itr) = -1: a_x_loc(a.itr) = 2 ' Up and right.
CASE 3: a_y_loc(a.itr) = 0: a_x_loc(a.itr) = 2 ' Right.
CASE 4: a_y_loc(a.itr) = 1: a_x_loc(a.itr) = 2 ' Down and right.
CASE 5: a_y_loc(a.itr) = 1: a_x_loc(a.itr) = 0 ' Down.
CASE 6: a_y_loc(a.itr) = 1: a_x_loc(a.itr) = -2 ' Down and left.
CASE 7: a_y_loc(a.itr) = 0: a_x_loc(a.itr) = -2 ' Left.
CASE 8: a_y_loc(a.itr) = -1: a_x_loc(a.itr) = -2 ' Up and left.
END SELECT
IF a_y(a.itr) = 0 AND a_x(a.itr) = 0 AND a_ran(a.itr) <> -1 THEN ' New alien space ship enters the screen.
i = RND * (v.bottom - v.top) \ 4
a_y(a.itr) = (v.bottom - v.top) \ 4 + i + v.top
IF a_ran(a.itr) < 5 THEN ' Determine side of entry from initial direction.
IF SCREEN(a_y(a.itr), v.left + LEN(a.ship)) = 32 THEN
a_x(a.itr) = v.left + 1 ' Enter from the left side and go right.
ELSE
CALL a_erase
EXIT FOR
END IF
ELSE
IF SCREEN(a_y(a.itr), v.right - LEN(a.ship) + 1) = 32 THEN
a_x(a.itr) = v.right - LEN(a.ship) ' Enter from the right side and go left.
ELSE
CALL a_erase
EXIT FOR
END IF
END IF
END IF
a_olda_ran(a.itr) = a_ran(a.itr) ' Remember last direction. Another line uses this to disallow any RND that chooses the same direction twice.
ELSE
a_inertia(a.itr) = a_inertia(a.itr) - 1 ' Count down the number of moves in any one direction. When zero, switch direction.
END IF
FOR i = 1 TO a.max
IF i <> a.itr AND a_y(i) <> 0 THEN
IF a_y(a.itr) + a_y_loc(a.itr) = a_y(i) THEN
IF a_x(a.itr) + a_x_loc(a.itr) + LEN(a.ship) > a_x(i) AND a_x(a.itr) + a_x_loc(a.itr) < a_x(i) + LEN(a.ship) THEN
collide = 1
EXIT FOR
END IF
END IF
END IF
NEXT
IF collide = 1 THEN
j = a_y(a.itr): k = a_x(a.itr)
a_y_loc(a.itr) = 0: a_x_loc(a.itr) = 0: a_inertia(a.itr) = 0
collide = 0 ' Collision detection off. Collision was detected and avoided.
ELSE
j = a_y(a.itr) + a_y_loc(a.itr): k = a_x(a.itr) + a_x_loc(a.itr)
END IF
IF j <= v.top OR k <= v.left OR k + LEN(a.ship) > v.right THEN ' Alien ship out of range, off screen.
a_inertia(a.itr) = 0 ' These two lines keep the out of range ship(s) reasonably nearby.
IF j > v.top - 4 AND k < v.right + 3 AND k > v.left - 4 THEN a_y(a.itr) = j: a_x(a.itr) = k
IF a_mask_y(a.itr) <> 0 AND a_mask_x(a.itr) <> 0 THEN
LOCATE a_mask_y(a.itr), a_mask_x(a.itr)
PRINT SPACE$(LEN(a.ship)); ' Mask old position here because the show part of the mask-and-show routine cannot be used when out of range.
END IF
IF a_offscrn(a.itr) > 25 THEN a_y(a.itr) = 0: a_x(a.itr) = 0: a_inertia(a.itr) = 0: a_offscrn(a.itr) = 0
a_mask_y(a.itr) = 0: a_mask_x(a.itr) = 0: a_offscrn(a.itr) = a_offscrn(a.itr) + 1
ELSE
' Check for v.bottom collision and reverse course if detected.
COLOR a.itr
IF j >= v.bottom THEN
IF j = v.bottom AND k > v.left + 10 AND k < v.right - 10 THEN
LOCATE a_y(a.itr) + 1, a_x(a.itr)
COLOR 15 + 16: PRINT "-500";
g.population = g.population - 500
SOUND 300, .2: _DELAY .07: SOUND 600, .2: _DELAY .07: SOUND 400, .2
COLOR 7
CALL comm
LOCATE a_y(a.itr) + 1, a_x(a.itr)
PRINT SPACE$(5);
a_inertia(a.itr) = v.bottom - v.top
a_y_loc(a.itr) = -a_y_loc(a.itr): a_x_loc(a.itr) = -a_x_loc(a.itr)
a_y_loc(a.itr) = -1
ELSE
a_y_loc(a.itr) = -a_y_loc(a.itr): a_x_loc(a.itr) = -a_x_loc(a.itr)
END IF
ELSE
a_y(a.itr) = j: a_x(a.itr) = k ' Next move coordinates.
ii = 0
kk = ASC(g.flagship)
FOR i = 0 TO LEN(a.ship) - 1 ' Check area through width of ship. Remember all or parts of ship are still present on screen.
SELECT CASE SCREEN(j, k + i)
CASE kk
ii = 1 ' Indicates contact with flagship and evokes call abduction routine a few lines down.
EXIT FOR
CASE g.m_asc
ii = 2 ' Indicates ship into missile collision.
EXIT FOR 'Okay to exit as a missile and Guardian craft cannot be present in the same location.
END SELECT
NEXT
IF ii <> 2 THEN ' This will make a move unless a ship into missile event would occur.
'--------------------------------------------Move alien ship-------------------------------------------------
IF a_mask_y(a.itr) <> 0 AND a_mask_x(a.itr) <> 0 THEN LOCATE a_mask_y(a.itr), a_mask_x(a.itr): PRINT SPACE$(LEN(a.ship));
LOCATE j, k: PRINT a.ship;
a_mask_y(a.itr) = j: a_mask_x(a.itr) = k ' Remember these coordinates to erase alien space ship on next loop.
'------------------------------------------------------------------------------------------------------------
END IF
IF ii = 1 THEN CALL guardian_abduction: EXIT FOR ' Exit loop.
j = j - g.y: k = k - g.x + LEN(a.ship) / 2
IF ABS(j) < 3 AND ABS(k) < 8 THEN CALL a_hunt(j, k)
END IF
COLOR 7
END IF
END IF ' a_ran(a.itr) > -1 exit point.
IF a.itr = a.max THEN a.itr = 0: EXIT FOR ' Finished loop. Keep this outside the IF/THEN statement.
NEXT h
z5 = TIMER
LOCATE y_restore, x_restore ' Restore entry column and row positions.
END IF ' End time event.
END SUB
SUB guardian_abduction
IF v.intro = 0 THEN
CALL mask_missiles ' Clear unexploded missiles off the screen after alien abduction.
msg$ = "[GUARDIAN ABDUCTED]"
SOUND 500, .4: SOUND 1000, .3: SOUND 1500, .2
PCOPY 0, 1
SCREEN 0, 0, 1, 1
LOCATE (v.bottom - v.top) \ 2 + v.top, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14 + 16: PRINT msg$;
_DELAY 2
SCREEN 0, 0, 0, 0
END IF
DO
j = 0
FOR i = 1 TO a.max
IF a_y(i) >= v.top AND a_x(i) >= v.left AND a_x(i) <= v.right - LEN(a.ship) THEN
SOUND 500, .04
LOCATE a_y(i), a_x(i): PRINT SPACE$(LEN(a.ship));
IF a_y(i) <> v.top THEN a_y(i) = a_y(i) - 1: LOCATE a_y(i), a_x(i): COLOR i: PRINT a.ship;: _DELAY .02: j = 1
END IF
NEXT
LOOP WHILE j
COLOR 7
IF v.intro THEN EXIT SUB
g.num = g.num - 1
CALL comm
_DELAY .75
v.redo_level = -1
a.count = 0 ' Zero to exit subs back to main game loop.
END SUB
SUB game_level ' Evaluates both alien defeated on a level and Guardian abduction.
_DELAY .5
VIEW PRINT v.top TO v.bottom: CLS 2: VIEW PRINT
_DELAY .5
msg$ = "[LEVEL " + LTRIM$(STR$(v.level)) + "]"
LOCATE (v.bottom - v.top) \ 2 + v.top, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14 + 16: PRINT msg$;
j = 0: k = 0
DO
IF ABS(z0 - TIMER) > .15 THEN
IF j = 0 THEN j = 1: SOUND 750, .3: k = k + 1 ELSE j = 0: _DELAY .1
z0 = TIMER
END IF
LOOP UNTIL k = 6
COLOR 7
LOCATE , v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
PRINT msg$;
VIEW PRINT v.top TO v.bottom: CLS 2: VIEW PRINT
_DELAY .75
CALL comm
g.y = (v.bottom - v.top) \ 2 + v.top: g.x = (v.right - v.left + 1) \ 2 + v.left ' Reset column and row for Guardian craft.
LOCATE g.y, g.x
COLOR 15 + 16: PRINT g.flagship;
_DELAY 1.5
COLOR 7: LOCATE g.y, g.x: PRINT g.flagship;
v.level_up = -1
END SUB
SUB level_up
v.level = v.level + 1
END SUB
SUB a_erase
a_y(a.itr) = 0: a_x(a.itr) = 0: a_mask_y(a.itr) = 0: a_mask_x(a.itr) = 0: a_inertia(a.itr) = 0: a_ran(a.itr) = 0: a_y_loc(a.itr) = 0: a_x_loc(a.itr) = 0: a_olda_ran(a.itr) = 0
END SUB
SUB mouse (mouse_event1, mouse_event2)
STATIC z9, z10, lb, lb_status ' lb_status keeps track of press/release.
WHILE _MOUSEINPUT
IF ABS(z10 - TIMER) > .1 THEN
z10 = TIMER
IF _MOUSEWHEEL > 0 THEN ' Down
IF g.thrusters < 20 THEN g.thrusters = g.thrusters + 1
ELSEIF _MOUSEWHEEL < 0 THEN ' Up
IF g.thrusters > 0 THEN g.thrusters = g.thrusters - 1
END IF
END IF
WEND
mx = _MOUSEX
my = _MOUSEY
lb = _MOUSEBUTTON(1)
rb = _MOUSEBUTTON(2)
IF lb THEN
IF lb_status = 0 THEN
IF ABS(z9 - TIMER) > .33 THEN
z9 = TIMER
mouse_event1 = -1: lb_status = -1: ' Left button down
END IF
END IF
ELSE
IF lb_status THEN lb_status = 0 ' Left button was released.
END IF
IF v.mouse_get_screen THEN
IF lb_status = -1 THEN
x$ = CHR$(SCREEN(my, mx))
SELECT CASE v.mouse_get_screen
CASE 1 ' Select difficulty.
SELECT CASE x$
CASE "1"
g.difficulty = 1
CASE "2"
g.difficulty = 2
CASE "3"
g.difficulty = 3
CASE "S" ' Skip intro.
IF x$ = "S" THEN v.intro = 999: SOUND 1000, .3: EXIT SUB
END SELECT
CASE 2 ' Replay
IF x$ = "Y" THEN v.play = 999: SOUND 1000, .1: EXIT SUB
IF x$ = "N" THEN v.play = -999: SOUND 1000, .1: EXIT SUB
END SELECT
END IF
END IF
cx = g.x: cy = g.y ' Angular calculations provided by bplus from the QB64 Phoenix Forum.
stepX = ABS(cx - mx): stepY = ABS(cy - my)
dAng = INT(_R2D(_ATAN2(my - cy, mx - cx)) + .5)
IF dAng < 0 THEN dAng = dAng + 360
IF dAng <= 90 THEN
startA = 0: endA = dAng: ra = dAng
ELSEIF dAng <= 180 THEN
startA = dAng: endA = 180: ra = 90 - (dAng - 90)
ELSEIF dAng <= 270 THEN
startA = 180: endA = dAng: ra = dAng - 180
ELSEIF dAng <= 360 THEN
startA = dAng: endA = 360: ra = 90 - (dAng - 270)
END IF
m_y = 0: m_x = 0
IF ra <= 90 AND ra >= 50 THEN
IF my > g.y THEN
x$ = "down": m_y = 1: m_x = 0 ' Down.
ELSE
x$ = "up": m_y = -1: m_x = 0 ' Up.
END IF
ELSEIF ra < 50 AND ra >= 15 THEN
IF mx > g.x AND my > g.y THEN
x$ = "down right": m_y = 1: m_x = 2 ' Down and right.
ELSEIF mx < g.x AND my > g.y THEN
x$ = "down left": m_y = 1: m_x = -2 ' Down an left.
ELSEIF mx > g.x AND my < g.y THEN
x$ = "up right": m_y = -1: m_x = 2 ' Up and right.
ELSEIF mx < g.x AND my < g.y THEN
x$ = "up left": m_y = -1: m_x = -2 ' Up and left.
END IF
ELSEIF ra < 15 AND ra >= 0 THEN
IF mx > g.x THEN
x$ = "right": m_y = 0: m_x = 2 ' Right
ELSE
x$ = "left": m_y = 0: m_x = -2 ' Left
END IF
END IF
IF rb AND mouse_event2 = 0 THEN
mouse_event2 = -1
g.m_y = m_y: g.m_x = m_x / 2
v.mouse_or_key_move = 1 ' Right mouse button to move.
ELSE
IF mouse_event2 THEN mouse_event2 = 0
END IF
IF mouse_event1 THEN
g.diry = m_y: g.dirx = m_x / 2
v.mouse_or_key_move = -1
END IF
END SUB
SUB game_over
v.mouse_get_screen = 2 ' Allows mouse to select replay options.
_DELAY .5
CALL comm
IF g.num THEN SOUND 1000, .75: SOUND 500, .75: SOUND 1000, 1.5 ELSE SOUND 1000, .75: SOUND 700, .75: SOUND 500, 1.5
_DELAY .5
VIEW PRINT v.top TO v.bottom: CLS 2: VIEW PRINT
IF g.num THEN msg$ = "[GUARDIAN WINS]" ELSE msg$ = "[Game Over]"
LOCATE (v.bottom - v.top) \ 2 + v.top - 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14 + 16
PRINT msg$;
_DELAY 2
IF g.num > 0 THEN
LOCATE (v.bottom - v.top) \ 2 + v.top - 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 7
PRINT SPACE$(LEN(msg$));
CALL displayhighscores
ELSE
FOR i = 1 TO 2
LOCATE v.bottom, v.left + ((v.right - v.left + 1) \ 2)
CALL explosion
NEXT
LOCATE v.bottom + 1, v.left
COLOR 8
PRINT STRING$(v.right - v.left + 1, "÷");
COLOR 7
_DELAY .3
g.population = 0
CALL comm
_DELAY .5
END IF
LOCATE (v.bottom - v.top) \ 2 + v.top - 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14: PRINT msg$;
msg$ = "Replay? Y/N"
_DELAY 1
LOCATE (v.bottom - v.top) \ 2 + v.top + 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 8
PRINT msg$;
COLOR 7
DO
_LIMIT 30
CALL mouse(mouse_event1, mouse_event2)
ky$ = INKEY$
IF LEN(ky$) OR ABS(v.play) = 999 THEN
IF v.play = 999 OR UCASE$(ky$) = "Y" OR ky$ = CHR$(13) THEN v.play = 1: VIEW PRINT v.top TO v.bottom: CLS 2: VIEW PRINT: EXIT DO
IF v.play = -999 OR UCASE$(ky$) = "N" OR ky$ = CHR$(27) THEN
msg$ = " [Bye Bye] "
LOCATE (v.bottom - v.top) \ 2 + v.top - 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14 + 16: PRINT msg$;
_DELAY 1
LOCATE (v.bottom - v.top) \ 2 + v.top - 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
COLOR 14: PRINT msg$;
_DELAY .5
LOCATE (v.bottom - v.top) \ 2 + v.top + 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
PRINT SPACE$(LEN(msg$));
COLOR 14
msg$ = " [Bye Bye] "
LOCATE (v.bottom - v.top) \ 2 + v.top - 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
DO
LOCATE , v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
SOUND 500, .04
PRINT SPACE$(LEN(msg$));
LOCATE CSRLIN - 1, v.left + ((v.right - v.left + 1) \ 2) - LEN(msg$) \ 2
PRINT msg$;
_DELAY .05
LOOP UNTIL CSRLIN = v.top
COLOR 7
VIEW PRINT v.top TO v.bottom: CLS 2
_DELAY .6
SYSTEM
END IF
END IF
LOOP
END SUB
SUB a_hunt (j, k)
SELECT CASE a.ai
CASE 0: EXIT SUB ' No hunting for level 1.
CASE 1: IF RND * 99 < 33 THEN EXIT SUB ' Reduces chances of abduction for level 2.
END SELECT
LOCATE 3, 1
a_inertia(a.itr) = 4
h = j / ABS(j): i = k / ABS(k)
SELECT CASE h
CASE IS < 0 ' Ship above Guardian.
SELECT CASE i
CASE IS < 0 ' Ship to left of Guardian.
a_y_loc(a.itr) = 1: a_x_loc(a.itr) = 1
CASE 0 ' Ship same column as Guardian.
a_y_loc(a.itr) = 1: a_x_loc(a.itr) = 0
CASE IS > 0 ' Ship to right of Guardian.
a_y_loc(a.itr) = 1: a_x_loc(a.itr) = -1
END SELECT
CASE 0 ' Ship same row as Guardian.
SELECT CASE i
CASE IS < 0 ' Ship to left of Guardian.
a_y_loc(a.itr) = 0: a_x_loc(a.itr) = 1
CASE IS > 0 ' Ship to right of Guardian.
a_y_loc(a.itr) = 0: a_x_loc(a.itr) = -1
END SELECT
CASE IS > 0 ' Ship below Guardian.
SELECT CASE i
CASE IS < 0 ' Ship to left of Guardian.
a_y_loc(a.itr) = -1: a_x_loc(a.itr) = 1
CASE 0 ' Ship same column as Guardian.
a_y_loc(a.itr) = -1: a_x_loc(a.itr) = 0
CASE IS > 0 ' Ship to right of Guardian.
a_y_loc(a.itr) = -1: a_x_loc(a.itr) = -1
END SELECT
END SELECT
REM Game Option - Shields as a_y_loc(a.itr) = -a_y_loc(a.itr) : a_x_loc(a.itr) = -a_x_loc(a.itr)
END SUB
SUB city
_CONTROLCHR OFF
a$ = "_ê_ê_ê__²_²_²_²___ï_ï_ï___ê_ê___ããã______²_²___ê_ê_ê_"
DO
cityscape$ = cityscape$ + a$
LOOP UNTIL LEN(cityscape$) > _WIDTH
cityscape$ = MID$(cityscape$, 1, _WIDTH)
LOCATE _HEIGHT, 1
PRINT cityscape$;
END SUB
SUB displayhighscores
hardware_top = v.top + 4
hardware_left = v.left + 34
score$ = LTRIM$(STR$(g.population))
DIM hs AS STRING * 25
REDIM highscore$(6), hsdata$(6)
DO
IF _FILEEXISTS("guardian-high-score.dat") THEN
OPEN "guardian-high-score.dat" FOR RANDOM AS #1 LEN = 25
FOR i = 1 TO 5
GET #1, i, hs
highscore$(i) = MID$(hs, 10, 6): hsdata$(i) = hs
NEXT
CLOSE #1
ELSE
FOR i = 1 TO 5
hsdata$(i) = SPACE$(25)
NEXT
END IF
IF VAL(score$) > VAL(highscore$(5)) THEN
IF VAL(score$) > VAL(highscore$(1)) THEN
topscore$ = "HIGH SCORE! Enter Initials!"
ELSE
topscore$ = "Top 5 Score Enter Initials!"
END IF
GOSUB hiscore
i = 14
OUT &H3C8, 0
OUT &H3C9, 20 - i
OUT &H3C9, 20 - i
OUT &H3C9, 20 - i
OUT &H3C8, 8
OUT &H3C9, 30 - i
OUT &H3C9, 30 - i
OUT &H3C9, 30 - i
OUT &H3C8, 7
OUT &H3C9, 30 - i
OUT &H3C9, 30 - i
OUT &H3C9, 30 - i
OUT &H3C8, 3
OUT &H3C9, 30 - i
OUT &H3C9, 30 - i
OUT &H3C9, 30 - i
GOSUB hardware_overlay
COLOR White, 0
t$ = msg$
PSLC 4.6, 41 - LEN(msg$) \ 2, t$
lscr = hardware_left + 6
z3 = TIMER
WHILE -1
initials$ = "": i = 0: nxt = 0
COLOR , _RGB(24, 24, 24): t$ = " " ' Blank initials for redo. Okay to blank at start.
PSL hardware_top + 2 + rank * 2, lscr, t$
_DISPLAY
DO
_LIMIT 30
IF ABS(z3 - TIMER) > .3 THEN ' Flashing cursor
underline hardware_top + 2 + rank * 2, lscr + nxt, 0
_DISPLAY
z3 = TIMER
END IF
ky$ = UCASE$(INKEY$)
IF LEN(ky$) THEN
IF ky$ = CHR$(13) THEN
kflag = 3
ELSEIF ky$ = CHR$(8) AND LEN(initials$) THEN
kflag = 2
ELSEIF ky$ = CHR$(27) THEN
kflag = 4
ELSEIF ky$ >= "A" AND ky$ <= "Z" AND LEN(initials$) < 3 THEN
initials$ = initials$ + ky$
kflag = 1
ELSE
ky$ = "": kflag = 0
END IF
END IF
SELECT CASE kflag
CASE 1
COLOR , _RGB(24, 24, 24)
PSL hardware_top + 2 + rank * 2, lscr + nxt, " "
COLOR Yellow
SOUND 1000, .1
PSL hardware_top + 2 + rank * 2, lscr + nxt, ky$
underline hardware_top + 2 + rank * 2, lscr + nxt, -1
nxt = nxt + 1
underline hardware_top + 2 + rank * 2, lscr + nxt, 0
_DISPLAY
kflag = 0
CASE 2
COLOR , _RGB(24, 24, 24)
underline hardware_top + 2 + rank * 2, lscr + nxt, -1
initials$ = MID$(initials$, 1, LEN(initials$) - 1)
nxt = nxt - 1
PSL hardware_top + 2 + rank * 2, lscr + nxt, " "
COLOR Yellow
SOUND 1000, .1
underline hardware_top + 2 + rank * 2, lscr + nxt, 0
_DISPLAY
kflag = 0
CASE 3
_DELAY 1
l$ = "12"
n$ = "n24": PLAY "L" + l$ + n$
n$ = "n28": PLAY "L" + l$ + n$
n$ = "n28": PLAY "L" + l$ + n$
l$ = "10"
n$ = "n31": PLAY "L" + l$ + n$
l$ = "12"
n$ = "n28": PLAY "L" + l$ + n$
l$ = "5"
n$ = "n31": PLAY "L" + l$ + n$
kflag = 1
_DELAY 1: EXIT DO
CASE 4
EXIT WHILE
END SELECT
LOOP
hsname$ = initials$
MID$(hsdata$(rank), 5, 3) = hsname$ + SPACE$(3 - LEN(hsname$))
OPEN "guardian-high-score.dat" FOR RANDOM AS #1 LEN = 25
FOR i = 1 TO 5
hs = hsdata$(i)
IF LEFT$(hs, 1) = "" THEN MID$(hs, 1, 2) = "0" + LTRIM$(STR$(i))
PUT #1, i, hs
NEXT
CLOSE #1
EXIT WHILE
WEND
_DISPLAY ' Remove scoreboard.
_DELAY .5
_FREEIMAGE Overlay
_DEST 0 'Reset dest back to the normal screen 0.
_AUTODISPLAY
PALETTE
_DELAY .5
EXIT DO
ELSE
EXIT DO ' Not in the top 5 highest scores so exit sub.
END IF
LOOP
EXIT SUB
hardware_overlay:
Overlay = _NEWIMAGE(_WIDTH * _FONTWIDTH, _HEIGHT * _FONTHEIGHT, 32)
_DEST Overlay
_DISPLAY ' Turn autodisplay off.
font = _LOADFONT("lucon.ttf", 24, "monospace")
IF font <= 0 THEN font = 16
_FONT font
bxy% = hardware_top
bxx% = hardware_left
COLOR White, 0
PSL bxy% + .8, bxx% + 1, topscore$
COLOR Yellow, 0
t$ = " " + CHR$(218) + STRING$(27, CHR$(196)) + CHR$(191) + " "
PSL bxy%, bxx% - 1, t$
FOR i = 1 TO 12
t$ = " " + CHR$(179) + STRING$(27, CHR$(32)) + CHR$(179) + " "
PSL bxy% + i, bxx% - 1, t$
NEXT
t$ = " " + CHR$(192) + STRING$(27, CHR$(196)) + CHR$(217) + " "
PSL bxy% + i, bxx% - 1, t$
bxy% = hardware_top + 1
COLOR Black, Yellow
t$ = " NAME SCORE DATE "
PSL bxy% + 1, bxx% + 1, t$
COLOR Yellow, 0
FOR i = 1 TO 5
t$ = hsdata$(i)
PSL bxy% + 1 + i * 2, bxx% + 2, t$
NEXT
_DISPLAY
RETURN
hiscore:
FOR i = 1 TO 5
IF VAL(score$) > VAL(highscore$(i)) THEN rank = i: EXIT FOR
NEXT
hsdata$(6) = SPACE$(25)
MID$(hsdata$(6), 10, 6) = score$
MID$(hsdata$(6), 18, 8) = MID$(DATE$, 1, 6) + MID$(DATE$, 9, 2)
highscore$(6) = score$
FOR i = 1 TO 6
FOR j = 1 TO 6
IF i <> j THEN
IF VAL(highscore$(i)) > VAL(highscore$(j)) THEN
SWAP highscore$(i), highscore$(j)
SWAP hsdata$(i), hsdata$(j)
END IF
END IF
NEXT
NEXT
FOR i = 1 TO 5
MID$(hsdata$(i), 1, 2) = "0" + LTRIM$(STR$(i))
NEXT
RETURN
END SUB
SUB PSLC (y!, x, t$)
_PRINTSTRING ((x - 1) * 8, (y! - 1) * 16), t$
END SUB
SUB PSL (y!, x, t$)
_PRINTSTRING ((x - 1) * _FONTWIDTH, (y! - 1) * _FONTHEIGHT), t$
Overlay_Hardware = _COPYIMAGE(Overlay, 33)
_PUTIMAGE (0, 0), Overlay_Hardware
_FREEIMAGE Overlay_Hardware
END SUB
SUB underline (y, x, uflag)
STATIC ucnt
ucnt = -ucnt - 1
IF ucnt OR uflag THEN
LINE ((x - 1) * _FONTWIDTH, y * _FONTHEIGHT)-((x - 1) * _FONTWIDTH + 12, y * _FONTHEIGHT), _RGB(24, 24, 24), BF
ELSE
LINE ((x - 1) * _FONTWIDTH, y * _FONTHEIGHT)-((x - 1) * _FONTWIDTH + 12, y * _FONTHEIGHT), Yellow, BF
END IF
Overlay_Hardware = _COPYIMAGE(Overlay, 33)
_PUTIMAGE (0, 0), Overlay_Hardware
_FREEIMAGE Overlay_Hardware
END SUB
Download sound effects files attachment in Post #13.
Pete
Posts: 3,932
Threads: 175
Joined: Apr 2022
Reputation:
216
10-17-2022, 10:44 PM
(This post was last modified: 10-17-2022, 10:46 PM by bplus.)
OK I tried it. It looked and worked fine until I got to around the last couple of ships in level 3 all of a sudden I am getting Virus Threats from MS Defender and it refused to store .exe as far as I can tell (No it must of erased the one I was playing on). Very strange response, never seen it before. It refused to allow me to play it again???
Here is screen shot from Windows Defender
b = b + ...
Posts: 3,932
Threads: 175
Joined: Apr 2022
Reputation:
216
10-17-2022, 11:01 PM
(This post was last modified: 10-17-2022, 11:05 PM by bplus.)
That was weird! I downloaded my Blackjack game in Terrys Game Programing Board just to check downloading on Windows. Everything went fine with that. Well let's see if anyone else runs into problems???
BTW I do like mouse action games, so much better than trying to find keys on my keyboard.
b = b + ...
|
