' PROGRAMMER : DARREN JAMES MARK ALAN JOHNSON-JANE ' FILE NAME : SVADERS.BAS ' DATE STARTED : 12/05/2000 A.D. ' LAST MODIFIED: 21/12/2001 A.D. ' TITLE : SPECTRUM INVADERS (PC CONVERSION) ' ORIGINS : THE SPECTRUM BOOK OF GAMES ' BY MIKE JAMES, S.M. GEE AND KAY EWBANK ' GRANADA PUBLISHING LIMITED ' 1983 A.D. DECLARE FUNCTION Copy$ (n1%, n2%) DECLARE FUNCTION HPos% () DECLARE FUNCTION Test% (x%, y%) DECLARE FUNCTION VPos% () DECLARE FUNCTION XPos% () DECLARE FUNCTION YPos% () DECLARE SUB Initialise () DECLARE SUB ClrGWin () DECLARE SUB ClrTWin () DECLARE SUB Colour (s%, n%, c%) DECLARE SUB ColourSet (s%) DECLARE SUB CursorTo (x%, y%) DECLARE SUB DefGWin (x1%, y1%, x2%, y2%) DECLARE SUB DefTWin (x1%, y1%, x2%, y2%) DECLARE SUB DrawMask (m%) DECLARE SUB DrawMode (m%) DECLARE SUB DrawTo (x%, y%) DECLARE SUB Ink (n%, c%) DECLARE SUB InputText (t0$, t1$, m%) DECLARE SUB Inverse (n%, m%) DECLARE SUB Invert (n%) DECLARE SUB Mode (m%) DECLARE SUB MoveTo (x%, y%) DECLARE SUB Origin (x%, y%) DECLARE SUB Over (n%, m%) DECLARE SUB Paper (n%, c%) DECLARE SUB PlotAt (x%, y%) DECLARE SUB PlotMode (m%) DECLARE SUB PlotText (t$, m%, s%) DECLARE SUB PlotTriangle (x1%, y1%, x2%, y2%, x3%, y3%) DECLARE SUB PrintText (t$, m%) DECLARE SUB Relative (r%) DECLARE SUB ScrollDown () DECLARE SUB ScrollLeft () DECLARE SUB ScrollRight () DECLARE SUB ScrollUp () DECLARE SUB Symbol (n%, m1%, m2%, m3%, m4%, m5%, m6%, m7%, m8%) DECLARE SUB TabTo (x%) DECLARE SUB TriangleMask (n%) DECLARE SUB CalcPoint (x%, y%) DECLARE SUB DrawPoint (x%, y%) DECLARE SUB PlotSymbol (n%, s%) DECLARE SUB PrintCursor () DECLARE SUB PrintSymbol (n%) DECLARE SUB Main () COMMON cflag% COMMON gflag% COMMON rflag% COMMON sflag% COMMON dmode% COMMON imode% COMMON omode% COMMON pmode% COMMON dmsk1% COMMON dmsk2% COMMON psize% COMMON tmask% COMMON sx1%, sy1% COMMON sx2%, sy2% COMMON txc%, tyc% COMMON tx1%, ty1% COMMON tx2%, ty2% COMMON tpc%, tic% COMMON oxc&, oyc& COMMON gxc&, gyc& COMMON gx1&, gy1& COMMON gx2&, gy2& COMMON gx3&, gy3& COMMON gpc%, gic% COMMON sx1&, sy1& COMMON sx2&, sy2& COMMON colours&() COMMON symbols%() COMMON colourarray&() DIM colours&(26) DIM symbols%(1023) DIM colourarray&(47) DIM systemarray%(3841) DEF FNm$ (q$) = RIGHT$(q$, LEN(q$) - 1) + LEFT$(q$, 1) Initialise Main SCREEN 0 SYSTEM PaletteData: DATA 000000: ' 00 Black DATA 1F0000: ' 01 Blue DATA 3E0000: ' 02 Bright Blue DATA 00001F: ' 03 Red DATA 1F001F: ' 04 Magenta DATA 3E001F: ' 05 Mauve DATA 00003E: ' 06 Bright Red DATA 1F003E: ' 07 Purple DATA 3E003E: ' 08 Bright Magenta DATA 001F00: ' 09 Green DATA 1F1F00: ' 10 Cyan DATA 3E1F00: ' 11 Sky Blue DATA 001F1F: ' 12 Yellow DATA 1F1F1F: ' 13 White DATA 3E1F1F: ' 14 Pastel Blue DATA 001F3E: ' 15 Orange DATA 1F1F3E: ' 16 Pink DATA 3E1F3E: ' 17 Pastel Magenta DATA 003E00: ' 18 Bright Green DATA 1F3E00: ' 19 Sea Green DATA 3E3E00: ' 20 Bright Cyan DATA 003E1F: ' 21 Lime Green DATA 1F3E1F: ' 22 Pastel Green DATA 3E3E1F: ' 23 Pastel Cyan DATA 003E3E: ' 24 Bright Yellow DATA 1F3E3E: ' 25 Pastel Yellow DATA 3E3E3E: ' 26 Bright White ColourData: DATA 00,01,09,10,03,04,12,13 DATA 00,02,18,20,06,08,24,26 SymbolData: DATA 00,00,00,00,00,00,00,00: ' 000 DATA 7E,81,A5,81,A5,99,81,7E: ' 001 DATA 7E,FF,DB,FF,DB,E7,FF,7E: ' 002 DATA 6C,FE,FE,FE,7C,38,10,00: ' 003 DATA 10,38,7C,FE,7C,38,10,00: ' 004 DATA 38,38,FE,FE,FE,10,38,00: ' 005 DATA 10,38,7C,FE,FE,10,38,00: ' 006 DATA 00,00,18,3C,3C,18,00,00: ' 007 DATA FF,FF,E7,C3,C3,E7,FF,FF: ' 008 DATA 00,00,18,24,24,18,00,00: ' 009 DATA FF,FF,E7,DB,DB,E7,FF,FF: ' 010 DATA 0F,07,0D,78,CC,CC,CC,78: ' 011 DATA 3C,66,66,66,3C,18,7E,18: ' 012 DATA 18,1C,1E,18,18,78,F8,70: ' 013 DATA 7F,63,7F,63,63,67,E6,C0: ' 014 DATA 99,5A,24,C3,C3,24,5A,99: ' 015 DATA 20,30,38,3C,38,30,20,00: ' 016 DATA 04,0C,1C,3C,1C,0C,04,00: ' 017 DATA 18,3C,7E,18,18,7E,3C,18: ' 018 DATA 66,66,66,66,66,00,66,00: ' 019 DATA 7E,F6,F6,76,36,36,36,00: ' 020 DATA 3E,60,3C,66,66,3C,06,7C: ' 021 DATA 00,00,00,00,7E,7E,7E,00: ' 022 DATA 18,3C,7E,18,7E,3C,18,7E: ' 023 DATA 18,3C,7E,18,18,18,18,18: ' 024 DATA 18,18,18,18,18,7E,3C,18: ' 025 DATA 00,04,06,FF,06,04,00,00: ' 026 DATA 00,20,60,FF,60,20,00,00: ' 027 DATA 00,00,60,60,7E,00,00,00: ' 028 DATA 00,24,66,FF,66,24,00,00: ' 029 DATA 00,00,18,3C,7E,FF,00,00: ' 030 DATA 00,00,FF,7E,3C,18,00,00: ' 031 DATA 00,00,00,00,00,00,00,00: ' " " DATA 18,18,18,18,18,00,18,00: ' "!" DATA 6C,6C,6C,00,00,00,00,00: ' """ DATA 6C,6C,FE,6C,FE,6C,6C,00: ' "#" DATA 18,3E,58,3C,1A,7C,18,00: ' "$" DATA 60,66,0C,18,30,66,06,00: ' "%" DATA 38,6C,38,76,DC,DC,76,00: ' "&" DATA 18,18,18,00,00,00,00,00: ' "'" DATA 0C,18,30,30,30,18,0C,00: ' "(" DATA 30,18,0C,0C,0C,18,30,00: ' ")" DATA 00,18,7E,3C,7E,18,00,00: ' "*" DATA 00,18,18,7E,18,18,00,00: ' "+" DATA 00,00,00,00,00,18,18,30: ' "," DATA 00,00,00,7E,00,00,00,00: ' "-" DATA 00,00,00,00,00,18,18,00: ' "." DATA 00,06,0C,18,30,60,00,00: ' "/" DATA 3C,66,6E,7E,76,66,3C,00: ' "0" DATA 18,38,18,18,18,18,3C,00: ' "1" DATA 3C,66,06,0C,18,30,7E,00: ' "2" DATA 3C,66,06,1C,06,66,3C,00: ' "3" DATA 0C,1C,3C,6C,7E,0C,0C,00: ' "4" DATA 7E,60,7C,06,06,66,3C,00: ' "5" DATA 1C,30,60,7C,66,66,3C,00: ' "6" DATA 7E,06,0C,18,30,30,30,00: ' "7" DATA 3C,66,66,3C,66,66,3C,00: ' "8" DATA 3C,66,66,3E,06,0C,38,00: ' "9" DATA 00,00,18,18,00,18,18,00: ' ":" DATA 00,00,18,18,00,18,18,30: ' ";" DATA 0C,18,30,60,30,18,0C,00: ' "<" DATA 00,00,7E,00,7E,00,00,00: ' "=" DATA 60,30,18,0C,18,30,60,00: ' ">" DATA 3C,66,06,0C,18,00,18,00: ' "?" DATA 3C,66,6E,6E,6E,60,3C,00: ' "@" DATA 3C,66,66,7E,66,66,66,00: ' "A" DATA 7C,66,66,7C,66,66,7C,00: ' "B" DATA 3C,66,60,60,60,66,3C,00: ' "C" DATA 7C,66,66,66,66,66,7C,00: ' "D" DATA 7E,60,60,7C,60,60,7E,00: ' "E" DATA 7E,60,60,7C,60,60,60,00: ' "F" DATA 3C,66,60,6E,66,66,3C,00: ' "G" DATA 66,66,66,7E,66,66,66,00: ' "H" DATA 3C,18,18,18,18,18,3C,00: ' "I" DATA 06,06,06,06,06,66,3C,00: ' "J" DATA 66,66,6C,78,6C,66,66,00: ' "K" DATA 60,60,60,60,60,60,7E,00: ' "L" DATA C6,EE,FE,D6,C6,C6,C6,00: ' "M" DATA 66,66,76,7E,6E,66,66,00: ' "N" DATA 3C,66,66,66,66,66,3C,00: ' "O" DATA 7C,66,66,7C,60,60,60,00: ' "P" DATA 3C,66,66,66,6A,6C,36,00: ' "Q" DATA 7C,66,66,7C,6C,66,66,00: ' "R" DATA 3C,66,60,3C,06,66,3C,00: ' "S" DATA 7E,18,18,18,18,18,18,00: ' "T" DATA 66,66,66,66,66,66,3C,00: ' "U" DATA 66,66,66,66,66,3C,18,00: ' "V" DATA C6,C6,C6,D6,D6,FE,6C,00: ' "W" DATA 66,66,3C,18,3C,66,66,00: ' "X" DATA 66,66,66,3C,18,18,18,00: ' "Y" DATA 7E,06,0C,18,30,60,7E,00: ' "Z" DATA 3C,30,30,30,30,30,3C,00: ' "[" DATA 00,60,30,18,0C,06,00,00: ' "\" DATA 3C,0C,0C,0C,0C,0C,3C,00: ' "]" DATA 18,3C,66,00,00,00,00,00: ' "^" DATA 00,00,00,00,00,00,00,FF: ' "_" DATA 30,18,0C,00,00,00,00,00: ' "`" DATA 00,00,3C,06,3E,66,3E,00: ' "a" DATA 60,60,7C,66,66,66,7C,00: ' "b" DATA 00,00,3C,66,60,66,3C,00: ' "c" DATA 06,06,3E,66,66,66,3E,00: ' "d" DATA 00,00,3C,66,7E,60,3C,00: ' "e" DATA 0C,18,3C,18,18,18,18,00: ' "f" DATA 00,00,3E,66,66,3E,06,3C: ' "g" DATA 60,60,7C,66,66,66,66,00: ' "h" DATA 18,00,38,18,18,18,3C,00: ' "i" DATA 0C,00,1C,0C,0C,0C,0C,38: ' "j" DATA 60,60,66,6C,78,6C,66,00: ' "k" DATA 38,18,18,18,18,18,3C,00: ' "l" DATA 00,00,EC,FE,D6,D6,D6,00: ' "m" DATA 00,00,7C,66,66,66,66,00: ' "n" DATA 00,00,3C,66,66,66,3C,00: ' "o" DATA 00,00,7C,66,66,7C,60,60: ' "p" DATA 00,00,3E,66,66,3E,06,06: ' "q" DATA 00,00,7C,66,60,60,60,00: ' "r" DATA 00,00,3E,60,3C,06,7C,00: ' "s" DATA 18,18,3C,18,18,18,0C,00: ' "t" DATA 00,00,66,66,66,66,3E,00: ' "u" DATA 00,00,66,66,66,3C,18,00: ' "v" DATA 00,00,C6,D6,D6,FE,6C,00: ' "w" DATA 00,00,66,3C,18,3C,66,00: ' "x" DATA 00,00,66,66,66,3E,06,3C: ' "y" DATA 00,00,7E,0C,18,30,7E,00: ' "z" DATA 0E,18,18,70,18,18,0E,00: ' "{" DATA 18,18,18,00,18,18,18,00: ' "|" DATA 70,18,18,0E,18,18,70,00: ' "}" DATA 76,DC,00,00,00,00,00,00: ' "~" DATA 18,3C,66,C3,C3,C3,C3,FF: ' 127 DATA 3C,66,60,60,66,3C,18,30: ' 128 DATA 66,00,00,66,66,66,3E,00: ' 129 DATA 0C,18,3C,66,7E,60,3C,00: ' 130 DATA 18,24,3C,06,3E,66,3E,00: ' 131 DATA 66,00,3C,06,3E,66,3E,00: ' 132 DATA 30,18,3C,06,3E,66,3E,00: ' 133 DATA 18,00,3C,06,3E,66,3E,00: ' 134 DATA 00,00,3E,60,60,3E,18,30: ' 135 DATA 18,24,3C,66,7E,60,3C,00: ' 136 DATA 66,00,3C,66,7E,60,3C,00: ' 137 DATA 30,18,3C,66,7E,60,3C,00: ' 138 DATA 66,00,00,38,18,18,3C,00: ' 139 DATA 18,24,00,38,18,18,3C,00: ' 140 DATA 30,18,00,38,18,18,3C,00: ' 141 DATA 66,00,3C,66,7E,66,66,00: ' 142 DATA 18,00,3C,66,7E,66,66,00: ' 143 DATA 0C,18,7E,60,7C,60,7E,00: ' 144 DATA 00,00,7E,1B,7F,D8,7E,00: ' 145 DATA 7F,D8,D8,FE,D8,D8,DF,00: ' 146 DATA 18,24,00,3C,66,66,3C,00: ' 147 DATA 66,00,00,3C,66,66,3C,00: ' 148 DATA 30,18,00,3C,66,66,3C,00: ' 149 DATA 18,24,00,66,66,66,3E,00: ' 150 DATA 30,18,00,66,66,66,3E,00: ' 151 DATA 66,00,00,66,66,3E,06,3C: ' 152 DATA 66,00,3C,66,66,66,3C,00: ' 153 DATA 66,00,66,66,66,66,3C,00: ' 154 DATA 00,18,3E,58,58,58,3E,18: ' 155 DATA 1C,36,30,78,30,36,7E,00: ' 156 DATA 66,66,3C,7E,18,7E,18,00: ' 157 DATA F0,D8,D8,F6,CF,C6,C3,00: ' 158 DATA 0C,18,3C,18,18,18,18,30: ' 159 DATA 0C,18,3C,06,3E,66,3E,00: ' 160 DATA 0C,18,00,38,18,18,3C,00: ' 161 DATA 0C,18,00,3C,66,66,3C,00: ' 162 DATA 0C,18,00,66,66,66,3E,00: ' 163 DATA 32,4C,00,7C,66,66,66,00: ' 164 DATA 32,4C,66,76,7E,6E,66,00: ' 165 DATA 00,3C,06,3E,66,3E,00,7E: ' 166 DATA 00,00,3C,66,66,3C,00,7E: ' 167 DATA 18,00,18,30,60,66,3C,00: ' 168 DATA 00,00,7E,60,60,00,00,00: ' 169 DATA 00,00,7E,06,06,00,00,00: ' 170 DATA 20,60,2C,22,24,08,0E,00: ' 171 DATA 20,60,2A,2A,2E,02,02,00: ' 172 DATA 18,00,18,18,18,18,18,00: ' 173 DATA 00,33,66,CC,66,33,00,00: ' 174 DATA 00,CC,66,33,66,CC,00,00: ' 175 DATA AA,00,AA,00,AA,00,AA,00: ' 176 DATA AA,55,AA,55,AA,55,AA,55: ' 177 DATA AA,FF,AA,FF,AA,FF,AA,FF: ' 178 DATA 18,18,18,18,18,18,18,18: ' 179 DATA 18,18,18,F8,18,18,18,18: ' 180 DATA 18,18,F8,18,F8,18,18,18: ' 181 DATA 66,66,66,E6,66,66,66,66: ' 182 DATA 00,00,00,FE,66,66,66,66: ' 183 DATA 00,00,F8,18,F8,18,18,18: ' 184 DATA 66,66,E6,06,E6,66,66,66: ' 185 DATA 66,66,66,66,66,66,66,66: ' 186 DATA 00,00,FE,06,E6,66,66,66: ' 187 DATA 66,66,E6,06,FE,00,00,00: ' 188 DATA 66,66,66,FE,00,00,00,00: ' 189 DATA 18,18,F8,18,F8,00,00,00: ' 190 DATA 00,00,00,F8,18,18,18,18: ' 191 DATA 18,18,18,1F,00,00,00,00: ' 192 DATA 18,18,18,FF,00,00,00,00: ' 193 DATA 00,00,00,FF,18,18,18,18: ' 194 DATA 18,18,18,1F,18,18,18,18: ' 195 DATA 00,00,00,FF,00,00,00,00: ' 196 DATA 18,18,18,FF,18,18,18,18: ' 197 DATA 18,18,1F,18,1F,18,18,18: ' 198 DATA 66,66,66,67,66,66,66,66: ' 199 DATA 66,66,67,60,7F,00,00,00: ' 200 DATA 00,00,7F,60,67,66,66,66: ' 201 DATA 66,66,E7,00,FF,00,00,00: ' 202 DATA 00,00,FF,00,E7,66,66,66: ' 203 DATA 66,66,67,60,67,66,66,66: ' 204 DATA 00,00,FF,00,FF,00,00,00: ' 205 DATA 66,66,E7,00,E7,66,66,66: ' 206 DATA 18,18,FF,00,FF,00,00,00: ' 207 DATA 66,66,66,FF,00,00,00,00: ' 208 DATA 00,00,FF,00,FF,18,18,18: ' 209 DATA 00,00,00,FF,66,66,66,66: ' 210 DATA 66,66,66,7F,00,00,00,00: ' 211 DATA 18,18,1F,18,1F,00,00,00: ' 212 DATA 00,00,1F,18,1F,18,18,18: ' 213 DATA 00,00,00,7F,66,66,66,66: ' 214 DATA 66,66,66,FF,66,66,66,66: ' 215 DATA 18,18,FF,18,FF,18,18,18: ' 216 DATA 18,18,18,F8,00,00,00,00: ' 217 DATA 00,00,00,1F,18,18,18,18: ' 218 DATA FF,FF,FF,FF,FF,FF,FF,FF: ' 219 DATA 00,00,00,00,FF,FF,FF,FF: ' 220 DATA F0,F0,F0,F0,F0,F0,F0,F0: ' 221 DATA 0F,0F,0F,0F,0F,0F,0F,0F: ' 222 DATA FF,FF,FF,FF,00,00,00,00: ' 223 DATA 00,00,73,DE,CC,DE,73,00: ' 224 DATA 3C,66,66,7C,66,66,7C,60: ' 225 DATA 7E,66,60,60,60,60,60,00: ' 226 DATA FE,6C,6C,6C,6C,6C,6C,00: ' 227 DATA 7E,66,30,18,30,66,7E,00: ' 228 DATA 00,00,7F,CC,CC,CC,78,00: ' 229 DATA 00,00,66,66,66,66,7C,C0: ' 230 DATA 00,00,76,DC,18,18,18,00: ' 231 DATA 18,18,7E,DB,DB,7E,18,18: ' 232 DATA 3C,66,66,7E,66,66,3C,00: ' 233 DATA 00,7C,C6,C6,C6,6C,EE,00: ' 234 DATA 3E,60,3C,66,66,66,3C,00: ' 235 DATA 00,00,76,DB,DB,DB,6E,00: ' 236 DATA 06,3C,6E,7E,76,3C,60,00: ' 237 DATA 1E,30,60,7E,60,30,1E,00: ' 238 DATA 3C,66,66,66,66,66,66,00: ' 239 DATA 00,7E,00,7E,00,7E,00,00: ' 240 DATA 18,18,7E,18,18,00,7E,00: ' 241 DATA 30,18,0C,18,30,00,7E,00: ' 242 DATA 0C,18,30,18,0C,00,7E,00: ' 243 DATA 0E,1B,18,18,18,18,18,18: ' 244 DATA 18,18,18,18,18,18,D8,70: ' 245 DATA 18,18,00,7E,00,18,18,00: ' 246 DATA 00,76,DC,00,76,DC,00,00: ' 247 DATA 38,6C,6C,38,00,00,00,00: ' 248 DATA 00,00,00,18,18,00,00,00: ' 249 DATA 00,00,00,10,00,00,00,00: ' 250 DATA 0F,0C,18,18,D8,70,30,00: ' 251 DATA 78,6C,6C,6C,00,00,00,00: ' 252 DATA 38,0C,18,3C,00,00,00,00: ' 253 DATA 00,00,3C,3C,3C,3C,00,00: ' 254 DATA 00,00,00,00,00,00,00,00: ' 255 SUB CalcPoint (x%, y%) SHARED gflag% SHARED gyc& SHARED sy1& SHARED sy2& SHARED systemarray%() MoveTo x%, y% IF gflag% = 1 AND gyc& >= sy1& AND gyc& <= sy2& THEN p1% = 3 * (gyc& \ 2) p2% = p1% + 1 p3% = p2% + 1 SELECT CASE systemarray%(p1%) CASE 0 systemarray%(p1%) = 1 systemarray%(p2%) = x% CASE 1 systemarray%(p1%) = 2 systemarray%(p3%) = x% IF systemarray%(p2%) > systemarray%(p3%) THEN SWAP systemarray%(p2%), systemarray%(p3%) END IF CASE 2 IF x% < systemarray%(p2%) THEN systemarray%(p2%) = x% ELSE IF x% > systemarray%(p3%) THEN systemarray%(p3%) = x% END IF END SELECT END IF END SUB SUB ClrGWin SHARED gflag% SHARED imode% SHARED psize% SHARED gpc%, gic% SHARED sx1&, sy1& SHARED sx2&, sy2& IF gflag% = 1 THEN sy3& = 479& - sy2& sy4& = 479& - sy1& SELECT CASE imode% AND 2 CASE 0: c% = gpc% CASE 2: c% = gic% END SELECT LINE (sx1&, sy3&)-(sx2&, sy4&), c%, BF END IF Relative 0: MoveTo 0, 0 END SUB SUB ClrTWin SHARED sflag% SHARED imode% SHARED psize% SHARED sx1%, sy1% SHARED sx2%, sy2% SHARED tpc%, tic% IF sflag% = 1 THEN sx3% = sx2% + (8 * psize% - 1) sy3% = sy2% + 15 SELECT CASE imode% AND 1 CASE 0: c% = tpc% CASE 1: c% = tic% END SELECT LINE (sx1%, sy1%)-(sx3%, sy3%), c%, BF END IF CursorTo 0, 0 END SUB SUB Colour (s%, n%, c%) SHARED cflag% SHARED colours&() SHARED colourarray&() ss% = s% AND 1 nn% = n% AND 15 cc% = ABS(c%) MOD 27 colourarray&(16 * ss% + nn%) = colours&(cc%) IF ss% = cflag% THEN PALETTE nn%, colours&(cc%) END SUB SUB ColourSet (s%) SHARED cflag% SHARED colourarray&() cflag% = s% AND 1 PALETTE USING colourarray&(16 * cflag%) END SUB FUNCTION Copy$ (n1%, n2%) SHARED imode% SHARED psize% SHARED txc%, tyc% SHARED tpc%, tic% SHARED symbols%() SHARED systemarray%() s% = 8 * psize% x1% = s% * txc% y1% = 16 * tyc% IF POINT(x1%, y1%) <> -1 THEN e% = 0 p% = 16 y% = y1% c1% = -1 c2% = -1 x2% = x1% + s% - psize% y2% = y1% + 14 DO x% = x1% DO systemarray%(p%) = POINT(x%, y%) IF c1% <> systemarray%(p%) AND c2% <> systemarray%(p%) AND e% = 0 THEN IF c2% <> -1 THEN e% = -1 ELSE IF c1% <> -1 THEN c2% = systemarray%(p%) ELSE c1% = systemarray%(p%) END IF END IF END IF p% = p% + 1 x% = x% + psize% LOOP WHILE x% <= x2% AND e% = 0 y% = y% + 2 LOOP WHILE y% <= y2% AND e% = 0 IF e% = 0 THEN IF c1% = tpc% OR c2% = tic% THEN m1% = 128 * (imode% AND 1) m2% = m1% XOR 128 ELSE IF c1% = tic% OR c2% = tpc% THEN m2% = 128 * (imode% AND 1) m1% = m2% XOR 128 ELSE m1% = 0 m2% = 128 END IF END IF p% = 16 FOR a% = 8 TO 15 m3% = m1% m4% = m2% systemarray%(a%) = 0 FOR b% = 0 TO 7 IF systemarray%(p%) = c1% THEN systemarray%(a%) = systemarray%(a%) OR m3% ELSE systemarray%(a%) = systemarray%(a%) OR m4% END IF p% = p% + 1 m3% = m3% \ 2 m4% = m4% \ 2 NEXT b% NEXT a% a% = 0 ds& = VARSEG(symbols%(0)) dp% = VARPTR(symbols%(0)) p1% = 8 * (n1% AND 255) + dp% p3% = 8 * (n2% AND 255) + dp% IF p1% > p3% THEN SWAP p1%, p3% DO p2% = p1% DO DEF SEG = ds& FOR p4% = 0 TO 7 systemarray%(p4%) = PEEK(p2% + p4%) NEXT p4% DEF SEG b% = -1: p% = 0 DO IF systemarray%(p%) <> systemarray%(p% + 8) THEN b% = 0 p% = p% + 1 LOOP WHILE p% < 8 AND b% = -1 p2% = p2% + 8 LOOP WHILE p2% <= p3% AND b% = 0 IF a% = 0 AND b% = 0 THEN FOR p% = 8 TO 15 systemarray%(p%) = systemarray%(p%) XOR 255 NEXT p% END IF a% = a% + 1 LOOP WHILE a% < 2 AND b% = 0 IF b% = -1 THEN Copy$ = CHR$((p2% - dp%) \ 8 - 1) ELSE Copy$ = "" ELSE Copy$ = "" END IF ELSE Copy$ = "" END IF END FUNCTION SUB CursorTo (x%, y%) SHARED txc%, tyc% SHARED tx1%, ty1% SHARED tx2%, ty2% x& = x%: x& = x& + tx1% y& = y%: y& = y& + ty1% IF x& >= tx1% AND x& <= tx2% AND y& >= ty1% AND y& <= ty2% THEN txc% = x& tyc% = y& ELSE dx& = x& - txc%: ax& = ABS(dx&) dy& = y& - tyc%: ay& = ABS(dy&) IF ax& > 0& THEN IF SGN(dx&) = -1 THEN x$ = CHR$(8) ELSE x$ = CHR$(9) FOR i& = 1& TO ax& PrintText x$, 1 NEXT i& END IF IF ay& > 0& THEN IF SGN(dy&) = -1 THEN y$ = CHR$(11) ELSE y$ = CHR$(10) FOR i& = 1& TO ay& PrintText y$, 1 NEXT i& END IF END IF END SUB SUB DefGWin (x1%, y1%, x2%, y2%) SHARED gflag% SHARED psize% SHARED gx1&, gy1& SHARED sx1&, sy1& SHARED sx2&, sy2& gx1& = x1%: gy1& = y1% gx2& = x2%: gy2& = y2% IF gx1& > gx2& THEN SWAP gx1&, gx2& IF gy1& > gy2& THEN SWAP gy1&, gy2& IF gx1& <= 639& AND gy1& <= 479& AND gx2& >= 0& AND gy2& >= 0& THEN gflag% = 1 IF gx1& >= 0& AND gx1& <= 639& THEN sx1& = gx1& ELSE sx1& = 0& IF gy1& >= 0& AND gy1& <= 479& THEN sy1& = gy1& ELSE sy1& = 0& IF gx2& >= 0& AND gx2& <= 639& THEN sx2& = gx2& ELSE sx2& = 639& IF gy2& >= 0& AND gy2& <= 479& THEN sy2& = gy2& ELSE sy2& = 479& mx& = -psize% my& = -2& sx1& = sx1& AND mx& sy1& = sy1& AND my& sx2& = (sx2& AND mx&) - mx& - 1& sy2& = (sy2& AND my&) + 1& ELSE gflag% = 0 END IF Origin 0, 0 END SUB SUB DefTWin (x1%, y1%, x2%, y2%) SHARED sflag% SHARED psize% SHARED sx1%, sy1% SHARED sx2%, sy2% SHARED tx1%, ty1% SHARED tx2%, ty2% tx1% = x1%: ty1% = y1% tx2% = x2%: ty2% = y2% xmin% = -4096 \ psize% ymin% = -2048 xmax% = 4096 \ psize% - 1 ymax% = 2047 IF tx1% < xmin% THEN tx1% = xmin% ELSE IF tx1% > xmax% THEN tx1% = xmax% IF ty1% < ymin% THEN ty1% = ymin% ELSE IF ty1% > ymax% THEN ty1% = ymax% IF tx2% < xmin% THEN tx2% = xmin% ELSE IF tx2% > xmax% THEN tx2% = xmax% IF ty2% < ymin% THEN ty2% = ymin% ELSE IF ty2% > ymax% THEN ty2% = ymax% IF tx1% > tx2% THEN SWAP tx1%, tx2% IF ty1% > ty2% THEN SWAP ty1%, ty2% xmax% = 80 \ psize% - 1 ymax% = 29 IF tx1% <= xmax% AND ty1% <= ymax% AND tx2% >= 0 AND ty2% >= 0 THEN sflag% = 1 IF tx1% >= 0 AND tx1% <= xmax% THEN sx1% = tx1% ELSE sx1% = 0 IF ty1% >= 0 AND ty1% <= ymax% THEN sy1% = ty1% ELSE sy1% = 0 IF tx2% >= 0 AND tx2% <= xmax% THEN sx2% = tx2% ELSE sx2% = xmax% IF ty2% >= 0 AND ty2% <= ymax% THEN sy2% = ty2% ELSE sy2% = ymax% s% = 8 * psize% sx1% = s% * sx1% sy1% = 16 * sy1% sx2% = s% * sx2% sy2% = 16 * sy2% ELSE sflag% = 0 END IF CursorTo 0, 0 END SUB SUB DrawMask (m%) SHARED dmsk1% SHARED dmsk2% dmsk1% = m% AND 255 dmsk2% = 128 END SUB SUB DrawMode (m%) SHARED dmode% dmode% = m% AND 1 END SUB SUB DrawPoint (x%, y%) SHARED imode% SHARED omode% SHARED dmsk1% SHARED dmsk2% SELECT CASE imode% AND 2 CASE 0: mask% = dmsk1% CASE 2: mask% = NOT dmsk1% END SELECT ti% = imode% IF (mask% AND dmsk2%) = 0 THEN imode% = 2 ELSE imode% = 0 SELECT CASE imode% AND omode% CASE 0: PlotAt x%, y% CASE 2: MoveTo x%, y% END SELECT imode% = ti% dmsk2% = dmsk2% \ 2 IF dmsk2% = 0 THEN dmsk2% = 128 END SUB SUB DrawTo (x%, y%) SHARED rflag% SHARED dmode% SHARED psize% xc% = XPos yc% = YPos x1& = xc% AND -psize% y1& = yc% AND -2 MoveTo x%, y% xx% = XPos yy% = YPos x2& = xx% AND -psize% y2& = yy% AND -2 dx& = x2& - x1& dy& = y2& - y1& sx% = SGN(dx&) * psize% sy% = SGN(dy&) * 2 ax& = 1& + ABS(dx&) \ psize% ay& = 1& + ABS(dy&) \ 2& tr% = rflag%: rflag% = 0 IF dmode% = 0 THEN DrawPoint xc%, yc% IF ax& >= ay& THEN IF ax& > 1& THEN by& = ay& FOR i& = 2& TO ax& by& = by& + ay& IF by& > ax& THEN by& = by& - ax& yc% = yc% + sy% END IF xc% = xc% + sx% DrawPoint xc%, yc% NEXT i& END IF ELSE bx& = ax& FOR i& = 2& TO ay& bx& = bx& + ax& IF bx& > ay& THEN bx& = bx& - ay& xc% = xc% + sx% END IF yc% = yc% + sy% DrawPoint xc%, yc% NEXT i& END IF MoveTo xx%, yy% rflag% = tr% END SUB FUNCTION HPos% SHARED txc% SHARED tx1% HPos% = txc% - tx1% END FUNCTION SUB Initialise SHARED colours&() SHARED symbols%() SHARED colourarray&() RESTORE PaletteData FOR c% = 0 TO 26 READ d$ colours&(c%) = VAL("&H" + d$) NEXT c% FOR p% = 32 TO 47 READ c% colourarray&(p%) = colours&(c%) NEXT p% DEF SEG = VARSEG(symbols%(0)) p1% = VARPTR(symbols%(0)) p2% = p1% + 2047 FOR p% = p1% TO p2% READ d$ POKE p%, VAL("&H" + d$) NEXT p% DEF SEG SCREEN 12: Mode 1 END SUB SUB Ink (n%, c%) SHARED tic% SHARED gic% SELECT CASE n% AND 1 CASE 0: tic% = c% AND 15 CASE 1: gic% = c% AND 15 END SELECT END SUB SUB InputText (t0$, t1$, m%) SHARED tx1%, ty1% SHARED tx2%, ty2% l0% = LEN(t0$) l1% = 0 l2% = 0 l3% = 0 t1$ = "" im% = 1 sx% = tx2% - tx1% + 1 sy% = ty2% - ty1% + 1 sx& = sx% sy& = sy% sw& = sx& * sy& PrintText t0$, 3 xc% = HPos yc% = VPos s1& = sx& * yc% + xc% s2& = sw& - s1& PLAY OFF PLAY "MF MN T120 O3 L16" DO l4% = 0 l7% = 0 t2$ = "" PrintCursor DO k$ = INKEY$ LOOP WHILE k$ = "" PrintCursor IF LEN(k$) = 1 THEN SELECT CASE ASC(k$) CASE 8 IF l1% = 0 THEN PLAY "C" ELSE l1% = l1% - 1 l3% = l3% - 1 l7% = -1 t1$ = LEFT$(t1$, l1%) + RIGHT$(t1$, l2%) t2$ = RIGHT$(t1$, l2%) + " " END IF CASE 9 IF im% = 0 THEN IF l2% > 0 THEN l2% = l2% - 1 l4% = 1 l7% = 1 t1$ = LEFT$(t1$, l1%) + " " + RIGHT$(t1$, l2%) t2$ = " " l1% = l1% + 1 ELSE IF l3% = 255 THEN PLAY "C" ELSE l1% = l1% + 1 l3% = l1% l4% = 1 l7% = 1 t1$ = t1$ + " " t2$ = " " END IF END IF ELSE IF l3% = 255 THEN PLAY "C" ELSE t1$ = LEFT$(t1$, l1%) + " " + RIGHT$(t1$, l2%) t2$ = RIGHT$(t1$, l2% + 1) l1% = l1% + 1 l3% = l3% + 1 l4% = 1 l7% = 1 END IF END IF CASE 13 IF l2% > 0 THEN l7% = l2% l1% = l3% l2% = 0 END IF CASE 27 IF l3% > 0 THEN l7% = -l1% t1$ = "" t2$ = SPACE$(l3%) l1% = 0 l2% = 0 l3% = 0 END IF CASE ELSE IF im% = 0 THEN IF l2% > 0 THEN l2% = l2% - 1 l4% = 1 l7% = 1 t1$ = LEFT$(t1$, l1%) + k$ + RIGHT$(t1$, l2%) t2$ = k$ l1% = l1% + 1 ELSE IF l3% = 255 THEN PLAY "C" ELSE l1% = l1% + 1 l3% = l1% l4% = 1 l7% = 1 t1$ = t1$ + k$ t2$ = k$ END IF END IF ELSE IF l3% = 255 THEN PLAY "C" ELSE t1$ = LEFT$(t1$, l1%) + k$ + RIGHT$(t1$, l2%) t2$ = RIGHT$(t1$, l2% + 1) l1% = l1% + 1 l3% = l3% + 1 l4% = 1 l7% = 1 END IF END IF END SELECT ELSE SELECT CASE ASC(RIGHT$(k$, 1)) CASE 71 IF l1% > 0 THEN l7% = -l1% l1% = 0 l2% = l3% END IF CASE 72 IF l1% < sx% THEN PLAY "C" ELSE l1% = l1% - sx% l2% = l2% + sx% l7% = -sx% END IF CASE 75 IF l1% = 0 THEN PLAY "C" ELSE l1% = l1% - 1 l2% = l2% + 1 l7% = -1 END IF CASE 77 IF l2% = 0 THEN PLAY "C" ELSE l1% = l1% + 1 l2% = l2% - 1 l7% = 1 END IF CASE 79 IF l2% > 0 THEN l7% = l2% l1% = l3% l2% = 0 END IF CASE 80 IF l2% < sx% THEN PLAY "C" ELSE l1% = l1% + sx% l2% = l2% - sx% l7% = sx% END IF CASE 82 im% = im% XOR 1 CASE 83 IF l2% = 0 THEN PLAY "C" ELSE l2% = l2% - 1 l3% = l3% - 1 t1$ = LEFT$(t1$, l1%) + RIGHT$(t1$, l2%) t2$ = RIGHT$(t1$, l2%) + " " END IF END SELECT END IF IF l7% <> 0 OR t2$ <> "" THEN l6% = LEN(t2$) l5% = l6% - l4% IF l7% <> 0 THEN s3& = s1& + l7% IF s3& < 0& THEN IF l6% = 0 THEN l5% = -s3& t2$ = MID$(t1$, l1% + 1, l5%) END IF l4% = l0% + l1% l6% = l4% + l5% t2$ = t0$ + LEFT$(t1$, l1%) + t2$ ELSE s4& = s2& - l7% IF s4& < 1& THEN IF s4& < 0& THEN l4% = -s4& l5% = l2% l6% = l4% + l5% t2$ = RIGHT$(t1$, l6%) END IF END IF CursorTo xc% + l7%, yc% xc% = HPos yc% = VPos s1& = sx& * yc% + xc% s2& = sw& - s1& END IF IF l4% <= s1& THEN CursorTo xc% - l4%, yc% ELSE CursorTo 0, 0 l4% = s1& l6% = l4% + l5% t2$ = RIGHT$(t2$, l6%) END IF IF l5% > s2& THEN l5% = s2& l6% = l4% + l5% t2$ = LEFT$(t2$, l6%) END IF IF l6% > 0 THEN PrintText LEFT$(t2$, l6% - 1), 3 PrintSymbol ASC(RIGHT$(t2$, 1)) END IF CursorTo xc%, yc% END IF LOOP UNTIL k$ = CHR$(13) IF (m% AND 1) = 0 THEN PrintText "", 0 PLAY "O4 L4" END SUB SUB Inverse (n%, m%) SHARED imode% SELECT CASE n% AND 1 CASE 0: imode% = (imode% AND 2) OR (m% AND 1) CASE 1: imode% = (imode% AND 1) OR (2 * (m% AND 1)) END SELECT END SUB SUB Invert (n%) SHARED tpc%, tic% SHARED gpc%, gic% SELECT CASE n% AND 1 CASE 0: SWAP tpc%, tic% CASE 1: SWAP gpc%, gic% END SELECT END SUB SUB Main 10 ' Define first alien ship graphics character. Symbol 128, &H18, &H3C, &H7E, &HFF, &HC3, &HC3, &H66, &H24 100 ' Define missile launcher graphics character. Symbol 131, &H18, &H18, &H18, &H3C, &H7E, &H7E, &HFF, &HFF 200 ' Define second alien ship graphics character. Symbol 129, &H18, &H3C, &H7E, &HFF, &H3C, &H66, &HC3, &H66 300 ' Define explosion graphics character. Symbol 130, &H28, &H88, &H91, &H28, &H1C, &H34, &HA4, &HA4 400 ' Initialise variables and set background paper and ink colours. y% = 1 xL% = 10 ym% = 0 t% = 0 s% = 0 sf% = 1 Paper 0, 0: Ink 0, 15 DefTWin 4, 3, 35, 24 488 ' Instructions. Ink 0, 14 PrintText "Controls are:", 0 PrintText "", 0 PrintText "[Z] - Left", 0 PrintText "[X] - Right", 0 PrintText "[SPACE] - Fire", 0 PrintText "", 0 PrintText "[S] - Toggle sound on/off", 0 Ink 0, 15: CursorTo 0, 21 PrintText "Press any key to start...", 1: SLEEP ClrTWin 500 ' Initialise strings. a$ = "" b$ = "" FOR c% = 1 TO 10 a$ = a$ + CHR$(128) + " " b$ = b$ + " " + CHR$(129) NEXT c% c$ = a$ d$ = b$ e$ = SPACE$(20) 1000 ' Print aliens. ClrTWin Ink 0, 14 CursorTo 1, y%: PrintText a$, 0: CursorTo 1, y% + 4: PrintText c$, 0 Ink 0, 12 CursorTo 1, y% + 2: PrintText b$, 0: CursorTo 1, y% + 6: PrintText d$, 0 GOTO 8000 1100 ' Print and move missile launcher and toggle sound. Ink 0, 10 t% = t% + 1 CursorTo xL%, 21: PrintText CHR$(131), 1 L$ = INKEY$ IF L$ = "" THEN RETURN CursorTo xL%, 21: PrintText " ", 1 IF (L$ = "z" OR L$ = "Z") AND xL% > 1 THEN xL% = xL% - 1 IF (L$ = "x" OR L$ = "X") AND xL% < 20 THEN xL% = xL% + 1 IF (L$ = "s" OR L$ = "S") THEN sf% = sf% XOR 1 CursorTo xL%, 21: PrintText CHR$(131), 1 1400 ' Shoot missile. Ink 0, 14 IF L$ <> " " THEN RETURN FOR m% = 19 TO y% + 6 STEP -1 CursorTo xL%, m%: PrintText ".", 0: CursorTo xL%, m% + 1: PrintText " ", 0 NEXT m% CursorTo xL%, m% + 1: PrintText " ", 0 1500 ' Test whether alien hit and for end of game. f% = 0 q$ = d$: r% = 6 GOSUB 7000 d$ = q$ IF f% = 1 THEN GOTO 1670 CursorTo xL%, y% + 5: PrintText ".", 0: CursorTo xL%, y% + 4: PrintText ".", 0 CursorTo xL%, y% + 5: PrintText " ", 0: CursorTo xL%, y% + 4: PrintText " ", 0 q$ = c$: r% = 4 GOSUB 7000 c$ = q$ IF f% = 1 THEN GOTO 1670 CursorTo xL%, y% + 3: PrintText ".", 0: CursorTo xL%, y% + 3: PrintText " ", 0 CursorTo xL%, y% + 2: PrintText ".", 0: CursorTo xL%, y% + 2: PrintText " ", 0 q$ = b$: r% = 2 GOSUB 7000 b$ = q$ IF f% = 1 THEN GOTO 1670 CursorTo xL%, y% + 1: PrintText ".", 0: CursorTo xL%, y% + 1: PrintText " ", 0 CursorTo xL%, y%: PrintText " ", 0 q$ = a$: r% = 0 GOSUB 7000 a$ = q$ 1670 IF a$ = e$ AND b$ = e$ AND c$ = e$ AND d$ = e$ THEN GOTO 9000 1680 ' No aliens left. IF q$ = e$ THEN y% = y% + 2: CursorTo 1, y% - 2: PrintText e$, 0 GOTO 1100 7000 ' Remove aliens when hit. IF MID$(q$, xL%, 1) = " " THEN RETURN q$ = LEFT$(q$, xL% - 1) + " " + RIGHT$(q$, LEN(q$) - xL%) f% = 1 7510 ' Increment score when alien hit. s% = s% + 10 - y% q$ = FNm$(q$) GOSUB 7900 RETURN 7900 ' Print explosion, produce its sound and display new score. FOR m% = 1 TO 8 Ink 0, 15: CursorTo xL%, y% + r%: Over 0, 1: PrintText CHR$(130), 0: Over 0, 0 IF sf% = 1 THEN SOUND 195.998, .182 NEXT m% Ink 0, 15: CursorTo 25, 10: PrintText "SCORE", 0 Ink 0, 15: CursorTo 26, 11: PrintText STR$(s%), 0 t% = t% - 1 RETURN 8000 ' Main play loop. CursorTo 0, 14: PrintText "x", 0 IF t% > 30 + INT(RND * 15) THEN y% = y% + 2 t% = 0 CursorTo 1, y% - 2: PrintText e$, 0 END IF a$ = FNm$(a$) CursorTo 1, y%: Ink 0, 14: PrintText a$, 0 IF sf% = 1 THEN SOUND 146.832, .182 * (17 - y%) GOSUB 1100 b$ = FNm$(b$) CursorTo 1, y% + 2: Ink 0, 12: PrintText b$, 0 IF sf% = 1 THEN SOUND 116.541, .182 * (17 - y%) GOSUB 1100 c$ = FNm$(c$) CursorTo 1, y% + 4: Ink 0, 14: PrintText c$, 0 IF sf% = 1 THEN SOUND 146.832, .182 * (17 - y%) GOSUB 1100 d$ = FNm$(d$) CursorTo 1, y% + 6: Ink 0, 12: PrintText d$, 0 IF sf% = 1 THEN SOUND 116.541, .182 * (17 - y%) GOSUB 1100 IF y% > 8 AND d$ <> e$ THEN GOTO 8500 IF y% > 10 AND c$ <> e$ THEN GOTO 8500 IF y% > 12 AND b$ <> e$ THEN GOTO 8500 IF y% > 14 THEN GOTO 8500 t% = t% + 1 GOTO 8000 8500 ' Losing message. DefTWin 4, 25, 35, 26 Ink 0, 15: CursorTo 1, 0: PrintText "THEY GOT YOU!!!!", 0 GOTO 9020 9000 ' Winning message and offer of new game. Ink 0, 15: CursorTo 1, 0: PrintText "YOU SAVED THE WORLD!!", 0 9020 CursorTo 1, 1: InputText "Another game (Y/N)?", Z$, 0 IF Z$ <> "" THEN Z$ = LEFT$(Z$, 1) IF Z$ = "y" OR Z$ = "Y" THEN RUN Paper 0, 0: Ink 0, 15 9500 ' String function (see program module SVADERS.BAS). END SUB SUB Mode (m%) SHARED imode% SHARED omode% SHARED psize% SHARED colourarray&() imode% = 0 omode% = 0 SELECT CASE ABS(m%) MOD 3 CASE 0: psize% = 1 CASE 1: psize% = 2 CASE 2: psize% = 4 END SELECT FOR p% = 32 TO 47 colourarray&(p% - 32) = colourarray&(p%) colourarray&(p% - 16) = colourarray&(p%) NEXT p% DrawMode 0 PlotMode 0 Paper 0, 0: Ink 0, 7 Paper 1, 0: Ink 1, 7 DrawMask 255: TriangleMask -1 DefGWin 0, 0, 639, 479 DefTWin 0, 0, 80 \ psize% - 1, 29 ClrTWin ColourSet 0 END SUB SUB MoveTo (x%, y%) SHARED rflag% SHARED oxc&, oyc& SHARED gxc&, gyc& SHARED gx2&, gy2& SHARED gx3&, gy3& IF rflag% = 0 THEN gxc& = oxc& + x% gyc& = oyc& + y% ELSE gxc& = gxc& + x% gyc& = gyc& + y% IF gxc& < gx2& OR gxc& > gx3& OR gyc& < gy2& OR gyc& > gy3& THEN SCREEN 0: PRINT "ERROR: Graphics co-ordinates out of range." SYSTEM END IF END IF END SUB SUB Origin (x%, y%) SHARED oxc&, oyc& SHARED gx1&, gy1& SHARED gx2&, gy2& SHARED gx3&, gy3& oxc& = gx1& + x% oyc& = gy1& + y% gx2& = oxc& - 32768: gx3& = oxc& + 32767& gy2& = oyc& - 32768: gy3& = oyc& + 32767& Relative 0: MoveTo 0, 0 END SUB SUB Over (n%, m%) SHARED omode% SELECT CASE n% AND 1 CASE 0: omode% = (omode% AND 2) OR (m% AND 1) CASE 1: omode% = (omode% AND 1) OR (2 * (m% AND 1)) END SELECT END SUB SUB Paper (n%, c%) SHARED tpc% SHARED gpc% SELECT CASE n% AND 1 CASE 0: tpc% = c% AND 15 CASE 1: gpc% = c% AND 15 END SELECT END SUB SUB PlotAt (x%, y%) SHARED imode% SHARED pmode% SHARED psize% SHARED gxc&, gyc& SHARED gpc%, gic% p% = Test(x%, y%) IF p% <> -1 THEN x1% = -psize% AND gxc& y1% = 478 - (-2 AND gyc&) y2% = y1% + 1 SELECT CASE imode% AND 2 CASE 0: c% = gic% CASE 2: c% = gpc% END SELECT SELECT CASE pmode% CASE 0: CASE 1: c% = c% AND p% CASE 2: c% = c% OR p% CASE 3: c% = c% XOR p% END SELECT SELECT CASE psize% CASE 1 PSET (x1%, y1%), c% PSET (x1%, y2%), c% CASE 2 x2% = x1% + 1 PSET (x1%, y1%), c% PSET (x2%, y1%), c% PSET (x1%, y2%), c% PSET (x2%, y2%), c% CASE 4 x2% = x1% + 1 x3% = x2% + 1 x4% = x3% + 1 PSET (x1%, y1%), c% PSET (x2%, y1%), c% PSET (x3%, y1%), c% PSET (x4%, y1%), c% PSET (x1%, y2%), c% PSET (x2%, y2%), c% PSET (x3%, y2%), c% PSET (x4%, y2%), c% END SELECT END IF END SUB SUB PlotMode (m%) SHARED pmode% pmode% = m% AND 3 END SUB SUB PlotSymbol (n%, s%) SHARED rflag% SHARED imode% SHARED omode% SHARED psize% SHARED symbols%() SHARED systemarray%() DEF SEG = VARSEG(symbols%(0)) p1% = 8 * (n% AND 255) + VARPTR(symbols%(0)) FOR p2% = 0 TO 7 systemarray%(p2%) = PEEK(p1% + p2%) NEXT p2% DEF SEG IF (imode% AND 2) = 2 THEN FOR p% = 0 TO 7 systemarray%(p%) = NOT systemarray%(p%) NEXT p% END IF p% = 0 sx% = ((s% AND 2) \ 2 + 1) * psize% sy% = ((s% AND 1) + 1) * 2 ti% = imode% tr% = rflag%: rflag% = 1 MoveTo 0, 7 * sy% FOR a% = 0 TO 7 mask% = 128 FOR b% = 0 TO 7 IF (systemarray%(p%) AND mask%) = 0 THEN imode% = 2 ELSE imode% = 0 IF (imode% AND omode%) = 0 THEN SELECT CASE s% AND 3 CASE 0 PlotAt 0, 0 CASE 1 PlotAt 0, 2 PlotAt 0, -2 CASE 2 PlotAt 0, 0 PlotAt psize%, 0 MoveTo -psize%, 0 CASE 3 PlotAt 0, 2 PlotAt psize%, 0 PlotAt -psize%, -2 PlotAt psize%, 0 MoveTo -psize%, 0 END SELECT END IF MoveTo sx%, 0 mask% = mask% \ 2 NEXT b% MoveTo -8 * sx%, -sy% p% = p% + 1 NEXT a% MoveTo 0, sy% rflag% = tr% imode% = ti% END SUB SUB PlotText (t$, m%, s%) SHARED rflag% SHARED psize% ox% = XPos sy% = 16 * ((s% AND 1) + 1) tr% = rflag%: rflag% = 1 length% = LEN(t$) IF length% > 0 THEN sx% = 8 * psize% * ((s% AND 2) \ 2 + 1) FOR p% = 1 TO length% n% = ASC(MID$(t$, p%, 1)) SELECT CASE m% AND 2 CASE 0 SELECT CASE n% CASE 7 PLAY OFF PLAY "MF MN T120 O4 L4 C" CASE 8 MoveTo -sx%, 0 CASE 9 MoveTo sx%, 0 CASE 10 MoveTo 0, -sy% CASE 11 MoveTo 0, sy% CASE 12 ClrGWin CASE 13 rflag% = 0: MoveTo ox%, YPos rflag% = 1 CASE ELSE PlotSymbol n%, s% MoveTo sx%, 0 END SELECT CASE 2 PlotSymbol n%, s% MoveTo sx%, 0 END SELECT NEXT p% END IF IF (m% AND 1) = 0 THEN MoveTo 0, -sy%: rflag% = 0 MoveTo ox%, YPos END IF rflag% = tr% END SUB SUB PlotTriangle (x1%, y1%, x2%, y2%, x3%, y3%) SHARED rflag% SHARED dmode% SHARED dmsk1% SHARED dmsk2% SHARED psize% SHARED tmask% SHARED oxc&, oyc& SHARED gxc&, gyc& SHARED symbols%() SHARED systemarray%() ERASE systemarray% sx& = psize% sy& = 2& MoveTo x1%, y1% systemarray%(720) = XPos systemarray%(721) = YPos MoveTo x2%, y2% systemarray%(722) = XPos systemarray%(723) = YPos MoveTo x3%, y3% systemarray%(724) = XPos systemarray%(725) = YPos tr% = rflag%: rflag% = 0 td% = dmode%: dmode% = 0 FOR p1% = 720 TO 724 STEP 2 IF p1% < 724 THEN p3% = p1% + 2 ELSE p3% = 720 p2% = p1% + 1 p4% = p3% + 1 xc% = systemarray%(p1%) yc% = systemarray%(p2%) x1& = xc% AND -psize% y1& = yc% AND -2 x2& = systemarray%(p3%) AND -psize% y2& = systemarray%(p4%) AND -2 dx& = x2& - x1& dy& = y2& - y1& sx% = SGN(dx&) * psize% sy% = SGN(dy&) * 2 ax& = 1& + ABS(dx&) \ sx& ay& = 1& + ABS(dy&) \ sy& CalcPoint xc%, yc% IF ax& >= ay& THEN IF ax& > 1& THEN by& = ay& FOR i& = 2& TO ax& by& = by& + ay& IF by& > ax& THEN by& = by& - ax& yc% = yc% + sy% END IF xc% = xc% + sx% CalcPoint xc%, yc% NEXT i& END IF ELSE bx& = ax& FOR i& = 2& TO ay& bx& = bx& + ax& IF bx& > ay& THEN bx& = bx& - ay& xc% = xc% + sx% END IF yc% = yc% + sy% CalcPoint xc%, yc% NEXT i& END IF NEXT p1% IF (oyc& AND 1&) = 0& THEN gyc& = 478& ELSE gyc& = 479& IF tmask% = -1 THEN FOR p% = 717 TO 0 STEP -3 IF systemarray%(p%) = 2 THEN yc% = YPos MoveTo systemarray%(p% + 1), yc% DrawTo systemarray%(p% + 2), yc% END IF gyc& = gyc& - sy& NEXT p% ELSE mx& = -sx& my& = -sy& t1% = dmsk1% t2% = dmsk2% DEF SEG = VARSEG(symbols%(0)) p1% = 8 * tmask% + VARPTR(symbols%(0)) p2% = 726 FOR p3% = 0 TO 7 systemarray%(p2% + p3%) = PEEK(p1% + p3%) NEXT p3% DEF SEG p3% = (NOT ((gyc& AND my&) - (oyc& AND my&)) \ sy&) AND 7& FOR p1% = 717 TO 0 STEP -3 IF systemarray%(p1%) = 2 THEN yc% = YPos MoveTo systemarray%(p1% + 1), yc% ix% = (((gxc& AND mx&) - (oxc& AND mx&)) \ sx&) AND 7& dmsk1% = systemarray%(p2% + p3%) dmsk2% = 128 IF ix% > 0 THEN FOR i% = 1 TO ix% dmsk2% = dmsk2% \ 2 NEXT i% END IF DrawTo systemarray%(p1% + 2), yc% END IF p3% = (p3% + 1) AND 7 gyc& = gyc& - sy& NEXT p1% dmsk1% = t1% dmsk2% = t2% END IF MoveTo systemarray%(720), systemarray%(721) rflag% = tr% dmode% = td% END SUB SUB PrintCursor SHARED psize% SHARED txc%, tyc% SHARED tpc%, tic% s% = 8 * psize% x1% = s% * txc% y1% = 16 * tyc% IF POINT(x1%, y1%) <> -1 THEN x2% = x1% + s% - psize% y2% = y1% + 14 FOR ya% = y1% TO y2% STEP 2 yb% = ya% + 1 FOR xa% = x1% TO x2% STEP psize% c% = POINT(xa%, ya%) IF c% = tpc% THEN c% = tic% ELSE IF c% = tic% THEN c% = tpc% ELSE c% = c% XOR 15 END IF SELECT CASE psize% CASE 1 PSET (xa%, ya%), c% PSET (xa%, yb%), c% CASE 2 xb% = xa% + 1 PSET (xa%, ya%), c% PSET (xb%, ya%), c% PSET (xa%, yb%), c% PSET (xb%, yb%), c% CASE 4 xb% = xa% + 1 xc% = xb% + 1 xd% = xc% + 1 PSET (xa%, ya%), c% PSET (xb%, ya%), c% PSET (xc%, ya%), c% PSET (xd%, ya%), c% PSET (xa%, yb%), c% PSET (xb%, yb%), c% PSET (xc%, yb%), c% PSET (xd%, yb%), c% END SELECT NEXT xa% NEXT ya% END IF END SUB SUB PrintSymbol (n%) SHARED imode% SHARED omode% SHARED psize% SHARED txc%, tyc% SHARED tpc%, tic% SHARED symbols%() SHARED systemarray%() s% = 8 * psize% x1% = s% * txc% y1% = 16 * tyc% IF POINT(x1%, y1%) <> -1 THEN DEF SEG = VARSEG(symbols%(0)) p1% = 8 * (n% AND 255) + VARPTR(symbols%(0)) FOR p2% = 0 TO 7 systemarray%(p2%) = PEEK(p1% + p2%) NEXT p2% DEF SEG IF (imode% AND 1) = 1 THEN FOR p% = 0 TO 7 systemarray%(p%) = NOT systemarray%(p%) NEXT p% END IF p% = 0 x2% = x1% + s% - psize% y2% = y1% + 14 FOR ya% = y1% TO y2% STEP 2 m1% = 128 yb% = ya% + 1 FOR xa% = x1% TO x2% STEP psize% IF (systemarray%(p%) AND m1%) = 0 THEN c% = tpc% m2% = 1 ELSE c% = tic% m2% = 0 END IF IF (omode% AND m2%) = 0 THEN SELECT CASE psize% CASE 1 PSET (xa%, ya%), c% PSET (xa%, yb%), c% CASE 2 xb% = xa% + 1 PSET (xa%, ya%), c% PSET (xb%, ya%), c% PSET (xa%, yb%), c% PSET (xb%, yb%), c% CASE 4 xb% = xa% + 1 xc% = xb% + 1 xd% = xc% + 1 PSET (xa%, ya%), c% PSET (xb%, ya%), c% PSET (xc%, ya%), c% PSET (xd%, ya%), c% PSET (xa%, yb%), c% PSET (xb%, yb%), c% PSET (xc%, yb%), c% PSET (xd%, yb%), c% END SELECT END IF m1% = m1% \ 2 NEXT xa% p% = p% + 1 NEXT ya% END IF END SUB SUB PrintText (t$, m%) SHARED txc%, tyc% SHARED tx1%, ty1% SHARED tx2%, ty2% length% = LEN(t$) IF length% > 0 THEN FOR p% = 1 TO length% n% = ASC(MID$(t$, p%, 1)) SELECT CASE m% AND 2 CASE 0 SELECT CASE n% CASE 7 PLAY OFF PLAY "MF MN T120 O4 L4 C" CASE 8 txc% = txc% - 1 CASE 9 txc% = txc% + 1 CASE 10 tyc% = tyc% + 1 CASE 11 tyc% = tyc% - 1 CASE 12 ClrTWin CASE 13 txc% = tx1% CASE ELSE PrintSymbol n% txc% = txc% + 1 END SELECT CASE 2 PrintSymbol n% txc% = txc% + 1 END SELECT IF txc% > tx2% THEN txc% = tx1% tyc% = tyc% + 1 ELSE IF txc% < tx1% THEN txc% = tx2% tyc% = tyc% - 1 END IF END IF IF tyc% > ty2% THEN tyc% = ty2% ScrollUp ELSE IF tyc% < ty1% THEN tyc% = ty1% ScrollDown END IF END IF NEXT p% END IF IF (m% AND 1) = 0 THEN txc% = tx1% tyc% = tyc% + 1 IF tyc% > ty2% THEN tyc% = ty2% ScrollUp END IF END IF END SUB SUB Relative (r%) SHARED rflag% rflag% = r% AND 1 END SUB SUB ScrollDown SHARED sflag% SHARED imode% SHARED psize% SHARED sx1%, sy1% SHARED sx2%, sy2% SHARED tpc%, tic% SHARED systemarray%() IF sflag% = 1 THEN x1% = sx1% x2% = sx2% + (8 * psize% - 1) SELECT CASE imode% AND 1 CASE 0: c% = tpc% CASE 1: c% = tic% END SELECT IF sy1% = sy2% THEN y1% = sy1% ELSE ya% = sy1% yb% = sy2% - 16 FOR y1% = yb% TO ya% STEP -16 y2% = y1% + 15 y3% = y2% + 1 GET (x1%, y1%)-(x2%, y2%), systemarray%(0) PUT (x1%, y3%), systemarray%(0), PSET NEXT y1% y1% = ya% END IF y2% = y1% + 15 LINE (x1%, y1%)-(x2%, y2%), c%, BF END IF END SUB SUB ScrollLeft SHARED sflag% SHARED imode% SHARED psize% SHARED sx1%, sy1% SHARED sx2%, sy2% SHARED tpc%, tic% SHARED systemarray%() IF sflag% = 1 THEN y1% = sy1% y2% = sy2% + 15 SELECT CASE imode% AND 1 CASE 0: c% = tpc% CASE 1: c% = tic% END SELECT IF sx1% = sx2% THEN x1% = sx1% ELSE s% = 8 * psize% i% = s% - 1 xa% = sx1% + s% xb% = sx2% FOR x1% = xa% TO xb% STEP s% x2% = x1% + i% x3% = x1% - s% GET (x1%, y1%)-(x2%, y2%), systemarray%(0) PUT (x3%, y1%), systemarray%(0), PSET NEXT x1% x1% = xb% END IF x2% = x1% + i% LINE (x1%, y1%)-(x2%, y2%), c%, BF END IF END SUB SUB ScrollRight SHARED sflag% SHARED imode% SHARED psize% SHARED sx1%, sy1% SHARED sx2%, sy2% SHARED tpc%, tic% SHARED systemarray%() IF sflag% = 1 THEN y1% = sy1% y2% = sy2% + 15 SELECT CASE imode% AND 1 CASE 0: c% = tpc% CASE 1: c% = tic% END SELECT IF sx1% = sx2% THEN x1% = sx1% ELSE s% = 8 * psize% i% = s% - 1 xa% = sx1% xb% = sx2% - s% FOR x1% = xb% TO xa% STEP -s% x2% = x1% + i% x3% = x2% + 1 GET (x1%, y1%)-(x2%, y2%), systemarray%(0) PUT (x3%, y1%), systemarray%(0), PSET NEXT x1% x1% = xa% END IF x2% = x1% + i% LINE (x1%, y1%)-(x2%, y2%), c%, BF END IF END SUB SUB ScrollUp SHARED sflag% SHARED imode% SHARED psize% SHARED sx1%, sy1% SHARED sx2%, sy2% SHARED tpc%, tic% SHARED systemarray%() IF sflag% = 1 THEN x1% = sx1% x2% = sx2% + (8 * psize% - 1) SELECT CASE imode% AND 1 CASE 0: c% = tpc% CASE 1: c% = tic% END SELECT IF sy1% = sy2% THEN y1% = sy1% ELSE ya% = sy1% + 16 yb% = sy2% FOR y1% = ya% TO yb% STEP 16 y2% = y1% + 15 y3% = y1% - 16 GET (x1%, y1%)-(x2%, y2%), systemarray%(0) PUT (x1%, y3%), systemarray%(0), PSET NEXT y1% y1% = yb% END IF y2% = y1% + 15 LINE (x1%, y1%)-(x2%, y2%), c%, BF END IF END SUB SUB Symbol (n%, m1%, m2%, m3%, m4%, m5%, m6%, m7%, m8%) SHARED symbols%() DEF SEG = VARSEG(symbols%(0)) p% = 8 * (n% AND 255) + VARPTR(symbols%(0)) POKE p%, m1% AND 255: p% = p% + 1 POKE p%, m2% AND 255: p% = p% + 1 POKE p%, m3% AND 255: p% = p% + 1 POKE p%, m4% AND 255: p% = p% + 1 POKE p%, m5% AND 255: p% = p% + 1 POKE p%, m6% AND 255: p% = p% + 1 POKE p%, m7% AND 255: p% = p% + 1 POKE p%, m8% AND 255 DEF SEG END SUB SUB TabTo (x%) IF x% < HPos THEN PrintText "", 0 CursorTo x%, VPos END SUB FUNCTION Test% (x%, y%) SHARED gflag% SHARED gxc&, gyc& SHARED sx1&, sy1& SHARED sx2&, sy2& MoveTo x%, y% IF gflag% = 1 AND gxc& >= sx1& AND gxc& <= sx2& AND gyc& >= sy1& AND gyc& <= sy2& THEN Test% = POINT(gxc&, 479& - gyc&) ELSE Test% = -1 END IF END FUNCTION SUB TriangleMask (n%) SHARED tmask% IF n% < 0 THEN tmask% = -1 ELSE tmask% = n% AND 255 END SUB FUNCTION VPos% SHARED tyc% SHARED ty1% VPos% = tyc% - ty1% END FUNCTION FUNCTION XPos% SHARED oxc& SHARED gxc& XPos% = gxc& - oxc& END FUNCTION FUNCTION YPos% SHARED oyc& SHARED gyc& YPos% = gyc& - oyc& END FUNCTION