home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / bp7os2 / oscrt4 / crt.pas next >
Pascal/Delphi Source File  |  1994-02-21  |  36KB  |  1,674 lines
  1. {$R-,I-,S-,G+}
  2.  
  3. {$C FIXED PRELOAD PERMANENT}
  4.  
  5. {$define UseAsm}
  6. {$define NoAutoShowBuf}
  7.  
  8. {**********************************************************}
  9. {                                                          }
  10. { BP4OS2: Crt Interface Unit                               }
  11. {                                                          }
  12. {         Portions of this file                            }
  13. {         Copyright (C) 1988,92 Borland International      }
  14. {         Used with permission                             }
  15. {                                                          }
  16. {----------------------------------------------------------}
  17. {  Borland - Interface                                     }
  18. {  Matthias Withopf / c't - limited Port to OS/2           }
  19. {  Brad Harrison  - completed Borland compatability        }
  20. {  Rohit Gupta  -  added KBD binary mode & break handler   }
  21. {  Dan Hughes - Converted to ASM and updated TextMode      }
  22. {**********************************************************}
  23.  
  24.  
  25.  
  26. {****************************************}
  27. {                                        }
  28. {      ***    ****   *****     *         }
  29. {      *  *   *        *      * *        }
  30. {      ***    ***      *      ***        }
  31. {      *  *   *        *     *   *       }
  32. {      ***    ****     *     *   *       }
  33. {                                        }
  34. { Please report problems (and successes) }
  35. { on BPASCAL section 17. Prefix all      }
  36. { messages with BP4OS2.                  }
  37. {                                        }
  38. { Internet: 72162.470@compuserve.com     }
  39. {                                        }
  40. {****************************************}
  41.  
  42. unit Crt;
  43.  
  44. {$ifndef OS2}
  45.   !! ERROR: This unit must be compiled for OS/2 !!
  46. {$endif}
  47.  
  48. interface
  49.  
  50. uses
  51.   BseSub;
  52.  
  53. const
  54.  
  55. { Crt modes }
  56.  
  57.   BW40          = 0;            { 40x25 B/W on Color Adapter }
  58.   CO40          = 1;            { 40x25 Color on Color Adapter }
  59.   BW80          = 2;            { 80x25 B/W on Color Adapter }
  60.   CO80          = 3;            { 80x25 Color on Color Adapter }
  61.   Mono          = 7;            { 80x25 on Monochrome Adapter }
  62.   Font8x8       = 256;          { Add-in for ROM font }
  63.  
  64. { Mode constants for 3.0 compatibility }
  65.  
  66.   C40           = CO40;
  67.   C80           = CO80;
  68.  
  69. { BP4OS2 specific Crt screen modes }
  70.  
  71.   smOs2         = 512;          { Text mode for OS/2 only }
  72.   smUnSupported = 1024;         { Unsupported mode }
  73.   smStartup     = -1;           { Initial startup mode }
  74.  
  75. { Foreground and background color constants }
  76.  
  77.   Black         = 0;
  78.   Blue          = 1;
  79.   Green         = 2;
  80.   Cyan          = 3;
  81.   Red           = 4;
  82.   Magenta       = 5;
  83.   Brown         = 6;
  84.   LightGray     = 7;
  85.  
  86. { Foreground color constants }
  87.  
  88.   DarkGray      = 8;
  89.   LightBlue     = 9;
  90.   LightGreen    = 10;
  91.   LightCyan     = 11;
  92.   LightRed      = 12;
  93.   LightMagenta  = 13;
  94.   Yellow        = 14;
  95.   White         = 15;
  96.  
  97. { Add-in for blinking }
  98.  
  99.   Blink         = 128;
  100.  
  101. var
  102.  
  103. { Interface variables }
  104.  
  105.   CheckBreak : Boolean;         { Enable Ctrl-Break }
  106.   CheckEOF   : Boolean;         { Enable Ctrl-Z }
  107.   DirectVideo: Boolean;         { Enable direct video addressing }
  108.   CheckSnow  : Boolean;         { Enable snow filtering }
  109.   LastMode   : Word;            { Current text mode }
  110.   TextAttr   : Byte;            { Current text attribute }
  111.   WindMin    : Word;            { Window upper left coordinates }
  112.   WindMax    : Word;            { Window lower right coordinates }
  113.  
  114. { Additional support for BP4OS2 }
  115.  
  116.   SaveInt1B  : Pointer;         { to pfnSighandler }
  117.   CrtVioMode : tVioModeInfo;    { Current OS/2 text mode information }
  118.   LocVioBuf  : Pointer;         { Local video buffer address }
  119.   LVBSize    : Word;            { Local video buffer size }
  120.   ShowBufDly : Word;            { ShowBuf delay factor }
  121.  
  122. { Interface procedures }
  123.  
  124. procedure AssignCrt(var F: Text);
  125. function  KeyPressed: Boolean;
  126. function  ReadKey: Char;
  127. procedure TextMode(Mode: Integer);
  128. procedure Window(X1, Y1, X2, Y2: Byte);
  129. procedure GotoXY(X, Y: Byte);
  130. function  WhereX: Byte;
  131. function  WhereY: Byte;
  132. procedure ClrScr;
  133. procedure ClrEol;
  134. procedure InsLine;
  135. procedure DelLine;
  136. procedure TextColor(Color: Byte);
  137. procedure TextBackground(Color: Byte);
  138. procedure LowVideo;
  139. procedure HighVideo;
  140. procedure NormVideo;
  141. procedure Delay(Ms: Word);
  142. procedure Sound(Hz: Word);
  143. procedure NoSound;
  144.  
  145. procedure ShowBuf;
  146. procedure AutoShowBuf(On: Boolean);
  147.  
  148. implementation
  149.  
  150. uses
  151.   OS2Def, BseDos, Dos;
  152.  
  153. type
  154.   tCell = record
  155.     c: Char;
  156.     a: Byte;
  157.   end;
  158.  
  159. const
  160.   soundStackSize   = 8192;
  161.   showBufStackSize = 8192;
  162.  
  163. var
  164.   SaveExitProc: Pointer;
  165.   StartVioMode: tVioModeInfo;
  166.   NormAttr    : Byte;             { Startup text attribute }
  167.   CurCrtSize  : Word;
  168.   ExtKeyChar  : Char;
  169.   SpaceCell   : tCell;            { cell used when SPACE+ATTRIB is needed }
  170.  
  171. { Sound() support }
  172.  
  173.   SoundHz      : Word;
  174.   SoundThreadID: PID;
  175.   SoundActive  : Boolean;
  176.   SoundStackPtr: Pointer;
  177.  
  178.   ShowBufThreadID: PID;
  179.   ShowBufActive  : Boolean;
  180.   ShowBufStackPtr: Pointer;
  181.  
  182.  
  183. { -----------------------------------------------------------}
  184. { Break handler }
  185.  
  186. procedure TriggerBreakHandler; forward;
  187.  
  188. procedure BreakHandler(A, B: Word); far;
  189.   begin
  190.     if CheckBreak then
  191.       Halt(255)
  192.     else
  193.       TriggerBreakHandler;
  194.   end;
  195.  
  196. procedure TriggerBreakHandler;
  197.   var
  198.     PrevAction: Word;
  199.   begin
  200.     DosSetSigHandler(BreakHandler, pfnSigHandler(SaveInt1B), PrevAction,
  201.                      siga_Accept, sig_CtrlBreak);
  202.   end;
  203.  
  204.  
  205. { -----------------------------------------------------------}
  206. { Get Crt Mode }
  207.  
  208. function GetCrtMode: Integer; near;
  209.   var
  210.     Mode: Integer;
  211.   begin
  212.     VioGetMode(CrtVioMode, 0);
  213.     if (CrtVioMode.fbType and 2) = 0 then
  214.       begin
  215.         if CrtVioMode.fbType = 0 then
  216.           Mode := Mono
  217.         else
  218.           begin
  219.             if CrtVioMode.col = 40 then
  220.               Mode := CO40
  221.             else if CrtVioMode.col = 80 then
  222.               Mode := CO80
  223.             else
  224.               Mode := smOs2 + CO80;
  225.             if CrtVioMode.fbType = 5 then
  226.               Dec(Mode);
  227.             if CrtVioMode.row > 25 then
  228.               Mode := Mode + Font8x8
  229.           end;
  230.       end
  231.     else
  232.       Mode := smUnSupported;
  233.     GetCrtMode := Mode;
  234.   end;
  235.  
  236.  
  237. { -----------------------------------------------------------}
  238. { Get Crt Mode }
  239.  
  240. procedure SetCrtMode(Mode: Integer); near;
  241.   begin
  242.     if Mode = smStartup then
  243.       VioSetMode(StartVioMode, 0)
  244.     else if (Mode and smOs2) <> 0 then
  245.       VioSetMode(CrtVioMode, 0)
  246.     else if (Mode < smUnSupported) then
  247.       begin
  248.         VioGetMode(CrtVioMode, 0);
  249.         case Lo(Mode) of
  250.           0:
  251.             begin
  252.               CrtVioMode.fbType := 5;
  253.               CrtVioMode.color  := 4;
  254.               CrtVioMode.col    := 40;
  255.               CrtVioMode.row    := 25;
  256.               CrtVioMode.hres   := 360;
  257.               CrtVioMode.vres   := 400;
  258.             end;
  259.           1:
  260.             begin
  261.               CrtVioMode.fbType := 1;
  262.               CrtVioMode.color  := 4;
  263.               CrtVioMode.col    := 40;
  264.               CrtVioMode.row    := 25;
  265.               CrtVioMode.hres   := 360;
  266.               CrtVioMode.vres   := 400;
  267.             end;
  268.           2:
  269.             begin
  270.               CrtVioMode.fbType := 5;
  271.               CrtVioMode.color  := 4;
  272.               CrtVioMode.col    := 80;
  273.               CrtVioMode.row    := 25;
  274.               CrtVioMode.hres   := 720;
  275.               CrtVioMode.vres   := 400;
  276.             end;
  277.           3:
  278.             begin
  279.               CrtVioMode.fbType := 1;
  280.               CrtVioMode.color  := 4;
  281.               CrtVioMode.col    := 80;
  282.               CrtVioMode.row    := 25;
  283.               CrtVioMode.hres   := 720;
  284.               CrtVioMode.vres   := 400;
  285.             end;
  286.           7:
  287.             begin
  288.               CrtVioMode.fbType := 0;
  289.               CrtVioMode.color  := 0;
  290.               CrtVioMode.col    := 80;
  291.               CrtVioMode.row    := 25;
  292.               CrtVioMode.hres   := 720;
  293.               CrtVioMode.vres   := 400;
  294.             end;
  295.         end;
  296.         if (Mode and Font8x8) <> 0 then
  297.           begin
  298.             CrtVioMode.row  := 50;
  299.             CrtVioMode.vres := 400;
  300.           end
  301.         else
  302.           begin
  303.             CrtVioMode.row  := 25;
  304.             CrtVioMode.vres := 400;
  305.           end;
  306.         VioSetMode(CrtVioMode, 0)
  307.       end;
  308.   end;
  309.  
  310.  
  311. { -----------------------------------------------------------}
  312. { Fix CRT mode }
  313.  
  314. function FixCrtMode(Mode: Integer): Integer; near;
  315.   var
  316.     FixMode: Integer;
  317.   begin
  318.     FixMode := Mode;
  319.     if (CrtVioMode.fbType and 2) <> 0  then
  320.       FixMode := CO80
  321.     else if (Mode and smOs2) = 0 then
  322.       begin
  323.         if Not(Lo(Mode) in [BW40,CO40,BW80,CO80,Mono]) then
  324.           FixMode := CO80;
  325.       end;
  326.     FixCrtMode := FixMode;
  327.   end;
  328.  
  329.  
  330. { -----------------------------------------------------------}
  331. { Setup CRT variables according to selected mode }
  332.  
  333. procedure CrtSetup; near;
  334.   begin
  335.     LastMode    := GetCrtMode;
  336.     CheckSnow   := True;
  337.     DirectVideo := True;
  338.     WindMin     := 0;
  339.     CurCrtSize  := ((CrtVioMode.row - 1) shl 8) + (CrtVioMode.col - 1);
  340.     WindMax     := CurCrtSize;
  341.     VioGetBuf(LocVioBuf, LVBSize, 0);
  342.   end;
  343.  
  344.  
  345. { -----------------------------------------------------------}
  346. { Return true if key is available }
  347.  
  348. {$ifndef UseAsm}
  349.  
  350. function KeyPressed: Boolean;
  351.   var
  352.     KeyInfo : tKbdKeyInfo;
  353.   begin
  354.     if ExtKeyChar <> #0 then
  355.       KeyPressed := True
  356.     else
  357.       begin
  358.         KbdPeek(KeyInfo, 0);
  359.         if (KeyInfo.fbStatus and $40) <> 0 then
  360.           KeyPressed := True
  361.         else
  362.           begin
  363.             KeyPressed := False;
  364.           end
  365.       end;
  366.   end;
  367.  
  368. {$else}
  369.  
  370. function KeyPressed: Boolean; assembler;
  371.   var
  372.     KeyInfo: tKbdKeyInfo;
  373.   asm
  374.     CMP   ExtKeyChar,0
  375.     JNE   @@1
  376.     PUSH  DI
  377.     LEA   DI,KeyInfo
  378.     PUSH  DS
  379.     PUSH  DI
  380.     PUSH  0000H
  381.     CALL  KbdPeek
  382.     MOV   AL,tKbdKeyInfo(DS:[DI]).fbStatus
  383.     AND   AL,40H
  384.     POP   DI
  385.     JZ    @@2
  386. @@1:
  387.     MOV   AL,1
  388. @@2:
  389.   end;
  390.  
  391. {$endif}
  392.  
  393.  
  394. { -----------------------------------------------------------}
  395. { Read character from keyboard }
  396.  
  397. {$ifndef UseAsm}
  398.  
  399. function ReadKey: Char;
  400.   var
  401.     KeyInfo: tKbdKeyInfo;
  402.   begin
  403.     if ExtKeyChar <> #0 then
  404.       begin
  405.         ReadKey    := ExtKeyChar;
  406.         ExtKeyChar := #0
  407.       end
  408.     else
  409.       begin
  410.         KbdCharIn(KeyInfo, 0, 0);
  411.         if ((KeyInfo.chChar=$00) or (KeyInfo.chChar=$E0)) and
  412.             ((KeyInfo.fbStatus and $02) <> 0) then
  413.           begin
  414.             ExtKeyChar := Char(KeyInfo.chScan);
  415.             ReadKey    := #0;
  416.           end
  417.         else
  418.           ReadKey := Char(KeyInfo.chChar);
  419.       end;
  420.   end;
  421.  
  422. {$else}
  423.  
  424. function ReadKey: Char; assembler;
  425.   var
  426.     KeyInfo: tKbdKeyInfo;
  427.   asm
  428.     PUSH  DI
  429.     MOV   AL,ExtKeyChar
  430.     MOV   ExtKeyChar,0
  431.     OR    AL,AL
  432.     JNZ   @@2
  433.     LEA   DI,KeyInfo
  434.     PUSH  DS
  435.     PUSH  DI
  436.     PUSH  0000H
  437.     PUSH  0000H
  438.     CALL  KbdCharIn
  439.     MOV   AL,tKbdKeyInfo(DS:[DI]).fbStatus
  440.     AND   AL,02H
  441.     MOV   AL,tKbdKeyInfo(DS:[DI]).chChar
  442.     JZ    @@2
  443.     CMP   AL,0E0H
  444.     JE    @@1
  445.     OR    AL,AL
  446.     JNZ   @@2
  447. @@1:
  448.     MOV   AH,tKbdKeyInfo(DS:[DI]).chScan
  449.     MOV   ExtKeyChar,AH
  450.     XOR   AL,AL
  451. @@2:
  452.     POP   DI
  453.   end;
  454.  
  455. {$endif}
  456.  
  457.  
  458. {$ifdef UseAsm}
  459.  
  460. { --------------------- Support Routine ---------------------}
  461. { Get cursor position }
  462. { Uses AX, BX, SI     }
  463.  
  464. procedure GetCursor; near; assembler;
  465.   var
  466.     Row, Col: Word;
  467.   asm
  468.     LEA   BX,Row
  469.     PUSH  DS
  470.     PUSH  BX
  471.     LEA   SI,Col
  472.     PUSH  DS
  473.     PUSH  SI
  474.     PUSH  0000H
  475.     CALL  VioGetCurPos
  476.     MOV   DH,[BX].Byte[0]
  477.     MOV   DL,[SI].Byte[0]
  478.   end;
  479.  
  480.  
  481. { --------------------- Support Routine ---------------------}
  482. { Set cursor position      }
  483. { In  DX = Cursor position }
  484. { Uses  AX                 }
  485.  
  486. procedure SetCursor; near; assembler;
  487.   asm
  488.     XOR   AH,AH
  489.     MOV   AL,DH
  490.     PUSH  AX
  491.     MOV   AL,DL
  492.     PUSH  AX
  493.     PUSH  0000H
  494.     CALL  VioSetCurPos
  495.   end;
  496.  
  497.  
  498. { --------------------- Support Routine ---------------------}
  499. { Do pending write string          }
  500. { In  BX    = Cursor position      }
  501. {     ES:SI = String start address }
  502. {     ES:DI = String end address   }
  503. { Uses  AX, BX, SI                 }
  504.  
  505. procedure DirectWrite; near; assembler;
  506.   asm
  507.     CMP   SI,DI
  508.     JE    @@2
  509.     PUSH  CX
  510.     PUSH  ES
  511.     PUSH  SI
  512.     MOV   CX,DI
  513.     SUB   CX,SI
  514.     PUSH  CX
  515.     XOR   AX,AX
  516.     MOV   AL,BH
  517.     PUSH  AX
  518.     MOV   AL,BL
  519.     PUSH  AX
  520.     LEA   AX,TextAttr
  521.     PUSH  DS
  522.     PUSH  AX
  523.     PUSH  0000H
  524.     CALL  VioWrtCharStrAtt
  525.     POP   CX
  526. @@2:
  527.   end;
  528.  
  529.  
  530. { --------------------- Support Routine ---------------------}
  531. { Do line-feed operation   }
  532. { In  DX = Cursor position }
  533. { Uses  AX, BX             }
  534.  
  535. procedure LineFeed; near; assembler;
  536.   asm
  537.     INC   DH
  538.     CMP   DH,WindMax.Byte[1]
  539.     JBE   @@1
  540.     DEC   DH
  541.     XOR   AX,AX
  542.     MOV   AL,WindMin.Byte[1]
  543.     PUSH  AX
  544.     MOV   AL,WindMin.Byte[0]
  545.     PUSH  AX
  546.     MOV   AL,WindMax.Byte[1]
  547.     PUSH  AX
  548.     MOV   AL,WindMax.Byte[0]
  549.     PUSH  AX
  550.     PUSH  0001H
  551.     MOV   AL,TextAttr
  552.     MOV   SpaceCell.a,AL
  553.     LEA   BX,SpaceCell.c
  554.     PUSH  DS
  555.     PUSH  BX
  556.     PUSH  0000h
  557.     CALL  VioScrollUp
  558. @@1:
  559.   end;
  560.  
  561. {$endif}
  562.  
  563.  
  564. { -----------------------------------------------------------}
  565. { Write character string directly to Crt }
  566.  
  567. {$ifndef UseAsm}
  568.  
  569. procedure WritePChar(S: PChar; Len: Word); near;
  570.   var
  571.     Row, Col, SCol: Word;
  572.     Cnt, SCnt     : Integer;
  573.  
  574.   procedure DirectWrite;
  575.     begin
  576.       if Cnt <> SCnt then
  577.         VioWrtCharStrAtt(@S[SCnt], Cnt - SCnt, Row, SCol, TextAttr, 0);
  578.     end;
  579.  
  580.   procedure LineFeed;
  581.     begin
  582.       if Row < Hi(WindMax) then
  583.         Inc(Row)
  584.       else
  585.         begin
  586.           SpaceCell.a := TextAttr;
  587.           VioScrollUp(Hi(WindMin), Lo(WindMin), Hi(WindMax), Lo(WindMax), 1,
  588.                       @SpaceCell, 0);
  589.         end;
  590.     end;
  591.  
  592.   begin
  593.     VioGetCurPos(Row, Col, 0);
  594.     SCol := Col;
  595.     Cnt := 0;
  596.     SCnt := Cnt;
  597.     while Cnt < Len do
  598.       begin
  599.         if S[Cnt] in [#$07,#$08,#$0A,#$0D] then
  600.           begin
  601.             DirectWrite;
  602.             case S[Cnt] of
  603.               #$07 : {bell}
  604.                 VioWrtTTY(@S[Cnt], 1, 0);
  605.               #$08 : {backspace}
  606.                 if Col <> Lo(WindMin) then
  607.                   Dec(Col);
  608.               #$0A : {line feed}
  609.                 LineFeed;
  610.               #$0D : {carriage return}
  611.                 Col := Lo(WindMin);
  612.             end;  { case }
  613.             Inc(Cnt);
  614.           end
  615.         else
  616.           begin
  617.             Inc(Cnt);
  618.             Inc(Col);
  619.             if Col <= Lo(WindMax) then
  620.               continue;
  621.             DirectWrite;
  622.             LineFeed;
  623.             Col := Lo(WindMin);
  624.           end;
  625.         SCnt := Cnt;
  626.         SCol := Col;
  627.       end;  { while }
  628.     DirectWrite;
  629.     VioSetCurPos(Row, Col, 0);
  630.   end;
  631.  
  632. {$else}
  633.  
  634. { In  CX    = Character count            }
  635. {     DX    = Position                   }
  636. {     ES:DI = String pointer             }
  637. { Uses  AX, BX, CX, DX, SI, DI, ES       }
  638.  
  639. procedure WritePChar; near; assembler;
  640.   asm
  641.     CALL  GetCursor
  642.     MOV   BX,DX
  643.     MOV   SI,DI
  644. @@1:
  645.     MOV   AL,ES:[DI]
  646.     CMP   AL,07H
  647.     JE    @@2
  648.     CMP   AL,08H
  649.     JE    @@3
  650.     CMP   AL,0AH
  651.     JE    @@4
  652.     CMP   AL,0DH
  653.     JE    @@5
  654.     INC   DI
  655.     INC   DL
  656.     CMP   DL,WindMax.Byte[0]
  657.     JBE   @@8
  658.     CALL  DirectWrite
  659.     CALL  LineFeed
  660.     MOV   DL,WindMin.Byte[0]
  661.     JMP   @@7
  662. @@2:
  663.     CALL  DirectWrite
  664.     PUSH  ES
  665.     PUSH  DI
  666.     XOR   AX,AX
  667.     INC   AX
  668.     PUSH  AX
  669.     DEC   AX
  670.     PUSH  AX
  671.     CALL  VioWrtTTY
  672.  
  673.     JMP   @@6
  674. @@3:
  675.     CALL  DirectWrite
  676.     CMP   DL,WindMin.Byte[0]
  677.     JE    @@6
  678.     DEC   DL
  679.     JMP   @@6
  680. @@4:
  681.     CALL  DirectWrite
  682.     CALL  LineFeed
  683.     JMP   @@6
  684. @@5:
  685.     CALL  DirectWrite
  686.     MOV   DL,WindMin.Byte[0]
  687. @@6:
  688.     INC   DI
  689. @@7:
  690.     MOV   SI,DI
  691.     MOV   BX,DX
  692. @@8:
  693.     LOOP  @@1
  694.     CALL  DirectWrite
  695.     CALL  SetCursor
  696.   end;
  697.  
  698. {$endif}
  699.  
  700.  
  701. {$ifdef UseAsm}
  702.  
  703. { --------------------- Support Routine ---------------------}
  704. { Writes character on Crt }
  705.  
  706. { In    AL = Character    }
  707. { Uses  None              }
  708.  
  709. procedure WriteChar; near; assembler;
  710.   var
  711.     WrkChar: Char;
  712.   asm
  713.     PUSHA
  714.     PUSH  ES
  715.     MOV   CX,1
  716.     MOV   WrkChar,AL
  717.     LEA   DI,WrkChar
  718.     PUSH  DS
  719.     POP   ES
  720.     CALL  WritePChar
  721.     POP   ES
  722.     POPA
  723.   end;
  724.  
  725. {$endif}
  726.  
  727.  
  728. { -----------------------------------------------------------}
  729. { CRT file read procedure }
  730.  
  731. {$ifndef UseAsm}
  732.  
  733. function CrtRead(var F: Text): Word; far;
  734.   var
  735.     Max    : Integer;
  736.     CurPos : Integer;
  737.     C      : Char;
  738.     C1     : Array[0..2] of Char;
  739.     Flag   : Boolean;
  740.   begin
  741.     with TextRec(F) do
  742.       begin
  743.         Max    := BufSize - 2;
  744.         CurPos := 0;
  745.         repeat
  746.           ExtKeyChar := #00;
  747.           C := ReadKey;
  748.           case C of
  749.             #8, ^S, #27, ^A :  { BS, ^S, ESC, ^A }
  750.               begin
  751.                 if (C = #8) or (C = ^S) then
  752.                   Flag := True
  753.                 else
  754.                   Flag := False;
  755.                 repeat
  756.                   if CurPos = 0 then
  757.                     Break;
  758.                   C1 := #8' '#8; WritePChar(@C1, 3);
  759.                   Dec(CurPos);
  760.                 until Flag;
  761.               end;
  762.             ^D, ^F :
  763.               begin
  764.                 if C = ^D then
  765.                   Flag := True
  766.                 else
  767.                   Flag := False;
  768.                 repeat
  769.                   if CurPos = BufPos then
  770.                     Break;
  771.                   C := BufPtr^[CurPos];
  772.                   WritePChar(@C, 1);
  773.                   Inc(CurPos);
  774.                 until Flag
  775.               end;
  776.             #13 :   { CR }
  777.               begin
  778.                 C1 := #$0D#$0A#00; WritePChar(@C1, 2);
  779.                 BufPtr^[CurPos] := #$0D; Inc(CurPos);
  780.                 BufPtr^[CurPos] := #$0A; Inc(CurPos);
  781.                 BufPos := 0;
  782.                 BufEnd := CurPos;
  783.                 Break;
  784.               end;
  785.             ^Z  :
  786.               begin
  787.                 if CheckEOF = True then
  788.                   begin
  789.                     BufPtr^[CurPos] := C;
  790.                     Inc(CurPos);
  791.                     BufPos := 0;
  792.                     BufEnd := CurPos;
  793.                     Break;
  794.                   end;
  795.               end;
  796.             #32..#255 :
  797.               if CurPos < Max then
  798.                 begin
  799.                   WritePChar(@C, 1);
  800.                   BufPtr^[CurPos] := C;
  801.                   Inc(CurPos);
  802.                   if CurPos > BufPos then
  803.                     begin
  804.                       BufPos := CurPos;
  805.                     end;
  806.                 end;
  807.           end;
  808.         until False;
  809.       end;
  810.     CrtRead := 0;
  811.   end;
  812.  
  813. {$else}
  814.  
  815. function CrtRead(var F: Text): Word; far; assembler;
  816.   asm
  817.     LES   DI, F
  818.     MOV   DX, TextRec(ES:[DI]).BufSize
  819.     DEC   DX
  820.     DEC   DX
  821.     MOV   SI, TextRec(ES:[DI]).BufPos
  822.     LES   DI, TextRec(ES:[DI]).BufPtr
  823.     XOR   BX, BX
  824. @@1:
  825.     MOV   ExtKeyChar,0
  826.     CALL  ReadKey
  827.     MOV   CX,1
  828.     CMP   AL,08H
  829.     JE    @@2
  830.     CMP   AL,'S'-64
  831.     JE    @@2
  832.     CMP   AL,'D'-64
  833.     JE    @@3
  834.     DEC   CX
  835.     CMP   AL,1BH
  836.     JE    @@2
  837.     CMP   AL,'A'-64
  838.     JE    @@2
  839.     CMP   AL,'F'-64
  840.     JE    @@3
  841.     CMP   AL,1AH
  842.     JE    @@4
  843.     CMP   AL,0DH
  844.     JE    @@5
  845.     CMP   AL,' '
  846.     JB    @@1
  847.     CMP   BX,DX
  848.     JE    @@1
  849.     MOV   ES:[DI+BX],AL
  850.     INC   BX
  851.     CALL  WriteChar
  852.     CMP   BX,SI
  853.     JBE   @@1
  854.     MOV   SI,BX
  855.     JMP   @@1
  856. @@2:
  857.     OR    BX,BX
  858.     JE    @@1
  859.     MOV   AL,08H
  860.     CALL  WriteChar
  861.     MOV   AL,' '
  862.     CALL  WriteChar
  863.     MOV   AL,08H
  864.     CALL  WriteChar
  865.     DEC   BX
  866.     LOOP  @@2
  867.     JMP   @@1
  868. @@3:
  869.     CMP   BX,SI
  870.     JE    @@1
  871.     MOV   AL,ES:[DI+BX]
  872.     CMP   AL,' '
  873.     JB    @@1
  874.     CALL  WriteChar
  875.     INC   BX
  876.     LOOP  @@3
  877.     JMP   @@1
  878. @@4:
  879.     CMP   CheckEOF,0
  880.     JE    @@1
  881.     MOV   ES:[DI+BX],AL
  882.     INC   BX
  883.     JMP   @@6
  884. @@5:
  885.     MOV   AL,0DH
  886.     CALL  WriteChar
  887.     MOV   AL,0AH
  888.     CALL  WriteChar
  889.     MOV   WORD PTR ES:[DI+BX],0A0DH
  890.     INC   BX
  891.     INC   BX
  892. @@6:
  893.     LES   DI,F
  894.     XOR   AX,AX
  895.     MOV   TextRec(ES:[DI]).BufPos,AX
  896.     MOV   TextRec(ES:[DI]).Bufend,BX
  897.   end;
  898.  
  899. {$endif}
  900.  
  901.  
  902. { -----------------------------------------------------------}
  903. { CRT file write procedure }
  904.  
  905. {$ifndef UseAsm}
  906.  
  907. function CrtWrite(var F: Text): Word; far;
  908.   begin
  909.     with TextRec(F) do
  910.       begin
  911.         WritePChar(PChar(BufPtr), BufPos);
  912.         BufPos := 0;
  913.       end;
  914.     CrtWrite := 0;
  915.   end;
  916.  
  917. {$else}
  918.  
  919. function CrtWrite(var F: Text): Word; far; assembler;
  920.   asm
  921.     LES   DI,F
  922.     MOV   CX,TextRec(ES:[DI]).BufPos
  923.     SUB   TextRec(ES:[DI]).BufPos,CX
  924.     JCXZ  @@1
  925.     LES   DI,TextRec(ES:[DI]).BufPtr
  926.     CALL  WritePChar
  927. @@1:
  928.     XOR   AX,AX
  929.   end;
  930.  
  931. {$endif}
  932.  
  933.  
  934. { -----------------------------------------------------------}
  935. { CRT file no-op procedure }
  936.  
  937. {$ifndef UseAsm}
  938.  
  939. function CrtReturn(var F: Text): Word; far;
  940.   begin
  941.     CrtReturn := 0;
  942.   end;
  943.  
  944. {$else}
  945.  
  946. function CrtReturn(var F: Text): Word; far; assembler;
  947.   asm
  948.     XOR AX,AX
  949.   end;
  950.  
  951. {$endif}
  952.  
  953.  
  954. { -----------------------------------------------------------}
  955. { CRT file open procedure }
  956.  
  957. {$ifndef UseAsm}
  958.  
  959. function CrtOpen(Var F: Text): Word; far;
  960.   var
  961.     InOut,
  962.     Flush: Pointer;
  963.   begin
  964.     with TextRec(F) do
  965.       begin
  966.         if Mode = fmInput then
  967.           begin
  968.             InOut := @CrtRead;
  969.             Flush := @CrtReturn;
  970.           end
  971.         else
  972.           begin
  973.             Mode := fmOutput;
  974.             InOut := @CrtWrite;
  975.             Flush := @CrtWrite;
  976.           end;
  977.         InOutFunc := InOut;
  978.         FlushFunc := Flush;
  979.         CloseFunc := @CrtReturn;
  980.       end;
  981.     CrtOpen := 0;
  982.   end;
  983.  
  984. {$else}
  985.  
  986. function CrtOpen(var F: Text): Word; far; assembler;
  987.   asm
  988.     LES   DI,F
  989.     MOV   AX,OFFSET CrtRead
  990.     MOV   BX,OFFSET CrtReturn
  991.     MOV   CX,BX
  992.     CMP   TextRec(ES:[DI]).Mode,fmInput
  993.     JE    @@1
  994.     MOV   TextRec(ES:[DI]).Mode,fmOutput
  995.     MOV   AX,OFFSET CrtWrite
  996.     MOV   BX,AX
  997. @@1:
  998.     MOV   TextRec(ES:[DI]).InOutFunc.Word[0],AX
  999.     MOV   TextRec(ES:[DI]).InOutFunc.Word[2],CS
  1000.     MOV   TextRec(ES:[DI]).FlushFunc.Word[0],BX
  1001.     MOV   TextRec(ES:[DI]).FlushFunc.Word[2],CS
  1002.     MOV   TextRec(ES:[DI]).CloseFunc.Word[0],CX
  1003.     MOV   TextRec(ES:[DI]).CloseFunc.Word[2],CS
  1004.     XOR   AX,AX
  1005.   end;
  1006.  
  1007. {$endif}
  1008.  
  1009.  
  1010. { -----------------------------------------------------------}
  1011. { Assign Crt to textfile }
  1012.  
  1013. {$ifndef UseAsm}
  1014.  
  1015. procedure AssignCrt(var F: Text);
  1016.   begin
  1017.     with TextRec(F) do
  1018.       begin
  1019.         Mode     := fmClosed;
  1020.         BufSize  := 128;
  1021.         BufPtr   := @Buffer;
  1022.         OpenFunc := @CrtOpen;
  1023.       end;
  1024.     end;
  1025.  
  1026. {$else}
  1027.  
  1028. procedure AssignCrt(var F: Text); assembler;
  1029.   asm
  1030.     LES   DI,F
  1031.     MOV   TextRec(ES:[DI]).Mode,fmClosed
  1032.     MOV   TextRec(ES:[DI]).BufSize,128
  1033.     LEA   AX,TextRec(ES:[DI]).Buffer
  1034.     MOV   TextRec(ES:[DI]).BufPtr.Word[0],AX
  1035.     MOV   TextRec(ES:[DI]).BufPtr.Word[2],ES
  1036.     MOV   TextRec(ES:[DI]).OpenFunc.Word[0],OFFSET CrtOpen
  1037.     MOV   TextRec(ES:[DI]).OpenFunc.Word[2],CS
  1038.     MOV   TextRec(ES:[DI]).Name.Byte[0],0
  1039.   end;
  1040.  
  1041. {$endif}
  1042.  
  1043.  
  1044. { -----------------------------------------------------------}
  1045. { Set Crt text mode }
  1046.  
  1047. procedure TextMode(Mode: Integer);
  1048.   begin
  1049.     SetCrtMode(FixCrtMode(Mode));
  1050.     CrtSetup;
  1051.     TextAttr := NormAttr;
  1052.     ClrScr;
  1053.   end;
  1054.  
  1055.  
  1056. { -----------------------------------------------------------}
  1057. { Define output window }
  1058.  
  1059. {$ifndef UseAsm}
  1060.  
  1061. procedure Window(X1, Y1, X2, Y2: Byte);
  1062.   begin
  1063.     if X1 > X2 then Exit;
  1064.     if Y1 > Y2 then Exit;
  1065.     Dec(X1);
  1066.     if X1 < 0 then Exit;
  1067.     Dec(Y1);
  1068.     if Y1 < 0 then Exit;
  1069.     Dec(X2);
  1070.     if X2 > Lo(CurCrtSize) then Exit;
  1071.     Dec(Y2);
  1072.     if y2 > Hi(CurCrtSize) then Exit;
  1073.     WindMin := (Y1 shl 8) + X1;
  1074.     WindMax := (Y2 shl 8) + X2;
  1075.     GotoXY(1, 1);
  1076.   End;
  1077.  
  1078. {$else}
  1079.  
  1080. procedure Window(X1, Y1, X2, Y2: Byte); assembler;
  1081.   asm
  1082.     MOV   DL,X1
  1083.     MOV   DH,Y1
  1084.     MOV   CL,X2
  1085.     MOV   CH,Y2
  1086.     CMP   DL,CL
  1087.     JA    @@1
  1088.     CMP   DH,CH
  1089.     JA    @@1
  1090.     DEC   DL
  1091.     JS    @@1
  1092.     DEC   DH
  1093.     JS    @@1
  1094.     DEC   CL
  1095.     CMP   CL,CurCrtSize.Byte[0]
  1096.     JA    @@1
  1097.     DEC   CH
  1098.     CMP   CH,CurCrtSize.Byte[1]
  1099.     JA    @@1
  1100.     MOV   WindMin,DX
  1101.     MOV   WindMax,CX
  1102.     CALL  SetCursor
  1103. @@1:
  1104.   end;
  1105.  
  1106. {$endif}
  1107.  
  1108.  
  1109. { -----------------------------------------------------------}
  1110. { Position cursor }
  1111.  
  1112. {$ifndef UseAsm}
  1113.  
  1114. procedure GotoXY(X,Y: Byte);
  1115.   begin
  1116.     Dec(X);
  1117.     X := X + Lo(WindMin);
  1118.     if X > Lo(WindMax) then
  1119.       Exit;
  1120.     Dec(Y);
  1121.     Y := Y + Hi(WindMin);
  1122.     if Y > Hi(WindMax) then
  1123.       Exit;
  1124.     VioSetCurPos(Y, X, 0);
  1125.   End;
  1126.  
  1127. {$else}
  1128.  
  1129. procedure GotoXY(X, Y: Byte); assembler;
  1130.   asm
  1131.     MOV   DL,X
  1132.     MOV   DH,Y
  1133.     DEC   DL
  1134.     ADD   DL,WindMin.Byte[0]
  1135.     JC    @@1
  1136.     CMP   DL,WindMax.Byte[0]
  1137.     JA    @@1
  1138.     DEC   DH
  1139.     ADD   DH,WindMin.Byte[1]
  1140.     JC    @@1
  1141.     CMP   DH,WindMax.Byte[1]
  1142.     JA    @@1
  1143.     CALL  SetCursor
  1144. @@1:
  1145.   end;
  1146.  
  1147. {$endif}
  1148.  
  1149.  
  1150. { -----------------------------------------------------------}
  1151. { Return cursor X coordinate }
  1152.  
  1153. {$ifndef UseAsm}
  1154.  
  1155. function WhereX;
  1156.   var
  1157.     Row, Col: Word;
  1158.   begin
  1159.     VioGetCurPos(Row, Col, 0);
  1160.     WhereX := Col - Lo(WindMin) + 1;
  1161.   end;
  1162.  
  1163. {$else}
  1164.  
  1165. function WhereX: Byte; assembler;
  1166.   asm
  1167.     CALL  GetCursor
  1168.     MOV   AL,DL
  1169.     SUB   AL,WindMin.Byte[0]
  1170.     INC   AL
  1171.   end;
  1172.  
  1173. {$endif}
  1174.  
  1175.  
  1176. { -----------------------------------------------------------}
  1177. { Return cursor Y coordinate }
  1178.  
  1179. {$ifndef UseAsm}
  1180.  
  1181. function WhereY: Byte;
  1182.   var
  1183.     Row, Col: Word;
  1184.   begin
  1185.     VioGetCurPos(Row, Col, 0);
  1186.     WhereY := Row - Hi(WindMin) + 1;
  1187.   end;
  1188.  
  1189. {$else}
  1190.  
  1191. function WhereY: Byte; assembler;
  1192.   asm
  1193.     CALL  GetCursor
  1194.     MOV   AL,DH
  1195.     SUB   AL,WindMin.Byte[1]
  1196.     INC   AL
  1197.   end;
  1198.  
  1199. {$endif}
  1200.  
  1201.  
  1202. { -----------------------------------------------------------}
  1203. { Clear screen }
  1204.  
  1205. {$ifndef UseAsm}
  1206.  
  1207. procedure ClrScr;
  1208.   begin
  1209.     SpaceCell.a := TextAttr;
  1210.     VioScrollUp(Hi(WindMin), Lo(WindMin), Hi(WindMax), Lo(WindMax),
  1211.                 Hi(WindMax) - Hi(WindMin) + 1, @SpaceCell, 0);
  1212.     GotoXY(1, 1);
  1213.   end;
  1214.  
  1215. {$else}
  1216.  
  1217. procedure ClrScr; assembler;
  1218.   asm
  1219.     XOR   AX,AX
  1220.     MOV   AL,WindMin.Byte[1]
  1221.     MOV   BX,AX
  1222.     PUSH  AX
  1223.     MOV   AL,WindMin.Byte[0]
  1224.     PUSH  AX
  1225.     MOV   AL,WindMax.Byte[1]
  1226.     PUSH  AX
  1227.     SUB   AL,BL
  1228.     MOV   BL,AL
  1229.     INC   BL
  1230.     MOV   AL,WindMax.Byte[0]
  1231.     PUSH  AX
  1232.     PUSH  BX
  1233.     MOV   AL,TextAttr
  1234.     MOV   SpaceCell.a,AL
  1235.     LEA   BX,SpaceCell.c
  1236.     PUSH  DS
  1237.     PUSH  BX
  1238.     PUSH  0000H
  1239.     CALL  VioScrollUp
  1240.     XOR   AX,AX
  1241.     INC   AX
  1242.     PUSH  AX
  1243.     PUSH  AX
  1244.     CALL  GotoXY
  1245.   end;
  1246.  
  1247. {$endif}
  1248.  
  1249.  
  1250. { -----------------------------------------------------------}
  1251. { Clear to end-of-line }
  1252.  
  1253. {$ifndef UseAsm}
  1254.  
  1255. procedure ClrEol;
  1256.   var
  1257.     Row, Col: Word;
  1258.   begin
  1259.     VioGetCurPos(Row, Col, 0);
  1260.     SpaceCell.a := TextAttr;
  1261.     VioScrollUp(Row, Col, Row, Lo(WindMax), 1, @SpaceCell, 0);
  1262.   end;
  1263.  
  1264. {$else}
  1265.  
  1266. procedure ClrEol; assembler;
  1267.   asm
  1268.     CALL  GetCursor
  1269.     XOR   AX,AX
  1270.     MOV   AL,DH
  1271.     MOV   BX,AX
  1272.     PUSH  AX
  1273.     MOV   AL,DL
  1274.     PUSH  AX
  1275.     PUSH  AX
  1276.     MOV   AL,WindMax.Byte[0]
  1277.     PUSH  AX
  1278.     PUSH  0001H
  1279.     MOV   AL,TextAttr
  1280.     MOV   SpaceCell.a,AL
  1281.     LEA   BX,SpaceCell.c
  1282.     PUSH  DS
  1283.     PUSH  BX
  1284.     PUSH  0000H
  1285.     CALL  VioScrollUp
  1286.   end;
  1287.  
  1288. {$endif}
  1289.  
  1290.  
  1291. { -----------------------------------------------------------}
  1292. { Insert line }
  1293.  
  1294. {$ifndef UseAsm}
  1295.  
  1296. procedure InsLine;
  1297.   var
  1298.     Row, Col: Word;
  1299.   begin
  1300.     VioGetCurPos(Row, Col, 0);
  1301.     SpaceCell.a := TextAttr;
  1302.     VioScrollDn(Row, Lo(WindMin), Hi(WindMax), Lo(WindMax), 1, @SpaceCell, 0);
  1303.   end;
  1304.  
  1305. {$else}
  1306.  
  1307. procedure InsLine; assembler;
  1308.   asm
  1309.     CALL  GetCursor
  1310.     XOR   AX,AX
  1311.     MOV   AL,DH
  1312.     PUSH  AX
  1313.     MOV   AL,WindMin.Byte[0]
  1314.     PUSH  AX
  1315.     MOV   AL,WindMax.Byte[1]
  1316.     PUSH  AX
  1317.     MOV   AL,WindMax.Byte[0]
  1318.     PUSH  AX
  1319.     PUSH  0001H
  1320.     MOV   AL,TextAttr
  1321.     MOV   SpaceCell.a,AL
  1322.     LEA   BX,SpaceCell.c
  1323.     PUSH  DS
  1324.     PUSH  BX
  1325.     PUSH  0000H
  1326.     CALL  VioScrollDn
  1327.   end;
  1328.  
  1329. {$endif}
  1330.  
  1331.  
  1332. { -----------------------------------------------------------}
  1333. { Delete line }
  1334.  
  1335. {$ifndef UseAsm}
  1336.  
  1337. procedure DelLine;
  1338.   var
  1339.     Row, Col: Word;
  1340.   begin
  1341.     VioGetCurPos(Row, Col, 0);
  1342.     SpaceCell.a := TextAttr;
  1343.     VioScrollUp(Row, Lo(WindMin), Hi(WindMax), Lo(WindMax), 1, @SpaceCell, 0);
  1344.   end;
  1345.  
  1346. {$else}
  1347.  
  1348. procedure DelLine; assembler;
  1349.   asm
  1350.     CALL  GetCursor
  1351.     XOR   AX,AX
  1352.     MOV   AL,DH
  1353.     PUSH  AX
  1354.     MOV   AL,WindMin.Byte[0]
  1355.     PUSH  AX
  1356.     MOV   AL,WindMax.Byte[1]
  1357.     PUSH  AX
  1358.     MOV   AL,WindMax.Byte[0]
  1359.     PUSH  AX
  1360.     PUSH  0001H
  1361.     MOV   AL,TextAttr
  1362.     MOV   SpaceCell.a,AL
  1363.     LEA   BX,SpaceCell.c
  1364.     PUSH  DS
  1365.     PUSH  BX
  1366.     PUSH  0000H
  1367.     CALL  VioScrollUp
  1368.   end;
  1369.  
  1370. {$endif}
  1371.  
  1372.  
  1373. { -----------------------------------------------------------}
  1374. { Set text color (color modes) }
  1375.  
  1376. {$ifndef UseAsm}
  1377.  
  1378. procedure TextColor(Color: Byte);
  1379.   begin
  1380.     TextAttr := (TextAttr and $70) or
  1381.                 (Color and $0F) + Ord(Color > $0F) * $80;
  1382.   end;
  1383.  
  1384. {$else}
  1385.  
  1386. procedure TextColor(Color: Byte); assembler;
  1387.   asm
  1388.     MOV   AL,Color
  1389.     TEST  AL,0F0H
  1390.     JE    @@1
  1391.     AND   AL,0FH
  1392.     OR    AL,80H
  1393. @@1:
  1394.     AND   TextAttr,70H
  1395.     OR    TextAttr,AL
  1396.   end;
  1397.  
  1398. {$endif}
  1399.  
  1400.  
  1401. { -----------------------------------------------------------}
  1402. { Set text background (color modes) }
  1403.  
  1404. {$ifndef UseAsm}
  1405.  
  1406. procedure TextBackground;
  1407.   begin
  1408.     TextAttr := (TextAttr and $8F) or ((Color and $07) shl 4);
  1409.   end;
  1410.  
  1411. {$else}
  1412.  
  1413. procedure TextBackground; assembler;
  1414.   asm
  1415.     MOV   AL,Color
  1416.     AND   AL,7
  1417.     MOV   CL,4
  1418.     SHL   AL,CL
  1419.     AND   TextAttr,8FH
  1420.     OR    TextAttr,AL
  1421.   end;
  1422.  
  1423. {$endif}
  1424.  
  1425.  
  1426. { -----------------------------------------------------------}
  1427. { Select low intensity }
  1428.  
  1429. {$ifndef UseAsm}
  1430.  
  1431. procedure LowVideo;
  1432.   begin
  1433.     TextAttr := TextAttr and $F7;
  1434.   end;
  1435.  
  1436.  
  1437. {$else}
  1438.  
  1439. procedure LowVideo; assembler;
  1440.   asm
  1441.     AND   TextAttr,0F7H
  1442.   end;
  1443.  
  1444. {$endif}
  1445.  
  1446.  
  1447. { -----------------------------------------------------------}
  1448. { Select high intensity }
  1449.  
  1450. {$ifndef UseAsm}
  1451.  
  1452. procedure HighVideo;
  1453.   begin
  1454.     TextAttr := TextAttr or $08;
  1455.   end;
  1456.  
  1457. {$else}
  1458.  
  1459. procedure HighVideo; assembler;
  1460.   asm
  1461.     OR    TextAttr,8
  1462.   end;
  1463.  
  1464. {$endif}
  1465.  
  1466.  
  1467. { -----------------------------------------------------------}
  1468. { Select normal intensity }
  1469.  
  1470. {$ifndef UseAsm}
  1471.  
  1472. procedure NormVideo;
  1473.   begin
  1474.     TextAttr := NormAttr;
  1475.   end;
  1476.  
  1477. {$else}
  1478.  
  1479. procedure NormVideo; assembler;
  1480.   asm
  1481.     MOV   AL,NormAttr
  1482.     MOV   TextAttr,AL
  1483.   end;
  1484.  
  1485. {$endif}
  1486.  
  1487.  
  1488. { -----------------------------------------------------------}
  1489. { Delay specified number of milliseconds }
  1490.  
  1491. {$ifndef UseAsm}
  1492.  
  1493. procedure Delay(MS: Word);
  1494.   begin
  1495.     if MS <> 0 then
  1496.       DosSleep(Ms);
  1497.   end;
  1498.  
  1499. {$else}
  1500.  
  1501. procedure Delay(Ms: Word); assembler;
  1502.   asm
  1503.     MOV   AX,Ms
  1504.     OR    AX,AX
  1505.     JZ    @@1
  1506.     PUSH  0000H
  1507.     PUSH  AX
  1508.     CALL  DosSleep
  1509. @@1:
  1510.   end;
  1511. {$endif}
  1512.  
  1513.  
  1514. { -----------------------------------------------------------}
  1515. { Sound thead }
  1516.  
  1517. procedure SoundThread; far;
  1518.   begin
  1519.     repeat
  1520.       DosBeep(SoundHz, 50);
  1521.     until False;
  1522.   end;
  1523.  
  1524.  
  1525. { -----------------------------------------------------------}
  1526. { Start sound generator }
  1527.  
  1528. procedure Sound(Hz: Word);
  1529.   begin
  1530.     SoundHz := Hz;
  1531.     if SoundActive then
  1532.       DosResumeThread(SoundThreadID)
  1533.     else
  1534.       begin
  1535.         GetMem(SoundStackPtr, soundStackSize);
  1536.         SoundActive := True;
  1537.         DosCreateThread(SoundThread, SoundThreadID,
  1538.                         @PChar(SoundStackPtr)[soundStackSize]);
  1539.       end;
  1540.   end;
  1541.  
  1542.  
  1543. { -----------------------------------------------------------}
  1544. { Turn off sound generator }
  1545.  
  1546. procedure NoSound;
  1547.   begin
  1548.     if SoundActive then
  1549.       DosSuspendThread(SoundThreadID);
  1550.     { If it was possible to cancel a task, then:  }
  1551.     { FreeMem(SoundStackPtr, SoundStackSize);     }
  1552.     { SoundActive := False;                       }
  1553.   end;
  1554.  
  1555.  
  1556. { -----------------------------------------------------------}
  1557. { Show local video buffer }
  1558.  
  1559. procedure ShowBuf;
  1560.   begin
  1561.     VioShowBuf(0, LVBSize, 0);
  1562.   end;
  1563.  
  1564.  
  1565. { -----------------------------------------------------------}
  1566. { ShowBuf thead }
  1567.  
  1568. procedure ShowBufThread; far;
  1569.   begin
  1570.     repeat
  1571.       DosSleep(ShowBufDly);
  1572.       VioShowBuf(0, LVBSize, 0);
  1573.     until False;
  1574.   end;
  1575.  
  1576.  
  1577. { -----------------------------------------------------------}
  1578. { Start ShowBuf thread }
  1579.  
  1580. procedure AutoShowBuf(On: Boolean);
  1581.   begin
  1582.     case On of
  1583.       False:
  1584.         begin
  1585.           if ShowBufActive then
  1586.             DosSuspendThread(ShowBufThreadID);
  1587.         end;
  1588.       True:
  1589.         begin
  1590.           if ShowBufActive then
  1591.             DosResumeThread(ShowBufThreadID)
  1592.           else
  1593.             begin
  1594.               GetMem(ShowBufStackPtr, showBufStackSize);
  1595.               ShowBufActive := True;
  1596.               DosCreateThread(ShowBufThread, ShowBufThreadID,
  1597.                               @PChar(ShowBufStackPtr)[showBufStackSize]);
  1598.             end;
  1599.         end;
  1600.     end;
  1601.   end;
  1602.  
  1603.  
  1604. { -----------------------------------------------------------}
  1605. { Crt exit procedure }
  1606.  
  1607. procedure CrtExitProc; far;
  1608.   begin
  1609.     { restore previous exit handler }
  1610.     ExitProc := SaveExitProc;
  1611.  
  1612.     { Show the last writes to the LVB }
  1613.     ShowBuf;
  1614.   end;
  1615.  
  1616.  
  1617. { -----------------------------------------------------------}
  1618. { One-time initialization }
  1619.  
  1620. procedure Initialize; near;
  1621.   const
  1622.     P2: Word = 2;
  1623.     ModeChg: Boolean = False;
  1624.  
  1625.   var
  1626.     Row, Col: Word;
  1627.     RCell   : tCell;
  1628.     Status  : tKbdInfo;
  1629.     Mode    : Integer;
  1630.  
  1631.   begin
  1632.     SoundActive   := False;
  1633.     ExtKeyChar    := #0;
  1634.     SpaceCell.c   := ' ';                             { space }
  1635.     CrtVioMode.cb := SizeOf(tVioModeInfo);
  1636.     LastMode      := GetCrtMode;
  1637.     StartVioMode  := CrtVioMode;
  1638.     Mode          := FixCrtMode(LastMode);
  1639.     if Mode <> LastMode then
  1640.       begin
  1641.         SetCrtMode(Mode);
  1642.         ModeChg := True;
  1643.       end;
  1644.     CrtSetup;
  1645.     ShowBufDly    := 10;
  1646.     ShowBufActive := False;
  1647. {$ifndef NoAutoShowBuf}
  1648.     AutoShowBuf(True)
  1649. {$endif}
  1650.     VioGetCurPos(Row, Col, 0);
  1651.     VioReadCellStr(RCell, P2, Row, Col, 0);
  1652.     NormAttr  := RCell.a and $7F;
  1653.     TextAttr  := NormAttr;
  1654.     CheckEOF  := False;
  1655.     if ModeChg then
  1656.       ClrScr;
  1657.     Status.cb := 10;                                  { Set KBD to binary }
  1658.     KbdGetStatus(Status, 0);                          { mode, else ctrl-c }
  1659.     Status.fsMask := (Status.fsMask and $80) or $6;   { is linked to      }
  1660.     KbdSetStatus(Status, 0);                          { ctrl-break        }
  1661.  
  1662.     CheckBreak   := True;
  1663.     TriggerBreakHandler;                              { Break Handler }
  1664.     SaveExitProc := ExitProc;                         { save old exit handler }
  1665.     ExitProc     := @CrtExitProc;                     { install exit handler }
  1666.   end;
  1667.  
  1668.  
  1669. begin
  1670.   Initialize;
  1671.   AssignCrt(Input);  Reset(Input);
  1672.   AssignCrt(Output); Rewrite(Output);
  1673. end.
  1674.