COMMANDS.PAS

   1 {//-------------------------------------------------------------------------}
   2 {/*                                                                         }
   3 {Copyright (C) 1990, 2009 - Apogee Software, Ltd.                           }
   4 {                                                                           }
   5 {This file is part of Supernova.  Supernova is free software; you can       }
   6 {redistribute it and/or modify it under the terms of the GNU General Public }
   7 {License as published by the Free Software Foundation; either version 2     }
   8 {of the License, or (at your option) any later version.                     }
   9 {                                                                           }
  10 {This program is distributed in the hope that it will be useful,            }
  11 {but WITHOUT ANY WARRANTY; without even the implied warranty of             }
  12 {MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                       }
  13 {                                                                           }
  14 {See the GNU General Public License for more details.                       }
  15 {                                                                           }
  16 {You should have received a copy of the GNU General Public License          }
  17 {along with this program; if not, write to the Free Software                }
  18 {Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.}
  19 {                                                                           }
  20 {Original Source: 1990 Scott Miller                                         }
  21 {Prepared for public release: 03/19/09 - Joe Siegler, Apogee Software, Ltd. }
  22 {*/                                                                         }
  23 {//-------------------------------------------------------------------------}
  24 {****************************************************************************}
  25 {*                                COMMANDS                                  *}
  26 {*                            by Scott Miller                               *}
  27 {*  These are misc procedures and functions used with the main file: AdGame *}
  28 {*                        Copyright 1984 Pending                            *}
  29 {****************************************************************************}
  30
  31 procedure SA;
  32    begin FlagSA:='s' end;
  33
  34 function En(c : char) : boolean;
  35    begin
  36      if(c in Ev)then En:=True else En:=False
  37    end;
  38
  39 function Here(noun : integer): Boolean;
  40    begin
  41      if(noun in Inven)or(r[noun]=Prm)or(noun in p[Prm])then Here:=True
  42      else Here:=False
  43    end;
  44
  45 procedure Crazy;
  46    begin SA;
  47     if(random(2)=1)then RL(107+random(7))else RL(300+random(6));
  48    end;
  49
  50 procedure DEAD;
  51     var b,c:integer;
  52    begin SA; NoSound;
  53      gotoxy(1,25);for x:=1 to 7 do writeln;
  54      Textcolor(1);Textbackground(m9);
  55      gotoxy(1,18);
  56      write('*********************************************************',
  57            '***********************');writeln;
  58      gotoxy(1,19); for x:=1 to 3 do
  59      write('*                                                        ',
  60              '                      *');writeln;
  61      gotoxy(1,22);
  62      write('*********************************************************',
  63            '***********************');writeln;
  64      TextColor(m0);gotoxy(27,20);writeln('\82 \82È\82½\82Í\8e\80\82ñ\82Å\82µ\82Ü\82Á\82½!!!');
  65      Textcolor(m2);Textbackground(0);
  66      for c:=700 downto 20 do for b:=70 downto 1 do sound(b*c);nosound;
  67      close(Rooms1);close(rooms2);close(special1);close(special2);close(line1);
  68      gotoxy(1,23);DelLine;DelLine;writeln;write('\82â\82è\92¼\82µ\82Ü\82·\82©? ');
  69      flag := readkey;
  70      if(upcase(flag)<>'N')then
  71       begin
  72        writeln('\82à\82¤\88ê\93x\81c');window(1,1,80,25);
  73        halt(executeProcess(ParamStr(0), '', []));
  74       end
  75      else
  76       begin
  77        textcolor(7);
  78        textbackground(0);
  79        window(1,1,80,25);
  80        clrscr;
  81        writeln('    Beyond the Titanic');
  82        writeln('A Scott Miller Production');
  83        writeln('    Have a nice day...');
  84        delay(2000);
  85        halt(0);
  86       end
  87    end;
  88
  89 procedure Home;
  90   var b,c:integer;
  91    begin SA;
  92      gotoxy(1,25);for x:=1 to 7 do writeln;
  93      Textcolor(25);Textbackground(m7);
  94      gotoxy(1,18);
  95      write('#########################################################',
  96            '#######################');writeln;
  97      gotoxy(1,19); for x:=1 to 3 do
  98      write('#                                                        ',
  99              '                      #');writeln;
 100      gotoxy(1,22);
 101      write('#########################################################',
 102            '#######################');writeln;
 103      TextColor(31);gotoxy(25,20);writeln('\82  \82È \82½ \82Í \8f\9f \97\98 \82µ \82½ ! ! !');
 104      Textcolor(m2);Textbackground(0);
 105      gotoxy(1,23);DelLine;DelLine;writeln;
 106      for x:=150 downto 1 do begin sound(x*55);delay(8);nosound;delay(20)end;
 107      if(Sc>1000)then Sc:=1000;
 108      write('\82 \82È\82½\82Í\82±\82Ì\83Q\81[\83\80\82Å',Sc,'\93_\82ð\8al\93¾\82µ\81A');
 109      if(Sc=1000)then
 110       begin writeln('\8a®àø\82È\96`\8c¯\8eÒ\82Æ\82È\82Á\82½!!!');
 111         for y:=1 to 7 do
 112          for o:=0 to 20 do
 113            for x:= 99+(o*430)to 998+(o*430)do begin sound(25);sound(x)end
 114       end
 115      else writeln('\92B\90l\96`\8c¯\8eÒ\82Æ\82È\82Á\82½!');
 116      for c:=1 to 999 do for b:=1 to 61 do sound(b*c);nosound;
 117      writeln;nosound;
 118      writeln('\83R\83\93\83s\83\85\81[\83^\82ð\8dÄ\8bN\93®\82µ\82Ä\82\82¾\82³\82¢\81c')
 119   end;
 120
 121 procedure Say(o : integer; p : Str16);
 122    begin
 123      writeln(n[o,1],'\82Í\8aù\82É',p,'\81B'); SA
 124    end;
 125
 126 procedure Diagnose;
 127    begin
 128      RL(191);
 129      if((tic>42)and not(en('c')))or((tic>146)and not(en('n')))or(en('r'))then
 130       begin
 131        if(tic>42)and (not(en('c')))then RL(192)
 132         else if(tic>146)and not(en('n'))then RL(192);
 133        if(en('r'))then RL(51)
 134       end
 135      else RL(207)
 136    end;
 137
 138 procedure Monster(var NewRm : integer);
 139    begin
 140     if(NewRm=MnRm)and(MnRm=25)then begin Attack:=False;RL(384)end else
 141     if(NewRm<>35)or not(en('v'))then
 142      begin
 143       p[Prm]:=p[Prm]-[23];p[NewRm]:=p[NewRm]+[23];MnRm:=NewRm;Attack:=False;
 144        if not((NewRm=30)and(Verb in[27,28]))then
 145         case random(7) of
 146          0:RS(71);1:RS(72);2:RL(359);3:RL(360);4:RL(361);5:RL(362);6:RL(363)
 147         end
 148      end
 149     else begin RL(383);Attack:=False end
 150    end;
 151
 152 procedure DescribeRm;
 153    var o : integer;
 154   procedure s(r : Str16);
 155      begin TextColor(m8);writeln(r);TextColor(m2);loc:=r;end;
 156    begin SA;
 157 if((en('a'))and(here(29)))or not(Prm in [6..24])then begin
 158      case Prm of
 159 0:s('\91D\82Ì\91O\95û');1:s('\91D\82Ì\92\86\89\9b');2:s('\91D\82Ì\8cã\95û');
 160 3:s('\8b~\96½\83{\81[\83g');4:s('\8aC\82Ì\8fã');5:s('\8dL\82¢\93´\8cA');
 161 6:s('\9e\99\82Ì\93´\8cA');7:s('\8aC\82Ì\92ê');8:s('\8db\8d\82\82¢\89¹\82Ì\93´\8cA');
 162 9:s('\90ì\82Ì\8bÈ\82ª\82è\8ap');10:s('\91ê');13:s('\93D\82¾\82ç\82¯\82Ì\93´\8cA');
 163 11:s('\98Z\8ap\8c`\82Ì\93´\8cA');12:s('\90ó\82¢\92J\8aÔ');20:s('\93®\95¨\89\80');
 164 14:s('\95\97\82Ì\90\81\82\83g\83\93\83l\83\8b');15:s('\92J\8aÔ');17:s('\92J\92ê');
 165 18:s('\8b·\82¢\93ü\82è\8cû');19:s('\8aâ\82Ì\8dâ\93¹');
 166 21:s('\89~\94Õ\82Ì\92[');22:s('\89~\94Õ\82Ì\91¤');
 167 23:s('\89~\94Õ\82Ì\8fã');24:s('\83G\83A\83\8d\83b\83N');16:s('\83\8d\81[\83v\82Ì\92[');
 168 76:s('\95Â\82¶\82½\83L\83\83\83r\83\93');25:s('\92\86\89\9b\83G\83\93\83g\83\89\83\93\83X');
 169 26:s('\89º\91w\83G\83\93\83g\83\89\83\93\83X');27:s('\91D\82Ì\93ª\94]');
 170 30:s('\8e\9e\82Ì\95\94\89®');28:s('\8c¤\8b\86\8eº');34:s('\91D\8b´');
 171 29:s('\83`\83\85\81[\83u\82Ì\92\86');31:s('\88ã\96±\8eº');58,69:s('\83V\83\83\83g\83\8b\82Ì\92\86');
 172 32:s('\91q\8cÉ');33:s('\90Q\8eº');
 173 35:s('\93®\97Í\8eº');36:s('1\8d\86\89Ý\95¨\8eº');37:s('2\8d\86\89Ý\95¨\8eº');
 174 38:s('3\8d\86\89Ý\95¨\8eº');39:s('4\8d\86\89Ý\95¨\8eº');40:s('\91å\82«\82È\89Ý\95¨\82Ì\92\86');
 175 41:s('\96Ø\82Ì\8b´');42:s('\94j\89ó\82³\82ê\82½\92[');43:s('\93ì\82Ì\92[');
 176 44..46:s('\8d»\82¾\82ç\82¯\82Ì\93¹\98H');47:s('\83N\83\8c\81[\83^\81[\82Ì\92[');48:s('\83N\83\8c\81[\83^\81[\82Ì\92\86');
 177 49:s('\83r\83\8b\82Ì\91O');50:s('\83\8d\83r\81[');51..54:s('\83I\83t\83B\83X');
 178 55:s('\92n\89º\8eº');56:s('\82Í\82µ\82²\82Ì\95\94\89®');57:s('\83r\83\8b\82Ì\89®\8fã');
 179 59:case ShRm of 0:s('\8fÀ\82Ì\8fã\8bó');
 180 1:s('\8a¢âI\82Ì\8fã\8bó');2:s('\8d»\94\99\82Ì\8fã\8bó');3:s('\83N\83\8c\81[\83^\81[\82Ì\8fã\8bó');
 181 4:s('\90ì\82Ì\8fã\8bó');5:s('\8f¬\90ì\82Ì\8fã\8bó');6:s('\92¬\82Ì\8fã\8bó');
 182 7:s('\8eR\82Ì\8fã\8bó');8:s('\83N\83\8c\81[\83^\81[\82Ì\8fã\8bó');9:s('\8bu\82Ì\8fã\8bó');
 183 10:s('\92J\82Ì\8fã\8bó');11:s('\95½\92n\82Ì\8fã\8bó');12:s('\8a±\8fã\82ª\82Á\82½\92r\82Ì\8fã\8bó');
 184 13:s('\8d»\94\99\82Ì\8fã\8bó');14:s('\8b´\82Ì\8fã\8bó')end;{of Above Rooms}
 185 63,64:s('\89_\82Ì\8fã');65..68:s('\93s\8es\82Ì\8aO');70:s('\8d`');
 186 71:s('\94\93d\90Ý\94õ');72..74:s('\94\96\88Ã\82¢\92Ê\98H');75:s('\90H\97¿\8cÉ')
 187      end; {of case}
 188
 189     if Verbose then begin FlagSA:='r';
 190       case Prm of
 191        2 :if(40 in p[2])then begin RR(2);RL(416)end;
 192        4 :if(en('B'))then RR(4)else begin RR(4);
 193            writeln('  \88À\91S\83x\83\8b\83g\82ª\8c©\82¦\82é\81B')end;
 194        11:if(en('C'))then RS(15);
 195        40:if(en('g'))then RS(17);
 196        12:if not(en('G'))then begin RR(12);RL(146)end;
 197        31:if not(en('I'))then begin RR(31);RL(156)end;
 198        34:if(74 in p[34])then begin RR(34);RL(273)end;
 199        35:if(77 in p[35])then begin RR(35);RL(381);RL(382)end else
 200            if(en('W'))then begin RR(35);RL(381)end;
 201        42:if(13 in p[42])then begin RR(42);RL(214)end;
 202        48:if(27 in p[48])then begin RR(48);RL(276)end;
 203        59..69:begin SA;
 204                if(Prm=59)and not(ShRm in RmSh)then
 205                 begin RmSh:=RmSh+[ShRm];RS(ShRm+46)end
 206                else if(Prm<>59)then RR(Prm);
 207                if KeyHole and here(63)then
 208                 writeln('\8bP\82\8c®\82Í\8c®\8c\8a\82É\82³\82³\82Á\82Ä\82¢\82é\81B')
 209               end
 210        else RR(Prm)
 211       end; {of case}
 212       if(FlagSA='r')and(Prm<>59)then RR(Prm)end;
 213
 214      for o:= 0 to NMax do begin
 215        if(o in Mov)then
 216          if(r[o]=Prm)then
 217           if not((Prm in[59..69])and(KeyHole)and(o=63))then
 218            begin writeln('',n[o,1],'\82ª\82 \82é\81B');
 219             if(here(ropecon))and(o=ropecon)and not(ropecon in inven)then
 220              writeln('  \83\8d\81[\83v\82ª',n[o,1],'\82É\8c\8b\82Ñ\95t\82¯\82ç\82ê\82Ä\82¢\82é\81B');
 221             if(en('d'))and(o=70)and(here(70))then RL(147);
 222             if(o=SlotCon)and(here(o))then RL(388);
 223             if(o in CabiSet)and(here(o))then RL(389);
 224             if(o=PanelCon)and(here(o))then RL(390);
 225             if(o in KitSet)and(here(o))then RL(391);
 226            end
 227      end end
 228     else RL(54)
 229    end;  {of DescribeRm}
 230
 231 procedure SAVE;
 232    begin SA; for x:=1 to 24 do writeln; nosound;
 233    window(1,3,80,25);
 234    gotoxy(1,4);
 235    if(Drive='A:')then
 236     writeln('\83h\83\89\83C\83uA:\82©\82ç\83Q\81[\83\80\83f\83B\83X\83N\82ð\94²\82«\81A\95Û\91¶\83f\83B\83X\83N\82ð\91}\93ü\82µ\82Ä\82\82¾\82³\82¢\81B')else
 237     writeln('\83h\83\89\83C\83uB:\82É\95Û\91¶\83f\83B\83X\83N\82ª\91}\93ü\82³\82ê\82Ä\82¢\82é\82©\8am\94F\82µ\82Ä\82\82¾\82³\82¢\81B');
 238    writeln('  (\89½\82©\83L\81[\82ð\89\9f\82·\82Æ\91±\82¯\82Ü\82·\81c)');flag:=readkey;
 239    writeln;writeln;
 240    write('\95Û\91¶\82·\82é\83t\83@\83C\83\8b\82Ì\83t\83@\83C\83\8b\96¼\82Í? ');readln(input);
 241    while pos(' ',input)>0 do delete(input,pos(' ',input),1);
 242    while pos('.',input)>0 do delete(input,pos('.',input),1);
 243    if(input='')then input:='LastRoom';
 244    writeln;writeln;input:=Drive+input;
 245    while pos(':',input)>0 do input[pos(':',input)] := '_';
 246    writeln('\95Û\91¶/\95\9c\8bA\82·\82é\83f\83B\83X\83N\82ð\83h\83\89\83C\83u',Drive,
 247             '\82É\91}\93ü\82³\82ê\82Ä\82¢\82ê\82Î\81A\89½\82©\83L\81[\82ð\89\9f\82·\82Æ\8en\82Ü\82è\82Ü\82·\81B');
 248    flag := readkey;
 249    with DiskSave do
 250     begin
 251      aInven:=Inven;aKitSet:=KitSet;aCabiSet:=CabiSet;aPanelCon:=PanelCon;
 252      aSlotCon:=SlotCon;aCompCon:=CompCon;aRopeCon:=RopeCon;aTic:=Tic;
 253      aYearDial:=YearDial;aPrm:=Prm;aMnRm:=MnRm;aSc:=Sc;aShots:=Shots;
 254      aShRm:=ShRm;aRx:=Rx;aEv:=Ev;aCode:=Code;aLoc:=Loc;aKeyHole:=KeyHole;
 255     end;
 256    assign(GameSave,input+'.a');
 257    rewrite(GameSave);
 258    write(GameSave,DiskSave);
 259    close(GameSave);
 260    assign(Objects,input+'.b');
 261    rewrite(Objects);
 262    for x:=0 to RMax do write(Objects,p[x]);
 263    close(Objects);
 264    assign(WordList,input+'.c');
 265    rewrite(Wordlist);
 266    for x:= 0 to NMax do
 267     for y:= 1 to 5 do
 268      write(WordList,n[x,y]);
 269    for x:= 0 to VMax do
 270     for y:= 1 to 10 do
 271      write(WordList,v[x,y]);
 272    close(WordList);
 273    assign(Things,input+'.d');
 274    rewrite(Things);
 275    for x:= 0 to NMax do write(Things,r[x]);
 276    close(Things);
 277    writeln; delete(input,1,2);
 278    writeln('\83Q\81[\83\80\82Ì\8fó\91Ô\82Í\83t\83@\83C\83\8b''',input,'''\82É\95Û\91¶\82³\82ê\82Ü\82µ\82½\81B');
 279    if(Drive='A:')then begin writeln;
 280     writeln('\95Û\91¶\83f\83B\83X\83N\82ð\94²\82«\81A\83Q\81[\83\80\83f\83B\83X\83N\82ð\91}\93ü\82µ\82Ä\82\82¾\82³\82¢\81B')end;
 281    writeln('  (\89½\82©\83L\81[\82ð\89\9f\82·\82Æ\91±\82¯\82Ü\82·\81c)');flag := readkey;
 282    writeln;writeln;
 283    if(Verb<>54)then writeln('\83Q\81[\83\80\82É\96ß\82è\82Ü\82·\81c');
 284    if(Line='')then Line:='look';Tic:=Tic-2;Back:=True;
 285    if(Prm in[59..68])then sound(20);
 286    window(1,2,80,25)
 287    end; {of Save}
 288
 289 procedure RESTORE;
 290  function Exist:Boolean;
 291  begin
 292  assign(GameSave,input+'.a');
 293  {$I-}
 294  Reset(GameSave);
 295  {$I+}
 296  Exist:=(IOresult=0)
 297  end;
 298    begin SA; for x:=1 to 24 do writeln; nosound;
 299    window(1,3,80,25);gotoxy(1,4);
 300    if(Drive='A:')then
 301     writeln('\83h\83\89\83C\83u',Drive,'\82©\82ç\83Q\81[\83\80\83f\83B\83X\83N\82ð\94²\82«\81A\95Û\91¶\83f\83B\83X\83N\82ð\91}\93ü\82µ\82Ä\82\82¾\82³\82¢\81B')else
 302     writeln('\83h\83\89\83C\83uB:\82É\95Û\91¶\83f\83B\83X\83N\82ª\91}\93ü\82³\82ê\82Ä\82¢\82é\82©\8am\94F\82µ\82Ä\82\82¾\82³\82¢\81B');
 303    writeln('  (\89½\82©\83L\81[\82ð\89\9f\82·\82Æ\91±\82¯\82Ü\82·\81c)');flag := readkey;
 304    writeln;writeln;
 305    write('\95\9c\8bA\82·\82é\83t\83@\83C\83\8b\82Ì\83t\83@\83C\83\8b\96¼\82Í? ');readln(input);
 306    while pos(' ',input)>0 do delete(input,pos(' ',input),1);
 307    while pos('.',input)>0 do delete(input,pos('.',input),1);
 308    if(input='')then input:='LastRoom';
 309    writeln;writeln;input:=Drive+input;
 310    while pos(':',input)>0 do input[pos(':',input)] := '_';
 311    writeln('\83h\83\89\83C\83u',Drive,'\82É\95Û\91¶\83f\83B\83X\83N\82ª\91}\93ü\82³\82ê\82Ä\82¢\82ê\82Î',
 312            '\89½\82©\83L\81[\82ð\89\9f\82µ\82Ä\82\82¾\82³\82¢\81B');
 313    flag := readkey;
 314    if Exist then
 315     begin
 316      close(GameSave);
 317      assign(GameSave,input+'.a');
 318      reset(GameSave);
 319      read(GameSave,DiskSave);
 320      close(GameSave);
 321      with DiskSave do
 322       begin
 323        Inven:=aInven;KitSet:=aKitSet;CabiSet:=aCabiSet;PanelCon:=aPanelCon;
 324        SlotCon:=aSlotCon;CompCon:=aCompCon;RopeCon:=aRopeCon;Tic:=aTic;
 325        YearDial:=aYearDial;Prm:=aPrm;MnRm:=aMnRm;Sc:=aSc;Shots:=aShots;
 326        ShRm:=aShRm;Rx:=aRx;Ev:=aEv;Code:=aCode;Loc:=aLoc;KeyHole:=aKeyHole;
 327       end;
 328      assign(Objects,input+'.b');
 329      reset(Objects);
 330      for x:=0 to RMax do read(Objects,p[x]);
 331      close(Objects);
 332      assign(WordList,input+'.c');
 333      reset(Wordlist);
 334      for x:= 0 to NMax do
 335       for y:= 1 to 5 do
 336        read(WordList,n[x,y]);
 337      for x:= 0 to VMax do
 338       for y:= 1 to 10 do
 339        read(WordList,v[x,y]);
 340      close(WordList);
 341      assign(Things,input+'.d');
 342      reset(Things);
 343      for x:= 0 to NMax do read(Things,r[x]);
 344      close(Things);
 345      writeln; delete(input,1,2);
 346      writeln('\83t\83@\83C\83\8b',input,'\82É\95Û\91¶\82³\82ê\82½\8fó\91Ô\82É\95\9c\8bA\82µ\82Ü\82µ\82½\81B');
 347      if(Drive='A:')then begin writeln;
 348       writeln('\95Û\91¶\83f\83B\83X\83N\82ð\94²\82¢\82Ä\83Q\81[\83\80\83f\83B\83X\83N\82ð\91}\93ü\82µ\82Ä\82\82¾\82³\82¢\81B')end;
 349      writeln('  (\89½\82©\83L\81[\82ð\89\9f\82·\82Æ\91±\82¯\82Ü\82·\81c)');flag := readkey;
 350     end
 351    else
 352     begin writeln;TextColor(28);
 353      writeln('             \82»\82Ì\96¼\91O\82Ì\83t\83@\83C\83\8b\82Í\95Û\91¶\83f\83B\83X\83N\82É\91¶\8dÝ\82µ\82Ü\82¹\82ñ\81B',^g);
 354      TextColor(m2);writeln;
 355      if(Drive='A:')then
 356       writeln('\83Q\81[\83\80\83f\83B\83X\83N\82É\96ß\82µ\82Ä\89½\82©\83L\81[\82ð\89\9f\82µ\82Ä\82\82¾\82³\82¢\81B')
 357      else writeln('  (\89½\82©\83L\81[\82ð\89\9f\82·\82Æ\91±\82¯\82Ü\82·\81c)');
 358      flag := readkey;
 359     end;
 360    writeln;writeln;writeln('\83Q\81[\83\80\82É\96ß\82è\82Ü\82·\81c');
 361    if(Line='')then Line:='look';Tic:=Tic-2;Back:=True;
 362    if(Prm in[59..68])then sound(20);
 363    window(1,2,80,25)
 364    end; {of Restore}
 365
 366 procedure Vanish(o : integer);
 367    begin SA;
 368      inven:=inven-[o];
 369      r[o]:=Null;
 370      p[Prm]:=p[Prm]-[o];
 371      if(o=7)and not(en('I'))then Ev:=Ev+['I'];
 372      if(o=13)and(13 in p[42])then p[42]:=p[42]-[13];
 373      if(o=PanelCon)then PanelCon:=Null;
 374      if(o=SlotCon)then SlotCon:=Null;
 375      if(o in CabiSet)then CabiSet:=CabiSet-[o];
 376      if(o in kitset)then kitset:=kitset-[o];
 377      if(o=63)and KeyHole then KeyHole:=False;
 378      if(o=74)then Ev:=Ev-['p'];
 379      if(o=89)then Ev:=Ev-['i'];
 380      if(o=RopeCon)and(verb=36)then begin RopeCon:=Null;RL(402)end;
 381      if(o=RopeCon)and not(Verb in[9,14])then RopeCon:=Null
 382    end;
 383
 384 procedure Play( Start, Stop, Wait: integer);
 385    var x : integer;
 386    begin
 387     if(Start<=Stop)then
 388      for x:= Start to Stop do
 389       begin sound(x); delay(Wait); end
 390     else
 391      for x:= Start downto Stop do
 392       begin sound(x); delay(Wait); end;
 393     if(Prm in[59..68])then sound(20)else nosound
 394    end; {of Play}
 395
 396 procedure DropAll;
 397    var o : integer;
 398    begin
 399      for o:= 0 to NMax do
 400        if(o in inven)then
 401          begin
 402            r[o]:=Prm;
 403            inven:=inven-[o];writeln(n[o,1],': \92u\82¢\82½\81B');
 404          end;
 405      RL(106);
 406    end;  {of DropAll}
 407
 408 function FlasOff : Boolean;
 409    begin
 410      if not(En('a'))then FlasOff:=True
 411      else
 412        if(r[29]=Prm)or(29 in inven)then FlasOff:=False
 413        else FlasOff:=True;
 414    end;
 415
 416 procedure MoveTo(NewRm : integer);
 417  var o : integer;
 418  begin
 419    if(57 in inven)and(ropecon<>Null)and not(ropecon in inven)
 420      and(ropecon in mov)and not(ropecon=70)then
 421       begin r[ropecon]:=Prm;RL(158);end
 422    else if(57 in inven)and(ropecon<>Null)and(not(ropecon in mov)or
 423         ((ropecon=70)and(en('d'))))then
 424           begin RL(55);inven:=inven-[57];r[57]:=Prm;end
 425    else if not(57 in inven)and((ropecon in inven)or
 426           (ropecon in[60,56,44]))then r[57]:=NewRm
 427    else if not(57 in inven)and(r[57]=Prm)and(r[ropecon]=NewRm)then
 428           begin r[57]:=NewRm;RopeOld:=Prm;end
 429    else if not(57 in inven)and(r[57]=Prm)and(NewRm=RopeOld)and
 430               (r[ropecon]=Prm)then
 431           begin r[57]:=RopeOld;RopeOld:=Null;end;
 432    if(ropecon=Null)or((NewRm<>RopeOld)and(Prm<>RopeOld))then RopeOld:=Null;
 433    if(MnRm<>Null)then Monster(NewRm);
 434    if(Prm in[63..68])and not(NewRm in[59,69])then RL(343);
 435    if(Prm in[59,63..68])then for o:=0 to NMax do if(r[o]=Prm)then r[o]:=NewRm;
 436    Prm:=NewRm;
 437    DescribeRm
 438  end;  {of MoveTo}
 439
 440 procedure Time;
 441    begin
 442      Tic:=Tic+1;
 443   case Tic of
 444     3:RL(280);
 445     4:RS(1);
 446     17:if not(en('A'))then begin RS(3);DEAD end else RS(5);
 447     19:RL(4);
 448     20:RL(5);
 449     21:RL(6);
 450     23:RS(6);
 451     24:if(en('B'))then begin RS(8);writeln;RL(16);moveto(5);Sc:=Sc+25;
 452          n[64,5]:='ship';v[26,2]:='pick' end
 453        else begin RS(7);DEAD;end;
 454     43:if(not(en('c'))and not(en('n')))then RL(31);
 455     73:if(not(en('c'))and not(en('n')))then RL(32);
 456     93:if(not(en('c'))and not(en('n')))then begin RL(33); DEAD end;
 457     99:if(Prm in[6..24])and(here(29))and not(flasoff)and(not(en('s')))then
 458          begin RL(41);Ev:=Ev+['s'] end;
 459     147:if not(en('n'))then RL(31);
 460     149:if(here(29))and not(flasoff)then RL(59);
 461     153:if(Prm in[6..23])and(here(29))and not(flasoff)then
 462           begin RS(14);vanish(29) end;
 463     170:if not(en('n'))then RL(32);
 464     181:if not(en('n'))then begin RL(33); DEAD end;
 465     549:RL(281);
 466     586:RL(282);
 467     598:RL(283);
 468     607:begin RL(284);DEAD;end;
 469   end; {of case}
 470
 471 case Prm of
 472     1..3:if(tic>4)and(random(4)=1)then RL(405);
 473   36..39:if(random(5)=2)then RL(219);
 474      7  :if(random(8)=2)then RL(266);
 475      8  :if(random(3)=2)then begin RL(265);play(6666,7000,0);end;
 476   13..24:if(random(16)=2)then RL(246);
 477   25..35:if(random(30)=2)then RL(267);
 478    47,48:if(random(5)=2)and(inven <>[])then
 479            begin
 480             if(Prm=48)then begin writeln;RS(40)end
 481             else begin writeln;RS(44);moveto(48)end;
 482             o:=1;flag:='?';
 483             repeat o:=o+1;
 484              if(o in inven)then
 485              begin vanish(o);r[o]:=random(9)+41;flag:='g';end;
 486             until Flag = 'g';
 487            end;
 488 end;
 489 case Prm of
 490   5,6,9,10:if(random(9)=2)then RL(268);
 491   7,8,11..40:if(here(84))and(random(20)=2)then RL(269)
 492         else if(random(75)=2)then RS(36)
 493         else if(Prm in[5..22])and(random(33)=2)then
 494          begin RL(265);play(6500,6950,0)end;
 495   41..49:if(random(27)=2)then RL(285);
 496     59  :if(random(15)=1)then RL(406);
 497 end;
 498 if Attack and(MnRm=Prm)and(not Back)then
 499  begin case random(3) of 0:RS(80); 1:RS(81); 2:RS(82)end;DEAD end
 500 else if(MnRm=Prm)then Attack:=True
 501    end;  {of Time}
 502
 503 function Present : Boolean;
 504    begin
 505     if(noun<>Null)and(noun<>1)then
 506      if(here(noun))then
 507       if(noun2<>Null)then
 508        if(here(noun2))then Present:=true
 509        else begin
 510          writeln(n[noun2,1],'\82Í\8c©\93\96\82½\82ç\82È\82¢\81B');Present:=false end
 511       else Present:=true
 512      else begin
 513        writeln(n[noun,1],'\82Í\8c©\93\96\82½\82ç\82È\82¢\81B');Present:=false end
 514     else Present:=true
 515    end;
 516
 517 procedure Initialize;
 518  procedure Cn(S : Str80);
 519  begin
 520   gotoxy(40-(length(S)div 2),wherey);writeln(S);
 521  end;
 522   begin
 523    textcolor(15);
 524    writeln('\96`\8c¯\82Ì\90¢\8aE\82Ö\94ò\82Ñ\8d\9e\82Þ\8f\80\94õ\82ð\82µ\82Ä\82\82¾\82³\82¢\81B');
 525    writeln('\82Å\82à\81A\82»\82Ì\91O\82É\8aÈ\92P\82È\8e¿\96â\82ª2\82Â\82 \82è\82Ü\82·:');
 526    gotoxy(1,4);write('\83f\83B\83X\83v\83\8c\83C\82Í\83J\83\89\81[\82Å\82·\82© (Y/N)? ');
 527    nosound; play(72,80,45);
 528    flag := readkey; play(2500,2490,6);
 529    m0:=20;m1:=14;m2:=11;m3:=4;m4:=15;m5:=28;m6:=1;m7:=4;m8:=10;m9:=10;
 530    if upcase(flag)='N' then
 531     begin
 532      writeln('\82¢\82¢\82¦\81B\83J\83\89\81[\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81B');
 533      m0:=31;m1:=15;m2:=15;m3:=7;m4:=0;m5:=31;m6:=7;m7:=8;m8:=7;m9:=0;
 534     end else writeln('\82Í\82¢\81B\83J\83\89\81[\82Å\82·\81B');writeln;
 535    write('\83f\83B\83X\83N\83h\83\89\83C\83u\82Í\82¢\82\82Â\82 \82è\82Ü\82·\82© (1/2)? ');
 536    play(80,88,30);
 537    flag := readkey; play(2500,2490,6);
 538    Drive:='B:';
 539    if(upcase(flag)='O')or(flag='1')then
 540     begin Drive:='A:';writeln('1\82Â\82Å\82·\81B')end else
 541     writeln('2\82Â\82Å\82·\81B');
 542    delay(999);clrscr;textcolor(15);gotoxy(1,4);writeln;textcolor(7);
 543    cn('Beyond the Titanic');cn('\83^\83C\83^\83j\83b\83N\82ð\89z\82¦\82Ä');textcolor(6);cn('------------------');writeln;
 544    textcolor(7);
 545    cn('A Text & Sound Adventure Fantasy');writeln;writeln;
 546    cn('An Apogee Software Production');writeln;writeln;writeln;
 547    cn('Written and Programmed by Scott Miller');
 548    textcolor(11);
 549    gotoxy(32,24);textcolor(7);
 550    write('\83L\81[\82ð\89\9f\82µ\82Ä\82\82¾\82³\82¢');flag := readkey;clrscr;
 551
 552    {                      *** SHAREWARE SCREEN ***                            }
 553
 554    textcolor(15);
 555    writeln('Please note that Beyond the Titanic is a SHAREWARE game.');
 556    writeln;
 557    textcolor(7);
 558    writeln('This game has been placed in the public domain for your enjoyment.');
 559    writeln;
 560    writeln('If you like the game the author (Scott Miller) asks that you please');
 561    writeln('contribute $5 or $10 (your discretion) to him.  This minimal payment');
 562    writeln('will help compensent the author for the year of work that went into');
 563    writeln('Beyond the Titanic.  It will also encourage the author to make new and');
 564    writeln('better games, like Supernova and Kingdom of Kroz, both of which are');
 565    writeln('also shareware games recently released.');
 566    writeln;
 567    writeln('This fee also registers the payer for telephone support and clues.');
 568    writeln;writeln;
 569    writeln('Please make checks payable to Scott Miller.');
 570    writeln;
 571    textcolor(15);
 572    writeln('        Scott Miller           (214) 240-0614');
 573    writeln('        4206 Mayflower Dr.');
 574    writeln('        Garland, TX  75043');
 575    writeln;
 576    textcolor(7);
 577    writeln('Thanks, enjoy the game...');
 578    gotoxy(23,25);
 579    delay(3000);
 580    while keypressed do readkey;
 581    write('\83L\81[\82ð\89\9f\82·\82Æ\83Q\81[\83\80\82ª\8en\82Ü\82è\82Ü\82·');
 582    readkey;
 583    while keypressed do readkey;
 584    clrscr;
 585    {                      ************************                            }
 586    Window(1,2,80,25);
 587    gotoxy(1,24);
 588    TextColor(m1);
 589 cn('1912\94N4\8c\8e14\93ú     \8cß\8cã11\8e\9e43\95ª');
 590 cn('');
 591 cn('\88Å\96é\82Ì\83J\83\93\83o\83X\82ª\82±\82ê\82Ù\82Ç\8bP\82¢\82Ä\82¢\82½\82Æ\82Í\81B');
 592 cn('\83z\83\8f\83C\83g\83X\83^\81[\82Ì\8dÅ\90V\82Ì\8d\8b\89Ø\8bq\91D\81A\90[\82¢\8aC\81A');
 593 cn('\83T\83\93\83t\83\89\83\93\83V\83X\83R\82Ì\82Ü\82Î\82ä\82¢\8cõ\82à\93Í\82©\82È\82¢\82±\82Ì\8fê\8f\8a\82Å');
 594 cn('\82 \82È\82½\82Í\8aô\90ç\82à\82Ì\92m\82ç\82ê\82´\82é\90¯\81X\82ð\8c©\82Ä\82¢\82½\81B');
 595 cn('');
 596 cn('\8aC\82É\96Ú\82ð\82â\82é\82Æ\8f¬\82³\82È\95X\82Ì\94j\95Ð\82ª\95Y\82Á\82Ä\82¢\82½\81B');
 597 cn('\82±\82Ì\82 \82½\82è\82É\82Í\8f¬\82³\82È\8eR\82Ù\82Ç\82Ì\95X\8eR\82ª\8c»\82ê\82é\82Æ\82¤\82í\82³\82¾\81B');
 598 cn('');
 599 cn('\82¾\82ª\90S\94z\82·\82é\82±\82Æ\82Í\82È\82¢\81B\83^\83C\83^\83j\83b\83N\8d\86\82Í\81u\95s\92¾\81v\81A');
 600 cn('\88ê\97¬\82Ì\8aC\89^\89ï\8eÐ\83z\83\8f\83C\83g\83X\83^\81[\82Æ\82»\82Ì\91D\82Ì\82±\82Æ\82Í\8fæ\8bq\82Ì\92N\82à\82ª\90M\97\8a\82µ\82Ä\82¢\82½\81c');
 601 for x:= 1 to 3 do writeln;
 602 Line        :='';
 603 LastNoun    :='';
 604 KitSet      :=[2,29,57];
 605 CabiSet     :=[89,63];
 606 CompCon     :=Null;
 607 PanelCon    :=8;
 608 RopeCon     :=Null;
 609 SlotCon     :=Null;
 610 RopeOld     :=Null;
 611 RmSh        :=[];
 612 Mov         :=[2,7,8,13,27,29,32,34,40,52,51,57,63,70,74,77,89];
 613 OneWordCommands:=[1,4,5,7,8,16,18,19,22,31,33..35,41,43..54,56..59,61..65];
 614 Ev          :=[];
 615 Inven       :=[];
 616 Prm         :=0;
 617 MnRm        :=Null;
 618 Tic         :=Prm;
 619 Sc          :=0;
 620 Shots       :=6;
 621 KeyHole     :=false;
 622 Verbose     :=true;
 623 Attack      :=False;
 624 YearDial    :=135;
 625 DayDial     :=60;
 626 assign(rooms1,'ROOMS1');assign(rooms2,'ROOMS2');
 627 assign(special1,'SPECIAL1');assign(special2,'SPECIAL2');assign(line1,'LINE');
 628 reset(rooms1);reset(rooms2);reset(special1);reset(special2);reset(line1);
 629 Str(Random(9998)+1,Code);
 630    DescribeRm; writeln; randomize;
 631    Window(1,1,80,25);
 632    gotoxy(1,1);TextBackGround(m6);
 633    for x:=1 to 80 do write(' ');writeln;TextColor(m4);
 634    gotoxy(4,1);writeln('Move');gotoxy(68,1);writeln('Score');TextColor(m2);
 635    TextBackGround(0); Window(1,2,80,25);
 636   end; {of Initialize}
 637 {***************************** END OF COMMANDS *****************************}
 638 \1a