home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / QWIK30.ZIP / QWRITES.INC < prev    next >
Encoding:
Text File  |  1987-08-31  |  16.2 KB  |  241 lines
  1. { Qwrites.inc - QwriteLV, QwriteV, Qwrite, QwriteC, QwriteCV  v 3.0, 08-31-87 }
  2. { These five procedures do fast screen writes and automatically configure to
  3.   any IBM adapter card.  They also have the feature of leaving the attribute
  4.   alone by setting Attr<0; then they will just overwrite the display using
  5.   the current attributes.  The upper left column is 1,1.
  6.   Read MODIFICATIONS in QWIK21.DOC for possible changes in this file.         }
  7.  
  8. { QwritesDisp - Subroutine for all QwriteXX procedures      ver 3.0, 08-31-87 }
  9. procedure QwritesDisp;
  10. begin
  11. Inline(                  {Assembly by Inline 08/16/87 19:48}
  12.   $4A/                   {       dec   dx               ;Convert to 0-?? range}
  13.   $88/$E6/               {       mov   dh,ah            ;Save St[1] in DH}
  14.   $31/$C0/               {       xor   ax,ax            ;Set AX=0}
  15.   $8E/$C0/               {       mov   es,ax            ;Set ES=0}
  16.   $26/                   {       es:                    ;Segment override}
  17.   $A1/$4A/$04/           {       mov   ax,[$044A]       ;Get CRT columns}
  18.   $F6/$E2/               {       mul   dl               ;(CRT columns)*(Row-1)}
  19.   $D1/$E0/               {       shl   ax,1             ;Mult by 2}
  20.   $01/$C7/               {       add   di,ax            ;Dest offset in DI}
  21.   $88/$DC/               {       mov   ah,bl            ;Move attr to AH}
  22.   $88/$F0/               {       mov   al,dh            ;Move St[1] to AL}
  23.   $8E/$46/$FC/           {       mov   es,[bp-$04]      ;Copy DS in ES}
  24.   $26/                   {       es:                    ;Segment override}
  25.   $80/$3E/>QWAIT/$00/    {       cmp   by[>Qwait],$00   ;Check need for wait}
  26.   $26/                   {       es:                    ;Segment override}
  27.   $8E/$06/>QSEG/         {       mov   es,[>Qseg]       ;ES:DI dest pointer}
  28.   $75/$32/               {       jne   Color            ;  use Color routine}
  29.                          {                              ;}
  30.   $84/$FF/               {       test  bh,bh            ;If Attr<0 ...}
  31.   $78/$16/               {       js    Mono1            ;  use char only}
  32.                          {                              ;}
  33.                          {; -- Mono routine; Attr, Char and No Wait--}
  34.                          {; Algorithm packs in an extra STOSW per LOOP}
  35.   $41/                   {Mono2: inc   cx               ;Bump CX for odd char}
  36.   $D1/$E9/               {       shr   cx,1             ;Divide counter by 2}
  37.                          {                              ; CF=0 if odd length}
  38.   $EB/$08/               {       jmp   SHORT Mon2b      ;Jump into mono loop}
  39.                          {                              ;}
  40.   $AD/                   {Mon2a: lodsw                  ;Load TWO char}
  41.   $88/$E7/               {       mov   bh,ah            ;Move Ch2 to BH}
  42.   $88/$DC/               {       mov   ah,bl            ;Copy attr to AH}
  43.   $AB/                   {       stosw                  ;To dest & inc DI 2}
  44.   $88/$F8/               {       mov   al,bh            ;Move Ch2 to AL}
  45.   $AB/                   {Mon2b: stosw                  ;To dest & inc DI 2}
  46.   $E2/$F5/               {       loop  Mon2a            ;Loop until CX=0}
  47.   $73/$6C/               {       jnc   Done             ;Exit if odd length}
  48.   $AC/                   {       lodsb                  ;Load last char}
  49.   $AB/                   {       stosw                  ;To dest & inc DI 2}
  50.   $EB/$68/               {       jmp   SHORT Done       ;Done}
  51.                          {                              ;}
  52.                          {; -- Mono routine; Char Only and No Wait--}
  53.                          {; Algorithm packs in an extra STOSB per LOOP}
  54.   $41/                   {Mono1: inc   cx               ;Bump CX for odd char}
  55.   $89/$CA/               {       mov   dx,cx            ;Save CX in DX}
  56.   $D1/$E9/               {       shr   cx,1             ;Divide counter by 2}
  57.   $EB/$05/               {       jmp   SHORT Mon1b      ;Jump into mono loop}
  58.                          {                              ;}
  59.   $AD/                   {Mon1a: lodsw                  ;Load TWO char}
  60.   $AA/                   {       stosb                  ;To dest & inc DI 1}
  61.   $47/                   {       inc   di               ;Pass up attr}
  62.   $88/$E0/               {       mov   al,ah            ;Move Ch2 to AL}
  63.   $AA/                   {Mon1b: stosb                  ;To dest & inc DI 1}
  64.   $47/                   {       inc   di               ;Pass up attr}
  65.   $E2/$F7/               {       loop  Mon1a            ;Loop until CX=0}
  66.   $D1/$EA/               {       shr   dx,1             ;Divide counter by 2}
  67.                          {                              ;CF=0 if odd length}
  68.   $73/$54/               {       jnc   Done             ;Exit if odd length}
  69.   $AC/                   {       lodsb                  ;Load last char}
  70.   $AA/                   {       stosb                  ;To dest & inc DI 1}
  71.   $EB/$50/               {       jmp   SHORT Done       ;Done}
  72.                          {                              ;}
  73.   $BA/$DA/$03/           {Color: mov   dx,$03DA         ;CGA port}
  74.   $84/$FF/               {       test  bh,bh            ;If Attr<0 ...}
  75.   $78/$29/               {       js    Col1b            ;  use char only}
  76.   $88/$DC/               {       mov   ah,bl            ;Move attr in AH}
  77.   $EB/$01/               {       jmp   SHORT Col2b      ;Attr and char}
  78.                          {                              ;}
  79.                          {; -- Color routine; Attr, Char and Wait --}
  80.   $AC/                   {Col2a: lodsb                  ;Load source char}
  81.   $88/$C7/               {Col2b: mov   bh,al            ;Save char in BH}
  82.   $FA/                   {       cli                    ;Disable interrupts}
  83.   $EC/                   {E4in2: in    al,dx            ;Check CGA status}
  84.   $A8/$08/               {       test  al,$08           ;If #3 bit clear ...}
  85.   $74/$09/               {       jz    Col2c            ;  check #0 bit.}
  86.   $88/$F8/               {       mov   al,bh            ;Move char back in AL}
  87.   $80/$F9/$90/           {       cmp   cl,$90           ;If <145 Cols left,}
  88.   $78/$B7/               {       js    Mono2            ;  do mono instead}
  89.   $EB/$0B/               {       jmp   SHORT Col2d      ;  else store direct}
  90.   $D0/$D8/               {Col2c: rcr   al,1             ;If #0 bit set ...}
  91.   $72/$EE/               {       jc    E4in2            ;  try again for $E4}
  92.   $EC/                   {E5in2: in    al,dx            ;Check CGA status}
  93.   $D0/$D8/               {       rcr   al,1             ;If #0 bit clear ...}
  94.   $73/$FB/               {       jnc   E5in2            ;  try again for $E5}
  95.   $88/$F8/               {       mov   al,bh            ;Move char back in AL}
  96.   $AB/                   {Col2d: stosw                  ;Put in dest & inc DI}
  97.   $FB/                   {       sti                    ;Enable interrupts}
  98.   $E2/$DF/               {       loop  Col2a            ;Loop till CX=0}
  99.   $EB/$22/               {       jmp   SHORT Done       ;Done}
  100.                          {                              ;}
  101.                          {; -- Color routine; Char only and Wait --}
  102.   $AC/                   {Col1a: lodsb                  ;Load source char}
  103.   $47/                   {       inc   di               ;Pass up attr}
  104.   $88/$C7/               {Col1b: mov   bh,al            ;Save char in BH}
  105.   $FA/                   {       cli                    ;Disable interrupts}
  106.   $EC/                   {E4in1: in    al,dx            ;Check CGA status}
  107.   $A8/$08/               {       test  al,$08           ;If #3 bit clear ...}
  108.   $74/$09/               {       jz    Col1c            ;  check #0 bit.}
  109.   $88/$F8/               {       mov   al,bh            ;Move char back in AL}
  110.   $80/$F9/$80/           {       cmp   cl,$80           ;If <129 Cols left,}
  111.   $78/$A9/               {       js    Mono1            ;  do mono instead.}
  112.   $EB/$0B/               {       jmp   SHORT Col1d      ;  else store direct}
  113.   $D0/$D8/               {Col1c: rcr   al,1             ;If #0 bit set ...}
  114.   $72/$EE/               {       jc    E4in1            ;  try again for $E4}
  115.   $EC/                   {E5in1: in    al,dx            ;Check CGA status}
  116.   $D0/$D8/               {       rcr   al,1             ;If #0 bit clear ...}
  117.   $73/$FB/               {       jnc   E5in1            ;  try again for $E5}
  118.   $88/$F8/               {       mov   al,bh            ;Move char back in AL}
  119.   $AA/                   {Col1d: stosb                  ;Put in dest & inc DI}
  120.   $FB/                   {       sti                    ;Enable interrupts}
  121.   $E2/$DE/               {       loop  Col1a            ;Loop till CX=0}
  122.                          {                              ;}
  123.   $FB/                   {Done:  sti                    ;Enable interrupts}
  124.   $C3);                  {       ret                    ;Return to call}
  125. end;
  126.  
  127. { QwriteLV - Quick screen write, specified Length, untyped VAR parameter      }
  128. {                                                           ver 3.0, 08-31-87 }
  129. { Unlike other QwriteXX procedures, this one lets you specify both Length and }
  130. { starting index for partial strings.  All other procedures assume length is  }
  131. { the value in St[0] and the index points to St[1].                           }
  132. procedure QwriteLV (Row, Col: byte; Attr, Length: integer; VAR St);
  133. begin
  134. Inline(                  {Assembly by Inline 08/16/87 19:48}
  135.   $8B/$4E/<LENGTH/       {       mov   cx,[bp+<Length]  ;Move length in CX}
  136.   $85/$C9/               {       test  cx,cx            ;If CX<=0,}
  137.   $7E/$18/               {       jle   exit             ;  nothing to do.}
  138.   $1E/                   {       push  ds               ;Save Turbo's DS}
  139.   $C5/$76/<ST/           {       lds   si,[bp+<St]      ;Place offset in SI}
  140.   $FC/                   {       cld                    ;Set DF to increment}
  141.   $AC/                   {       lodsb                  ;Load St[i]}
  142.   $88/$C4/               {       mov   ah,al            ;Move St[i] to AH}
  143.   $8B/$56/<ROW/          {       mov   dx,[bp+<Row]     ;Move row in DX}
  144.   $8B/$7E/<COL/          {       mov   di,[bp+<Col]     ;Move col in DI}
  145.   $4F/                   {       dec   di               ;Convert to 0-?? range}
  146.   $D1/$E7/               {       shl   di,1             ;Mult by 2}
  147.   $8B/$5E/<ATTR/         {       mov   bx,[bp+<Attr]    ;Move attr in BX}
  148.   $E8/>QWRITESDISP-*+5/  {       call  >QwritesDisp-*+5 ;Call QwritesDisp}
  149.   $1F                    {       pop   ds               ;Restore Turbo's DS}
  150.  );                      {Exit:                         ;}
  151. end;
  152.  
  153. { QwriteV - Quick screen write, untyped VAR parameter       ver 3.0, 08-31-87 }
  154. procedure QwriteV (Row, Col: byte; Attr: integer; VAR St);
  155. begin
  156. Inline(                  {Assembly by Inline 08/16/87 19:48}
  157.   $1E/                   {       push  ds               ;Save Turbo's DS}
  158.   $C5/$76/<ST/           {       lds   si,[bp+<St]      ;Place offset in SI}
  159.   $FC/                   {       cld                    ;Set DF to increment}
  160.   $AD/                   {       lodsw                  ;Load St[1],St[0]}
  161.   $31/$C9/               {       xor   cx,cx            ;Set CX=0}
  162.   $00/$C1/               {       add   cl,al            ;Save length in CL}
  163.   $74/$0F/               {       jz    Exit             ;Null string}
  164.   $8B/$56/<ROW/          {       mov   dx,[bp+<Row]     ;Move row in DX}
  165.   $8B/$7E/<COL/          {       mov   di,[bp+<Col]     ;Move col in DI}
  166.   $4F/                   {       dec   di               ;Convert to 0-?? range}
  167.   $D1/$E7/               {       shl   di,1             ;Mult by 2}
  168.   $8B/$5E/<ATTR/         {       mov   bx,[bp+<Attr]    ;Move attr}
  169.   $E8/>QWRITESDISP-*+5/  {       call  >QwritesDisp-*+5 ;Call QwritesDisp}
  170.   $1F);                  {Exit:  pop   ds               ;Restore Turbo's DS}
  171. end;
  172.  
  173. { Qwrite - Quick screen write, value parameter              ver 3.0, 08-31-87 }
  174. procedure Qwrite (Row, Col: byte; Attr: integer; St: Str80);
  175. begin
  176. Inline(                  {Assembly by Inline 08/16/87 19:48}
  177.   $1E/                   {       push  ds               ;Save Turbo's DS}
  178.   $8D/$B6/>ST/           {       lea   si,[bp+>St]      ;Place offset in SI}
  179.   $8C/$D2/               {       mov   dx,ss            ;Move SS into DS for}
  180.   $8E/$DA/               {       mov   ds,dx            ;  use by LODS}
  181.   $FC/                   {       cld                    ;Set DF to increment}
  182.   $AD/                   {       lodsw                  ;Load St[1],St[0]}
  183.   $31/$C9/               {       xor   cx,cx            ;Set CX=0}
  184.   $00/$C1/               {       add   cl,al            ;Save length in CL}
  185.   $74/$12/               {       jz    Exit             ;Null string}
  186.   $8B/$96/>ROW/          {       mov   dx,[bp+>Row]     ;Move row in DX}
  187.   $8B/$BE/>COL/          {       mov   di,[bp+>Col]     ;Move col in DI}
  188.   $4F/                   {       dec   di               ;Convert to 0-?? range}
  189.   $D1/$E7/               {       shl   di,1             ;Mult by 2}
  190.   $8B/$9E/>ATTR/         {       mov   bx,[bp+>Attr]    ;Move attr}
  191.   $E8/>QWRITESDISP-*+5/  {       call  >QwritesDisp-*+5 ;Call QwritesDisp}
  192.   $1F);                  {Exit:  pop   ds               ;Restore Turbo's DS}
  193. end;
  194.  
  195. { QwriteC - Quick screen write, self-centering, value param   v 3.0, 08-31-87 }
  196. procedure QwriteC (Row, ColL, ColR: byte; Attr: integer; St: Str80);
  197. begin
  198. Inline(                  {Assembly by Inline 08/16/87 19:48}
  199.   $1E/                   {       push  ds               ;Save Turbo's DS}
  200.   $8D/$B6/>ST/           {       lea   si,[bp+>St]      ;Place offset in SI}
  201.   $8C/$D2/               {       mov   dx,ss            ;Move SS into DS for}
  202.   $8E/$DA/               {       mov   ds,dx            ;  use by LODS}
  203.   $FC/                   {       cld                    ;Set DF to increment}
  204.   $AD/                   {       lodsw                  ;Load St[1],St[0]}
  205.   $31/$C9/               {       xor   cx,cx            ;Set CX=0}
  206.   $00/$C1/               {       add   cl,al            ;Save length in CL}
  207.   $74/$1A/               {       jz    Exit             ;Null string}
  208.   $8B/$96/>ROW/          {       mov   dx,[bp+>Row]     ;Move row in DX}
  209.   $8B/$BE/>COLL/         {       mov   di,[bp+>ColL]    ;Move col in DI}
  210.   $03/$BE/>COLR/         {       add   di,[bp+>ColR]    ;Add right col}
  211.   $4F/                   {       dec   di               ;Convert to 0-?? range}
  212.   $29/$CF/               {       sub   di,cx            ;Offset calc'd in DI}
  213.   $81/$E7/$FE/$FF/       {       and   di,$FFFE         ;Make even}
  214.   $8B/$9E/>ATTR/         {       mov   bx,[bp+>Attr]    ;Move attr}
  215.   $E8/>QWRITESDISP-*+5/  {       call  >QwritesDisp-*+5 ;Call QwritesDisp}
  216.   $1F);                  {Exit:  pop   ds               ;Restore Turbo's DS}
  217. end;
  218.  
  219. { QwriteCV - Quick screen write, self-centering, untyped VAR parameter
  220.                                                             ver 3.0, 08-31-87 }
  221. procedure QwriteCV (Row, ColL, ColR: byte; Attr: integer; VAR St);
  222. begin
  223. Inline(                  {Assembly by Inline 08/16/87 19:48}
  224.   $1E/                   {       push  ds               ;Save Turbo's DS}
  225.   $C5/$76/<ST/           {       lds   si,[bp+<St]      ;Place offset in SI}
  226.   $FC/                   {       cld                    ;Set DF to increment}
  227.   $AD/                   {       lodsw                  ;Load St[1],St[0]}
  228.   $31/$C9/               {       xor   cx,cx            ;Set CX=0}
  229.   $00/$C1/               {       add   cl,al            ;Save length in CL}
  230.   $74/$16/               {       jz    Exit             ;Null string}
  231.   $8B/$56/<ROW/          {       mov   dx,[bp+<Row]     ;Move row in DX}
  232.   $8B/$7E/<COLL/         {       mov   di,[bp+<ColL]    ;Move col in DI}
  233.   $03/$7E/<COLR/         {       add   di,[bp+<ColR]    ;Add right col}
  234.   $4F/                   {       dec   di               ;Convert to 0-?? range}
  235.   $29/$CF/               {       sub   di,cx            ;Offset calc'd in DI}
  236.   $81/$E7/$FE/$FF/       {       and   di,$FFFE         ;Make even}
  237.   $8B/$5E/<ATTR/         {       mov   bx,[bp+<Attr]    ;Move attr}
  238.   $E8/>QWRITESDISP-*+5/  {       call  >QwritesDisp-*+5 ;Call QwritesDisp}
  239.   $1F);                  {Exit:  pop   ds               ;Restore Turbo's DS}
  240. end;
  241.