OVERLAY


PROCEDURE INIT;

  VAR
      L     : INTEGER;
      DONE  : BOOLEAN;
      alias : str;
      piont : integer;
      Ack   : char;
BEGIN
  ASSIGN(MSGER,'tradewar\TWOPENG.DAT');
  RESET(MSGER);
  APPEND(MSGER);
  ASSIGN(teams,'tradewar\twteam.dat');
  RESET(teams);
  ASSIGN(SMG,'tradewar\TWSMF.DAT');
  ENDED := FALSE;
  ASSIGN(USERF,'tradewar\TWDATA.DAT');
  RESET(USERF);
  READIN(1,USERR);
  planets := TRUE;
  ports   := TRUE;
  players := TRUE;
  WITH USERR DO
    BEGIN
      AY := FC;
      TT := FD;
      LP := FE;
      LS := FF;
      LT1 := FG;
      LL1 := FO;
    END;
  GETDATE;
  NL;
  ANSIC(3);
  cls;
  PRINTFILE('tradewar\twhello.msg');
  CLS;
  ANSIC(4);
  PRINTFILE('tradewar\TWOPENG.DAT');
  PAUSESCR;
  APPEND(MSGER);
  cls;
  ANSIC(6);
  NL;
  PRINT('Initializing...');
  PD := D;
  NL;
  PRINT('Welcome '+THISUSER.NAME+'!');
  PRINT('Searching my records for your name.');
  L := 2;
  DONE := FALSE;
  REPEAT
    READIN(L,USERR);
    IF USERR.FAREAL=THISUSER.NAME
      THEN
        BEGIN
          PN := L;
          DONE := TRUE;
        END;
    L := L+1;
  UNTIL DONE OR (L>LP) OR HANGUP;
  IF NOT DONE
    THEN
      BEGIN
        PRINT(
           'I can''t find your record, so I am assuming you are a new trainee.'
        );
        NL;
        PRINT('Entering a new trainee...');
        PN := 2;
        DONE := FALSE;
        REPEAT
          READIN(PN,USERT);
          IF USERT.FM < 1
            THEN
              DONE := TRUE;
          PN := PN+1;
        UNTIL DONE OR (PN>LP);
        PN := PN-1;
        IF NOT DONE
          THEN
            BEGIN
              PRINT('I''m sorry but the game is full.');
              PRINT('Please leave a message for the Emperor so');
              PRINT('he can save a space for you when one opens up.');
              SYSOPLOG(TIME+' '+DATE+' '+THISUSER.NAME+
                       ': New player not allowed - game full.');
              ENDED := TRUE;
            END
          ELSE
            BEGIN
              READIN(1,USERT);
              NL;
              PRINT('Notice: If you don''t play for '+CSTR(USERT.
                    FK)
                 +' days, you will');
              PRINT('be.....removed to make room for someone else.');
              NL;
              alias := '';
              prompt('Do you wish to use an Alias? ');
              if yn then
                 begin
                    prompt('Enter the Alias you want to use ');
                    mpl(41);
                    inputl(alias,41);
                    if alias<>'' then
                       userr.fa := alias;
                 end;
              if alias='' then
                 begin
                    alias := nam;
                    piont := pos('#',alias)-1;
                    DELETE(alias,piont,9);
                 end;
              READIN(PN,USERR);
              USERR.FA := ALIAS;
              USERR.FAREAL := THISUSER.NAME;
              USERR.FM := LENGTH(alias);
              USERR.FR := 0;
              WRITEOUT(PN,USERR);
              SYSOPLOG(TIME+' '+DATE+' '+USERR.FAREAL+
                       '('+CSTR(PN)+'): New Player on Trade Wars');
              SYSOPLOG('Under the assumed name of '+userr.fa);
              INITSHIP;
            END;
      END
    ELSE
      BEGIN
        PNN := USERR.FA;
        NL;
        SYSOPLOG(TIME+' '+DATE+' '+PNN+'('+CSTR(PN)+'): Tradewars.');
        READIN(PN,USERR);
        if userr.fr <> 0 then
        begin
          SEEK(teams,userr.fr);
          read(teams,rteams);
        end;
        A := USERR.FB;
        DONE := FALSE;
        IF A>PD
          THEN
            BEGIN
              PRINT('You won''t be allowed on for another '+CSTR(A-PD)+' day(s)!');
              ENDED := TRUE;
            END;
        IF ((A=PD) AND (USERR.FC<>-99))
          THEN
            BEGIN
              ANSIC(6);
              PRINT('You have been on today.');
              IF USERR.FD<1
                THEN
                  BEGIN
                    ANSIC(8);
                    PRINT('You don''t have any turns left today.'+
                          ' You will be allowed to play tomorrow.');
                    ENDED := TRUE;
                    ANSIC(1);
                  END;
              IF USERR.FC=PN
                THEN
                  BEGIN
                    PRINT('Oi Vey!! You killed yourself today! Maybe you will be allowed on tomorrow');
                    ENDED := TRUE;
                  END;
            END;
        IF (A<PD) OR ((A=PD) AND (NOT ENDED) AND (USERR.FC<>99))
          THEN
            BEGIN
              READMSG;
              IF (USERR.FC=0) OR (USERR.FC=-75)
                THEN
                  BEGIN
                    IF (USERR.FD<=TT) AND (USERR.FB<PD)
                      THEN
                        BEGIN
                          USERR.FD := TT;
                          USERR.FB := PD;
                          WRITEOUT(PN,USERR);
                        END;
                    DONE := TRUE;
                    NL;
                    PRINT('You have '+CSTR(USERR.FD)+' turns this Stardate.');
                  END;
            END;
        IF (NOT ENDED) AND (NOT DONE)
          THEN
            BEGIN
              A := USERR.FC;
              IF A=-99
                THEN
                  INITSHIP
                ELSE
                  BEGIN
                    IF A=-98
                      THEN
                        PRINT('You have been destroyed by a person '+
                                 'who has been...removed from the game.');
                    IF A=-1
                      THEN
                        PRINT('You have been ambushed by the Ferrengi!');
                    IF A=PN
                      THEN
                        BEGIN
                          NL;
                          PRINT(
                       'You managed to Q''est'' yourself on your last time on.'
                          );
                        END;
                    IF (A>1) AND (A<=LP)
                      THEN
                        BEGIN
                          READIN(A,USERT);
                          PRINT(USERT.FA+' destroyed your ship!');
                        END;
                    INITSHIP;
                  END;
            END;
      END;
END;

OVERLAY

PROCEDURE COMPUTER;

  VAR
      PRR,S2,N : INTEGER;
      I        : STR;

  PROCEDURE FINDSEC(PRR:INTEGER);

    VAR
        A,B,SUD   : INTEGER;
        I : STR;
  BEGIN
    A := PRR;
    PROMPT('What sector do you want to get to? ');
    INPUT(I,4);
    IF I<>''
      THEN
        BEGIN
          B := VALUE(I);
          IF (B<1) OR (B>LS-LP)
            THEN
              PRINT('Valid sector numbers are from 1 to '+CSTR(LS-LP)+'.')
            ELSE
              IF A=B
                THEN
                  PRINT('You are already in that sector!')
                ELSE
                  BEGIN
                    NL;
                    PRINT('Computing shortest path...');
                    SHORTEST(A,B);
                    IF S[A,1]=0
                      THEN
                        PRINT(
                           'There was an error in computation between sectors.'
                        )
                      ELSE
                        BEGIN
                          NL;
                          PRINT('The shortest path from sector '
                                +CSTR(A)+' to sector '+CSTR(B)+' is:');
                          PROMPT(CSTR(A));
                          SUD := A;
                          REPEAT
                            SUD := S[SUD,1];
                            IF SUD<>0
                              THEN
                                PROMPT(' > '+CSTR(SUD))
                              ELSE
                                NL;
                          UNTIL SUD=0;
                          READIN(LP+PRR,USERT);
                          E[1] := USERT.FB;
                          E[2] := USERT.FC;
                          E[3] := USERT.FD;
                          E[4] := USERT.FE;
                          E[5] := USERT.FF;
                          E[6] := USERT.FG
                        END;
                  END;
        END;
  END;


  PROCEDURE SNDMSSG;

   VAR
      PID,PPTR    : INTEGER;
      MESSAGE1    : STRING[160];
      SCANSTRING  : STRING[41];
      PFOUND      : BOOLEAN;
      ANSWER      : STRING[2];
      USERZ       : USERS;

   BEGIN
       ANSWER := 'N';
       NL;
       ANSIC(3);
       PROMPT('Enter part of name to search for - ');
       MPL(41);
       INPUTL(SCANSTRING,41);
       IF (scanstring <> '') then
        begin
          PPTR := 2;
          PID  := 0;
          PFOUND := FALSE;
          REPEAT
             READIN(PPTR,USERZ);
             IF (POS(SCANSTRING,USERZ.FA)>0) AND (USERZ.FM>0) THEN
             BEGIN
                ANSIC(4);
                PROMPT('Send to '+USERZ.FA+'? ');
                IF yn THEN
                BEGIN
                   SSM(PPTR,'Hyperspace message received from '+userr.fa+':');
                   PROMPT('Enter message [160 chars]');
                   NL;
                   INPUTL(MESSAGE1,160);
                   SSM(PPTR,MESSAGE1);
                   SSM(PPTR,' ');
                   prompt('Transmission sent');
                   nl;
                   PFOUND := TRUE;
                END;
             END;
             PPTR := PPTR + 1;
          UNTIL PFOUND OR HANGUP OR (PPTR >= LP);
        end;
    IF (ANSWER='N') AND (PPTR >= LP) THEN
      BEGIN
        ANSIC(8);
        PROMPT('Name not found!');
      END;
 END;


 PROCEDURE REPORTSEC(S2:INTEGER);

    VAR
        I: STR;
        A,P: INTEGER;
  BEGIN
    PROMPT('What sector is the port in? ['+cstr(prr)+'] ');
    INPUT(I,4);
        BEGIN
          if (I='') then a := prr
          else  A := VALUE(I);
          IF (A<1) OR (A>LS-LP)
            THEN
              PRINT('The Empire only possesses sectors 1 to '+CSTR(LS-LP)+'.')
            ELSE
              BEGIN
                READIN(LP+A,USERT);
                P := USERT.FH;
                IF (P=0) OR ( ((USERT.FL>0) AND (USERT.FM<>PN)) AND
                              ((userr.fr>0) AND ((-1*(usert.fm+10))<>userr.fr)) )
                  THEN
                    BEGIN
                      NL;
                      PRINT('I have no information about that port.');
                    END
                  ELSE
                    IF (P <> 1) AND (P <> 153) AND (P <> 154)
                      THEN
                        BEGIN
                          UPPORT(LP+A);
                          OTHERPORT(P+LS);
                        END
                      ELSE
                        PORT1;
              END;
        END;
  END;


  PROCEDURE RANKINGS;

    VAR
        P,R        : INTEGER;
        ABORT,NEXT : BOOLEAN;
        temy       : str;
  BEGIN
    cls;
    ANSIC(8);
    NL;
    PRINT('Ranking players...');
    RANK(P);
    cls;
    ansic(3);
    PRINT('Player Rankings: '+DATE+' '+TIME);
    NL;
    ANSIC(5);
    PRINT('Rank     Value       Team    Player   ');
    ANSIC(2);
    PRINT('~~~~  ~~~~~~~~~~~~ ~~~~~~~~ ~~~~~~~~ ');
    R := 1;
    ANSIC(1);
    ABORT := FALSE;
    REPEAT
      READIN(P,USERT);
      if r = 1 then ansic(6);
      if p = pn then ansic(6);
      if usert.fr <> 0 then
        begin
          temy := '  ['+addblank(cstr(usert.fr),2)+']  ';
        end
      else temy := 'Indpndnt';
      if usert.fv > 0 then
      PRINTACR(ADDBLANK(CSTR(R),4)+ADDBLANK(CSTR(USERT.FV),14)
               +' '+temy+' '+USERT.FA,ABORT,NEXT)
      else
      PRINTACR(ADDBLANK(CSTR(R),4)+'          Dead'
               +' '+temy+' '+USERT.FA,ABORT,NEXT);

      P := USERT.FT;
      R := R+1;
    UNTIL (P=-1) OR ABORT;
  END;

BEGIN
  cls;
  ANSIC(8);
  PRINT('<Computer>');
  NL;
  ANSIC(2);
  PRINT('<Computer activated>');
  ANSIC(1);
  DONE := FALSE;
  READIN(PN,USERR);
  PRR := USERR.FF;
  S2 := PRR+LP;
  WHILE (NOT HANGUP) AND (NOT DONE) DO
    BEGIN
      DUMP;
      TLEFT;
      NL;
      PROMPT('Computer command (?=Help)? ');
      MMKEY(I);
      IF I=''
        THEN
          PRINT('? = Help');
      CASE I[1] OF
        'Q','q','1' : DONE := TRUE;
        'P','p','2' : REPORTSEC(S2);
        'F','f','3' : FINDSEC(PRR);
        'R','r','4' : RANKINGS;
        'S','s','5' : SNDMSSG;
        'V','v','6' : PRINTFILE('tradewar\twmap.msg');
        'T','t','7' : BEGIN
                        NL;
                        ANSIC(4);
                        PRINT(DAT);
                        NL;
                      END;
       ELSE           PRINTFILE('tradewar\twcmenu.msg');
      END;
    END;
  NL;
  PRINT('<Computer deactivated>');
END;

OVERLAY

PROCEDURE PORT;

  VAR
      ST,R,P2,F2,L2,A           : INTEGER;
      DONEIT                    : BOOLEAN;
      M2,NUH,C2                 : REAL;

PROCEDURE IDUNNO;
BEGIN
  READIN(P2,USERT);
  IF L2=1
    THEN
      USERT.FD := TRUNC(N[1]-NUH)
    ELSE
      IF L2=2
        THEN
          USERT.FE := TRUNC(N[2]-NUH)
        ELSE
          USERT.FF := TRUNC(N[3]-NUH);
  WRITEOUT(P2,USERT);
END;

PROCEDURE DUNNO2;

  VAR
      S : INTEGER;
BEGIN
  s := SGN(TRUNC(C1[L2]));
  USERR.credits := M2-s*A;
  IF L2=1
    THEN
      USERR.FI := TRUNC(H[1]+S*NUH)
    ELSE
      IF L2=2
        THEN
          USERR.FJ := TRUNC(H[2]+S*NUH)
        ELSE
          USERR.FK := TRUNC(H[3]+S*NUH);
  WRITEOUT(PN,USERR);
  IDUNNO;
  H[L2] := H[L2]+S*trunc(NUH);
END;

PROCEDURE TRADE(L2:INTEGER);

  VAR
      V,HUH,B   : INTEGER;
      MUH       : REAL;
      DIM,EIM,I : STR;
BEGIN
  M2 := USERR.credits;
  HUH := TRUNC(H[0]-H[1]-H[2]-H[3]);
  IF C1[L2]>0
    THEN
      BEGIN
        DIM := 'buy';
        EIM := 'sell';
        B := -1;
      END
              ELSE
                BEGIN
                  DIM := 'sell';
                  EIM := 'buy' ;
                  B := 0;
                END;
  IF B=-1
    THEN
      BEGIN
        MUH := HUH;
        IF trunc(MUH) > N[L2]
          THEN
            MUH := N[L2];
      END;
  IF B=-1
    THEN
      BEGIN
        IF MUH*M[L2] > M2
          THEN
            MUH := M2/M[L2]
      END;
  IF B=0
    THEN
      BEGIN
        MUH := N[L2];
        IF MUH>TRUNC(H[L2])
          THEN
            MUH := TRUNC(H[L2]);
      END;
  IF MUH<>0
    THEN
      BEGIN
        DONE := FALSE;
        REPEAT
          NL;
          PRINT('You have '+CSTRR(M2,10)+' credits and '+CSTR(HUH)+
          ' empty cargo holds.');
          NL;
          PRINT('We are '+EIM+'ing up to '+CSTR(ROUND(N[L2]))+
                '.  You have '+CSTR(ROUND(H[L2]))+' in your holds.');
          F2 := 1;
          PROMPT('How many holds of ');
          IF L2=1
            THEN
              PROMPT('Ore')
            ELSE
              IF L2=2
                THEN
                  PROMPT('Organics')
                ELSE
                  PROMPT('Equipment');
          PROMPT(' do you want to '+DIM+' ['+CSTRR(MUH,10)+']? ');
          INPUT(I,4);
          IF I=''
            THEN
             NUH := MUH
            ELSE
              NUH := VALUE(I);
          IF NUH=0
            THEN
              DONE := TRUE;
          IF NUH>=1
            THEN
              IF (B=-1) AND (NUH>HUH)
                THEN
                  PRINT('You don''t have enough cargo holds.')
                ELSE
                  IF (B=-1) AND (trunc(NUH)>N[L2])
                    THEN
                      PRINT('They''re not selling that many.')
                    ELSE
                      IF (B=0) AND (trunc(NUH)>N[L2])
                        THEN
                          PRINT('They don''t want that many.')
                        ELSE
                          IF (B=0) AND (trunc(NUH)>H[L2])
                            THEN
                              PRINT('You don''t have that many in your holds.')
                            ELSE
                              DONE := TRUE;
        UNTIL HANGUP OR DONE;
        IF (NUH>=1) AND (NOT HANGUP)
          THEN
            BEGIN
              PRINT('Agreed, '+CSTRR(NUH,10)+' units.');
              V := RANDOM(3)+1;
              R := 1;
              DONEIT := FALSE;
              REPEAT
                NL;
                IF R=V+1
                  THEN
                    PROMPT('Our final offer is ')
                  ELSE
                    IF B=-1
                      THEN
                        PROMPT('We''ll sell them for ')
                      ELSE
                        PROMPT('We''ll buy them for ');
                PRINT(CSTR(TRUNC(NUH*M[L2]*(1+C1[L2]/1000)+0.5))+' credits.');
                REPEAT
                  DONE := TRUE;
                  PROMPT('Your offer? ');
                  INPUT(I,5);
                  A := VALUE(I);
                  IF (A<M[L2]*trunc(NUH)/10) OR (A>M[L2]*trunc(NUH)*10)
                    THEN
                      BEGIN
                        NL;
                        PRINT('Imperial Intelligence frowns upon those who are'
                        );
                        PRINT('too flippant. Make a SERIOUS offer...');
                        DONE := FALSE;
                      END;
                  IF (A>M2) AND (B=-1)
                    THEN
                      BEGIN
                        PRINT('  You only have '+CSTRR(M2,10)+' credits!');
                        DONE := FALSE;
                      END;
                UNTIL HANGUP OR DONE;
                IF (B=0) AND (A<=M[L2]*trunc(NUH))
                  THEN
                    BEGIN
                      ANSIC(8);
                      PRINT('Agreed! We''ll PURCHASE them!');
                      ANSIC(1);
                      DUNNO2;
                      DONEIT := TRUE;
                    END
                  ELSE
                    IF (B=-1) AND (A>=M[L2]*trunc(NUH))
                      THEN
                        BEGIN
                          ANSIC(8);
                          PRINT('Sold!');
                          ANSIC(1);
                          DUNNO2;
                          DONEIT := TRUE;
                        END
                      ELSE
                        BEGIN
                          T := TRUNC(NUH*M[L2]*(1-C1[L2]/250/R)+0.5);
                          IF (B=0) AND (A>T)
                            THEN
                              BEGIN
                                IDUNNO;
                                ANSIC(7);
                                PRINT(
                               'Too high.  We''ll buy them from Orion Traders.'
                                );
                                ANSIC(1);
                                DONEIT := TRUE;
                              END
                            ELSE
                              IF (B=-1) AND (A<T)
                                THEN
                                  BEGIN
                                    IDUNNO;
                                    ANSIC(6);
                                    NL;
                                    PRINT(
                               'Too low.  We''ll scalp them to the Federation.'
                                    );
                                    ANSIC(1);
                                    DONEIT := TRUE;
                                  END;
                          M[L2] := 0.7*M[L2]+0.3*A/trunc(NUH);
                        END;
                R := R+1;
              UNTIL HANGUP OR DONEIT OR (R>V+1);
            END;
      END;
END;

BEGIN
  ANSIC(8);
  PRINT('<Port>');
  ANSIC(3);
  NL;
  PRINT('Docking...');
  ANSIC(1);
  A := USERR.FD;
  IF A<1
    THEN
      BEGIN
        ANSIC(8);
        PRINT