! Asteroids ! PR April 84 ! Modified August 84 ! Modified IMN October 85 %control 0 %begin %include "Inc:Maths.Imp" %include "Inc:Util.Imp" %include "games:Graph.Inc" %include "games:Crypt.Inc" %include "games:Stuff.Inc" %include "games:Random.Inc" @16_01108 %integerfn FCOMM(%integer cn,%string(255)s) @16_01110 %integerfn FCOMMR(%integer c,%string(255)p,%bytename b,%integer max) %conststring (255) Version = "Version 4.4" %constinteger Refresh Rate = 75 %constbyte Ctrl Y Abort = 0, ESC Abort = 11, Time Out = 12, ESC = 27, DEL = 127, CR = 13, Clear Screen = 'v', Dim = '4', Bright = '3', Graphics On = 'F', Graphics Off = 'G', Position Cursor = 'Y', Background = Black, Star Colour = White, Ship Colour = Cyan, Ast Colour = Red, Saucer Colour = White, Bullet Colour = White, Thrust Colour = Yellow, Score Colour = Green, Title Colour = Cyan, Lower Colour = Red, Higher Colour = Red, True = 1, False = 0 %constreal Inc = 1.9 %byte Decel, Num Aiming, ShRel, NumRel %string (255) User %constbyte Big Asts = 10, Max Asts = Big Asts * 4, ShTop = 7, NumTop = 5, AVS = 7, MaxB = 30, MaxP = 13, Decel Value = 10, Angle = 5 %constshort ShAn = 360//Angle, MaxAA = 6, MinAA = -MaxAA %constshort BVS = 19, Bullet LifeTime = 260//BVS %constshort Big = 0, Mid = 1, Wee = 2, BigS = 3, WeeS = 4, ShTemp = 5, Sh = 6, ThrTemp = 7, Thr = 8 %constinteger Ast Addr = 16_850000, Bul Addr = Ast Addr + Max Asts * 4 %record %format SHT (%shortarray P (1:MaxP, 1:2)) %record (SHT) %array Shape (Big:Thr) %record %format Object (%short X, Y, Type, VX, VY, A, N, Rad, Rsq, %integer P, Q, Value) %record (Object) %array OA (1:Max Asts) @AstAddr %record (Object) %name %array A (1:Max Asts) %record (Object) Ship, Thrust, BigSau, WeeSau %record (Object) %name Saucer, Ast, Shp, Tht %record %format BType (%short X, Y, Type, VX, VY, Time) %record (BType) %array OB (1:MaxB) @BulAddr %record (BType) %name %array B (1:MaxB) %record (BType) %name B1,B2 %short %name BT %constbyte Exps = 9, Pts = 12 %constreal Incr = 2 * PI / Pts %constbytearray Dst (1:Exps) = 13, 23, 33, 42, 50, 56, 62, 66, 69 %real Ang %constbytearray Col (1:Exps) = White(2), Yellow(2), Red(*) %real An %realarray CEA,SEA (1: Pts) %real %array CSA,SSA (0:ShAn) %ownshortarray S (Big:Thr, 1:MaxP, 1:2)= {Big} 4,18, 14,20, 22,8, 16,-4, 22,-8, 18,-16, 12,-14, 2,-20, -22,-14, -18,-6, -22,-4, -14,24, 4,18, {Mid} 8,10, 10,2, 14,0, 12,-6, 6,-6, 0,-12, -10,-6, -8,-2, -10,4, -4,12, 8,10, 0(2*(MaxP-11)), {Wee} 4,4, 6,0, 2,-4, -2,-3, -4,2, -2,6, 4,4, 0(2*(MaxP-7)), {BigS} 8,0, -8,0, -6,8, 6,8, 8,0, 20,0, 12,-8, 4,-10, -4,-10, -12,-8, -20,0, -8,0, 0(2*(MaxP-12)), {WeeS} 3,0, -3,0, -2,3, 2,3, 3,0, 7,0, 4,-3, 1,-4, -1,-4, -4,-3, -7,0, -3,0, 0(2*(MaxP-12)), {ShTemp} 0,20, 10,-10, -10,-10, 0,20, 0(2*(MaxP-4)), {Sh} 0,20, 10,-10, -10,-10, 0,20, 0(2*(MaxP-4)), {ThrTemp} 0,-10, 1,-13, 0,-16, -1,-13, 0,-10, 0(2*(MaxP-5)), {Thr} 0,-10, 1,-13, 0,-16, -1,-13, 0,-10, 0(2*(MaxP-5)) %constintegerarray Value (Big:WeeS) = 20, 40, 60, 100, 500 %constbytearray N (Big:Thr) = 12, 10, 6, 11, 11, 3, 3, 4, 4 %constrealarray SCF (Big:Thr) = 1, 1, 1, 0.8, 1, 0.8, 0.8, 0.8, 0.8 %ownshortarray Radius (Big:Thr) = 27, 15, 8, 18, 8, 10, 10, 10, 10 %shortarray RSq (Big:Thr) %short %array %name RdA (Big:Thr) %short %array %name RsA (Big:Thr) %constbyte Max Stars = 100, Star Velocity = 3 %shortarray Star (1:Max Stars,1:2) %integer StB,StT %constbyte Time for SauBul = 10 %constbytearray Ast Num (1:ShTop) = 6(3), 7, 8, 10(*) %constshortarray SType (1:ShTop,0:NumTop) = BigS (4), WeeS (NumTop-3), BigS (3), WeeS (NumTop-2), BigS (3), WeeS (NumTop-2), BigS (2), WeeS (NumTop-1), BigS (2), WeeS (NumTop-1), BigS (2), WeeS (NumTop-1), BigS (1), WeeS (NumTop-0) %constintegerarray Delay (1:ShTop,0:NumTop) = 450, 150, 100, 100, 90, 90, 400, 150, 100, 100, 90, 90, 350, 150, 100, 100, 90, 80, 300, 200, 150, 150, 90, 80, 200, 200, 200, 100, 90, 80, 200, 200, 200, 100, 90, 80, 200, 200, 150, 100, 90, 80 %integer i,j,k %integer BigSaAddr, WeeSaAddr, BNA, Num Games %integer DTemp1 %short DTemp2 %short SV,SDX,SDY %conststring(9) OverStr = "GAME OVER" %bytearray Over (1:9) %constbytearray SCl (0:5) = Red,Yellow,Green,Cyan,Blue,Magenta %constbyte Alive = 1, Dying = 2, Dead = 3, Max Men = 9, Start Men = 5, Ast Trigger = 20, Ship Trigger = 3 %constshort BulAllowed = 4, PMins = 3, Pause = 60 * PMins, Border = 27, Top = 512 - Border, Bottom = Border, Height = Top - Bottom, Right = 687 - Border, Left = Border, Width = Right - Left %short SSn, SCs, AA %short X,Y,Z,XX,YY,ZZ,XP,YP, Draw Screen, Fired, Saucer Origin %byte MB, Corrupted, Need a New Copy, Num Saucers, Ship State, Ship Allowed, Num Asts, Score Altered, Saucer State, Sheet, Men Left, NumBul, Thrusting, Saucer Death, Ship Death, Wait Time, Saucer Time, Scaling, Ast Wait %constinteger BInc = 2 %integer BB, Score, Next Score, Saucer Appears, Clock, Tick %constreal HPi = Pi/2, Rads = Angle * Pi / 180 %label DBE,DBL1,DBL2,DBL3,DBL4, End of Program,Restart !%label Skipped %label Hold %label No Key, Firing, Clear Loop, LNone, LRight, Decelerate, No Inc %label No Thrust, LNext, RotShip %label Dec1, Dec2, Dec3 %label Notal, ShCont, ShDead, MLoopEnd, ILoopEnd, Hyper %on %event Ctrl Y Abort, ESC Abort, Time Out %start PrintSymbol (ESC); PrintSymbol ('v') %if Event_Event = Time Out %then Printstring ("Program Timed Out") %elsec %if Event_Event = Esc Abort %then Printstring ("Escape Abort") %elsec Printstring ("Ctrl-Y Abort") Newlines (2) *Bra End of Program %finish %routine Screen Op (%integer Mode) Print Symbol (ESC) Print Symbol (Mode) %end %routine Goto (%integer X, Y) Screen Op (Position Cursor) Print Symbol (32+Y) Print Symbol (32+X) %end %string (255) %fn Current Directory %string (255) Me %integer I = 1 Length (Me) = Fcommr ('F'<<8, "", Charno (Me, 1), 255) I = I + 1 %while Charno (Me, I) # ' ' Length (Me) = I - 1 %result = String (Addr (Me)) %end %string (255) %fn Current User %string (7) This Dir, This User %integer I %on 3,4,9 %start %result = "" %finish This Dir = Current Directory I = Fcomm ('J'<<8,"") This User = Current Directory I = Fcomm ('J'<<8, This dir) %result = String (Addr (This User)) %end %routine Rotate (%record (Object) %name O, %short A) %ownbyte i %shortarrayname A1,A2 (1:MaxP,1:2) %ownreal Sn,Cs O_A = Rem(O_A + A,ShAn) %if O_A < 0 %then O_A = O_A + ShAn A1 == Shape(O_Type)_P; A2 == Shape(O_Type-1)_P Cs = CSA (O_A) Sn = SSA (O_A) %for i = 1,1,O_N + 1 %cycle A1(i,1) = Int ( Cs * A2(i,1) + Sn * A2(i,2)) A1(i,2) = Int ( -Sn * A2(i,1) + Cs * A2(i,2)) %repeat %end %routine At Draw (%byte T,%short X, Y) %owninteger temp2 %ownshort px,py,ppx,ppy,temp1 temp1 = N(T) temp2 = Addr(Shape(T)_P) *Move.w Temp1,d0 *Subq.w #1,d0 *Move.l temp2,a1 *Move.w (a1)+,d1 *Add.w X,d1 *Move.w d1,px *Move.w (a1)+,d1 *Add.w Y,d1 *Move.w d1,py AtDLoop: *Move.w d0,temp1 *Move.w (a1)+,d1 *Add.w X,d1 *Move.w d1,ppx *Move.w (a1)+,d1 *Add.w Y,d1 *Move.w d1,ppy *Move.l a1,temp2 Line (px,py,ppx,ppy) *Move.w ppx,px *Move.w ppy,py *Move.l temp2,a1 *Move.w temp1,d0 *Dbra d0, AtDLoop %end %routine Draw (%record (Object) %name O) %ownshort px,py,ppx,ppy,temp1 %owninteger temp2 %label L1,L2,L3,L4 *Move.l O,a0 *Move.w 6(a0),d0 *extl d0 *add.w (a0),d0 *Cmp.w #Right,d0 *Blt L1 *Sub.w #Width,d0 *Bra L2 L1: *Cmp.w #Left,d0 *Bge L2 *Add.w #Width,d0 L2: *Move.w d0,(a0) *Move.w 8(a0),d0 *extl d0 *add.w 2(a0),d0 *Cmp.w #Top,d0 *Ble L3 *Sub.w #Height,d0 *Bra L4 L3: *Cmp.w #Bottom,d0 *Bge L4 *Add.w #Height,d0 L4: *Move.w d0,2(a0) *Move.w 12(a0),d0 *Subq.w #1,d0 *Move.l 18(a0),a1 *Move.w (a1)+,d1 *Add.w (a0),d1 *Move.w d1,px *Move.w (a1)+,d1 *Add.w 2(a0),d1 *Add.w Draw Screen,d1 *Move.w d1,py DLoop: *Move.w d0,temp1 *Move.w (a1)+,d1 *Add.w (a0),d1 *Move.w d1,ppx *Move.w (a1)+,d1 *Add.w 2(a0),d1 *Add.w Draw Screen,d1 *Move.w d1,ppy *Move.l a1,temp2 Line (px,py,ppx,ppy) *Move.w ppx,px *Move.w ppy,py *Move.l O,a0 *Move.l temp2,a1 *Move.w temp1,d0 *Dbra d0, DLoop %end {*** SCORES STUFF ***} %routine Show Number (%integer N) %integer p10 Show Symbol ('0') %and %return %if N <= 0 %if N < 10 %then p10 = 1 %else p10 = 10 ^^ Int Pt (Log Ten (N)) %cycle Show Symbol (N//p10 + '0') N = Rem (n,p10) p10 = p10//10 %repeat %until p10 = 0 %end %routine Draw Scores Etc %label No Inc, No Draw, Draw Max *Move.b #Score Colour, Colour Reg *Move.l #200,XPos *Move.w Draw Screen,d0 *Addi.w #492,d0 *extl d0 *Move.l d0,YPos Show String ("Sheet: ") Show Number (Sheet) *Move.l #300,XPos Show String ("Score: ") Show Number (Score) *Tst.b Score Altered *Beq No Inc *Move.l Next Score, d0 *Cmp.l Score, d0 *Bgt No Inc *Clr.b Score Altered *Addi.l #5000, Next Score *Addq.b #1, Men Left No Inc: *Tst.b Men Left *Beq No Draw *Cmpi.b #Max Men, Men Left *Bgt Draw Max *Move.b #Ship Colour, Colour Reg At Draw (ShTemp, 450 + 25 * i, Top + Draw Screen) %for i = 1,1,Men Left No Draw: %return Draw Max: At Draw (ShTemp, 450 + 25 * i, Top + Draw Screen) %for i = 1,1,Max Men %end {*** END OF SCORES ***} %routine Break up Asteroid (%byte i) %ownshort Type %ownreal XX, YY %record (Object) %name A1, A2 A1 == A(i) Type = A1_Type Score = Score + A1_Value Score Altered = True %if Type = Wee %start A(i) == A(Num Asts) %and A(Num Asts) == A1 %if i < Num Asts Num Asts = Num Asts - 1 Saucer Appears = Clock + 1000 %if Num Asts = 0 %else Type = Type + 1 A1_Type = Type A1_Value = Value (Type) A1_N = N(Type); A1_Rad = Radius (Type); A1_Rsq = Rsq (Type) A1_P = Addr(Shape(Type)_P) Num Asts = Num Asts + 1 A2 == A(Num Asts) A2_Type = Type; A2_X = A1_X; A2_Y = A1_Y A2_N = A1_N; A2_Rad = A1_Rad; A2_Rsq = A1_Rsq A2_P = A1_P; A2_Value = A1_Value XX = A1_VX * Random Real (0.3, 0.9) + Random Real (-3.5, 3.5) YY = A1_VY * Random Real (0.9, 1.3) + Random Real (-3.5, 3.5) A2_VX = Int(A1_VX * Random Real (0.9, 1.3) - XX) A2_VY = Int(A1_VY * Random Real (0.3, 0.9) - YY) A1_VX = Int(XX); A1_VY = Int(YY) %finish %end %routine Saucer Bullet %ownshort ShX, ShY, SaX, SaY,XX,YY %ownreal D *Addq.b #1,NumBul B1 == B(NumBul) %if Saucer == BigSau %start B1_VX = Int (Random Real (-BVS,BVS)) B1_VY = Int (Sqrt (BVS*BVS-B1_VX*B1_VX)) B1_VY = -B1_VY %if Random Int (-10, 10) < 0 %else XX = Ship_X - Saucer_X YY = Ship_Y - Saucer_Y D = Sqrt (XX * XX + YY * YY)/BVS B1_VX = Int(XX/D) B1_VY = Int(YY/D) %finish B1_X = Saucer_X B1_Y = Saucer_Y B1_Time = 0 B1_Type = Saucer_Type *Addq.l #4,BNA %end %routine Explode (%bytename Turn, %shortname CX, CY, %short T) %ownreal D %ownreal II %ownshort XP, YP Colour Reg = Col(Turn) II = Random Real (0.3,1.5) %if Turn = T %for i = 1,1,Pts %cycle D = Dst(Turn) * II + Random Real (5,20) XP = CX + Int (D * CEA(i)) YP = CY + Int (D * SEA(i)) XP = XP - Width %if XP > Right; XP = XP + Width %if XP < Left YP = YP + Height %if YP < Bottom; YP = YP - Height %if YP > Top YP = YP + Draw Screen %if Turn < 4 %then Fill (XP-1,YP-1,XP+1,YP+1) %c %elseif Turn < 7 %then Fill (XP,YP,XP+1,YP+1) %c %else Plot (XP,YP) Ang = Ang + Incr %repeat %end %routine Set up Asteroids (%byte Num) %record (Object) %name As %ownshort R %ownreal An %ownbyte i %for i = 1,1,Num %cycle As == A(i) As_Type = Big As_Value = Value(Big) As_N = N(Big); As_Rad = Radius (Big); As_Rsq = Rsq (Big) As_P = Addr(Shape (Big)_P) As_X = Random Int (Left, Right) %if Random Int (Bottom, Top) > 256 %then As_Y = Bottom %else As_Y = Top %if i > Num Aiming %start R = Random Int (-AVS,AVS) As_VX = Int(R * Random Real (0.7,1.2)) R = Int (Sqrt(AVS*AVS-R*R)) R = -R %if Random Int (-100,100) < 0 As_VY = Int(R * Random Real (0.7,1.2)) %else XX = Ship_X - As_X YY = Ship_Y - As_Y An = Sqrt (XX*XX+YY*YY)/AVS As_VX = Int (XX/An) As_VY = Int (YY/An) %finish %repeat %end %routine Update Situation %short s, s2, s3 %byte i,j %label N1,N4,N5, Start Up, Erase Bullet, Delete, L1, Bul Al, Not Hit, Saucer Not Hit, Saucer Dead, Is Dead, Bang, End Up, Got Max, Mak Wee, Contn *Bra Start Up Impact: *Move.w (a1),d0 *Sub.w (a0),d0 *Muls d0,d0 *Move.w 2(a1),d1 *Sub.w 2(a0),d1 *Muls d1,d1 *Add.l d1,d0 *Move.w 14(a1),d1 *Add.w 14(a0),d1 *Muls d1,d1 *Cmp.l d1,d0 *Blt Bang *Clr.b d0 *Rts Bang: *Move.b #True,d0 *Clr.b Ship Allowed *Cmpi.b #Dead, Ship State *Beq Is Dead *Move.b #Dying,Ship State Is Dead: *Rts Strike: *Move.w (a0),d0 *Sub.w (a1),d0 *Muls d0,d0 *Move.w 2(a0),d1 *Sub.w 2(a1),d1 *Muls d1,d1 *Add.l d1,d0 *Move.w 16(a0),d1 *Extl d1 *Cmp.l d1,d0 *Blt Delete *Clr.b d0 *Rts Delete: *Cmpa.l BNA,a2 *Bgt Erase Bullet *Move.l BNA,a0 *Subq.l #4, a2 *Move.l (a2),DTemp1 *Move.l (a0),(a2) *Move.l DTemp1,(a0) Erase Bullet: *Subq.l #4, BNA *Subq.b #1, NumBul *Move.b #True,d0 *Rts Start Up: *Cmpi.b #Dead, Saucer State *Bne N1 *Move.l Saucer Appears, d0 *Cmp.l Clock, d0 *Bgt N1 *Move.b #Alive, Saucer State xx = SType (ShRel,Num Saucers) *Cmpi.b #NumTop, Num Saucers *Bge Got Max *Addq.b #1, Num Saucers Got Max: Saucer Appears = Saucer Appears + Delay (ShRel, Num Saucers) s2 = Random Int (Bottom, Top) s3 = Random Int (1,10000) *Cmpi.w #BigS,xx *Bne Mak Wee *Move.l BigSaAddr,Saucer *Bra Contn Mak Wee: *Move.l WeeSaAddr,Saucer Contn: *Move.l Saucer, a1 *cmpi.w #5000,s3 *Ble N4 *Move.w #Left, Saucer Origin *Move.w #Left, (a1) {** X = Left **} *Move.w #10, 6(a1) {** VX = 10 **} *Bra N5 N4: *Move.w #Right, Saucer Origin *Move.w #Right, (a1) *Move.w #-10, 6(a1) N5: *Clr.w 8(a1) *Move.w s2,2(a1) {** Y **} *Clr.b Saucer Time N1: *Move.l #Bul Addr,a2 C1: *Cmpa.l BNA,a2 *Bgt L1 *Move.l (a2)+,a1 *Cmpi.w #Bullet Lifetime, 10(a1) *Bne Bul Al *Bsr Delete *Bra C1 Bul Al: *Addq.w #1, 10(a1) *Cmpi.b #Alive, Ship State *Bne Not Hit *Move.l Shp,a0 *Bsr Strike *Tst.b d0 *Beq Not Hit *Move.b #Dying, Ship State *Bra C1 Not Hit: *Cmpi.w #Sh, 4(a1) *Bne C1 *Cmpi.b #Alive, Saucer State *Bne Saucer Not Hit *Move.l Saucer,a0 *Bsr Strike *Tst.b d0 *Beq Saucer Not Hit *Move.l Saucer,a0 *Move.l 26(a0),d0 *Add.l d0,Score *Move.b #Dying, Saucer State *Bra C1 Saucer Not Hit: *Clr.b j *Move.l #Ast Addr, a3 XC1: *Move.b j,d0 *Cmp.b Num Asts, d0 *Bge C1 *Addq.b #1,j *Move.l (a3)+,a0 *Bsr Strike *Tst.b d0 *Beq XC1 *Move.l a2,DTemp1 Break up Asteroid (j) *Move.l DTemp1,a2 *Bra C1 L1: *Cmpi.b #Dying,Ship State *Beq End Up *Move.b #True, Ship Allowed *Move.l Shp,a0 *Cmpi.b #Alive, Saucer State *Bne Saucer Dead *Move.l Saucer,a1 *Bsr Impact *Tst.b d0 *Bne End Up Saucer Dead: *Clr.b i *Move.l #Ast Addr,a2 SC1: *Move.b i,d0 *Cmp.b Num Asts,d0 *Bge End Up *Addq.b #1,i *Move.l (a2)+,a1 *Bsr Impact *Tst.b d0 *Beq SC1 *Cmpi.b #Dead,Ship State *Bne End Up *Tst.w 6(a1) *Bne End Up *Tst.w 8(a1) *Bne End Up Break up Asteroid (i) End Up: %end {*** START OF LEAGUE TABLE & HELP INFO ***} %routine New League %constbyte Max Players = 10, Name Length = 30 %ownstring (Name Length) A, B %ownbytename L %own %string (8) Dat,Tim %ownintegerarray PScore (1:Max Players) %ownstring (255) %array PName (1:Max Players) %conststring (255) Input File = "games:AstLeague", OutPut File = "games:AstLeague", Backup File = "games:AstBackup" %constshort NameX = 360, ScoreX = 240, ScoreY = 455 %routine Read Table (%string (255) File) %label EndR %ownstring (255) A,B %owninteger i,j %on %event 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15 %start %signal ESC Abort %if Event_Event = ESC Abort Corrupted = True Close Input Select Input(0) %return %finish Corrupted = False Open Input (1, File) Select Input (1) Key No = 1 Read Symbol (j) %until j = NL Read Symbol (j) %until j = NL Read Symbol (j) Corrupted = True %and -> EndR %if j # NL Dat = Decode String; Decode Skip Tim = Decode String; Decode Skip Num Games = Decode Integer Corrupted = True %and -> EndR %if Num Games = -1 Num Games = Num Games + 1 Decode Skip %for i = 1,1,Max Players %cycle PName (i) = "" PScore (i) = Decode Integer Corrupted = True %and %exit %if PScore (i) <= 0 Decode Skip j = Decode Symbol Corrupted = True %and %exit %if j # Int (Log Ten (PScore(i))) PName (i) = Decode String Corrupted = True %and %exit %if Length (PName(i)) = 255 Decode Skip j = Decode Symbol Corrupted = True %and %exit %if j # Length (PName(i)) %repeat EndR: Close Input Select Input (0) %end %routine Cursor Show Symbol ('_') XPos = XPos - 9 %end %routine Show Table %owninteger i Set Colour (Higher Colour) At (191, 480) Show String ("APM Asteroids League Table - Game ") Show Number (Num Games) At (224, 460) Show String ("Last Updated: ".Dat." at ".Tim) %for i = 1,1,Max Players %cycle Set Colour (Cyan) At (ScoreX, ScoreY - 28 * i) Show Symbol (' ') %if i < 10 Show Number (i) ShowString (": ") Set Colour (White) Show Number (PScore(i)) At (NameX, ScoreY-28*i) Set Colour (Green) Show String (PName (i)) %repeat %end %routine Write Table (%string (255) File) %real Tmp Open Output (1, File) Select Output (1) PrintString("This file has been encrypted to try to stop".nls) PrintString("people mucking about with it.".nls.nls) Key No = 1 Code String (Dat.nls) Code String (Tim.nls) Code Write (Num Games) Code NL %for i = 1,1,Max Players %cycle Code Write (PScore (i)) Code NL Code Symbol (Int (Log Ten (PScore(i)))) Code String (PName (i).nls) Code Symbol (Length (PName(i))) %repeat Close Output Select Output (1) Select Output (0) %end Need a New Copy = False Read Table (Input File) %if Corrupted = True %start Need a New Copy = True At (70, 130) Set Colour (White) Show String ("Someone has corrupted the old League Table ") Show String ("by trying to edit it") At (70, 118) Show String ("Reading from the Backup Table...") Read Table (Backup File) %if Corrupted = True %start At (70, 106) Show String ("My god, the bastard has also corrupted the Backup Table") PScore(i) = 1000 %andc PName (i) = "Mr. Asteroids" %for i = 1,1,Max Players Dat = Date; Tim = Time Num Games = 1 %finish %finish i = 1 i = i + 1 %while i <= Max Players %and Score < PScore (i) %if i > Max Players %start Show Table At (242,70) Set Colour (Lower Colour) Show String ("Your Score was: ") Show Number (Score) %else Dat = Date; Tim = Time %if i < Max Players %start PScore (j+1) = PScore (j) %and PName (j+1) = PName(j) %c %for j = Max Players - 1, -1, i %finish PScore (i) = Score L == Length(PName (i)) L = 0 Show Table At (242, 70) Set Colour (Lower Colour) j = Test Symbol %until j = -1 Show String ("Enter Your Name") Set Colour (Green) At (NameX, ScoreY - 28 * i) Cursor %cycle j = Test Symbol %if j = NL %start Set Colour (Background) Fill (XPos,YPos,XPos+9,YPos+12) %exit %finish %continue %if j = -1 %or j < 32 %or j > DEL %if j = DEL %start %continue %if L = 0 L = L - 1 Set Colour (Background) XPos = Xpos-9 Fill (XPos,YPos,XPos+18,YPos+12) Set Colour (Green) Cursor %else %exit %if L = Name Length j = j & 95 %ifc ( L = 0 %or Char No (PName (i),L)= ' ') %and 'a' <= j <= 'z' PName (i) = PName (i).To String (j) Set Colour (Background) Fill (XPos,YPos,XPos+9,YPos+12) Set Colour (Green) Show Symbol (j) Cursor %finish %repeat PName (i) = " " %if L = 0 %finish Write Table (Output File) Write Table (Backup File) %ifc Rem (Num Games,10) = 0 %or Need a New Copy = True %end %routine Print V200 Info Screen Op (Clear Screen) Printstring(" Asteroids - ".Version.nls.nls) Open Input (2,"games:Ast.Inf") Select Input(2) %while Next Symbol <> '$' %cycle Read Symbol (x) Print Symbol (x) %repeat Close Input Select Input (0) %end %routine Title %constbyte Letters = 9 %constbytearray TL (1:Letters, 1:7, 1:2) = 0, 0, 0,35, 15,35, 15,20, 0,20, 15,20, 15, 0, 0, 0, 10, 0, 10,10, 0,10, 0,20, 10,20, 0(2), 10,20, 0,20, 0,30, 0, 0, 10, 0, 0(4), 10, 0, 0, 0, 0,20, 10,20, 10,10, 0,10, 0(2), 0, 0, 0, 20, 10,20, 0(8), 0, 0, 10, 0, 10,20, 0,20, 0, 0, 0(4), 0, 0, 0,20, 0(10), 10,35, 10, 0, 0, 0, 0,20, 10,20, 0(4), 0, 0, 10, 0, 10,10, 0,10, 0,20, 10,20, 0(2) %constbytearray TN (1:Letters) = 7, 6, 5, 6, 3, 5, 2, 5, 6 %short X = 250, Y = 400 %integer i,j Set Colour (Red) At (240, 440) Show String ("APM") Set Colour (Title Colour) %for i = 1,1,Letters %cycle Line (TL(i,j,1)+X, TL(i,j,2)+Y, TL(i,j+1,1)+X, TL(i,j+1,2)+Y) %for j = 1,1,TN(i)-1 %if i = 7 %then Plot (X, 25 + Y) X = X + 15 X = X + 5 %if i = 1 X = X - 10 %if i = 7 %repeat At (280,380) Set Colour (Red) Show String(Version) %end %routine Print Help Info %constinteger Num Lines = 7 %const %string (30) %array Info (1:Num Lines, 1:2) = "Mouse L/R : ", "Rotate Left/Right", "Mouse M : ", "Thrust", "Space bar : ", "Fire", "ESC Key : ", "Aborts the program cleanly", "TAB Key : ", "Waits for 3 mins/Any other Key", "Return : ", "Restarts the game", "Other Keys : ", "Hyperspace" Title At (260,321) Draw Screen = 0 Set Colour (Yellow) Show String ("Ship Control") %for i = 1,1,Num Lines %cycle Set Colour (Cyan) At (160, 321-i*21) ShowString (Info(i,1)) Set Colour (Red) Show String (Info(i,2)) %repeat At (255, 150) Set Colour (Yellow) Show String ("Scoring Values") j = Ast Colour k = 0 %for i = Big,1,WeeS %cycle j = Saucer Colour %if i = BigS k = k + Radius (i) + 65 Set Colour (j) At Draw (i, k, 115 + Draw Screen) Set Colour (Green) k = k + Radius (i) + 15 At (k, 115) Show Number (Value (i)) %repeat Set Colour (Yellow) At (230,50) Show String ("Hit Any Key to Start") %end {*** END OF HELP INFO ***} %routine Initialise Program Set Up Clear User = Current User %if User = "" %then User = "ANON" %and i = FComm ('L' << 8, "PUB") Quote (Pass) Read Font ("games:Font.1") Initialise Random Set Terminal Mode (No Page) Over (i) = CharNo(OverStr,i) %for i = 1,1,9 An = 0 %for i = 0,1,ShAn %cycle CSA (i) = Cos (An) SSA (i) = Sin (An) An = An + Rads %repeat Ang = 0 %for i = 1,1,Pts %cycle CEA (i) = Cos (Ang) SEA (i) = Sin (Ang) Ang = Ang + Incr %repeat %for i = Big,1,Thr %cycle %for j = 1,1,N(i)+1 %cycle Shape(i)_P(j,1) = Int (S(i,j,1) * SCF(i)) Shape(i)_P(j,2) = Int (S(i,j,2) * SCF(i)) %repeat Radius (i) = Int (Radius(i) * SCF(i)) RSq (i) = Radius (i) * Radius (i) %repeat Shp == Ship Ship_N = N(Sh); Ship_Rad = Radius(Sh); Ship_Rsq = Rsq(Sh) Ship_P = Addr(Shape(Sh)_P); Ship_Q = Addr(Shape(ShTemp)_P); Ship_Type = Sh Tht == Thrust Thrust_N = N(Thr); Thrust_Rad = Radius(Thr); Thrust_Rsq = Rsq(Thr) Thrust_P = Addr(Shape(Thr)_P); Thrust_Q = Addr(Shape(ThrTemp)_P) Thrust_Type = Thr BigSaAddr = Addr(BigSau) BigSau_N = N(BigS); BigSau_Rad = Radius(BigS); BigSau_Rsq = Rsq(BigS) BigSau_P = Addr(Shape(BigS)_P); BigSau_Type = BigS BigSau_Value = Value(BigS) WeeSaAddr = Addr(WeeSau) WeeSau_N = N(WeeS); WeeSau_Rad = Radius(WeeS); WeeSau_Rsq = Rsq(WeeS) WeeSau_P = Addr(Shape(WeeS)_P); WeeSau_Type = WeeS WeeSau_Value = Value(WeeS) StB = Addr (Star(1,1)) StT = Addr (Star(Max Stars,2)) %end %routine Set up Stars %for i = 1,1,Max Stars %cycle Star (i,1) = Random Int (1,686) Star (i,2) = Random Int (1,511) %repeat %end %routine Initialise Game Num Saucers = 0 Draw Screen = 0 Num Asts = 0 Num Aiming = 0 Sheet = 0 Clock = 0 NumBul = 0 Saucer Death = 0 Ship Death = 0 Wait Time = 0 Saucer Appears = 1000 AA = 0 BB = 0 Fired = 0 Score = 0 Men Left = Start Men Ast Wait = 0 Next Score = 5000 Ship State = Alive Ship Allowed = True Saucer State = Dead Score Altered = False Ship_VX = 0; Thrust_VX = 0 Ship_VY = 0; Thrust_VY = 0 Ship_A = 0 Ship_X = 344; Thrust_X = 344 Ship_Y = 255; Thrust_Y = 255 BNA = Bul Addr - 4 B (i) == OB (i) %for i = 1,1,MaxB A (i) == OA (i) %for i = 1,1,Max Asts Rotate (Ship, Ship_A) %end {** ---===<<< Main Block >>>===--- **} Initialise Program Print V200 Info MLoop: Set Up Stars Print Help Info i = Test Symbol %cycle i = Test Symbol j = MouseButtons %repeat %until i # -1 %or j # MsNone j = MouseButtons %until j = MsNone %signal ESC Abort %if i = ESC Restart: Initialise Game Inner Loop: Tick = Cpu Time + Refresh Rate *Addq.l #1, Clock Offset (0,Draw Screen) Draw Screen = 512 - Draw Screen Half Clear (Draw Screen>>9) Update Situation *Move.b #Star Colour, Colour Reg *Movea.l StB,a1 StLp: *Move.w (a1)+,xp *addq.w #Star Velocity,(a1) *andi.w #511,(a1) *move.w (a1)+,d0 *add.w Draw Screen,d0 *Move.w d0,yp Frame (yp<<5+xp>>5)=1<<(31-xp&31) *cmpa.l StT,a1 *ble StLp %if Num Asts = 0 %start Ast Wait = Ast Wait + 1 %if Ast Wait >= Ast Trigger %start Sheet = Sheet + 1 %if Sheet >= 10 %then Ast Wait = Ast Trigger %c %else Ast Wait = Sheet * 2 %if Sheet > ShTop %then ShRel = ShTop %else ShRel = Sheet Num Asts = Ast Num (ShRel) Num Aiming = Num Aiming + 1 %if Sheet < 13 %and Rem (Sheet,2) = 0 Set Up Asteroids (Num Asts) Num Saucers = 0 Saucer Appears = Clock + Delay (ShRel, Num Saucers) %finish %else *Move.b #Ast Colour, Colour Reg Draw (A(x)) %for x = 1,1,Num Asts %finish %if Saucer State = Dying %start Saucer Death = Saucer Death + 1 %if Saucer Death <= Exps %start Explode (Saucer Death, Saucer_X, Saucer_Y, 1) %finish At (Saucer_X-13, Saucer_Y-6+DrawScreen) Colour Reg = SCl (Rem (Saucer Death,6)) Show Symbol (Saucer_Value//100+'0') Colour Reg = SCl (Rem (Saucer Death+1,6)) Show Symbol (Rem(Saucer_Value,100)//10+'0') Colour Reg = SCl (Rem (Saucer Death+2,6)) Show Symbol (Rem(Saucer_Value,10)+'0') %if Saucer Death = 2*Exps %thenc Saucer State = Dead %and Saucer Death = 0 %finishelseif Saucer State = Alive %start %if Saucer Origin = Left %start %if Saucer_X + Saucer_VX > Right %then Saucer State = Dead %finishelsec %if Saucer_X + Saucer_VX < Left %then Saucer State = Dead %if Saucer State = Alive %start %if Saucer_Type = Bigs %then Scaling = 1 %else Scaling = 2 Saucer_VY = Saucer_VY + Random Int (-Scaling, Scaling) *Move.b #Saucer Colour, Colour Reg Draw (Saucer) Saucer Time = Saucer Time + 1 Saucer Bullet %and Saucer Time = 0 %c %if Saucer Time = Time for SauBul %and Ship State # Dead %finish %finish *Cmpi.b #Alive, Ship State *Bne Notal x = Test Symbol *Tst.w x *Blt No Key *Cmpi.w #27,x *Bne Clear Loop %signal ESC Abort Clear Loop: y = Test Symbol *Tst.w y *Bge Clear Loop *Cmpi.w #32,x *Beq Firing *Cmpi.w #9,x *Beq Hold *Cmpi.w #10,x *Bne Hyper Initialise Game *Bra Restart Hyper: Ship_X = Random Int(Left, Right) Ship_Y = Random Int(Bottom, Top) Ship_VX = 0 Ship_VY = 0 *Bra No Key Firing: *Move.l Clock,d0 *Cmp.l BB,d0 *Blt No Key *Add.l #BInc,d0 *Move.w Fired,d1 *Addq.w #1,d1 *Divs #BulAllowed,d1 *Lsr #8,d1 *Lsr #8,d1 *Move.w d1,Fired *Tst.w d1 *Bne No Inc *Addq.l #BInc,d0 No Inc: *Move.l d0,BB *Addq.b #1,NumBul *Addq.l #4,BNA *Move.l BNA,a1 *Move.l (a1),a1 *Move.l Shp,a2 *Move.l 18(a2),a3 *Move.w (a2),d0 *Add.w (a3),d0 *Move.w d0,(a1) *Move.w 2(a2),d1 *Add.w 2(a3),d1 *Move.w d1,2(a1) *Move.w #Sh,4(a1) *Clr.w 10(a1) x = Int(BVS * SSA (Ship_A) + Ship_VX) y = Int(BVS * CSA (Ship_A) + Ship_VY) *Move.l BNA,a0 *Move.l (a0),a0 *Move.w x,6(a0) *Move.w y,8(a0) *Bra No Key Hold: Screen Op (Clear Screen) x = Pause y = -1 Tick = Cpu Time %cycle %cycle %exitif Cpu Time >= Tick y = Test Symbol %and %exit %unless Test Symbol = -1 %repeat %exit %if y # -1 Tick = Cpu Time + 1000 PrintString(" Waiting for") %andc Write(x,Int (Log Ten(Pause))) %and PrintSymbol(CR) x = x - 1 %continue %if x >= 0 %signal Time Out %repeat %signal ESC Abort %if y = ESC Printstring(ToString(CR)." ".ToString(CR)) No Key: *Clr.b Thrusting ! *Move.l mouse buttons, MB MB = mouse buttons *Bclr #1, MB *Beq No Thrust *Move.b #True, Thrusting *Move.b #Decel Value, Decel SSn = Int(SSA (Ship_A) * Inc) SCs = Int(CSA (Ship_A) * Inc) *Move.l Shp,a0 *Move.w SSn,d0 *Add.w d0, 6(a0) *Move.w SCs,d0 *Add.w d0, 8(a0) No Thrust: *Cmpi.b #MsLR, MB *Beq LNone *Cmpi.b #MsR, MB *Beq LRight *Cmpi.b #MsL, MB *Bne LNone *Cmpi.w #MinAA, AA *Ble RotShip *Subq.w #1,AA *Bra RotShip LRight: *Cmpi.w #MaxAA, AA *Bge RotShip *Addq.w #1,AA RotShip: Rotate (Ship,AA) *Bra LNext LNone: *Clr.w AA LNext: *Move.b #Ship Colour, Colour Reg Draw (Ship) *Tst.b Thrusting *Beq Decelerate *Move.l Tht,a0 *Move.l Shp,a1 *Clr.w 10(a0) *Move.w (a1)+,(a0)+ *Move.w (a1),(a0) Rotate (Thrust,Ship_A) *Move.b #Thrust Colour, Colour Reg Draw (Thrust) *Bra ShCont Decelerate: *Subq.b #1,Decel *Bne ShCont *Move.b #Decel Value,Decel *Move.l Shp,a0 *Tst.w 6(a0) *Beq Dec1 *Blt Dec2 *Subq.w #1,6(a0) *Bra Dec1 Dec2: *Addq.w #1,6(a0) Dec1: *Tst.w 8(a0) *Beq ShCont *Blt Dec3 *Subq.w #1,8(a0) *Bra ShCont Dec3: *Addq.w #1,8(a0) *Bra ShCont Notal: *Cmpi.b #Dying, Ship State *Bne ShDead %signal ESC Abort %if TestSymbol = ESC -> Restart %if TestSymbol = NL *Addq.b #1, Ship Death Explode (Ship Death, Ship_X, Ship_Y, 1) *Cmpi.b #Exps, Ship Death *Bne ShCont *Move.b #Dead, Ship State *Clr.b Ship Death *Movea.l Shp, a0 *Move.w #344, (a0)+ *Move.w #255, (a0) *Bra ShCont ShDead: -> ILoop End %if Men Left = 0 %signal ESC Abort %if TestSymbol = ESC -> Restart %if TestSymbol = NL Wait Time = Wait Time + 1 %if Wait Time >= Ship Trigger %and Ship Allowed = True %start Men Left = Men Left - 1 Ship State = Alive Ship_VX = 0; Ship_VY = 0; AA = 0 Wait Time = 0 j = TestSymbol %until j = -1 %finish ShCont: *Tst.b NumBul *Beq DBE *Move.b NumBul,d3 *Extw d3 *Subq.w #1,d3 *Move.b #Bullet Colour, Colour Reg *Move.l #Bul Addr,a2 DBB: *Move.l (a2)+,a0 *Move.w 6(a0),d0 *extl d0 *add.w (a0),d0 *Cmp.w #Right,d0 *Blt DBL1 *Sub.w #Width,d0 *Bra DBL2 DBL1: *Cmp.w #Left,d0 *Bge DBL2 *Add.w #Width,d0 DBL2: *Move.w d0,(a0) *Move.w 8(a0),d0 *extl d0 *add.w 2(a0),d0 *Cmp.w #Top,d0 *Ble DBL3 *Sub.w #Height,d0 *Bra DBL4 DBL3: *Cmp.w #Bottom,d0 *Bge DBL4 *Add.w #Height,d0 DBL4: *Move.w d0,2(a0) *Move.w (a0)+,XX *Move.w (a0)+,d1 *Add.w Draw Screen,d1 *Move.w d1,YY *Move.l a2,DTemp1 *Move.w d3,DTemp2 Fill (XX-1, YY-1, XX+1, YY+1) *Move.w DTemp2,d3 *Move.l DTemp1,a2 *Dbra d3,DBB DBE: Draw Scores Etc %cycle; %repeat %until Cpu Time >= Tick *Bra Inner Loop ILoop End: i = 1 %cycle At (290, 768 - Draw Screen) %for j = 1,1,9 %cycle Colour Reg = SCl (Rem (i,6)) Show Symbol (Over (j)) i = i + 1 %and i = i - 1 %for k = 1,1,950 i = i + 1 %repeat %repeat %until i = 100 Clear Offset (0,0) New League At (242, 50) Set Colour (Lower Colour) Show String ("Another Game? (Y/N)") %cycle i = Test Symbol & 95 %repeat %until i = 'Y' %or i = 'N' -> MLoopEnd %if i = 'N' Clear *Bra MLoop MLoopEnd: Screen Op (Clear Screen) Printstring("End of Program".nls.nls) End of Program: Quote ("") i = FComm ('M' << 8, "") %if User = "ANON" %endofprogram