home *** CD-ROM | disk | FTP | other *** search
/ Between Heaven & Hell 2 / BetweenHeavenHell.cdr / 500 / 433 / pybaseut.inc < prev    next >
Text File  |  1986-10-25  |  7KB  |  249 lines
  1. PROCEDURE GetSpellRepeat;
  2. VAR
  3.   GSRMax : INTEGER;
  4. BEGIN
  5.   MannaPoints := MannaPoints + SpellCost;   { Assume '0' repetitions for now }
  6.   IF SpellCost = 0
  7.   THEN GSRMax := 500
  8.   ELSE GSRMax := MannaPoints DIV SpellCost;
  9.   REPEAT
  10.     X('You can afford to do this '+IntToStr(GSRMax)+' time');
  11.     IF GSRMax <> 1 THEN X('s');
  12.     XLn('.');
  13.     XLF;
  14.     SpellRepeat := GetInt('How many times?  ');
  15.     XLF;
  16.   UNTIL (SpellRepeat <= GSRMax);
  17.   MannaPoints := MannaPoints - SpellCost * SpellRepeat;
  18. END;
  19.  
  20. FUNCTION Yes : BOOLEAN;
  21. VAR
  22.   YChar : CHAR;
  23. BEGIN
  24.   XLF;  X('Do you wish to do so? (Y/N)  '+^Q);
  25.   REPEAT YChar := UPCASE(SerialIn);  UNTIL (YChar IN ['Y','N', ^M]);
  26.   IF YChar = ^M THEN YChar := 'N';
  27.   SerialOut(YChar);  XLF;
  28.   IF YChar = 'Y'  THEN Yes := TRUE  ELSE Yes := FALSE;
  29. END;
  30.  
  31. PROCEDURE ExplainKeys;
  32. BEGIN
  33.   IF (Level < 5) AND (NOT Explained) THEN
  34.   BEGIN
  35.     XLn('Press SPACEBAR to skip print.');
  36.     XLn('Press P to pause and restart.');
  37.     IF Multiple THEN
  38.     XLn('Any other key  displays menu.');
  39.     XLF;
  40.     DELAY(1000 - (Level * 150));
  41.     Explained := TRUE;
  42.   END;
  43. END;
  44.  
  45. PROCEDURE ShowSysLog(ShowWhat : TenType);
  46. VAR
  47.   SSCntr : INTEGER;
  48.   SSDate : INTEGER;
  49.   SSDone : BOOLEAN;
  50.   SSLoop : INTEGER;
  51.   SSMint : INTEGER;
  52.   SSSave : INTEGER;
  53.   SSStep : INTEGER;
  54.   SSTry  : INTEGER;
  55. BEGIN
  56.   X('Meditate on the past....');
  57.   IF Level > 250 THEN ShowWhat := ShowWhat + 'W';
  58.   SSDate := Date_Last;
  59.   SSMint := Mint_Last;
  60.   IF Date_Warp <> -1 THEN
  61.   BEGIN
  62.     SSDate := Date_Warp;
  63.     SSMint := Mint_Warp;
  64.   END;
  65.   {----- Roughly find the spot from which to read -----}
  66.   SSCntr := NextLog;
  67.   SSSave := -1;
  68.   SSStep := MaxSysLog DIV 10;
  69.   SSTry  := 8;
  70.   SSDone := FALSE;
  71.   REPEAT
  72.     FOR SSLoop := 1 TO SSStep DO SSCntr := SysLogBefore(SSCntr);
  73.     SEEK(SysLogFile,SSCntr);
  74.     READ(SysLogFile,SysLogItem);
  75.     IF Before(SSDate,SSMint,SysLogItem.SLDate,SysLogItem.SLMint)
  76.     THEN SSSave := SSCntr
  77.     ELSE SSDone := TRUE;
  78.     SSTry := SSTry - 1;
  79.   UNTIL SSDone OR (SSTry = 0);
  80.   X('.');
  81.   {----- Zero in on spot from which to read -----}
  82.   IF SSSave = -1
  83.   THEN SSCntr := NextLog
  84.   ELSE SSCntr := SSSave;
  85.   SSDone := FALSE;
  86.   REPEAT
  87.     SSCntr := SysLogBefore(SSCntr);
  88.     SEEK(SysLogFile,SSCntr);
  89.     READ(SysLogFile,SysLogItem);
  90.     IF Before(SSDate,SSMint,SysLogItem.SLDate,SysLogItem.SLMint)
  91.     THEN SSSave := SSCntr
  92.     ELSE SSDone := TRUE;
  93.   UNTIL SSDone OR (SSCntr = NextLog);
  94.   {----- Display -----}
  95.   XLF; XLF;
  96.   IF SSSave = -1
  97.   THEN XLn('Nothing to display.')
  98.   ELSE
  99.   BEGIN
  100.     {----- Print the display -----}
  101.     SSCntr := SSSave;
  102.     REPEAT
  103.       SEEK(SysLogFile,SSCntr);
  104.       READ(SysLogFile,SysLogItem);
  105.       IF  (POS(SysLogItem.SLType,ShowWhat) > 0)
  106.       AND (SysLogItem.SLText <> '')
  107.       AND ((POS('ssword',SysLogItem.SLText) = 0) OR WizOp)
  108.       AND (InFocus(SysLogItem.SLText))
  109.       THEN
  110.       BEGIN
  111.         X(Fmt(IntToStr(SysLogItem.SLDate), Right, 4));
  112.         X(':');
  113.         X(Fmt(IntToStr(SysLogItem.SLMint), Left,  4));
  114.         X(' ');
  115.         X(SysLogItem.SLText);
  116.         IF SysLogItem.SLRept > 1
  117.         THEN XLn(' '+ IntToStr(SysLogItem.SLRept) + ' times')
  118.         ELSE XLF;
  119.       END;  { He is permitted to see this }
  120.       SSCntr := SysLogAfter(SSCntr);
  121.     UNTIL CharDuringO OR (SSCntr = NextLog);
  122.   END;  { Had something to show }
  123. END;
  124.  
  125. PROCEDURE CleanUp;
  126. VAR
  127.   CUChar : CHAR;
  128. BEGIN
  129.   CLOSE(UsersFile);
  130.   CLOSE(NextMsgFile);
  131.   CLOSE(MsgTimesFile);
  132.   CLOSE(SysLogFile);
  133.   CLOSE(SeismoFile);
  134.   IF SysFail THEN
  135.   BEGIN
  136.     WRITE('SYSTEM FAILURE!  ');
  137.     SOUND(1000); DELAY(1000); NOSOUND;
  138.   END;
  139.   WINDOW(1,1,80,25);
  140. END;
  141.  
  142. FUNCTION EsteemCalc : INTEGER;
  143. VAR
  144.   TempEst : REAL;
  145.   TempP   : REAL;
  146. BEGIN
  147.   {----- Esteem 1 to 10, otherwise by 10's -----}
  148.   TempP   := Postings;
  149.   TempEst := TempP * 100.0 / (Level + 1);
  150.   IF TempEst > 10 THEN
  151.   TempEst := Postings * 10 DIV (Level + 1) * 10;
  152.   EsteemCalc := TRUNC(TempEst);
  153. END;
  154.  
  155. FUNCTION PatienceCalc : INTEGER;
  156. BEGIN
  157.   PatienceCalc := 15 + RANDOM(10) + (Level DIV 5);
  158. END;
  159.  
  160. FUNCTION XlateBand(XLNum : INTEGER) : CHAR;
  161. BEGIN
  162.   IF XLNum  =   0 THEN XlateBand := '0';
  163.   IF XLNum >=   1 THEN XlateBand := 'A';
  164.   IF XLNum >=  30 THEN XlateBand := 'B';
  165.   IF XLNum >= 100 THEN XlateBand := 'C';
  166.   IF XLNum >= 300 THEN XlateBand := 'D';
  167. END;
  168.  
  169. FUNCTION XlateBoard(XBChar : CHAR) : ComLine;
  170. BEGIN
  171.   CASE XBChar OF
  172.     '0' : XlateBoard := 'Crowds at the Base Portal';
  173.     'A' : XlateBoard := 'Disciples of the Arduous Task';
  174.     'B' : XlateBoard := 'Brothers of Apprentice Sorcery';
  175.     'C' : XlateBoard := 'Craftsmen of Operative Magic';
  176.     'D' : XlateBoard := 'Pilgrims of the Final Ascent';
  177.     'G' : XlateBoard := 'Guardian of the Base Portal';
  178.     'P' : XlateBoard := 'Beseechers of TSOTL';
  179.     'S' : XlateBoard := 'Scribe of the Tidings Scrolls';
  180.     ELSE
  181.       XlateBoard := 'Void';
  182.   END;
  183. END;
  184.  
  185. FUNCTION PresentBoard : ComLine;
  186. BEGIN PresentBoard := XlateBoard(XlateBand(Altitude)); END;
  187.  
  188. PROCEDURE SetAltitude(NewAlt : INTEGER);
  189. VAR
  190.   OldBoard : ComLine;
  191.   NewBoard : ComLine;
  192. BEGIN
  193.   OldBoard := PresentBoard;
  194.   IF NewAlt > Level THEN NewAlt := Level;
  195.   IF NewAlt <   0 THEN NewAlt := 0;
  196.   IF NewAlt > 500 THEN NewAlt := 500;
  197.   Altitude := NewAlt;
  198.   If AscCnt > 5 THEN AscCnt := AscCnt - 5;
  199.   NewBoard := PresentBoard;
  200.   SaveDescTexture := DescTexture[RANDOM(MaxDescTexture)+1];
  201.   SaveDescType    := DescType[RANDOM(MaxDescType)+1];
  202.   SaveDescCharac  := DescCharac[RANDOM(MaxDescCharac)+1];
  203.   IF OldBoard <> NewBoard THEN
  204.   BEGIN
  205.     XLn(LF+'This level of the Mountain is used by');
  206.     XLn('the '+NewBoard+'.');
  207.     Promo := TRUE;
  208.   END;
  209. END;
  210.  
  211. PROCEDURE SetManna(SMAmnt : INTEGER);
  212. BEGIN
  213.   MannaPoints := SMAmnt;
  214.   IF MannaPoints < -20000 THEN MannaPoints := -20000;
  215.   IF MannaPoints > ((Level + 1) * 50) THEN MannaPoints := ((Level + 1) * 50);
  216. END;
  217.  
  218. FUNCTION ParmFrom(PFLine : Line) : ComLine;  { Get parm from PYCONFIG line }
  219. VAR
  220.   PFCntr : INTEGER;
  221. BEGIN
  222.   IF LENGTH(PFLine) > 39 THEN PFLine := COPY(PFLine,1,39);
  223.   PFCntr := LENGTH(PFLine);
  224.   IF PFLine[PFCntr] = ' ' THEN
  225.   REPEAT
  226.     PFCntr := PFCntr - 1;
  227.   UNTIL (PFLine[PFCntr] <> ' ') OR (PFCntr = 1);
  228.   PFLine := COPY(PFLine,1,PFCntr);
  229.   ParmFrom := PFLine;
  230. END;
  231.  
  232. FUNCTION DeBlank(DBString : Line) : Line;
  233. VAR
  234.   DBCntr : INTEGER;
  235. BEGIN
  236.   DeBlank := '';
  237.   DBCntr := 0;
  238.   REPEAT DBCntr := DBCntr + 1;
  239.   UNTIL (DBCntr > LENGTH(DBString)) OR (DBString[DBCntr] <> ' ');
  240.   IF DBCntr <= LENGTH(DBString) THEN
  241.   BEGIN
  242.     DELETE(DBString,1,DBCntr - 1);
  243.     DBCntr := LENGTH(DBString) + 1;
  244.     REPEAT DBCntr := DBCntr - 1;
  245.     UNTIL (DBCntr < 1) OR (DBString[DBCntr] <> ' ');
  246.     DeBlank := COPY(DBString,1,DBCntr);
  247.   END;
  248. END; { Function DeBlank }
  249.