0001 ! Extended Parsec ... a tribute to the Eighties
0002 //
0003 ! written by Stefan Bauch and Helge Spahrbier in 2021
0004 //
0005 // See licence file for full BSD Licence
0006 //
0007 // This source code is written in Structured Extended BASIC,
0008 // a modern BASIC dialect implemented in TiCodEd.
0009 // You may download TiCodEd at www.lizardware.de for free.
0010 //
0011 // TiCodEd produces Standard Extended Basic Source for full
0012 // compatibility with the original equipment and emulators.
0013 //
0014 // Compile with Harry Wilhelm's BASIC Compiler.
0015 //
0016
0017
0018 DIM CLR(3),MOVEX$(15),MOVEY$(15),ENEMY(10),ENPATT$(8)
0019 // CLR : Colortable for Blast and Enemies
0020 // MOVEX$, MOVEY$: Flightpath of Enemies
0021 // ENEMY: Enemy existing or not (=0)
0022 // ENPATT$: Enemy graphics pattern for animation
0023
0024
0025 gosub xpinit
0026
0027 repeat
0028 gosub xpscreen
0029 gosub GameLoop
0030 gosub GameOver
0031 until 1=2 // Forever
0032 end
0033
0034 PlayerMove:
0035 CALL SYNC(3) :: IF KILLED=1 THEN RETURN
0036 RC=0 :: CALL JOYST(1,X,Y) :: CALL KEY(1,K,S) :: SPEEDX=SPEEDX+X/4+(K=2)-(K=3) :: Y=Y+4*((K=0)-(K=5)):: CALL POSITION(#10,Q1,W1) :: CALL LOCATE(#11,Q1,W1-16)
0037 IF W1<32 THEN SPEEDX=MAX(SPEEDX,0) ELSE IF W1>210 THEN SPEEDX=MIN(SPEEDX,0)
0038 IF Q1>200 THEN CALL LOCATE(#10,10,W1) :: Q1=10
0039 IF Q1<16 AND Y=4 THEN Y=0 ELSE IF Q1>136 THEN CALL SOUND(-500,-7,1)::RC=-11
0040 IF FUELCHAR<1 THEN Y=-1 :: CALL COLOR(#11,2) ELSE CALL COLOR(#11,CLR(BLASTCOL)):: IF BLASTCOL<3 THEN BLASTCOL=BLASTCOL+1 ELSE BLASTCOL=0
0041 CALL MOTION(#10,-Y*LIFT,SPEEDX,#11,-Y*LIFT,SPEEDX) :: CALL FUEL(FUELCHAR,FUELCOUNT) :: CALL SCPXLF(128,6,1) ::IF OVERHEAT>0 THEN OVERHEAT=OVERHEAT-1 :: IF OVERHEAT<6 THEN CALL COLOR(#10,MYCOLOR)
0042 IF BLAST=1 THEN CALL PATTERN(#11,100)::BLAST=0 ELSE CALL PATTERN(#11,104)::BLAST=1
0043 IF ENPATT$(2)<>"" THEN CHARCOUNT=CHARCOUNT+1 :: IF CHARCOUNT>CHARSPEED THEN CALL CHAR(108,ENPATT$(CHARIDX)):: CHARCOUNT=0::CHARIDX=CHARIDX+1 :: IF CHARIDX>7 OR ENPATT$(CHARIDX)="" THEN CHARIDX=1
0044 FOR A1=1 TO 9 :: CALL COINC(#10,#A1,10,E) :: IF E THEN RC=-A1
0045 NEXT A1 :: IF RC=-8 THEN FUELCOUNT=FUELCOUNT+20::RC=0:: CALL SOUND(-200,130,4) ELSE IF RC<0 THEN CALL SHIPEXPLODE :: KILLED=1::FUELTANK=0 :: ENEMY(8)=0
0046 IF FUELCHAR<5 THEN FUELTANK=1
0047 IF FUELTANK=0 THEN NOREFUEL
0048 IF ENEMY(8)=0 THEN CALL SPRITE(#8,116,9,134,255) :: ENEMY(8)=255 ELSE CALL LOCATE(#8,134,ENEMY(8)):: ENEMY(8)=ENEMY(8)-1
0049 IF ENEMY(8)=0 AND FUELCHAR>8 THEN FUELTANK=0 :: CALL DELSPRITE(#8)
0050 NOREFUEL:
0051 CALL KEY(2,K2,S2)
0052 IF K=18 OR K2=13 THEN PlayerFire
0053 IF K=19 THEN LIFT=1 :: CALL HCHAR(24,17,1,1)
0054 IF K=7 THEN LIFT=4 :: CALL HCHAR(24,17,2,1)
0055 IF K=8 THEN LIFT=7 :: CALL HCHAR(24,17,3,1)
0056 IF K=11 OR K2=11 THEN TimeWarp
0057 IF DISPTIME>0 THEN DISPTIME=DISPTIME-1 :: IF DISPTIME=0 THEN CALL HCHAR(20,1,124,32)
0058 CALL SYNC
0059 RETURN
0060
0061 PlayerFire:
0062 OVERHEAT=OVERHEAT+3 :: IF OVERHEAT>6 THEN CALL COLOR(#10,9) :: IF OVERHEAT>20 THEN LaserOverheated
0063 CALL POSITION(#10,Q1,W1):: Q1=Q1+14 :: Q2=INT(Q1/8) :: Q3=Q1-Q2*8 :: W2=W1/8+2:: CALL COLOR2(30,Q3+6,1)
0064 CALL HCHAR(Q2,W2,8+Q3,32-W2) :: CALL SOUND(-10,329,0) :: FOR A1=1 TO 8 :: CALL POSITION(#A1,Q3,W3):: IF Q3<Q1-4 AND Q3>Q1-18 THEN RC=A1
0065 NEXT A1 :: CALL SOUND(100,329,2) :: CALL SYNC :: CALL HCHAR(Q2,W2,32,32-W2)
0066 IF RC>0 THEN CALL EXPLODE(RC) :: ENEMY(RC)=0 :: SCORE=SCORE+POINTS :: CALL DISPSC(SCORE)::CALL DELSPRITE(#RC)
0067 IF SCORE>=NEXTSHIP THEN NEXTSHIP=NEXTSHIP+5000 :: SHIP = SHIP +1 :: CALL STATUS("extra|ship") :: DISPTIME=20 :: CALL SHIPS(SHIP) :: CALL SOUND(200,800,4)
0068 RETURN
0069
0070 LaserOverheated:
0071 RC=-12 :: CALL STATUS("laser|overheated") :: DISPTIME=10 :: CALL SHIPEXPLODE :: KILLED=1
0072 RETURN
0073
0074 TimeWarp:
0075 CALL FREEZE :: CALL STATUS("time|warp|activated")
0076 REPEAT
0077 CALL KEY(1,K,S)
0078 UNTIL S=1
0079 CALL HCHAR(20,1,124,32) :: CALL THAW
0080 RETURN
0081
0082
0083 GameLoop:
0084 REPEAT
0085 GOSUB DelEnemy :: KILLED=0
0086 GOSUB LevelInit
0087 ON Lvl GOSUB LV01, LV02, LV03, LV04, LV05, LV06, LV07, LV08, LV09, LV10, LV11, LV12, LV13, LV14, LV15, LV16, LV17, LV18, LV19, LV20, LV21, LV22, LV23, LV24, LV25, LVEND
0088 IF KILLED=0 THEN Lvl=Lvl+1 ELSE Ship=Ship-1 :: CALL Ships(Ship) :: CALL SPRITE(#10,96,3,100,56) :: CALL SPRITE(#11,100,16,100,40):: FUELCHAR = 11 :: FUELCOUNT = 0 :: FUELTANK = 0
0089 UNTIL Ship=0 OR Lvl<0
0090 RETURN
0091
0092 1000
0093 // TYPE 1: One-by-One Attack
0094 // Parameters:
0095 // AP$ 1 : Color of Enemy Missle, A for no Missle, Q for white (16)
0096 // 2-n : Index of Attack Path MOVEX$(), MOVEY$()
0097 // CL$ : Color of Enemy ASC-65
0098 LevelType1:
0099 AL=1 :: J=1 :: CALL CHAR(108,ENPATT$(1)) :: C=ASC(SEG$(AP$,1,1))-65:: GOSUB LevelIntro :: IF KILLED=1 THEN RETURN
0100 REPEAT
0101 FOR I=5 TO 1 STEP-1 :: CALL SOUND(150,530,I*2) :: GOSUB PlayerMove :: NEXT I
0102 U=ASC(SEG$(AP$,AL+1,1))-64 :: CALL SPRITE(#AL,108,ASC(SEG$(CL$,AL,1))-65,(ASC(SEG$(MOVEY$(U),1,1))-65)*8+1,(ASC(SEG$(MOVEX$(U),1,1))-65)*8+1) :: ENEMY(AL)=1 :: I=2
0103 REPEAT
0104 CALL MOTION(#AL,ASC(SEG$(MOVEY$(U),I,1))-65,ASC(SEG$(MOVEX$(U),I,1))-65) :: GOSUB PlayerMove :: GOSUB LevelType1Enemy :: GOSUB PlayerMove :: GOSUB LevelType1Enemy :: GOSUB PlayerMove :: I=I+1
0105 UNTIL I>LEN(MOVEY$(U)) OR ENEMY(AL)=0 OR KILLED=1 //# If current alien is hit abort attack
0106 AL=AL+1
0107 UNTIL AL>=LEN(AP$) OR KILLED=1
0108
0109 AL=0 :: FOR I=1 TO 5 :: IF ENEMY(I) THEN AL=AL+1
0110 NEXT I
0111 WHILE KILLED=0 AND AL>0
0112 GOSUB LevelType1Enemy
0113 GOSUB PlayerMove :: IF RC>0 THEN AL=AL-1 :: ENEMY(RC)=0
0114 WEND
0115 GOSUB DelEnemy
0116 RETURN
0117
0118
0119 LevelType1Enemy:
0120 IF ENEMY(J)=0 THEN NEXT_SHIP
0121 CALL POSITION(#J,Q,W) :: IF Q<80 THEN CALL LOCATE(#J,Q+1,W) ELSE CALL LOCATE(#J,Q-1,W)
0122 IF C=0 OR ENEMY(9)>0 THEN NEXT_SHIP
0123 CALL POSITION(#10,Q1,W1) :: IF ABS(Q-Q1)<8 AND W>W1 THEN CALL SPRITE(#9,112,C,Q,W,0,-50)::ENEMY(9)=1:: W9=255
0124 NEXT_SHIP: J=J+1 :: IF J>7 THEN J=1
0125 CALL POSITION(#9,Q2,W2) :: IF W2<32 OR W2>W9 THEN CALL DELSPRITE(#9):: ENEMY(9)=0 ELSE W9=W2
0126 RETURN
0127
0128
0129 // Type 2: Urbite, Dramite & Bynite
0130 // Parameters:
0131 // AP$ 1 : Vertical Speed
0132 // 2 : Horizontal Speed
0133 // 3 : Horizontal Speed when on same height as player
0134 // 4 : Void
0135 // 5,7,... : Starting row
0136 // 6,8,... : Starting column
0137 // special rows: !=other half of screen; #=same row as player
0138 // CL$ 1 : Color of Enemy
0139 // 2 : Color of Enemy Missle
0140 LevelType2:
0141 AL=1 :: CALL CHAR(108,ENPATT$(1))
0142 REPEAT
0143 GOSUB LevelIntro :: IF KILLED=1 THEN RETURN
0144 Q=(ASC(SEG$(AP$,AL*2+3,1))-65)*8+1 :: W=(ASC(SEG$(AP$,AL*2+4,1))-65)*8+1
0145 CALL POSITION(#10,Q1,W1):: IF Q=-239 THEN Q=Q1 ELSE IF Q=-255 THEN Q=20-100*(Q1<80)
0146 VV=ASC(SEG$(AP$,1,1))-65::VH=ASC(SEG$(AP$,2,1))-65::VS=ASC(SEG$(AP$,3,1))-65
0147 CALL SPRITE(#1,108,ASC(SEG$(CL$,1,1))-65,Q,W)
0148 REPEAT
0149 CALL POSITION(#1,Q,W,#10,Q1,W1) :: IF ABS(Q-Q1)<8 AND ENEMY(9)=0 THEN CALL SPRITE(#9,112,ASC(SEG$(CL$,2,1))-65,Q,W-16,0,-70)::ENEMY(9)=1::W9=255
0150 IF ENEMY(9)=1 THEN CALL POSITION(#9,Q2,W2) :: IF W2<40 OR W2>W9 THEN CALL DELSPRITE(#9) :: ENEMY(9)=0 ELSE W9=W2
0151 IF ABS(Q-Q1)<8 THEN CALL MOTION(#1,0,VS) ELSE CALL MOTION(#1,(Q>Q1)*2*VV+VV,VH)
0152 GOSUB PlayerMove
0153 UNTIL RC=1 OR KILLED=1
0154 WHILE ENEMY(9)=1 AND KILLED=0
0155 GOSUB PlayerMove :: CALL POSITION(#9,Q2,W2) :: IF W2<32 OR W2>W9 THEN CALL DELSPRITE(#9) :: ENEMY(9)=0 ELSE W9=W2
0156 WEND
0157 AL=AL+1:: CALL DELSPRITE(#9) :: ENEMY(9)=0
0158 UNTIL AL=6 OR KILLED=1
0159 RETURN
0160
0161 // Type 3: Asteroids
0162 // Parameters:
0163 // AP$ 1 : Vertical Speed (100 +/- RND * Val/2)
0164 // 2 : Horizontal Speed
0165 // 3 : Graphics change rate
0166 // CL$ : Color of Enemy ASC-65
0167 LevelType3:
0168 AL=1 :: I=1 :: CALL CHAR(108,ENPATT$(1))
0169 GOSUB LevelIntro :: IF KILLED=1 THEN RETURN
0170 VV=ASC(SEG$(AP$,1,1))-65::VH=ASC(SEG$(AP$,2,1))-65::CHARSPEED=ASC(SEG$(AP$,3,1))-65
0171 REPEAT
0172 IF ENEMY(I)=0 THEN ENEMY(I)=100+RND*VV-VV/2 :: CALL SPRITE(#I,108,ASC(SEG$(CL$,i,1))-65,15+i*16,255,ENEMY(I)-100,VH-RND*4)
0173 CALL POSITION(#I,Q,W) :: IF ABS(Q1-Q)<32 THEN CALL LOCATE(#I,Q+(Q1<Q)-(Q1>Q),W)
0174 IF Q<16 OR Q>120 THEN ENEMY(I)=200-ENEMY(I) :: CALL MOTION(#I,ENEMY(I)-100,VH-RND*4)
0175 I=I+1 :: IF I>7 THEN I=1
0176 AL=AL+1 :: GOSUB PlayerMove
0177 UNTIL AL=120 OR KILLED=1
0178 FOR I=1 to 7 :: IF ENEMY(I)>0 THEN CALL PATTERN(#I,120)
0179 NEXT I :: GOSUB PlayerMove :: FOR I=1 to 7 :: IF ENEMY(I)>0 THEN CALL DELSPRITE(#I)
0180 NEXT I
0181 RETURN
0182
0183
0184 RotateEnemy:
0185 CHARCOUNT=CHARCOUNT+1 :: IF CHARCOUNT>CHARSPEED THEN CALL CHAR(108,ENPATT$(CHARIDX)):: CHARCOUNT=0::CHARIDX=CHARIDX+1 :: IF CHARIDX>7 OR ENPATT$(CHARIDX)="" THEN CHARIDX=1
0186 RETURN
0187
0188 DelEnemy:
0189 FOR I=1 TO 9 :: ENEMY(I)=0 :: CALL DELSPRITE(#I):: NEXT I
0190 RETURN
0191
0192 2000
0193
0194 LV01:
0195 ENPATT$(1)=AL1$ :: AP$="AABCDE" :: GOSUB LevelType1
0196 RETURN
0197
0198 LV02:
0199 ENPATT$(1)=URB$ :: CALL CHAR(112,PHT1$) :: CL$="QK" :: AP$="KA2 !^#^Q^Q^Q^":: LT$="urbite*" :: GOSUB LevelType2
0200 RETURN
0201
0202 LV03:
0203 ENPATT$(1)=AL2$ :: AP$="AFCABD" :: GOSUB LevelType1
0204 RETURN
0205
0206 LV04:
0207 ENPATT$(1)=URB$ :: CALL CHAR(112,PHT2$) ::CL$="QQ" :: AP$="PA2 !^#^Q^Q^Q^":: LT$="dramite*" :: GOSUB LevelType2
0208 RETURN
0209
0210 LV05:
0211 ENPATT$(1)=UFO$ :: AP$="AGHIJG" :: IF RND*10<2 THEN AP$="AIJHGI"
0212 GOSUB LevelType1
0213 RETURN
0214
0215 LV06:
0216 ENPATT$(1)=URB$ :: CALL CHAR(112,PHT3$) ::CL$="QL" :: AP$="P:: !^#^Q^C^!^":: LT$="bynite*" :: GOSUB LevelType2
0217 RETURN
0218
0219 LV07:
0220 GOSUB LevelAsteroid :: AP$="A2D":: POINTS=25::LT$="caution|asteriod|belt" :: GOSUB LevelType3
0221 RETURN
0222
0223 LV08:
0224 ENPATT$(1)=KSA$ :: CALL CHAR(112,PHT4$) :: CL$="FJ" :: AP$="ZA7 #^#^#^#^#^":: LT$="" :: GOSUB LevelType2
0225 RETURN
0226
0227 LV09:
0228 ENPATT$(1)=AL1$ :: AP$="QCDABE" :: IF RND*10<2 THEN AP$="QCABDE"
0229 GOSUB LevelType1
0230 RETURN
0231
0232 LV10:
0233 ENPATT$(1)="000000030F1E0F0100010F1F0F03000000000080E0F0F0F878F8F0F0E0800000"
0234 ENPATT$(2)="000000030F1E1F3F013F1F1F0F03000000000080E0F0F0F8F8F8F0F0E0800000"
0235 ENPATT$(3)="" :: AP$="A2A":: POINTS=25 ::LT$="pacman*" :: GOSUB LevelType3
0236 RETURN
0237
0238 LV11:
0239 CALL CHAR(96,"00FCFC3F3F3F3F3F3F3F3FFCFC0000000000000000FEFEFEFE")
0240 ENPATT$(1)="CFCF3F3FFFFFFFFF3F3F0F0F3030C0C0F3F3FFFFFFFFFFFFFCFCF0F00C0C0303"
0241 ENPATT$(2)="CFCF3F3FFFFFFFFF3F3F0F0F3030C0C0F0F0FEFEFFFFFFFFFFFFF3F30C0C0303"
0242 MOVEX$(11) ="_---77-(!" :: MOVEY$(11) ="RAAA+2:AA"
0243 MOVEX$(12) ="_--7*7-(#" :: MOVEY$(12) ="RAA+##7:A"
0244 MOVEX$(13) ="_-7777777-( " :: MOVEY$(13) ="RAA%)++-9<=A"
0245 LT$="prepare|for|tombstone"
0246 CALL COLOR(#10,5) :: AP$="AKLMKL" :: MYCOLOR=5 :: CL$="DDDDD" :: GOSUB LevelType1
0247 RETURN
0248
0249 LV12:
0250 CALL CHAR(96,"0000C0F3FF3F3FFF3F3FFFF3C00000000000000000C0FCFFFCC")
0251 ENPATT$(1)="000000000000010F1FFFFF0100000000000003071C7CFFFFFCFCFFE3"
0252 MOVEX$(11) ="_!" :: MOVEY$(11) ="LA"
0253 MOVEX$(12) ="_#" :: MOVEY$(12) ="OA"
0254 MOVEX$(13) ="_ " :: MOVEY$(13) ="GA"
0255 MOVEX$(14) ="_$" :: MOVEY$(14) ="CA"
0256 MOVEX$(15) ="_!" :: MOVEY$(15) ="IA"
0257 LT$="vanguard*"
0258 CALL COLOR(#10,10) :: AP$="PKLMNO" :: MYCOLOR=10 :: CL$="FFFFF" :: GOSUB LevelType1
0259 RETURN
0260
0261 LV13:
0262 ENPATT$(1)="000F102740FF8080BFBF9F8C807F000000FE03E509F90B0BEBC9090A0CF00000"
0263 ENPATT$(2)="00000F102740FF8F9FBF9F8080807F000000FE03E509F90BCBEB89090A0CF000"
0264 ENPATT$(3)="" :: AP$="J2A":: POINTS=25 ::LT$="flying|toasters|ahead" :: GOSUB LevelType3
0265 RETURN
0266
0267 LV14:
0268 ENPATT$(1)="3F0171F9FFFFF971013F000000000000FF808083FCFC838080FF" //:: CALL CHAR(112,PHT3$)
0269 CL$="QL" :: AP$="P:: !^#^Q^C^!^":: LT$="vanguards|revenge" :: GOSUB LevelType2
0270 RETURN
0271
0272 LV15:
0273 ENPATT$(1)="003F2F777BFDFE00FEFD7B772F3F000000FCF4EEDEBF7F007FBFDEEEF4FC0000")
0274 AP$="QCDABE" :: LT$="t|fighter*" :: GOSUB LevelType1
0275 RETURN
0276
0277 LV16:
0278 ENPATT$(1)="00000007FFFF00FFFF00FFFF070000001E3EFCF8F08000FFFF0080F0F8FC3E1E" :: CALL CHAR(112,PHT4$)
0279 CL$="JG" :: AP$="P33 !^#^Q^C^!^":: LT$="atari|attacking" :: GOSUB LevelType2
0280 RETURN
0281
0282 LV17:
0283 ENPATT$(1)="00000000010F1C39E03E01000000000000007C8810FF01E2261804FF"
0284 AP$="QADFBE" :: LT$="friendly|fire" :: GOSUB LevelType1
0285 RETURN
0286
0287 LV18:
0288 ENPATT$(1)="3CFC3C30FF3030333F1F07010000000000E020E0E0E0E0F8FCFCF8F878180000"
0289 ENPATT$(2)="003CFC3C30FF3030333F1F07010000000000E626FEFEFEFEF8FCFCF8F060000000"
0290 ENPATT$(3)="" :: AP$="J2A":: POINTS=25 ::CL$="MOMOMOM"::LT$="joust*" :: GOSUB LevelType3
0291 RETURN
0292
0293 LV19:
0294 ENPATT$(1)="FFCFFFFFF0000003FFCF0F0F0C0C1C7CFCFFFFFF0F0FFFFFFFFFFFFFCF3F0000"
0295 ENPATT$(2)="00FFCFFFFFF0000003FFCF0F0F3CFC0000FCFFFFFF0F0FFFFFFFFFFFFFCF0F3F"
0296 CALL CHAR(112,"18180808081818"&RPT$("0",50))
0297 CL$="LQ" :: AP$="P:: !^#^Q^C^!^"::LT$="et|phone|home" :: GOSUB LevelType2
0298 RETURN
0299
0300 LV20:
0301 CALL CHAR(96,"0E0EC7C76363FFFF6363C7C70E0E0000000000008080FFFF808")
0302 ENPATT$(1)="00077E060F13237F7F3F1F493F00000000E000000080C3FDFEC38000C0000000"
0303 ENPATT$(2)="007E07060F13237F7F3F1F493F0000000000E0000080C3FEFDC38000C0000000"
0304 MOVEX$(11) ="_!" :: MOVEY$(11) ="LA"
0305 MOVEX$(12) ="_#" :: MOVEY$(12) ="OA"
0306 MOVEX$(13) ="_ " :: MOVEY$(13) ="GA"
0307 MOVEX$(14) ="_$" :: MOVEY$(14) ="CA"
0308 MOVEX$(15) ="_!" :: MOVEY$(15) ="IA"
0309 AP$="PKLMNO":: POINTS=25 ::CALL COLOR(#10,12) ::MYCOLOR=12::CL$="PEPEPEPE"::LT$="parsec|raid" :: GOSUB LevelType1
0310 RETURN
0311
0312 LV21:
0313 ENPATT$(1)="0001030302061F7FFF99916000000101F8FCFEFE4F4FFFFFFFFEFEFC48E8DCB8"
0314 CALL CHAR(112,"287C287C280018241444380000000000808098A404881010001")
0315 CL$="KM" :: AP$="P:: !^#^Q^C^!^":: LT$="q|bert|is|shouting|at|you" :: GOSUB LevelType2
0316 RETURN
0317
0318 LV22:
0319 ENPATT$(1)="00C0E0F87C7F3F0F3F7F070000000000183C7C7CFCF8F8F1FEFFF80000000000"
0320 ENPATT$(2)="0000000000000F3F7F07000000000000000000000000F1FEFFF8783C00000000"
0321 CALL CHAR(112,"0811122224242424242424221211080000000020404088928840402000000000")
0322
0323 MOVEX$(11)="ZAABBB6655++" :: MOVEY$(11)="AUUVVVA00MBA"
0324 MOVEX$(12)="ZEE9:60A?!!!!!!!!!!" :: MOVEY$(12)="AUUQGA49D:AAA6G6GA"
0325 MOVEX$(13)="Z@@6600++!" :: MOVEY$(13)="ATTPMMECBA"
0326 MOVEX$(14)="Z@90-))&#!!" :: MOVEY$(14)="AZa]P70+09A"
0327 MOVEX$(15)="Z<0+!!" :: MOVEY$(15)="ArhZ1A"
0328
0329 AP$="QKLMNO" :: LT$="rippana|hayabusa" :: GOSUB LevelType1
0330 RETURN
0331
0332 LV23:
0333 ENPATT$(1)="01070D1F1908080E3F2F2F272733010000C060F0302020E0F0D0D090B01080C0"
0334 CALL CHAR2(4,"00000000C0203068747A3D1E0F0300000000000000000000000000804078FC48") // remaining ships as vacuum cleaner
0335 CALL CHAR(112,PHT3$)
0336 CL$="EK" :: AP$="P:: !^#^Q^C^!^":: LT$="who|you|gonna|call" :: GOSUB LevelType2
0337 RETURN
0338
0339 LV24:
0340 ENPATT$(1)="00000C0417151F07041800000000000000006040D050F0C0403"
0341 ENPATT$(2)="00000C04070D1F17140600000000000000006040C060F0D050C"
0342 AP$="QGHIJG" :: LT$="invader*" :: GOSUB LevelType1
0343 RETURN
0344
0345 LV25:
0346 ENPATT$(1)="1F3F73E1E1733F1F03031F3FF3E30000F0F89C0E0E9CF8F08080F0F89E8E"
0347 MOVEX$(11) ="_AA!" :: MOVEY$(11) ="AUUA"
0348 MOVEX$(12) ="_AA#" :: MOVEY$(12) ="APPA"
0349 MOVEX$(13) ="_AA " :: MOVEY$(13) ="AssA"
0350 MOVEX$(14) ="_AA$" :: MOVEY$(14) ="AaaA"
0351 MOVEX$(15) ="_AAA!" :: MOVEY$(15) ="AaaaA"
0352 AP$="PKLMNO" :: LT$="defender*" :: GOSUB LevelType1
0353 RETURN
0354
0355 LVEND:
0356 CALL CHAR2(94,"")::DISPLAY AT(4,11):"THE END^" :: CALL MOTION(#10,0,0,#11,0,0)
0357 CALL POSITION(#10,Q1,W1)::CALL CHAR(108,RPT$("F",64))::CALL SPRITE(#12,108,2,137,255)
0358 for i=0 to 17
0359 for j=0 to 7
0360 CALL SCPXLF(128,6,1)
0361 CALL LOCATE(#10,MAX(Q1,i*8+j),MAX(W1,i*8+j),#11,MAX(Q1,i*8+j),MAX(W1,i*8+j)-16)
0362 CALL LOCATE(#12,137,256-i*8-j) :: CALL Delay(75)
0363 next j
0364 call hchar(19,32-i,32,1)
0365 next i
0366 CALL DELSPRITE(#12) :: CALL Delay(500)
0367 CALL CHAR(112,"",113,"",114,"",115,"") :: CALL CHAR2(94,"0038440408100010")
0368 CALL SPRITE(#8,112,16,144,152)::CALL COLOR(#11,2)
0369 FOR I=1 to 20
0370 CALL CHAR(112,"00004000604040A0") :: call Delay(100) :: CALL LOCATE(#8,144,152+i*2)
0371 CALL CHAR(112,"0000400040404040") :: CALL Delay(100) :: CALL LOCATE(#8,144,152+i*2+1)
0372 NEXT I
0373 CALL CHAR(112,"00006000F0606090")
0374
0375 WHILE Ship>1
0376 Ship=Ship-1 :: CALL Ships(Ship)
0377 Score=Score+1000 :: CALL DISPSC(Score)
0378 CALL SOUND(175,750,0) :: CALL Delay(1000)
0379 ENDWHILE
0380
0381 CALL Delay(1000)::GOSUB LevelAsteroid :: CALL CHAR(108,ENPATT$(1)):: CALL SPRITE(#1,108,9,1,188,32,0)::I=1
0382 REPEAT
0383 i=i+1 :: IF i>70 then i=1 else CALL CHAR(108,ENPATT$(i/10))
0384 CALL POSITION(#1,Q1,W1)
0385 UNTIL Q1>140
0386 CALL SPRITE(#1,108,9,142,188,0,0):: CALL DELSPRITE(#8)::CALL SOUND(100,-7,0)
0387 Lvl=-10 :: CALL CHAR2(94,"0010101010100010")
0388 RETURN
0389
0390 LevelIntro:
0391 IF LT$="" THEN RETURN ELSE IF SEG$(LT$,LEN(LT$),1)="*" THEN LT$=SEG$(LT$,1,LEN(LT$)-1)&"|ships|attacking"
0392 WHILE DISPTIME>0
0393 GOSUB PlayerMove :: DISPTIME=DISPTIME-1
0394 WEND
0395 FOR I=1 TO 3 :: CALL STATUS(LT$) :: CALL SOUND(40,230,0):: GOSUB PlayerMove :: CALL SOUND(60,231,4)
0396 CALL HCHAR(20,1,124,32):: GOSUB PlayerMove :: CALL SOUND(80,234,8) :: GOSUB PlayerMove:: NEXT I
0397 CALL STATUS(LT$) :: DISPTIME = 20
0398 RETURN
0399
0400 LevelInit:
0401 // Reset graphics (may be changed in prev. level)
0402 CALL CHAR(96,"3E1108FF804724081041FE0000000000000080F0188C077C80") // Own Ship
0403 CALL CHAR(100,"000000000000010200000000000000000000000000042092240000000000") // Blast 1
0404 CALL CHAR(104,"0000000000000201000000000000000000000000000A51A40A0000000000") // Blast 2
0405 CALL CHAR(116,"00001F78C0B5A5B5A5A7C0781F0814220000F80E03694969496D031EF8102844") // Fuel
0406 CALL CHAR2(4,"00000000003E1108FF804724081041FE0000000000000080F0188C077C80") // Own Ship in blue
0407 CALL CHAR2(128,"0000001B73FE9FFF0080C0687CB7FBFF000000010382C7FF0030C87663B7DBFF000040A1F6ADBF6F00001434F677BDFF") // Ground
0408 CALL CHAR(112,"000000000000FC"&RPT$("0",50)) :: CALL COLOR(#10,3) // Alien Missile, Ship Color
0409 // Reset Enemy-Pattern 2-8, 1 to default ship
0410 FOR I=2 TO 8 :: ENPATT$(I)="" :: NEXT I :: CHARIDX=1 :: CHARCOUNT=0 :: CHARSPEED=1 :: ENPATT$(1)=AL1$
0411 // Reset refueling
0412 ENEMY(8)=0 :: FUELTANK=0
0413 // Default Level-Text, 100 Points per alien, own color 3, Color-Sequence for Aliens index of CL(), clear message-line
0414 LT$="alien|craft|advancing" :: POINTS=100 :: MYCOLOR=3 :: CL$="DKGOLQF" :: OVERHEAT=0 :: CALL HCHAR(20,1,124,32)
0415 RETURN
0416
0417 LevelAsteroid:
0418 ENPATT$(1)="070D191032434964504C23100C0700000000E030501098CC1272941CF"
0419 ENPATT$(2)="0000010D1210121410181C13110D03000000F008104844CC9A126484186"
0420 ENPATT$(3)="00000001020509181F10100E07000000000000F02804E4063EE2020CF"
0421 ENPATT$(4)="00000000031C382E212018070000000000000070888C5262828C90E"
0422 ENPATT$(5)="0000000007182F2524150E000000000000000000E01078C4042CD8"
0423 ENPATT$(6)="00000000000F18282F28311E0000000000000000E05844C43C0428F"
0424 ENPATT$(7)="000000000304041D161414181108070000000000789412729A06024438C08"
0425 ENPATT$(8)="000000000304041D161414181108070000000000789412729A06024438C08"
0426 RETURN
0427
0428 xpinit:
0429 CALL SCREEN(2) :: CALL CLEAR :: CALL DELSPRITE(ALL) :: CALL MAGNIFY(3)
0430 FOR I=1 to 14 :: CALL COLOR(I,8,1) :: NEXT I
0431 CALL CHAR(64,"3C4299A1A199423C")
0432
0433 DISPLAY AT(6,2):"Extended" :: DISPLAY AT(8,8):" P A R S E C "
0434 DISPLAY AT(20,4)BEEP:"PRESS ANY KEY TO BEGIN" :: CALL DISPLY(23,2,"@2021 by S.Bauch & H.Spahrbier")
0435 DISPLAY AT(24,8):"Version 1.0.1"
0436
0437 repeat
0438 CALL KEY(3,K,S)
0439 until s<>0
0440 Lvl=1
0441 #IF K>64 AND K<91 THEN Lvl=K-64 // for debugging: A=Level 1, B = 2, ...
0442
0443 CALL SCRN2 :: CALL SCREEN2(2) :: CALL COLOR2(81,11,1) //# Yellow on Black
0444 CALL COLOR2(3,16,1,4,16,1) //# White digits
0445 CALL COLOR2(5,8,1,6,8,1,7,8,1,8,8,1) //# light blue upper case letters
0446 CALL COLOR2(9,1,11,10,1,11,11,1,11,12,1,11) //# black on yellow lower case letters
0447 CALL COLOR2(29,8,1,30,4,1,31,16,9) //# light blue ships and lift & Lift digits; Laser; Red/White Fuel
0448
0449 CALL CHAR2(123,"00FFFFFFFFFFFFFF",124,"",91,"00C0C0FFFFC0C000000000FFFF000000180C06FFFF060C18") // Arrow
0450 CALL CHAR2(8,"FF",9,"00FF",10,"0000FF",11,"000000FF") // Laser
0451 CALL CHAR2(12,"00000000FF",13,"0000000000FF",14,"000000000000FF0000000000000000FFFF000000000000FF")
0452 CALL CHAR2(58,"01010101010101018080808080808080FF000000000000FF") //# Left, Right, Empty Fuel Char
0453
0454 AL1$="000001023FFF020700000000000000007F82007F820408F000" :: UFO$="0F1F357F3F0012040400000000000000E0F058FCF80050A080"
0455 AL2$="000000010EFF080000000000000000000F1E7CF870F0F87C1E0F" :: URB$="0003040F101F351F100F0403000000003CC404FF02FFA4FF02FF04C43C"
0456 KSA$="000003047F20103FFF10207F000000000000FF01D2265ADADA267F"
0457 PHT1$="00005500000000000000005500000000000055000000000000000055" :: PHT2$="00000000000000FFFF0000000000000000000000000000FFFF"
0458 PHT3$="000000001449904A802400000000000000000000004015884" :: PHT4$="0000000000002070F9702000000000000000000000000080CD8"
0459
0460 // Sprite number / character assignments
0461 // #1-7 : Enemy ; 108
0462 // #8 : Fuel Tank ; 116
0463 // #9 : Enemy Missle ; 112
0464 // #10: Own Ship ; 96
0465 // #11: Jet-Blast ; 100 & 104
0466 // #12-32 : Stars ; 142
0467
0468 CALL CHAR(108,AL1$) :: GOSUB LevelInit
0469 CALL CHAR(120,"0042001081000420000012004001200440000800011000048000210008002002") // Explosion
0470 CALL CHAR2(1,"0010301010101038003844040810207C0038440418044438") //# Numbers 1,2,3 in blue for Lift
0471
0472 // Flight-Path
0473 // Values are encoded in printable characters
0474 // --> Motion = ASC(char) - 65
0475 // 1. Char: Start-Position A=1, B=9, ... Z=201, h=313
0476 // 2-n. Char: Motion A=0, !=-32, Z=25, z=57
0477 // i.e.: 'ZAK' -> Pos 201, Movement 0, then 10
0478 // Flight paths A-F
0479 MOVEX$(1)="ZAABBB6655++" :: MOVEY$(1)="AUUVVVA00MBA"
0480 MOVEX$(2)="ZEE9:60AJK?!!!!!!!!!!" :: MOVEY$(2)="AaaQGA493AD:AAA6G6GA"
0481 MOVEX$(3)="Z@@6600++!" :: MOVEY$(3)="AYYWQQECBA"
0482 MOVEX$(4)="Z@90-))&#!!" :: MOVEY$(4)="AahcT70+& A"
0483 MOVEX$(5)="Z<0+MTb!!" :: MOVEY$(5)="ArhZ<401A"
0484 MOVEX$(6)="Z#9HHHWW!!" :: MOVEY$(6)="Annr89#!!A"
0485 // UFO G-J
0486 MOVEX$(7) ="AzzpaA-!!!" :: MOVEY$(7) ="LAA909AAA"
0487 MOVEX$(8) ="AtrpaQA-!!!" :: MOVEY$(8) ="IAAA909AAA"
0488 MOVEX$(9) ="AzzpaA-)&#" :: MOVEY$(9) ="GAA909AAA"
0489 MOVEX$(10)="AtrpaQA-!!!" :: MOVEY$(10)="OAAA909AAA"
0490 // K-O user defined paths
0491
0492 // Color of Blasts 0-3; Alien 4-9
0493 CLR(0) = 3 :: CLR(1) = 8:: CLR(2) = 12 :: CLR(3) = 16
0494 return
0495
0496 xpscreen:
0497 CALL CLEAR :: CALL DELSPRITE(ALL)
0498 CALL HCHAR(20,1,124,32) :: CALL HCHAR(21,1,123,32) :: DISPLAY AT(24,10):"LIFT 3 TOP" :: CALL DISPHISC(HISCORE)::CALL HCHAR(24,17,3,1)
0499 CALL Ships(5) :: CALL SPRITE(#10,96,3,100,56) :: CALL SPRITE(#11,100,16,100,40) :: DISPLAY AT(22,1):"FUEL:<<<<<<<<<<; [\] 000000";
0500 LIFT=7 :: SPEEDX=0 :: SHIP=5 :: NEXTSHIP=2000 :: FUELCHAR = 11 :: FUELCOUNT = 0 :: CALL FUEL(FUELCHAR,FUELCOUNT)
0501 C=1 :: FOR I=1 TO 32 :: CALL HCHAR(19,i,127+C):: C=-(C<6)*C+1 :: NEXT I
0502 CALL CHAR(142,"1") :: FOR I=12 TO 28 :: CALL SPRITE(#I,142,RND*13+3,RND*125+1,RND*250+1,0,-RND*5-3) :: NEXT I
0503
0504 I=49
0505 repeat
0506 IF i=35 THEN CALL HCHAR(20,1,124,32)
0507 IF i=50 THEN CALL DISPLY(20,7,"press|fire|to|begin") :: I=1 :: CALL SOUND(200,800,4)
0508 i=i+1 :: FUELCOUNT=FUELCOUNT+1 :: GOSUB PlayerMove
0509 until OVERHEAT>0 OR RC<0 OR HISCORE>0
0510 return
0511
0512 GameOver:
0513 DISPLAY AT(12,10):"GAME OVER"
0514 IF SCORE>HISCORE THEN HISCORE=SCORE :: CALL DISPHISC(HISCORE)
0515 CALL DISPLY(20,5,"press|any|key|to|restart") :: KILLED=0
0516 repeat
0517 IF Lvl>0 THEN GOSUB PlayerMove
0518 CALL KEY(3,K,S) :: CALL KEY(1,X,Y)
0519 until s<>0 OR Y<>0
0520 Lvl=1 :: SCORE=0
0521 return
0522
0523
0524 SUB Ships(a)
0525 CALL HCHAR(23,1,32,10) :: CALL HCHAR(24,1,32,10)
0526 FOR I=1 to MIN(a*2-2,8) STEP 2 :: CALL HCHAR(23,2+I,4)::CALL HCHAR(24,2+I,5)::CALL HCHAR(23,3+I,6)::CALL HCHAR(24,3+I,7)::NEXT I
0527 SUBEND
0528
0529 SUB FUEL(FUELCHAR,FUELCOUNT)
0530 IF FUELCOUNT > 100 THEN FUELCOUNT=FUELCOUNT-100 :: FUELCHAR=FUELCHAR+1 ELSE FUELCOUNT=FUELCOUNT-1 :: IF FUELCOUNT>0 THEN SUBEXIT
0531 IF FUELCOUNT<0 THEN FUELCOUNT=100 :: FUELCHAR=FUELCHAR-1
0532 IF FUELCHAR>10 THEN FUELCHAR=10
0533 CALL HCHAR(22,8,60,10) :: IF FUELCHAR>0 THEN CALL HCHAR(22,8,16,FUELCHAR)
0534 SUBEND
0535
0536 SUB EXPLODE(N)
0537 CALL POSITION(#10,Q,W):: IF Q<24 THEN CALL MOTION(#10,0,0,#11,0,0) // Stop ship if far up
0538 //CALL PATTERN(#N,120) :: CALL MOTION(#N,0,0):: FOR I=4 TO 12 :: CALL SOUND(30,-7,i-4)::CALL COLOR(#N,I):: NEXT I :: CALL DELSPRITE(#N)
0539 CALL PATTERN(#N,120) :: CALL COLOR(#N,16) :: CALL MOTION(#N,0,0):: CALL SOUND(240,-7,2)
0540 SUBEND
0541
0542 SUB SHIPEXPLODE
0543 CALL POSITION(#10,Q1,W1) :: CALL DELSPRITE(#10,#11,#9)
0544 CALL SPRITE(#1,120,16,Q1,W1,-3,0,#2,120,16,Q1,W1,-3,3,#3,120,16,Q1,W1,0,3,#4,120,16,Q1,W1,3,3)
0545 CALL SPRITE(#5,120,16,Q1,W1,3,0,#6,120,16,Q1,W1,3,-3,#7,120,16,Q1,W1,0,-3,#8,120,16,Q1,W1,-3,-3)
0546 FOR I=1 TO 15 :: CALL SOUND(60,-7,i) :: NEXT I :: CALL DELSPRITE(#1,#2,#3,#4,#5,#6,#7,#8,#9)
0547 SUBEND
0548
0549 SUB STATUS(A$)
0550 CALL HCHAR(20,1,124,32) :: CALL DISPLY(20,16-LEN(A$)/2,A$)
0551 SUBEND
0552
0553 SUB DISPSC(SCORE)
0554 SCORE$=STR$(SCORE) :: SCORE$=RPT$("0",6-LEN(SCORE$))&SCORE$ :: CALL DISPLY(22,24,SCORE$)
0555 SUBEND
0556
0557 SUB DISPHISC(HISCORE)
0558 SCORE$=STR$(HISCORE) :: SCORE$=RPT$("0",6-LEN(SCORE$))&SCORE$ :: CALL DISPLY(24,24,SCORE$)
0559 SUBEND
0560
0561
0562