home *** CD-ROM | disk | FTP | other *** search
/ Between Heaven & Hell 2 / BetweenHeavenHell.cdr / 500 / 433 / pysign.inc < prev    next >
Text File  |  1986-11-30  |  18KB  |  518 lines
  1. OVERLAY PROCEDURE SignOn;
  2. VAR
  3.   FoundSpace : BOOLEAN;
  4.   HadNews    : BOOLEAN;
  5.   EReal      : REAL;
  6.   ETime      : INTEGER;
  7.   PassOkay   : BOOLEAN;
  8.   SONum      : INTEGER;
  9.   SOChar     : CHAR;
  10.   SOCntr     : INTEGER;
  11.   SpCntr     : INTEGER;
  12.   TestName   : UNameType;
  13.   XPass      : STRING[10];
  14.   XPhone     : STRING[25];
  15.   XRealName  : UNameType;
  16.   XWidth     : INTEGER;
  17. BEGIN
  18.   GetDate;
  19.   StartDate  := Date;
  20.   StartMint  := Mint;
  21.   BreakPoint := 20;
  22.   Logoff     := TRUE;
  23.   NewUser    := TRUE;
  24.   Postings   := 0;
  25.   Width      := 80;
  26.   WizOp      := FALSE;
  27.   YesNo      := 'X';
  28.   FOR SOCntr := 1 TO 15 DO
  29.   BEGIN
  30.     SOUND(500+SOCntr*50);
  31.     DELAY(3);
  32.     SOUND(1000-SOCntr*50);
  33.     DELAY(3);
  34.   END;
  35.   NOSOUND;
  36.   XLF;
  37.   IF GotCarrier THEN DELAY(1000);
  38.   XLF;
  39.   IF AnyKeyPressed THEN SOChar := SerialIn;
  40.   CharDuringO := FALSE;
  41.   SOCntr := 0;
  42.   REPEAT
  43.     SOCntr := SOCntr + 1;
  44.     IF Banner[SOCntr] <> '?' THEN XLnI(Banner[SOCntr]);
  45.   UNTIL CharDuringO OR (SOCntr = 8);
  46.   IF CharDuringO
  47.   THEN
  48.   BEGIN
  49.     CharDuringO := FALSE;
  50.     XLn(LF+'State your name.'+LF)
  51.   END
  52.   ELSE
  53.   BEGIN
  54.     XLF;
  55.     XLnI('CURRENT TIME:  '+ShowDate(Date,Mint));
  56.     XLF;
  57.     XLnI('Advance, mortal.   State your name or');
  58.     XLnI('nickname -- the name you  like  to be');
  59.     XLnI('to be known by.');
  60.     XLF;
  61.     XLn('      ....................');
  62.   END;
  63.   CharDuringO := FALSE;
  64.   X('<(*)> ');
  65.   UserName := Upper(GetInputLn);
  66.   TestName := '';
  67.   FOR SOCntr := 1 TO LENGTH(UserName) DO
  68.   IF UserName[SOCntr] IN ['A'..'Z','0']
  69.   THEN TestName := TestName + UserName[SOCntr];
  70.   {--- Note how I make life hard for the debugger/besmirchers of Pyroto ---}
  71.   IF POS('CK',TestName) - 2 = POS('FU',TestName) THEN UserName := 'TSOTL';
  72.   IF POS('TSOTL',TestName) > 0 THEN UserName := 'TSOTL';
  73.   IF POS('TS0TL',TestName) > 0 THEN UserName := 'TSOTL';
  74.   { Test for S.O.T. attempt (should be <space>, not full name }
  75.   IF UserName = 'SERVANT OF TSOTL' THEN UserName := 'TSOTL';{ i.e. No-go }
  76.   IF LENGTH(UserName) > 0
  77.   THEN
  78.   BEGIN
  79.     SOCntr := LENGTH(UserName);
  80.     REPEAT
  81.       IF UserName[SOCntr] = ' ' THEN DELETE(UserName,SOCntr,1);
  82.       IF UserName[SOCntr] = '.' THEN DELETE(UserName,SOCntr,1);
  83.       SOCntr := SOCntr - 1;
  84.     UNTIL (SOCntr = 0) OR (NOT(UserName[SOCntr] IN [' ','.']));
  85.     IF LENGTH(UserName) = 0 THEN UserName := 'SERVANT OF TSOTL';
  86.     XLF;
  87.     IF (UserName = 'SERVANT OF TSOTL') THEN
  88.     BEGIN
  89.       XLn('State the Servant''s Word.');
  90.       GetTestPass;
  91.       IF TestPass = ServantWord
  92.       THEN WizOp := TRUE
  93.       ELSE
  94.       BEGIN
  95.         WizOp := FALSE;
  96.         UserName := 'TSOTL';
  97.       END;
  98.       XLn(LF);
  99.     END;
  100.     IF POS('/'+UserName,AlertName) > 0 THEN
  101.     BEGIN
  102.       FOR SOCntr := 1000 TO 2000 DO
  103.       BEGIN
  104.         SOUND(SOCntr);
  105.         DELAY(2);
  106.         NOSOUND;
  107.         DELAY(1);
  108.       END;
  109.     END;
  110.     IF ((POS('TSOTL',UserName) > 0) AND (UserName <> 'SERVANT OF TSOTL'))
  111.     THEN XLn(LF+'TSOTL is amused.')
  112.     ELSE
  113.     BEGIN
  114.       IF NOT FindUserRecPtr(UserName) THEN
  115.       BEGIN
  116.         XLF;
  117.         X('One moment please...');
  118.         {--- Any room in the file? ---}
  119.         SpCntr := 1;  { 0 is always SERVANT OF TSOTL }
  120.         FoundSpace := FALSE;
  121.         RESET(UsersFile);
  122.         REPEAT
  123.           SEEK(UsersFile,SpCntr);
  124.           READ(UsersFile,UsersRec);
  125.           { Level 21 has 30 days, Level 100 has 30 days, Level 500 has 70 }
  126.           IF ( UsersRec.Date_Last < ( Date - 20 - (UsersRec.Level DIV 10) ) )
  127.           THEN FoundSpace := TRUE
  128.           ELSE SpCntr := SpCntr + 1;
  129.         UNTIL FoundSpace OR (SpCntr = MaxUsers);
  130.         XLF; XLF;
  131.         IF NOT FoundSpace THEN
  132.         BEGIN
  133.           XLn('The Users File is FULL.  Please try on');
  134.           XLn('another occasion.');
  135.         END
  136.         ELSE
  137.         BEGIN
  138.           XLF;
  139.           XLn('-------- PLEASE READ CAREFULLY --------');
  140.           SlowX('Your name is not known to The Spirit Of'); XLF;
  141.           SlowX('The Land.   Please provide the staff of'); XLF;
  142.           SlowX('the  Base Portal  with some information'); XLF;
  143.           SlowX('so you can be recognized...');             XLF; XLF;
  144.           SlowX('********* VERY IMPORTANT NOTE *********'); XLF;
  145.           SlowX('You  MUST enter  a valid name and tele-'); XLF;
  146.           SlowX('phone  number.   If you  do  not,  your'); XLF;
  147.           SlowX('access will be  terminated.   This data'); XLF;
  148.           SlowX('will be  known  ONLY  to  the  staff of'); XLF;
  149.           SlowX('the  company  running  this service.');    XLF; XLF;
  150.           XLn('If you  mis-spoke your name,  or do not');
  151.           XLn('wish to be recognized, press RETURN for');
  152.           XLn('the next question...');
  153.           REPEAT
  154.             REPEAT
  155.               XLF;
  156.               XLn('What is your True Name?'); XLF;
  157.               XLn('      .................... Max 20 Chars');
  158.               X  ('<(*)> ');
  159.               XRealName := Upper(GetInputLn);
  160.               IF (LENGTH(XRealName) <> 0) AND (POS(' ',XRealName) = 0)
  161.               THEN XLn(LF+'Your FULL name, please.');
  162.             UNTIL (LENGTH(XRealName) = 0) OR (POS(' ',XRealName) > 1) OR LostCarrier;
  163.             IF LENGTH(XRealName) > 0 THEN
  164.             BEGIN
  165.               REPEAT
  166.                 XLF;
  167.                 XLn('What is your phone number?'); XLF;
  168.                 XLn('      XXX-XXX-XXXX  <- Use this format');
  169.                 X  ('<(*)> ');
  170.                 XPhone := GetInputLn;  XLF;
  171.               UNTIL (LENGTH(XPhone) >= 12) OR LostCarrier;
  172.               PassOkay := FALSE;
  173.               REPEAT
  174.                 XLn('By what secret word will we know you?'); XLF;
  175.                 XLn('      ..........  Max 10');
  176.                 X  ('<(*)> ');
  177.                 XPass := Upper(GetInputLn);  XLF;
  178.                 IF (POS(XPass,XRealName) > 0) OR (XPass = 'TEST')
  179.                 OR (POS(XPass,UserName) > 0)
  180.                 THEN XLn('That password is too easy to guess.'+LF)
  181.                 ELSE PassOkay := TRUE;
  182.               UNTIL PassOkay OR LostCarrier;
  183.               XLn('How many characters across can your');
  184.               XLn('terminal or computer display?'); XLF;
  185.               Logoff := FALSE;  { Disable drop-checking }
  186.               XWidth := GetInt('<(*)> ');
  187.               Logoff := TRUE;
  188.               IF XWidth = 0 THEN XWidth := 80;
  189.               XLF; XLF;
  190.               XLn('Reviewing what you entered...'); XLF;
  191.               XLn('True Name ...... '+XRealName);
  192.               XLn('Phone Number ... '+XPhone);
  193.               XLn('Password ....... '+XPass);
  194.               XLn('Screen Width ... '+IntToStr(XWidth));
  195.               XLF;
  196.               X('Is that right? (Y/N)  '+XON);
  197.               Inputting := TRUE;
  198.               YesNo := SerialIn;
  199.               SerialOut(YesNo);
  200.               Inputting := FALSE;
  201.               XLF;
  202.             END;
  203.           UNTIL ((UPCASE(YesNo) = 'Y') OR (LENGTH(XRealName) = 0));
  204.           IF LENGTH(XRealName) = 0 THEN XLn(LF+'Bye for now...');
  205.           IF UPCASE(YesNo) = 'Y' THEN
  206.           BEGIN
  207.             UsersRec.UserName := UserName;
  208.             UserNames[SpCntr+1] := UserName;
  209.             Postings := 0;
  210.             UsersRec.Level := 0;
  211.             WITH UsersRec DO
  212.             BEGIN
  213.               RealName  := XRealName; Phone    := XPhone;
  214.               Password  := XPass;     Points   := 50;
  215.               Date_Last := Date;      Mint_Last := Mint;  Width := XWidth;
  216.               MsgsSent  := 0;         MaxLevel  := 15;
  217.               Date_A    := Date - 7;  Mint_A    := 1;
  218.               Date_B    := Date - 7;  Mint_B    := 1;
  219.               Date_C    := Date - 7;  Mint_C    := 1;
  220.               Date_D    := Date - 7;  Mint_D    := 1;
  221.               Date_P    := Date - 7;  Mint_P    := 1;
  222.               Date_S    := Date - 7;  Mint_S    := 1;
  223.               Date_X    := Date - 7;  Mint_X    := 1;
  224.             END;
  225.             RESET(UsersFile);
  226.             SEEK(UsersFile,SpCntr);
  227.             WRITE(UsersFile,UsersRec);
  228.             FLUSH(UsersFile);
  229.             XLF;
  230.             XLn('You are now known to the  Base  Portal');
  231.             XLn('staff.  Please call back in  12 hours.');
  232.             XLn('If  TSOTL  approves,  you will be able');
  233.             XLn('to start your quest...'); XLF;
  234.             XLn('Remember to  sign on  with your chosen');
  235.             XLn('name: '+UserName+'.');
  236.             SysLog('L',UserName+' signed up');
  237.           END; { User info was good }
  238.         END; { Had space in the file }
  239.       END { New user }
  240.       ELSE
  241.       BEGIN
  242.         SEEK(UsersFile,UserRecPtr);
  243.         READ(UsersFile,UsersRec);
  244.         EReal := ElapsedTime(UsersRec.Date_Last,UsersRec.Mint_Last,Date,Mint);
  245.         IF EReal > 32000.0 THEN EReal := 32000.0;
  246.         IF EReal < 0.0     THEN EReal := 0.0;
  247.         ETime := TRUNC(EReal);
  248.         IF (NOT WizOp) AND (ETime < 660)
  249.         THEN
  250.         BEGIN  { < 11 hours since he logged off }
  251.           XLn('You visited less than 12 hours ago.');
  252.           XLn('Please give somebody else a chance.');
  253.           ETime := 660 - ETime;
  254.           IF ETime <= 90 THEN
  255.           BEGIN
  256.             X(LF+'Try again in '+IntToStr(ETime)+' minute');
  257.             IF ETime = 1
  258.             THEN XLn('.')
  259.             ELSE XLn('s.');
  260.           END;
  261.         END
  262.         ELSE
  263.         BEGIN
  264.           XLn('What is your private magic word?');
  265.           GetTestPass;
  266.           XLF;
  267.           IF TestPass = UsersRec.Password
  268.           THEN
  269.           BEGIN
  270.             SysLog('L','On:  '+UserName);
  271.             XLF;
  272.             XLn('"ADVANCE TO THE MOUNTAIN, MORTAL..."'); XLF;
  273.             IF (UsersRec.MsgsSent > -6)
  274.             THEN XLn('TSOTL will tolerate your presence.')
  275.             ELSE XLn('TSOTL wants one LAST look at you.');
  276.             IF (UsersRec.Date_Last = 0) AND (NOT WizOp) THEN
  277.             BEGIN
  278.               XLF;
  279.               IF UsersRec.MsgsSent > -6 THEN
  280.               XLn('Unfortunately,  somebody  else  WON''T!');
  281.               XLn('You''ve been BANISHED!  You''ll have to');
  282.               XLn('change your  name,  because you are not');
  283.               XLn('appreciated, here!'); XLF;
  284.               XLn('Soon, even TSOTL will forget you exist.');
  285.               SysLog('I',UserName+' informed of "banished" status');
  286.             END
  287.             ELSE
  288.             BEGIN
  289.               Altitude      := 0;
  290.               AscCnt        := 0;
  291.               AscLast       := -1;
  292.               ChatAsk       := FALSE;
  293.               Communicative := FALSE;
  294.               Date_Last     := UsersRec.Date_Last;
  295.               Date_Warp     := -1;  { i.e. Inactive }
  296.               Explained     := FALSE;
  297.               FocusString   := '';
  298.               Level         := UsersRec.Level;
  299.               IF Level > 500 THEN Level := 500;
  300.               Logoff        := FALSE;
  301.               MaxLev        := UsersRec.MaxLevel;
  302.               MannaRecharge := FALSE;
  303.               Mint_Last     := UsersRec.Mint_Last;
  304.               Multiple      := FALSE;
  305.               MyPassword    := UsersRec.Password;
  306.               NewUser       := FALSE;
  307.               NonReadInfo   := FALSE;
  308.               NumSends      := 0;
  309.               SetManna(UsersRec.Points + ((Date - Date_Last) * (25 + Level)) );
  310.               IF (MannaPoints < 0) AND (Level > 0)
  311.               THEN Level := Level + (MannaPoints DIV 500) - 1;
  312.               Patience      := PatienceCalc;
  313.               Pleaseable    := TRUE;
  314.               Postings      := UsersRec.MsgsSent - ((Date - Date_Last) DIV 7);
  315.               IF Postings > 3050 THEN Postings := 3050;
  316.               SlowedTime    := FALSE;
  317.               StoppedTime   := FALSE;
  318.               Tactical      := FALSE;
  319.               TimeOutCntr   := 0;
  320.               IF Level > 299
  321.               THEN TimeOutSecs := 300
  322.               ELSE TimeOutSecs := 30;
  323.               TuneString    := '';
  324.               Width         := UsersRec.Width;
  325.               BreakPoint    := Width DIV 2;
  326.               Wrapping      := FALSE;
  327.               {--- WizOp Saver ---}
  328.               IF UserName = 'SERVANT OF TSOTL' THEN
  329.               BEGIN
  330.                 IF Postings     <   0   THEN Postings    := 10;
  331.                 IF MannaPoints  <   0   THEN MannaPoints := 100;
  332.                 IF Level        <> 500  THEN Level       := 500;
  333.                 IF MaxLev       <>  0   THEN MaxLev      := 0;
  334.               END;
  335.               Read_A := FALSE; Read_B := FALSE;
  336.               Read_C := FALSE; Read_D := FALSE;
  337.               Read_P := FALSE; Read_S := FALSE;
  338.               Read_X := FALSE;
  339.               StatusLine;
  340.               WINDOW(1,1,80,25);
  341.               TextInverseOn;
  342.               GOTOXY(1,2); CLREOL;
  343.               WRITE(UserName+'   '+UsersRec.RealName+'   '+UsersRec.Phone+'   MaxLev '+IntToStr(MaxLev));
  344.               TextInverseOff;
  345.               WINDOW(1,3,80,25);
  346.               CLRSCR;
  347.               XLF;
  348.               HadNews := ReadBoard('G');
  349.               IF Level < 4 THEN
  350.               BEGIN
  351.                 XLF;
  352.                 XLn('Awaiting  your  commands.');
  353.                 X('Type'); SlowX(' HELP '); XLn('if you need it.');
  354.               END;
  355.             END;  { Not banished }
  356.           END { Password okay }
  357.           ELSE
  358.           BEGIN
  359.             SysLog('I','Imposter gave wrong password for '+UserName);
  360.             SysLog('W','Attempted password: '+TestPass);
  361.             XLF;
  362.             XLn('That is not the correct word.'+LF);
  363.             XLn('A bolt of lightning strikes down...');
  364.           END; { Password not okay }
  365.         END; { Not successive call }
  366.       END; { Found UserRecPtr }
  367.     END; { Not a TSOTL name }
  368.   END; { UserName was not null }
  369. END;
  370.  
  371. {======= Disconnection =======}
  372.  
  373. OVERLAY PROCEDURE ShakeMount;
  374. VAR
  375.   SMCnt  : INTEGER;
  376. BEGIN
  377.   WRITELN(#17#16+' Performing Seismoros scrub -- this takes a while');
  378.   SOUND(512);  DELAY(1000);
  379.   SOUND(1024); DELAY(1000);
  380.   SOUND(2048); DELAY(1500);
  381.   NOSOUND;
  382.   FOR SMCnt := 1 TO (MaxUsers - 1) DO
  383.   BEGIN
  384.     SEEK(UsersFile,SMCnt);
  385.     READ(UsersFile,UsersRec);
  386.     IF (LENGTH(UsersRec.UserName) > 0) AND (UsersRec.Level > 5) THEN
  387.     BEGIN
  388.       WITH UsersRec DO
  389.       BEGIN
  390.         Level := Level DIV (20 + RANDOM(20)) + 2;
  391.         IF Points >  0 THEN Points := 10 + RANDOM(50);
  392.         MsgsSent := MsgsSent DIV 50;
  393.       END;
  394.       SEEK(UsersFile,SMCnt);
  395.       WRITE(UsersFile,UsersRec);
  396.     END;  { Valid User }
  397.   END;  { Scrub Loop }
  398.   SeismoActive := FALSE;
  399. END;  { SeismoActive }
  400.  
  401. OVERLAY PROCEDURE Disconnect;  { After-visit processing }
  402. VAR
  403.   UUCnt      : INTEGER;
  404. BEGIN
  405.   IF SysFail THEN
  406.   BEGIN
  407.     XLn('System failure.  Shutting down.');
  408.     XLn('Our apologies.');
  409.     DropCarrier;
  410.     ModemCtrl(ModemReset);
  411.   END
  412.   ELSE
  413.   BEGIN
  414.     IF NewUser THEN
  415.     BEGIN
  416.       XLn(LF+'Thanks for stopping by!');
  417.       DropCarrier;
  418.     END
  419.     ELSE
  420.     BEGIN
  421.       IF POS('PASSWORD',CmdParm) > 0 THEN
  422.       BEGIN
  423.         XLF;
  424.         XLn('Changing Password.');
  425.         XLF;
  426.         XLn('What is your old password?  ');
  427.         GetTestPass;  XLF;
  428.         IF TestPass <> MyPassword
  429.         THEN XLn('This is not correct.')
  430.         ELSE
  431.         BEGIN
  432.           REPEAT
  433.             XLF;
  434.             XLn('What is your new password?');
  435.             GetTestPass;  XLF;
  436.             MyPassword := TestPass;
  437.             XLF;
  438.             XLn('Type it again, to make sure.');
  439.             GetTestPass;  XLF;
  440.             IF TestPass <> MyPassword THEN XLn(LF+'Try again.');
  441.           UNTIL (TestPass = MyPassword) OR LostCarrier;
  442.           XLF;
  443.           XLn('Password changed.');
  444.         END;  { Okay to change }
  445.       END;  { Password change }
  446.       CmdParm := '';
  447.       XLF;
  448.       {----- Check for lackadaisia -----}
  449.       IF  (NOT (Read_A OR Read_B OR Read_C OR Read_D OR Read_S OR Read_X))
  450.       AND (NOT NonReadInfo)
  451.       AND Tactical THEN Postings := Postings - 2 - RANDOM(2);
  452.       {--- 1-in-3 chance of hit against quiet types ---}
  453.       IF  (Level > 15)
  454.       AND (NOT Communicative) THEN Postings := Postings - (RANDOM(3) DIV 2);
  455.       IF Postings > -3
  456.       THEN
  457.       BEGIN
  458.         IF SeismoActive
  459.         THEN XLn('Good-bye.')
  460.         ELSE XLn('Thank-you for visiting...')
  461.       END
  462.       ELSE
  463.       BEGIN
  464.         XLn('TSOTL angrily hurls you'+CR+LF+'from the Mountain.');
  465.         SysLog('I',UserName+' thrown off by TSOTL');
  466.       END;
  467.       DropCarrier;
  468.       ModemCtrl(ModemNoAnswer);  { Don't answer while updating files }
  469.       WRITELN(#17#16+' Updating User Info');
  470.       {--- Update User Info ---}
  471.       IF FindUserRecPtr(UserName) THEN
  472.       BEGIN
  473.         UsersRec.Level := Level;
  474.         UsersRec.Width := Width;
  475.         WITH UsersRec DO
  476.         BEGIN
  477.           MaxLevel  := MaxLev;
  478.           MsgsSent  := Postings;
  479.           Points    := MannaPoints;
  480.           Date_Last := Date;  Mint_Last := Mint;
  481.           Password  := MyPassword;
  482.           IF Postings <= -3
  483.           THEN Date_Last := 0
  484.           ELSE
  485.           BEGIN
  486.             IF Read_A THEN BEGIN Date_A := Date; Mint_A := Mint; END;
  487.             IF Read_B THEN BEGIN Date_B := Date; Mint_B := Mint; END;
  488.             IF Read_C THEN BEGIN Date_C := Date; Mint_C := Mint; END;
  489.             IF Read_D THEN BEGIN Date_D := Date; Mint_D := Mint; END;
  490.             IF Read_P THEN BEGIN Date_P := Date; Mint_P := Mint; END;
  491.             IF Read_S THEN BEGIN Date_S := Date; Mint_S := Mint; END;
  492.             IF Read_X THEN BEGIN Date_X := Date; Mint_X := Mint; END;
  493.           END;
  494.         END;
  495.         SEEK(UsersFile, UserRecPtr);
  496.         WRITE(UsersFile, UsersRec);
  497.       END;
  498.       IF SeismoActive THEN ShakeMount;
  499.       CLOSE(UsersFile);
  500.       CLOSE(MsgTimesFile);
  501.       CLOSE(SeismoFile);
  502.       {--- Get ready again ---}
  503.       {$I-}
  504.       ASSIGN(UsersFile,DFLocation + File_Users);
  505.       RESET(UsersFile);
  506.       IF IORESULT > 0 THEN OpenFail(File_Users);
  507.       ASSIGN(MsgTimesFile,DFLocation + File_Times);
  508.       RESET(MsgTimesFile);
  509.       IF IORESULT > 0 THEN OpenFail(File_Times);
  510.       ASSIGN(SeismoFile,DFLocation + File_Seismo);
  511.       RESET(SeismoFile);
  512.       IF IORESULT > 0 THEN OpenFail(File_Seismo);
  513.       {$I+}
  514.     END;  { Not NewUser }
  515.     ResetAnswer;
  516.   END; { Not SysFail }
  517. END;
  518.