home *** CD-ROM | disk | FTP | other *** search
/ On Disk Monthly 62 / odm62.zip / GDSOURCE.EXE / PASQWIK.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-14  |  20KB  |  778 lines
  1. unit pasqwik;
  2. {$R-,S-,L-,D-,I-,V-}
  3.  
  4. interface
  5.  
  6. USES dos;
  7.  
  8. TYPE ScreenCharAttr = RECORD
  9.              Ch: char;
  10.              At: byte;
  11.           END;
  12.  
  13.      ScreenMap = array [1..2000] of ScreenCharAttr;
  14.  
  15.      GetArrayType = RECORD
  16.               C,
  17.               R: byte;
  18.              CA: array [0..1999] of ScreenCharAttr;
  19.           END;
  20.  
  21. TYPE ByteArray = array [0..4000] of byte;
  22.      ByteBufferPtr = ^ByteArray;
  23.  
  24. TYPE BoxArray = array [1..9] of char;
  25.      GridArray = array [1..16] of char;
  26.      AdapterType = (MDA, CGA, MCGA, EGA, VGA);
  27.  
  28. CONST SameAttr = $55;
  29.  
  30. CONST SingleGrid : GridArray = ('┌', '─', '┬', '┐',
  31.                                 '│', '.', '│', '│',
  32.                                 '├', '─', '┼', '┤',
  33.                                 '└', '─', '┴', '┘');
  34. CONST DoubleGrid : GridArray = ('╔', '═', '╦', '╗',
  35.                                 '║', ' ', '║', '║',
  36.                                 '╠', '═', '╬', '╣',
  37.                                 '╚', '═', '╩', '╝');
  38. CONST SingleBox : BoxArray = ('┌', '─', '┐',
  39.                               '│', ' ', '│',
  40.                               '└', '─', '┘');
  41. CONST DoubleBox : BoxArray = ('╔', '═', '╗',
  42.                               '║', ' ', '║',
  43.                               '╚', '═', '╝');
  44. CONST SingleSide: BoxArray = ('╒', '═', '╕',
  45.                               '│', ' ', '│',
  46.                               '╘', '═', '╛');
  47. CONST DoubleSide: BoxArray = ('╓', '─', '╖',
  48.                               '║', ' ', '║',
  49.                               '╙', '─', '╜');
  50. CONST MarieBox  : BoxArray = ('▄', '▄', '▄',
  51.                               '█', ' ', '█',
  52.                               '▀', '▀', '▀');
  53. CONST GeorgeBox : BoxArray = ('▐', '▀', '▌',
  54.                               '▐', ' ', '▌',
  55.                               '▐', '▄', '▌');
  56. CONST Button    : BoxArray = ('┌', '─', '╖',
  57.                               '│', ' ', '║',
  58.                               '╘', '═', '╝');
  59. CONST HappyBox  : BoxArray = ('', '', '',
  60.                               '', ' ', '',
  61.                               '', '', '');
  62. CONST EmptyBox  : boxarray = (' ', ' ', ' ',
  63.                               ' ', ' ', ' ',
  64.                               ' ', ' ', ' ');
  65. CONST ShadowBox : boxarray = (' ', ' ', '▄',
  66.                               ' ', ' ', '█',
  67.                               ' ', '▀', '▀');
  68.  
  69.  
  70.  
  71. VAR  ScrOfs,                             { Screen Segment for writing }
  72.      ScrSeg       : word;                { Screen Offset for writing}
  73.      Screen       : ^ScreenCharAttr absolute ScrOfs;
  74.      PagOfs       : word;
  75.      CRTrows,
  76.      CRTcolumns   : byte;                { Number of Screen rows and columns}
  77.      VideoAdapter : AdapterType;
  78.      StartCursor  : word;
  79.  
  80. (**  use SameAttr to not rewrite the existing string attributes.  **)
  81.  
  82. PROCEDURE SetCursor(Top, Bottom: byte);
  83. FUNCTION  GetCursor: word;
  84. PROCEDURE GotoRC(Row, Col: byte);
  85. PROCEDURE Qwrite(Row, Col, Attr: byte; St: string);
  86. PROCEDURE QwriteS(Row, Col: byte; St: string);
  87. PROCEDURE QwriteC(Row, ColL, ColR, Attr: byte; St: string);
  88. PROCEDURE QwriteA(Attr: byte; St: string);
  89. PROCEDURE QwriteL(Row, Col, Attr: byte; St: string; Start, Lengt: byte);
  90. PROCEDURE QwriteV(Row, Col, Attr: byte; St: string);
  91. PROCEDURE QwriteU(Row, Col, Attr: byte; St: string);
  92. PROCEDURE Qfill(Row, Col, Rows, Cols, Attr: byte; Ch: char);
  93. PROCEDURE QAttr(Row, Col, Rows, Cols, Attr: byte);
  94. PROCEDURE QXorAttr(Row, Col, Rows, Cols, Attr: byte);
  95. FUNCTION  GetAttr(Row, Col: byte): byte;
  96. PROCEDURE SetAttr(Row, Col, Attr: byte);
  97. FUNCTION  GetChar(Row, Col: byte): char;
  98. PROCEDURE SetChar(Row, Col: byte; Ch: char);
  99. PROCEDURE XorAttr(Row, Col, Attr: byte);
  100.  
  101. FUNCTION TextImageSize(Rows, Cols: byte): integer;
  102. PROCEDURE TextGet(Row, Col, Rows, Cols: byte; VAR Arr);
  103. PROCEDURE TextPut(Row, Col: byte; VAR Arr);
  104. PROCEDURE TextSwap(Row, Col: byte; VAR Arr);
  105. PROCEDURE Textrestore(Row, Col, Rows, Cols: byte; VAR Arr);
  106. PROCEDURE Qbox(Row, Col, Rows, Cols, WindowAttr, BorderAttr: byte;
  107.                                              VAR BxArry: BoxArray);
  108. PROCEDURE Qgrid(Row, Col: byte; VAR ZR; VAR ZC;
  109.                 WindowAttr, BorderAttr: byte; VAR GdArry: GridArray);
  110. FUNCTION  GridSize(Arr: ByteArray): integer;
  111. PROCEDURE ShadowedBox(Row, Col, Rows, Cols, WindowAttr, BorderAttr: byte;
  112.                                    VAR Box: BoxArray; ShadowAmount: byte);
  113. PROCEDURE BoxMessage(Row, Col, Attr: byte; St: string; VAR Box: BoxArray);
  114. PROCEDURE HalfShadowBox(Row, Col, Rows, Cols, BxAttr, Shdwattr: byte;
  115.                                                    VAR Box: BoxArray);
  116. PROCEDURE SetPage(NewPage: byte);
  117.  
  118. FUNCTION  EGAcheck: BOOLEAN;
  119. FUNCTION  VGAcheck: BOOLEAN;
  120. FUNCTION  MCGAcheck: BOOLEAN;
  121.  
  122. implementation
  123.  
  124. VAR  NextRow,
  125.      R,
  126.      C,
  127.      RW,
  128.      CW       : integer;
  129.      CABorder,
  130.      CAWindow : ScreenCharAttr;
  131.      PageSize : word;
  132.      Page     : byte;
  133.  
  134. PROCEDURE SetCursor(Top, Bottom: byte);
  135. VAR  Regs : Registers;
  136. BEGIN
  137.   WITH Regs DO
  138.   BEGIN
  139.     AH := 1;
  140.     BH := 0;
  141.     CH := Top;
  142.     CL := Bottom;
  143.   END;
  144.   Intr($10, Regs);
  145. END;
  146.  
  147. FUNCTION GetCursor: word;
  148. VAR  Regs : Registers;
  149. BEGIN
  150.   WITH Regs DO
  151.   BEGIN
  152.     AH := 3;
  153.     BH := 0;
  154.   END;
  155.   Intr($10, Regs);
  156.   GetCursor := Regs.CX
  157. END;
  158.  
  159. PROCEDURE GotoRC(Row, Col: byte);
  160. VAR  Regs : Registers;
  161. BEGIN
  162.   WITH Regs DO
  163.   BEGIN
  164.     AH := 2;
  165.     BH := 0;
  166.     DH := Row;
  167.     DL := Col;
  168.     Dec(DX, $101);
  169.   END;
  170.   Intr($10, Regs);
  171. END;
  172.  
  173. PROCEDURE Qwrite(Row, Col, Attr: byte; St: string);
  174. BEGIN
  175.   ScrOfs := PagOfs + ((Pred(Row) * CRTcolumns) + Pred(Col)) SHL 1;
  176.   IF Attr <> SameAttr THEN
  177.   BEGIN
  178.     CAWindow.At := Attr;
  179.     FOR C := 1 TO Length(St) DO
  180.     BEGIN
  181.       CAWindow.Ch := St[C];
  182.       Screen^ := CAWindow;
  183.       Inc(word(Screen), 2);
  184.     END;
  185.   END
  186.   ELSE
  187.   BEGIN
  188.     FOR C := 1 TO Length(St) DO
  189.     BEGIN
  190.       Screen^.Ch := St[C];
  191.       Inc(word(Screen), 2);
  192.     END;
  193.   END;
  194.   CW := Col + Length(St);
  195.   RW := Row;
  196. END;
  197.  
  198. PROCEDURE QwriteS(Row, Col: byte; St: string);
  199. BEGIN
  200.   ScrOfs := PagOfs + ((Pred(Row) * CRTcolumns) + Pred(Col)) SHL 1;
  201.   FOR C := 1 TO Length(St) DO
  202.   BEGIN
  203.     Screen^.Ch := St[C];
  204.     Inc(word(Screen), 2);
  205.   END;
  206.   CW := Col + Length(St);
  207.   RW := Row;
  208. END;
  209.  
  210. PROCEDURE QwriteC(Row, ColL, ColR, Attr: byte; St: string);
  211. VAR  Col: integer;
  212. BEGIN
  213.   ScrOfs := PagOfs + (Pred(Row) * CRTcolumns) SHL 1 + (ColL + ColR - Length(St)) and $FFFE;
  214.   IF Attr <> SameAttr THEN
  215.   BEGIN
  216.     CAWindow.At := Attr;
  217.     FOR C := 1 TO Length(St) DO
  218.     BEGIN
  219.       CAWindow.Ch := St[C];
  220.       Screen^ := CAWindow;
  221.       Inc(word(Screen), 2);
  222.     END;
  223.   END
  224.   ELSE
  225.   BEGIN
  226.     FOR C := 1 TO Length(St) DO
  227.     BEGIN
  228.       Screen^.Ch := St[C];
  229.       Inc(word(Screen), 2);
  230.     END;
  231.   END;
  232.   CW := Col + Length(St);
  233.   RW := Row;
  234. END;
  235.  
  236. PROCEDURE QwriteA(Attr: byte; St: string);
  237. VAR  Csave: integer;
  238. BEGIN
  239.   ScrOfs := PagOfs + ((Pred(RW) * CRTcolumns) + Pred(CW)) SHL 1;
  240.   Csave := CW;
  241.   IF Attr <> SameAttr THEN
  242.   BEGIN
  243.     CAWindow.At := Attr;
  244.     FOR C := 1 TO Length(St) DO
  245.     BEGIN
  246.       CAWindow.Ch := St[C];
  247.       Screen^ := CAWindow;
  248.       Inc(word(Screen), 2);
  249.     END;
  250.   END
  251.   ELSE
  252.   BEGIN
  253.     FOR C := 1 TO Length(St) DO
  254.     BEGIN
  255.       Screen^.Ch := St[C];
  256.       Inc(word(Screen), 2);
  257.     END;
  258.   END;
  259.   CW := CW + length(st);
  260. END;
  261.  
  262. PROCEDURE QwriteL(Row, Col, Attr: byte; St: string; Start, Lengt: byte);
  263. BEGIN
  264.   ScrOfs := PagOfs + ((Pred(Row) * CRTcolumns) + Pred(Col)) SHL 1;
  265.   IF Attr <> SameAttr THEN
  266.   BEGIN
  267.     CAWindow.At := Attr;
  268.     FOR C := Start TO Pred(Start + Lengt) DO
  269.     BEGIN
  270.       CAWindow.Ch := St[C];
  271.       Screen^ := CAWindow;
  272.       Inc(word(Screen), 2);
  273.     END;
  274.   END
  275.   ELSE
  276.   BEGIN
  277.     FOR C := Start TO Pred(Start + Lengt) DO
  278.     BEGIN
  279.       Screen^.Ch := St[C];
  280.       Inc(word(Screen), 2);
  281.     END;
  282.   END;
  283.   CW := Succ(Col) + Lengt;
  284.   RW := Row;
  285. END;
  286.  
  287. PROCEDURE QwriteV(Row, Col, Attr: byte; St: string);
  288. BEGIN
  289.   ScrOfs := PagOfs + ((Pred(Row) * CRTcolumns) + Pred(Col)) SHL 1;
  290.   NextRow := CRTcolumns SHL 1;
  291.   IF Attr <> SameAttr THEN
  292.   BEGIN
  293.     CAWindow.At := Attr;
  294.     FOR C := 1 TO Length(St) DO
  295.     BEGIN
  296.       CAWindow.Ch := St[C];
  297.       Screen^ := CAWindow;
  298.       Inc(word(Screen), NextRow);
  299.     END;
  300.   END
  301.   ELSE
  302.   BEGIN
  303.     FOR C := 1 TO Length(St) DO
  304.     BEGIN
  305.       Screen^.Ch := St[C];
  306.       Inc(word(Screen), NextRow);
  307.     END;
  308.   END;
  309.   CW := Col + Length(St);
  310.   RW := Row;
  311. END;
  312.  
  313. PROCEDURE QwriteU(Row, Col, Attr: byte; St: string);
  314. BEGIN
  315.   ScrOfs := PagOfs + ((Pred(Row) * CRTcolumns) + Pred(Col)) SHL 1;
  316.   NextRow := CRTcolumns SHL 1;
  317.   IF Attr <> SameAttr THEN
  318.   BEGIN
  319.     CAWindow.At := Attr;
  320.     FOR C := 1 TO Length(St) DO
  321.     BEGIN
  322.       CAWindow.Ch := St[C];
  323.       Screen^ := CAWindow;
  324.       Dec(word(Screen), NextRow);
  325.     END;
  326.   END
  327.   ELSE
  328.   BEGIN
  329.     FOR C := 1 TO Length(St) DO
  330.     BEGIN
  331.       Screen^.Ch := St[C];
  332.       Dec(word(Screen), NextRow);
  333.     END;
  334.   END;
  335.   CW := Col + Length(St);
  336.   RW := Row;
  337. END;
  338.  
  339. PROCEDURE Qfill(Row, Col, Rows, Cols, Attr: byte; Ch: char);
  340. BEGIN
  341.   ScrOfs := PagOfs + ((Pred(Row) * CRTcolumns) + Pred(Col)) SHL 1;
  342.   CAWindow.Ch := Ch;
  343.   CAWindow.At := Attr;
  344.   NextRow := (CRTcolumns - Cols) SHL 1;
  345.   IF Attr <> SameAttr THEN
  346.   BEGIN
  347.     FOR R := 1 TO Rows DO
  348.     BEGIN
  349.       FOR C := 1 TO Cols DO
  350.       BEGIN
  351.         Screen^ := CAWindow;
  352.         Inc(word(Screen), 2);
  353.       END;
  354.       Inc(word(Screen), NextRow);
  355.     END;
  356.   END
  357.   ELSE
  358.     FOR R := 1 TO Rows DO
  359.     BEGIN
  360.       FOR C := 1 TO Cols DO
  361.       BEGIN
  362.         Screen^.Ch := Ch;
  363.         Inc(word(Screen), 2);
  364.       END;
  365.       Inc(word(Screen), NextRow);
  366.     END;
  367. END;
  368.  
  369. PROCEDURE QAttr(Row, Col, Rows, Cols, Attr: byte);
  370. BEGIN
  371.   ScrOfs := PagOfs + ((Pred(Row) * CRTcolumns) + Pred(Col)) SHL 1;
  372.   NextRow := (CRTcolumns - Cols) SHL 1;
  373.   FOR R := 1 TO Rows DO
  374.   BEGIN
  375.     FOR C := 1 TO Cols DO
  376.     BEGIN
  377.       Screen^.At := Attr;
  378.       Inc(word(Screen), 2);
  379.     END;
  380.     Inc(word(Screen), NextRow);
  381.   END;
  382. END;
  383.  
  384. PROCEDURE QXorAttr(Row, Col, Rows, Cols, Attr: byte);
  385. BEGIN
  386.   ScrOfs := PagOfs + ((Pred(Row) * CRTcolumns) + Pred(Col)) SHL 1;
  387.   NextRow := (CRTcolumns - Cols) SHL 1;
  388.   FOR R := 1 TO Rows DO
  389.   BEGIN
  390.     FOR C := 1 TO Cols DO
  391.     BEGIN
  392.       Screen^.At := Screen^.At XOR Attr;
  393.       Inc(word(Screen), 2);
  394.     END;
  395.     Inc(word(Screen), NextRow);
  396.   END;
  397. END;
  398.  
  399. FUNCTION GetAttr(Row, Col: byte): byte;
  400. BEGIN
  401.   ScrOfs := PagOfs + ((Pred(Row) * CRTcolumns) + Pred(Col)) SHL 1;
  402.   GetAttr := Screen^.At;
  403. END;
  404.  
  405. PROCEDURE SetAttr(Row, Col, Attr: byte);
  406. BEGIN
  407.   ScrOfs := PagOfs + ((Pred(Row) * CRTcolumns) + Pred(Col)) SHL 1;
  408.   Screen^.At := Attr;
  409. END;
  410.  
  411. FUNCTION GetChar(Row, Col: byte): char;
  412. BEGIN
  413.   ScrOfs := PagOfs + ((Pred(Row) * CRTcolumns) + Pred(Col)) SHL 1;
  414.   GetChar := Screen^.Ch;
  415. END;
  416.  
  417. PROCEDURE SetChar(Row, Col: byte; Ch: char);
  418. BEGIN
  419.   ScrOfs := PagOfs + ((Pred(Row) * CRTcolumns) + Pred(Col)) SHL 1;
  420.   Screen^.Ch := Ch;
  421. END;
  422.  
  423. PROCEDURE XorAttr(Row, Col, Attr: byte);
  424. BEGIN
  425.   ScrOfs := PagOfs + ((Pred(Row) * CRTcolumns) + Pred(Col)) SHL 1;
  426.   Screen^.At := Screen^.At XOR Attr;
  427. END;
  428.  
  429. FUNCTION TextImageSize(Rows, Cols: byte): integer;
  430. BEGIN
  431.   TextImageSize := Succ(Rows * Cols) SHL 1;
  432. END;
  433.  
  434. PROCEDURE TextGet(Row, Col, Rows, Cols: byte; VAR Arr);
  435. VAR  MemoryBuffer : GetArrayType absolute Arr;
  436.      Position     : word;
  437.      BytesToMove  : word;
  438. BEGIN
  439.   ScrOfs := PagOfs + ((Pred(Row) * CRTcolumns) + Pred(Col)) SHL 1;
  440.   NextRow := CRTcolumns SHL 1;
  441.   BytesToMove := Cols SHL 1;
  442.   MemoryBuffer.C := Cols;
  443.   MemoryBuffer.R := Rows;
  444.   Position := 0;
  445.   FOR R := 1 TO Rows DO
  446.   BEGIN
  447.     Move(Screen^, MemoryBuffer.CA[Position], BytesToMove);
  448.     Inc(word(Screen), NextRow);
  449.     Inc(Position, Cols);
  450.   END;
  451. END;
  452.  
  453. PROCEDURE TextPut(Row, Col: byte; VAR Arr);
  454. VAR  MemoryBuffer : GetArrayType absolute Arr;
  455.      Position     : word;
  456.      BytesToMove  : word;
  457. BEGIN
  458.   ScrOfs := PagOfs + ((Pred(Row) * CRTcolumns) + Pred(Col)) SHL 1;
  459.   NextRow := CRTcolumns SHL 1;
  460.   BytesToMove := MemoryBuffer.C SHL 1;
  461.   Position := 0;
  462.   FOR R := 1 TO MemoryBuffer.R DO
  463.   BEGIN
  464.     Move(MemoryBuffer.CA[Position], Screen^, BytesToMove);
  465.     Inc(word(Screen), NextRow);
  466.     Inc(Position, MemoryBuffer.C);
  467.   END;
  468. END;
  469.  
  470. PROCEDURE TextSwap(Row, Col: byte; VAR Arr);
  471. VAR  LineBuff     : array [1..80] of ScreenCharAttr;
  472.      MemoryBuffer : GetArrayType absolute Arr;
  473.      Position     : word;
  474.      BytesToMove  : word;
  475. BEGIN
  476.   ScrOfs := PagOfs + ((Pred(Row) * CRTcolumns) + Pred(Col)) SHL 1;
  477.   NextRow := CRTcolumns SHL 1;
  478.   BytesToMove := MemoryBuffer.C SHL 1;
  479.   Position := 0;
  480.   FOR R := 1 TO MemoryBuffer.R DO
  481.   BEGIN
  482.     Move(Screen^, LineBuff, BytesToMove);
  483.     Move(MemoryBuffer.CA[Position], Screen^, BytesToMove);
  484.     Move(LineBuff, MemoryBuffer.CA[Position], BytesToMove);
  485.     Inc(word(Screen), NextRow);
  486.     Inc(Position, MemoryBuffer.C);
  487.   END;
  488. END;
  489.  
  490. PROCEDURE Textrestore(Row, Col, Rows, Cols: byte; VAR Arr);
  491. VAR  MemoryBuffer : GetArrayType absolute Arr;
  492.      Position     : word;
  493.      BytesToMove  : word;
  494. BEGIN
  495.   ScrOfs := PagOfs + ((Pred(Row) * CRTcolumns) + Pred(Col)) SHL 1;
  496.   NextRow := CRTcolumns SHL 1;
  497.   BytesToMove := Cols SHL 1;
  498.   Position := (Pred(Row) * MemoryBuffer.C + Pred(Col));
  499.   FOR R := 1 TO Rows DO
  500.   BEGIN
  501.     Move(MemoryBuffer.CA[Position], Screen^, BytesToMove);
  502.     Inc(word(Screen), NextRow);
  503.     Inc(Position, MemoryBuffer.C);
  504.   END;
  505. END;
  506.  
  507. PROCEDURE Qbox(Row, Col, Rows, Cols, WindowAttr, BorderAttr: byte;
  508.                                               VAR BxArry: BoxArray);
  509. VAR  Rowm2,
  510.      Colm2: integer;
  511. BEGIN
  512.   ScrOfs := PagOfs + ((Pred(Row) * CRTcolumns) + Pred(Col)) SHL 1;
  513.   NextRow := Succ(CRTcolumns - Cols) SHL 1;
  514.   Rowm2 := Rows - 2;
  515.   Colm2 := Cols - 2;
  516.   CABorder.At := BorderAttr;
  517.   CABorder.Ch := BxArry[1];
  518.   CAWindow.At := WindowAttr;
  519.   CAWindow.Ch := BxArry[5];
  520.  
  521.   Screen^ := CABorder;
  522.   Inc(word(Screen), 2);
  523.   CABorder.Ch := BxArry[2];
  524.   FOR C := 1 TO Colm2 DO
  525.   BEGIN
  526.     Screen^ := CABorder;
  527.     Inc(word(Screen), 2);
  528.   END;
  529.   CABorder.Ch := BxArry[3];
  530.   Screen^ := CABorder;
  531.   Inc(word(Screen), NextRow);
  532.  
  533.   IF WindowAttr <> SameAttr THEN
  534.   BEGIN
  535.     FOR R := 1 TO Rowm2 DO
  536.     BEGIN
  537.       CABorder.Ch := BxArry[4];
  538.       Screen^ := CABorder;
  539.       Inc(word(Screen), 2);
  540.       FOR C := 1 TO Colm2 DO
  541.       BEGIN
  542.         Screen^ := CAWindow;
  543.         Inc(word(Screen), 2);
  544.       END;
  545.       CABorder.Ch := BxArry[6];
  546.       Screen^ := CABorder;
  547.       Inc(word(Screen), NextRow);
  548.     END;
  549.   END
  550.   ELSE
  551.   BEGIN
  552.     FOR R := 1 TO Rowm2 DO
  553.     BEGIN
  554.       CABorder.Ch := BxArry[4];
  555.       Screen^ := CABorder;
  556.       Inc(word(Screen), Succ(Colm2) SHL 1);
  557.       CABorder.Ch := BxArry[6];
  558.       Screen^ := CABorder;
  559.       Inc(word(Screen), NextRow);
  560.     END;
  561.   END;
  562.   CABorder.Ch := BxArry[7];
  563.   R := Row + Rows - 1;
  564.   Screen^ := CABorder;
  565.   Inc(word(Screen), 2);
  566.   CABorder.Ch := BxArry[8];
  567.   FOR C := 1 TO Colm2 DO
  568.   BEGIN
  569.     Screen^ := CABorder;
  570.     Inc(word(Screen), 2);
  571.   END;
  572.   CABorder.Ch := BxArry[9];
  573.   Screen^ := CABorder;
  574. END;
  575.  
  576. FUNCTION GridSize(Arr: ByteArray): integer;
  577. VAR  I: integer;
  578.      Result: word;
  579. BEGIN
  580.   I := 0;
  581.   Result := 1;
  582.   WHILE Arr[I] <> 255 DO
  583.   BEGIN
  584.     Inc(Result);
  585.     Inc(Result, Arr[I]);
  586.     Inc(I);
  587.   END;
  588.   GridSize := Result;
  589. END;
  590.  
  591. PROCEDURE Qgrid(Row, Col: byte; VAR ZR; VAR ZC;
  592.                 WindowAttr, BorderAttr: byte; VAR GdArry: GridArray);
  593. VAR  Rows: bytearray absolute ZR;
  594.      Cols: bytearray absolute ZC;
  595.      CI,
  596.      RI,
  597.      AI: integer;
  598.  
  599.   PROCEDURE DoOneRow;
  600.   BEGIN
  601.     CABorder.Ch := GdArry[AI];
  602.     Screen^ := CABorder;
  603.     Inc(word(Screen), 2);
  604.  
  605.     Inc(AI);
  606.     CAWindow.Ch := GdArry[AI];
  607.     FOR C := 1 TO Cols[0] DO
  608.     BEGIN
  609.       Screen^ := CAWindow;
  610.       Inc(word(Screen), 2);
  611.     END;
  612.  
  613.     CI := 1;
  614.     Inc(AI);
  615.     CABorder.Ch := GdArry[AI];
  616.     WHILE Cols[CI] <> 255 DO
  617.     BEGIN
  618.       Screen^ := CABorder;
  619.       Inc(word(Screen), 2);
  620.       FOR C := 1 TO Cols[CI] DO
  621.       BEGIN
  622.         Screen^ := CAWindow;
  623.         Inc(word(Screen), 2);
  624.       END;
  625.       Inc(CI);
  626.     END;
  627.  
  628.     Inc(AI);
  629.     CABorder.Ch := GDArry[AI];
  630.     Screen^ := CABorder;
  631.     Inc(word(Screen), NextRow);
  632.     Dec(AI, 3);
  633.   END;
  634.  
  635. BEGIN
  636.   ScrOfs := PagOfs + ((Pred(Row) * CRTcolumns) + Pred(Col)) SHL 1;
  637.   NextRow := Succ(CRTcolumns - GridSize(Cols)) SHL 1;
  638.  
  639.   CABorder.At := BorderAttr;
  640.   CAWindow.At := BorderAttr;
  641.   AI := 1;
  642.   DoOneRow;
  643.   FOR R := 1 TO Rows[0] DO
  644.   BEGIN
  645.     AI := 5;
  646.     CAWindow.At := WindowAttr;
  647.     DoOneRow;
  648.   END;
  649.   RI := 1;
  650.   WHILE rows[RI] <> 255 DO
  651.   BEGIN
  652.     AI := 9;
  653.     CAWindow.At := BorderAttr;
  654.     DoOneRow;
  655.     AI := 5;
  656.     CAWindow.At := WindowAttr;
  657.     FOR R := 1 TO rows[RI] DO
  658.       DoOneRow;
  659.     Inc(RI);
  660.   END;
  661.   AI := 13;
  662.   CAWindow.At := BorderAttr;
  663.   DoOneRow;
  664. END;
  665.  
  666. PROCEDURE ShadowedBox(Row, Col, Rows, Cols, WindowAttr, BorderAttr: byte;
  667.                                    VAR Box: BoxArray; ShadowAmount: byte);
  668. BEGIN
  669.   QBox(Row, Col, Rows, Cols, Windowattr, Borderattr, Box);
  670.   QAttr(Row + 1, Col + Cols, Rows, ShadowAmount, $08);
  671.   QAttr(Row + Rows, Col + ShadowAmount, 1, Cols, $08);
  672. END;
  673.  
  674. PROCEDURE BoxMessage(Row, Col, Attr: byte; St: string; VAR Box: BoxArray);
  675. BEGIN
  676.   QBox(Row, Col, 3, length(St) + 4, attr, attr, box);
  677.   QwriteS(Row + 1, Col + 2, St);
  678. END;
  679.  
  680. PROCEDURE HalfShadowBox(Row, Col, Rows, Cols, BxAttr, Shdwattr: byte;
  681.                                                    VAR Box: BoxArray);
  682. BEGIN
  683.   Qbox(Row, Col, Succ(Rows), Succ(Cols), Shdwattr, Shdwattr, ShadowBox);
  684.   Qbox(Row, Col, Rows, Cols, BxAttr, BxAttr, box);
  685. END;
  686.  
  687. PROCEDURE SetPage(NewPage: byte);
  688. VAR  Regs : Registers;
  689. BEGIN
  690.   Page := NewPage;
  691.   ScrOfs := word(Page * PageSize);
  692.   WITH Regs DO
  693.   BEGIN
  694.     AH := 5;
  695.     AL := NewPage;
  696.   END;
  697.   Intr($10, Regs);
  698. END;
  699.  
  700. FUNCTION EGAcheck: BOOLEAN;
  701. VAR  Regs : Registers;
  702. BEGIN
  703.   WITH Regs DO
  704.   BEGIN
  705.     AH := $12;
  706.     BX := $FF10;
  707.     Intr($10, Regs);
  708.     EGAcheck := (BH <> $FF);
  709.   END;
  710. END;
  711.  
  712. FUNCTION VGAcheck: BOOLEAN;
  713. VAR  Regs : Registers;
  714. BEGIN
  715.   WITH Regs DO
  716.   BEGIN
  717.     AX := $1A00;
  718.     Intr($10, Regs);
  719.     VGAcheck := (AL = $1A);
  720.   END;
  721. END;
  722.  
  723. FUNCTION MCGAcheck: BOOLEAN;
  724. VAR  Regs : Registers;
  725. BEGIN
  726.   WITH Regs DO
  727.   BEGIN
  728.     AX := $1A00;
  729.     Intr($10, Regs);
  730.     MCGAcheck := (AL = $1A) and ((BH >= $B) and (BH <= $C));
  731.   END;
  732. END;
  733.  
  734. VAR  VidMode : byte absolute $0040:$0049;  { Video mode - Mono=7, Color<>7 }
  735.  
  736. PROCEDURE QwikInit;
  737. BEGIN
  738.   StartCursor := GetCursor;
  739.   CRTcolumns := Mem[0:$44A];
  740.   CRTrows := Succ(Mem[0:$484]);
  741.   PageSize := MemW[0:$44C];
  742.   Page := 0;
  743.  
  744.   IF CRTrows = 1 THEN CRTrows := 25;
  745.   ScrOfs := 0;
  746.   PagOfs := 0;
  747.  
  748.   IF VidMode = 7 THEN
  749.   BEGIN
  750.     ScrSeg := $B000;                 { Segment FOR Monochrome monitors }
  751.     VideoAdapter := MDA;
  752.     Exit;
  753.   END;
  754.  
  755. { *****************************************************************
  756.   *  Assume CGA at this point since we know it ain't no MDA.
  757.   ***************************************************************** }
  758.   ScrSeg := $B800;
  759.   VideoAdapter := CGA;
  760.  
  761.   IF EGAcheck THEN
  762.   BEGIN
  763.     IF VGAcheck THEN
  764.       IF MCGAcheck THEN
  765.         VideoAdapter := MCGA
  766.       ELSE
  767.         VideoAdapter := VGA
  768.     ELSE
  769.       VideoAdapter := EGA;
  770.   END;
  771. END;
  772.  
  773. BEGIN { ***  UNIT  *** }
  774.   RW := 1;
  775.   CW := 1;
  776.   QwikInit;
  777. END.
  778.