PROGRAM Marmoset(Input,Output,InText,OutText,InBin,OutBin);

{JOSHUA DAVIS          Design:  5/06/93      Accompanying Files:     MarmEdit}
{SPACE MARMOSET        1000 Ln: 5/25/93      MarmIndx    MarmData    MarmChar}
{Sci-Fi Adventure      Coding:               MarmTalk    MarmHelp    MarmEnem}
{Second Incarnation    Modified:8/24/93      MarmDraw    MarmKeep    MarmPics}

USES
  CRT,Graph{,MarmEdit,MarmDraw};

CONST
  Obj=75;                                                  {number of objects}
  Mon=0;                                                  {number of monsters}
  DLin=2;                                      {lines per entry in 'MarmData'}
  GPos=1;                                   {grid data position in 'MarmData'}
  RPos=2;                                   {rank data position in 'MarmData'}
  KLin=4;                                      {lines per entry in 'MarmKeep'}
  KEnt=Obj+Mon;                              {number of entries in 'MarmKeep'}
  NMax=20;                                          {maximum letters per name}
  CMax='J';                                       {maximum character per game}
  OMax='T';                                    {maximum objects per character}
  FAge=25;                                     {age needed for fission engine}
  AAge=45;                                 {age needed for anti-matter engine}
  CAge=65;                                   {age needed for continuum jumper}
  FCst=1000;                                            {fission reactor cost}
  ACst=10000;                                       {anti-matter reactor cost}
  CCst=100000;                                         {continuum jumper cost}
  RCst=50;                                                 {cost to gain rank}
  BCst=10;                                                  {cost to recharge}
  HDie=10;                                     {random field for health rolls}
  IMon=0;                                                      {initial money}
  TMon=1000;                                                    {trader money}
  Blnk='                    ';         {blanks out names. change to suit NMax}
  Xtra=7;                                               {points to distribute}
  Plan='L';                                   {maximum planet including Earth}
  YNum=10;                                     {number of toggling properties}
  ZNum=70;                                     {number of special game events}

TYPE
  GenType=(Male,Female);
  ProfType=(Sniper,Monk,Explorer,Trader,Survivalist,Mercenary,Spy,Scientist,
            Scholar,Bomber,Physician,Electrician,Tourist,Patroller,Janitor,
            EnviroTech);
  Inventory=ARRAY [1..Obj] OF Integer;
  CraftType=RECORD
            E:Inventory;
            F,R:Integer;
            END;
  EquipType=ARRAY ['A'..OMax] OF Integer;
  SkillType=ARRAY [1..7] OF Integer;
  ToggleType=ARRAY [1..YNum] OF Boolean;
  EventType=ARRAY [1..ZNum] OF Boolean;
  NameType=RECORD
           N:ARRAY [1..NMax] OF Char;
           L:Integer;
           END;
  PlayType=RECORD
           A,B:Integer;                                        {age,batteries}
           C:CraftType;                                           {spacecraft}
           D:Integer;                                              {dexterity}
           E:EquipType;                                            {equipment}
           F:Integer;                                                   {food}
           G:GenType;                                                 {gender}
           H,I:Integer;                                  {health,intelligence}
           J:ProfType;                                            {profession}
           K:Integer;                                                  {kills}
           L:Char;                                                  {location}
           M:Real;                                                     {money}
           N:NameType;                                           {name string}
           O:Integer;                                                {objects}
           P:Real;                                                    {points}
           Q,R,S,T:Integer;                      {movement,rank,strength,time}
           U:Char;                                            {identification}
           V,W:Integer;                                {morale,wounded health}
           X:SkillType;                                        {combat skills}
           Y:ToggleType;                                     {boolean toggles}
           Z:EventType;                                          {event index}
           END;                                                  {none remain}
  PlayArray=ARRAY ['A'..CMax] OF PlayType;
  PlayArrayRec=RECORD
               C:Char;
               P:PlayArray;
               END;
  PFile=FILE OF PlayArrayRec;
  RangeGrid=ARRAY ['A'..Plan,'A'..Plan] OF Integer;
  RankArray=ARRAY [1..16] OF Real;
  CharArray=ARRAY [1..6] OF Char;
  CellType=RECORD
            PicKey,Prob,Level,Spec:Integer;
            Enc:Boolean;
           END;
  Grid2525=ARRAY [1..25,1..25] OF CellType;
  Grid2020=ARRAY [1..20,1..20] OF CellType;
  Grid1010=ARRAY [1..10,1..10] OF CellType;
  Grid550=ARRAY [1..5,1..50] OF CellType;
  EarthSurface=Grid2525;
  MoonSurface=Grid2020;
  JeydnaluSurface=Grid2020;
  GalileiSurface=Grid1010;
  NewtonSurface=Grid1010;
  XlioriSurface=Grid2020;
  JuveniaSurface=Grid1010;
  SchizmusSurface=Grid550;
  MechySurface=Grid2020;
  UrmlicasSurface=Grid2020;
  VerdaSurface=Grid2020;
  AntediluviusSurface=Grid2020;
  PlatformSurface=Grid550;
  VariantSurface=RECORD
                 MaxX,MaxY:Integer;
                 ScrX,ScrY:Boolean;
                 CASE Planet:Char OF
                  'A': (Sa:EarthSurface);
                  'B': (Sb:MoonSurface);
                  'C': (Sc:JeydnaluSurface);
                  'D': (Sd:GalileiSurface);
                  'E': (Se:NewtonSurface);
                  'F': (Sf:XlioriSurface);
                  'G': (Sg:JuveniaSurface);
                  'H': (Sh:SchizmusSurface);
                  'I': (Si:MechySurface);
                  'J': (Sj:UrmlicasSurface);
                  'K': (Sk:VerdaSurface);
                  'L': (Sl:AntediluviusSurface);
                 END;
  SFile=FILE OF VariantSurface;

VAR
  Play:PlayArrayRec;
  Exit:Boolean;
  Ans:Char;

FUNCTION MOrd(Ch:Char):Integer;
         BEGIN
           MOrd:=(Ord(Ch))-(Ord('A'))+1;
         END;

FUNCTION MChr(Num:Integer):Char;
         BEGIN
           MChr:=Chr(Num+Ord('A')-1);
         END;

FUNCTION ChoiceOK(Ans,Top:Char;XInc:Boolean):Boolean;
         VAR
           Result:Boolean;
         BEGIN
           Result:=False;
           IF XInc AND (Ans='X') THEN Result:=True;
           IF ((Ans>='A') AND (Ans<=Top)) THEN Result:=True;
           ChoiceOk:=Result;
         END;

FUNCTION Present(VAR E:EquipType):Boolean;
         VAR
           A:Char;
           Here:Boolean;
         BEGIN
           Here:=False;
           FOR A:='A' TO OMax DO
            IF E[A]>0 THEN Here:=True;
           Present:=Here;
         END;

PROCEDURE ReadInt(VAR Res:Integer);
          VAR
            Ch:CharArray;
            Error,Negate:Boolean;
            A,B,Value,Expon,Count:Integer;
          BEGIN
            Res:=0;
            Count:=0;
            Error:=False;
            Negate:=False;
            WHILE (NOT EOLN) AND (Count<6) DO BEGIN
             Count:=Count+1;
             Read(Ch[Count]);
            END;
            Readln;
            FOR A:=1 TO Count DO
             IF ((Ord(Ch[A]))>=(Ord('0'))) AND
              ((Ord(Ch[A]))<=(Ord('9'))) THEN BEGIN
              Value:=(Ord(Ch[A]))-(Ord('0'));
              Expon:=1;
              FOR B:=1 TO (A-1) DO Expon:=Expon*10;
              Res:=Res+(Value*Expon);
             END
              ELSE IF (A=1) AND (Ch[A]='-') THEN Negate:=True
               ELSE Error:=True;
            IF Negate AND (NOT Error) THEN Res:=-1*Res;
            IF Error THEN Res:=-MaxInt;
          END;

PROCEDURE Help;
          VAR
            InText:Text;
            Ch:Char;
            A:Integer;
          BEGIN
            ClrScr;
            Assign(InText,'B:MarmHelp.Pas');
            Reset(InText);
            A:=0;
            WHILE NOT EOF(InText) DO BEGIN
             WHILE NOT EOLN(InText) DO BEGIN
              Read(InText,Ch);
              Write(Ch);
             END;
             Readln(InText);
             Writeln;
             A:=A+1;
             IF (A MOD 20)=0 THEN Readln;
            END;
            Close(InText);
            Readln;
          END;

PROCEDURE CalcDamage(Code:Integer;VAR IniDam,RevDam:Integer);
          BEGIN
            RevDam:=0;
            CASE Code OF
             40:;
            END;
          END;

PROCEDURE InputAllChars(VAR Play:PlayArrayRec);
          VAR
            InBin:PFile;
          BEGIN
            Assign(InBin,'B:MarmChar');
            Reset(InBin);
            IF EOF(InBin) THEN Play.C:=Chr(Ord('A')-1)
             ELSE Read(InBin,Play);
            Close(InBin);
          END;

PROCEDURE SaveAllChars(VAR Play:PlayArrayRec);
          VAR
            OutBin:PFile;
          BEGIN
            Assign(OutBin,'B:MarmChar');
            Rewrite(OutBin);
            Write(OutBin,Play);
            Close(OutBin);
          END;

PROCEDURE SaveOneChar(VAR P:PlayType);
          VAR
            Play:PlayArrayRec;
            OutBin:PFile;
          BEGIN
            Assign(OutBin,'B:MarmChar');
            Reset(OutBin);
            Read(OutBin,Play);
            Play.P[(P.U)]:=P;
            IF (P.U)>(Play.C) THEN Play.C:=P.U;         {new character clause}
            Rewrite(OutBin);
            Write(OutBin,Play);
            Close(OutBin);
          END;

PROCEDURE WriteIndex;
          VAR
            InText,OutText:Text;
            A,B:Integer;
            Ch:Char;
          BEGIN
            Assign(InText,'B:MarmKeep.Pas');
            Assign(OutText,'B:MarmIndx.Pas');
            Reset(InText);
            Rewrite(OutText);
            FOR A:=1 TO (KEnt-1) DO BEGIN
             WHILE NOT EOLN(InText) DO BEGIN
              Read(InText,Ch);
              Write(OutText,Ch);
             END;
             Writeln(OutText);
             FOR B:=1 TO KLin DO Readln(InText);
            END;
            WHILE NOT EOLN(InText) DO BEGIN
             Read(InText,Ch);
             Write(OutText,Ch);
            END;
            Writeln(OutText);
            Close(InText);
            Close(OutText);
          END;

PROCEDURE Refer(Index:Integer);
          VAR
            InText:Text;
            I,J:Integer;
            Ch:Char;
          BEGIN
            Writeln('Referencing...');
            Assign(InText,'B:MarmKeep.Pas');
            Reset(InText);
            FOR I:=1 TO (Index-1) DO
             FOR J:=1 TO KLin DO Readln(InText);
            FOR I:=1 TO KLin DO BEGIN
             WHILE (NOT EOLN(InText)) DO BEGIN
              Read(InText,Ch);
              Write(Ch);
             END;
             Readln(InText);
             Writeln;
            END;
            Close(InText);
            Readln;
          END;

PROCEDURE CharDisp(VAR P:PlayType);
          VAR
            A,B,C,D,E:Integer;
            Ch:Char;
            InText:Text;
          BEGIN
            ClrScr;
            FOR A:=1 TO P.L DO Write(P.N[A]);
            Writeln;
            Writeln(' ':35,'Net Health:',P.W:19);
            Writeln('Age:',P.A:26,' ':5,'Total Health:',P.H:17);
            Write('Gender:',' ':17);
            IF P.G=Male THEN Writeln('  Male',' ':5)
             ELSE Writeln('Female',' ':5);
            Writeln('Origin:',' ':18,'Earth     Rank:',P.R:25);
            Writeln(' ':35,'Points:',P.P:23:0);
            Writeln('Strength:',P.S:21,'     Kills:',P.K:24);
            Writeln('Dexterity:',P.D:20);
            Writeln('Intelligence:',P.I:17,'     Batteries:',P.B:20);
            Writeln(' ':35,'Food:',P.F:25);
            Writeln('Evasion:',P.V:22,'     Money:',P.M:24:0);
            Writeln;
            IF P.O>0 THEN BEGIN
             B:=0;
             C:=0;
             Assign(InText,'MarmIndx');
             Reset(InText);
             FOR A:=1 TO (P.O) DO BEGIN
              REPEAT
               B:=B+1;
              UNTIL (P.E[B].Pr) OR (B=Obj);
              FOR D:=1 TO (B-1-C) DO Readln(InText);
              C:=B;
              Write('[',B:2,'] ');
              E:=1;
              WHILE NOT EOLN(InText) DO BEGIN
               Read(InText,Ch);
               Write(Ch);
               E:=E+1;
              END;
              E:=E-1;
              IF Odd(A) THEN Write(' ':30-E)
               ELSE IF A<(P.O) THEN Writeln;
              Readln(InText);
             END;
             Close(InText);
            END;
            Writeln;
            Readln;
          END;

PROCEDURE ChooseRefer;
          VAR
            Index:Integer;
          BEGIN
            REPEAT
             Writeln('Select a topic to reference, or type 0 to exit.');
             ReadInt(Index);
            UNTIL (Index>=0) AND (Index<=KEnt);
            IF Index>=1 THEN Refer(Index);
          END;

PROCEDURE ShipObjects(VAR Inv:Inventory;VAR Count:Integer);
          VAR
            Ch:Char;
            InText:Text;
            A,B,C,D,E:Integer;
          BEGIN
            ClrScr;
            Write('Code Item     Qty   ');
            IF Count>=2 THEN Write('Code Item     Qty   ');
            IF Count>=3 THEN Write('Code Item     Qty   ');
            Writeln;
            B:=0;
            C:=0;
            Assign(InText,'MarmIndx');
            Reset(InText);
            FOR A:=1 TO Count DO BEGIN
             REPEAT
              B:=B+1;
             UNTIL ((Inv[B])>0) OR (B=Obj);
             FOR D:=1 TO (B-1-C) DO Readln(InText);
             C:=B;
             Write('[',B:2,'] ');
             E:=0;
             WHILE (E<8) AND (NOT EOLN(InText)) DO BEGIN
              E:=E+1;
              Read(InText,Ch);
              Write(Ch);
             END;
             Write(' ':8-E);
             Write(Inv[B],' ':5);
             IF (A MOD 3)=0 THEN Writeln;
             Readln(InText);
            END;
            IF (Count MOD 3)<>0 THEN Writeln;
            Close(InText);
          END;

PROCEDURE ReArmor(VAR P:PlayType);
          BEGIN
            P.V[6]:=2*(P.D);
            IF P.E[46] THEN P.V[6]:=(P.V[6])+25
             ELSE BEGIN
              IF P.E[39] THEN P.V[6]:=(P.V[6])+20
               ELSE IF P.E[38] THEN P.V[6]:=(P.V[6])+10;
              IF P.E[40] THEN P.V[6]:=(P.V[6])+5;
             END;
            IF P.E[41] THEN P.V[6]:=(P.V[6])+20;
            IF P.E[42] THEN P.V[6]:=(P.V[6])+5;
            IF P.E[43] THEN P.V[6]:=(P.V[6])+10;
          END;

PROCEDURE ReEquip(VAR P:PlayType);
          VAR
            Ans5:Char;
            A,Ans6,Count:Integer;
            Exit2:Boolean;
          BEGIN
            REPEAT
              MenuReequip;
              REPEAT
               Writeln('Select a course of action, or type X to exit.');
               Ans5:=ReadKey;
              UNTIL ChoiceOK(Ans5,MChr(6),True);
              CASE Ans5 OF
               'A': BEGIN
                     IF P.E[3] THEN P.B:=199
                      ELSE P.B:=99;
                     Writeln('Battery pack recharged.');
                     Readln;
                    END;
               'B': BEGIN
                     IF (P.C.Food)>(9-(P.F)) THEN BEGIN
                      P.C.Food:=(P.C.Food)-9+(P.F);
                      P.F:=9;
                     END
                      ELSE BEGIN
                       P.F:=(P.F)+(P.C.Food);
                       P.C.Food:=0;
                      END;
                     Writeln(P.C.Food,' rations remain on your spacecraft.');
                     Writeln(P.F,' rations are currently equipped.');
                     Readln;
                    END;
               'C': ChooseRefer;
               'D': CharDisp(P);
               'E': BEGIN
                     Count:=0;
                     FOR A:=1 TO Obj DO
                      IF (P.C.Equip[A])>0 THEN Count:=Count+1;
                     IF Count>0 THEN BEGIN
                      Exit2:=False;
                      REPEAT
                       ShipObjects(P.C.Equip,Count);
                       Writeln('Select an object to equip, or type 0.');
                       ReadInt(Ans6);
                       IF Ans6<=Obj THEN
                        IF ((Ans6=0) OR ((P.C.Equip[Ans6])>0))
                         THEN Exit2:=True;
                      UNTIL Exit2;
                      IF Ans6>0 THEN BEGIN
                       IF P.O<P.S THEN
                        IF NOT (P.E[Ans6].Pr) THEN BEGIN
                         P.E[Ans6]:=True;
                         P.C.Equip[Ans6]:=(P.C.Equip[Ans6])-1;
                         Inc(P.O);
                         IF (Ans6>=38) AND (Ans6<=46) THEN ReArmor(P);
                        END
                         ELSE Writeln('You have this object equipped.')
                        ELSE Writeln('You may only equip ',P.S,' objects.');
                       Readln;
                      END;
                     END
                      ELSE Writeln('You do not have any objects stored.');
                    END;
               'F': BEGIN
                     FOR A:=1 TO Obj DO
                      IF P.E[A] THEN BEGIN
                       P.E[A]:=False;
                       IF (P.C.Equip[A])<9 THEN Inc(P.C.Equip[A]);
                      END;
                     P.O:=0;
                     Writeln('All of your objects have been stored.');
                     Readln;
                    END;
              END;
            UNTIL Ans5='X';
          END;

PROCEDURE ReadMove(VAR CX,CY,NX,NY:Integer;VAR Other:Boolean);
          VAR
            Move:Char;
          BEGIN
            Other:=False;
            Move:=ReadKey;
            CASE Move OF
             '1': BEGIN
                   NX:=CX-1;
                   NY:=NY+1;
                  END;
             '2': NY:=CY+1;
             '3': BEGIN
                   NX:=CX+1;
                   NY:=CY+1;
                  END;
             '4': NX:=CX-1;
             '5': Other:=True;
             '6': NX:=CX+1;
             '7': BEGIN
                   NX:=CX-1;
                   NY:=CY-1;
                  END;
             '8': NY:=CY-1;
             '9': BEGIN
                   NX:=CX+1;
                   NY:=CY-1;
                  END;
            END;
          END;

PROCEDURE ReadyGraph;
          VAR
            Mode,Adapter:Integer;
          BEGIN
            DetectGraph(Mode,Adapter);
            InitGraph(Mode,Adapter,'c:\tp\bgi');
            ClearDevice;
          END;

PROCEDURE BorderExplain(Plan:Integer);
          BEGIN
            CASE Plan OF
             1: Writeln('You may not leave the European Security Zone.');
             2: Writeln('There is no exit from the Moonbase here.');
             3: Writeln('The Jeydnali ocean blocks your progress.');
             7: Writeln('The craggy igneous rock is impassable.');
             8: BEGIN
                 Write('Departing the Temperate Region would ');
                 Writeln('surely cause your death.');
                END;
             9: Writeln('You cannot pass the walls of the Mechy fortress.');
             11: Writeln('Here the forests grow to dense to pass.');
             12: Writeln('The ruins and choking growth block your passage.');
            END;
          END;

PROCEDURE ReadPlanet(VAR S:VariantSurface;Planet:Integer);
          VAR
            A:Integer;
            InBin:SFile;
          BEGIN

          END;

FUNCTION GridOK:Boolean;
         BEGIN

         END;

PROCEDURE NewEngine(VAR Range:Integer;Age:Integer;
                    VAR Money:Real;Pres:Boolean);
          VAR
            Cost:Real;
            Ans6:Char;
            Possible:Boolean;
          BEGIN
           Ans6:='!';
           CASE Range OF
            1: IF Age>=FAge THEN BEGIN
                Write('A fission reactor ');
                Writeln('is available for $',FCst,'.');
                Cost:=FCst;
               END
                ELSE Writeln('Your hydrogen system is the finest available!');
            2: IF Age>=AAge THEN BEGIN
                Write('An anti-matter reactor ');
                Writeln('is available for $',ACst,'.');
                Cost:=ACst;
               END
                ELSE Writeln('Your fission reactor is the finest available!');
            3: IF Age>=CAge THEN BEGIN
                Write('A continuum jumper ');
                Writeln('is available for $',CCst,'.');
                Cost:=CCst;
               END
                ELSE
                 Writeln('Your anti-matter reactor is the finest available!');
            4: Writeln('Your continuum jumper is the finest available!');
           END;
           Possible:=False;
           CASE Range OF
            1: IF Age>=FAge THEN Possible:=True;
            2: IF Age>=AAge THEN Possible:=True;
            3: IF Age>=CAge THEN Possible:=True;
           END;
           IF Possible THEN BEGIN
            Writeln('Do you wish to upgrade your system? Type Y or N.');
            Ans6:=ReadKey;
            IF Ans6='Y' THEN BEGIN
             IF NOT Pres THEN BEGIN
              Write('Your Data Keeper is required for ');
              Writeln('all monetary transactions.');
             END;
             IF Cost>Money THEN Writeln('You have insufficient funds.')
              ELSE IF Pres THEN BEGIN
               Money:=Money-Cost;
               Range:=Range+1;
               Writeln('New propulsion system installed.');
               Readln;
              END;
            END;
           END;
           IF Ans6='!' THEN Readln;
          END;

PROCEDURE BuyFood(VAR Food,Stored:Integer;VAR Money:Real;Pres,FPres:Boolean);
          VAR
            Capac,FHere,Ans6:Integer;
          BEGIN
            ClrScr;
            IF FPres THEN BEGIN
             Capac:=9;
             FHere:=Food;
            END
             ELSE BEGIN
              Capac:=0;
              FHere:=0;
             END;
            Writeln('You are presently carrying ',FHere,' food rations.');
            Writeln('The price here is $',FCst,'.');
            Writeln('How much would you like to buy? Type 0 to exit.');
            REPEAT
             ReadInt(Ans6);
            UNTIL Ans6>=0;
            IF Ans6>0 THEN BEGIN
             IF NOT Pres THEN BEGIN
              Write('Your Data Keeper is required ');
              Writeln('for all monetary transactions.');
             END;
             IF Ans6*FCst>Money THEN Writeln('You have insufficient funds.')
              ELSE IF Pres THEN
               IF Food+Ans6<=Capac THEN BEGIN
                Food:=Food+Ans6;
                Money:=Money-(FCst*Ans6);
                Writeln('You now have ',Food,' food rations equipped.');
                Writeln('$',Money:1:0,' remains in your account.');
               END
                ELSE BEGIN
                 Money:=Money-(FCst*Ans6);
                 Ans6:=Ans6-9+Food;
                 Food:=9;
                 Stored:=Stored+Ans6;
                 IF Stored>99 THEN Stored:=99;
                 Writeln('You now have ',FHere,' food rations equipped.');
                 Writeln('$',Money:1:0,' remains in your account.');
                 Write('The balance of your purchase will be delivered ');
                 Writeln('to your spacecraft.');
                END;
             Readln;
            END;
          END;

PROCEDURE Recharge(VAR Batt:Integer;VAR Money:Real;Pres,B1Pr,B2Pr:Boolean);
          VAR
            Ans6:Char;
            Capac:Integer;
          BEGIN
            IF B2Pr THEN Capac:=199
             ELSE Capac:=99;
            IF (B1Pr OR B2Pr) THEN BEGIN
             Writeln('Your Battery Pack currently holds ',Batt,' charges.');
             Writeln('You may recharge it at the power plant.');
             Writeln('For this there is a fee of $',BCst,'.');
             Writeln('Do you wish to recharge? Type Y or N.');
             Ans6:=ReadKey;
             IF Ans6='Y' THEN BEGIN
              IF NOT Pres THEN BEGIN
               Write('Your Data Keeper is required ');
               Writeln('for all monetary transactions.');
              END;
              IF Money<BCst THEN Writeln('You have insufficient funds.')
               ELSE IF Pres THEN BEGIN
                Money:=Money-BCst;
                Batt:=Capac;
                Writeln('Battery Pack recharged.');
               END;
             END
              ELSE Writeln('Your Battery Pack must be present to recharge.');
             Readln;
            END;
          END;

PROCEDURE Shop(VAR P:PlayType;Planet:Integer);
          BEGIN

          END;

PROCEDURE AddStats(VAR P:PlayType;Remain:Integer);
          VAR
            AddTo:Char;
          BEGIN
            WHILE Remain>0 DO BEGIN
             ClrScr;
             GotoXY(0,0);
             Writeln('Strength:     ',P.S);
             Writeln('Dexterity:    ',P.D);
             Writeln('Intelligence: ',P.I);
             Writeln;
             IF Remain=1 THEN Writeln('You have 1 point to distribute.')
              ELSE Writeln(Remain,' points remain to distribute.');
             REPEAT
              Writeln('Type S, D, or I to add to an attribute.');
              AddTo:=ReadKey;
             UNTIL ((AddTo='S') OR (AddTo='D') OR (AddTo='I'));
             CASE AddTo OF
              'S': IF ((P.S)<20) THEN BEGIN
                    Inc(P.S);
                    Dec(Remain);
                   END;
              'D': IF ((P.D)<20) THEN BEGIN
                    Inc(P.D);
                    Dec(Remain);
                   END;
              'I': IF ((P.I)<20) THEN BEGIN
                    Inc(P.I);
                    Dec(Remain);
                   END;
             END;
            END;
          END;

PROCEDURE AddSkills(VAR P:PlayType);
          VAR
            AddTo:Char;
            A,Remain:Integer;
          BEGIN
            Remain:=P.I;
            WHILE Remain>0 DO BEGIN
             ClrScr;
             GotoXY(0,0);
             Writeln('Weapons 1 (Natural):    ',P.O);
             Writeln('Weapons 2 (Charge):     ',P.O);
             Writeln('Weapons 3 (Contact):    ',P.O);
             Writeln('Weapons 4 (Projectile): ',P.O);
             Writeln('Weapons 5 (Energy):     ',P.O);
             Writeln;
             Write(Remain);
             IF Remain=1 THEN Writeln(' point remains to distribute.')
              ELSE Writeln(' points remain to distribute.');
             REPEAT
              Writeln('Type 1, 2, 3, 4, or 5 to add to a skill.');
              AddTo:=ReadKey;
             UNTIL (AddTo>='1') AND (AddTo<='5');
             CASE AddTo OF
              '1': IF P.[1]<99 THEN BEGIN
                    Inc(P.[1])
                    Dec(Remain);
                   END;
              '2': IF P.[2]<99 THEN BEGIN
                    Inc(P.[2]);
                    Dec(Remain);
                   END;
              '3': IF P.[3]<99 THEN BEGIN
                    Inc(P.[3]);
                    Dec(Remain);
                   END;
              '4': IF P.[4]<99 THEN BEGIN
                    Inc(P.[4]);
                    Dec(Remain);
                   END;
              '5': IF P.[5]<99 THEN BEGIN
                    Inc(P.[5]);
                    Dec(Remain);
                   END;
             END;
            END;
          END;

PROCEDURE NextRank(VAR P:PlayType);
          VAR
            Ranks:RankArray;
            InText:Text;
            A,B,Freq,Total:Integer;
            Ans6,Ans7:Char;
            Needed:Real;
            Valid:Boolean;
          BEGIN
            Assign(InText,'MarmData.Pas');
            Reset(InText);
            B:=0;
            FOR A:=1 TO (DLin*(RPos-1)) DO Readln(InText);
            FOR A:=1 TO DLin DO BEGIN
             WHILE NOT EOLN(InText) DO BEGIN
              B:=B+1;
              Read(InText,Ranks[B]);
             END;
             Readln(InText);
            END;
            Close(InText);
            ClrScr;
            IF (P.R)<=15 THEN Needed:=Ranks[(P.R)+1]
             ELSE Needed:=(Ranks[(P.R)+1])+(((P.R)-16)*(250000));
            Writeln('You are presently of Rank ',P.R,'.');
            Writeln('You have collected ',P.P:1:0,' points.');
            Write('To advance to Rank ',(P.R)+1,' you require a total ');
            Writeln('of ',Needed:1:0,' points.');
            IF (P.P)<Needed THEN
             Writeln('You are ineligible for the next rank.')
             ELSE BEGIN
              Writeln('You are eligible for the next rank.');
              Writeln('There is a $',RCst,' fee for your training.');
              Writeln('Do you wish to advance? Type Y or N.');
              Ans6:=ReadKey;
              IF Ans6='Y' THEN BEGIN
               IF NOT (P.E[1].Pr) THEN BEGIN
                Write('Your Data Keeper is required ');
                Writeln('for all monetary transactions.');
               END;
               IF RCst>(P.M) THEN Writeln('You have insufficient funds.')
                ELSE IF (P.E[1].Pr) THEN BEGIN
                 P.M:=(P.M)-RCst;
                 P.R:=(P.R)+1;
                 Writeln('Abilities are enhanced through training!');
                 P.H:=(P.H)+Random(HDie);
                 P.W:=P.H;
                 IF P.J=Scholar THEN Freq:=3
                  ELSE Freq:=5;
                 IF ((P.R) MOD (2*Freq)=0) THEN Inc(P.V[7]);
                 Total:=(P.S)+(P.D)+(P.I);
                 IF (((P.R) MOD Freq)=0) AND (Total<=59) THEN AddStats(P,1)
                  ELSE Writeln('Attributes are at maximum.');
                 Total:=((P.E[].Sk)+(P.E[].Sk)+
                        (P.E[].Sk)+(P.E[].Sk));
                 IF Total<=(396-(P.I)) THEN AddSkills(P)
                  ELSE BEGIN
                   FOR A:= TO DO P.E[A].Sk:=99;
                   Writeln('Skills are at maximum.');
                  END;
                 Write('Congratulations on your advancement ');
                 Writeln('to Rank ',P.R,'.');
                 END;
                END;
              END;
             END;
            Readln;
          END;

PROCEDURE Earth(VAR P:PlayType;Planet:Integer);
          VAR
            Sur:EarthSurface;
            CX,CY,SX,SY,NX,NY:Integer;
            Other,Valid:Boolean;
          BEGIN
            ReadyGraph;
            SX:=6;
            SY:=11;
            CX:=SX-1;
            CY:=SY;
            REPEAT
             ReadMove(CX,CY,NX,NY,Other);
             Valid:=False;
             IF Other THEN BEGIN

             END
              ELSE IF Other THEN BEGIN

              END
               ELSE BorderExplain(1);

             IF Valid THEN P.T:=(P.T)+1;
             IF (P.T)>=XAge THEN BEGIN
              P.T:=0;
              P.A:=(P.A)+1;
             END;
            UNTIL (NOT P.Q) OR ((CX=SX) AND (CY=SY));
          END;

PROCEDURE MoonBase(VAR P:PlayType;Planet:Integer);
          VAR
            Sur:MoonSurface;
          BEGIN

          END;

PROCEDURE Jeydnalu(VAR P:PlayType;Planet:Integer);
          VAR
            Sur:JeydnaluSurface;
          BEGIN

          END;

PROCEDURE Galilei(VAR P:PlayType);
          VAR
            Sur:GalileiSurface;
          BEGIN

          END;

PROCEDURE Newton(VAR P:PlayType);
          VAR
            Sur:NewtonSurface;
          BEGIN

          END;

PROCEDURE Xliori(VAR P:PlayType);
          VAR
            Sur:XlioriSurface;
          BEGIN

          END;

PROCEDURE Juvenia(VAR P:PlayType);
          VAR
            Sur:JuveniaSurface;
          BEGIN

          END;

PROCEDURE Schizmus(VAR P:PlayType);
          VAR
            Sur:SchizmusSurface;
          BEGIN

          END;

PROCEDURE MechyWorld(VAR P:PlayType);
          VAR
            Sur:MechyWorldSurface;
          BEGIN

          END;

PROCEDURE Urmlicas(VAR P:PlayType);
          VAR
            Sur:UrmlicasSurface;
          BEGIN

          END;

PROCEDURE Verda(VAR P:PlayType;);
          VAR
            Sur:VerdaSurface;
          BEGIN

          END;

PROCEDURE Antediluvius(VAR P:PlayType);
          VAR
            Sur:AntediluviusSurface;
          BEGIN

          END;

PROCEDURE Port(VAR P:PlayType);
          VAR
            Ans5:Char;
          BEGIN
            ClrScr;
            Write('You have disembarked into ');
            CASE Planet OF
             1: Writeln('Karlstad Spaceport.');
             2: Writeln('the UESA base on Earth''s moon.');
             3: Writeln('the Earthling spaceport on Jeydnalu.');
            END;
            Readln;
            REPEAT
             MenuPort;
             REPEAT
              Writeln('Select a course of action.');
              Ans5:=ReadKey;
             UNTIL ChoiceOK(Ans5,7,False);
             CASE Ans5 OF
              'A': NewEngine(P.C.Range,P.A,P.M,P.E[1].Pr);
              'B': BuyFood(P.F,P.C.Food,P.M,P.E[1].Pr,P.E[4].Pr);
              'C': Recharge(P.B,P.M,P.E[1].Pr,P.E[2].Pr,P.E[3].Pr);
              'D': Shop(P,Planet);
              'E': NextRank(P);
              'F': CASE Planet OF
                  1: {Earth(P,Planet)};
                  2: MoonBase(P,Planet);
                  3: Jeydnalu(P,Planet);
                 END;
             END;
            UNTIL Ans5='G';
          END;

PROCEDURE ReadGrid(VAR Grid:RangeGrid);
          VAR
            InText:Text;
            A,X,Y:Integer;
          BEGIN
            Assign(InText,'MarmData.Pas');
            Reset(InText);
            FOR A:=1 TO (DLin*(GPos-1)) DO Readln(InText);
            FOR X:=2 TO Plan DO
             FOR Y:=1 TO (X-1) DO BEGIN
              IF EOLN(InText) THEN Readln(InText);
              Read(InText,Grid[X,Y]);
             END;
            Close(InText);
            FOR X:=2 TO Plan DO
             FOR Y:=1 TO (X-1) DO Grid[Y,X]:=Grid[X,Y];
            FOR A:=1 TO Plan DO Grid[A,A]:=5;
          END;

PROCEDURE Launch(VAR P:PlayType;VAR Ranges:RangeGrid);
          VAR
            Move:Char;
          BEGIN
            MenuLaunch(P.C.Range,Ranges);
            REPEAT
             Move:=ReadKey;
            UNTIL ((P.C.Range)>=(Ranges[P.L,Move])) OR (Move='X');
            IF Move<>'X' THEN BEGIN
             IF Ranges[P.L,Move]>1 THEN Inc(P.A);
             P.L:=Move;
            END;
          END;

PROCEDURE Leave(VAR P:PlayType);
          BEGIN
            CASE P.L OF
             'A','B','C': SpacePort(P);
             'D': Galilei(P);
             'E': Newton(P);
             'F': Xliori(P);
             'G': Juvenia(P);
             'H': Schizmus(P);
             'I': MechyWorld(P);
             'J': Urmlicas(P);
             'K': Verda(P);
             'L': Antediluvius(P);
            END;
          END;

PROCEDURE OnBoard(VAR P:PlayType);
          VAR
            Ranges:RangeGrid;
          BEGIN
            ReadGrid(Ranges);
            REPEAT
             MenuOnBoard(P.L);
             REPEAT
              Move:=ReadKey;
             UNTIL ChoiceOK(Move,9,True);
             IF Move<>'X' THEN
              CASE Move OF
               'A': ViewChar(P);
               'B': ChooseRefer;
               'C': Recharge(P);
               'D': ReFood(P);
               'E': ReEquip(P);
               'F': Rest(P,True);
               'G': SaveChar(P);
               'H': Launch(P,Ranges);
               'I': Leave(P);
              END;
            UNTIL Move='X';
          END;

PROCEDURE SubCreate(VAR P:PlayType);           {starting character attributes}
          VAR
            A:Integer;
          BEGIN
            P.A:=20;
            P.B:=99;
            P.C.Range:=1;
            P.C.Food:=36;
            FOR A:=1 TO Obj DO BEGIN
             P.C.Equip[A]:=0;
             P.E[A]:=False;
            END;
            P.C.Equip[2]:=1;
            P.C.Equip[4]:=1;
            P.C.Equip[23]:=1;
            P.C.Equip[39]:=1;
            P.E[1]:=True;
            P.F:=9;
            P.H:=(P.S)+Random(HDie);
            P.K:=0;
            P.M:=0;
            P.O:=1;
            P.P:=0;
            P.R:=1;
            P.V:=0;
            P.W:=P.H;
          END;

PROCEDURE ChooseProf(VAR P:PlayType);
          VAR
            A:Integer;
            Ans4:Char;
          BEGIN
            MenuProf;
            REPEAT
             Writeln('Select a profession to pursue.');
             Ans4:=ReadKey;
            UNTIL ChoiceOK(Ans4,13,False);
            CASE Ans4 OF
             'A': BEGIN
                   P.J:=Explorer;
                   P.C.Range:=2;
                  END;
             'B': BEGIN
                   P.J:=Trader;
                   P.M:=P.M+TMon;
                  END;
             'C': BEGIN
                   P.J:=Sniper;
                   P.T[4]:=30;
                  END;
             'D': BEGIN
                   P.J:=Survivalist;
                   P.H:=(P.H)+(P.S);
                   P.W:=P.H;
                  END;
             'E': BEGIN
                   P.J:=Tourist;
                   P.C.Food:=999;
                   P.C.Equip[6]:=1;
                  END;
             'F': BEGIN
                   P.J:=Patroller;
                   P.C.Equip[49]:=1;
                  END;
             'G': P.J:=Scholar;
             'H': BEGIN
                   P.J:=Mercenary;
                   Inc(P.S);
                  END;
             'I': BEGIN
                   P.J:=Spy;
                   Inc(P.D);
                  END;
             'J': BEGIN
                   P.J:=Scientist;
                   Inc(P.I);
                  END;
             'K': BEGIN
                   P.J:=Electrician;
                   P.C.Equip[3]:=1;
                   P.C.Equip[7]:=1;
                   P.B:=199;
                  END;
             'L': BEGIN
                   P.J:=Bomber;
                   P.C.Equip[14]:=1;
                   P.C.Equip[16]:=1;
                   P.C.Equip[17]:=1;
                   P.C.Equip[18]:=1;
                  END;
             'M': BEGIN
                   P.J:=Physician;
                   P.C.Equip[21]:=3;
                   P.C.Equip[11]:=1;
                  END;
            END;
          END;

PROCEDURE Create(VAR Play:PlayArrayRec);
          VAR
            A:Integer;
            Ans:Char;
          BEGIN
            IF (Play.C)<CMax THEN BEGIN
             ClrScr;
             Inc(Play.C);
             A:=0;
             Play[Play.C].N.N:=Blnk;
             Write('Name your new character.');
             Writeln(' Use up to ',NMax,' characters.');
             WHILE (NOT EOLN) AND (A<NMax) DO BEGIN
              A:=A+1;
              Read(Play.P[Play.C].N.N[A]);
             END;
             Readln;
             REPEAT
              Writeln('Choose your character''s gender:');
              Writeln('[A] Female   [B] Male');
              Ans:=ReadKey;
             UNTIL ChoiceOK(Ans,MChr(2),False);
             IF Ans='A' THEN Play.P[Play.C].G:=Female
              ELSE Play.P[Play.C].G:=Male;
             Play.P[Play.C].N.L:=A;
             Play.P[Play.C].U:=Play.C;
             Play.P[Play.C].S:=11;
             Play.P[Play.C].D:=11;
             Play.P[Play.C].I:=11;
             AddStats(Play.P[Play.C],Xtra);
             SubCreate(Play.P[Play.C]);
             ChooseProf(Play.P[Play.C]);
             AddSkills(Play.P[Play.C]);
             Write('This character will begin ');
             IF Play.P[Play.C].G=Male THEN Writeln('his adventuring at:')
              ELSE Writeln('her adventuring at:');
             Writeln('Karlstad Spaceport, European Federation, Earth.');
             IF Play.P[Play.C].G=Male THEN Write('His spacecraft is ')
              ELSE Write('Her spacecraft is ');
             Writeln('equipped with a hydrogen propulsion system.');
            END
             ELSE Writeln('Only ',MOrd(CMax),' characters may exist.');
            Readln;
          END;

PROCEDURE Delete(VAR Play:PlayArrayRec);
          VAR
            A,Ans:Char;
          BEGIN
            MenuChar(Play);
            REPEAT
             Ans:=ReadKey;
            UNTIL ChoiceOK(Ans,Play.C,True);
            IF Ans<>'X' THEN BEGIN
             FOR A:=Ans TO (Dec(Play.C)) DO Play.P[A]:=Play.P[Inc(A)];
             FOR A:=Ans TO (Dec(Play.C)) DO Dec(Play.P[A].U);
             Dec(Play.C);
             Writeln('Character deleted.');
             Readln;
            END;
          END;

PROCEDURE ViewChars(VAR Play:PlayArrayRec);
          VAR
            Ans:Char;
          BEGIN
            MenuChar(Play);
            REPEAT
             Ans:=ReadKey;
            UNTIL ChoiceOK(Ans,Play.C,True);
            IF Ans2<>'X' THEN CharDisp(Play.P[Ans]);
          END;

PROCEDURE Rename(VAR Play:PlayArrayRec);
          VAR
            A:Integer;
            Ans:Char;
          BEGIN
            MenuChar(Play);
            REPEAT
             Ans:=ReadKey;
            UNTIL ChoiceOK(Ans,Play.C,True);
            IF Ans<>'X' THEN BEGIN
             A:=0;
             Writeln('Type');
             Play.P[Ans].N.N:=Blnk;
             WHILE (A<NMax) AND (NOT EOLN) DO BEGIN
              A:=A+1;
              Read(Play.P[Ans].N.N[A]);
             END;
             Readln;
             Writeln('Character renamed.');
             Readln;
            END;
          END;

PROCEDURE Clone(VAR Play:PlayArrayRec);
          VAR
            Ans:Char;
          BEGIN
            IF (Play.C)<CMax THEN BEGIN
             MenuChar(Play);
             REPEAT
              Ans:=ReadKey;
             UNTIL ChoiceOK(Ans,Play.C,True);
             IF Ans2<>'X' THEN BEGIN
              Inc(Play.C);
              Play.P[Play.C]:=Play.P[Ans];
              Play.P[Play.C].N.N[NMax-4]:='C';
              Play.P[Play.C].N.N[NMax-3]:='L';
              Play.P[Play.C].N.N[NMax-2]:='O';
              Play.P[Play.C].N.N[NMax-1]:='N';
              Play.P[Play.C].N.N[NMax-0]:='E';
              Play.P[Play.C].U:=Play.C;
              Writeln('Character cloned.');
             END;
            END
             ELSE Writeln('Only ',CMax,' characters may exist at one time.');
            Readln;
          END;

PROCEDURE Adventure(VAR Play:PlayArrayRec);
          VAR
            Ans:Char;
          BEGIN
            MenuChar(Play);
            REPEAT
             Ans:=ReadKey;
            UNTIL ChoiceOK(Ans,Play.C,True);
            IF Ans2<>'X' THEN OnBoard(Play.P[Ans]);
          END;

PROCEDURE Reset(VAR Play:PlayArrayRec);
          VAR
            Ans:Char;
          BEGIN
            REPEAT
             Ans:=ReadKey;
            UNTIL (Ans='Y') OR (Ans='N');
            IF Ans='Y' THEN InputAllChars(Play);
          END;

PROCEDURE Saver(VAR Play:PlayArrayRec);
          VAR
            Ans:Char;
          BEGIN
            REPEAT
             Ans:=ReadKey;
            UNTIL (Ans='Y') OR (Ans='N');
            IF Ans='Y' THEN SaveAllChars(Play);
          END;

PROCEDURE Exitor(VAR Exit:Boolean);
          VAR
            Ans:Char;
          BEGIN
            REPEAT
             Ans:=ReadKey;
            UNTIL (Ans='Y') OR (Ans='N');
            IF Ans='Y' THEN Exit:=True;
          END;

BEGIN
  ClrScr;
  Writeln('Preparing for simulation...');
  InputAllChars(Play);
  WriteIndex;
  Exit:=False;
  Randomize;
  ClrScr;
  Writeln('Welcome to SPACE MARMOSET.');
  Writeln('For additional information on how to pay Josh heaps of money');
  Writeln('please call (216)234-1789 during normal business hours.');
  Writeln;
  REPEAT
   MenuMain;
   REPEAT
    Writeln('Select a course of action.');
    Ans:=ReadKey;
   UNTIL (ChoiceOK(Ans,10,False)) OR (Ans='!');
   CASE Ans OF
    'A': Help;
    'B': ViewChars(Play);
    'C': Create(Play);
    'D': Rename(Play);
    'E': Delete(Play);
    'F': Clone(Play);
    'G': Adventure(Play);
    'H': Reset(Play);
    'I': Saver(Play);
    'J': Exitor(Exit);
    '!': {EditMain};
   END;
   ClrScr;
  UNTIL Exit;
END.