home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_PAS / UTIL178.ZIP / UTILITY.PAS < prev   
Pascal/Delphi Source File  |  1994-02-09  |  126KB  |  4,463 lines
  1. {$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S-,T-,V-,X-,Y+}
  2. {
  3. Utility 17.8  (c) Copyright 1990, 1994 by Gemini Systems. ALL RIGHTS RESERVED
  4. ╒════════════════════════════════════════════════════════════════════════╕
  5. │                                                                        │
  6. │          This UNIT was written for TURBO PASCAL by:                    │
  7. │                                                                        │
  8. │                      Gemini Systems                                    │
  9. │                      7748 Lake Ridge Drive                             │
  10. │                      Waterford, MI 48327                               │
  11. │                                                                        │
  12. │                  BBS Support (810) 360-6407                            │
  13. │                  Fax support (810) 360-6407                            │
  14. │                                                                        │
  15. │  This code is Shareware.  If you use any part of it for more than 10   │
  16. │  days you must register it.  To register, send $10.00 to the above     │
  17. │  address.                                                              │
  18. │                                                                        │
  19. │  See UTILITY.DOC for complete information on all features.             │
  20. │                                                                        │
  21. │                                                                        │
  22. │  To use in your programs, simply state UTILITY in your uses clause.    │
  23. │                                                                        │
  24. │  example:      PROGRAM prog_name;                                      │
  25. │                  USES utility;       (Programs must be compiled with   │
  26. │                                       the $V- Compiler Directive)      │
  27. │                                                                        │
  28. ╘════════════════════════════════════════════════════════════════════════╛
  29. }
  30.  
  31. {$I UTILITY.DOC }
  32.  
  33. IMPLEMENTATION
  34. CONST
  35.   HEXCHARS  : ARRAY [1..16] OF CHAR =
  36.               ('0','1','2','3','4','5','6','7','8','9',
  37.                'A','B','C','D','E','F');VAR
  38.   ExitSave  : pointer;
  39.   OLDVAL    : STRING;
  40.  
  41. type
  42.   EnvArray = array[0..32767] of Char;
  43.   EnvArrayPtr = ^EnvArray;
  44.   EnvRec =
  45.     record
  46.       EnvSeg : Word;              {Segment of the environment}
  47.       EnvLen : Word;              {Usable length of the environment}
  48.       EnvPtr : Pointer;           {Nil except when allocated on heap}
  49.     end;
  50.  
  51. VAR
  52.   ENV_REC        : ENVREC;
  53.   CURRENT_BORDER : INTEGER;
  54.   BLINK_IS_ON    : BOOLEAN;
  55.  
  56. PROCEDURE FILL_BUFFER;
  57. VAR
  58.   F    : TEXT;
  59.   TEMP : STRING;
  60. BEGIN
  61.   ASSIGN(F,'UTILITY.GO');
  62.   {$I-}
  63.     RESET(F);
  64.   {$I+}
  65.   IF IORESULT = 0 THEN
  66.     BEGIN
  67.       WHILE NOT EOF(F) DO
  68.         BEGIN
  69.           READ(F,TEMP[1]);
  70.           COMMAND_BUFFER := COMMAND_BUFFER + TEMP[1];
  71.         END;
  72.       CLOSE(F);
  73.       SETFATTR(F,ARCHIVE);
  74.       {$I-}
  75.         ERASE(F);
  76.       {$I+}
  77.       IF IORESULT <> 0 THEN;
  78.     END;
  79. END;
  80.  
  81. FUNCTION GETHEX(DECIMAL_VALUE : WORD) : STRING;
  82. VAR
  83.   ADDRESS_DIGIT,
  84.   COUNTER,
  85.   DIVISOR,
  86.   QUOTIENT   : INTEGER;
  87.   TEMPSTRING : STRING;
  88. BEGIN
  89.   GETHEX := '';
  90.   TEMPSTRING := '';
  91.   FOR ADDRESS_DIGIT := 1 TO 4 DO
  92.     BEGIN
  93.       DIVISOR := 1;
  94.       FOR COUNTER := ADDRESS_DIGIT TO 3 DO
  95.         DIVISOR := DIVISOR * 16;
  96.         QUOTIENT := DECIMAL_VALUE DIV DIVISOR;
  97.         DECIMAL_VALUE := DECIMAL_VALUE MOD DIVISOR;
  98.         TEMPSTRING := TEMPSTRING + HEXCHARS[QUOTIENT+1];
  99.       END;
  100.   GETHEX := TEMPSTRING;
  101. END;
  102.  
  103. PROCEDURE SET_CURSOR;
  104. VAR
  105.   TOPLINE,
  106.   BOTLINE       : BYTE;
  107.   BIOSPARAM     : REGISTERS;
  108. BEGIN
  109.   CASE CURS OF
  110.           BLOCK : BEGIN
  111.                     TOPLINE := 0;
  112.                     BOTLINE := 7;
  113.                   END;
  114.      UNDERLINE  : BEGIN
  115.                     TOPLINE := 6;
  116.                     BOTLINE := 7;
  117.                   END;
  118.           NONE  : BEGIN
  119.                     TOPLINE := 32;
  120.                     BOTLINE := 0;
  121.                   END;
  122.           HALF  : BEGIN
  123.                     TOPLINE := 4;
  124.                     BOTLINE := 7;
  125.                   END;
  126.   END;
  127.   WITH BIOSPARAM DO
  128.     BEGIN
  129.       AX := 1 SHL 8 + 0;
  130.       CX := TOPLINE SHL 8 + BOTLINE;
  131.     END;
  132.   INTR($10,BIOSPARAM);
  133.   CUR := CURS;
  134. END;
  135.  
  136. {$F+}
  137. PROCEDURE EXITHANDLER;
  138. VAR
  139.   OFFSET,
  140.   SEGMENT : STRING;
  141. BEGIN
  142.   EXITPROC := EXITSAVE;
  143.   IF RESET_CURSOR THEN
  144.     SET_CURSOR(UNDERLINE);
  145.   IF (EXITCODE <> 0) AND (SHOW_ERROR) THEN
  146.     BEGIN
  147.       OFFSET    := GETHEX(OFS(ERRORADDR^));
  148.       SEGMENT   := GETHEX(SEG(ERRORADDR^));
  149.       WINDOW(1,1,80,25);
  150.       WRITELN;
  151.       ERRORADDR := NIL;
  152.       GOTOXY(1,25);
  153.       WRITELN; WRITELN; WRITELN; WRITELN; WRITELN; WRITELN; WRITELN; WRITELN;
  154.           FW(1,18,$4E,'╔═══════════════════════════════════════════════════════════════════════════╗');
  155.       IF EXITCODE = 255 THEN
  156.         BEGIN
  157.           FW(1,19,$4E,'║    Program Terminated by Operator !                                       ║');
  158.           FW(1,20,$4E,'║      Press <any key> to Continue                                          ║');
  159.           FW(1,21,$4E,'╚═══════════════════════════════════════════════════════════════════════════╝');
  160.           GOTOXY(35,20);
  161.         END
  162.       ELSE
  163.         BEGIN
  164.           FW(1,19,$4E,'║                  Program Terminated by Run-Time Error!                    ║');
  165.           FW(1,20,$4E,'║ Program       -                                                           ║');
  166.           FW(1,21,$4E,'║ Error Code    -                                                           ║');
  167.           FW(1,22,$4E,'║ Error Address -                                                           ║');
  168.           FW(1,23,$4E,'║                       Press <any key> to Continue                         ║');
  169.           FW(1,24,$4E,'╚═══════════════════════════════════════════════════════════════════════════╝');
  170.           TEXTATTR := $4F;
  171.           GOTOXY(19,20);
  172.           WRITE(PARAMSTR(0));
  173.           GOTOXY(19,21);
  174.           WRITE(EXITCODE);
  175.           GOTOXY(19,22);
  176.           WRITE(SEGMENT,':',OFFSET);
  177.           GOTOXY(52,23);
  178.         END;
  179.       CH := READKEY;
  180.       WRITELN;
  181.     END;
  182.   TEXTATTR := TEXTATTR_AT_ENTRY;
  183. END;
  184. {$F-}
  185.  
  186. FUNCTION CGA_INSTALLED : BOOLEAN;
  187. VAR
  188.   MONITOR_INFO   : BYTE;
  189. BEGIN
  190.   MONITOR_INFO := MEM[SEG0040:$0010];
  191.   CGA_INSTALLED := TRUE;
  192.   IF MONITOR_INFO AND 48=48 THEN
  193.     BEGIN
  194.       CGA_INSTALLED := FALSE;
  195.       P := PTR(SEGB000,$0);
  196.     END
  197.   ELSE
  198.     IF MONITOR_INFO AND 32=32 THEN
  199.       BEGIN
  200.         CGA_INSTALLED := TRUE;
  201.         P := PTR(SEGB800,$0);
  202.       END;
  203. END;
  204.  
  205. PROCEDURE SAVE_SCREEN;
  206. BEGIN
  207.   MOVE(P^[1],SCREEN[1],4000);
  208. END;
  209.  
  210. PROCEDURE REBUILD_SCREEN;
  211. BEGIN
  212.   MOVE(SCREEN[1],P^[1],4000);
  213. END;
  214.  
  215. PROCEDURE UP_SOUND;
  216. VAR
  217.   I : INTEGER;
  218. BEGIN
  219.   FOR I := 2000 TO 4000 DO
  220.     SOUND(I);
  221.   NOSOUND;
  222. END;
  223.  
  224. PROCEDURE DOWN_SOUND;
  225. VAR
  226.   I : INTEGER;
  227. BEGIN
  228.   FOR I := 4000 DOWNTO 2000 DO
  229.     SOUND(I);
  230.   NOSOUND;
  231. END;
  232.  
  233. PROCEDURE CAPS_ON;
  234. VAR
  235.   KEYBOARD       : BYTE;
  236. BEGIN
  237.   KEYBOARD := MEM[SEG0040:$0017];
  238.   KEYBOARD:=KEYBOARD OR 64;
  239. END;
  240.  
  241. FUNCTION CAPS_ARE_ON : BOOLEAN;
  242. VAR
  243.   KEYBOARD       : BYTE;
  244. BEGIN
  245.   KEYBOARD := MEM[SEG0040:$0017];
  246.   CAPS_ARE_ON := KEYBOARD AND 64 = 64;
  247. END;
  248.  
  249. PROCEDURE CAPS_OFF;
  250. VAR
  251.   KEYBOARD       : BYTE;
  252. BEGIN
  253.   KEYBOARD := MEM[SEG0040:$0017];
  254.   KEYBOARD:=KEYBOARD AND 191;
  255. END;
  256.  
  257. PROCEDURE NUM_LOCK_ON;
  258. VAR
  259.   KEYBOARD       : BYTE;
  260. BEGIN
  261.   KEYBOARD := MEM[SEG0040:$0017];
  262.   KEYBOARD:=KEYBOARD OR 32;
  263. END;
  264.  
  265. FUNCTION NUM_LOCK_IS_ON : BOOLEAN;
  266. VAR
  267.   KEYBOARD       : BYTE;
  268. BEGIN
  269.   KEYBOARD := MEM[SEG0040:$0017];
  270.   NUM_LOCK_IS_ON := KEYBOARD AND 32 = 32;
  271. END;
  272.  
  273. PROCEDURE NUM_LOCK_OFF;
  274. VAR
  275.   KEYBOARD       : BYTE;
  276. BEGIN
  277.   KEYBOARD := MEM[SEG0040:$0017];
  278.   KEYBOARD:=KEYBOARD AND 223;
  279. END;
  280.  
  281. PROCEDURE SCROLL_LOCK_ON;
  282. VAR
  283.   KEYBOARD       : BYTE;
  284. BEGIN
  285.   KEYBOARD := MEM[SEG0040:$0017];
  286.   KEYBOARD:=KEYBOARD OR 16;
  287. END;
  288.  
  289. PROCEDURE SCROLL_LOCK_OFF;
  290. VAR
  291.   KEYBOARD       : BYTE;
  292. BEGIN
  293.   KEYBOARD := MEM[SEG0040:$0017];
  294.   KEYBOARD:=KEYBOARD AND 239;
  295. END;
  296.  
  297. FUNCTION SCROLL_LOCK_IS_ON : BOOLEAN;
  298. VAR
  299.   KEYBOARD       : BYTE;
  300. BEGIN
  301.   KEYBOARD := MEM[SEG0040:$0017];
  302.   SCROLL_LOCK_IS_ON := KEYBOARD AND 16 = 16;
  303. END;
  304.  
  305. PROCEDURE SHOW_VERSION;
  306. VAR
  307.   CH     : CHAR;
  308.   L      : LONGINT;
  309.   SCREEN : ARRAY [1..355] OF CHAR;
  310.   TEMP   : STRING[15];
  311.   X,Y    : INTEGER;
  312. BEGIN
  313.   X := WHEREX;
  314.   Y := WHEREY;
  315.   MOVE(P^[319],SCREEN[1],71);
  316.   MOVE(P^[479],SCREEN[72],71);
  317.   MOVE(P^[639],SCREEN[143],71);
  318.   MOVE(P^[799],SCREEN[214],71);
  319.   MOVE(P^[959],SCREEN[285],71);
  320.   FW(1,3,$4F,'╒════════════════════════════════╕');
  321.   FW(1,4,$4F,'│                                │');
  322.   IF LENGTH(PARAMSTR(0)) <= 30 THEN
  323.     FW(3,4,$4F,PARAMSTR(0))
  324.   ELSE
  325.     BEGIN
  326.       FW(3,4,$4F,CHR(27)+COPY(PARAMSTR(0),LENGTH(PARAMSTR(0))-28,29));
  327.     END;
  328.   FW(1,5,$4F,'│ U17.8 RELEASE                  │');
  329.   IF BTfiler <> '' THEN
  330.     BEGIN
  331.       FW(1,6,$4F,'│ B-Tree Filer   v               │');
  332.       FW(19,6,$4F,BTfiler);
  333.       FW(1,7,$4F,'╘════════════════════════════════╛');
  334.     END
  335.   ELSE
  336.     FW(1,6,$4F,'╘════════════════════════════════╛');
  337.   IF UT.COMPILED_DATE <> '%%-%%-%%' THEN
  338.     BEGIN
  339.       FW(18,5,$4F,UT.COMPILED_DATE+' ');
  340.       IF UT.COMPILED_TIME <> '%%:%%' THEN
  341.         FW(27,5,$4F,UT.COMPILED_TIME);
  342.     END
  343.   ELSE
  344.     FW(18,5,$4F,VERSION);
  345.   GOTOXY(16,5);
  346.   START_TIMER(L);
  347.   REPEAT
  348.   UNTIL (ELAP_TIME(L) > 15) OR KEYPRESSED OR (COMMAND_BUFFER <> '');
  349.   IF KEYPRESSED THEN
  350.     BEGIN
  351.       READCH(CH,FALSE);
  352.       IF CH = AF1 THEN
  353.         BEGIN
  354.           TEMP := 'Meulpk([éx|fp{';
  355.           UN_ENCRYPT(TEMP,15000);
  356.           FW(1,5,$4F,'│                                │');
  357.           FW(11,5,$4F,TEMP);
  358.           READCHT(CH,FALSE,30);
  359.         END;
  360.     END;
  361.   WHILE KEYPRESSED DO
  362.     CH := READKEY;
  363.   MOVE(SCREEN[1],P^[319],71);
  364.   MOVE(SCREEN[72],P^[479],71);
  365.   MOVE(SCREEN[143],P^[639],71);
  366.   MOVE(SCREEN[214],P^[799],71);
  367.   MOVE(SCREEN[285],P^[959],71);
  368.   GOTOXY(X,Y);
  369. END;
  370.  
  371. PROCEDURE SPECIAL_KEY(VAR CH : CHAR);
  372. BEGIN
  373.   CASE ORD(CH) OF
  374.        72  : CH:=#180; { UP ARROW    }
  375.        80  : CH:=#181; { DOWN ARROW  }
  376.        77  : CH:=#192; { RIGHT ARROW }
  377.        75  : CH:=#191; { LEFT ARROW  }
  378.        71  : CH:=#196; { HOME KEY    }    { ESC KEY RETURNS CHR(27) }
  379.        73  : CH:=#178; { PGUP KEY    }
  380.        79  : CH:=#197; { END KEY     }
  381.        81  : CH:=#179; { PGDN KEY    }
  382.        82  : CH:=#198; { INSERT KEY  }
  383.        83  : CH:=#199; { DELETE KEY  }
  384.        59  : CH:=#127; { F1 }
  385.        60  : CH:=#128; { F2 }
  386.        61  : CH:=#129; { F3 }
  387.        62  : CH:=#130; { F4 }
  388.        63  : CH:=#131; { F5 }
  389.        64  : CH:=#132; { F6 }
  390.        65  : CH:=#133; { F7 }
  391.        66  : CH:=#134; { F8 }
  392.        67  : CH:=#135; { F9 }
  393.        68  : CH:=#136; { F10 }
  394.        104 : CH:=#139; { ALT F1 }
  395.        105 : CH:=#140; { ALT F2 }
  396.        106 : CH:=#141; { ALT F3 }
  397.        107 : CH:=#142; { ALT F4 }
  398.        108 : CH:=#143; { ALT F5 }
  399.        109 : CH:=#144; { ALT F6 }
  400.        110 : CH:=#145; { ALT F7 }
  401.        111 : CH:=#146; { ALT F8 }
  402.        112 : CH:=#147; { ALT F9 }
  403.        113 : CH:=#148; { ALT F10}
  404.        30  : CH:=#151; { ALT A  }
  405.        48  : CH:=#152; { ALT B  }
  406.        46  : CH:=#153; { ALT C  }
  407.        32  : CH:=#154; { ALT D  }
  408.        18  : CH:=#155; { ALT E  }
  409.        33  : CH:=#156; { ALT F  }
  410.        34  : CH:=#157; { ALT G  }
  411.        35  : CH:=#158; { ALT H  }
  412.        23  : CH:=#159; { ALT I  }
  413.        36  : CH:=#160; { ALT J  }
  414.        37  : CH:=#161; { ALT K  }
  415.        38  : CH:=#162; { ALT L  }
  416.        50  : CH:=#163; { ALT M  }
  417.        49  : CH:=#164; { ALT N  }
  418.        24  : CH:=#165; { ALT O  }
  419.        25  : CH:=#166; { ALT P  }
  420.        16  : CH:=#167; { ALT Q  }
  421.        19  : CH:=#168; { ALT R  }
  422.        31  : CH:=#169; { ALT S  }
  423.        20  : CH:=#170; { ALT T  }
  424.        22  : CH:=#171; { ALT U  }
  425.        47  : CH:=#172; { ALT V  }
  426.        17  : CH:=#173; { ALT W  }
  427.        45  : CH:=#174; { ALT X  }
  428.        21  : CH:=#175; { ALT Y  }
  429.        44  : CH:=#176; { ALT Z  }
  430.        94  : CH:=#200; { CNTR F1 }
  431.        95  : CH:=#201;
  432.        96  : CH:=#202;
  433.        97  : CH:=#203;
  434.        98  : CH:=#204;
  435.        99  : CH:=#205;
  436.       100  : CH:=#206;
  437.       101  : CH:=#207;
  438.       102  : CH:=#208;
  439.       103  : CH:=#209;
  440.        15  : CH:=#212;
  441.   END;
  442. END;                              
  443.  
  444. Procedure PROCESS_COMMAND(UserRoutine : Pointer; NA : STRING);
  445.   Procedure CallUserRoutine (NA : STRING); INLINE
  446.     ( $FF / $5E / <UserRoutine );
  447. Begin
  448.   CallUserRoutine(NA);
  449. End;
  450.  
  451. PROCEDURE EVENT_HANDLER(PROCESS_ROUTINE : POINTER; MASK : STRING);
  452. BEGIN
  453.   PROCESS_COMMAND(PROCESS_ROUTINE,'');
  454. END;
  455.  
  456. PROCEDURE BLANK_SCREEN;
  457. VAR
  458.   SC        : BUFFER;
  459.   I,J,X,Y   : INTEGER;
  460.   ATX,ATY   : INTEGER;
  461.   TIM       : LONGINT;
  462.   SAVECUR   : CURTYPE;
  463.   SAVE_ATTR : BYTE;
  464.   SETimer   : LONGINT;
  465. BEGIN
  466.   ATX := WHEREX;
  467.   ATY := WHEREY;
  468.   SAVECUR := CUR;
  469.   SET_CURSOR(NONE);
  470.   SAVE_SCREEN(SC);
  471.   SAVE_ATTR := TEXTATTR;
  472.   TEXTATTR := $07;
  473.   WRITE_DATE(0,0,'N');
  474.   CH := 'X';
  475.   START_TIMER(SETimer);
  476.   REPEAT
  477.     CLRSCR;
  478.     START_TIMER(TIM);
  479.     X := RANDOM(60)+1;
  480.     Y := RANDOM(21)+1;
  481.     FW(X,Y  ,$1F,'                   ');
  482.     WRITE_TIME(X+6,Y,UT.TIME_TYPE);
  483.     FW(X,Y+1,$3F,' Press <space bar> ');
  484.     FW(X,Y+2,$1F,'                   ');
  485.     FW(X,Y+3,$8F,PAD(BLANK_MESS,19));
  486.     WRITE_DATE(X+6,Y+2,'N');
  487.     REPEAT
  488.     UNTIL KEYPRESSED OR (ELAP_TIME(TIM) > 30) OR (COMMAND_BUFFER <> '');
  489.     IF (ScreenEvent <> NIL) AND (ELAP_TIME(SETimer) > ScreenEventTimer) THEN
  490.       BEGIN
  491.         EVENT_HANDLER(ScreenEvent,'');
  492.         START_TIMER(SETimer);
  493.       END;
  494.     WHILE KEYPRESSED DO
  495.       CH := READKEY;
  496.   UNTIL (CH = ' ') OR (CH = ESCAPE) OR (COMMAND_BUFFER <> '');
  497.   REBUILD_SCREEN(SC);
  498.   WRITE_TIME(UT.TIMEX,UT.TIMEY,UT.TIME_TYPE);
  499.   WRITE_DATE(UT.DATEX,UT.DATEY,UT.DATE_TYPE);
  500.   GOTOXY43(ATX,ATY);
  501.   SET_CURSOR(SAVECUR);
  502.   TEXTATTR := SAVE_ATTR;
  503. END;
  504.  
  505. PROCEDURE READCH;
  506. VAR
  507.   I,
  508.   ATX, ATY : INTEGER;
  509.   LINE25   : BUF160;
  510.   HELP     : BOOLEAN;
  511.   TSTART   : LONGINT;
  512.   TEMP     : STRING[3];
  513.  
  514.  
  515. BEGIN
  516.   ATX := WHEREX;
  517.   ATY := WHEREY;
  518.   SAVE_LINE(25,LINE25);
  519.   HELP := FALSE;
  520.   START_TIMER(TSTART);
  521.   REPEAT
  522.     I := 300;
  523.     REPEAT
  524.       IF (SHIFT_KEYS('A')) AND (HELP_LINE <> '') THEN
  525.         BEGIN
  526.           FW(1,25,HELP_ATTR,PAD(HELP_LINE,80));
  527.           GOTOXY(ATX,ATY);
  528.           HELP := TRUE;
  529.         END
  530.       ELSE
  531.         IF (SHIFT_KEYS('C')) AND (HELP_LINE2 <> '') THEN
  532.           BEGIN
  533.             FW(1,25,HELP_ATTR2,PAD(HELP_LINE2,80));
  534.             GOTOXY(ATX,ATY);
  535.             HELP := TRUE;
  536.           END
  537.         ELSE
  538.           IF HELP THEN
  539.             BEGIN
  540.               REBUILD_LINE(25,LINE25);
  541.               GOTOXY(ATX,ATY);
  542.               HELP := FALSE;
  543.             END;
  544.       IF UT.TIMEX > 0 THEN
  545.         BEGIN
  546.           I := SUCC(I);
  547.           IF I > 200 THEN
  548.             BEGIN
  549.               WRITE_TIME(UT.TIMEX,UT.TIMEY,UT.TIME_TYPE);
  550.               I := 0;
  551.             END;
  552.           GOTOXY43(ATX,ATY);
  553.         END;
  554.       IF (SCREEN_BLANKER > 0) AND (ELAP_TIME(TSTART) > SCREEN_BLANKER) THEN
  555.         BEGIN
  556.           GOTOXY43(ATX,ATY);
  557.           BLANK_SCREEN;
  558.           START_TIMER(TSTART);
  559.         END;
  560.     UNTIL KEYPRESSED OR (COMMAND_BUFFER <> '');
  561.     REBUILD_LINE(25,LINE25);
  562.     HELP := FALSE;
  563.     IF COMMAND_BUFFER = '' THEN
  564.       BEGIN
  565.         CH := READKEY;
  566.         IF CH = #0 THEN
  567.           BEGIN
  568.             CH := READKEY;
  569.             SPECIAL_KEY(CH);
  570.           END;
  571.         IF (CH IN [' '..'~']) AND ECHO THEN
  572.           WRITE(CH);
  573.       END
  574.     ELSE
  575.       BEGIN
  576.         CH := COMMAND_BUFFER[1];
  577.         DELETE(COMMAND_BUFFER,1,1);
  578.         IF (CH IN [' '..'~']) AND ECHO THEN
  579.           WRITE(CH);
  580.         IF CH = #255 THEN
  581.           BEGIN
  582.             START_TIMER(TSTART);
  583.             TEMP[0] := #3;
  584.             TEMP[1] := COMMAND_BUFFER[1];
  585.             DELETE(COMMAND_BUFFER,1,1);
  586.             TEMP[2] := COMMAND_BUFFER[1];
  587.             DELETE(COMMAND_BUFFER,1,1);
  588.             TEMP[3] := COMMAND_BUFFER[1];
  589.             DELETE(COMMAND_BUFFER,1,1);
  590.             REPEAT UNTIL ELAP_TIME(TSTART) = _LONGINT(TEMP);
  591.           END;
  592.       END;
  593.     IF CH = AF10 THEN SHOW_VERSION;
  594.     IF EventHandler <> NIL THEN
  595.       EVENT_HANDLER(EventHandler,'');
  596.   UNTIL (CH <> AF10) AND (CH <> #255);
  597. END;
  598.  
  599. FUNCTION PRINTER_NOT_READY : BOOLEAN;
  600. VAR
  601.   REGS         : REGISTERS;
  602. BEGIN
  603.   PRINTER_NOT_READY := TRUE;
  604.   FILLCHAR(REGS,SIZEOF(REGS),00);
  605.   WITH REGS DO
  606.     BEGIN
  607.       AX := $0200;
  608.       DX := 0;     { LPT1 = 0, LPT2 = 1 }
  609.     END;
  610.   INTR($17,REGS);
  611.   IF REGS.AX AND $4000 = 0 THEN
  612.     BEGIN
  613.       IF REGS.AX AND $1000 <> 0 THEN PRINTER_NOT_READY := FALSE;
  614.     END;
  615.   IF REGS.AX AND $8000 = 0 THEN PRINTER_NOT_READY := TRUE;
  616. END;
  617.  
  618. PROCEDURE SET_ATTR;
  619. VAR
  620.   MONITOR_INFO : BYTE ABSOLUTE $0040:$0010;
  621.   SCREEN1      : ARRAY [1..4000] OF BYTE ABSOLUTE $B800:$0000;
  622.   SCREEN2      : ARRAY [1..4000] OF BYTE ABSOLUTE $B000:$0000;
  623.   I,Z          : INTEGER;
  624. BEGIN
  625.   FOR I := 1 TO 80 DO
  626.     IF I IN X THEN
  627.       BEGIN
  628.         Z := ((Y * 160) - 160) + (I * 2);
  629.         IF MONITOR_INFO AND 48=48 THEN
  630.           SCREEN2[Z] := ATTRIB
  631.         ELSE
  632.           IF MONITOR_INFO AND 32=32 THEN
  633.             SCREEN1[Z] := ATTRIB;
  634.       END;
  635. END;
  636.  
  637. PROCEDURE SET_ATTR_BUFFER;
  638. VAR
  639.   I,Z          : INTEGER;
  640. BEGIN
  641.   FOR I := 1 TO 80 DO
  642.     IF I IN X THEN
  643.       BEGIN
  644.         Z := ((Y * 160) - 160) + (I * 2);
  645.         SC[Z] := CHAR(ATTRIB);
  646.       END;
  647. END;
  648.  
  649. PROCEDURE WRITE_TIME;
  650. VAR
  651.   IND,TEMP             : STR8;
  652.   HR, MIN, SEC, SEC100 : WORD;
  653.   C                    : CURTYPE;
  654.   SAVE_ATTR            : BYTE;
  655.   SX, SY               : INTEGER;
  656. BEGIN
  657.   GETTIME(HR,MIN,SEC,SEC100);
  658.   IND := '  ';
  659.   NOW := (HR * 60) + MIN;
  660.   IF NOT (MILITARY IN ['M','m']) THEN
  661.     BEGIN
  662.       IF HR > 12 THEN
  663.         BEGIN
  664.           HR := HR - 12;
  665.           IND := 'pm';
  666.         END
  667.       ELSE
  668.         IF HR = 12 THEN
  669.           IND := 'pm'
  670.         ELSE
  671.           IND := 'am';
  672.     END;
  673.   STR(HR:2,TIME);
  674.   IF (TIME[1] = ' ') AND (MILITARY IN ['M','n']) THEN TIME[1] := '0';
  675.   STR(MIN:2,TEMP);
  676.   IF TEMP[1] = ' ' THEN TEMP[1] := '0';
  677.   TIME := TIME + ':' + TEMP;
  678.   IF NOT (MILITARY IN ['M','m']) THEN
  679.     TIME := TIME + ' ' + IND;
  680.   IF X <> 0 THEN
  681.     BEGIN
  682.       C := CUR;
  683.       SX := WHEREX;
  684.       SY := WHEREY;
  685.       SET_CURSOR(NONE);
  686.       SAVE_ATTR := CRT.TEXTATTR;
  687.       CRT.TEXTATTR := SCREEN_ATTR(X,Y);
  688.       GOTOXY43(X,Y);
  689.       WRITE(COPY(TIME,1,2));
  690.       IF BLINK_IS_ON THEN
  691.         CRT.TEXTATTR := CRT.TEXTATTR + BLINK;
  692.       WRITE(':');
  693.       IF BLINK_IS_ON THEN
  694.         CRT.TEXTATTR := CRT.TEXTATTR - BLINK;
  695.       WRITE(COPY(TIME,4,5));
  696.       CRT.TEXTATTR := SAVE_ATTR;
  697.       GOTOXY(SX,SY);
  698.       SET_CURSOR(C);
  699.     END;
  700. END;
  701.  
  702. PROCEDURE WRITE_DATE;
  703. VAR
  704.   TEMP         : STRING[9];
  705.   YR, MO, DAY  : WORD;
  706. BEGIN
  707.   GETDATE(YR,MO,DAY,DOW);
  708.   IF WORDS IN ['W','w','D','d'] THEN
  709.     BEGIN
  710.       CASE MO OF
  711.             1 : DATE := 'January ';
  712.             2 : DATE := 'February ';
  713.             3 : DATE := 'March ';
  714.             4 : DATE := 'April ';
  715.             5 : DATE := 'May ';
  716.             6 : DATE := 'June ';
  717.             7 : DATE := 'July ';
  718.             8 : DATE := 'August ';
  719.             9 : DATE := 'September ';
  720.            10 : DATE := 'October ';
  721.            11 : DATE := 'November ';
  722.            12 : DATE := 'December ';
  723.       END;
  724.       STR(DAY:2,TEMP);
  725.       DATE := DATE + TEMP;
  726.       STR(YR:4,TEMP);
  727.       DATE := DATE + ', '+TEMP;
  728.       IF WORDS IN ['D','d'] THEN
  729.         BEGIN
  730.           CASE DOW OF
  731.               0 : TEMP := 'Sunday';
  732.               1 : TEMP := 'Monday';
  733.               2 : TEMP := 'Tuesday';
  734.               3 : TEMP := 'Wednesday';
  735.               4 : TEMP := 'Thursday';
  736.               5 : TEMP := 'Friday';
  737.               6 : TEMP := 'Saturday';
  738.           END;
  739.           DATE := TEMP + ' ' + DATE;
  740.         END;
  741.     END
  742.       ELSE
  743.         BEGIN
  744.           IF YR > 2000 THEN
  745.             YR := YR - 2000
  746.           ELSE
  747.             YR := YR - 1900;
  748.           STR(MO:2,DATE);
  749.           IF DATE[1] = ' ' THEN DATE[1] := '0';
  750.           STR(DAY:2,TEMP);
  751.           IF TEMP[1] = ' ' THEN TEMP[1] := '0';
  752.           DATE := DATE + '-' + TEMP + '-';
  753.           STR(YR:2,TEMP);
  754.           IF TEMP[1] = ' ' THEN TEMP[1] := '0';
  755.           DATE := DATE + TEMP;
  756.         END;
  757.   IF X <> 0 THEN
  758.     FW(X,Y,SCREEN_ATTR(X,Y),DATE);
  759. END;
  760.  
  761. PROCEDURE FW(X,Y : INTEGER; ATTR : BYTE; LINE : STR80);
  762. VAR
  763.   I,J,
  764.   Z : INTEGER;
  765. BEGIN
  766.   Z := (((Y * 160) - 160) + (X * 2)) - 1;
  767.   I := 1;
  768.   J := 1;
  769.   IF LENGTH(LINE) > 0 THEN
  770.     REPEAT
  771.       P^[Z+J-1] := LINE[I];
  772.       P^[Z+J]   := CHR(ATTR);
  773.       I := I + 1;
  774.       J := J + 2;
  775.     UNTIL I > LENGTH(LINE);
  776. END;
  777.  
  778. FUNCTION WHOAMI;
  779. BEGIN
  780.   WHOAMI := PARAMSTR(0);
  781. END;
  782.  
  783. PROCEDURE START_TIMER;
  784. VAR
  785.   TIME1     : DATETIME;
  786.   SEC100,
  787.   DAYOFWEEK : WORD;
  788. BEGIN
  789.   WITH TIME1 DO
  790.     GETDATE(YEAR,MONTH,DAY,DAYOFWEEK);
  791.   WITH TIME1 DO
  792.     GETTIME(HOUR,MIN,SEC,SEC100);
  793.   PACKTIME(TIME1,T);
  794. END;
  795.  
  796. FUNCTION ELAP_TIME;
  797. VAR
  798.   TIME1,
  799.   TIME2     : DATETIME;
  800.   SEC100,
  801.   DAYOFWEEK : WORD;
  802.   L,M,N     : LONGINT;
  803.   R         : REAL;
  804.  
  805.        FUNCTION JULIAN(T : DATETIME) : REAL;
  806.        VAR
  807.           TEMP : REAL;
  808.        BEGIN
  809.           TEMP   := INT((T.MONTH - 14.0) / 12.0);
  810.           JULIAN := T.DAY - 32075.0 +
  811.                     INT(1461.0 * (T.YEAR + 4800.0 + TEMP) / 4.0) +
  812.                     INT(367.0 * (T.MONTH - 2.0 - TEMP * 12.0) / 12.0) -
  813.                     INT(3.0 * INT((T.YEAR + 4900.0 + TEMP) / 100.0) / 4.0)
  814.        END;
  815. BEGIN
  816.   WITH TIME1 DO
  817.     GETDATE(YEAR,MONTH,DAY,DAYOFWEEK);
  818.   WITH TIME1 DO
  819.     GETTIME(HOUR,MIN,SEC,SEC100);
  820.   UNPACKTIME(T,TIME2);
  821.   R := JULIAN(TIME1)-JULIAN(TIME2);
  822.   L := TRUNC(R * 864.0 * 100.0);
  823.   M := TIME1.HOUR * 60;
  824.   M := (M + TIME1.MIN) * 60;
  825.   M := M + TIME1.SEC;
  826.   N := TIME2.HOUR * 60;
  827.   N := (N + TIME2.MIN) * 60;
  828.   N := N + TIME2.SEC;
  829.   ELAP_TIME := L + M - N;
  830. END;
  831.  
  832. FUNCTION ELAP_TIME_STR;
  833. VAR
  834.   D,H,M,S : LONGINT;
  835.   T       : LONGINT;
  836.   ST      : STRING;
  837. BEGIN
  838.   T  := ELAP_TIME(TIM);
  839.   D  := T DIV 86400;
  840.   T  := T MOD 86400;
  841.   H  := T DIV 3600;
  842.   T  := T MOD 3600;
  843.   M  := T DIV 60;
  844.   S  := T MOD 60;
  845.   IF D > 0 THEN
  846.     BEGIN
  847.       ST := LONGINT_STR(D,1);
  848.       IF D = 1 THEN
  849.         ST := ST + ' day, '
  850.       ELSE
  851.         ST := ST + ' days, ';
  852.     END
  853.   ELSE
  854.     ST := '';
  855.   IF (D > 0) OR (H > 0) THEN
  856.     BEGIN
  857.       ST := ST + LONGINT_STR(H,2);
  858.       IF H = 1 THEN
  859.         ST := ST + ' hour, '
  860.       ELSE
  861.         ST := ST + ' hours, ';
  862.     END;
  863.   IF (D > 0) OR (H > 0) OR (M > 0) THEN
  864.     ST := ST + LONGINT_STR(M,2) + ' min, ';
  865.   ST := ST + LONGINT_STR(S,2) + ' sec';
  866.   ELAP_TIME_STR := PAD(ST,35);
  867. END;
  868.  
  869. FUNCTION PAD;
  870. VAR
  871.   I : INTEGER;
  872. BEGIN
  873.   I := 1;
  874.   IF LENGTH(S) < LEN THEN
  875.     S := S + SPACES(LEN - LENGTH(S));
  876.   IF LENGTH(S) > LEN THEN
  877.     S[0] := CHR(LEN);
  878.   WHILE POS(#0,S) > 0 DO
  879.     S[POS(#0,S)] := ' ';
  880.   PAD := S;
  881. END;
  882.  
  883. FUNCTION PAD_LEFT;
  884. BEGIN
  885.   IF LENGTH(S) < LEN THEN
  886.     S := SPACES(LEN - LENGTH(S)) + S;
  887.   IF LENGTH(S) > LEN THEN
  888.     S[0] := CHR(LEN);
  889.   PAD_LEFT := S;
  890. END;
  891.  
  892. FUNCTION PAD_CH;
  893. BEGIN
  894.   IF LENGTH(S) < LEN THEN
  895.     S := S + DUP(CH,LEN - LENGTH(S));
  896.   IF LENGTH(S) > LEN THEN
  897.     S[0] := CHR(LEN);
  898.   PAD_CH := S;
  899. END;
  900.  
  901. FUNCTION  PAD_CH_LEFT(S : STRING; LEN : INTEGER; CH : CHAR) : STRING;
  902. BEGIN
  903.   IF LENGTH(S) < LEN THEN
  904.     S := DUP(CH,LEN - LENGTH(S)) + S;
  905.   IF LENGTH(S) > LEN THEN
  906.     S[0] := CHR(LEN);
  907.   PAD_CH_LEFT := S;
  908. END;
  909.  
  910. FUNCTION SPACES;
  911. VAR
  912.   S : STRING;
  913. BEGIN
  914.   S[0] := CHR(NUM);
  915.   FILLCHAR(S[1], NUM, ' ');
  916.   SPACES := S;
  917. END;
  918.  
  919. FUNCTION UPPERCASE;
  920. VAR
  921.   COUNTER : WORD;
  922. BEGIN
  923.   FOR COUNTER := 1 TO LENGTH(S) DO
  924.     S[COUNTER] := UPCASE(S[COUNTER]);
  925.   UPPERCASE := S;
  926. END;
  927.  
  928. FUNCTION EGA_INSTALLED : BOOLEAN;
  929. VAR
  930.   REG : REGISTERS;
  931. BEGIN
  932.   REG.AX := $1200;
  933.   REG.BX := $0010;
  934.   REG.CX := $FFFF;
  935.   INTR($10, REG);
  936.   EGA_INSTALLED := REG.CX <> $FFFF;
  937. END;
  938.  
  939. FUNCTION VGA_INSTALLED : BOOLEAN;
  940. VAR
  941.   REGS : REGISTERS;
  942. BEGIN
  943.   REGS.AX := $1A00;
  944.   INTR($10,REGS);
  945.   VGA_INSTALLED := (REGS.AL = $1A);
  946. END;
  947.  
  948. PROCEDURE LINES43;
  949. BEGIN
  950.   IF EGA_PRESENT THEN
  951.     TEXTMODE(CO80 + FONT8X8);
  952. END;
  953.  
  954. PROCEDURE GOTOXY43;
  955. VAR
  956.   I : INTEGER;
  957.   C : CURTYPE;
  958. BEGIN
  959.   C := CUR;
  960.   IF Y < 26 THEN
  961.     GOTOXY(X,Y)
  962.   ELSE
  963.     IF LASTMODE = 259 THEN
  964.       BEGIN
  965.         I := 25;
  966.         SET_CURSOR(NONE);
  967.         GOTOXY(X,25);
  968.         WHILE I < Y DO
  969.           BEGIN
  970.             WRITE(CHR(10));
  971.             I := SUCC(I);
  972.           END;
  973.         SET_CURSOR(C);
  974.       END;
  975. END;
  976.  
  977. PROCEDURE LINES25;
  978. BEGIN
  979.   TEXTMODE(CO80);
  980. END;
  981.  
  982. PROCEDURE READCHTIME;
  983. VAR
  984.   I,
  985.   ATX, ATY : INTEGER;
  986.   HELP     : BOOLEAN;
  987.   LINE25   : BUF160;
  988. BEGIN
  989.   ATX := WHEREX;
  990.   ATY := WHEREY;
  991.   HELP := FALSE;
  992.   SAVE_LINE(25,LINE25);
  993.   I := 300;
  994.   REPEAT
  995.     I := SUCC(I);
  996.     IF (SHIFT_KEYS('A')) AND (HELP_LINE <> '') THEN
  997.       BEGIN
  998.         FW(1,25,HELP_ATTR,PAD(HELP_LINE,80));
  999.         GOTOXY(ATX,ATY);
  1000.         HELP := TRUE;
  1001.       END
  1002.     ELSE
  1003.       IF (SHIFT_KEYS('C')) AND (HELP_LINE2 <> '') THEN
  1004.         BEGIN
  1005.           FW(1,25,HELP_ATTR2,PAD(HELP_LINE2,80));
  1006.           GOTOXY(ATX,ATY);
  1007.           HELP := TRUE;
  1008.         END
  1009.       ELSE
  1010.         IF HELP THEN
  1011.           BEGIN
  1012.             REBUILD_LINE(25,LINE25);
  1013.             GOTOXY(ATX,ATY);
  1014.             HELP := FALSE;
  1015.           END;
  1016.     IF I > 200 THEN
  1017.       BEGIN
  1018.         WRITE_TIME(X,Y,UT.TIME_TYPE);
  1019.         I := 0;
  1020.       END;
  1021.     GOTOXY43(ATX,ATY);
  1022.   UNTIL KEYPRESSED OR (COMMAND_BUFFER <> '');
  1023.   REBUILD_LINE(25,LINE25);
  1024.   READCH(CH,ECHO);
  1025. END;
  1026.  
  1027. PROCEDURE READSTR;
  1028. VAR
  1029.   I,
  1030.   START  : INTEGER;
  1031.   CAPIT,
  1032.   CAPWO,
  1033.   INSON  : BOOLEAN;
  1034.   SAVECH : CHAR;
  1035.   SX, SY : INTEGER;
  1036.  
  1037.        FUNCTION EDIT_ALL : BOOLEAN;
  1038.        VAR
  1039.          I : INTEGER;
  1040.        BEGIN
  1041.          EDIT_ALL := TRUE;
  1042.          FOR I := 1 TO LEN DO
  1043.            IF NOT (I IN CANEDIT) THEN
  1044.              EDIT_ALL := FALSE;
  1045.        END;
  1046.  
  1047. BEGIN
  1048.   OLDVAL := INSTRING;
  1049.   INSON := FALSE;
  1050.   IF YLOC > 199 THEN
  1051.     BEGIN
  1052.       CAPIT := TRUE;
  1053.       YLOC := YLOC - 200;
  1054.     END
  1055.   ELSE
  1056.     BEGIN
  1057.       CAPIT := FALSE;
  1058.       IF YLOC > 99 THEN
  1059.         BEGIN
  1060.           YLOC := YLOC - 100;
  1061.           CAPWO := TRUE;
  1062.         END
  1063.       ELSE
  1064.         CAPWO := FALSE;
  1065.     END;
  1066.   IF CLEAR IN EXITCH THEN
  1067.     INSTRING := SPACES(LEN)
  1068.   ELSE
  1069.     INSTRING := PAD(INSTRING,LEN);
  1070.   FW(X,Y,PATTR,PROMPT);
  1071.   START := X + LENGTH(PROMPT);
  1072.   X := X_IN;
  1073.   FW(START,Y,IATTR,INSTRING);
  1074.   WHILE (NOT (X IN CANEDIT)) AND
  1075.         (X <= LEN + START) DO
  1076.     X := SUCC(X);
  1077.   IF XLOC > 99 THEN
  1078.     BEGIN
  1079.       X := LEN;
  1080.       XLOC := XLOC - 100;
  1081.     END;
  1082.   WHILE NOT (X IN CANEDIT) DO
  1083.     X := PRED(X);
  1084.   SET_CURSOR(UNDERLINE);
  1085.   SX := UT.TIMEX;
  1086.   SY := UT.TIMEY;
  1087.   UT.TIMEX := XLOC;
  1088.   UT.TIMEY := YLOC;
  1089.   IF NOT (DISPLAY IN EXITCH) THEN
  1090.     REPEAT
  1091.       GOTOXY(START+X-1,Y);
  1092.       CH := CH1;
  1093.       READCH(CH,FALSE);
  1094.       SAVECH := CH;
  1095.       CASE CH OF
  1096.           HOMEKEY : BEGIN
  1097.                       X := 1;
  1098.                       WHILE (NOT (X IN CANEDIT)) AND
  1099.                             (X <= LEN + START) DO
  1100.                         X := SUCC(X);
  1101.                     END;
  1102.            ENDKEY : BEGIN
  1103.                       X := LEN;
  1104.                       WHILE (X > 2) AND (INSTRING[X-1] = ' ') DO
  1105.                         X := PRED(X);
  1106.                       WHILE (NOT (X IN CANEDIT)) AND
  1107.                             (X <= LEN) DO
  1108.                         X := SUCC(X);
  1109.                       WHILE NOT (X IN CANEDIT) DO
  1110.                         X := PRED(X);
  1111.                       IF X < 1 THEN
  1112.                         X := 1
  1113.                       ELSE
  1114.                         IF (X = 2) AND (INSTRING[1] = ' ') AND
  1115.                            (1 IN CANEDIT) THEN
  1116.                           X := 1;
  1117.                     END;
  1118.                #8 : IF (X > 1) AND EDIT_ALL THEN
  1119.                       BEGIN
  1120.                         DELETE(INSTRING,X-1,1);
  1121.                         INSTRING := INSTRING + ' ';
  1122.                         FW(START,Y,IATTR,INSTRING);
  1123.                         X := PRED(X);
  1124.                         WHILE (NOT (X IN CANEDIT)) AND
  1125.                               (X > 1) DO
  1126.                           X := PRED(X);
  1127.                         WHILE NOT (X IN CANEDIT) DO
  1128.                           X := SUCC(X);
  1129.                       END
  1130.                     ELSE
  1131.                       IF X > 1 THEN
  1132.                         BEGIN
  1133.                           X := PRED(X);
  1134.                           WHILE (NOT (X IN CANEDIT)) AND
  1135.                                 (X > 1) DO
  1136.                             X := PRED(X);
  1137.                           WHILE NOT (X IN CANEDIT) DO
  1138.                             X := SUCC(X);
  1139.                         END
  1140.                       ELSE
  1141.                         BEGIN
  1142.                           SAVECH := CH;
  1143.                           IF NOCONV IN EXITCH THEN
  1144.                             CH := NOCONV
  1145.                           ELSE
  1146.                             CH := UP;
  1147.                         END;
  1148.             RIGHT : IF X < LEN THEN
  1149.                       BEGIN
  1150.                         X := SUCC(X);
  1151.                         WHILE (NOT (X IN CANEDIT)) AND
  1152.                               (X <= LEN + START) DO
  1153.                           X := SUCC(X);
  1154.                         IF NOT (X IN CANEDIT) THEN
  1155.                           IF NOCONV IN EXITCH THEN
  1156.                             BEGIN
  1157.                               SAVECH := RIGHT;
  1158.                               CH := NOCONV;
  1159.                             END
  1160.                           ELSE
  1161.                             CH := DOWN;
  1162.                         WHILE NOT (X IN CANEDIT) DO
  1163.                           X := PRED(X);
  1164.                       END
  1165.                     ELSE
  1166.                       BEGIN
  1167.                         SAVECH := CH;
  1168.                         IF NOCONV IN EXITCH THEN
  1169.                           CH := NOCONV
  1170.                         ELSE
  1171.                           CH := DOWN;
  1172.                       END;
  1173.              LEFT : IF X > 1 THEN
  1174.                       BEGIN
  1175.                         X := PRED(X);
  1176.                         WHILE (NOT (X IN CANEDIT)) AND
  1177.                               (X > 1) DO
  1178.                           X := PRED(X);
  1179.                         IF NOT (X IN CANEDIT) THEN
  1180.                           IF NOCONV IN EXITCH THEN
  1181.                             BEGIN
  1182.                               SAVECH := LEFT;
  1183.                               CH := NOCONV;
  1184.                             END
  1185.                           ELSE
  1186.                             CH := UP;
  1187.                         WHILE NOT (X IN CANEDIT) DO
  1188.                           X := SUCC(X);
  1189.                       END
  1190.                     ELSE
  1191.                       BEGIN
  1192.                         SAVECH := CH;
  1193.                         IF NOCONV IN EXITCH THEN
  1194.                           CH := NOCONV
  1195.                         ELSE
  1196.                           CH := UP;
  1197.                       END;
  1198.          ' '..'~' : IF CH IN VALID THEN
  1199.                       IF INSON THEN
  1200.                         BEGIN
  1201.                           DELETE(INSTRING,LENGTH(INSTRING),1);
  1202.                           IF (CAPWO AND ((X = 1) OR (INSTRING[X-1] = ' '))) OR
  1203.                              CAPIT THEN
  1204.                             CH := UPCASE(CH);
  1205.                           INSERT(CH,INSTRING,X);
  1206.                           X := SUCC(X);
  1207.                           IF X > LEN THEN
  1208.                             CH := DOWN;
  1209.                           WHILE (NOT (X IN CANEDIT)) AND
  1210.                                 (X <= LEN + START) DO
  1211.                             X := SUCC(X);
  1212.                           WHILE NOT (X IN CANEDIT) DO
  1213.                             X := PRED(X);
  1214.                           FW(START,Y,IATTR,INSTRING);
  1215.                         END
  1216.                       ELSE
  1217.                         BEGIN
  1218.                           IF (CAPWO AND ((X = 1) OR (INSTRING[X-1] = ' '))) OR
  1219.                              CAPIT THEN
  1220.                             CH := UPCASE(CH);
  1221.                           INSTRING[X] := CH;
  1222.                           FW(START+X-1,Y,IATTR,CH);
  1223.                           X := SUCC(X);
  1224.                           IF X > LEN THEN
  1225.                             BEGIN
  1226.                               SAVECH := RIGHT;
  1227.                               IF NOCONV IN EXITCH THEN
  1228.                                 CH := NOCONV
  1229.                               ELSE
  1230.                                 CH := DOWN;
  1231.                             END;
  1232.                           WHILE (NOT (X IN CANEDIT)) AND
  1233.                                 (X <= LEN + START) DO
  1234.                             X := SUCC(X);
  1235.                           IF NOT (X IN CANEDIT) THEN
  1236.                             IF NOCONV IN EXITCH THEN
  1237.                               BEGIN
  1238.                                 SAVECH := RIGHT;
  1239.                                 CH := NOCONV;
  1240.                               END
  1241.                             ELSE
  1242.                               CH := DOWN;
  1243.                           WHILE NOT (X IN CANEDIT) DO
  1244.                             X := PRED(X);
  1245.                         END;
  1246.            INSKEY : BEGIN
  1247.                       INSON := NOT INSON;
  1248.                       IF INSON AND (EDIT_ALL) THEN
  1249.                         SET_CURSOR(BLOCK)
  1250.                       ELSE
  1251.                         BEGIN
  1252.                           SET_CURSOR(UNDERLINE);
  1253.                           INSON := FALSE;
  1254.                         END;
  1255.                     END;
  1256.            DELKEY : IF EDIT_ALL THEN
  1257.                       BEGIN
  1258.                         DELETE(INSTRING,X,1);
  1259.                         INSTRING := INSTRING + ' ';
  1260.                         GOTOXY(START,Y);
  1261.                         FW(START,Y,IATTR,INSTRING);
  1262.                       END;
  1263.             ALT_C : BEGIN
  1264.                       FOR I := 1 TO LEN DO
  1265.                         IF I IN CANEDIT THEN
  1266.                           INSTRING[I] := ' ';
  1267.                       X := 1;
  1268.                       FW(START,Y,IATTR,INSTRING);
  1269.                       WHILE (NOT (X IN CANEDIT)) AND
  1270.                             (X <= LEN + START) DO
  1271.                         X := SUCC(X);
  1272.                     END;
  1273.       END;
  1274.       IF X > LEN THEN X := LEN;
  1275.     UNTIL (CH = #27) OR (CH IN EXITCH);
  1276.   UT.TIMEX := SX;
  1277.   UT.TIMEY := SY;
  1278.   IF NOCONV IN EXITCH THEN
  1279.     CH := SAVECH;
  1280.   X_OUT := X;
  1281.   X_IN  := 1;
  1282.   SET_CURSOR(UNDERLINE);
  1283.   CHANGED := INSTRING <> OLDVAL;
  1284. END;
  1285.  
  1286. PROCEDURE READ_STR;
  1287. VAR
  1288.   I,
  1289.   LEN,
  1290.   START   : INTEGER;
  1291.   CAPWO,
  1292.   VALID,
  1293.   EDITALL,
  1294.   INSON   : BOOLEAN;
  1295.   SAVECH  : CHAR;
  1296.   OLDATTR : BYTE;
  1297.   OLDCUR  : CURTYPE;
  1298.  
  1299.          FUNCTION CANEDIT(INCHAR : CHAR) : BOOLEAN;
  1300.          BEGIN
  1301.            IF ((INCHAR = ' ') OR
  1302.                (INCHAR = 'c') OR
  1303.                (INCHAR = 'y') OR
  1304.                (INCHAR = 'A') OR
  1305.                (INCHAR = '0') OR
  1306.                (INCHAR = '1') OR
  1307.                (INCHAR = '.') OR
  1308.                (INCHAR = '!') OR
  1309.                (INCHAR = '+')) THEN
  1310.              CANEDIT := TRUE
  1311.            ELSE
  1312.              CANEDIT := FALSE;
  1313.          END;
  1314.  
  1315.  
  1316. BEGIN                           
  1317.   INSTRING := PAD(INSTRING,LENGTH(MASK));
  1318.   OLDVAL := INSTRING;
  1319.   INSON := FALSE;
  1320.   SAVECH := #0;
  1321.   CAPWO := FALSE;
  1322.   EDITALL := TRUE;
  1323.   OLDCUR := CUR;
  1324.   TEXTATTR := UT.INPUT_ATTR;
  1325.   LEN := LENGTH(INSTRING);
  1326.   FOR I := 1 TO LENGTH(INSTRING) DO
  1327.     BEGIN
  1328.       IF MASK[I] = 'c' THEN
  1329.         CAPWO := TRUE
  1330.       ELSE
  1331.         IF (NOT CANEDIT(MASK[I])) THEN
  1332.           BEGIN
  1333.             IF MASK[I] <> 'x' THEN
  1334.               INSTRING[I] := MASK[I];
  1335.             EDITALL := FALSE;
  1336.           END;
  1337.       IF EDITALL THEN
  1338.         BEGIN
  1339.           IF (POS('y',MASK) > 0) AND (MASK <> DUP('y',LENGTH(MASK))) THEN
  1340.             EDITALL := FALSE;
  1341.           IF (POS('y',MASK) > 0) AND (MASK <> DUP('y',LENGTH(MASK))) THEN
  1342.             EDITALL := FALSE;
  1343.           IF (POS('A',MASK) > 0) AND (MASK <> DUP('A',LENGTH(MASK))) THEN
  1344.             EDITALL := FALSE;
  1345.           IF (POS('0',MASK) > 0) AND (MASK <> DUP('0',LENGTH(MASK))) THEN
  1346.             EDITALL := FALSE;
  1347.           IF (POS('1',MASK) > 0) AND (MASK <> DUP('1',LENGTH(MASK))) THEN
  1348.             EDITALL := FALSE;
  1349.           IF (POS('.',MASK) > 0) AND (MASK <> DUP('.',LENGTH(MASK))) THEN
  1350.             EDITALL := FALSE;
  1351.           IF (POS('!',MASK) > 0) AND (MASK <> DUP('!',LENGTH(MASK))) THEN
  1352.             EDITALL := FALSE;
  1353.           IF (POS('+',MASK) > 0) AND (MASK <> DUP('+',LENGTH(MASK))) THEN
  1354.             EDITALL := FALSE;
  1355.         END;
  1356.     END;
  1357.   IF X > 99 THEN
  1358.     BEGIN
  1359.       X := X - 100;
  1360.       START := X;
  1361.       X := LEN;
  1362.       WHILE (X > 2) AND (NOT CANEDIT(MASK[X])) DO
  1363.         X := X - 1;
  1364.     END
  1365.   ELSE
  1366.     BEGIN
  1367.       START := X;
  1368.       X := X_IN;
  1369.     END;
  1370.   OLDATTR := SCREEN_ATTR(START,Y);
  1371.   GOTOXY(START,Y);
  1372.   WRITE(INSTRING);
  1373.   SET_CURSOR(UNDERLINE);
  1374.   WHILE (NOT CANEDIT(MASK[X])) AND (X <= LEN) DO
  1375.     X := X + 1;
  1376.   REPEAT
  1377.     GOTOXY(START+X-1,Y);
  1378.     READCH(CH,FALSE);
  1379.     CASE CH OF
  1380.         HOMEKEY : BEGIN
  1381.                     X := 1;
  1382.                     WHILE (NOT CANEDIT(MASK[X])) AND
  1383.                           (X <= LEN + START) DO
  1384.                       X := SUCC(X);
  1385.                   END;
  1386.          ENDKEY : BEGIN
  1387.                     X := LEN;
  1388.                     WHILE (X > 2) AND (INSTRING[X-1] = ' ') DO
  1389.                       X := PRED(X);
  1390.                     WHILE (NOT CANEDIT(MASK[X])) AND
  1391.                           (X <= LEN) DO
  1392.                       X := SUCC(X);
  1393.                     WHILE NOT CANEDIT(MASK[X]) DO
  1394.                       X := PRED(X);
  1395.                     IF X < 1 THEN
  1396.                       X := 1
  1397.                     ELSE
  1398.                       IF (X = 2) AND (INSTRING[1] = ' ') AND
  1399.                          (CANEDIT(MASK[1])) THEN
  1400.                         X := 1;
  1401.                   END;
  1402.              #8 : IF (X > 1) AND EDITALL THEN
  1403.                     BEGIN
  1404.                       DELETE(INSTRING,X-1,1);
  1405.                       INSTRING := INSTRING + ' ';
  1406.                       GOTOXY(START,Y);
  1407.                       WRITE(INSTRING);
  1408.                       X := PRED(X);
  1409.                       WHILE (NOT CANEDIT(MASK[X])) AND
  1410.                             (X > 1) DO
  1411.                         X := PRED(X);
  1412.                       WHILE NOT CANEDIT(MASK[X]) DO
  1413.                         X := SUCC(X);
  1414.                     END
  1415.                   ELSE
  1416.                     IF X > 1 THEN
  1417.                       BEGIN
  1418.                         X := PRED(X);
  1419.                         WHILE (NOT CANEDIT(MASK[X])) AND
  1420.                               (X > 1) DO
  1421.                           X := PRED(X);
  1422.                         WHILE NOT CANEDIT(MASK[X]) DO
  1423.                           X := SUCC(X);
  1424.                       END
  1425.                     ELSE
  1426.                       BEGIN
  1427.                         IF UT.NOCONV THEN
  1428.                           SAVECH := LEFT
  1429.                         ELSE
  1430.                           CH := UP;
  1431.                       END;
  1432.           RIGHT : IF X < LEN THEN
  1433.                     BEGIN
  1434.                       X := SUCC(X);
  1435.                       WHILE (NOT CANEDIT(MASK[X])) AND
  1436.                             (X <= LEN + START) DO
  1437.                         X := SUCC(X);
  1438.                       IF NOT CANEDIT(MASK[X]) THEN
  1439.                         IF UT.NOCONV THEN
  1440.                           SAVECH := RIGHT
  1441.                         ELSE
  1442.                           CH := DOWN;
  1443.                       WHILE NOT CANEDIT(MASK[X]) DO
  1444.                         X := PRED(X);
  1445.                     END
  1446.                   ELSE
  1447.                     BEGIN
  1448.                       IF UT.NOCONV THEN
  1449.                         SAVECH := CH
  1450.                       ELSE
  1451.                         CH := DOWN;
  1452.                     END;
  1453.            LEFT : IF X > 1 THEN
  1454.                     BEGIN
  1455.                       X := PRED(X);
  1456.                       WHILE (NOT CANEDIT(MASK[X])) AND
  1457.                             (X > 1) DO
  1458.                         X := PRED(X);
  1459.                       IF NOT CANEDIT(MASK[X]) THEN
  1460.                         IF UT.NOCONV THEN
  1461.                           SAVECH := LEFT
  1462.                         ELSE
  1463.                           CH := UP;
  1464.                       WHILE NOT CANEDIT(MASK[X]) DO
  1465.                         X := SUCC(X);
  1466.                     END
  1467.                   ELSE
  1468.                     BEGIN
  1469.                       IF UT.NOCONV THEN
  1470.                         SAVECH := LEFT
  1471.                       ELSE
  1472.                         CH := UP;
  1473.                     END;
  1474.        ' '..'~' : BEGIN
  1475.                     VALID := FALSE;
  1476.                     CASE MASK[X] OF
  1477.                         ' ',
  1478.                         'c'  : VALID := TRUE;
  1479.                         'A'  : BEGIN
  1480.                                  VALID := TRUE;
  1481.                                  CH := UPCASE(CH);
  1482.                                END;
  1483.                         'y'  : BEGIN
  1484.                                  CH := UPCASE(CH);
  1485.                                  IF CH IN ['Y','N'] THEN
  1486.                                    VALID := TRUE;
  1487.                                END;
  1488.                         '0'  : IF CH IN ['0'..'9'] THEN
  1489.                                  VALID := TRUE;
  1490.                         '1'  : IF CH IN ['0'..'9',' '] THEN
  1491.                                  VALID := TRUE;
  1492.                         '.'  : IF CH IN ['0'..'9','.'] THEN
  1493.                                  VALID := TRUE;
  1494.                         '!'  : IF CH IN ['0'..'9','.',' '] THEN
  1495.                                  VALID := TRUE;
  1496.                         '+'  : IF CH IN ['0'..'9','.',' ','+','-'] THEN
  1497.                                  VALID := TRUE;
  1498.                     END;
  1499.                     IF VALID THEN
  1500.                       BEGIN
  1501.                         IF (CAPWO) AND ((X = 1) OR
  1502.                            (INSTRING[X-1] = ' ')) THEN
  1503.                           CH := UPCASE(CH);
  1504.                         IF INSON THEN
  1505.                           BEGIN
  1506.                             DELETE(INSTRING,LENGTH(INSTRING),1);
  1507.                             INSERT(CH,INSTRING,X);
  1508.                             GOTOXY(START,Y);
  1509.                             WRITE(INSTRING);
  1510.                           END
  1511.                         ELSE
  1512.                           BEGIN
  1513.                             INSTRING[X] := CH;
  1514.                             GOTOXY(START+X-1,Y);
  1515.                             WRITE(CH);
  1516.                           END;
  1517.                         X := SUCC(X);
  1518.                         IF X > LEN THEN
  1519.                           BEGIN
  1520.                             IF UT.NOCONV THEN
  1521.                               SAVECH := RIGHT
  1522.                             ELSE
  1523.                               CH := DOWN;
  1524.                           END
  1525.                         ELSE
  1526.                           BEGIN
  1527.                             WHILE (NOT CANEDIT(MASK[X])) AND
  1528.                                   (X <= LEN + START) DO
  1529.                               X := SUCC(X);
  1530.                             IF NOT CANEDIT(MASK[X]) THEN
  1531.                               IF UT.NOCONV THEN
  1532.                                 SAVECH := RIGHT
  1533.                               ELSE
  1534.                                 CH := DOWN;
  1535.                             WHILE NOT CANEDIT(MASK[X]) DO
  1536.                               X := PRED(X);
  1537.                           END;
  1538.                       END;
  1539.                   END;
  1540.          INSKEY : BEGIN
  1541.                     INSON := NOT INSON;
  1542.                     IF INSON AND (EDITALL) THEN
  1543.                       SET_CURSOR(BLOCK)
  1544.                     ELSE
  1545.                       BEGIN
  1546.                         SET_CURSOR(UNDERLINE);
  1547.                         INSON := FALSE;
  1548.                       END;
  1549.                   END;
  1550.          DELKEY : IF EDITALL THEN
  1551.                     BEGIN
  1552.                       DELETE(INSTRING,X,1);
  1553.                       INSTRING := INSTRING + ' ';
  1554.                       GOTOXY(START,Y);
  1555.                       WRITE(INSTRING);
  1556.                     END;
  1557.           ALT_C : BEGIN
  1558.                     FOR I := 1 TO LEN DO
  1559.                       IF CANEDIT(MASK[I]) THEN
  1560.                         INSTRING[I] := ' ';
  1561.                     X := 1;
  1562.                     GOTOXY(START,Y);
  1563.                     WRITE(INSTRING);
  1564.                     WHILE (NOT CANEDIT(MASK[X])) AND
  1565.                           (X <= LEN) DO
  1566.                       X := SUCC(X);
  1567.                   END;
  1568.     END;
  1569.     IF X > LEN THEN X := LEN;
  1570.   UNTIL (CH = #27) OR (UT.EXITCH[ORD(CH)]) OR (SAVECH <> #0);
  1571.   IF SAVECH <> #0 THEN
  1572.     CH := SAVECH;
  1573.   X_OUT := X;
  1574.   X_IN  := 1;
  1575.   SET_CURSOR(UNDERLINE);
  1576.   TEXTATTR := OLDATTR;
  1577.   GOTOXY(START,Y);
  1578.   WRITE(INSTRING);
  1579.   TEXTATTR := UT.DEFAULT_ATTR;
  1580.   SET_CURSOR(OLDCUR);
  1581.   CHANGED := INSTRING <> OLDVAL;
  1582. END;
  1583.  
  1584. PROCEDURE READ_ONLY(NAME : STRING);
  1585. VAR
  1586.   F    : FILE;
  1587.   ATTR : WORD;
  1588. BEGIN
  1589.   ASSIGN(F,NAME);
  1590.   GETFATTR(F,ATTR);
  1591.   ATTR := ATTR OR 1;
  1592.   SETFATTR(F,ATTR);
  1593. END;
  1594.  
  1595. PROCEDURE READ_WRITE(NAME : STRING);
  1596. VAR
  1597.   F    : FILE;
  1598.   ATTR : WORD;
  1599. BEGIN
  1600.   ASSIGN(F,NAME);
  1601.   GETFATTR(F,ATTR);
  1602.   IF ODD(ATTR) THEN
  1603.     ATTR := ATTR - 1;
  1604.   SETFATTR(F,ATTR);
  1605. END;
  1606.  
  1607. PROCEDURE READ_REAL(X,Y,LEN  : INTEGER;
  1608.                     PATTR    : INTEGER;
  1609.                     PROMPT   : STR80;
  1610.                     IATTR    : INTEGER;
  1611.                     VAR R    : REAL;
  1612.                     DPLACES  : INTEGER;
  1613.                     LOW,HIGH : REAL;
  1614.                     EXITCH   : ETYPE;
  1615.                     ICOMA    : BOOLEAN;
  1616.                     TX, TY   : INTEGER;
  1617.                     CH       : CHAR);
  1618. VAR
  1619.   RESULT : INTEGER;
  1620.   TEMP   : STRING[40];
  1621.   T      : ETYPE;
  1622.   S      : BUF160;
  1623.   SAT    : INTEGER;
  1624. BEGIN
  1625.   IF ICOMA THEN
  1626.     TEMP := COMMA(R,0,DPLACES,RNUM)
  1627.   ELSE
  1628.     STR(R:0:DPLACES,TEMP);
  1629.   IF (R = 0.0) OR (CLEAR IN EXITCH) THEN
  1630.     BEGIN
  1631.       TEMP := '0';
  1632.       TEMP := PAD(TEMP,LEN);
  1633.       EXITCH := EXITCH - [CLEAR];
  1634.     END;
  1635.   T := [' ','0'..'9','-',','];
  1636.   IF DPLACES > 0 THEN
  1637.     T := T + ['.'];
  1638.   REPEAT
  1639.     WHILE LENGTH(TEMP) < LEN DO
  1640.       TEMP := TEMP + ' ';
  1641.     READSTR(X,Y,LEN,PATTR,PROMPT,IATTR,TEMP,T,[1..LEN],EXITCH,TX,TY,CH);
  1642.     WHILE (TEMP[1] = ' ') AND (LENGTH(TEMP) > 0) DO
  1643.       DELETE(TEMP,1,1);
  1644.     WHILE (TEMP[LENGTH(TEMP)] = ' ') AND (LENGTH(TEMP) > 0) DO
  1645.       DELETE(TEMP,LENGTH(TEMP),1);
  1646.     IF TEMP[LENGTH(TEMP)] = '.' THEN
  1647.       DELETE(TEMP,LENGTH(TEMP),1);
  1648.     WHILE (POS(',',TEMP) > 0) AND (LENGTH(TEMP) > 0) DO
  1649.       DELETE(TEMP,POS(',',TEMP),1);
  1650.     IF TEMP[1] = '.' THEN
  1651.       TEMP := '0' + TEMP;
  1652.     VAL(TEMP,R,RESULT);
  1653.     IF (RESULT = 0) AND ((R < LOW) OR (R > HIGH)) THEN
  1654.       RESULT := 1;
  1655.     IF RESULT <> 0 THEN
  1656.       BEGIN
  1657.         SAT := TEXTATTR;
  1658.         SAVE_LINE(Y+1,S);
  1659.         TEXTATTR := $4F;
  1660.         IF X > 30 THEN
  1661.           GOTOXY(30,Y+1)
  1662.         ELSE
  1663.           GOTOXY(X,Y+1);
  1664.         WRITE(' Range: ',LOW:0:DPLACES,' to ',HIGH:0:DPLACES,'  Press <any key> ',CHR(8));
  1665.         READCH(CH,FALSE);
  1666.         REBUILD_LINE(Y+1,S);
  1667.         TEXTATTR := SAT;
  1668.       END;
  1669.   UNTIL RESULT = 0;
  1670.   WHILE LENGTH(TEMP) < LEN DO
  1671.     TEMP := ' ' + TEMP;
  1672.   IF ICOMA THEN
  1673.     FW(X+LENGTH(PROMPT),Y,IATTR,COMMA(R,LEN,DPLACES,RNUM))
  1674.   ELSE
  1675.     FW(X+LENGTH(PROMPT),Y,IATTR,TEMP);
  1676. END;
  1677.  
  1678. PROCEDURE READ_INT(X,Y,LEN   : INTEGER;
  1679.                     PATTR    : INTEGER;
  1680.                     PROMPT   : STR80;
  1681.                     IATTR    : INTEGER;
  1682.                     VAR R    : INTEGER;
  1683.                     LOW,HIGH : INTEGER;
  1684.                     EXITCH   : ETYPE;
  1685.                     ICOMA    : BOOLEAN;
  1686.                     TX, TY   : INTEGER;
  1687.                     CH       : CHAR);
  1688. VAR
  1689.   RESULT : INTEGER;
  1690.   TEMP   : STRING;
  1691.   T      : ETYPE;
  1692.   S      : BUF160;
  1693.   SAT    : INTEGER;
  1694. BEGIN
  1695.   IF (R = 0) OR (CLEAR IN EXITCH) THEN
  1696.     BEGIN
  1697.       TEMP := '0';
  1698.       EXITCH := EXITCH - [CLEAR];
  1699.     END
  1700.   ELSE
  1701.     IF ICOMA THEN
  1702.       TEMP := COMMA(R,0,0,INUM)
  1703.     ELSE
  1704.       STR(R,TEMP);
  1705.   WHILE LENGTH(TEMP) < LEN DO
  1706.     TEMP := TEMP + ' ';
  1707.   T := [' ','0'..'9','-',','];
  1708.   REPEAT
  1709.     WHILE LENGTH(TEMP) < LEN DO
  1710.       TEMP := TEMP + ' ';
  1711.     READSTR(X,Y,LEN,PATTR,PROMPT,IATTR,TEMP,T,[1..LEN],EXITCH,TX,TY,CH);
  1712.     WHILE (TEMP[1] = ' ') AND (LENGTH(TEMP) > 0) DO
  1713.       DELETE(TEMP,1,1);
  1714.     WHILE (TEMP[LENGTH(TEMP)] = ' ') AND (LENGTH(TEMP) > 0) DO
  1715.       DELETE(TEMP,LENGTH(TEMP),1);
  1716.     WHILE (POS(',',TEMP) > 0) AND (LENGTH(TEMP) > 0) DO
  1717.       DELETE(TEMP,POS(',',TEMP),1);
  1718.     IF _LONGINT(TEMP) <= 32767 THEN
  1719.       VAL(TEMP,R,RESULT)
  1720.     ELSE
  1721.       RESULT := 1;
  1722.     IF (RESULT = 0) AND ((R < LOW) OR (R > HIGH)) THEN
  1723.       RESULT := 1;
  1724.     IF RESULT <> 0 THEN
  1725.       BEGIN
  1726.         SAVE_LINE(Y+1,S);
  1727.         SAT := TEXTATTR;
  1728.         TEXTATTR := $4F;
  1729.         IF X > 39 THEN
  1730.           GOTOXY(39,Y+1)
  1731.         ELSE
  1732.           GOTOXY(X,Y+1);
  1733.         WRITE(' Range: ',LOW,' to ',HIGH,'  Press <any key> ',CHR(8));
  1734.         READCH(CH,FALSE);
  1735.         REBUILD_LINE(Y+1,S);
  1736.         TEXTATTR := SAT;
  1737.       END;
  1738.   UNTIL RESULT = 0;
  1739.   WHILE LENGTH(TEMP) < LEN DO
  1740.     TEMP := ' ' + TEMP;
  1741.   IF ICOMA THEN
  1742.     FW(X+LENGTH(PROMPT),Y,IATTR,COMMA(R,LEN,0,INUM))
  1743.   ELSE
  1744.     FW(X+LENGTH(PROMPT),Y,IATTR,TEMP);
  1745. END;
  1746.  
  1747. FUNCTION DRIVE_READY(DRIVE : CHAR) : BOOLEAN;
  1748. BEGIN
  1749.   DRIVE_READY := DISKSIZE(ORD(DRIVE)-64) <> -1;
  1750. END;
  1751.  
  1752. FUNCTION _REAL(INSTRING : STRING) : REAL;
  1753. VAR
  1754.   R      : REAL;
  1755.   RESULT : INTEGER;
  1756. BEGIN
  1757.   WHILE POS(' ',INSTRING) > 0 DO
  1758.     DELETE(INSTRING,POS(' ',INSTRING),1);
  1759.   VAL(INSTRING,R,RESULT);
  1760.   _REAL := R;
  1761. END;
  1762.  
  1763. FUNCTION _INTEGER(INSTRING : STRING) : INTEGER;
  1764. VAR
  1765.   I,
  1766.   RESULT : INTEGER;
  1767. BEGIN
  1768.   WHILE POS(' ',INSTRING) > 0 DO
  1769.     DELETE(INSTRING,POS(' ',INSTRING),1);
  1770.   IF POS('.',INSTRING) > 0 THEN
  1771.     INSTRING := COPY(INSTRING,1,POS('.',INSTRING)-1);
  1772.   IF (LENGTH(INSTRING) >= 5) AND (INSTRING > '32767') THEN
  1773.     BEGIN
  1774.       _INTEGER := 0;
  1775.       EXIT;
  1776.     END;
  1777.   VAL(INSTRING,I,RESULT);
  1778.   _INTEGER := I;
  1779. END;
  1780.  
  1781. FUNCTION _LONGINT(INSTRING : STRING) : LONGINT;
  1782. VAR
  1783.   SIGN,
  1784.   LEN,
  1785.   I      : INTEGER;
  1786.   TENS,
  1787.   NUMBER : LONGINT;
  1788. BEGIN
  1789.   TENS := 1;
  1790.   NUMBER := 0;
  1791.   SIGN := 1;
  1792.   _LONGINT := 0;
  1793.   WHILE POS(' ',INSTRING) > 0 DO
  1794.     DELETE(INSTRING,POS(' ',INSTRING),1);
  1795.   IF POS('.',INSTRING) > 0 THEN
  1796.     INSTRING := COPY(INSTRING,1,POS('.',INSTRING)-1);
  1797.   IF (LENGTH(INSTRING) >= 10) AND (INSTRING > '2147483648') THEN
  1798.     EXIT;
  1799.   LEN := LENGTH(INSTRING);
  1800.   IF INSTRING[1] = '-' THEN
  1801.     BEGIN
  1802.       IF LEN = 1 THEN
  1803.         EXIT;
  1804.       SIGN := -1;
  1805.     END;
  1806.   FOR I := LEN DOWNTO 1 DO
  1807.     IF (INSTRING[I] < '0') OR (INSTRING[I] > '9') THEN
  1808.     ELSE
  1809.       BEGIN
  1810.         NUMBER := NUMBER + (ORD(INSTRING[I]) - ORD('0')) * TENS;
  1811.         TENS := TENS * 10;
  1812.       END;
  1813.   NUMBER := NUMBER * SIGN;
  1814.   _LONGINT := NUMBER;
  1815. END;
  1816.  
  1817. FUNCTION _WORD(INSTRING : STRING) : WORD;
  1818. VAR
  1819.   SIGN,
  1820.   LEN,
  1821.   I      : INTEGER;
  1822.   TENS   : LONGINT;
  1823.   NUMBER : WORD;
  1824. BEGIN
  1825.   TENS := 1;
  1826.   NUMBER := 0;
  1827.   SIGN := 1;
  1828.   _WORD := 0;
  1829.   WHILE POS(' ',INSTRING) > 0 DO
  1830.     DELETE(INSTRING,POS(' ',INSTRING),1);
  1831.   IF POS('.',INSTRING) > 0 THEN
  1832.     INSTRING := COPY(INSTRING,1,POS('.',INSTRING)-1);
  1833.   IF (LENGTH(INSTRING) >= 5) AND (INSTRING > '65535') THEN
  1834.     EXIT;
  1835.   LEN := LENGTH(INSTRING);
  1836.   IF INSTRING[1] = '-' THEN
  1837.     BEGIN
  1838.       IF LEN = 1 THEN
  1839.         EXIT;
  1840.       SIGN := -1;
  1841.     END;
  1842.   FOR I := LEN DOWNTO 1 DO
  1843.     IF (INSTRING[I] < '0') OR (INSTRING[I] > '9') THEN
  1844.       EXIT
  1845.     ELSE
  1846.       BEGIN
  1847.         NUMBER := NUMBER + (ORD(INSTRING[I]) - ORD('0')) * TENS;
  1848.         TENS := TENS * 10;
  1849.       END;
  1850.   NUMBER := NUMBER * SIGN;
  1851.   _WORD := NUMBER;
  1852. END;
  1853.  
  1854. FUNCTION GET_FILE_NAME(MASK : STRING; DEL : BOOLEAN) : STRING;
  1855. TYPE
  1856.   STR12     = STRING[12];
  1857. VAR
  1858.   I,J,
  1859.   FM,
  1860.   TOP,
  1861.   SEL,
  1862.   INDEX     : INTEGER;
  1863.   TEMP      : STR12;
  1864.   DIRINFO   : SEARCHREC;
  1865.   SAVENAME  : ARRAY [1..500] OF STRING[12];
  1866.   F         : FILE;
  1867.   C         : CURTYPE;
  1868.   SAVE_ATTR : INTEGER;
  1869.  
  1870.       PROCEDURE WRITE_PAGE;
  1871.       VAR
  1872.         I : INTEGER;
  1873.       BEGIN
  1874.         J := 10;
  1875.         WINDOW(36,10,50,17);
  1876.         CLRSCR;
  1877.         WINDOW(1,1,80,25);
  1878.         FOR I := TOP TO TOP+7 DO
  1879.           IF I <= INDEX THEN
  1880.             BEGIN
  1881.               FW(38,J,$0E,SAVENAME[I]);
  1882.               J := SUCC(J);
  1883.             END;
  1884.       END;
  1885.  
  1886. BEGIN
  1887.   C := CUR;
  1888.   SAVE_ATTR := TEXTATTR;
  1889.   SET_CURSOR(NONE);
  1890.   TEXTBACKGROUND(BLACK);
  1891.   FM := FILEMODE;
  1892.   FILEMODE := 0;
  1893.   INDEX := 1;
  1894.   FILLCHAR(SAVENAME,SIZEOF(SAVENAME),0);
  1895.   FINDFIRST(MASK,READONLY+ARCHIVE,DIRINFO);
  1896.   WHILE DOSERROR = 0 DO
  1897.     BEGIN
  1898.       SAVENAME[INDEX] := DIRINFO.NAME;
  1899.       INDEX := SUCC(INDEX);
  1900.       FINDNEXT(DIRINFO);
  1901.     END;
  1902.   INDEX := PRED(INDEX);
  1903.   FOR I := 1 TO INDEX DO
  1904.     FOR J := I+1 TO INDEX DO
  1905.       IF SAVENAME[I] > SAVENAME[J] THEN
  1906.         BEGIN
  1907.           TEMP := SAVENAME[I];
  1908.           SAVENAME[I] := SAVENAME[J];
  1909.           SAVENAME[J] := TEMP;
  1910.         END;
  1911.   FW(35, 8,$0E,'╔═ Select File ═╗');
  1912.   FW(35, 9,$0E,'║               ║');
  1913.   FW(35,10,$0E,'║               ║');
  1914.   FW(35,11,$0E,'║               ║');
  1915.   FW(35,12,$0E,'║               ║');
  1916.   FW(35,13,$0E,'║               ║');
  1917.   FW(35,14,$0E,'║               ║');
  1918.   FW(35,15,$0E,'║               ║');
  1919.   FW(35,16,$0E,'║               ║');
  1920.   FW(35,17,$0E,'║               ║');
  1921.   FW(35,18,$0E,'║               ║');
  1922.   FW(35,19,$0E,'║               ║');
  1923.   FW(35,20,$0E,'║               ║');
  1924.   FW(35,21,$0E,'╚═══════════════╝');
  1925.   FW(39,19,$0F,CHR(24)+' '+CHR(25)+'   '+ENTER_KEY);
  1926.   FW(38,20,$0F,'PgUp   PgDn');
  1927.   IF DEL THEN
  1928.     BEGIN
  1929.       FW(35,21,$0E,'║  <DEL> Delete ║');
  1930.       FW(35,22,$0E,'╚═══════════════╝');
  1931.       SET_ATTR([36..49],21,$0F);
  1932.     END;
  1933.   SET_CURSOR(NONE);
  1934.   TOP := 1;
  1935.   SEL := 1;
  1936.   FOR I := 1 TO 8 DO
  1937.     IF I <= INDEX THEN
  1938.       FW(38,I+9,$0E,SAVENAME[I]);
  1939.   REPEAT
  1940.     SET_ATTR([37..49],SEL+9,$70);
  1941.     READCH(CH,FALSE);
  1942.     CH := UPCASE(CH);
  1943.     SET_ATTR([37..49],SEL+9,$0E);
  1944.     CASE CH OF
  1945.        '0'..'9',
  1946.        'A'..'Z' : BEGIN
  1947.                     TOP := 1;
  1948.                     WHILE (TOP < 500) AND (SAVENAME[TOP][1] < CH) DO
  1949.                       TOP := SUCC(TOP);
  1950.                     SEL := 1;
  1951.                     WHILE (TOP > 1) AND (LENGTH(SAVENAME[TOP]) = 0) DO
  1952.                       TOP := PRED(TOP);
  1953.                     WRITE_PAGE;
  1954.                   END;
  1955.              UP : IF SEL > 1 THEN
  1956.                     SEL := PRED(SEL)
  1957.                   ELSE
  1958.                     IF TOP > 1 THEN
  1959.                       BEGIN
  1960.                         WINDOW(36,10,50,17);
  1961.                         INSLINE;
  1962.                         WINDOW(1,1,80,25);
  1963.                         TOP := PRED(TOP);
  1964.                         FW(38,10,$0E,SAVENAME[TOP]);
  1965.                       END;
  1966.            DOWN : IF (SEL < 8) AND (TOP+SEL-1 < INDEX) THEN
  1967.                     SEL := SUCC(SEL)
  1968.                   ELSE
  1969.                     IF TOP+SEL < INDEX THEN
  1970.                       BEGIN
  1971.                         WINDOW(36,10,50,17);
  1972.                         GOTOXY(1,8);
  1973.                         WRITELN;
  1974.                         WINDOW(1,1,80,25);
  1975.                         TOP := SUCC(TOP);
  1976.                         FW(38,17,$0E,SAVENAME[TOP+SEL-1]);
  1977.                       END;
  1978.            PGDN : IF TOP + 8 <= INDEX THEN
  1979.                     BEGIN
  1980.                       SEL := 1;
  1981.                       TOP := TOP + 8;
  1982.                       WRITE_PAGE;
  1983.                     END;
  1984.            PGUP : IF TOP > 1 THEN
  1985.                     BEGIN
  1986.                       SEL := 1;
  1987.                       TOP := TOP - 8;
  1988.                       IF TOP < 1 THEN TOP := 1;
  1989.                       WRITE_PAGE;
  1990.                     END;
  1991.          DELKEY : IF DEL THEN
  1992.                     BEGIN
  1993.                       SET_ATTR([37..49],SEL+9,$70);
  1994.                       FW(36,21,$8E,' Are You Sure? ');
  1995.                       SET_CURSOR(UNDERLINE);
  1996.                       REPEAT
  1997.                         GOTOXY(50,21);
  1998.                         READCH(CH,FALSE);
  1999.                         CH := UPCASE(CH);
  2000.                       UNTIL CH IN ['Y','N'];
  2001.                       SET_CURSOR(NONE);
  2002.                       IF CH = 'Y' THEN
  2003.                         BEGIN
  2004.                           ASSIGN(F,SAVENAME[TOP+SEL-1]);
  2005.                           {$I-}
  2006.                             ERASE(F);
  2007.                           {$I+}
  2008.                           IF IORESULT = 0 THEN
  2009.                             BEGIN
  2010.                               FOR I := TOP+SEL-1 TO INDEX-1 DO
  2011.                                 SAVENAME[I] := SAVENAME[I+1];
  2012.                               INDEX := PRED(INDEX);
  2013.                               WRITE_PAGE;
  2014.                             END;
  2015.                         END;
  2016.                       FW(37,21,$0F,' <DEL> Delete ');
  2017.                     END;
  2018.     END;
  2019.   UNTIL (CH = RETURN) OR (CH = ESCAPE);
  2020.   IF CH = RETURN THEN
  2021.     GET_FILE_NAME := SAVENAME[TOP+SEL-1]
  2022.   ELSE
  2023.     GET_FILE_NAME := '';
  2024.   CH := 'X';
  2025.   SET_CURSOR(CUR);
  2026.   FILEMODE := FM;
  2027.   TEXTATTR := SAVE_ATTR;
  2028. END;
  2029.  
  2030. PROCEDURE PATHEXEC(COMMAND : PATHSTR; PARMS : STRING);
  2031. VAR
  2032.   P,
  2033.   DIRSTR    : STRING;
  2034.   AllocError: Integer;
  2035.   Regs      : Registers;
  2036.  
  2037.          procedure SetMemTop(MemTop: Pointer); assembler;
  2038.          asm
  2039.              MOV    BX,MemTop.Word[0]
  2040.              ADD    BX,15
  2041.              MOV    CL,4
  2042.              SHR    BX,CL
  2043.              ADD    BX,MemTop.Word[2]
  2044.              MOV    AX,PrefixSeg
  2045.              SUB    BX,AX
  2046.              MOV    ES,AX
  2047.              MOV    AH,4AH
  2048.              INT    21H
  2049.          end;
  2050.  
  2051. BEGIN
  2052.   DIRSTR := GETENV('PATH');
  2053.   P := FSEARCH(COMMAND,DIRSTR);
  2054.   IF P <> '' THEN
  2055.     BEGIN
  2056.       If DynamicPathExec Then
  2057.         SetMemTop(HeapPtr);
  2058.       SWAPVECTORS;
  2059.       EXEC(P,PARMS);
  2060.       SWAPVECTORS;
  2061.       If DynamicPathExec Then
  2062.         SetMemTop(HeapEnd);
  2063.     END
  2064.   ELSE
  2065.     DOSERROR := 2;
  2066. END;
  2067.  
  2068. FUNCTION  COMMA(VAR VALUE; FIELDWIDTH, PLACES : INTEGER; NTYPE : TYPEN) : STRING;
  2069. VAR
  2070.   TEMP           : STRING;
  2071.   I,
  2072.   COMMAPOS,
  2073.   COMMASINSERTED : INTEGER;
  2074.   RNUMBER        : REAL ABSOLUTE VALUE;
  2075.   LNUMBER        : LONGINT ABSOLUTE VALUE;
  2076.   INUMBER        : INTEGER ABSOLUTE VALUE;
  2077. BEGIN
  2078.   IF FIELDWIDTH < 0 THEN FIELDWIDTH := 0;
  2079.   IF PLACES < 0 THEN PLACES := 0;
  2080.   CASE NTYPE OF
  2081.       RNUM : STR(RNUMBER:FIELDWIDTH:PLACES,TEMP);
  2082.       LNUM : BEGIN
  2083.                STR(LNUMBER:FIELDWIDTH,TEMP);
  2084.                PLACES := 0;
  2085.              END;
  2086.       INUM : BEGIN
  2087.                STR(INUMBER:FIELDWIDTH,TEMP);
  2088.                PLACES := 0;
  2089.              END;
  2090.   END;
  2091.   IF PLACES = 0 THEN
  2092.     COMMAPOS := LENGTH(TEMP)-2
  2093.   ELSE
  2094.     COMMAPOS := LENGTH(TEMP)-PLACES-3;
  2095.   COMMASINSERTED := 0;
  2096.   WHILE (COMMAPOS > 1) AND (TEMP[COMMAPOS-1] IN ['0'..'9']) DO
  2097.     BEGIN
  2098.       INSERT(',',TEMP,COMMAPOS);
  2099.       COMMASINSERTED := SUCC(COMMASINSERTED);
  2100.       COMMAPOS := COMMAPOS - 3;
  2101.     END;
  2102.   FOR I := 1 TO COMMASINSERTED DO
  2103.     IF TEMP[1] = ' ' THEN
  2104.       DELETE(TEMP,1,1);
  2105.   COMMA := TEMP;
  2106. END;
  2107.  
  2108. FUNCTION READ_SCREEN(X,Y : INTEGER) : CHAR;
  2109. VAR
  2110.   Z : INTEGER;
  2111. BEGIN
  2112.   Z := (((Y * 160) - 160) + (X * 2)) - 1;
  2113.   READ_SCREEN := P^[Z];
  2114. END;
  2115.  
  2116. FUNCTION SCREEN_ATTR(X,Y : INTEGER) : BYTE;
  2117. VAR
  2118.   Z : INTEGER;
  2119. BEGIN
  2120.   Z := (((Y * 160) - 160) + (X * 2));
  2121.   SCREEN_ATTR := ORD(P^[Z]);
  2122. END;
  2123.  
  2124. PROCEDURE READCHT(VAR CH : CHAR; ECHO : BOOLEAN; TOO : LONGINT);
  2125. VAR
  2126.   T      : LONGINT;
  2127.   HELP   : BOOLEAN;
  2128.   ATX,
  2129.   ATY    : INTEGER;
  2130.   LINE25 : BUF160;
  2131. BEGIN
  2132.   ATX := WHEREX;
  2133.   ATY := WHEREY;
  2134.   START_TIMER(T);
  2135.   HELP := FALSE;
  2136.   SAVE_LINE(25,LINE25);
  2137.   REPEAT
  2138.     IF (SHIFT_KEYS('A')) AND (HELP_LINE <> '') THEN
  2139.       BEGIN
  2140.         FW(1,25,HELP_ATTR,PAD(HELP_LINE,80));
  2141.         GOTOXY(ATX,ATY);
  2142.         HELP := TRUE;
  2143.       END
  2144.     ELSE
  2145.       IF (SHIFT_KEYS('C')) AND (HELP_LINE2 <> '') THEN
  2146.         BEGIN
  2147.           FW(1,25,HELP_ATTR2,PAD(HELP_LINE2,80));
  2148.           GOTOXY(ATX,ATY);
  2149.           HELP := TRUE;
  2150.         END
  2151.       ELSE
  2152.         IF HELP THEN
  2153.           BEGIN
  2154.             REBUILD_LINE(25,LINE25);
  2155.             GOTOXY(ATX,ATY);
  2156.             HELP := FALSE;
  2157.           END;
  2158.   UNTIL KEYPRESSED OR (ELAP_TIME(T) >= TOO) OR (COMMAND_BUFFER <> '');
  2159.   REBUILD_LINE(25,LINE25);
  2160.   IF KEYPRESSED THEN
  2161.     READCH(CH,ECHO);
  2162. END;
  2163.  
  2164. PROCEDURE PRINT_SCREEN(X1,Y1,X2,Y2 : INTEGER; EXT : BOOLEAN);
  2165. VAR
  2166.   CH   : CHAR;
  2167.   I,J  : INTEGER;
  2168. BEGIN
  2169.   IF NOT PRINTER_READY THEN EXIT;
  2170.   FOR I := Y1 TO Y2 DO
  2171.     BEGIN
  2172.       FOR J := X1 TO X2 DO
  2173.         BEGIN
  2174.           CH := READ_SCREEN(J,I);
  2175.           IF (CH IN [' '..'~']) OR EXT THEN
  2176.             WRITE(LST,CH)
  2177.           ELSE
  2178.             WRITE(LST,' ');
  2179.         END;
  2180.       WRITELN(LST);
  2181.     END;
  2182. END;
  2183.  
  2184. FUNCTION PRINTER_READY : BOOLEAN;
  2185. VAR
  2186.   SC : BUFFER;
  2187. BEGIN
  2188.   IF PRINTER_NOT_READY THEN
  2189.     BEGIN
  2190.       SAVE_SCREEN(SC);
  2191.       POP_WINDOW(30,10,57,14,2,$4F);
  2192.       FW(34,11,$CF,'PRINTER NOT READY !!');
  2193.       FW(33,13,$4F,'Ready Printer, or <ESC>');
  2194.       CH := 'X';
  2195.       GOTOXY(56,13);
  2196.       WHILE (CH <> ESCAPE) AND PRINTER_NOT_READY DO
  2197.         IF KEYPRESSED THEN
  2198.           READCH(CH,FALSE);
  2199.       IF CH = ESCAPE THEN
  2200.         PRINTER_READY := FALSE
  2201.       ELSE
  2202.         PRINTER_READY := TRUE;
  2203.       CH := 'X';
  2204.       REBUILD_SCREEN(SC);
  2205.     END
  2206.   ELSE
  2207.     PRINTER_READY := TRUE;
  2208. END;
  2209.  
  2210. FUNCTION COMBINE(S1, S2 : STRING;
  2211.                     MAX : INTEGER;
  2212.            INSERT_COMMA : BOOLEAN) : STRING;
  2213. BEGIN
  2214.   WHILE (S1[LENGTH(S1)] = ' ') AND (LENGTH(S1) > 0) DO
  2215.     DELETE(S1,LENGTH(S1),1);
  2216.   IF INSERT_COMMA THEN
  2217.     S1 := S1 + ', ' + S2
  2218.   ELSE
  2219.     S1 := S1 + ' ' + S2;
  2220.   IF LENGTH(S1) > MAX THEN
  2221.     S1 := COPY(S1,1,MAX)
  2222.   ELSE
  2223.     WHILE LENGTH(S1) < MAX DO
  2224.       S1 := S1 + ' ';
  2225.   COMBINE := S1;
  2226. END;
  2227.  
  2228. PROCEDURE ENCRYPT(VAR LINE : STRING; I : INTEGER);
  2229. BEGIN
  2230.   RANDSEED := I;
  2231.   FOR I := 1 TO LENGTH(LINE) DO
  2232.     LINE[I] := CHR(ORD(LINE[I]) + RANDOM(10));
  2233. END;
  2234.  
  2235. PROCEDURE UN_ENCRYPT(VAR LINE : STRING; I : INTEGER);
  2236. BEGIN
  2237.   RANDSEED := I;
  2238.   FOR I := 1 TO LENGTH(LINE) DO
  2239.     LINE[I] := CHR(ORD(LINE[I]) - RANDOM(10));
  2240. END;
  2241.  
  2242. PROCEDURE CENTER(Y, ATTRIB : INTEGER; LINE : STRING);
  2243. VAR
  2244.   TEMP      : STRING;
  2245. BEGIN
  2246.   TEMP := STRIP(LINE,FALSE);
  2247.   FW(40 - (LENGTH(TEMP) DIV 2),Y,ATTRIB,TEMP);
  2248. END;
  2249.  
  2250. PROCEDURE SET_ATTR_BOX(X1,Y1,X2,Y2,ATT : INTEGER);
  2251. VAR
  2252.   I : INTEGER;
  2253. BEGIN
  2254.   FOR I := Y1 TO Y2 DO
  2255.     SET_ATTR([X1..X2],I,ATT);
  2256. END;
  2257.  
  2258. FUNCTION FILE_OPEN(VAR F) : BOOLEAN;
  2259. VAR
  2260.   FILE_INFO : FILEREC ABSOLUTE F;
  2261. BEGIN
  2262.   FILE_OPEN := FILE_INFO.MODE <> FMCLOSED;
  2263. END;
  2264.  
  2265. PROCEDURE WRITE_X80_Y25(CH : CHAR; ATTRIB : INTEGER);
  2266. BEGIN
  2267.   FW(80,25,ATTRIB,CH);
  2268. END;
  2269.  
  2270. PROCEDURE GET_DOS_VER;
  2271. VAR
  2272.   VER   : WORD;
  2273.   TEMP,
  2274.   TEMP2 : STRING[4];
  2275. BEGIN
  2276.   VER := DOSVERSION;
  2277.   STR(LO(VER),TEMP);
  2278.   STR(HI(VER),TEMP2);
  2279.   DOS_VER := TEMP + '.' + TEMP2;
  2280. END;
  2281.  
  2282. FUNCTION RANDOM_NUMBER(LOW, HIGH : INTEGER) : INTEGER;
  2283. VAR
  2284.   H,M,S,S100 : WORD;
  2285. BEGIN
  2286.   IF (LOW < 0) OR (HIGH > 99) THEN
  2287.     BEGIN
  2288.       RANDOM_NUMBER := 0;
  2289.       EXIT;
  2290.     END;
  2291.   REPEAT
  2292.     GETTIME(H,M,S,S100);
  2293.   UNTIL (S100 >= LOW) AND (S100 <= HIGH);
  2294.   RANDOM_NUMBER := S100;
  2295. END;
  2296.  
  2297. FUNCTION FILE_EXIST(FILENAME : STRING) : BOOLEAN;
  2298. VAR
  2299.   INF : SEARCHREC;
  2300. BEGIN
  2301.   FINDFIRST(FILENAME,ANYFILE-DIRECTORY,INF);
  2302.   FILE_EXIST := (DOSERROR = 0);
  2303. END;
  2304.  
  2305. PROCEDURE BEEP;
  2306. BEGIN
  2307.   SOUND(400);
  2308.   DELAY(150);
  2309.   SOUND(300);
  2310.   DELAY(100);
  2311.   NOSOUND;
  2312. END;
  2313.  
  2314. PROCEDURE READSTR_BIG(X,Y,LEN : INTEGER;
  2315.                         PATTR : INTEGER;
  2316.                        PROMPT : STR80;
  2317.                         IATTR : INTEGER;
  2318.                  VAR INSTRING : STRING;
  2319.                         VALID : ETYPE;
  2320.                       CANEDIT : CTYPE;
  2321.                        EXITCH : ETYPE;
  2322.                        XLOC,
  2323.                        YLOC   : INTEGER;
  2324.                        CH1    : CHAR;
  2325.                        WIN    : INTEGER);
  2326. VAR
  2327.   I,
  2328.   XX,
  2329.   START,
  2330.   OFS    : INTEGER;
  2331.   CAPIT,
  2332.   CAPWO,
  2333.   INSON  : BOOLEAN;
  2334.   SAVECH : CHAR;
  2335.   SX, SY : INTEGER;
  2336.  
  2337. BEGIN
  2338.   OLDVAL := INSTRING;
  2339.   INSON := FALSE;
  2340.   IF X_IN > LEN THEN
  2341.     X_IN := LEN;
  2342.   IF X_IN > WIN THEN
  2343.     OFS   := X_IN
  2344.   ELSE
  2345.     OFS   := 1;                
  2346.   IF OFS + WIN > LEN THEN
  2347.     OFS := LEN - WIN + 1;
  2348.   IF YLOC > 199 THEN
  2349.     BEGIN
  2350.       CAPIT := TRUE;
  2351.       YLOC := YLOC - 200;
  2352.     END
  2353.   ELSE
  2354.     BEGIN
  2355.       CAPIT := FALSE;
  2356.       IF YLOC > 99 THEN
  2357.         BEGIN
  2358.           YLOC := YLOC - 100;
  2359.           CAPWO := TRUE;
  2360.         END
  2361.       ELSE
  2362.         CAPWO := FALSE;
  2363.     END;
  2364.   IF CLEAR IN EXITCH THEN
  2365.     INSTRING := SPACES(LEN)
  2366.   ELSE
  2367.     INSTRING := PAD(INSTRING,LEN);
  2368.   FW(X,Y,PATTR,PROMPT);
  2369.   START := X + LENGTH(PROMPT);
  2370.   IF X_IN > WIN THEN
  2371.     X := X_IN - OFS + 1
  2372.   ELSE
  2373.     X := X_IN;
  2374.   FW(START,Y,IATTR,COPY(INSTRING,OFS,WIN));
  2375.   IF XLOC > 99 THEN
  2376.     BEGIN
  2377.       X := LEN;
  2378.       XLOC := XLOC - 100;
  2379.     END;                
  2380.  
  2381.   SET_CURSOR(UNDERLINE);
  2382.   SX := UT.TIMEX;
  2383.   SY := UT.TIMEY;
  2384.   UT.TIMEX := XLOC;
  2385.   UT.TIMEY := YLOC;
  2386.   IF NOT (DISPLAY IN EXITCH) THEN
  2387.     REPEAT
  2388.  
  2389.       FW(START,Y,IATTR,COPY(INSTRING,OFS,WIN));
  2390.  
  2391.       GOTOXY(START+X-1,Y);
  2392.       CH := CH1;
  2393.       READCH(CH,FALSE);
  2394.       SAVECH := CH;
  2395.       CASE CH OF
  2396.           HOMEKEY : BEGIN
  2397.                       OFS := 1;
  2398.                       X := 1;
  2399.                     END;
  2400.            ENDKEY : BEGIN
  2401.                       X := LEN;
  2402.                       WHILE (X > 2) AND (INSTRING[X-1] = ' ') DO
  2403.                         X := PRED(X);
  2404.                       IF (X = 1) AND (INSTRING[1] = ' ') THEN
  2405.                         X := 1;
  2406.                       OFS := X - (WIN - 2);
  2407.                       IF OFS < 1 THEN OFS := 1;
  2408.                       X := WIN;
  2409.                       WHILE (X > 1) AND (INSTRING[X+OFS-2] = ' ') DO
  2410.                         X := PRED(X);
  2411.                       IF X + OFS > LEN THEN
  2412.                         OFS := PRED(OFS);
  2413.                     END;
  2414.                #8 : IF (X > 1) THEN
  2415.                       BEGIN
  2416.                         DELETE(INSTRING,X-1+OFS-1,1);
  2417.                         INSTRING := INSTRING + ' ';
  2418.                         X := PRED(X);
  2419.                       END
  2420.                     ELSE
  2421.                       IF X > 1 THEN
  2422.                         X := PRED(X)
  2423.                       ELSE
  2424.                         BEGIN
  2425.                           SAVECH := CH;
  2426.                           IF NOCONV IN EXITCH THEN
  2427.                             CH := NOCONV
  2428.                           ELSE
  2429.                             CH := UP;
  2430.                         END;
  2431.             RIGHT : IF X < WIN THEN
  2432.                       X := SUCC(X)
  2433.                     ELSE
  2434.                       IF OFS + WIN <= LEN THEN
  2435.                         OFS := SUCC(OFS)
  2436.                       ELSE
  2437.                         BEGIN
  2438.                           SAVECH := CH;
  2439.                           IF NOCONV IN EXITCH THEN
  2440.                             CH := NOCONV
  2441.                           ELSE
  2442.                             CH := DOWN;
  2443.                         END;
  2444.              LEFT : IF X > 1 THEN
  2445.                       X := PRED(X)
  2446.                     ELSE
  2447.                       IF OFS > 1 THEN
  2448.                         OFS := PRED(OFS)
  2449.                       ELSE
  2450.                         BEGIN
  2451.                           SAVECH := CH;
  2452.                           IF NOCONV IN EXITCH THEN
  2453.                             CH := NOCONV
  2454.                           ELSE
  2455.                             CH := UP;
  2456.                         END;
  2457.          ' '..'~' : IF CH IN VALID THEN
  2458.                       IF INSON THEN
  2459.                         BEGIN
  2460.                           IF INSTRING[LEN] = ' ' THEN
  2461.                             BEGIN
  2462.                               DELETE(INSTRING,LENGTH(INSTRING),1);
  2463.                               IF (CAPWO AND ((X = 1) OR (INSTRING[X+OFS-2] = ' '))) OR
  2464.                                  CAPIT THEN
  2465.                                 CH := UPCASE(CH);
  2466.                               INSERT(CH,INSTRING,X+OFS-1);
  2467.                               IF X < WIN THEN
  2468.                                 X := SUCC(X)
  2469.                               ELSE
  2470.                                 IF OFS + WIN <= LEN THEN
  2471.                                   OFS := SUCC(OFS)
  2472.                                 ELSE
  2473.                                   BEGIN
  2474.                                     SAVECH := RIGHT;
  2475.                                     IF NOCONV IN EXITCH THEN
  2476.                                       CH := NOCONV
  2477.                                     ELSE
  2478.                                       CH := DOWN;
  2479.                                   END;
  2480.                             END
  2481.                           ELSE
  2482.                             BEEP;
  2483.                         END
  2484.                       ELSE
  2485.                         BEGIN
  2486.                           IF (CAPWO AND ((X = 1) OR (INSTRING[X+OFS-2] = ' '))) OR
  2487.                              CAPIT THEN
  2488.                             CH := UPCASE(CH);
  2489.                           INSTRING[X+OFS-1] := CH;
  2490.                           IF X < WIN THEN
  2491.                             X := SUCC(X)
  2492.                           ELSE
  2493.                             IF OFS + WIN <= LEN THEN
  2494.                               OFS := SUCC(OFS)
  2495.                             ELSE
  2496.                               BEGIN
  2497.                                 SAVECH := RIGHT;
  2498.                                 IF NOCONV IN EXITCH THEN
  2499.                                   CH := NOCONV
  2500.                                 ELSE
  2501.                                   CH := DOWN;
  2502.                               END;
  2503.                         END;
  2504.            INSKEY : BEGIN
  2505.                       INSON := NOT INSON;
  2506.                       IF INSON THEN
  2507.                         SET_CURSOR(BLOCK)
  2508.                       ELSE
  2509.                         BEGIN
  2510.                           SET_CURSOR(UNDERLINE);
  2511.                           INSON := FALSE;
  2512.                         END;
  2513.                     END;
  2514.            DELKEY : BEGIN
  2515.                       DELETE(INSTRING,X+OFS-1,1);
  2516.                       INSTRING := INSTRING + ' ';
  2517.                       GOTOXY(START,Y);
  2518.                     END;
  2519.             ALT_C : BEGIN
  2520.                       FOR I := 1 TO LEN DO
  2521.                         INSTRING[I] := ' ';
  2522.                       X := 1;
  2523.                       OFS := 1;
  2524.                     END;
  2525.       END;
  2526.       FW(START,Y,IATTR,COPY(INSTRING,OFS,WIN));
  2527.       IF X > LEN THEN X := LEN;
  2528.     UNTIL (CH = #27) OR (CH IN EXITCH);
  2529.   UT.TIMEX := SX;
  2530.   UT.TIMEY := SY;
  2531.   IF NOCONV IN EXITCH THEN
  2532.     CH := SAVECH;
  2533.   X_IN := 1;
  2534.   X_OUT := X+OFS-1;
  2535.   SET_CURSOR(UNDERLINE);
  2536.   CHANGED := INSTRING <> OLDVAL;
  2537. END;
  2538.  
  2539. PROCEDURE CENTER_PRINT(LINE     : STRING;
  2540.                         LEN     : INTEGER;
  2541.                     VAR NEXTPOS : INTEGER;
  2542.                         CR      : BOOLEAN);
  2543. BEGIN
  2544.   NEXTPOS := ((LEN DIV 2) + (LENGTH(LINE) DIV 2)) + 1;
  2545.   IF CR THEN
  2546.     WRITELN(LST,LINE:NEXTPOS-1)
  2547.   ELSE
  2548.     WRITE(LST,LINE:NEXTPOS-1);
  2549. END;
  2550.  
  2551. PROCEDURE CLEAR_BUFFER(VAR SCREEN : BUFFER;
  2552.                          ATTR : INTEGER);
  2553. VAR
  2554.   I : INTEGER;
  2555. BEGIN
  2556.   I := 1;
  2557.   REPEAT
  2558.     SCREEN[I] := ' ';
  2559.     SCREEN[I+1] := CHAR(ATTR);
  2560.     I := I + 2;
  2561.   UNTIL I > 3999;
  2562. END;
  2563.  
  2564. PROCEDURE FWB(VAR SCREEN : BUFFER;
  2565.                 X,Y,ATTR : INTEGER;
  2566.                 INSTRING : STR80);
  2567. VAR
  2568.   I,Z : INTEGER;
  2569. BEGIN
  2570.   Z := (((Y * 160) - 160) + (X * 2)) - 1;
  2571.   FOR I := 1 TO LENGTH(INSTRING) DO
  2572.     IF Z < 4000 THEN
  2573.       BEGIN
  2574.         SCREEN[Z] := INSTRING[I];
  2575.         SCREEN[Z+1] := CHR(ATTR);
  2576.         Z := Z + 2;
  2577.       END;
  2578. END;
  2579.  
  2580. FUNCTION CREATE_NEW_FILE(FILENAME, MESS : STR80) : BOOLEAN;
  2581. VAR
  2582.   CH : CHAR;
  2583.   SC : BUFFER;
  2584. BEGIN
  2585.   SAVE_SCREEN(SC);
  2586.   FW(10,15,$04,'╒══════════════════════════════════════════════════╕');
  2587.   FW(10,16,$04,'│               FILE NOT FOUND !!                  │');
  2588.   FW(10,17,$04,'│                                                  │');
  2589.   FW(10,18,$04,'│                                                  │');
  2590.   FW(10,19,$04,'│                                                  │');
  2591.   FW(10,20,$04,'│   Contact:                                       │');
  2592.   FW(10,21,$04,'│                                                  │');
  2593.   FW(10,22,$04,'│        Press <any Key> to Abort Program          │');
  2594.   FW(10,23,$04,'╘══════════════════════════════════════════════════╛');
  2595.   FW(28,18,$0F,FILENAME);
  2596.   FW(23,20,$0F,MESS);
  2597.   GOTOXY(52,22);
  2598.   WHILE KEYPRESSED DO
  2599.     CH := READKEY;
  2600.   READCH(CH,FALSE);
  2601.   CREATE_NEW_FILE := CH = AF1;
  2602.   REBUILD_SCREEN(SC);
  2603. END;
  2604.  
  2605. FUNCTION INT_STR(I,LEN : INTEGER) : STR80;
  2606. VAR
  2607.   TEMP   : STR80;
  2608. BEGIN
  2609.   STR(I:LEN,TEMP);
  2610.   INT_STR := TEMP;
  2611. END;
  2612.  
  2613. FUNCTION REAL_STR(R : REAL; LEN, PLACES : INTEGER) : STR80;
  2614. VAR
  2615.   TEMP   : STR80;
  2616. BEGIN
  2617.   STR(R:LEN:PLACES,TEMP);
  2618.   REAL_STR := TEMP;
  2619. END;
  2620.  
  2621. FUNCTION LONGINT_STR(I : LONGINT; LEN : INTEGER) : STR80;
  2622. VAR
  2623.   TEMP   : STR80;
  2624. BEGIN
  2625.   STR(I:LEN,TEMP);
  2626.   LONGINT_STR := TEMP;
  2627. END;
  2628.  
  2629. FUNCTION DATE_TIME_KEY : STR16;
  2630. VAR
  2631.   YEAR, MON, DAY, DOW,
  2632.   HOUR, MIN, SEC, SEC100 : WORD;
  2633.   TEMP1,
  2634.   TEMP2                  : STR16;
  2635. BEGIN
  2636.   GETDATE(YEAR,MON,DAY,DOW);
  2637.   GETTIME(HOUR,MIN,SEC,SEC100);
  2638.   STR(YEAR:4,TEMP1);
  2639.   STR(MON:2,TEMP2);
  2640.   IF TEMP2[1] = ' ' THEN TEMP2[1] := '0';
  2641.   TEMP1 := TEMP1 + TEMP2;
  2642.   STR(DAY:2,TEMP2);
  2643.   IF TEMP2[1] = ' ' THEN TEMP2[1] := '0';
  2644.   TEMP1 := TEMP1 + TEMP2;
  2645.   STR(HOUR:2,TEMP2);
  2646.   IF TEMP2[1] = ' ' THEN TEMP2[1] := '0';
  2647.   TEMP1 := TEMP1 + TEMP2;
  2648.   STR(MIN:2,TEMP2);
  2649.   IF TEMP2[1] = ' ' THEN TEMP2[1] := '0';
  2650.   TEMP1 := TEMP1 + TEMP2;
  2651.   STR(SEC:2,TEMP2);
  2652.   IF TEMP2[1] = ' ' THEN TEMP2[1] := '0';
  2653.   TEMP1 := TEMP1 + TEMP2;
  2654.   STR(SEC100:2,TEMP2);
  2655.   IF TEMP2[1] = ' ' THEN TEMP2[1] := '0';
  2656.   TEMP1 := TEMP1 + TEMP2;
  2657.   DATE_TIME_KEY := TEMP1;
  2658. END;
  2659.  
  2660. FUNCTION STRIP(ST : STRING; IMBED : BOOLEAN) : STRING;
  2661. BEGIN
  2662.   WHILE (LENGTH(ST) > 0) AND (ST[1] = ' ') DO
  2663.     DELETE(ST,1,1);
  2664.   WHILE (LENGTH(ST) > 0) AND (ST[LENGTH(ST)] = ' ') DO
  2665.     DELETE(ST,LENGTH(ST),1);
  2666.   IF IMBED THEN
  2667.     WHILE POS('  ',ST) > 0 DO
  2668.       DELETE(ST,POS('  ',ST),1);
  2669.   STRIP := ST;
  2670. END;
  2671.  
  2672. FUNCTION KEY_TO_DATE(ST : STRING) : STRING;
  2673. VAR
  2674.   INT : INTEGER;
  2675.   IND : STRING[2];
  2676.   TMP : STRING[2];
  2677. BEGIN
  2678.   INT := _INTEGER(COPY(ST,9,2));
  2679.   IF INT > 11 THEN
  2680.     IND := 'pm'
  2681.   ELSE
  2682.     IND := 'am';
  2683.   IF INT > 12 THEN
  2684.     INT := INT - 12;
  2685.   TMP := INT_STR(INT,2);
  2686.   IF TMP[1] = ' ' THEN TMP[1] := '0';
  2687.   KEY_TO_DATE := COPY(ST,5,2)+'-'+COPY(ST,7,2)+'-'+COPY(ST,1,4)+' '+
  2688.                   TMP+':'+COPY(ST,11,2)+' '+IND;
  2689. END;
  2690.  
  2691. function Julian(DT : STR8) : longint;
  2692. var
  2693.    Temp, Y, M, D  : longint;
  2694.    Year, Mon, Day : integer;
  2695. begin
  2696.    YEAR := _INTEGER(COPY(DT,7,2));
  2697.    MON  := _INTEGER(COPY(DT,1,2));
  2698.    DAY  := _INTEGER(COPY(DT,4,2));
  2699.    if (Year < 0) or (Mon < 1) or (Mon > 12)             {Mod. #1}
  2700.                  or (Day < 1) or (Day > 31) then
  2701.       begin
  2702.          Julian := -1;
  2703.          exit
  2704.       end;
  2705.    Y := Year;  M := Mon;  D := Day;
  2706.    if Y < 100 then Y := Y + 1900;                       {Mod. #1}
  2707.    Temp   := (M - 14) div 12;
  2708.    Julian := D - 32075 +
  2709.              (1461 * (Y + 4800 + Temp) div 4) +
  2710.              (367 * (M - 2 - Temp * 12) div 12) -
  2711.              (3 * ((Y + 4900 + Temp) div 100) div 4)
  2712. end;
  2713.  
  2714. FUNCTION JulToMDY(JulianDay: longint) : STR8;
  2715. var
  2716.    TempA, TempB, TempC : longint;
  2717.    MON, YEAR, DAY      : INTEGER;
  2718.    TEMP                : STRING[10];
  2719. begin
  2720.    TempA := JulianDay + 68569;
  2721.    TempB := 4 * TempA div 146097;
  2722.    TempA := TempA - (146097 * TempB + 3) div 4;
  2723.    Year  := 4000 * (TempA + 1) div 1461001;
  2724.    TempC := Year;
  2725.    TempA := TempA - (1461 * TempC div 4) + 31;
  2726.    Mon   := 80 * TempA div 2447;
  2727.    TempC := Mon;
  2728.    Day   := TempA - (2447 * TempC div 80);
  2729.    TempA := Mon div 11;
  2730.    Mon   := Mon + 2 - (12 * TempA);
  2731.    Year  := 100 * (TempB - 49) + Year + TempA;
  2732.    TEMP := INT_STR(MON,2) + '-' + INT_STR(DAY,2) + '-' + INT_STR(YEAR,4);
  2733.    IF TEMP[1] = ' ' THEN TEMP[1] := '0';
  2734.    IF TEMP[4] = ' ' THEN TEMP[4] := '0';
  2735.    DELETE(TEMP,7,2);
  2736.    JULTOMDY := TEMP;
  2737. end;
  2738.  
  2739. procedure DayWeek(DT : STR8; var DayNum: integer;
  2740.                   var DayName: Str3);
  2741. VAR
  2742.   CENTURY,
  2743.   Tmp      : Integer;
  2744.   YEAR,
  2745.   MONTH,
  2746.   DAY      : WORD;
  2747. Begin
  2748.   VAL(COPY(DT,7,2),YEAR,TMP);
  2749.   VAL(COPY(DT,1,2),MONTH,TMP);
  2750.   VAL(COPY(DT,4,2),DAY,TMP);
  2751.   If Year < 1900 then
  2752.      Inc(Year,1900);
  2753.   If Month < 3 then
  2754.      Inc(Month, 10)
  2755.   else
  2756.      Dec(Month, 2);
  2757.   If Month > 10 then
  2758.      Dec(Year);
  2759.   Century := Year div 100;
  2760.   Year := Year mod 100;
  2761.   Tmp := Trunc((2.6 * Month - 0.2) + Day + Year + (Year div 4) +
  2762.      (Century div 4) - (2 * Century));
  2763.   DAYNUM := (Tmp + 777) mod 7;
  2764.   CASE DAYNUM OF
  2765.       0 : DAYNAME := 'Sun';
  2766.       1 : DAYNAME := 'Mon';
  2767.       2 : DAYNAME := 'Tue';
  2768.       3 : DAYNAME := 'Wed';
  2769.       4 : DAYNAME := 'Thu';
  2770.       5 : DAYNAME := 'Fri';
  2771.       6 : DAYNAME := 'Sat';
  2772.   END;
  2773. End;
  2774.  
  2775. FUNCTION DUP(MASK : CHAR; N : INTEGER) : STRING;
  2776. VAR
  2777.   ST : STRING;
  2778. BEGIN
  2779.   FILLCHAR(ST,SIZEOF(ST),MASK);
  2780.   IF (N < 256) AND (N > 0) THEN
  2781.     ST[0] := CHR(N)
  2782.   ELSE
  2783.     ST[0] := CHR(0);
  2784.   DUP := ST;
  2785. END;
  2786.  
  2787. PROCEDURE POP_WINDOW(X1,Y1,X2,Y2 : INTEGER; STYLE : INTEGER; ATTR : BYTE);
  2788. VAR
  2789.   I,
  2790.   SHADOW       : BYTE;
  2791.   URCORNER,
  2792.   ULCORNER,
  2793.   LRCORNER,
  2794.   LLCORNER,
  2795.   VERTICAL,
  2796.   HORIZONTAL   : CHAR;
  2797. BEGIN
  2798.   CASE STYLE OF
  2799.      0,
  2800.     10 : BEGIN
  2801.            URCORNER   := ' ';
  2802.            ULCORNER   := ' ';
  2803.            LRCORNER   := ' ';
  2804.            LLCORNER   := ' ';
  2805.            VERTICAL   := ' ';
  2806.            HORIZONTAL := ' ';
  2807.          END;
  2808.      1,
  2809.     11  : BEGIN
  2810.            URCORNER   := '┐';
  2811.            ULCORNER   := '┌';
  2812.            LRCORNER   := '┘';
  2813.            LLCORNER   := '└';
  2814.            VERTICAL   := '│';
  2815.            HORIZONTAL := '─';
  2816.          END;
  2817.     ELSE BEGIN
  2818.            URCORNER   := '╗';
  2819.            ULCORNER   := '╔';
  2820.            LRCORNER   := '╝';
  2821.            LLCORNER   := '╚';
  2822.            VERTICAL   := '║';
  2823.            HORIZONTAL := '═';
  2824.          END;
  2825.   END;
  2826.   FW(X1,Y1,ATTR,ULCORNER+DUP(HORIZONTAL,X2-X1-1)+URCORNER);
  2827.   FOR I := Y1 + 1 TO Y2 - 1 DO
  2828.     FW(X1,I,ATTR,VERTICAL+DUP(' ',X2-X1-1)+VERTICAL);
  2829.   FW(X1,Y2,ATTR,LLCORNER+DUP(HORIZONTAL,X2-X1-1)+LRCORNER);
  2830.  
  2831.   IF STYLE < 10 THEN
  2832.     IF (X2 < 80) AND (Y2 < 25) THEN
  2833.       BEGIN
  2834.         SHADOW := $07;
  2835.         IF Y2 < 25 THEN
  2836.           SET_ATTR([X1+2..X2+2],Y2+1,SHADOW);
  2837.         FOR I := Y1 + 1 TO Y2 + 1 DO
  2838.           IF I <= 25 THEN
  2839.             SET_ATTR([X2+1,X2+2],I,SHADOW);
  2840.       END;
  2841. END;
  2842.  
  2843. FUNCTION GET_FILE_INFO(FILENAME : STRING) : STR80;
  2844. VAR
  2845.   F         : FILE OF BYTE;
  2846.   SAVE_MODE : BYTE;
  2847.   DT        : DATETIME;
  2848.   DATE,
  2849.   SIZE      : LONGINT;
  2850.                                  
  2851.        FUNCTION CONVERT_DATE : STRING;
  2852.        VAR
  2853.          IND         : CHAR;
  2854.          TEMP, TEMP2 : STRING;
  2855.        BEGIN
  2856.          UNPACKTIME(DATE,DT);
  2857.          STR(DT.MONTH:2,TEMP2);
  2858.          STR(DT.DAY:2,TEMP);
  2859.          IF TEMP[1] = ' ' THEN TEMP[1] := '0';
  2860.          TEMP2 := TEMP2 + '-' + TEMP;
  2861.          STR(DT.YEAR:4,TEMP);
  2862.          TEMP2 := TEMP2 + '-' + COPY(TEMP,3,2);
  2863.          IF DT.HOUR >= 12 THEN
  2864.            BEGIN
  2865.              IND := 'p';
  2866.              IF DT.HOUR > 12 THEN
  2867.                DT.HOUR := DT.HOUR - 12;
  2868.            END
  2869.          ELSE
  2870.            IND := 'a';
  2871.          STR(DT.HOUR:2,TEMP);
  2872.          TEMP2 := TEMP2 + ' ' + TEMP + ':';
  2873.          STR(DT.MIN:2,TEMP);
  2874.          IF TEMP[1] = ' ' THEN TEMP[1] := '0';
  2875.          TEMP2 := TEMP2 + TEMP + IND;
  2876.          IF (DT.HOUR=0) AND (DT.MIN=0) AND (DT.SEC=0) THEN
  2877.            BEGIN
  2878.              TEMP2 := COPY(TEMP2,1,10);
  2879.              TEMP2 := TEMP2 + SPACES(5);
  2880.            END;
  2881.          CONVERT_DATE := TEMP2;
  2882.        END;
  2883.  
  2884. BEGIN
  2885.   SAVE_MODE := FILEMODE;
  2886.   FILEMODE  := 0;
  2887.   ASSIGN(F,FILENAME);
  2888.   {$I-}
  2889.     RESET(F);
  2890.   {$I+}
  2891.   IF IORESULT = 0 THEN
  2892.     BEGIN
  2893.       SIZE := FILESIZE(F);
  2894.       GETFTIME(F,DATE);
  2895.       CLOSE(F);
  2896.       GET_FILE_INFO := LONGINT_STR(SIZE,9)+' '+CONVERT_DATE;
  2897.     END
  2898.   ELSE
  2899.     GET_FILE_INFO := '';
  2900.   FILEMODE := SAVE_MODE;
  2901. END;
  2902.  
  2903. PROCEDURE SAVE_LINE(Y : INTEGER; VAR STR : BUF160);
  2904. VAR
  2905.   Z : INTEGER;
  2906. BEGIN
  2907.   Z := (((Y * 160) - 160) + 2) - 1;
  2908.   MOVE(P^[Z],STR,160);
  2909. END;
  2910.  
  2911. PROCEDURE REBUILD_LINE(Y : INTEGER; STR : BUF160);
  2912. VAR
  2913.   Z : INTEGER;
  2914. BEGIN
  2915.   Z := (((Y * 160) - 160) + 2) - 1;
  2916.   MOVE(STR,P^[Z],160);
  2917. END;
  2918.  
  2919. PROCEDURE FILL_SCREEN(X1,Y1,X2,Y2 : INTEGER; CH : CHAR; ATTR : INTEGER);
  2920. VAR
  2921.   X,Y,
  2922.   Z   : INTEGER;
  2923.   SC  : BUFFER;
  2924. BEGIN
  2925.   SAVE_SCREEN(SC);
  2926.   FOR Y := Y1 TO Y2 DO
  2927.     FOR X := X1 TO X2 DO
  2928.       BEGIN
  2929.         Z := (((Y * 160) - 160) + (X * 2)) - 1;
  2930.         SC[Z] := CH;
  2931.         SC[Z+1] := CHR(ATTR);
  2932.       END;
  2933.   REBUILD_SCREEN(SC);
  2934. END;
  2935.  
  2936. FUNCTION PROGRAM_LOCATION : STRING;
  2937. VAR
  2938.   TEMP,
  2939.   DIR,
  2940.   NAME,
  2941.   EXT    : STRING;
  2942. BEGIN
  2943.   TEMP := PARAMSTR(0);
  2944.   FSPLIT(TEMP,DIR,NAME,EXT);
  2945.   PROGRAM_LOCATION := DIR;
  2946. END;
  2947.  
  2948. PROCEDURE REBOOT;
  2949. BEGIN
  2950. INLINE(
  2951.   $B8/$40/$00/
  2952.   $8E/$D8/
  2953.   $C7/$06/$72/$00/$34/$12/
  2954.   $EA/$00/$00/$FF/$FF);
  2955. END;
  2956.  
  2957. procedure SetBlink(On : Boolean);
  2958.   {-Enable text mode attribute blinking if On is True}
  2959. const
  2960.   PortVal : array[0..4] of Byte = ($0C, $08, $0D, $09, $09);
  2961. var
  2962.   PortNum : Word;
  2963.   Index : Byte;
  2964.   PVal : Byte;
  2965. begin
  2966.   IF EGA_PRESENT THEN
  2967.     begin
  2968.         inline(
  2969.           $8A/$5E/<On/     {mov bl,[bp+<On]}
  2970.           $B8/$03/$10/     {mov ax,$1003}
  2971.           $CD/$10);        {int $10}
  2972.         Exit;
  2973.     end
  2974.   ELSE
  2975.     IF CGA_PRESENT THEN
  2976.       begin
  2977.         PortNum := $3D8;
  2978.         case LastMode of
  2979.           0..3 : Index := LastMode;
  2980.           else Exit;
  2981.         end;
  2982.       end
  2983.     ELSE
  2984.       begin
  2985.         PortNum := $3B8;
  2986.         Index := 4;
  2987.       end;
  2988.   PVal := PortVal[Index];
  2989.   if On then
  2990.     PVal := PVal or $20;
  2991.   Port[PortNum] := PVal;
  2992. end;
  2993.  
  2994. PROCEDURE BLINK_OFF;
  2995. BEGIN
  2996.   SetBlink(False);
  2997.   BLINK_IS_ON := FALSE;
  2998. END;
  2999.  
  3000. PROCEDURE BLINK_ON;
  3001. BEGIN
  3002.   SetBlink(True);
  3003.   BLINK_IS_ON := TRUE;
  3004. END;
  3005.  
  3006. PROCEDURE SET_BORDER(COLOR : INTEGER);
  3007. VAR
  3008.   REGS         : REGISTERS;
  3009.   MONITOR_INFO : BYTE;
  3010. BEGIN
  3011.   MONITOR_INFO := MEM[SEG0040:$0010];
  3012.   CURRENT_BORDER := COLOR;
  3013.   IF (EGA_PRESENT) OR (VGA_PRESENT) THEN
  3014.     BEGIN
  3015.       REGS.AH := $10;
  3016.       REGS.AL := 1;
  3017.       REGS.BH := COLOR;
  3018.       INTR($10,REGS);
  3019.     END
  3020.   ELSE
  3021.     PORT[$03D9]:=15 AND COLOR;
  3022. END;
  3023.  
  3024. PROCEDURE SCREEN_ON;
  3025. VAR
  3026.   REGS         : REGISTERS;
  3027.   MONITOR_INFO : BYTE;
  3028. BEGIN
  3029.   MONITOR_INFO := MEM[SEG0040:$0010];
  3030.   IF EGA_PRESENT OR VGA_PRESENT THEN
  3031.     BEGIN
  3032.       REGS.AH := $12;
  3033.       REGS.AL := 0;
  3034.       REGS.BL := $36;
  3035.       INTR($10,REGS);
  3036.     END
  3037.   ELSE
  3038.     BEGIN
  3039.       IF MONITOR_INFO AND 48 = 48 THEN
  3040.         PORT[952]:=255
  3041.       ELSE
  3042.         PORT[984]:=41;
  3043.     END;
  3044.   SET_BORDER(CURRENT_BORDER);
  3045. END;
  3046.  
  3047. PROCEDURE SCREEN_OFF;
  3048. VAR
  3049.   REGS         : REGISTERS;
  3050.   MONITOR_INFO : BYTE;
  3051. BEGIN
  3052.   MONITOR_INFO := MEM[SEG0040:$0010];
  3053.   IF EGA_PRESENT OR VGA_PRESENT THEN
  3054.     BEGIN
  3055.       REGS.AH := $12;
  3056.       REGS.AL := 1;
  3057.       REGS.BL := $36;
  3058.       INTR($10,REGS);
  3059.     END
  3060.   ELSE
  3061.     BEGIN
  3062.       IF MONITOR_INFO AND 48 = 48 THEN
  3063.         PORT[952]:=1
  3064.       ELSE
  3065.         PORT[984]:=1;
  3066.     END;
  3067.   IF (EGA_PRESENT) OR (VGA_PRESENT) THEN
  3068.     BEGIN
  3069.       REGS.AH := $10;
  3070.       REGS.AL := 1;
  3071.       REGS.BH := 0;
  3072.       INTR($10,REGS);
  3073.     END
  3074.   ELSE
  3075.     PORT[$03D9]:=15 AND 0;
  3076. END;
  3077.  
  3078. PROCEDURE POP_MESSAGE(X,Y : INTEGER; BORDER, ATTR : BYTE;
  3079.                          MATTR : BYTE; MESSAGE : STR80);
  3080. BEGIN
  3081.   IF X = 0 THEN
  3082.     X := 40 - ((LENGTH(MESSAGE) + 3) DIV 2);
  3083.   POP_WINDOW(X,Y,X+LENGTH(MESSAGE)+3,Y+2,BORDER,ATTR);
  3084.   FW(X+2,Y+1,MATTR,MESSAGE);
  3085.   GOTOXY(X+LENGTH(MESSAGE)+2,Y+1);
  3086. END;
  3087.  
  3088. PROCEDURE POP_WINDOW_TITLE(   X,Y,X1,Y1 : INTEGER;
  3089.                            BORDER, ATTR : BYTE;
  3090.                                   TATTR,
  3091.                                      TY : BYTE;
  3092.                                   TITLE : STR80);
  3093. BEGIN
  3094.   POP_WINDOW(X,Y,X1,Y1,BORDER,ATTR);
  3095.   FW((X+((X1-X) DIV 2) - (LENGTH(TITLE) DIV 2)),TY,TATTR,+' '+TITLE+' ');
  3096. END;
  3097.  
  3098. FUNCTION SHIFT_KEYS(KEY : CHAR) : BOOLEAN;
  3099.  { KEY = 'R' for Right, 'L' for Left, 'C' for Control, 'A' for Alt }
  3100. VAR
  3101.   KEYBOARD : BYTE;
  3102. BEGIN
  3103.   KEYBOARD := MEM[SEG0040:$0017];
  3104.   CASE UPCASE(KEY) OF
  3105.      'R' : SHIFT_KEYS := KEYBOARD AND 1 = 1;
  3106.      'L' : SHIFT_KEYS := KEYBOARD AND 2 = 2;
  3107.      'C' : SHIFT_KEYS := KEYBOARD AND 4 = 4;
  3108.      'A' : SHIFT_KEYS := KEYBOARD AND 8 = 8;
  3109.   END;
  3110. END;
  3111.  
  3112. procedure MasterEnv;
  3113.   {-Return master environment record}
  3114. var
  3115.   Owner : Word;
  3116.   Mcb : Word;
  3117.   Eseg : Word;
  3118.   Done : Boolean;
  3119. begin
  3120.   with Env_Rec do begin
  3121.     FillChar(Env_Rec, SizeOf(Env_Rec), 0);
  3122.  
  3123.     {Interrupt $2E points into COMMAND.COM}
  3124.     Owner := MemW[0:(2+4*$2E)];
  3125.  
  3126.     {Mcb points to memory control block for COMMAND}
  3127.     Mcb := Owner-1;
  3128.     if (Mem[Mcb:0] <> Byte('M')) or (MemW[Mcb:1] <> Owner) then
  3129.       Exit;
  3130.  
  3131.     {Read segment of environment from PSP of COMMAND}
  3132.     Eseg := MemW[Owner:$2C];
  3133.  
  3134.     {Earlier versions of DOS don't store environment segment there}
  3135.     if Eseg = 0 then begin
  3136.       {Master environment is next block past COMMAND}
  3137.       Mcb := Owner+MemW[Mcb:3];
  3138.       if (Mem[Mcb:0] <> Byte('M')) or (MemW[Mcb:1] <> Owner) then
  3139.         {Not the right memory control block}
  3140.         Exit;
  3141.       Eseg := Mcb+1;
  3142.     end else
  3143.       Mcb := Eseg-1;
  3144.  
  3145.     {Return segment and length of environment}
  3146.     EnvSeg := Eseg;
  3147.     EnvLen := MemW[Mcb:3] shl 4;
  3148.   end;
  3149. end;
  3150.  
  3151. procedure SkipAsciiZ(EPtr : EnvArrayPtr; var EOfs : Word);
  3152.   {-Skip to end of current AsciiZ string}
  3153. begin
  3154.   while EPtr^[EOfs] <> #0 do
  3155.     Inc(EOfs);
  3156. end;
  3157.  
  3158. function EnvNext(EPtr : EnvArrayPtr) : Word;
  3159.   {-Return the next available location in environment at EPtr^}
  3160. var
  3161.   EOfs : Word;
  3162. begin
  3163.   EOfs := 0;
  3164.   if EPtr <> nil then begin
  3165.     while EPtr^[EOfs] <> #0 do begin
  3166.       SkipAsciiZ(EPtr, EOfs);
  3167.       Inc(EOfs);
  3168.     end;
  3169.   end;
  3170.   EnvNext := EOfs;
  3171. end;
  3172.  
  3173. function SearchEnv(EPtr : EnvArrayPtr;
  3174.                    var Search : string) : Word;
  3175.   {-Return the position of Search in environment, or $FFFF if not found.
  3176.     Prior to calling SearchEnv, assure that
  3177.       EPtr is not nil,
  3178.       Search is not empty
  3179.   }
  3180. var
  3181.   SLen : Byte absolute Search;
  3182.   EOfs : Word;
  3183.   MOfs : Word;
  3184.   SOfs : Word;
  3185.   Match : Boolean;
  3186. begin
  3187.   {Force upper case search}
  3188.   Search := UPPERCASE(Search);
  3189.  
  3190.   {Assure search string ends in =}
  3191.   if Search[SLen] <> '=' then begin
  3192.     Inc(SLen);
  3193.     Search[SLen] := '=';
  3194.   end;
  3195.  
  3196.   EOfs := 0;
  3197.   while EPtr^[EOfs] <> #0 do begin
  3198.     {At the start of a new environment element}
  3199.     SOfs := 1;
  3200.     MOfs := EOfs;
  3201.     repeat
  3202.       Match := (EPtr^[EOfs] = Search[SOfs]);
  3203.       if Match then begin
  3204.         Inc(EOfs);
  3205.         Inc(SOfs);
  3206.       end;
  3207.     until not Match or (SOfs > SLen);
  3208.  
  3209.     if Match then begin
  3210.       {Found a match, return index of start of match}
  3211.       SearchEnv := MOfs;
  3212.       Exit;
  3213.     end;
  3214.  
  3215.     {Skip to end of this environment string}
  3216.     SkipAsciiZ(EPtr, EOfs);
  3217.  
  3218.     {Skip to start of next environment string}
  3219.     Inc(EOfs);
  3220.   end;
  3221.  
  3222.   {No match}
  3223.   SearchEnv := $FFFF;
  3224. end;
  3225.  
  3226. procedure GetAsciiZ(EPtr : EnvArrayPtr; var EOfs : Word; var EStr : string);
  3227.   {-Collect AsciiZ string starting at EPtr^[EOfs]}
  3228. var
  3229.   ELen : Byte absolute EStr;
  3230. begin
  3231.   ELen := 0;
  3232.   while (EPtr^[EOfs] <> #0) and (ELen < 255) do begin
  3233.     Inc(ELen);
  3234.     EStr[ELen] := EPtr^[EOfs];
  3235.     Inc(EOfs);
  3236.   end;
  3237. end;
  3238.  
  3239. function SetEnv(Name, Value : string) : Boolean;
  3240.   {-Set environment string, returning true if successful}
  3241. var
  3242.   SLen : Byte absolute Name;
  3243.   VLen : Byte absolute Value;
  3244.   EPtr : EnvArrayPtr;
  3245.   ENext : Word;
  3246.   EOfs : Word;
  3247.   MOfs : Word;
  3248.   OldLen : Word;
  3249.   NewLen : Word;
  3250.   NulLen : Word;
  3251. begin
  3252.   with Env_Rec do begin
  3253.     SetEnv := False;
  3254.     if (EnvSeg = 0) or (SLen = 0) then
  3255.       Exit;
  3256.     EPtr := Ptr(EnvSeg, 0);
  3257.  
  3258.     {Find the search string}
  3259.     EOfs := SearchEnv(EPtr, Name);
  3260.  
  3261.     {Get the index of the next available environment location}
  3262.     ENext := EnvNext(EPtr);
  3263.  
  3264.     {Get total length of new environment string}
  3265.     NewLen := SLen+VLen;
  3266.  
  3267.     if EOfs <> $FFFF then begin
  3268.       {Search string exists}
  3269.       MOfs := EOfs+SLen;
  3270.       {Scan to end of string}
  3271.       SkipAsciiZ(EPtr, MOfs);
  3272.       OldLen := MOfs-EOfs;
  3273.       {No extra nulls to add}
  3274.       NulLen := 0;
  3275.     end else begin
  3276.       OldLen := 0;
  3277.       {One extra null to add}
  3278.       NulLen := 1;
  3279.     end;
  3280.  
  3281.     if VLen <> 0 then
  3282.       {Not a pure deletion}
  3283.       if ENext+NewLen+NulLen >= EnvLen+OldLen then
  3284.         {New string won't fit}
  3285.         Exit;
  3286.  
  3287.     if OldLen <> 0 then begin
  3288.       {Overwrite previous environment string}
  3289.       Move(EPtr^[MOfs+1], EPtr^[EOfs], ENext-MOfs-1);
  3290.       {More space free now}
  3291.       Dec(ENext, OldLen+1);
  3292.     end;
  3293.  
  3294.     {Append new string}
  3295.     if VLen <> 0 then begin
  3296.       Move(Name[1], EPtr^[ENext], SLen);
  3297.       Inc(ENext, SLen);
  3298.       Move(Value[1], EPtr^[ENext], VLen);
  3299.       Inc(ENext, VLen);
  3300.     end;
  3301.  
  3302.     {Clear out the rest of the environment}
  3303.     FillChar(EPtr^[ENext], EnvLen-ENext, 0);
  3304.  
  3305.     SetEnv := True;
  3306.   end;
  3307. end;
  3308.  
  3309. PROCEDURE READ_R(     X,Y : INTEGER;
  3310.                     VAR R : REAL;
  3311.                       MIN,
  3312.                       MAX : REAL;
  3313.                    PLACES : INTEGER;
  3314.                RIGHT_JUST : INTEGER;
  3315.                    ICOMMA : BOOLEAN);
  3316. var
  3317.   temp : string[80];
  3318.   len  : integer;
  3319.   SAT  : BYTE;
  3320.   S    : BUF160;
  3321. begin
  3322.   str(max:0:places,temp); 
  3323.   LEN := LENGTH(TEMP);
  3324.   str(r:0:places,temp);
  3325.   sat := screen_attr(x,y);
  3326.   textattr := sat;
  3327.   FW(X,Y,SAT,SPACES(RIGHT_JUST));
  3328.   IF MIN < 0.0 THEN
  3329.     BEGIN
  3330.       len := LEN + 1;                   { +1 FOR MINUS SIGN }
  3331.       REPEAT
  3332.         read_str(x,y,temp,dup('+',len));
  3333.        IF (_REAL(TEMP) < MIN) OR (_REAL(TEMP) > MAX) THEN
  3334.          BEGIN
  3335.            SAVE_LINE(Y+1,S);
  3336.            TEXTATTR := $4F;
  3337.            IF X > 30 THEN
  3338.              GOTOXY(30,Y+1)
  3339.            ELSE
  3340.              GOTOXY(X,Y+1);
  3341.            WRITE(' Range: ',MIN:0:PLACES,' to ',MAX:0:PLACES,'  Press <any key> ',CHR(8));
  3342.            READCH(CH,FALSE);
  3343.            REBUILD_LINE(Y+1,S);
  3344.            TEXTATTR := SAT;
  3345.          END;
  3346.       UNTIL (_REAL(TEMP) >= MIN) AND (_REAL(TEMP) <= MAX);
  3347.     END
  3348.   ELSE
  3349.     REPEAT
  3350.       READ_STR(X,Y,TEMP,DUP('.',LEN));
  3351.       IF (_REAL(TEMP) < MIN) OR (_REAL(TEMP) > MAX) THEN
  3352.         BEGIN
  3353.           SAVE_LINE(Y+1,S);
  3354.           TEXTATTR := $4F;
  3355.           IF X > 30 THEN
  3356.             GOTOXY(30,Y+1)
  3357.           ELSE
  3358.             GOTOXY(X,Y+1);
  3359.           WRITE(' Range: ',MIN:0:PLACES,' to ',MAX:0:PLACES,'  Press <any key> ',CHR(8));
  3360.           READCH(CH,FALSE);
  3361.           REBUILD_LINE(Y+1,S);
  3362.           TEXTATTR := SAT;
  3363.         END;
  3364.     UNTIL (_REAL(TEMP) >= MIN) AND (_REAL(TEMP) <= MAX);
  3365.   r := _real(temp);
  3366.   str(r:0:places,temp);               { THIS TRUNCATES ANYTHING }
  3367.   r := _real(temp);                   { PAST PLACES             }
  3368.   textattr := screen_attr(x,y);
  3369.   gotoxy(x,y);
  3370.   IF ICOMMA THEN
  3371.     write(comma(r,RIGHT_JUST,places,RNUM))
  3372.   ELSE
  3373.     WRITE(R:RIGHT_JUST:PLACES);
  3374. end;
  3375.  
  3376. PROCEDURE READ_I(     X,Y : INTEGER;
  3377.                     VAR R : INTEGER;
  3378.                       MIN,
  3379.                       MAX : INTEGER;
  3380.                RIGHT_JUST : INTEGER;
  3381.                    ICOMMA : BOOLEAN);
  3382. var
  3383.   temp : string[80];
  3384.   len  : integer;
  3385.   SAT  : BYTE;
  3386.   S    : BUF160;
  3387. begin
  3388.   str(max:0,temp);
  3389.   LEN := LENGTH(TEMP);
  3390.   str(r:0,temp);
  3391.   sat := screen_attr(x,y);
  3392.   textattr := sat;
  3393.   GOTOXY(X,Y);
  3394.   WRITE(' ':RIGHT_JUST);
  3395.   IF MIN < 0.0 THEN
  3396.     BEGIN
  3397.       len := LEN + 1;                   { +1 FOR MINUS SIGN }
  3398.       REPEAT
  3399.         read_str(x,y,temp,dup('+',len));
  3400.        IF (_INTEGER(TEMP) < MIN) OR (_INTEGER(TEMP) > MAX) THEN
  3401.          BEGIN
  3402.            SAVE_LINE(Y+1,S);
  3403.            TEXTATTR := $4F;
  3404.            IF X > 30 THEN
  3405.              GOTOXY(30,Y+1)
  3406.            ELSE
  3407.              GOTOXY(X,Y+1);
  3408.            WRITE(' Range: ',MIN:0,' to ',MAX:0,'  Press <any key> ',CHR(8));
  3409.            READCH(CH,FALSE);
  3410.            REBUILD_LINE(Y+1,S);
  3411.            TEXTATTR := SAT;
  3412.          END;
  3413.       UNTIL (_INTEGER(TEMP) >= MIN) AND (_INTEGER(TEMP) <= MAX);
  3414.     END
  3415.   ELSE
  3416.     REPEAT
  3417.       READ_STR(X,Y,TEMP,DUP('.',LEN));
  3418.       IF (_INTEGER(TEMP) < MIN) OR (_INTEGER(TEMP) > MAX) THEN
  3419.         BEGIN
  3420.           SAVE_LINE(Y+1,S);
  3421.           TEXTATTR := $4F;
  3422.           IF X > 30 THEN
  3423.             GOTOXY(30,Y+1)
  3424.           ELSE
  3425.             GOTOXY(X,Y+1);
  3426.           WRITE(' Range: ',MIN:0,' to ',MAX:0,'  Press <any key> ',CHR(8));
  3427.           READCH(CH,FALSE);
  3428.           REBUILD_LINE(Y+1,S);
  3429.           TEXTATTR := SAT;
  3430.         END;
  3431.     UNTIL (_INTEGER(TEMP) >= MIN) AND (_INTEGER(TEMP) <= MAX);
  3432.   r := _INTEGER(temp);
  3433.   str(r:0,temp);               { THIS TRUNCATES ANYTHING }
  3434.   r := _INTEGER(temp);                   { PAST PLACES             }
  3435.   textattr := screen_attr(x,y);
  3436.   gotoxy(x,y);
  3437.   IF ICOMMA THEN
  3438.     write(comma(r,RIGHT_JUST,0,INUM))
  3439.   ELSE
  3440.     WRITE(R:RIGHT_JUST);
  3441. end;
  3442.  
  3443. PROCEDURE READ_L(     X,Y : INTEGER;
  3444.                     VAR R : LONGINT;
  3445.                       MIN,
  3446.                       MAX : LONGINT;
  3447.                RIGHT_JUST : LONGINT;
  3448.                    ICOMMA : BOOLEAN);
  3449. var
  3450.   temp : string[80];
  3451.   len  : integer;
  3452.   SAT  : BYTE;
  3453.   S    : BUF160;
  3454. begin
  3455.   str(max:0,temp);
  3456.   LEN := LENGTH(TEMP);
  3457.   str(r:0,temp);
  3458.   sat := screen_attr(x,y);
  3459.   textattr := sat;
  3460.   GOTOXY(X,Y);
  3461.   WRITE(' ':RIGHT_JUST);
  3462.   IF MIN < 0.0 THEN
  3463.     BEGIN
  3464.       len := LEN + 1;                   { +1 FOR MINUS SIGN }
  3465.       REPEAT
  3466.         read_str(x,y,temp,dup('+',len));
  3467.        IF (_LONGINT(TEMP) < MIN) OR (_LONGINT(TEMP) > MAX) THEN
  3468.          BEGIN
  3469.            SAVE_LINE(Y+1,S);
  3470.            TEXTATTR := $4F;
  3471.            IF X > 30 THEN
  3472.              GOTOXY(30,Y+1)
  3473.            ELSE
  3474.              GOTOXY(X,Y+1);
  3475.            WRITE(' Range: ',MIN:0,' to ',MAX:0,'  Press <any key> ',CHR(8));
  3476.            READCH(CH,FALSE);
  3477.            REBUILD_LINE(Y+1,S);
  3478.            TEXTATTR := SAT;
  3479.          END;
  3480.       UNTIL (_LONGINT(TEMP) >= MIN) AND (_LONGINT(TEMP) <= MAX);
  3481.     END
  3482.   ELSE
  3483.     REPEAT
  3484.       READ_STR(X,Y,TEMP,DUP('.',LEN));
  3485.       IF (_LONGINT(TEMP) < MIN) OR (_LONGINT(TEMP) > MAX) THEN
  3486.         BEGIN
  3487.           SAVE_LINE(Y+1,S);
  3488.           TEXTATTR := $4F;
  3489.           IF X > 30 THEN
  3490.             GOTOXY(30,Y+1)
  3491.           ELSE
  3492.             GOTOXY(X,Y+1);
  3493.           WRITE(' Range: ',MIN:0,' to ',MAX:0,'  Press <any key> ',CHR(8));
  3494.           READCH(CH,FALSE);
  3495.           REBUILD_LINE(Y+1,S);
  3496.           TEXTATTR := SAT;
  3497.         END;
  3498.     UNTIL (_LONGINT(TEMP) >= MIN) AND (_LONGINT(TEMP) <= MAX);
  3499.   r := _LONGINT(temp);
  3500.   str(r:0,temp);               { THIS TRUNCATES ANYTHING }
  3501.   r := _LONGINT(temp);                   { PAST PLACES             }
  3502.   textattr := screen_attr(x,y);
  3503.   gotoxy(x,y);
  3504.   IF ICOMMA THEN
  3505.     write(comma(r,RIGHT_JUST,0,LNUM))
  3506.   ELSE
  3507.     WRITE(R:RIGHT_JUST);
  3508. end;
  3509.  
  3510. PROCEDURE READ_MONEY(X,Y : INTEGER;
  3511.                    VAR R : REAL;
  3512.                  DPLACES : INTEGER;
  3513.               RIGHT_JUST : INTEGER;
  3514.                LOW, HIGH : REAL);
  3515. VAR
  3516.   I         : INTEGER;
  3517.   TEMP      : STRING[15];
  3518.   OLDATTR   : BYTE;
  3519.   LEN       : INTEGER;
  3520.   VALID_SET : SET OF CHAR;
  3521.   FACTOR    : REAL;
  3522.   OLD_CUR   : CURTYPE;
  3523. BEGIN
  3524.   OLD_CUR := CUR;
  3525.   SET_CURSOR(UNDERLINE);
  3526.   FACTOR := 1;
  3527.   FOR I := 1 TO DPLACES DO
  3528.     FACTOR := FACTOR * 10;
  3529.   VALID_SET := ['0'..'9',#8];
  3530.   IF R > HIGH THEN R := HIGH;
  3531.   IF R < LOW  THEN R := LOW;
  3532.   OLDATTR := SCREEN_ATTR(X,Y);
  3533.   TEXTATTR := UT.INPUT_ATTR;
  3534.   LEN := LENGTH(COMMA(HIGH,0,DPLACES,RNUM));
  3535.   IF LOW < 0.0 THEN
  3536.     BEGIN                          
  3537.       VALID_SET := VALID_SET + ['-'];
  3538.       IF LENGTH(COMMA(LOW,0,DPLACES,RNUM)) > LEN THEN
  3539.         LEN := LENGTH(COMMA(LOW,0,DPLACES,RNUM));
  3540.     END;
  3541.   CHANGED := FALSE;
  3542.   TEMP := COMMA(R,LEN,DPLACES,RNUM);
  3543.   GOTOXY(X+RIGHT_JUST-LEN,Y);
  3544.   WRITE(TEMP);
  3545.   TEMP := '';
  3546.   REPEAT
  3547.     GOTOXY(X+RIGHT_JUST-1,Y);
  3548.     READCH(CH,FALSE);
  3549.     IF CH IN VALID_SET THEN
  3550.       BEGIN
  3551.         VALID_SET := VALID_SET - ['-'];
  3552.         CHANGED := TRUE;
  3553.         IF CH = #8 THEN
  3554.           DELETE(TEMP,LENGTH(TEMP),1)
  3555.         ELSE
  3556.           IF (_REAL(TEMP+CH) > 0.0) THEN
  3557.             IF (LENGTH(TEMP) < LEN) AND
  3558.                ((_REAL(TEMP+CH) / FACTOR) <= HIGH) THEN
  3559.               TEMP := TEMP + CH
  3560.             ELSE
  3561.           ELSE
  3562.             IF (LENGTH(TEMP) < LEN) AND
  3563.                ((_REAL(TEMP+CH) / FACTOR) >= LOW) THEN
  3564.               TEMP := TEMP + CH;
  3565.         R := _REAL(TEMP) / FACTOR;
  3566.         GOTOXY(X+RIGHT_JUST-LEN,Y);
  3567.         WRITE(COMMA(R,LEN,DPLACES,RNUM));
  3568.         IF CH = '-' THEN
  3569.           BEGIN
  3570.             GOTOXY(X+RIGHT_JUST-LEN,Y);
  3571.             WRITE('-');
  3572.           END;
  3573.       END;
  3574.   UNTIL (CH = #27) OR (UT.EXITCH[ORD(CH)]);
  3575.   TEXTATTR := OLDATTR;
  3576.   GOTOXY(X,Y);
  3577.   WRITE(COMMA(R,RIGHT_JUST,DPLACES,RNUM));
  3578.   TEXTATTR := UT.DEFAULT_ATTR;
  3579.   SET_CURSOR(OLD_CUR);
  3580. END;
  3581.  
  3582. PROCEDURE READ_DIGIT(    X,Y : INTEGER;
  3583.                    VAR VALUE;          
  3584.                   RIGHT_JUST : INTEGER;
  3585.                    LOW, HIGH : LONGINT;
  3586.                        NTYPE : TYPEN);
  3587. VAR
  3588.   TEMP      : STRING[15];
  3589.   OLDATTR   : BYTE;
  3590.   LNUMBER   : LONGINT ABSOLUTE VALUE;
  3591.   INUMBER   : INTEGER ABSOLUTE VALUE;
  3592.   LEN       : INTEGER;
  3593.   VALID_SET : SET OF CHAR;
  3594.   OLD_CUR   : CURTYPE;
  3595. BEGIN
  3596.   OLD_CUR := CUR;
  3597.   SET_CURSOR(UNDERLINE);
  3598.   VALID_SET := ['0'..'9',#8];
  3599.   LEN := LENGTH(COMMA(HIGH,0,0,LNUM));
  3600.   IF LOW < 0 THEN
  3601.     BEGIN
  3602.       VALID_SET := VALID_SET + ['-'];
  3603.       IF LENGTH(COMMA(LOW,0,0,LNUM)) > LEN THEN
  3604.         LEN := LENGTH(COMMA(LOW,0,0,LNUM));
  3605.     END;
  3606.   CASE NTYPE OF
  3607.       LNUM : BEGIN
  3608.                IF LNUMBER > HIGH THEN LNUMBER := HIGH;
  3609.                IF LNUMBER < LOW  THEN LNUMBER := LOW;
  3610.                TEMP := COMMA(LNUMBER,LEN,0,LNUM);
  3611.              END;
  3612.       INUM : BEGIN
  3613.                IF INUMBER > HIGH THEN INUMBER := HIGH;
  3614.                IF INUMBER < LOW  THEN INUMBER := LOW;
  3615.                TEMP := COMMA(INUMBER,LEN,0,INUM);
  3616.              END;
  3617.       ELSE   EXIT;
  3618.   END;
  3619.   OLDATTR := SCREEN_ATTR(X,Y);
  3620.   TEXTATTR := UT.INPUT_ATTR;
  3621.   CHANGED := FALSE;
  3622.   GOTOXY(X+RIGHT_JUST-LEN,Y);
  3623.   WRITE(TEMP);
  3624.   TEMP := '';
  3625.   REPEAT        
  3626.     GOTOXY(X+RIGHT_JUST-1,Y);
  3627.     READCH(CH,FALSE);
  3628.     IF CH IN VALID_SET THEN
  3629.       BEGIN
  3630.         VALID_SET := VALID_SET - ['-'];
  3631.         CHANGED := TRUE;
  3632.         IF CH = #8 THEN
  3633.           DELETE(TEMP,LENGTH(TEMP),1)
  3634.         ELSE
  3635.           CASE NTYPE OF
  3636.              LNUM : IF _LONGINT(TEMP+CH) > 0 THEN
  3637.                       IF (LENGTH(TEMP) < LEN) AND
  3638.                          ((_LONGINT(TEMP+CH) <= HIGH)) THEN
  3639.                         TEMP := TEMP + CH
  3640.                       ELSE
  3641.                     ELSE
  3642.                       IF (LENGTH(TEMP) < LEN) AND
  3643.                          ((_LONGINT(TEMP+CH) >= LOW)) THEN
  3644.                         TEMP := TEMP + CH;
  3645.              INUM : IF _INTEGER(TEMP+CH) > 0 THEN
  3646.                       IF (LENGTH(TEMP) < LEN) AND
  3647.                          ((_INTEGER(TEMP+CH) <= HIGH)) THEN
  3648.                         TEMP := TEMP + CH
  3649.                       ELSE
  3650.                     ELSE
  3651.                       IF (LENGTH(TEMP) < LEN) AND
  3652.                          ((_INTEGER(TEMP+CH) >= LOW)) THEN
  3653.                         TEMP := TEMP+CH;
  3654.           END;
  3655.         GOTOXY(X+RIGHT_JUST-LEN,Y);
  3656.         CASE NTYPE OF
  3657.             LNUM : BEGIN
  3658.                      LNUMBER := _LONGINT(TEMP);
  3659.                      WRITE(COMMA(LNUMBER,LEN,0,LNUM));
  3660.                    END;
  3661.             INUM : BEGIN
  3662.                      INUMBER := _INTEGER(TEMP);
  3663.                      WRITE(COMMA(INUMBER,LEN,0,INUM));
  3664.                    END;
  3665.         END;
  3666.         IF CH = '-' THEN
  3667.           BEGIN
  3668.             GOTOXY(X+RIGHT_JUST-LEN,Y);
  3669.             WRITE('-');
  3670.           END;
  3671.       END;
  3672.   UNTIL (CH = #27) OR (UT.EXITCH[ORD(CH)]);
  3673.   TEXTATTR := OLDATTR;
  3674.   GOTOXY(X+RIGHT_JUST-LEN,Y);
  3675.   CASE NTYPE OF
  3676.       LNUM : BEGIN
  3677.                IF CHANGED THEN
  3678.                  LNUMBER := _LONGINT(TEMP);
  3679.                WRITE(COMMA(LNUMBER,LEN,0,LNUM));
  3680.              END;
  3681.       INUM : BEGIN
  3682.                IF CHANGED THEN
  3683.                  INUMBER := _INTEGER(TEMP);
  3684.                WRITE(COMMA(INUMBER,LEN,0,INUM));
  3685.              END;
  3686.   END;
  3687.   TEXTATTR := UT.DEFAULT_ATTR;
  3688.   SET_CURSOR(OLD_CUR);
  3689. END;
  3690.  
  3691. FUNCTION BLANKS(INSTRING : STRING) : BOOLEAN;
  3692. BEGIN
  3693.   BLANKS := PAD(' ',LENGTH(INSTRING)) = INSTRING;
  3694. END;
  3695.  
  3696. Function PackKey(Dte, Tme : str8) : longint;
  3697. var
  3698.   Dow,
  3699.   sec100 : word;
  3700.   dt     : DateTime;
  3701.   Tlong  : longint;
  3702. begin
  3703.   if Dte = '' then
  3704.     begin
  3705.       GetDate(Dt.Year,Dt.Month,Dt.Day,Dow);
  3706.       GetTime(Dt.Hour,Dt.Min,Dt.Sec,Sec100);
  3707.     end
  3708.   else
  3709.     begin
  3710.       if copy(Dte,7,2) < '80' then
  3711.         Dt.Year  := 2000 + _word(copy(Dte,7,2))
  3712.       else
  3713.         Dt.Year  := 1900 + _word(copy(Dte,7,2));
  3714.       Dt.Month := _word(copy(Dte,1,2));
  3715.       Dt.Day   := _word(copy(Dte,4,2));
  3716.       Dt.Hour  := _word(copy(Tme,1,2));
  3717.       Dt.Min   := _word(copy(Tme,4,2));
  3718.       Dt.Sec   := _word(copy(Tme,7,2));
  3719.     end;
  3720.   PackTime(Dt, Tlong);
  3721.   PackKey := Tlong;
  3722. end;
  3723.  
  3724. Function UnPackKey(PK : longint) : str20;
  3725. var
  3726.   Temp : str20;
  3727.   Dt   : DateTime;
  3728. begin
  3729.   UnPackTime(PK, Dt);
  3730.   temp := longint_str(Dt.Month,2) + '-' +
  3731.           longint_str(Dt.Day,2)   + '-' +
  3732.           longint_str(Dt.Year,2)  + ' ' +
  3733.           longint_str(Dt.Hour,2)  + ':' +
  3734.           longint_str(Dt.Min,2)   + ':' +
  3735.           longint_str(Dt.Sec,2);
  3736.   delete(temp,7,2);
  3737.   if temp[1] = ' ' then temp[1] := '0';
  3738.   if temp[4] = ' ' then temp[4] := '0';
  3739.   if temp[7] = ' ' then temp[7] := '0';
  3740.   if temp[10] = ' ' then temp[10] := '0';
  3741.   if temp[13] = ' ' then temp[13] := '0';
  3742.   if temp[16] = ' ' then temp[16] := '0';
  3743.   UnPackKey := Temp;
  3744. end;
  3745.  
  3746. PROCEDURE StuffBuffer(S : STR16);
  3747. CONST
  3748.   KbStart = $1E;
  3749. VAR
  3750.   N,MAX : BYTE;
  3751.   KbHead : WORD ABSOLUTE $40:$1A;
  3752.   KbTail : WORD ABSOLUTE $40:$1C;
  3753.   KbBuff : ARRAY [0..15] OF WORD ABSOLUTE $40:KbStart;
  3754. BEGIN
  3755.   MAX := 15;
  3756.   IF LENGTH(S) < MAX THEN
  3757.     MAX := LENGTH(S);
  3758.   ASM CLI END;
  3759.   KbHead := KbStart;
  3760.   KbTail := KbStart + 2*MAX;
  3761.   FOR N := 1 TO MAX DO
  3762.     KbBuff[PRED(N)] := WORD(S[N]);
  3763.   ASM STI END;
  3764. END;
  3765.  
  3766. FUNCTION DATE_MATH(DT : STR8; NUM : INTEGER) : STR8;
  3767. BEGIN
  3768.   DATE_MATH := JULTOMDY(JULIAN(DT) + NUM);
  3769. END;
  3770.  
  3771. FUNCTION GET_CHOICE(ATTR1 : BYTE;    { WINDOW Attribute    }
  3772.                     ATTR2 : BYTE;    { LIGHT-BAR Attribute }
  3773.                     ATTR3 : BYTE;    { Hot-Key Attribute   }
  3774.                     TITLE,
  3775.                     S1    : STR80;
  3776.                     P1    : BYTE;
  3777.                     S2    : STR80;
  3778.                     P2    : BYTE;
  3779.                     S3    : STR80;
  3780.                     P3    : BYTE;
  3781.                     S4    : STR80;
  3782.                     P4    : BYTE;
  3783.                     S5    : STR80;
  3784.                     P5    : BYTE;
  3785.                     S6    : STR80;
  3786.                     P6    : BYTE;
  3787.                     S7    : STR80;
  3788.                     P7    : BYTE;
  3789.                     S8    : STR80;
  3790.                     P8    : BYTE;
  3791.                     S9    : STR80;
  3792.                     P9    : BYTE;
  3793.                     S10   : STR80;
  3794.                     P10   : BYTE) : INTEGER;
  3795.  
  3796. VAR
  3797.   SC       : BUFFER;
  3798.   I        : INTEGER;
  3799.   TOP      : INTEGER;
  3800.   BOT      : INTEGER;
  3801.   LEFTS    : INTEGER;
  3802.   RIGHTS   : INTEGER;
  3803.   SEL      : INTEGER;
  3804.   LONGEST  : INTEGER;
  3805.   NUM_INP  : INTEGER;
  3806.   BAR1     : INTEGER;
  3807.   BAR2     : INTEGER;
  3808.   SAVE_CUR : CURTYPE;
  3809. BEGIN
  3810.   SAVE_CUR := CUR;
  3811.   SET_CURSOR(NONE);
  3812.   SAVE_SCREEN(SC);
  3813.   LONGEST := 0;
  3814.   NUM_INP := 0;
  3815.   IF LENGTH(S1)  > LONGEST THEN LONGEST := LENGTH(S1);
  3816.   IF LENGTH(S2)  > LONGEST THEN LONGEST := LENGTH(S2);
  3817.   IF LENGTH(S3)  > LONGEST THEN LONGEST := LENGTH(S3);
  3818.   IF LENGTH(S4)  > LONGEST THEN LONGEST := LENGTH(S4);
  3819.   IF LENGTH(S5)  > LONGEST THEN LONGEST := LENGTH(S5);
  3820.   IF LENGTH(S6)  > LONGEST THEN LONGEST := LENGTH(S6);
  3821.   IF LENGTH(S7)  > LONGEST THEN LONGEST := LENGTH(S7);
  3822.   IF LENGTH(S8)  > LONGEST THEN LONGEST := LENGTH(S8);
  3823.   IF LENGTH(S9)  > LONGEST THEN LONGEST := LENGTH(S9);
  3824.   IF LENGTH(S10) > LONGEST THEN LONGEST := LENGTH(S10);
  3825.   BAR1 := 40 - (LONGEST DIV 2) - 1;
  3826.   BAR2 := 40 + (LONGEST DIV 2) + 1;
  3827.   IF LONGEST > 0 THEN
  3828.     LONGEST := LONGEST + 2;
  3829.   IF LENGTH(TITLE) > 0 THEN
  3830.     BEGIN
  3831.       TITLE := CHR(16)+' '+TITLE+' '+CHR(17);
  3832.       IF LONGEST < LENGTH(TITLE) + 4 THEN
  3833.         LONGEST := LENGTH(TITLE) + 4;
  3834.     END;
  3835.   IF S1  <> '' THEN
  3836.     BEGIN
  3837.       INC(NUM_INP);              
  3838.       IF S2  <> '' THEN
  3839.         BEGIN
  3840.           INC(NUM_INP);          
  3841.           IF S3  <> '' THEN
  3842.             BEGIN
  3843.               INC(NUM_INP);      
  3844.               IF S4  <> '' THEN
  3845.                 BEGIN
  3846.                   INC(NUM_INP);  
  3847.                   IF S5  <> '' THEN
  3848.                     BEGIN
  3849.                       INC(NUM_INP);
  3850.                       IF S6  <> '' THEN
  3851.                         BEGIN
  3852.                           INC(NUM_INP);
  3853.                           IF S7  <> '' THEN
  3854.                             BEGIN
  3855.                               INC(NUM_INP);
  3856.                               IF S8  <> '' THEN
  3857.                                 BEGIN
  3858.                                   INC(NUM_INP);
  3859.                                   IF S9  <> '' THEN
  3860.                                     BEGIN
  3861.                                       INC(NUM_INP);
  3862.                                       IF S10 <> '' THEN
  3863.                                         INC(NUM_INP);
  3864.                                     END;
  3865.                                 END;
  3866.                             END;
  3867.                         END;
  3868.                     END;
  3869.                 END;
  3870.             END;
  3871.         END;
  3872.     END;
  3873.   IF LONGEST < 17 THEN
  3874.     LONGEST := 17;
  3875.   LEFTS  := 39-(LONGEST DIV 2);
  3876.   TOP    := 11-(NUM_INP DIV 2);
  3877.   RIGHTS := LEFTS + LONGEST + 1;
  3878.   BOT    := TOP + NUM_INP + 4;
  3879.   IF BAR2 >= RIGHTS - 1 THEN
  3880.     BAR2 := RIGHTS - 1;
  3881.   IF LEFTS + 1 >= BAR1 THEN
  3882.     BAR1 := LEFTS + 1;
  3883.   POP_WINDOW(LEFTS,
  3884.              TOP,
  3885.              RIGHTS,
  3886.              BOT, 2, ATTR1);
  3887.   IF LENGTH(TITLE) > 0 THEN
  3888.     CENTER(TOP,ATTR1,TITLE);
  3889.   CENTER(BOT-1,ATTR1,CHR(24)+' '+CHR(25)+' '+ENTER_KEY+'-Select');
  3890.   IF S1 <> '' THEN
  3891.     BEGIN
  3892.       FW(40 - (LENGTH(S1) DIV 2),TOP+2,ATTR1,S1);
  3893.       IF S2 <> '' THEN
  3894.         BEGIN
  3895.           FW(40 - (LENGTH(S2) DIV 2),TOP+3,ATTR1,S2);
  3896.           IF S3 <> '' THEN
  3897.             BEGIN
  3898.               FW(40 - (LENGTH(S3) DIV 2),TOP+4,ATTR1,S3);
  3899.               IF S4 <> '' THEN
  3900.                 BEGIN
  3901.                   FW(40 - (LENGTH(S4) DIV 2),TOP+5,ATTR1,S4);
  3902.                   IF S5 <> '' THEN
  3903.                     BEGIN
  3904.                       FW(40 - (LENGTH(S5) DIV 2),TOP+6,ATTR1,S5);
  3905.                       IF S6 <> '' THEN
  3906.                         BEGIN
  3907.                           FW(40 - (LENGTH(S6) DIV 2),TOP+7,ATTR1,S6);
  3908.                           IF S7 <> '' THEN
  3909.                             BEGIN
  3910.                               FW(40 - (LENGTH(S7) DIV 2),TOP+8,ATTR1,S7);
  3911.                               IF S8 <> '' THEN
  3912.                                 BEGIN
  3913.                                   FW(40 - (LENGTH(S8) DIV 2),TOP+9,ATTR1,S8);
  3914.                                   IF S9 <> '' THEN
  3915.                                     BEGIN
  3916.                                       FW(40 - (LENGTH(S9) DIV 2),TOP+10,ATTR1,S9);
  3917.                                       IF S10 <> '' THEN
  3918.                                         FW(40 - (LENGTH(S10) DIV 2),TOP+11,ATTR1,S10);
  3919.                                     END;
  3920.                                 END;
  3921.                             END;
  3922.                         END;
  3923.                     END;
  3924.                 END;
  3925.             END;
  3926.         END;
  3927.     END;
  3928.   IF NOT ODD(LONGEST) THEN
  3929.     INC(LONGEST);
  3930.   IF LENGTH(S1) > 0 THEN
  3931.     BEGIN
  3932.       SEL := 1;
  3933.       REPEAT                                      
  3934.         IF (P1 <> 0) AND (LENGTH(S1) > 0) THEN
  3935.           BEGIN
  3936.             SET_ATTR([40 - (LENGTH(S1) DIV 2)+P1-1],TOP+2,ATTR3);
  3937.             IF (P2 <> 0) AND (LENGTH(S2) > 0) THEN
  3938.               BEGIN
  3939.                 SET_ATTR([40 - (LENGTH(S2) DIV 2)+P2-1],TOP+3,ATTR3);
  3940.                 IF (P3 <> 0) AND (LENGTH(S3) > 0) THEN
  3941.                   BEGIN
  3942.                     SET_ATTR([40 - (LENGTH(S3) DIV 2)+P3-1],TOP+4,ATTR3);
  3943.                     IF (P4 <> 0) AND (LENGTH(S4) > 0) THEN
  3944.                       BEGIN
  3945.                         SET_ATTR([40 - (LENGTH(S4) DIV 2)+P4-1],TOP+5,ATTR3);
  3946.                         IF (P5 <> 0) AND (LENGTH(S5) > 0) THEN
  3947.                           BEGIN
  3948.                             SET_ATTR([40 - (LENGTH(S5) DIV 2)+P5-1],TOP+6,ATTR3);
  3949.                             IF (P6 <> 0) AND (LENGTH(S6) > 0) THEN
  3950.                               BEGIN
  3951.                                 SET_ATTR([40 - (LENGTH(S6) DIV 2)+P6-1],TOP+7,ATTR3);
  3952.                                 IF (P7 <> 0) AND (LENGTH(S7) > 0) THEN
  3953.                                   BEGIN
  3954.                                     SET_ATTR([40 - (LENGTH(S7) DIV 2)+P7-1],TOP+8,ATTR3);
  3955.                                     IF (P8 <> 0) AND (LENGTH(S8) > 0) THEN
  3956.                                       BEGIN
  3957.                                         SET_ATTR([40 - (LENGTH(S8) DIV 2)+P8-1],TOP+9,ATTR3);
  3958.                                         IF (P9 <> 0) AND (LENGTH(S9) > 0) THEN
  3959.                                           BEGIN
  3960.                                             SET_ATTR([40 - (LENGTH(S9) DIV 2)+P9-1],TOP+10,ATTR3);
  3961.                                             IF (P10 <> 0) AND (LENGTH(S10) > 0) THEN
  3962.                                               SET_ATTR([40 - (LENGTH(S10) DIV 2)+P10-1],TOP+11,ATTR3);END;
  3963.                                       END;
  3964.                                   END;
  3965.                               END;
  3966.                           END;
  3967.                       END;
  3968.                   END;
  3969.               END;
  3970.           END;                                        
  3971.         SET_ATTR([BAR1..BAR2],SEL+TOP+1,ATTR2);
  3972.         READCH(CH,FALSE);
  3973.         SET_ATTR([BAR1..BAR2],SEL+TOP+1,ATTR1);
  3974.         CASE CH OF
  3975.              UP : DEC(SEL);
  3976.            DOWN : INC(SEL);
  3977.            ELSE   BEGIN
  3978.                     IF UPCASE(CH) = UPCASE(S1[P1]) THEN
  3979.                       BEGIN
  3980.                         SEL := 1;
  3981.                         CH := ENTER;
  3982.                       END
  3983.                     ELSE
  3984.                       IF UPCASE(CH) = UPCASE(S2[P2]) THEN
  3985.                         BEGIN
  3986.                           SEL := 2;
  3987.                           CH := ENTER;
  3988.                         END
  3989.                     ELSE
  3990.                       IF UPCASE(CH) = UPCASE(S3[P3]) THEN
  3991.                         BEGIN
  3992.                           SEL := 3;
  3993.                           CH := ENTER;
  3994.                         END
  3995.                     ELSE
  3996.                       IF UPCASE(CH) = UPCASE(S4[P4]) THEN
  3997.                         BEGIN
  3998.                           SEL := 4;
  3999.                           CH := ENTER;
  4000.                         END
  4001.                     ELSE
  4002.                       IF UPCASE(CH) = UPCASE(S5[P5]) THEN
  4003.                         BEGIN
  4004.                           SEL := 5;
  4005.                           CH := ENTER;
  4006.                         END
  4007.                     ELSE
  4008.                       IF UPCASE(CH) = UPCASE(S6[P6]) THEN
  4009.                         BEGIN
  4010.                           SEL := 6;
  4011.                           CH := ENTER;
  4012.                         END
  4013.                     ELSE
  4014.                       IF UPCASE(CH) = UPCASE(S7[P7]) THEN
  4015.                         BEGIN
  4016.                           SEL := 7;
  4017.                           CH := ENTER;
  4018.                         END
  4019.                     ELSE
  4020.                       IF UPCASE(CH) = UPCASE(S8[P8]) THEN
  4021.                         BEGIN
  4022.                           SEL := 8;
  4023.                           CH := ENTER;
  4024.                         END
  4025.                     ELSE
  4026.                       IF UPCASE(CH) = UPCASE(S9[P9]) THEN
  4027.                         BEGIN
  4028.                           SEL := 9;
  4029.                           CH := ENTER;
  4030.                         END
  4031.                     ELSE
  4032.                       IF UPCASE(CH) = UPCASE(S10[P10]) THEN
  4033.                         BEGIN
  4034.                           SEL := 10;
  4035.                           CH := ENTER;
  4036.                         END
  4037.                   END;
  4038.         END;
  4039.         IF SEL > NUM_INP THEN SEL := 1;
  4040.         IF SEL < 1 THEN SEL := NUM_INP;
  4041.       UNTIL CH IN [ESCAPE,ENTER];
  4042.       IF CH = ENTER THEN
  4043.         GET_CHOICE := SEL
  4044.       ELSE
  4045.         GET_CHOICE := 0;
  4046.     END
  4047.   ELSE
  4048.     GET_CHOICE := 0;
  4049.   SET_CURSOR(SAVE_CUR);
  4050.   REBUILD_SCREEN(SC);
  4051. END;
  4052.  
  4053. PROCEDURE DUMP_RECORD(VAR REC;
  4054.                           NUM_BYTES   : INTEGER;
  4055.                           IDNAME      : STR80;
  4056.                           DESTINATION : STR80);
  4057.  
  4058. TYPE
  4059.   HEXBYTE = STRING [2];
  4060. VAR
  4061.   I           : LONGINT;
  4062.   J,
  4063.   TEMP        : INTEGER;
  4064.   HX          : ARRAY [0..255] of HEXBYTE;
  4065.   BUFFER2     : ARRAY [1..32767] OF BYTE ABSOLUTE REC;
  4066.   DEST        : TEXT;
  4067.   DUMPSCREEN  : BUFFER;
  4068.   DATEE       : STRING[30];
  4069.  
  4070.        PROCEDURE PRINT_BUFFER;
  4071.        VAR
  4072.          K : LONGINT;
  4073.        BEGIN
  4074.          I:=1;
  4075.          REPEAT
  4076.            J:=2;
  4077.            REPEAT
  4078.              WRITE(DEST,' ');
  4079.              FOR K:=I TO I+15 DO
  4080.                IF K <= NUM_BYTES THEN
  4081.                  BEGIN
  4082.                    WRITE(DEST,HX[BUFFER2[K]]);
  4083.                    WRITE(DEST,' ');
  4084.                  END
  4085.                ELSE
  4086.                  WRITE(DEST,'   ');
  4087.              WRITE(DEST,'   ');
  4088.              FOR K:=I TO I+15 DO
  4089.                IF K <= NUM_BYTES THEN
  4090.                  IF ORD(BUFFER2[K]) > 32 THEN
  4091.                    WRITE(DEST,CHR(BUFFER2[K]))
  4092.                  ELSE
  4093.                    WRITE(DEST,'.');
  4094.              I:=I+16;
  4095.              J:=J+1;
  4096.              WRITELN(DEST);
  4097.            UNTIL (J=18) OR (I >= NUM_BYTES) OR (I >= 32767);
  4098.            IF DESTINATION = 'CON' THEN
  4099.              BEGIN
  4100.                WRITELN;
  4101.                WRITE('Press <any key> to continue, <ESC> to Exit...');
  4102.                READCH(CH,FALSE);
  4103.                IF CH = ESCAPE THEN
  4104.                  BEGIN
  4105.                    CH := 'X';
  4106.                    EXIT;
  4107.                  END;
  4108.                CH := 'X';
  4109.                CLRSCR;
  4110.                WRITELN(DEST);
  4111.                DATEE := DATE_TIME_KEY;
  4112.                WRITELN(DEST,'*** ',COPY(DATEE,5,2),
  4113.                                    COPY(DATEE,7,2),
  4114.                                    COPY(DATEE,1,4),
  4115.                                    COPY(DATEE,9,2),':',
  4116.                                    COPY(DATEE,11,2),':',
  4117.                                    COPY(DATEE,13,2),':',
  4118.                                    COPY(DATEE,15,2),'         Gemini Systems     DumpRecord');
  4119.                WRITELN(DEST);
  4120.                WRITELN(DEST,'    Variable : ',IDNAME);
  4121.                WRITELN(DEST);
  4122.              END;
  4123.          UNTIL (I >= NUM_BYTES) OR (I >= 32767);
  4124.        END;
  4125.  
  4126. BEGIN
  4127.   SAVE_SCREEN(DUMPSCREEN);
  4128.   IF DESTINATION = '' THEN
  4129.     BEGIN
  4130.       POP_WINDOW(30,8,62,12,2,$4F);
  4131.       FW(32,10,$4E,'F)ile, P)rinter, S)creen ? ');
  4132.       REPEAT
  4133.         GOTOXY(59,10);
  4134.         READCH(CH,TRUE);
  4135.         CH := UPCASE(CH);
  4136.       UNTIL CH IN ['F','P','S',ESCAPE];
  4137.       IF CH = ESCAPE THEN
  4138.         BEGIN
  4139.           REBUILD_SCREEN(DUMPSCREEN);
  4140.           CH := 'X';
  4141.           EXIT;
  4142.         END;
  4143.       CASE CH OF
  4144.          'S' : DESTINATION := 'CON';
  4145.          'P' : DESTINATION := 'PRN';
  4146.          'F' : READSTR(32,11,12,$4F,'Enter Filename..',$70,
  4147.                           DESTINATION,[' '..'~'],
  4148.                           [1..12],
  4149.                           [CLEAR,ENTER],69,2,'N');
  4150.       END;
  4151.       IF CH = ESCAPE THEN
  4152.         BEGIN
  4153.           REBUILD_SCREEN(DUMPSCREEN);
  4154.           HALT;
  4155.         END;
  4156.     END;
  4157.   DESTINATION := UPPERCASE(STRIP(DESTINATION,TRUE));
  4158.   ASSIGN(DEST,DESTINATION);
  4159.   IF (DESTINATION <> 'PRN') AND (DESTINATION <> 'CON') THEN
  4160.     BEGIN
  4161.       {$I-}
  4162.         APPEND(DEST);
  4163.       {$I+}
  4164.       IF IORESULT <> 0 THEN
  4165.         {$I-}
  4166.           REWRITE(DEST);
  4167.         {$I+}
  4168.     END
  4169.   ELSE
  4170.     {$I-}
  4171.       REWRITE(DEST);
  4172.     {$I-}
  4173.   IF IORESULT <> 0 THEN
  4174.     BEGIN
  4175.       CLRSCR;
  4176.       WRITELN('*** ERROR ***   Cannot open "',DESTINATION,'"');
  4177.       WRITELN;
  4178.       WRITELN('Press <any key> ');
  4179.       WHILE KEYPRESSED DO
  4180.         READCH(CH,FALSE);
  4181.       READCH(CH,FALSE);
  4182.       CH := 'X';
  4183.       EXIT;
  4184.     END;
  4185.   for I:=0 to 255 do
  4186.     begin
  4187.       HX[I]:='00';
  4188.       temp:=I mod 16;
  4189.       if temp<=9 then
  4190.         HX[I][2]:=chr(temp+48)
  4191.       else
  4192.         HX[I][2]:=chr(temp+55);
  4193.       temp:=I div 16;
  4194.       if temp<=9 then
  4195.         HX[I][1]:=chr(temp+48)
  4196.       else
  4197.         HX[I][1]:=chr(temp+55);
  4198.     end;        
  4199.   IF DESTINATION = 'CON' THEN
  4200.     CLRSCR;
  4201.   WRITELN(DEST);
  4202.   DATEE := DATE_TIME_KEY;
  4203.   WRITELN(DEST,'*** ',COPY(DATEE,5,2),'-',
  4204.                       COPY(DATEE,7,2),'-',
  4205.                       COPY(DATEE,1,4),' ',
  4206.                       COPY(DATEE,9,2),':',
  4207.                       COPY(DATEE,11,2),':',
  4208.                       COPY(DATEE,13,2),':',
  4209.                       COPY(DATEE,15,2),'         Gemini Systems     DumpRecord');
  4210.   WRITELN(DEST);
  4211.   WRITELN(DEST,'    Variable : ',IDNAME);
  4212.   WRITELN(DEST);
  4213.   PRINT_BUFFER;
  4214.   WRITELN(DEST);
  4215.   WRITELN(DEST);
  4216.   CLOSE(DEST);
  4217.   REBUILD_SCREEN(DUMPSCREEN);
  4218. END;
  4219.  
  4220. FUNCTION GSI_DATE(INDATE : STR8; MASK : STR20) : STR80;
  4221.                 { INDATE must in format mm/dd/yy
  4222.  
  4223.                   MASK:
  4224.                          DD  = Day in format '01'
  4225.                          dd  = Day in format ' 1'
  4226.                          D   = Day in format '1'
  4227.                          MM  = Month in format '02'
  4228.                          mm  = Month in format ' 2'
  4229.                          M   = Month in format '2'
  4230.                          WW  = Month in word format
  4231.                          YY  = Year in format  '1993'
  4232.                          yy  = Year in format  '93'
  4233.  
  4234.                          All other characters in MASK
  4235.                          remain unchanged.
  4236.                                                          }
  4237. VAR
  4238.   MonthIn  : STRING[2];
  4239.   DayIn    : STRING[2];
  4240.   YearIn   : STRING[2];
  4241.   MonthOut : STRING[2];
  4242.   DayOut   : STRING[2];
  4243.   YearOut  : STRING[2];
  4244. BEGIN
  4245.   MonthIn := COPY(INDATE,1,2);
  4246.   DayIn   := COPY(INDATE,4,2);
  4247.   YearIn  := COPY(INDATE,7,2);
  4248.   WHILE POS('DD',MASK) > 0 DO
  4249.     BEGIN
  4250.       IF DayIn[1] = ' ' THEN
  4251.         DayIn[1] := '0';
  4252.       INSERT(DayIn,MASK,POS('DD',MASK));
  4253.       DELETE(MASK,POS('DD',MASK),2);
  4254.     END;
  4255.   WHILE POS('dd',MASK) > 0 DO
  4256.     BEGIN
  4257.       IF DayIn[1] = '0' THEN
  4258.         DayIn[1] := ' ';
  4259.       INSERT(DayIn,MASK,POS('dd',MASK));
  4260.       DELETE(MASK,POS('dd',MASK),2);
  4261.     END;
  4262.  
  4263.   WHILE POS('D',MASK) > 0 DO
  4264.     BEGIN
  4265.       IF DayIn[1] = '0' THEN
  4266.         DayIn[1] := ' ';
  4267.       IF DayIn[1] <> ' ' THEN
  4268.         INSERT(DayIn,MASK,POS('D',MASK))
  4269.       ELSE
  4270.         INSERT(DayIn[2],MASK,POS('D',MASK));
  4271.       DELETE(MASK,POS('D',MASK),1);
  4272.     END;
  4273.  
  4274.  
  4275.   WHILE POS('MM',MASK) > 0 DO
  4276.     BEGIN
  4277.       IF MonthIn[1] = ' ' THEN
  4278.         MonthIn[1] := '0';
  4279.       INSERT(MonthIn,MASK,POS('MM',MASK));
  4280.       DELETE(MASK,POS('MM',MASK),2);
  4281.     END;
  4282.   WHILE POS('mm',MASK) > 0 DO
  4283.     BEGIN
  4284.       IF MonthIn[1] = '0' THEN
  4285.         MonthIn[1] := ' ';
  4286.       INSERT(MonthIn,MASK,POS('mm',MASK));
  4287.       DELETE(MASK,POS('mm',MASK),2);
  4288.     END;
  4289.  
  4290.   WHILE POS('M',MASK) > 0 DO
  4291.     BEGIN
  4292.       IF MonthIn[1] = '0' THEN
  4293.         MonthIn[1] := ' ';
  4294.       IF MonthIn[1] <> ' ' THEN
  4295.         INSERT(MonthIn,MASK,POS('M',MASK))
  4296.       ELSE
  4297.         INSERT(MonthIn[2],MASK,POS('M',MASK));
  4298.       DELETE(MASK,POS('M',MASK),1);
  4299.     END;
  4300.  
  4301.  
  4302.   WHILE POS('WW',MASK) > 0 DO
  4303.     BEGIN
  4304.       CASE _INTEGER(MonthIn) OF
  4305.           1 : INSERT('January',MASK,POS('WW',MASK));
  4306.           2 : INSERT('February',MASK,POS('WW',MASK));
  4307.           3 : INSERT('March',MASK,POS('WW',MASK));
  4308.           4 : INSERT('April',MASK,POS('WW',MASK));
  4309.           5 : INSERT('May',MASK,POS('WW',MASK));
  4310.           6 : INSERT('June',MASK,POS('WW',MASK));
  4311.           7 : INSERT('July',MASK,POS('WW',MASK));
  4312.           8 : INSERT('August',MASK,POS('WW',MASK));
  4313.           9 : INSERT('September',MASK,POS('WW',MASK));
  4314.          10 : INSERT('October',MASK,POS('WW',MASK));
  4315.          11 : INSERT('November',MASK,POS('WW',MASK));
  4316.          12 : INSERT('December',MASK,POS('WW',MASK));
  4317.       END;
  4318.       DELETE(MASK,POS('WW',MASK),2);
  4319.     END;
  4320.   WHILE POS('ww',MASK) > 0 DO
  4321.     BEGIN
  4322.       CASE _INTEGER(MonthIn) OF
  4323.           1 : INSERT('January',MASK,POS('ww',MASK));
  4324.           2 : INSERT('February',MASK,POS('ww',MASK));
  4325.           3 : INSERT('March',MASK,POS('ww',MASK));
  4326.           4 : INSERT('April',MASK,POS('ww',MASK));
  4327.           5 : INSERT('May',MASK,POS('ww',MASK));
  4328.           6 : INSERT('June',MASK,POS('ww',MASK));
  4329.           7 : INSERT('July',MASK,POS('ww',MASK));
  4330.           8 : INSERT('August',MASK,POS('ww',MASK));
  4331.           9 : INSERT('September',MASK,POS('ww',MASK));
  4332.          10 : INSERT('October',MASK,POS('ww',MASK));
  4333.          11 : INSERT('November',MASK,POS('ww',MASK));
  4334.          12 : INSERT('December',MASK,POS('ww',MASK));
  4335.       END;
  4336.       DELETE(MASK,POS('ww',MASK),2);
  4337.     END;
  4338.  
  4339.   WHILE POS('YY',MASK) > 0 DO
  4340.     BEGIN
  4341.       IF YearIn[1] = ' ' THEN
  4342.         YearIn[1] := '0';
  4343.       IF _INTEGER(YearIn) >= 10 THEN
  4344.         INSERT('19'+YearIn,MASK,POS('YY',MASK))
  4345.       ELSE
  4346.         INSERT('20'+YearIn,MASK,POS('YY',MASK));
  4347.       DELETE(MASK,POS('YY',MASK),2);
  4348.     END;
  4349.   WHILE POS('yy',MASK) > 0 DO
  4350.     BEGIN
  4351.       IF YearIn[1] = '0' THEN
  4352.         YearIn[1] := ' ';
  4353.       INSERT(YearIn,MASK,POS('yy',MASK));
  4354.       DELETE(MASK,POS('yy',MASK),2);
  4355.     END;
  4356.   GSI_DATE := MASK;
  4357. END;
  4358.  
  4359. Function ValidDate(INDATE : STR8) : Boolean;
  4360.                 { INDATE must in format mm/dd/yy  }
  4361. VAR
  4362.   Day, Month, Year : Integer;
  4363. CONST
  4364.   Threshold2000 : Integer = 1900;
  4365.   MinYear = 1600;
  4366.   MaxYear = 3999;
  4367.  
  4368.       function IsLeapYear(Year : Integer) : Boolean;
  4369.         {-Return True if Year is a leap year}
  4370.       begin
  4371.         IsLeapYear := (Year mod 4 = 0) and (Year mod 4000 <> 0) and
  4372.           ((Year mod 100 <> 0) or (Year mod 400 = 0));
  4373.       end;
  4374.  
  4375.       function DaysInMonth(Month, Year : Integer) : Integer;
  4376.         {-Return the number of days in the specified month of a given year}
  4377.       begin
  4378.         if Word(Year) < 100 then
  4379.           begin
  4380.             Inc(Year, 1900);
  4381.             if Year < Threshold2000 then
  4382.               Inc(Year, 100);
  4383.           end;
  4384.         case Month of
  4385.           1, 3, 5, 7, 8, 10, 12 : DaysInMonth := 31;
  4386.                     4, 6, 9, 11 : DaysInMonth := 30;
  4387.                               2 : DaysInMonth := 28+Ord(IsLeapYear(Year));
  4388.                            else   DaysInMonth := 0;
  4389.         end;
  4390.       end;
  4391.  
  4392. begin
  4393.   Day   := _INTEGER(COPY(INDATE,4,2));
  4394.   Month := _INTEGER(COPY(INDATE,1,2));
  4395.   Year  := _INTEGER(COPY(INDATE,7,2));
  4396.   if Word(Year) < 100 then
  4397.     begin
  4398.       Inc(Year, 1900);
  4399.       if Year < Threshold2000 then
  4400.         Inc(Year, 100);
  4401.     end;
  4402.   if (Day < 1) or (Year < MinYear) or (Year > MaxYear) then
  4403.     ValidDate := False
  4404.   else
  4405.     case Month of
  4406.             1..12 : ValidDate := Day <= DaysInMonth(Month, Year);
  4407.              else   ValidDate := False;
  4408.     end
  4409. end;
  4410.  
  4411. FUNCTION KEYPRESS : BOOLEAN;
  4412. BEGIN
  4413.   KEYPRESS := KEYPRESSED OR (COMMAND_BUFFER <> '');
  4414. END;
  4415.  
  4416. BEGIN
  4417.   SHOW_ERROR := TRUE;
  4418.   EXITSAVE := EXITPROC;
  4419.   EXITPROC := @EXITHANDLER;
  4420.   TEXTATTR_AT_ENTRY := TEXTATTR;
  4421.   GEMINI_SYSTEMS := 'Hgqiul$Yyzujo|';
  4422.   UN_ENCRYPT(GEMINI_SYSTEMS,69);
  4423.  
  4424.   UT.TIMEX         := 0;
  4425.   UT.TIMEY         := 2;
  4426.   UT.TIME_TYPE     := 'N';
  4427.   UT.DATEX         := 0;
  4428.   UT.DATEY         := 2;
  4429.   UT.DATE_TYPE     := ' ';   { D,W,else }
  4430.   UT.INPUT_ATTR    := $70;
  4431.   UT.DEFAULT_ATTR  := $02;
  4432.   UT.COMPILED_DATE := '%%-%%-%%';
  4433.   UT.COMPILED_TIME := '%%:%%';
  4434.   UT.NOCONV        := FALSE;
  4435.   FILLCHAR(UT.EXITCH,SIZEOF(UT.EXITCH),1);
  4436.   FILLCHAR(UT.EXITCH[32],95,0);
  4437.   UT.EXITCH[191] := FALSE;
  4438.   UT.EXITCH[192] := FALSE;
  4439.   UT.EXITCH[8] := FALSE;
  4440.   UT.EXITCH[196] := FALSE;
  4441.   UT.EXITCH[197] := FALSE;
  4442.   UT.EXITCH[198] := FALSE;
  4443.   UT.EXITCH[199] := FALSE;
  4444.   SET_CURSOR(UNDERLINE);
  4445.   BLINK_ON;
  4446.   CGA_PRESENT := CGA_INSTALLED;
  4447.   EGA_PRESENT := EGA_INSTALLED;
  4448.   VGA_PRESENT := VGA_INSTALLED;
  4449.   CURRENT_BORDER   := 0;
  4450.   GET_DOS_VER;
  4451.   WRITE_TIME(0,1,UT.TIME_TYPE);
  4452.   WRITE_DATE(0,1,UT.DATE_TYPE);
  4453.   DISPLAY := #255;
  4454.   NOCONV  := #254;
  4455.   CLEAR   := #253;
  4456.   X_IN    := 1;
  4457.   X_OUT   := 1;
  4458.   MASTERENV;
  4459.   IF (FILE_EXIST('UTILITY.GO')) THEN
  4460.     FILL_BUFFER;
  4461.   START_TIMER(TIM);
  4462. END.
  4463.