home *** CD-ROM | disk | FTP | other *** search
/ Between Heaven & Hell 2 / BetweenHeavenHell.cdr / 500 / 433 / pyutilit.inc < prev    next >
Text File  |  1986-09-17  |  10KB  |  338 lines
  1. {======= UTILITIES =======}
  2.  
  3. FUNCTION BigAdd(BANum1, BANum2 : INTEGER) : INTEGER;
  4. VAR
  5.   BATemp : REAL;
  6. BEGIN
  7.   BATemp := BANum1 + BANum2;
  8.   IF BATemp > 30000 THEN BATemp := 30000;
  9.   BigAdd := TRUNC(BATemp);
  10. END;
  11.  
  12. FUNCTION BigSub(BSNum1, BSNum2 : INTEGER) : INTEGER;
  13. VAR
  14.   BSTemp : REAL;
  15. BEGIN
  16.   BSTemp := BSNum1 - BSNum2;
  17.   IF BSTemp < -30000 THEN BSTemp := -30000;
  18.   BigSub := TRUNC(BSTemp);
  19. END;                       
  20.  
  21. PROCEDURE TextInverseOn;
  22.   BEGIN TextColor(0); TextBackGround(7); END;
  23. PROCEDURE TextInverseOff;
  24.   BEGIN TextColor(3); TextBackGround(0); END;
  25.  
  26. FUNCTION Upper(InStr : Line) : Line;
  27. VAR
  28.   UCnt : INTEGER;
  29. BEGIN
  30.   FOR UCnt := 1 TO LENGTH(InStr) DO InStr[UCnt] := UPCASE(InStr[UCnt]);
  31.   Upper := InStr;
  32. END;
  33.  
  34. FUNCTION IntToStr(ITSInt : INTEGER) : TenType;
  35. VAR
  36.   ITSStr  : TenType;
  37. BEGIN
  38.   STR(ITSInt,ITSStr);
  39.   IntToStr := ITSStr;
  40. END;
  41.  
  42. FUNCTION Fmt(FLine : Line; FSide : LeftRight; FLen : INTEGER) : Line;
  43. VAR
  44.   FPad : Line;
  45. BEGIN
  46.   IF LENGTH(FLine) > FLen THEN FLine := COPY(FLine,1,FLen);
  47.   FPad := COPY(Blanks, 1, FLen - LENGTH(FLine));
  48.   IF FSide = Left
  49.   THEN Fmt := FLine + FPad
  50.   ELSE Fmt := FPad + FLine;
  51. END;
  52.  
  53. FUNCTION LastPos(LPFind : Line; LPIn : Line) : INTEGER;
  54. { High-speed location of last occurance of a string in another string }
  55. VAR
  56.   LPCntr     : INTEGER;
  57.   RevFind    : Line;
  58.   RevFindLen : BYTE ABSOLUTE RevFind;
  59.   RevIn      : Line;
  60.   RevInLen   : BYTE ABSOLUTE RevIn;
  61. BEGIN
  62.   RevFindLen := LENGTH(LPFind);
  63.   FOR LPCntr := 0 TO LENGTH(LPFind) - 1
  64.   DO RevFind[RevFindLen - LPCntr] := LPFind[LPCntr + 1];
  65.   RevInLen := LENGTH(LPIn);
  66.   FOR LPCntr := 0 TO LENGTH(LPIn) - 1
  67.   DO RevIn[RevInLen - LPCntr] := LPIn[LPCntr + 1];
  68.   LPCntr := POS(RevFind,RevIn);
  69.   IF LPCntr = 0
  70.   THEN LastPos := 0
  71.   ELSE LastPos := 2 + RevInLen - LPCntr - RevFindLen;
  72. END;
  73.  
  74. FUNCTION InFocus(IFString : Line) : BOOLEAN;
  75. BEGIN
  76.   IF FocusString = ''
  77.   THEN InFocus := TRUE
  78.   ELSE
  79.   BEGIN
  80.     IF POS(FocusString,Upper(IFString)) > 0
  81.     THEN InFocus := TRUE
  82.     ELSE InFocus := FALSE;
  83.   END;
  84. END;
  85.  
  86. FUNCTION SysLogAfter(SLNum : INTEGER) : INTEGER;
  87. BEGIN
  88.   IF SLNum = MaxSysLog
  89.   THEN SysLogAfter := 1
  90.   ELSE SysLogAfter := SLNum + 1;
  91. END;
  92.  
  93. FUNCTION SysLogBefore(SLNum : INTEGER) : INTEGER;
  94. BEGIN
  95.   IF SLNum = 1
  96.   THEN SysLogBefore := MaxSysLog
  97.   ELSE SysLogBefore := SLNum - 1;
  98. END;
  99.  
  100. {======= Date-Oriented Functions =======}
  101.  
  102. FUNCTION ShowDate(SDDate,SDMint : INTEGER) : TenType;
  103. BEGIN ShowDate := IntToStr(SDDate) + ':' + IntToStr(SDMint); END;
  104.  
  105. PROCEDURE GetDate;
  106. VAR
  107.   Day            : INTEGER;
  108.   GDCntr         : INTEGER;
  109.   Month          : INTEGER;
  110.   RecPack        : RegPack;
  111.   SaveDate       : INTEGER;
  112.   SaveMint       : INTEGER;
  113.   Year           : INTEGER;
  114.   ah,al,ch,cl,dh : BYTE;
  115. BEGIN
  116.   SaveDate := Date;
  117.   SaveMint := Mint;
  118.   {--- Get Day ---}
  119.   WITH RecPack DO ax := $2A SHL 8;
  120.   MSDOS(RecPack);
  121.   WITH RecPack DO
  122.   BEGIN
  123.     Day := dx MOD 256;
  124.     Month := dx SHR 8;
  125.     Year := cx;
  126.   END;
  127.   Date := ((Year - 1985) * 365) + Day;
  128.   IF Month > 1 THEN
  129.   FOR GDCntr := 1 TO Month - 1 DO Date := Date + DaysInMonth[GDCntr];
  130.   {--- Get Mint ---}
  131.   ah := $2C;
  132.   WITH RecPack DO ax := ah SHL 8 + al;
  133.   INTR($21,RecPack);
  134.   WITH RecPack DO
  135.   BEGIN
  136.     Mint := (cx SHR 8 * 60) + (cx MOD 256);
  137.     Secs := dx SHR 8;
  138.   END;
  139. END;
  140.  
  141. FUNCTION GetHSecs : INTEGER;
  142. VAR
  143.   RecPack        : RegPack;
  144. BEGIN
  145.   WITH RecPack DO ax := $2C SHL 8;
  146.   MSDOS(RecPack);
  147.   WITH RecPack DO GetHSecs := dx MOD 256;
  148. END;
  149.  
  150. FUNCTION ElapsedTime(FromDate, FromMint, ToDate, ToMint : INTEGER) : REAL;
  151. BEGIN
  152.   ElapsedTime := ((ToDate - FromDate) * 1440.0) + (ToMint - FromMint);
  153. END;
  154.  
  155. FUNCTION Before(FromDate, FromMint, ToDate, ToMint : INTEGER) : BOOLEAN;
  156. BEGIN
  157.   IF ElapsedTime(FromDate, FromMint, ToDate, ToMint) > 0.0
  158.   THEN Before := TRUE
  159.   ELSE Before := FALSE;
  160.   IF FromDate = 0 THEN Before := FALSE;
  161. END;
  162.  
  163. PROCEDURE IncrementLog;
  164. BEGIN
  165.   NextLog := SysLogAfter(NextLog);
  166.   WITH SysLogItem DO
  167.   BEGIN
  168.     SLDate := 0;
  169.     SLMint := 0;
  170.     SLType := '?';
  171.     SLText := '-- Pointer to Next Log Item --';
  172.     SLRept := NextLog;
  173.   END;
  174.   SEEK(SysLogFile,0);
  175.   WRITE(SysLogFile,SysLogItem);
  176. END;
  177.  
  178. PROCEDURE SysLog(MsgType : CHAR; SLLine : Line);
  179. VAR
  180.   SLFind   : INTEGER;
  181.   SLX, SLY : INTEGER;
  182. BEGIN
  183.   WITH SysLogItem DO
  184.   BEGIN
  185.     SLDate := Date;
  186.     SLMint := Mint;
  187.     SLType := MsgType;
  188.     SLText := SLLine;
  189.     SLRept := SpellRepeat;
  190.   END;
  191.   SEEK(SysLogFile,NextLog);
  192.   WRITE(SysLogFile,SysLogItem);
  193.   IncrementLog;
  194.   SLX := WHEREX; SLY := WHEREY;
  195.   WINDOW(1,1,80,25); GOTOXY(26,1);
  196.   TextInverseOn; CLREOL; WRITE(SLLine); TextInverseOff;
  197.   WINDOW(1,3,80,25); GOTOXY(SLX,SLY);
  198. END;
  199.  
  200. PROCEDURE StatusLine;  { Top-line status-line for WizOp's information }
  201. VAR
  202.   SOX, SOY : INTEGER;
  203. BEGIN
  204.   SaveTime := Mint;
  205.   SOX := WHEREX; SOY := WHEREY;
  206.   WINDOW(1,1,25,25);
  207.   TextInverseOn;
  208.   GOTOXY(1,1); CLREOL;
  209.   WRITE('Lev '+IntToStr(Level)+' Time ');
  210.   WRITE(IntToStr(Patience - TRUNC(ElapsedTime(StartDate,StartMint,Date,Mint)))+' ');
  211.   IF WizOp      THEN WRITE(#236) ELSE WRITE(' ');
  212.   IF ShutDown   THEN WRITE(#031) ELSE WRITE(' ');
  213.   IF Chattable  THEN WRITE(#001) ELSE WRITE(' ');
  214.   IF Alert      THEN WRITE(#004) ELSE WRITE(' ');
  215.   IF ChatAsk    THEN WRITE( '?') ELSE WRITE(' ');
  216.   IF Ascendable THEN WRITE(#127) ELSE WRITE(' ');
  217.   TextInverseOff;
  218.   WINDOW(1,3,80,25);
  219.   GOTOXY(SOX,SOY);
  220. END;
  221.  
  222. PROCEDURE Contact(CType : CHAR); FORWARD;  { Chat-with-WizOp }
  223.  
  224. PROCEDURE DoFnKeys;  { Process Function keys from console }
  225. VAR
  226.   FnKey   : CHAR;
  227.   DFKNum  : INTEGER;
  228. BEGIN
  229.   ExFnKey := TRUE;
  230.   DELAY(100);
  231.   IF KEYPRESSED THEN
  232.   BEGIN
  233.     READ(KBD,FnKey);
  234.     CASE FnKey OF
  235.       {------- Regular Function Keys -------}
  236.       ';' : BEGIN { F1 }
  237.               WRITELN; WRITELN;
  238.               WRITELN('   Regular Function Keys                ALT Function Keys');
  239.               WRITELN('  ╔══════════╦══════════╗            ╔══════════╦══════════╗');
  240.               WRITELN('1 ║   HELP   ║ YOO-HOO! ║  2       1 ║    --    ║    --    ║  2');
  241.               WRITELN('  ╠══════════╬══════════╣            ╠══════════╬══════════╣');
  242.               WRITELN('3 ║ TIME -10 ║ TIME +10 ║  4       3 ║    --    ║    --    ║  4');
  243.               WRITELN('  ╠══════════╬══════════╣            ╠══════════╬══════════╣');
  244.               WRITELN('5 ║ OK  CHAT ║   CHAT   ║  6       5 ║    --    ║    --    ║  6');
  245.               WRITELN('  ╠══════════╬══════════╣            ╠══════════╬══════════╣');
  246.               WRITELN('7 ║    --    ║    --    ║  8       7 ║ SANCTIFY ║  BANISH  ║  8');
  247.               WRITELN('  ╠══════════╬══════════╣            ╠══════════╬══════════╣');
  248.               WRITELN('9 ║ SHUTDOWN ║    --    ║ 10       9 ║  ASCENT  ║   WIZOP  ║ 10');
  249.               WRITELN('  ╚══════════╩══════════╝            ╚══════════╩══════════╝');
  250.               WRITELN;
  251.             END;
  252.       '<' : BEGIN { F2 }
  253.               Alert := NOT Alert;
  254.               IF Alert THEN
  255.               BEGIN
  256.                 WRITELN; WRITELN;
  257.                 WRITELN(#17#16+' Enter a list of names to wait for, like this: Fred/Mary/John');
  258.                 WRITE('> ');
  259.                 READLN(AlertName);
  260.                 AlertName := '/'+Upper(AlertName);
  261.                 WRITELN;
  262.                 WRITELN(#17#16+' Press the Yoo-Hoo key again when you wish to disable monitoring.');
  263.                 WRITELN;
  264.               END;
  265.             END;
  266.       '=' : Patience := Patience - 10;  { F3 }
  267.       '>' : Patience := Patience + 10;  { F4 }
  268.       '?' : Chattable := NOT Chattable;  { F5 }
  269.       '@' : IF CONTACTING THEN WRITE(#17#16+' ??? '+#17#16) ELSE Contact('I');  { F6 }
  270.       'C' : BEGIN
  271.               ShutDown := NOT ShutDown;  { F9 }
  272.               IF ShutDown
  273.               THEN SysLog('L','"No Visitors" sign put up')
  274.               ELSE SysLog('L','"No Visitors" sign taken down');
  275.             END;
  276.       {------- ALT Function Keys -------}
  277.       'n' : BEGIN  { ALT-F7 }
  278.               WRITELN; WRITELN;
  279.               WRITE(#17#16+' Sanctify this wizard upon disconnection?  (Y/N)  ');
  280.               READ(KBD,FnKey);
  281.               WRITELN; WRITELN;
  282.               IF UPCASE(FnKey) = 'Y'
  283.               THEN
  284.               BEGIN
  285.                 WRITELN(#17#16+' This wizard will be sanctified!');
  286.                 MaxLev := 0;
  287.               END
  288.               ELSE WRITELN(#17#16+' No action taken.');
  289.               WRITELN;
  290.             END;
  291.       'o' : BEGIN  { ALT-F8 }
  292.               WRITELN; WRITELN;
  293.               WRITE(#17#16+' Banish this wizard upon disconnection?  (Y/N)  ');
  294.               READ(KBD,FnKey);
  295.               WRITELN; WRITELN;
  296.               IF UPCASE(FnKey) = 'Y'
  297.               THEN
  298.               BEGIN
  299.                 WRITELN(#17#16+' This wizard will be banished upon disconnection!');
  300.                 Patience := 1;
  301.                 Postings := -100;
  302.               END
  303.               ELSE WRITELN(#17#16+' Nothing done.');
  304.               WRITELN;
  305.             END;
  306.       'p' : BEGIN  { ALT-F9 }
  307.               IF Ascendable = FALSE
  308.               THEN Ascendable := TRUE
  309.               ELSE
  310.               BEGIN
  311.                 Ascendable := FALSE;
  312.                 WRITELN(#17#16+' No ascending; the Guardian explains why:');
  313.                 WRITELN('----+----1----+----2----+----3----+----');
  314.                 READLN(NoAscendMsg);
  315.                 IF LENGTH(NoAscendMsg) = 0
  316.                 THEN NoAscendMsg := 'TSOTL has his reasons!';
  317.               END;
  318.             END;
  319.       'q' : BEGIN
  320.               WizOp := NOT WizOp;
  321.               IF WizOp THEN
  322.               BEGIN
  323.                 FOR DFKNum := 200 TO 800 DO
  324.                 BEGIN
  325.                   SOUND(RANDOM(DFKNum)+1200);
  326.                   DELAY(RANDOM(5));
  327.                   NOSOUND;
  328.                   DELAY(RANDOM(2));
  329.                 END;
  330.               END;  { WizOp On }
  331.             END;  { WizOp key }
  332.       ELSE
  333.       WRITELN; WRITELN; WRITELN(#17#16+' Undefined Function Key'); WRITELN;
  334.     END;
  335.     StatusLine;
  336.   END;
  337. END;
  338.