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
Download sound effects files attachment in Post #13.
Pete
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 SUBDownload sound effects files attachment in Post #13.
Pete