home *** CD-ROM | disk | FTP | other *** search
/ Between Heaven & Hell 2 / BetweenHeavenHell.cdr / 500 / 433 / pycmdpro.inc < prev    next >
Text File  |  1986-10-23  |  54KB  |  1,751 lines
  1. OVERLAY PROCEDURE StartUp;  { Initialize everything when Pyroto starts }
  2. VAR
  3.   CommentCh : CHAR;
  4.   NumItems  : INTEGER;
  5.   SUChar    : CHAR;
  6.   SUCntr    : INTEGER;
  7.   SULine    : Line;
  8. BEGIN
  9.   CLRSCR;
  10.   WINDOW(1,3,80,25);
  11.   GOTOXY(1,5);
  12.   WRITELN(#17#16,' Start-up of Version ',Ver,' of Pyroto Mountain.');
  13.   SuppressOut := FALSE;
  14.   {------- Init variables -------}
  15.   Adding       := FALSE;
  16.   Alert        := FALSE;
  17.   Blanks       := '                                        ';
  18.   Blanks       := Blanks + Blanks;  { 80 spaces }
  19.   CharDuringO  := FALSE;
  20.   Charging     := FALSE;
  21.   ChatAsk      := FALSE;
  22.   Chattable    := FALSE;
  23.   Cloaked      := FALSE;
  24.   Contacting   := FALSE;
  25.   CmdParm      := '';
  26.   ExFnKey      := FALSE;
  27.   Inputting    := FALSE;
  28.   Level        := 0;
  29.   IF UPPER(PARAMSTR(1)) = 'LOCAL'
  30.   THEN Comm    := FALSE
  31.   ELSE Comm    := TRUE;
  32.   Ascendable   := TRUE;
  33.   Patience     := 0;
  34.   SeismoActive := FALSE;
  35.   ShutDown     := FALSE;
  36.   SpellRepeat  := 1;
  37.   SysFail      := FALSE;
  38.   TimeOutSecs  := 30;
  39.   UpCaseInput  := FALSE;
  40.   UserName     := '';
  41.   Wrapping     := FALSE;
  42.   Date         := 0;
  43.   Mint         := 0;
  44.   GetDate;
  45.   StartDate    := Date;
  46.   StartMint    := Mint;
  47.   SaveDescTexture := DescTexture[RANDOM(MaxDescTexture)+1];
  48.   SaveDescType    := DescType[RANDOM(MaxDescType)+1];
  49.   SaveDescCharac  := DescCharac[RANDOM(MaxDescCharac)+1];
  50.   {----- Read in Configuation -----}
  51.   {$I-}
  52.   ASSIGN(TxtFile,'PYCONFIG.DAT');
  53.   RESET(TxtFile);
  54.   IF OpenFailed THEN
  55.   BEGIN
  56.     CLRSCR;
  57.     WRITELN('Can''t open PYCONFIG.DAT on logged drive and/or directory.');
  58.     HALT;
  59.   END;
  60.   WRITELN(#17#16+' Reading in configuration data.');
  61.   CommentCh := #255;
  62.   NumItems  := 26;
  63.   SUCntr := 0;
  64.   REPEAT
  65.     READLN(TxtFile,SULine);
  66.     IF (SULine[1] <> CommentCh) THEN
  67.     BEGIN
  68.       IF SUCntr > 0 THEN SULine := ParmFrom(SULine);
  69.       CASE SUCntr OF
  70.         00 : CommentCh     := SULine[1];
  71.         01..08 : Banner[SUCntr] := SULine;
  72.         09 : BEGIN
  73.                VAL(SULine,Com1Base,VALRetCode);
  74.                IF VALRetCode <> 0 THEN
  75.                BEGIN
  76.                  WRITELN('Non-numeric com port: ',SULine);
  77.                  WRITELN('Try 1016 for COM1.');
  78.                  HALT;
  79.                END;
  80.              END;
  81.         10 : ModemOkay     := Upper(SULine);
  82.         11 : Modem300      := Upper(SULine);
  83.         12 : Modem1200     := Upper(SULine);
  84.         13 : Modem2400     := Upper(SULine);
  85.         14 : ModemAttn     := SULine;
  86.         15 : ModemPickUp   := SULine;
  87.         16 : ModemHangUp   := SULine;
  88.         17 : ModemConfig   := SULine;
  89.         18 : ModemReset    := SULine;
  90.         19 : ModemDoAnswer := SULine;
  91.         20 : ModemNoAnswer := SULine;
  92.         21 : DFLocation    := Upper(SULine + '\');
  93.         22 : MFLocation    := Upper(SULine + '\');
  94.         23 : ServantWord   := Upper(SULine);
  95.         24 : BEGIN
  96.                DisconMethod := Upper(SULine);
  97.                IF  (DisconMethod <> 'DTR')
  98.                AND (DisconMethod <> 'ATTN') THEN
  99.                BEGIN
  100.                  WRITELN('Disconnect method specified as: ',DisconMethod);
  101.                  WRITELN('Invalid; should be DTR or ATTN.  DTR assumed.');
  102.                  DisconMethod := 'DTR';
  103.                END;
  104.              END;
  105.         25 : Attn          := SULine;
  106.         26 : BEGIN
  107.                VAL(SULine,DisconDelay,VALRetCode);
  108.                IF VALRetCode <> 0 THEN
  109.                BEGIN
  110.                  WRITELN('Non-numeric disconnect delay: ',SULine);
  111.                  WRITELN('500 milliseconds assumed.');
  112.                  DisconDelay := 500;
  113.                END;
  114.              END;
  115.         ELSE
  116.           WRITELN(SULine,' <-- Item ',SUCntr,' ignored.');
  117.       END; { of case }
  118.       SUCntr := SUCntr + 1;
  119.     END;  { of not-a-comment }
  120.   UNTIL EOF(TxtFile) OR (SUCntr = (NumItems + 1));
  121.   CLOSE(TxtFile);
  122.   IF SUCntr < (NumItems + 1) THEN
  123.   BEGIN
  124.     WRITELN('Configuration file has less than '+IntToStr(NumItems)+' items!');
  125.     HALT;
  126.   END;
  127.   {------- Set up serial specs -------}
  128.   LowBaud     := Com1Base;
  129.   HighBaud    := Com1Base + 1;
  130.   DataPort    := Com1Base;
  131.   IntReg      := Com1Base + 1;
  132.   LineContrl  := Com1Base + 3;
  133.   ModemContrl := Com1Base + 4;
  134.   StatusPort  := Com1Base + 5;
  135.   ModemStatus := Com1Base + 6;
  136.   {----- Read in Spell Specs -----}
  137.   FOR SUCntr := 1 TO NumCmds DO
  138.   BEGIN
  139.     CmdCosts[SUCntr]  := 0;
  140.     CmdLevels[SUCntr] := 0;
  141.   END;
  142.   ASSIGN(TxtFile,DFLocation + File_Specs);
  143.   RESET(TxtFile);
  144.   IF OpenFailed THEN
  145.   BEGIN
  146.     CLRSCR;
  147.     WRITELN('Can''t find ' + DFLocation + File_Specs + ' file.');
  148.     WRITELN('Copy it in from your installation disk.');
  149.     HALT;
  150.   END;
  151.   WRITELN(#17#16+' Reading in spell-specs data.');
  152.   CommentCh := #255;
  153.   READLN(TxtFile,SULine);
  154.   IF LENGTH(SULine) > 0 THEN CommentCh := SULine[1];
  155.   SUCntr := 0;
  156.   REPEAT
  157.     READLN(TxtFile,SULine);
  158.     IF (SULine[1] <> CommentCh) AND (LENGTH(SULine) <> 0) THEN
  159.     BEGIN
  160.       SUCntr := SUCntr + 1;
  161.       VAL(DeBlank(COPY(SULine,1,10)),CmdLevels[SUCntr],VALRetCode);
  162.       IF VALRetCode <> 0 THEN
  163.       WRITELN('Non-numeric spell level in line ',IntToStr(SUCntr),'.');
  164.       VAL(DeBlank(COPY(SULine,15,10)),CmdCosts[SUCntr],VALRetCode);
  165.       IF VALRetCode <> 0 THEN
  166.       WRITELN('Non-numeric spell cost in line ',IntToStr(SUCntr),'.');
  167.     END;  { of not-a-comment }
  168.   UNTIL EOF(TxtFile) OR (SUCntr = NumCmds);
  169.   CLOSE(TxtFile);
  170.   IF SUCntr < NumCmds THEN
  171.   BEGIN
  172.     WRITELN('Spell-specs file has less than ',NumCmds,' items!');
  173.     WRITELN('Some spell levels and costs will be incorrect.');
  174.   END;
  175.   {------- Open the files -------}
  176.   {--- User File ---}
  177.   ASSIGN(UsersFile,DFLocation + File_Users);
  178.   RESET(UsersFile);
  179.   IF OpenFailed THEN
  180.   BEGIN
  181.     WRITELN('* Creating Users file:  ' + DFLocation + File_Users);
  182.     WRITELN('* Press a key to begin ');
  183.     REPEAT UNTIL KEYPRESSED;
  184.     READ(KBD,SUChar);
  185.     REWRITE(UsersFile);
  186.     WRITELN('* Users file creation return code = '+IntToStr(IORESULT));
  187.     WRITELN('* Formatting Users file -- this takes a while');
  188.     WITH UsersRec DO
  189.     BEGIN
  190.       RealName  := 'SERVANT OF TSOTL';
  191.       Phone     := '0-000-000-0000 EXT. 00000';
  192.       UserName  := 'SERVANT OF TSOTL';
  193.       Password  := '.ABIA.'; { Ass-Backwards Into Adventure }
  194.       Points    := 25000;    Level     := 500;
  195.       Date_Last := Date;     Mint_Last := 0;
  196.       Width     := 80;
  197.       MsgsSent  := 0;        MaxLevel  := 0;
  198.       Date_A    := 1;        Mint_A    := 0;
  199.       Date_B    := 1;        Mint_B    := 0;
  200.       Date_C    := 1;        Mint_C    := 0;
  201.       Date_D    := 1;        Mint_D    := 0;
  202.       Date_P    := 1;        Mint_P    := 0;
  203.       Date_S    := 1;        Mint_S    := 0;
  204.       Date_X    := 1;        Mint_X    := 0;
  205.     END;
  206.     WRITE(UsersFile,UsersRec);
  207.     WITH UsersRec DO
  208.     BEGIN
  209.       { Fields are blanked to make file-dumps look nice }
  210.       RealName  := '                    ';
  211.       Phone     := '                         ';
  212.       UserName  := '                    ';
  213.       UserName  := '';
  214.       Password  := '          ';
  215.       Points := 0;      Level := 0;
  216.       Date_Last := 0;   Mint_Last := 0;
  217.     END;
  218.     FOR SUCntr := 2 TO MaxUsers DO WRITE(UsersFile,UsersRec);
  219.     RESET(UsersFile);
  220.   END;
  221.   {--- Next Msg # ---}
  222.   ASSIGN(NextMsgFile,DFLocation + File_Next);
  223.   RESET(NextMsgFile);
  224.   IF OpenFailed THEN
  225.   BEGIN
  226.     WRITELN('* Creating Next-Message file');
  227.     REWRITE(NextMsgFile);
  228.     WRITELN('* Return code = '+IntToStr(IORESULT));
  229.     NextMsg := 1;
  230.     WRITE(NextMsgFile,NextMsg);
  231.     RESET(NextMsgFile);
  232.   END;
  233.   {--- Msg Times ---}
  234.   ASSIGN(MsgTimesFile,DFLocation + File_Times);
  235.   RESET(MsgTimesFile);
  236.   IF OpenFailed THEN
  237.   BEGIN
  238.     WRITELN('* Creating Message-Times file');
  239.     REWRITE(MsgTimesFile);
  240.     WRITELN('* Return code = '+IntToStr(IORESULT));
  241.     WITH MsgTimesRec DO
  242.     BEGIN
  243.       Date_Added := 0;  Mint_Added := 0;  MsgBand := '?';
  244.     END;
  245.     FOR SUCntr := 1 TO MaxMsgs DO WRITE(MsgTimesFile,MsgTimesRec);
  246.     RESET(MsgTimesFile);
  247.   END;
  248.   {--- Seismoros ---}
  249.   ASSIGN(SeismoFile,DFLocation + File_Seismo);
  250.   RESET(SeismoFile);
  251.   IF OpenFailed THEN
  252.   BEGIN
  253.     REWRITE(SeismoFile);
  254.     WRITELN('* Creating Seismoros file');
  255.     WRITELN('* Return code = '+IntToStr(IORESULT));
  256.     WITH SeismoRec DO
  257.     BEGIN
  258.       Energy := 500;  Spare1 := 0;  Spare2 := 0;
  259.     END;
  260.     WRITE(SeismoFile,SeismoRec);
  261.   END;
  262.   RESET(SeismoFile);
  263.   {--- SysLog File ---}
  264.   ASSIGN(SysLogFile,DFLocation + File_SysLog);
  265.   RESET(SysLogFile);
  266.   IF OpenFailed
  267.   THEN
  268.   BEGIN
  269.     WRITELN('* Creating Observe file -- this takes a while');
  270.     REWRITE(SysLogFile);
  271.     IF IORESULT >  0
  272.     THEN OpenFail(DFLocation + File_SysLog)
  273.     ELSE
  274.     BEGIN
  275.       NextLog := 0;
  276.       IncrementLog;
  277.       WITH SysLogItem DO
  278.       BEGIN
  279.         SLDate := 0;
  280.         SLMint := 0;
  281.         SLType := '?';
  282.         SLText := '--- FORMAT OF SYSLOG FILE ---';
  283.         SLRept := 0;
  284.       END;
  285.       FOR SUCntr := 1 TO MaxSysLog DO WRITE(SysLogFile,SysLogItem);
  286.     END;
  287.     CLOSE(SysLogFile);
  288.     ASSIGN(SysLogFile,DFLocation + File_SysLog);
  289.     RESET(SysLogFile);
  290.     WRITELN;
  291.   END;
  292.   SEEK(SysLogFile,0);
  293.   READ(SysLogFile,SysLogItem);
  294.   NextLog := SysLogItem.SLRept;
  295.   {----- Question File -----}
  296.   ASSIGN(QuestFile,DFLocation + File_Queries);
  297.   RESET(QuestFile);
  298.   IF OpenFailed THEN
  299.   BEGIN
  300.     WRITELN('* Missing Question file ' + DFLocation + File_Queries);
  301.     WRITELN('* Copy it from installation disk.');
  302.     HALT;
  303.   END;
  304.   CLOSE(QuestFile);
  305.   {$I+}
  306.   {---------- Read in the data from the files ----------}
  307.   WRITELN(#17#16,' Reading in user file.');
  308.   SUCntr := 0;
  309.   REPEAT
  310.     SUCntr := SUCntr + 1;
  311.     READ(UsersFile,UsersRec);
  312.     UserNames[SUCntr] := UsersRec.UserName;
  313.   UNTIL SUCntr = MaxUsers;
  314.   {--- Read in Next msg # ---}
  315.   WRITELN(#17#16,' Reading in next message number.');
  316.   READ(NextMsgFile,NextMsg);
  317.   {--- Read in MsgTimes ---}
  318.   WRITELN(#17#16,' Reading in message times.');
  319.   FOR SUCntr := 1 TO MaxMsgs DO
  320.   BEGIN
  321.     READ(MsgTimesFile,MsgTimesRec);
  322.     MsgDates[SUCntr] := MsgTimesRec.Date_Added;
  323.     MsgMints[SUCntr] := MsgTimesRec.Mint_Added;
  324.     MsgBands[SUCntr] := MsgTimesRec.MsgBand;
  325.     MsgPosters[SUCntr] := MsgTimesRec.Poster;
  326.   END;
  327.   {----- Be Impressive -----}
  328.   WRITELN;
  329.   WRITELN('╔═════════════════════════════════════════════════════════════╗');
  330.   WRITELN('╟─┼───┼───┼─  THE PYROTO MOUNTAIN BBS/GAME SYSTEM  ─┼───┼───┼─╢');
  331.   WRITELN('╟───┼───┼───  Entire product copyrighted (C) 1986  ───┼───┼───╢');
  332.   WRITELN('╟─┼───┼───┼─  P I N N A C L E     S O F T W A R E  ─┼───┼───┼─╢');
  333.   WRITELN('╟───┼───┼───  Post Office Box  163,  Cartierville  ───┼───┼───╢');
  334.   WRITELN('╟─┼───┼───┼─  Montreal,  Quebec,  Canada  H4K 2J5  ─┼───┼───┼─╢');
  335.   WRITELN('╠╤═══════════════╤╤══════════════╤╤═════════╤╤═══════════════╤╣');
  336.   WRITELN('║│    VERSION    ││   REVISION   ││ PACKAGE ││   BETA-TEST   │║');
  337.   WRITE('║│       ',Ver[1],'       ││      ',Ver[3],Ver[4]);
  338.   WRITELN('      ││    ',Ver[5],'    ││       ',Ver[6],'       │║');
  339.   WRITELN('╚╧═══════════════╧╧══════════════╧╧═════════╧╧═══════════════╧╝');
  340.   WRITELN;
  341.   ModemInit;
  342.   SysLog('L','"No Visitors" sign taken down');
  343. END;
  344.  
  345. {======= COMMAND PROCESSORS =======}
  346.  
  347. OVERLAY PROCEDURE Ascend;  { Ascent-related spells:  ASCEND, CLOAK, CHARGE }
  348. VAR
  349.   AscOkay   : BOOLEAN;
  350.   HintCntr  : INTEGER;
  351.   QuesPtr   : INTEGER;
  352.   SaveCmdP  : Line;
  353.   SaveLevel : INTEGER;
  354.   SaveTOS   : INTEGER;
  355.   SpellChk  : INTEGER;
  356.   TestAns   : STRING[30];
  357. BEGIN
  358.   SaveLevel := Level;
  359.   Promo := FALSE;
  360.   IF Ascendable
  361.   THEN AscOkay := TRUE
  362.   ELSE
  363.   BEGIN
  364.     AscOkay := FALSE;
  365.     XLn('You can''t currently earn higher levels!');
  366.     IF NOT CharDuringO THEN XLn('The Guardian explains the reason why...');
  367.     IF NOT CharDuringO THEN XLn(LF+NoAscendMsg);
  368.   END;
  369.   IF AscOkay AND (Altitude = 500) THEN
  370.   BEGIN
  371.     AscOkay := FALSE;
  372.     XLn('You''re as high as you can go!');
  373.     XLn('Meet the  challenge of power!');
  374.   END;
  375.   IF AscOkay AND ( Postings < ( Altitude DIV (8 - RANDOM(5)) ) )
  376.   AND (NOT WizOp)
  377.   THEN
  378.   BEGIN
  379.     XLn('TSOTL  thinks  you  should get to  know');
  380.     XLn('your fellow wizards a  bit better.  You');
  381.     XLn('will have to send a few messages before');
  382.     XLn('you can advance any further.');
  383.     AscOkay := FALSE;
  384.   END;
  385.   IF AscOkay THEN
  386.   BEGIN
  387.     IF (MaxLev < (Altitude + 1)) AND (MaxLev <> 0) THEN
  388.     BEGIN
  389.       XLn('Before you can rise  any further,  you');
  390.       XLn('must use the BESEECH spell to convince');
  391.       XLn('TSOTL that you are  worthy.  (However,');
  392.       XLn('if you  gave the wrong phone-number at');
  393.       XLn('sign-up time ... don''t bother.)');
  394.       AscOkay := FALSE;
  395.     END;
  396.   END;
  397.   IF AscOkay THEN
  398.   BEGIN
  399.     IF NOT OpenQuestFile THEN XLn('Sorry; the Guardians are in a bad mood.')
  400.     ELSE
  401.     BEGIN
  402.       AscCnt := AscCnt + 1;
  403.       IF Altitude > 12 THEN AscCnt := AscCnt + 1;
  404.       IF Altitude > 20 THEN AscCnt := AscCnt + 1;
  405.       IF Altitude > 35 THEN AscCnt := AscCnt + 1;
  406.       IF RANDOM(20) < (AscCnt-2) THEN
  407.       BEGIN
  408.         X('The Guardian ');
  409.         CASE AscCnt OF
  410.           00..02 : XLn('is busy, having coffee.');
  411.           03..03 : XLn('is busy, filing his fangs.');
  412.           04..04 : BEGIN
  413.                      XLn('is busy, reading a copy');
  414.                      XLn('of "Guardian''s Monthly" magazine.');
  415.                    END;
  416.           05..05 : BEGIN
  417.                      XLn('is talking to another');
  418.                      XLN('Guardian about the weather.');
  419.                    END;
  420.           06..09 : XLn('pretends not to see you.');
  421.           10..12 : XLn('doesn''t want to talk.');
  422.           13..16 : XLn('looks annoyed.');
  423.           17..20 : XLn('looks very annoyed.');
  424.           ELSE
  425.             XLn('looks VERY irritated.');
  426.         END;
  427.         XLF;
  428.         IF RANDOM(100) < 25
  429.         THEN XLn('He turns away.')
  430.         ELSE XLn('He turns his back.');
  431.         IF AscCnt >= 20 THEN XLn(LF+'You are being totally ignored.');
  432.       END
  433.       ELSE
  434.       BEGIN
  435.         XLn('The Guardian is '+SaveDescTexture);
  436.         X(SaveDescType);
  437.         XLn(SaveDescCharac+'.');
  438.         X(LF+'He is checking his list...');
  439.         { In case of same que. }  QuesPtr := RANDOM(FileSize(QuestFile));
  440.         IF QuesPtr = AscLast THEN QuesPtr := RANDOM(FileSize(QuestFile));
  441.         AscLast := QuesPtr;
  442.         SEEK(QuestFile,QuesPtr);
  443.         READ(QuestFile,QuestRec);
  444.         XLF; XLn('He says to you...');
  445.         XLn(LF+QuestRec.Question);
  446.         IF Altitude < 35 THEN
  447.         BEGIN
  448.           X(LF+'            ');
  449.           FOR HintCntr := 1 TO LENGTH(QuestRec.Answer) DO
  450.           BEGIN
  451.             IF QuestRec.Answer[HintCntr] = ' ' THEN X(' ') ELSE X('.');
  452.           END;
  453.         END;
  454.         XLF;
  455.         X('ANSWER HIM> ');
  456.         SaveCmdP := CmdParm;
  457.         CmdParm := '';
  458.         SaveTOS := TimeOutSecs;
  459.         TimeOutSecs := 50 - Level;
  460.         IF TimeOutSecs < 2 THEN TimeOutSecs := 2;
  461.         TestAns := Upper(GetInputLn); XLF;
  462.         TimeOutSecs := SaveTOS;
  463.         CmdParm := SaveCmdP;
  464.         WITH QuestRec DO
  465.         IF
  466.         ( TestAns = Answer )
  467.         OR
  468.         (
  469.            (  LENGTH(TestAns) > ( LENGTH(Answer) DIV 2 )  )
  470.            AND
  471.            (
  472.               (  ( POS(TestAns,Answer)>0 ) AND ( POS(' ', Answer)>0 )  )
  473.               OR
  474.               (  ( POS(Answer,TestAns)>0 ) AND ( POS(' ',TestAns)>0 )  )
  475.            )
  476.         )
  477.         THEN
  478.         BEGIN
  479.           XLn('"You may pass," says the Guardian.');
  480.           AscCnt := 0;
  481.           IF Level < 4 THEN
  482.           BEGIN
  483.             XLF; XLn('As you move uphill, he reminds you to use');
  484.             XLn('the magic  HELP  word to see new spells.'); XLF;
  485.           END;
  486.           IF  (EsteemCalc > (100 + Level))
  487.           AND (Altitude = Level)
  488.           AND Pleaseable THEN
  489.           BEGIN
  490.             XLF;
  491.             XLn('And TSOTL, pleased with you,');
  492.             XLn('grants you some extra Manna.');
  493.             SetManna(Altitude*3+MannaPoints+2);
  494.           END;
  495.           IF Level < Altitude+1 THEN Level := Altitude+1;
  496.           SetAltitude(Altitude+1);
  497.           IF Promo THEN
  498.           BEGIN
  499.             XLF; XLn('Congratulations!  You''re now part of');
  500.             XLn('the '+PresentBoard+'!');
  501.             XLF; XLn('Use READ to check the messages.');
  502.           END;
  503.           IF Altitude = 30 THEN
  504.           BEGIN
  505.             XLF; XLn('As you move uphill,  the Guardian tells');
  506.             XLn('you  that  further  ascent  with  CLOAK');
  507.             XLn('or  ASCEND  will cost  as much Manna as');
  508.             XLn('the number of the level above.');
  509.           END;
  510.           IF (Altitude = 500) AND (SaveLevel = 499) THEN
  511.           BEGIN
  512.             XLF;
  513.             XLn('You  have  reached  The  Pinnacle!');
  514.             XLF;
  515.             XLn('TSOTL is very much impressed.');
  516.             XLF;
  517.             XLn('"WELCOME TO THE PINNACLE, MORTAL."');
  518.             SysLog('L',UserName+' reached Level 500!');
  519.           END;
  520.         END { Answer was right }
  521.         ELSE
  522.         BEGIN
  523.           IF (LENGTH(TestAns) <> LENGTH(QuestRec.Answer)) AND (Level > 3)
  524.           THEN AscCnt := AscCnt + 1;
  525.           IF Charging THEN
  526.           BEGIN
  527.             XLn('"Wrong!" yells the Guardian, and hurls');
  528.             IF LENGTH(TestAns) = 0
  529.             THEN
  530.             BEGIN
  531.               XLn('a fire-ball towards you.');
  532.               AscCnt := AscCnt + 1;
  533.             END
  534.             ELSE XLn('a bolt of lightning towards you.');
  535.             IF Cloaked
  536.             THEN XLn(LF+'Luckily, your cloaking spell saves you.')
  537.             ELSE Logoff := TRUE;
  538.           END
  539.           ELSE
  540.           BEGIN
  541.             IF LENGTH(TestAns) = 0
  542.             THEN
  543.             BEGIN
  544.               XLn('The Guardian shrugs.');
  545.               AscCnt := AscCnt + 1;
  546.             END
  547.             ELSE XLn('"No," says the Guardian.  "Incorrect."');
  548.             IF (LENGTH(TestAns) = LENGTH(QuestRec.Answer))
  549.             AND (LENGTH(TestAns) > 5) THEN
  550.             BEGIN
  551.               HintCntr := 0;
  552.               FOR SpellChk := 1 TO LENGTH(TestAns) DO
  553.               IF TestAns[SpellChk] = QuestRec.Answer[SpellChk]
  554.               THEN HintCntr := HintCntr + 1;
  555.               IF (LENGTH(TestAns) - 2) <= HintCntr
  556.               THEN
  557.               BEGIN
  558.                 XLF; XLn('As you depart, the Guardian mutters');
  559.                 XLn('something about "bad spelling"...');
  560.               END;
  561.             END; { Worth spell-checking }
  562.           END; { Wasn't charging }
  563.         END; { Answer was wrong }
  564.       END; { Guard not fed up }
  565.       CLOSE(QuestFile);
  566.     END; { File opened okay }
  567.   END; { Posted enough and was sanctified enough }
  568.   Charging := FALSE;
  569.   Cloaked  := FALSE;
  570. END;
  571.  
  572. OVERLAY PROCEDURE Check;
  573. BEGIN  { Check }
  574.   XLnI('DAY:MINUTE ....... '+ShowDate(Date,Mint));
  575.   XLnI('Sorcery Level .... '+IntToStr(Level));
  576.   XLnI('Manna-points ..... '+IntToStr(MannaPoints));
  577.   XLnI('Maximum Manna .... '+IntToStr((Level+1) * 50));
  578.   XLnI('Manna Recovery ... '+IntToStr(25+Level) + ' per day.');
  579.   XLnI('TSOTL''s Esteem ... '+IntToStr(EsteemCalc));
  580.   IF WizOp THEN
  581.   XLnI(LF+'Next message # ... '+IntToStr(NextMsg));
  582.   XLnI(LF+'You are currently on a level used by');
  583.   XLnI('the '+PresentBoard+'.');
  584.   CharDuringO := FALSE;
  585. END;
  586.  
  587. OVERLAY PROCEDURE Help;  { HELP Spell }
  588. VAR
  589.   HelpCntr : INTEGER;
  590. BEGIN
  591.   Explained := FALSE;
  592.   ExplainKeys;
  593.   XLn('"YOU ARE PERMITTED TO USE THESE SPELLS"');
  594.   HelpCntr := 1;
  595.   IF Width >= 64 THEN XLF;
  596.   REPEAT
  597.     IF  (CmdLevels[HelpCntr] <= Level)
  598.     AND ((CmdLevels[HelpCntr] < 499) OR WizOp)
  599.     AND (InFocus(CmdWords[HelpCntr]) OR InFocus(CmdDescs[HelpCntr]))
  600.     THEN
  601.     BEGIN
  602.       IF Width < 64 THEN
  603.       BEGIN  XLn(LF+CmdWords[HelpCntr]);  XLn(CmdDescs[HelpCntr]);  END
  604.       ELSE
  605.       BEGIN
  606.         XLn(Fmt(CmdWords[HelpCntr],Left,10)+'  '+CmdDescs[HelpCntr]);
  607.       END;
  608.     END;
  609.     HelpCntr := HelpCntr + 1;
  610.   UNTIL CharDuringO OR (HelpCntr > NumCmds);
  611. END;
  612.  
  613. OVERLAY PROCEDURE Spells;  { SPELLS spell }
  614. VAR
  615.   OutCntr   : INTEGER;
  616.   SpellCntr : INTEGER;
  617. BEGIN
  618.   Explained := FALSE;
  619.   ExplainKeys;
  620.   OutCntr := 0;
  621.   SpellCntr := 0;
  622.   IF WIDTH < 80 THEN
  623.   BEGIN
  624.     XLn('  MAGIC     MANNA-   SORCERY');
  625.     XLn('  WORD      POINTS    LEVEL');
  626.     XLn('----------  -------  -------');
  627.     REPEAT
  628.       SpellCntr := SpellCntr + 1;
  629.       IF ((CmdLevels[SpellCntr] < 401) OR WizOp)
  630.       AND (InFocus(CmdWords[SpellCntr]) OR InFocus(CmdDescs[SpellCntr]))
  631.       THEN
  632.       BEGIN
  633.         X( Fmt( CmdWords[SpellCntr],            Left, 10 ) + '   '    );
  634.         X( Fmt( IntToStr(CmdCosts[SpellCntr]),  Right, 4 ) + '      ' );
  635.         X( Fmt( IntToStr(CmdLevels[SpellCntr]), Right, 3 )            );
  636.         XLF;
  637.       END;
  638.     UNTIL CharDuringO OR (SpellCntr = NumCmds);
  639.   END
  640.   ELSE
  641.   BEGIN
  642.     XLn('  MAGIC     MANNA-   SORCERY      MAGIC     MANNA-   SORCERY');
  643.     XLn('  WORD      POINTS    LEVEL       WORD      POINTS    LEVEL');
  644.     XLn('----------  -------  -------    ----------  -------  -------');
  645.     REPEAT
  646.       SpellCntr := SpellCntr + 1;
  647.       IF ((CmdLevels[SpellCntr] < 401) OR WizOp)
  648.       AND (InFocus(CmdWords[SpellCntr]) OR InFocus(CmdDescs[SpellCntr]))
  649.       THEN
  650.       BEGIN
  651.         X( Fmt( CmdWords[SpellCntr],            Left, 10 ) + '   '     );
  652.         X( Fmt( IntToStr(CmdCosts[SpellCntr]),  Right, 4 ) + '       ' );
  653.         X( Fmt( IntToStr(CmdLevels[SpellCntr]), Right, 3 )             );
  654.         OutCntr := OutCntr + 1;
  655.         IF ODD(OutCntr) THEN X('     ') ELSE XLF;
  656.       END;
  657.     UNTIL CharDuringO OR (SpellCntr = NumCmds);
  658.   END;
  659.   IF NOT CharDuringO THEN
  660.   BEGIN
  661.     IF ODD(OutCntr) THEN XLF;
  662.     XLF; XLn('It is not necessary to type the entire');
  663.     XLn('word -- just the  first  few  letters.');
  664.   END;
  665. END;
  666.  
  667. OVERLAY PROCEDURE Review;  { REVIEW spell }
  668. VAR
  669.   RStat    : SFType;
  670.   SaveTune : Line;
  671. BEGIN
  672.   ReadBand := '*';
  673.   SaveTune := TuneString;
  674.   TuneString := '';
  675.   MsgPtr := AskMsgTimesPtr + 1;  { Add one 'cuz in-core index starts at zero }
  676.   IF MsgPtr > MaxMsgs
  677.   THEN XLn('Sorry, can''t find that message.')
  678.   ELSE RStat := XMsg;
  679.   TuneString := SaveTune;
  680. END;
  681.  
  682. OVERLAY PROCEDURE Specs;  { Specs spell }
  683. VAR
  684.   XWidth : INTEGER;
  685. BEGIN
  686.   XLn('Your screen width is set to '+IntToStr(Width)+'.');
  687.   XLF;
  688.   XWidth := GetInt('Specify a new screen width:  ');
  689.   IF (XWidth < 10) OR (XWidth > 80)
  690.   THEN XLn('Width must be between 10 and 80.')
  691.   ELSE Width := XWidth;
  692.   BreakPoint := Width DIV 3;
  693. END;
  694.  
  695. OVERLAY PROCEDURE TimeWarp;  { TimeWarp spell }
  696. BEGIN  { TimeWarp }
  697.   XLn('It is now '+ShowDate(Date,Mint)+'.'+LF);
  698.   Date_Warp := GetInt('Warp back to which day?   ');
  699.   Mint_Warp := GetInt('What minute of that day?  ');
  700.   IF Date_Warp < 1 THEN
  701.   BEGIN
  702.     Date_Warp := 1;
  703.     Mint_Warp := 1;
  704.   END;
  705.   XLF;
  706.   IF (Date_Warp < Date)
  707.   OR ((Date_Warp = Date) AND (Mint_Warp < Mint))
  708.   THEN
  709.   BEGIN
  710.     XLnI('Your READ, SCROLLS & LISTEN spells will');
  711.     XLnI('now show messages sent after '+ShowDate(Date_Warp,Mint_Warp)+'.');
  712.     XLnI('');
  713.     XLnI('To set your  "read-after" times back to');
  714.     XLnI('the way  they  were  when  you  arrived');
  715.     XLnI('here, TIMEWARP  to a future  DAY:MINUTE');
  716.     XLnI('such as '+ShowDate( (Date DIV 10) * 10 + 10, 0 )+'.');
  717.   END
  718.   ELSE
  719.   BEGIN
  720.     Date_Warp := -1;  { Inactive }
  721.     XLn('Back on normal time...');
  722.   END;
  723. END;
  724.  
  725. OVERLAY PROCEDURE Detect;
  726. VAR
  727.   BDate    : INTEGER;
  728.   BDateStr : Line;
  729.   TempInt  : INTEGER;
  730. BEGIN
  731.   XLn('Today is day '+IntToStr(Date)+'.'); XLF;
  732.   BDate := GetInt('Display for what day and earlier?  ');
  733.   XLF;
  734.   XLn(' DAY:MIN        SENT BY         LEVEL');
  735.   XLn('--------- -------------------- -------');
  736.   TempInt := NextMsg;
  737.   REPEAT
  738.     TempInt := MsgNumBefore(TempInt);
  739.     IF (MsgDates[TempInt] <> 0)
  740.     AND (BDate >= MsgDates[TempInt])
  741.     AND (InFocus(MsgPosters[TempInt]))
  742.     THEN
  743.     BEGIN
  744.       X( Fmt (IntToStr(MsgDates[TempInt]), Right, 4) + ':');
  745.       X( Fmt (IntToStr(MsgMints[TempInt]), Left, 4) + ' ');
  746.       X( Fmt (Upper(MsgPosters[TempInt]), Left, 20) + ' ');
  747.       CASE MsgBands[TempInt] OF
  748.         '0' : X('   0   ');
  749.         'A' : X(' 1 - 29');
  750.         'B' : X('30 - 99');
  751.         'C' : X('100-299');
  752.         'D' : X('300-500');
  753.         'G' : X('Arrival');
  754.         'P' : X('Beseech');
  755.         'S' : X('Scrolls');
  756.         ELSE  X('UNKNOWN');
  757.       END;
  758.       XLF;
  759.     END;
  760.   UNTIL (TempInt = NextMsg) OR CharDuringO;
  761. END;  { Detect }
  762.  
  763. OVERLAY PROCEDURE Change;  { CHANGE spell }
  764. VAR
  765.   ChChar   : CHAR;
  766.   SaveIt   : BOOLEAN;
  767. BEGIN
  768.   MsgPtr := AskMsgTimesPtr;
  769.   IF MsgPtr = MaxMsgs
  770.   THEN XLn('Sorry, can''t find that message.')
  771.   ELSE
  772.   BEGIN
  773.     IF (MsgPosters[MsgPtr+1] <> UserName) AND (NOT WizOp)
  774.     THEN
  775.     BEGIN
  776.       XLn('TSOTL takes a  dim view  of those who');
  777.       XLn('try to alter what others have said...');
  778.     END
  779.     ELSE
  780.     BEGIN
  781.       IF NOT OpenFile(MsgFile(MsgPtr+1))
  782.       THEN XLn('That message is strangely immune.')
  783.       ELSE
  784.       BEGIN
  785.         XLn('One moment, please...');
  786.         ChSize := 0;
  787.         REPEAT
  788.           ChSize := ChSize + 1;
  789.           READLN(TxtFile,EditBuffer[ChSize]);
  790.           EditBuffer[ChSize] := DeCompress(EditBuffer[ChSize]);
  791.         UNTIL EOF(TxtFile);
  792.         ChChar := Editor('C');
  793.       END; { Got msg }
  794.     END; { His msg }
  795.   END; { Found msg }
  796. END;
  797.  
  798. OVERLAY PROCEDURE Bestow;  { BESTOW spell }
  799. VAR
  800.   BAmntStr : TenType;
  801.   BAmnt    : INTEGER;
  802.   PoorGuy  : UNameType;
  803. BEGIN
  804.   Tactical := TRUE;
  805.   X('Give Manna to who?  ');
  806.   PoorGuy := Upper(GetInputLn); XLF;
  807.   IF NOT FindUserRecPtr(PoorGuy)
  808.   THEN XLn('No such person on THIS Mountain!')
  809.   ELSE
  810.   BEGIN
  811.     XLn('You have '+IntToStr(Mannapoints)+' Manna-points.'); XLF;
  812.     BAmnt := GetInt('How much will you give?  ');
  813.     IF BAmnt > MannaPoints
  814.     THEN XLn('You don''t HAVE that many!')
  815.     ELSE
  816.     BEGIN
  817.       MannaPoints := MannaPoints - BAmnt;
  818.       SEEK(UsersFile,UserRecPtr);
  819.       READ(UsersFile,OtherUsersRec);
  820.       IF OtherUsersRec.UserName <> PoorGuy
  821.       THEN XLn('Strangely immune!')
  822.       ELSE
  823.       BEGIN
  824.         OtherUsersRec.Points := BigAdd(OtherUsersRec.Points,BAmnt);
  825.         SEEK(UsersFile,UserRecPtr);
  826.         WRITE(UsersFile,OtherUsersRec);
  827.         XLF;
  828.         IF BAmnt > 9
  829.         THEN XLn('Now at '+IntToStr(OtherUsersRec.Points)+' Manna-points!')
  830.         ELSE XLn('Not very generous, are you?');
  831.         IF (RANDOM(100) < 10) AND (BAmnt > 50)
  832.         THEN XLn(LF+'TSOTL values your generosity.');
  833.         SysLog('I',UserName+' bestowed '+IntToStr(BAmnt)+' to '+PoorGuy);
  834.       END;
  835.     END;
  836.   END;
  837. END;
  838.  
  839. OVERLAY PROCEDURE Teleport;
  840. VAR
  841.   TNum : INTEGER;
  842. BEGIN  { Teleport }
  843.   TNUm := GetInt('To which level are you going?  ');
  844.   IF Tnum > Level THEN Tnum := Level;
  845.   IF (TNum DIV 25 < Postings) OR WizOp
  846.   THEN SetAltitude(TNum)
  847.   ELSE
  848.   BEGIN
  849.     XLn('TSOTL rumbles:');
  850.     XLF;
  851.     XLn('"I HOLD YOU IN  VERY  LOW  ESTEEM!');
  852.     XLn('YOU  MUST  CLIMB  THE  HARD  WAY!"');
  853.     XLF;
  854.     XLn('Looks like you''ll have to ASCEND.');
  855.   END;
  856. END;
  857.  
  858. OVERLAY PROCEDURE Boost;
  859. VAR
  860.   OkayLine : TenType;
  861.   TempInt  : INTEGER;
  862. BEGIN
  863.   IF BaudRate > 999
  864.   THEN
  865.   BEGIN
  866.     XLn('BOOST  is only useable');
  867.     XLn('on  low-speed  modems.');
  868.   END
  869.   ELSE
  870.   BEGIN
  871.     XLn('Some modems  can  run  faster  over');
  872.     XLn('local lines if the terminal program');
  873.     XLn('has variable baud-rate selection...'); XLF;
  874.     TempInt := GetInt('What baud-rate do you want?  '); XLF;
  875.     IF (TempInt <= 300) OR (TempInt > 999)
  876.     THEN
  877.     BEGIN
  878.       XLn('Impossible baud rate.');
  879.       XLn('Baud-rate  unchanged.');
  880.     END
  881.     ELSE
  882.     BEGIN
  883.       XLn('If you don''t succeed, switch back to '+IntToStr(BaudRate)+' Baud.'); XLF;
  884.       XLn('Reset baud-rate, then type:  TEST');
  885.       X('AWAITING TEST> ');
  886.       SetBaud(TempInt);
  887.       OkayLine := '';
  888.       FOR TempInt := 1 TO 4 DO OkayLine := OkayLine + UPCASE(SerialIn);
  889.       IF OkayLine <> 'TEST' THEN SetBaud(BaudRate);
  890.       XLF;
  891.     END;  { Acceptable attempt }
  892.   END;  { Low-speed modem }
  893. END;
  894.  
  895. OVERLAY PROCEDURE SlowTime;
  896. BEGIN
  897.   IF SlowedTime
  898.   THEN XLn('Don''t push TSOTL''s patience.')
  899.   ELSE
  900.   BEGIN
  901.     SlowX('Time slows down ...');
  902.     XLF;
  903.     Patience := Patience + 15;
  904.     SlowedTime := TRUE;
  905.   END;
  906. END;
  907.  
  908. OVERLAY PROCEDURE Roster;  { ROSTER spell }
  909. VAR
  910.   RDiv  : INTEGER;
  911.   PCntr : INTEGER;
  912.   RCntr : INTEGER;
  913. BEGIN
  914.   RDiv := Width DIV 21;
  915.   PCntr := 1;
  916.   RCntr := 1;
  917.   REPEAT
  918.     IF (LENGTH(UserNames[RCntr]) > 0) AND (InFocus(UserNames[RCntr]))
  919.     THEN
  920.     BEGIN
  921.       IF Width < 22
  922.       THEN XLn(UserNames[RCntr])
  923.       ELSE
  924.       BEGIN
  925.         IF (PCntr DIV RDiv * RDiv) = PCntr
  926.         THEN XLn(UserNames[RCntr])
  927.         ELSE X(Fmt(UserNames[RCntr],Left,21));
  928.         PCntr := PCntr + 1;
  929.       END;
  930.     END;
  931.     RCntr := RCntr + 1;
  932.   UNTIL (RCntr = MaxUsers) OR CharDuringO;
  933.   XLF;
  934. END;
  935.  
  936. OVERLAY PROCEDURE Probe;  { PROBE spell }
  937. VAR
  938.   VWho   : UNameType;
  939.   Esteem : INTEGER;
  940. BEGIN
  941.   X('Probe who?  ');
  942.   VWho := Upper(GetInputLn); XLF;
  943.   IF LENGTH(VWho) = 0 THEN XLn('Okay ... FORGET it, then!')
  944.   ELSE
  945.   BEGIN
  946.     IF NOT FindUserRecPtr(VWho)
  947.     THEN XLn('Don''t know the person...')
  948.     ELSE
  949.     BEGIN
  950.       SEEK(UsersFile,UserRecPtr);
  951.       READ(UsersFile,OtherUsersRec);
  952.       IF VWho = UserName
  953.       THEN Esteem := EsteemCalc
  954.       ELSE Esteem := OtherUsersRec.MsgsSent*10 DIV (OtherUsersRec.Level + 1) * 10;
  955.       IF Esteem < 0 THEN Esteem := 0;
  956.       IF (OtherUsersRec.Level > Level + 400)
  957.       THEN XLn('Sorcery Level too high to probe!')
  958.       ELSE WITH OtherUsersRec DO
  959.       BEGIN
  960.         XLnI('Sorcery Level .... '+IntToStr(Level));
  961.         IF WizOp THEN XLnI('Maximum Level .... '+IntToStr(MaxLevel));
  962.         XLnI('Manna-points ..... '+IntToStr(Points));
  963.         XLnI('Manna Recovery ... '+IntToStr(25+Level)+' per day.');
  964.         XLnI('TSOTL''s Esteem ... '+IntToStr(Esteem));
  965.         IF WizOp THEN XLnI('Esteem Basis ..... '+IntToStr(MsgsSent));
  966.         IF Date_Last = 0
  967.         THEN XLnI('Status ........... BANISHED!')
  968.         ELSE XLnI('Last call at ..... '+ShowDate(Date_Last,Mint_Last));
  969.         IF WizOp THEN
  970.         BEGIN
  971.            XLnI('True Name ........ '+RealName);
  972.            XLnI('Phone Number ..... '+Phone);
  973.            XLnI('Terminal Width ... '+IntToStr(Width));
  974.         END;
  975.       END;
  976.     END;
  977.   END;
  978.   CharDuringO := FALSE;
  979. END;
  980.  
  981. OVERLAY PROCEDURE Inquire;
  982. VAR
  983.   TempInt  : INTEGER;
  984. BEGIN
  985.   XLn('The Spirit Of The Land says unto you:');
  986.   XLF;
  987.   XLn('"I WILL NOT PERMIT THIS VISIT TO LAST');
  988.   XLn('MORE THAN '+IntToStr(Patience)+' MINUTES."'); XLF;
  989.   X('You''ve been here about ');
  990.   TempInt := ROUND(ElapsedTime(StartDate,StartMint,Date,Mint));
  991.   X(IntToStr(TempInt));
  992.   X(' minute'); IF TempInt = 1 THEN XLn('.') ELSE XLn('s.');
  993. END;
  994.  
  995. OVERLAY PROCEDURE Drain(DFunc : CHAR);  { DRAIN spell }
  996. VAR
  997.   PoorGuy  : UNameType;
  998. BEGIN
  999.   Tactical := TRUE;
  1000.   X('Remove Manna from WHO?  ');
  1001.   PoorGuy := Upper(GetInputLn); XLF;
  1002.   IF NOT FindUserRecPtr(PoorGuy)
  1003.   THEN XLn('Don''t know that name.')
  1004.   ELSE
  1005.   BEGIN
  1006.     SEEK(UsersFile,UserRecPtr);
  1007.     READ(UsersFile,OtherUsersRec);
  1008.     IF OtherUsersRec.UserName <> PoorGuy
  1009.     THEN XLn('Strangely immune!')
  1010.     ELSE
  1011.     BEGIN
  1012.       IF (MaxLev <> 0) AND (MaxLev < 16)
  1013.       AND (OtherUsersRec.MaxLevel = 0)
  1014.       THEN
  1015.       BEGIN
  1016.         XLn('That  wizard  has been  sanctified  for');
  1017.         XLn('further advancement,  but you have not.');
  1018.         XLn('You must BESEECH for sanctification be-');
  1019.         XLn('fore you can do this.');
  1020.       END
  1021.       ELSE
  1022.       BEGIN
  1023.         GetSpellRepeat;
  1024.         IF SpellRepeat = 0
  1025.         THEN XLn('That''s nice of you!')
  1026.         ELSE
  1027.         BEGIN
  1028.           WITH OtherUsersRec DO
  1029.           BEGIN
  1030.             Points := BigSub(Points,SpellRepeat * 100);
  1031.             IF (Level > 10) AND (Points = -30000)
  1032.             THEN
  1033.             BEGIN
  1034.               Level := Level - 10;
  1035.               XLn('"DOWNWARDS!"');
  1036.               XLF;
  1037.             END;
  1038.           END;
  1039.           SEEK(UsersFile,UserRecPtr);
  1040.           WRITE(UsersFile,OtherUsersRec);
  1041.           IF DFunc = 'S'
  1042.           THEN SysLog('W',UserName+' stole from '+PoorGuy)
  1043.           ELSE SysLog('I',UserName+' drained '+PoorGuy);
  1044.           XLF;
  1045.           XLn('Now at '+IntToStr(OtherUsersRec.Points)+' Manna-points!');
  1046.           IF RANDOM(100) < 5 THEN XLn(LF+'TSOTL is amused.');
  1047.           IF DFunc = 'S' THEN
  1048.           BEGIN
  1049.             IF Level > OtherUsersRec.Level THEN SpellRepeat := SpellRepeat * 2;
  1050.             Postings := Postings - SpellRepeat;
  1051.           END;
  1052.         END;  { Repeat > 0 }
  1053.       END;  { Sanc/Sanc draining }
  1054.     END;  { File checked okay }
  1055.   END;  { Name is okay }
  1056. END;
  1057.  
  1058. OVERLAY PROCEDURE Seismo(SFunc : CHAR);  { FEED and STARVE spells }
  1059. VAR
  1060.   SAmnt    : INTEGER;
  1061.   SReal    : REAL;
  1062.   SRand    : INTEGER;
  1063. BEGIN
  1064.   Tactical := TRUE;
  1065.   XLn('Quoth Seismoros:');
  1066.   XLF;
  1067.   SRand := RANDOM(15);
  1068.   X('"I AM ');
  1069.   CASE SRand OF
  1070.     00 : X('LIFE.');
  1071.     01 : X('SHIVA.');
  1072.     02 : X('MOTHER TO THE PHOENIX.');
  1073.     03 : X('CREATOR.');
  1074.     04 : X('DESTROYER.');
  1075.     05 : X('SEISMOROS!');
  1076.     06 : X('THE CIRCLE.');
  1077.     07 : X('THE SPIRIT OF DEATH.');
  1078.     08 : X('THE WILL OF REBIRTH.');
  1079.     09 : X('THE AGENT OF WILL.');
  1080.     10 : X('THE CYCLE OF THE SEASONS.');
  1081.     11 : X('THE EQUALIZER.');
  1082.     12 : X('THE HOPE OF THE OPPRESSED.');
  1083.     13 : X('THE DESPISED ONE.');
  1084.     14 : X('THE ONE THEY FEAR.');
  1085.   END;
  1086.   XLn('"');
  1087.   XLF;
  1088.   XLn('You have '+IntToStr(MannaPoints)+' Manna-points.');
  1089.   XLF;
  1090.   XLn('How many Manna-points will you use for');
  1091.   IF SFunc = 'F'
  1092.   THEN X('feeding')
  1093.   ELSE X('starving');
  1094.   SAmnt := GetInt(' Seismoros?  ');
  1095.   XLF;
  1096.   IF (SAmnt <= 10) AND (NOT WizOp)
  1097.   THEN XLn('Seismoros brushes you aside.')
  1098.   ELSE
  1099.   BEGIN
  1100.     IF SAmnt > MannaPoints
  1101.     THEN XLn('You don''t HAVE that many!')
  1102.     ELSE
  1103.     BEGIN
  1104.       SetManna(MannaPoints - SAmnt);
  1105.       RESET(SeismoFile);
  1106.       READ(SeismoFile,SeismoRec);
  1107.       IF SFunc = 'F'
  1108.       THEN SAmnt := BigAdd(SeismoRec.Energy,SAmnt DIV 2)
  1109.       ELSE SAmnt := BigSub(SeismoRec.Energy,SAmnt DIV 2);
  1110.       IF SAmnt < 0 THEN SAmnt := 0;
  1111.       SeismoRec.Energy := SAmnt;
  1112.       IF SAmnt < 20000
  1113.       THEN
  1114.       BEGIN
  1115.         SReal := SAmnt / 200.0;
  1116.         XLn('Seismoros is '
  1117.         +IntToStr( TRUNC(SReal) )
  1118.         +'.'
  1119.         +IntToStr( TRUNC( FRAC(SReal) * 10 ) )
  1120.         +'% energized.');
  1121.       END
  1122.       ELSE
  1123.       BEGIN
  1124.         XLn('Seismoros is fully energized!');
  1125.         XLF;
  1126.         XLn('The  Mountain  is  quivering!');
  1127.         XLF;
  1128.         XLn('SEISMOROS HAS BEEN UNLEASHED!');
  1129.         SysLog('I','SEISMOROS HAS BEEN UNLEASHED!');
  1130.         Logoff := TRUE;
  1131.         SeismoActive := TRUE;
  1132.         SeismoRec.Energy := 500;
  1133.       END;  { 100% energized! }
  1134.       RESET(SeismoFile);
  1135.       WRITE(SeismoFile,SeismoRec);
  1136.     END;  { Contribution <= Manna }
  1137.   END;  { Contribution exceeded 10 }
  1138. END;
  1139.  
  1140. OVERLAY PROCEDURE StopTime;
  1141. BEGIN
  1142.   IF StoppedTime
  1143.   THEN XLn('TSOTL says, "NOT TWICE IN ONE VISIT".')
  1144.   ELSE
  1145.   BEGIN
  1146.     X('Time seems to be coming to a ');
  1147.     DELAY(100); X('h'); DELAY(200); X('a');
  1148.     DELAY(300); X('l'); DELAY(400); X('t');
  1149.     DELAY(500); X('.'); DELAY(600);
  1150.     XLF;
  1151.     Patience := Patience + PatienceCalc;
  1152.     StoppedTime := TRUE;
  1153.   END;
  1154. END;
  1155.  
  1156. OVERLAY PROCEDURE Promote;  { PROMOTE spell }
  1157. VAR
  1158.   PoorGuy  : UNameType;
  1159.   PromoOK  : BOOLEAN;
  1160. BEGIN
  1161.   Tactical := TRUE;
  1162.   PromoOK  := TRUE;
  1163.   SpellRepeat := 0;
  1164.   X('Promote who?  ');
  1165.   PoorGuy := Upper(GetInputLn); XLF;
  1166.   {----- Valid user? -----}
  1167.   IF NOT FindUserRecPtr(PoorGuy) THEN
  1168.   BEGIN
  1169.     XLn('Can''t find that name.');
  1170.     PromoOK := FALSE;
  1171.   END;
  1172.   {----- Index Error or Auto-Promote? -----}
  1173.   IF PromoOK THEN
  1174.   BEGIN
  1175.     SEEK(UsersFile,UserRecPtr);
  1176.     READ(UsersFile,OtherUsersRec);
  1177.     IF (OtherUsersRec.UserName <> PoorGuy) OR (PoorGuy = UserName)
  1178.     THEN
  1179.     BEGIN
  1180.       XLn('Nice try!');
  1181.       PromoOK := FALSE;
  1182.     END;
  1183.   END;
  1184.   {----- Higher-Wizard Promote? -----}
  1185.   IF PromoOK THEN
  1186.   BEGIN
  1187.     IF OtherUsersRec.Level >= Level
  1188.     THEN
  1189.     BEGIN
  1190.       XLn('You can''t promote somebody');
  1191.       XLn('to a level  above your own.');
  1192.       PromoOK := FALSE;
  1193.     END
  1194.   END;
  1195.   {----- Zero Promote? -----}
  1196.   IF PromoOK THEN
  1197.   BEGIN
  1198.     GetSpellRepeat;
  1199.     IF SpellRepeat = 0 THEN PromoOK := FALSE;
  1200.   END;
  1201.   {----- Past Sanctification Limit? -----}
  1202.   IF PromoOK THEN
  1203.   BEGIN
  1204.     IF  (OtherUsersRec.Level + SpellRepeat > OtherUsersRec.MaxLevel)
  1205.     AND (OtherUsersRec.MaxLevel <> 0)
  1206.     THEN
  1207.     BEGIN
  1208.       XLn('That wizard is not sanctified to rise');
  1209.       XLn('above level '+IntToStr(OtherUsersRec.MaxLevel)+'.');
  1210.       PromoOK := FALSE;
  1211.     END;
  1212.   END;
  1213.   {----- Overhead Promote? -----}
  1214.   IF PromoOK THEN
  1215.   BEGIN
  1216.     IF OtherUsersRec.Level + SpellRepeat > Level
  1217.     THEN
  1218.     BEGIN
  1219.       XLn('You can''t promote somebody higher');
  1220.       XLn('than your  own  sorcery level!');
  1221.       PromoOK := FALSE;
  1222.     END;
  1223.   END;
  1224.   {----- Esteemed Enough? -----}
  1225.   IF PromoOK THEN
  1226.   BEGIN
  1227.     IF (OtherUsersRec.Level + SpellRepeat) DIV 30 > OtherUsersRec.MsgsSent
  1228.     THEN
  1229.     BEGIN
  1230.       XLn('TSOTL doesn''t think that wizard');
  1231.       XLn('deserves  to be  promoted  that');
  1232.       XLn('high -- power  must  be earned!');
  1233.       PromoOK := FALSE;
  1234.     END;
  1235.   END;
  1236.   {----- Do the Promote -----}
  1237.   IF PromoOK THEN
  1238.   BEGIN
  1239.     OtherUsersRec.Level := OtherUsersRec.Level + SpellRepeat;
  1240.     SEEK(UsersFile,UserRecPtr);
  1241.     WRITE(UsersFile,OtherUsersRec);
  1242.     XLn('Now at Level '+IntToStr(OtherUsersRec.Level)+'.');
  1243.     IF RANDOM(100) < 5 THEN XLn(LF+'TSOTL is intrigued.');
  1244.     SysLog('I',UserName+' promoted '+PoorGuy);
  1245.   END
  1246.   ELSE
  1247.   BEGIN
  1248.     XLF;
  1249.     XLn('No promotion done.');
  1250.     MannaPoints := MannaPoints + (SpellCost * SpellRepeat);
  1251.   END;
  1252. END;
  1253.  
  1254. OVERLAY PROCEDURE Demote;  { DEMOTE spell }
  1255. VAR
  1256.   BelowNum : INTEGER;
  1257.   PoorGuy  : UNameType;
  1258. BEGIN
  1259.   Tactical := TRUE;
  1260.   IF NOT WizOp THEN
  1261.   BEGIN
  1262.     BelowNum := Level - 2;
  1263.     XLn('You can demote any wizard who has a');
  1264.     XLn('Sorcery Level below '+IntToStr(BelowNum)+'.');
  1265.     XLF;
  1266.   END;
  1267.   X('Demote WHO?  ');
  1268.   PoorGuy := Upper(GetInputLn); XLF;
  1269.   IF NOT FindUserRecPtr(PoorGuy)
  1270.   THEN XLn('Can''t find that name.')
  1271.   ELSE
  1272.   BEGIN
  1273.     SEEK(UsersFile,UserRecPtr);
  1274.     READ(UsersFile,OtherUsersRec);
  1275.     IF (OtherUsersRec.UserName <> PoorGuy) OR (PoorGuy = UserName)
  1276.     THEN XLn('Strangely immune!')
  1277.     ELSE
  1278.     BEGIN
  1279.       IF (OtherUsersRec.Level >= BelowNum) AND (NOT WizOp)
  1280.       THEN XLn('Too powerful for you to do that!')
  1281.       ELSE
  1282.       BEGIN
  1283.         IF WizOp
  1284.         THEN
  1285.         BEGIN
  1286.           XLn(PoorGuy+' is at level '+IntToStr(OtherUsersRec.Level+1)+'.');
  1287.           OtherUsersRec.Level := GetInt('Specify new level:  ');
  1288.           SpellRepeat := 1;
  1289.         END
  1290.         ELSE
  1291.         BEGIN
  1292.           GetSpellRepeat;
  1293.           OtherUsersRec.Level := OtherUsersRec.Level - SpellRepeat; { ouch }
  1294.         END;
  1295.         IF SpellRepeat = 0
  1296.         THEN XLn('Level unchanged.')
  1297.         ELSE
  1298.         BEGIN
  1299.           IF OtherUsersRec.Level > 500 THEN OtherUsersRec.Level := 500;
  1300.           IF OtherUsersRec.Level <  0  THEN OtherUsersRec.Level := 0;
  1301.           SEEK(UsersFile,UserRecPtr);
  1302.           WRITE(UsersFile,OtherUsersRec);
  1303.           XLn('Now at Level '+IntToStr(OtherUsersRec.Level)+'.');
  1304.           IF RANDOM(100) < 5 THEN XLn(LF+'TSOTL is intrigued.');
  1305.           SysLog('I',UserName+' demoted '+PoorGuy);
  1306.         END;  { Repeat > 0 }
  1307.       END;  { Demoteable }
  1308.     END;  { File checks out, not himself }
  1309.   END;  { Valid name }
  1310. END;
  1311.  
  1312. OVERLAY PROCEDURE Suggest;  { SUGGEST spell }
  1313. VAR
  1314.   PQuest : STRING[40];
  1315.   PAns   : STRING[30];
  1316.   QPosn  : INTEGER;
  1317. BEGIN
  1318.   Tactical := TRUE;
  1319.   XLn('You may add a question to the list that');
  1320.   XLn('the Guardians  use to  test  a wizard''s');
  1321.   XLn('qualifications to progress higher.');
  1322.   XLF;
  1323.   XLn('NOTE:  Answers are uppercased automatically.');
  1324.   XLF;
  1325.   XLn('Enter your question (max 39 chars).');
  1326.   XLn('----+----+----+----+----+----+----+----');
  1327.   PQuest := GetInputLn; XLF;
  1328.   IF LENGTH(PQuest) > 2 THEN
  1329.   BEGIN
  1330.     XLn('And the answer is?  (max 30 chars).');
  1331.     XLn('----+----+----+----+----+----+');
  1332.     PAns := Upper(GetInputLn);
  1333.     XLF; XLn('Ready to add the question.');
  1334.     IF Yes THEN
  1335.     BEGIN
  1336.       XLF;
  1337.       IF NOT OpenQuestFile THEN XLn('Sorry -- The Guardians are out.')
  1338.       ELSE
  1339.       BEGIN
  1340.         WITH QuestRec DO BEGIN Question := PQuest;  Answer := PAns; END;
  1341.         QPosn := FILESIZE(QuestFile);
  1342.         WRITELN(#17#16,' ',QPosn,' questions.'); WRITELN;
  1343.         IF QPosn > 1000 THEN QPosn := RANDOM(1000) + 1;   { 70,000 bytes max }
  1344.         SEEK(QuestFile,QPosn);
  1345.         WRITE(QuestFile,QuestRec);
  1346.         CLOSE(QuestFile);
  1347.         XLn('The Guardians thank you.');
  1348.         AscCnt := AscCnt - 2;
  1349.         SysLog('I',UserName+' suggested a new question');
  1350.         IF RANDOM(100) < 15 THEN XLn(LF+'TSOTL likes that question.');
  1351.       END;
  1352.     END;
  1353.   END
  1354.   ELSE XLn('Hardly a question!');
  1355. END;
  1356.  
  1357. OVERLAY PROCEDURE Correct;  { CORRECT spell }
  1358. VAR
  1359.   CCntr   : INTEGER;
  1360.   CFind   : STRING[40];
  1361.   Corring : BOOLEAN;
  1362.   GotQ    : BOOLEAN;
  1363.   PQuest  : STRING[40];
  1364.   PAns    : STRING[30];
  1365.   QSize   : INTEGER;
  1366. BEGIN
  1367.   Tactical := TRUE;
  1368.   IF NOT WizOp THEN
  1369.   BEGIN
  1370.     XLn('NOTE:   You  can  only  change  the');
  1371.     XLn('QUESTION, not the answer!   If this');
  1372.     XLn('isn''t what you''d hoped,  just press');
  1373.     XLn('RETURN in answer to this:'); XLF;
  1374.   END;
  1375.   XLn('Enter a recognizable portion of the');
  1376.   XLn('question you wish to rephrase.');
  1377.   X('> ');
  1378.   CFind := GetInputLn; XLF;
  1379.   IF LENGTH(CFind) > 0 THEN
  1380.   BEGIN
  1381.     IF NOT OpenQuestFile THEN XLn('The Guardians ignore you.')
  1382.     ELSE
  1383.     BEGIN
  1384.       CCntr := 0;
  1385.       GotQ := FALSE;
  1386.       QSize := FileSize(QuestFile);
  1387.     REPEAT
  1388.         READ(QuestFile,QuestRec);
  1389.         IF POS(CFind,QuestRec.Question) > 0
  1390.         THEN GotQ := TRUE
  1391.         ELSE CCntr := CCntr + 1;
  1392.       UNTIL GotQ OR (CCntr = QSize);
  1393.       IF NOT GotQ THEN XLn('Can''t find that question.')
  1394.       ELSE
  1395.       BEGIN
  1396.         Corring := FALSE;
  1397.         XLn('----+----+----+----+----+----+----+----');
  1398.         XLn(QuestRec.Question);
  1399.         PQuest := GetInputLn; XLF;
  1400.         IF LENGTH(PQuest) < 3
  1401.         THEN XLn('Question unchanged.')
  1402.         ELSE
  1403.         BEGIN
  1404.           QuestRec.Question := PQuest;
  1405.           Corring := TRUE;
  1406.         END;
  1407.         IF WizOp THEN
  1408.         BEGIN
  1409.           XLn('You may change the answer.');
  1410.           IF Yes THEN
  1411.           BEGIN
  1412.             XLF;
  1413.             XLn('----+----+----+----+----+----+');
  1414.             XLn(QuestRec.Answer);
  1415.             PAns := Upper(GetInputLn); XLF;
  1416.             IF LENGTH(PAns) = 0
  1417.             THEN XLn('Answer unchanged.')
  1418.             ELSE
  1419.             BEGIN
  1420.               QuestRec.Answer := PAns;
  1421.               Corring := TRUE;
  1422.             END;
  1423.           END;
  1424.           IF Corring THEN
  1425.           BEGIN
  1426.             SEEK(QuestFile,CCntr);
  1427.             WRITE(QuestFile,QuestRec);
  1428.             XLn('The Guardians thank you.');
  1429.             AscCnt := AscCnt - 2;
  1430.             SysLog('I',UserName+' corrected a question');
  1431.           END;
  1432.         END;
  1433.       END;
  1434.       CLOSE(QuestFile);
  1435.     END;
  1436.   END
  1437.   ELSE XLn('No harm done.');
  1438. END;
  1439.  
  1440. OVERLAY PROCEDURE Focus;  { FOCUS spell }
  1441. BEGIN
  1442.   XLn('This will affect the display spells:');
  1443.   XLn('What name or phrase are you seeking?');
  1444.   X('> ');
  1445.   UpCaseInput := TRUE;
  1446.   FocusString := Upper(GetInputLn);
  1447.   UpCaseInput := FALSE;
  1448.   IF FocusString = '' THEN XLn('Defocussed.');
  1449. END;
  1450.  
  1451. OVERLAY PROCEDURE Tune;  { TUNE spell }
  1452. BEGIN
  1453.   XLn('This will affect the reading spells:');
  1454.   XLn('What name or phrase are you seeking?');
  1455.   X('> ');
  1456.   UpCaseInput := TRUE;
  1457.   TuneString := Upper(GetInputLn);
  1458.   UpCaseInput := FALSE;
  1459.   IF TuneString = '' THEN XLn('Detuned.');
  1460. END;                  
  1461.  
  1462. OVERLAY PROCEDURE Hurl;  { HURL spell }
  1463. VAR
  1464.   HCntr   : INTEGER;
  1465.   HDate   : INTEGER;
  1466.   HMint   : INTEGER;
  1467.   NewDate : INTEGER;
  1468.   NewMint : INTEGER;
  1469. BEGIN
  1470.   Tactical := TRUE;
  1471.   HCntr := AskMsgTimesPtr;
  1472.   IF HCntr = MaxMsgs
  1473.   THEN XLn('Can''t find that message -- sorry!')
  1474.   ELSE
  1475.   BEGIN
  1476.     NewDate := 1; NewMint := 0;
  1477.     IF Level > 149 THEN
  1478.     BEGIN
  1479.       XLn('You may specify the actual new time.');
  1480.       IF Yes THEN
  1481.       BEGIN
  1482.         XLF;
  1483.         NewDate := GetInt('New date?    ');
  1484.         IF NewDate = 0 THEN NewDate := 1;
  1485.         NewMint := GetInt('New minute?  ');
  1486.       END;
  1487.     END;
  1488.     XLF;
  1489.     X('D'); SEEK(MsgTimesFile,HCntr);
  1490.     X('O'); READ(MsgTimesFile,MsgTimesRec);
  1491.     MsgDates[HCntr + 1] := NewDate;  MsgTimesRec.Date_Added := NewDate;
  1492.     MsgMints[HCntr + 1] := NewMint;  MsgTimesRec.Mint_Added := NewMint;
  1493.     X('N'); SEEK(MsgTimesFile,HCntr);
  1494.     X('E'); WRITE(MsgTimesFile,MsgTimesRec); XLn('.');
  1495.     SysLog('I',UserName+' hurled message by '+MsgPosters[HCntr + 1]);
  1496.     IF RANDOM(100) < 25 THEN XLn(LF+'TSOTL is amused.');
  1497.   END;
  1498. END;
  1499.  
  1500. OVERLAY PROCEDURE OmniView;  { OMNIVIEW spell }
  1501. VAR
  1502.   OVChar  : CHAR;
  1503.   OVCntr  : INTEGER;
  1504.   OVLevel : INTEGER;
  1505.   MsgTotC : INTEGER;
  1506.   MsgTot  : INTEGER;
  1507.   WizTot  : INTEGER;
  1508.   Wiz03   : INTEGER;
  1509.   Wiz07   : INTEGER;
  1510.   Wiz14   : INTEGER;
  1511. BEGIN
  1512.   NonReadInfo := TRUE;
  1513.   XLn('What is the lowest Sorcery Level');
  1514.   OVLevel := GetInt('that you wish to display?  ');
  1515.   IF WizOp THEN XLn(LF+'For WizOp:  Includes Esteem, MaxLevel, Phone.');
  1516.   XLF; XLn('Display may pause for up to a minute.');
  1517.   XLn('This is a normal cogitation delay.');
  1518.   XLF; XLn('    WIZARD  NAME     LEV MANNA LAST CALL');
  1519.   XLn('-------------------- --- ----- ---------');
  1520.   OVCntr := 1;
  1521.   WizTot := 0;
  1522.   Wiz03  := 0;
  1523.   Wiz07  := 0;
  1524.   Wiz14  := 0;
  1525.   RESET(UsersFile);
  1526.   REPEAT
  1527.     READ(UsersFile,OtherUsersRec);
  1528.     WITH OtherUsersRec DO
  1529.     BEGIN
  1530.       IF (Date_Last > 0) AND (Level >= OVLevel)
  1531.       AND (LENGTH(UserName) > 0)
  1532.       AND (InFocus(UserName))
  1533.       THEN
  1534.       BEGIN
  1535.         WizTot := WizTot + 1;
  1536.         IF (Date - 2)  <= Date_Last THEN Wiz03 := Wiz03 + 1;
  1537.         IF (Date - 6)  <= Date_Last THEN Wiz07 := Wiz07 + 1;
  1538.         IF (Date - 13) <= Date_Last THEN Wiz14 := Wiz14 + 1;
  1539.         X( Fmt(UserName, Left, 20) );
  1540.         X( Fmt(IntToStr(Level), Right, 4) );
  1541.         X( Fmt(IntToStr(Points), Right, 6) );
  1542.         X( Fmt(IntToStr(Date_Last), Right, 5) + ':' );
  1543.         X( Fmt(IntToStr(Mint_Last), Left, 4));
  1544.         IF WizOp THEN
  1545.         BEGIN
  1546.           X( Fmt(IntToStr(MsgsSent * 10 DIV (Level + 1) * 10), Right, 6));
  1547.           X( Fmt(IntToStr(MaxLevel), Right, 4)+' ');
  1548.           X( Phone );
  1549.         END;
  1550.         XLF;
  1551.       END;
  1552.     END;
  1553.     OVCntr := OVCntr + 1;
  1554.   UNTIL CharDuringO OR (OVCntr = MaxUsers);
  1555.   IF Level > 300 THEN
  1556.   BEGIN
  1557.     XLF;
  1558.     IF NOT CharDuringO THEN
  1559.     XLn('Number of wizards shown ..... '+Fmt(IntToStr(WizTot),Right, 3));
  1560.     IF NOT CharDuringO THEN
  1561.     XLn('Visited within  3 days ...... '+Fmt(IntToStr(Wiz03), Right, 3));
  1562.     IF NOT CharDuringO THEN
  1563.     XLn('Visited within  7 days ...... '+Fmt(IntToStr(Wiz07), Right, 3));
  1564.     IF NOT CharDuringO THEN
  1565.     XLn('Visited within 14 days ...... '+Fmt(IntToStr(Wiz14), Right, 3));
  1566.     IF NOT CharDuringO THEN
  1567.     BEGIN
  1568.       MsgTot  := 0;
  1569.       MsgTotC := NextMsg;
  1570.       REPEAT
  1571.         IF ElapsedTime(MsgDates[MsgTotC],MsgMints[MsgTotC],Date,Mint)
  1572.         <= 1440.0 THEN MsgTot := MsgTot + 1;
  1573.         MsgTotC := MsgNumBefore(MsgTotC);
  1574.       UNTIL (MsgTotC = NextMsg);
  1575.       XLF;
  1576.       XLn('Messages sent in 24 hours ... '+Fmt(IntToStr(MsgTot), Right, 3));
  1577.     END;
  1578.   END;
  1579. END;
  1580.  
  1581. OVERLAY PROCEDURE Manna;
  1582. VAR
  1583.   TempInt  : INTEGER;
  1584. BEGIN
  1585.   IF MannaRecharge AND (NOT WizOp)
  1586.   THEN XLn('TSOTL thinks you''re greedy.')
  1587.   ELSE
  1588.   BEGIN
  1589.     IF Altitude < 100
  1590.     THEN XLn('No Manna-Springs in sight.')
  1591.     ELSE
  1592.     BEGIN
  1593.       TempInt := RANDOM(Altitude * 2) + 50;
  1594.       IF WizOp THEN TempInt := TempInt * 2;
  1595.       XLn('TSOTL grants you '+IntToStr(TempInt)+ ' Manna-Points.');
  1596.       SetManna(MannaPoints + TempInt);
  1597.       MannaRecharge := TRUE;
  1598.     END;
  1599.   END;
  1600. END;
  1601.  
  1602. OVERLAY PROCEDURE Banish(AttType : CHAR);  { BANISH spell }
  1603. VAR
  1604.   BelowNum : INTEGER;
  1605.   PoorGuy  : UNameType;
  1606. BEGIN
  1607.   BelowNum := Level - 30;
  1608.   IF AttType = 'R' THEN BelowNum := Level - 50;
  1609.   Tactical := TRUE;
  1610.   IF NOT WizOp THEN
  1611.   BEGIN
  1612.     XLn('You can attack any wizard who has a');
  1613.     XLn('Sorcery Level below '+IntToStr(BelowNum)+'.');
  1614.     XLF;
  1615.   END;
  1616.   X('WHO are you attacking?  ');
  1617.   PoorGuy := Upper(GetInputLn); XLF;
  1618.   IF LENGTH(PoorGuy) = 0 THEN XLn('The spell discharges harmlessly.');
  1619.   IF NOT FindUserRecPtr(PoorGuy) THEN
  1620.   BEGIN
  1621.     XLn('No such person!');
  1622.     PoorGuy := '';
  1623.   END;
  1624.   IF LENGTH(PoorGuy) > 0 THEN
  1625.   BEGIN
  1626.     SEEK(UsersFile,UserRecPtr);
  1627.     READ(UsersFile,OtherUsersRec);
  1628.     IF OtherUsersRec.UserName <> PoorGuy
  1629.     THEN XLn('Hmm, he''s strangely immune!')
  1630.     ELSE
  1631.     BEGIN
  1632.       IF (OtherUsersRec.Level >= BelowNum) AND (NOT WizOp)
  1633.       THEN XLn('Too powerful for that!')
  1634.       ELSE
  1635.       BEGIN
  1636.         IF AttType = 'B'
  1637.         THEN OtherUsersRec.Date_Last := 0
  1638.         ELSE OtherUsersRec.Level := 0;
  1639.         OtherUsersRec.Points := 50;
  1640.         IF AttType = 'B'
  1641.         THEN OtherUsersRec.MsgsSent := 1
  1642.         ELSE
  1643.         BEGIN
  1644.           IF OtherUsersRec.MsgsSent > 15 THEN OtherUsersRec.MsgsSent := 15;
  1645.         END;
  1646.         SEEK(UsersFile,UserRecPtr);
  1647.         WRITE(UsersFile,OtherUsersRec);
  1648.         X('The deed is ... '); SlowX('DONE!'); XLF;
  1649.         IF AttType = 'B'
  1650.         THEN SysLog('I',UserName+' banished '+PoorGuy)
  1651.         ELSE SysLog('I',UserName+' reduced '+PoorGuy);
  1652.       END;
  1653.     END;
  1654.   END;
  1655. END;
  1656.  
  1657. OVERLAY PROCEDURE Sanctify;  { SANCTIFY spell -- WizOp only }
  1658. VAR
  1659.   FudjLoop : INTEGER;
  1660.   PoorGuy  : UNameType;
  1661.   TempEst  : INTEGER;
  1662.   TempInfo : ComLine;
  1663. BEGIN
  1664.   X('Sanctify who?  ');
  1665.   PoorGuy := Upper(GetInputLn); XLF;
  1666.   IF NOT FindUserRecPtr(PoorGuy)
  1667.   THEN XLn('No such person!')
  1668.   ELSE
  1669.   BEGIN
  1670.     SEEK(UsersFile,UserRecPtr);
  1671.     READ(UsersFile,OtherUsersRec);
  1672.     IF OtherUsersRec.UserName <> PoorGuy
  1673.     THEN XLn('Hmm, he''s strangely immune!')
  1674.     ELSE
  1675.     WITH OtherUsersRec DO
  1676.     BEGIN
  1677.       {----- Rise-Control -----}
  1678.       XLn('You may respecify rise-control values.');
  1679.       IF Yes THEN
  1680.       BEGIN
  1681.         XLF;
  1682.         XLn('Maximum Level:  '+IntToStr(MaxLevel));
  1683.         XLn('TSOTL''s Esteem: '+IntToStr(MsgsSent * 10 DIV (Level + 1) * 10));
  1684.         MaxLevel := GetInt('Maximum Level?  (0 = No limit)    ');
  1685.         TempEst  := GetInt('New Esteem?  (Rounding may occur) ');
  1686.         MsgsSent := TRUNC(TempEst / 10 * (Level + 1) / 10);
  1687.         IF (TempEst / 10 * (Level + 1) / 10) > 3000.0
  1688.         THEN
  1689.         BEGIN
  1690.           XLn('Esteem can''t be that high at level '+IntToStr(Level)+'.');
  1691.           MsgsSent := 3000;
  1692.         END
  1693.         ELSE
  1694.         BEGIN
  1695.           {----- Loop to contend with round-off of DIV -----}
  1696.           FudjLoop := 1;
  1697.           WHILE (MsgsSent * 10 DIV (Level + 1) * 10 < TempEst)
  1698.           AND   (FudjLoop < 50)
  1699.           DO
  1700.           BEGIN
  1701.             MsgsSent := MsgsSent + 1;
  1702.             FudjLoop := FudjLoop + 1;
  1703.           END;
  1704.         END;
  1705.         IF (MsgsSent * 10 DIV (Level + 1) * 10) <> TempEst
  1706.         THEN
  1707.         XLn('Rounded Esteem has been set to:   '+
  1708.         IntToStr(MsgsSent * 10 DIV (Level + 1) * 10));
  1709.       END;
  1710.       {----- Profile -----}
  1711.       XLF;
  1712.       XLn('You may change profile info.');
  1713.       IF Yes THEN
  1714.       BEGIN
  1715.         XLF;
  1716.         XLn('Respecify  profile info  or');
  1717.         XLn('press RETURN for No Change.');
  1718.         XLF;
  1719.         XLn('User Name:  '+PoorGuy);
  1720.         XLn('(Type DELETE to remove)');
  1721.         X('> ');
  1722.         TempInfo := Upper(GetInputLn);
  1723.         XLF;
  1724.         IF LENGTH(TempInfo) > 0 THEN
  1725.         BEGIN
  1726.           IF TempInfo = 'DELETE' THEN TempInfo := '';
  1727.           UserName                  := TempInfo;
  1728.           UserNames[UserRecPtr + 1] := TempInfo;
  1729.         END;
  1730.         XLn('Name:  '+RealName);
  1731.         X('> ');
  1732.         TempInfo := GetInputLn;
  1733.         XLF;
  1734.         IF LENGTH(TempInfo) > 0 THEN RealName := TempInfo;
  1735.         XLn('Phone:  '+Phone);
  1736.         X('> ');
  1737.         TempInfo := GetInputLn;
  1738.         XLF;
  1739.         IF LENGTH(TempInfo) > 0 THEN Phone := TempInfo;
  1740.         XLn('Password:  '+Password);
  1741.         X('> ');
  1742.         TempInfo := GetInputLn;
  1743.         IF LENGTH(TempInfo) > 0 THEN Password := Upper(TempInfo);
  1744.       END;
  1745.       SEEK(UsersFile,UserRecPtr);
  1746.       WRITE(UsersFile,OtherUsersRec);
  1747.       XLF;
  1748.       XLn('Done.');
  1749.     END;
  1750.   END;
  1751. END;