home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / QWIK13.ZIP / QFILLS.INC < prev    next >
Encoding:
Text File  |  1986-11-10  |  9.2 KB  |  142 lines
  1. { Qfills - Qfill, Qattr                                     ver 1.3, 11-10-86 }
  2. { This procedure does fast screen writes and automatically configures to
  3.   your machine for Mono, CGA, and EGA.  It also has the feature of leaving the
  4.   attribute alone by setting Attr<0; then Qfill will just overwrite the display
  5.   using the current attributes while Qattr will simply abort the procedure.
  6.   The upper left column is 1,1.  Cols can range from 1 to 2000 (a full screen
  7.   on 80x25), but EGA can handle more.  Example applications for Qfill is a fast
  8.   screen clear or clear EOL; for Qattr is changing the highlighted cursor in
  9.   pull down menus without the need of a string.
  10.   You MUST read MODIFICATIONS in QWIK13.DOC for any changes in this file!     }
  11.  
  12. { Qfill - Quick screen repetitive fill                      ver 1.3, 11-10-86 }
  13. procedure Qfill (Row, Col: byte; Attr: integer; Ch: char; Cols: integer);
  14. begin
  15. Inline(
  16.    $31/$D2               {       XOR   DX,DX            ;Set DX=0}
  17.   /$8E/$C2               {       MOV   ES,DX            ;Set ES=0}
  18.   /$8A/$76/<ROW          {       MOV   DH,[BP+<Row]     ;Move row (Row*256)}
  19.   /$8B/$7E/<COL          {       MOV   DI,[BP+<Col]     ;Move col}
  20.   /$4F                   {       DEC   DI               ;Convert to 0-79 range}
  21.   /$D1/$E7               {       SHL   DI,1             ;Mult by 2}
  22.   /$8B/$5E/<ATTR         {       MOV   BX,[BP+<Attr]    ;Move attr to BX}
  23.   /$88/$DC               {       MOV   AH,BL            ;Move attr to AH}
  24.   /$8A/$46/<CH           {       MOV   AL,[BP+<Ch]      ;Move char to AL}
  25.   /$8B/$4E/<COLS         {       MOV   CX,[BP+<Cols]    ;Move number of cols}
  26.   /$E8/$10/$00           {       CALL  NEAR Qdisp       ;Call Qdisp, address}
  27.                          {                              ;  is calculated!}
  28. );
  29. end;
  30.  
  31. { QfillsDisp - Subroutine for all Qfills procedures         ver 1.3, 11-10-86 }
  32. procedure QfillsDisp;
  33. begin
  34. Inline(
  35.    $85/$C9               {Qdisp: TEST  CX,CX            ;If CX<=0 ...}
  36.   /$7E/$1E               {       JLE   ExitS            ;   nothing to do}
  37.   /$D1/$EA               {       SHR   DX,1             ;(Row*128)}
  38.   /$01/$D7               {       ADD   DI,DX            ;Save (Row*128) in DI}
  39.   /$D1/$EA               {       SHR   DX,1             ;(Row*64)}
  40.   /$D1/$EA               {       SHR   DX,1             ;(Row*32)}
  41.   /$01/$D7               {       ADD   DI,DX            ;Dest offset in DI}
  42.   /$FC                   {       CLD                    ;Set DF to increment}
  43.   /$26/$80/$3E/$49/$04/$07{      ES: CMP BY[$0449],$07  ;Check video mode}
  44.   /$75/$1A               {       JNE   Color            ;  use Color routine}
  45.                          {                              ;}
  46.   /$BA/$F6/$AF           {       MOV   DX,$AFF6         ;Addr for Mono}
  47.   /$8E/$C2               {       MOV   ES,DX            ;ES:DI dest pointer}
  48.   /$84/$FF               {EGA:   TEST  BH,BH            ;If Attr<0 ...}
  49.   /$78/$04               {       JS    Mono1            ;  use char only}
  50.                          {                              ;}
  51.                          {; -- Mono routine; Attr, Char and No Wait--}
  52.   /$F2/$AB               {Mono2: REP   STOSW            ;To dest & inc DI 2}
  53.   /$EB/$63               {ExitS: JMP   SHORT Done       ;Done}
  54.                          {                              ;}
  55.                          {; -- Mono routine; Char/Attr Only and No Wait--}
  56.                          {; Algorithm packs in an extra STOSB per LOOP}
  57.   /$41                   {Mono1: INC   CX               ;Bump CX for odd col}
  58.   /$D1/$E9               {       SHR   CX,1             ;Divide counter by 2}
  59.                          {                              ; CF=0 if odd count}
  60.   /$73/$02               {       JNC   Mon1b            ;Jump if odd count}
  61.                          {                              ;}
  62.   /$AA                   {Mon1a: STOSB                  ;To dest & inc DI 1}
  63.   /$47                   {       INC   DI               ;Pass up attr/char}
  64.   /$AA                   {Mon1b: STOSB                  ;To dest & inc DI 1}
  65.   /$47                   {       INC   DI               ;Pass up attr/char}
  66.   /$E2/$FA               {       LOOP  Mon1a            ;Loop until CX=0}
  67.   /$EB/$56               {       JMP   SHORT Done       ;Done}
  68.                          {                              ;}
  69.   /$80/$3E/>TOEGA/$00    {Color: CMP   BY[>ToEGA],$00   ;Check for EGA}
  70.   /$BA/$F6/$B7           {       MOV   DX,$B7F6         ;Addr for Color}
  71.   /$8E/$C2               {       MOV   ES,DX            ;ES:DI dest pointer}
  72.   /$75/$DF               {       JNE   EGA              ;If EGA, do Mono}
  73.   /$BA/$DA/$03           {       MOV   DX,$03DA         ;CGA port}
  74.   /$88/$C3               {       MOV   BL,AL            ;Save char in BL}
  75.   /$84/$FF               {       TEST  BH,BH            ;If Attr<0 ...}
  76.   /$78/$21               {       JS    Col1a            ;  use char/attr only}
  77.                          {                              ;}
  78.                          {; -- Color routine; Attr, Char and Wait --}
  79.   /$FA                   {Col2a: CLI                    ;Disable interrupts}
  80.   /$EC                   {E4in2: IN    AL,DX            ;Check CGA status}
  81.   /$A8/$08               {       TEST  AL,$08           ;If #3 bit clear ...}
  82.   /$74/$0A               {       JZ    Col2b            ;  skip tests}
  83.   /$88/$D8               {       MOV   AL,BL            ;Move char back in AL}
  84.   /$81/$F9/$D0/$00       {       CMP   CX,$00D0         ;If <209 Cols left,}
  85.   /$78/$CC               {       JS    Mono2            ;  do mono instead}
  86.   /$EB/$0B               {       JMP   SHORT Col2c      ;  else store direct}
  87.   /$D0/$D8               {Col2b: RCR   AL,1             ;If #0 bit set ...}
  88.   /$72/$ED               {       JC    E4in2            ;  try again for $E4}
  89.   /$EC                   {E5in2: IN    AL,DX            ;Check CGA status}
  90.   /$D0/$D8               {       RCR   AL,1             ;If #0 bit clear ...}
  91.   /$73/$FB               {       JNC   E5in2            ;  try again for $E5}
  92.   /$88/$D8               {       MOV   AL,BL            ;Move char back in AL}
  93.   /$AB                   {Col2c: STOSW                  ;Put in dest & inc DI}
  94.   /$FB                   {       STI                    ;Enable interrupts}
  95.   /$E2/$E1               {       LOOP  Col2a            ;Loop till CX=0}
  96.   /$EB/$20               {       JMP   SHORT Done       ;Done}
  97.                          {                              ;}
  98.                          {; -- Color routine; Char/Attr only and Wait --}
  99.   /$FA                   {Col1a: CLI                    ;Disable interrupts}
  100.   /$EC                   {E4in1: IN    AL,DX            ;Check CGA status}
  101.   /$A8/$08               {       TEST  AL,$08           ;If #3 bit clear ...}
  102.   /$74/$0A               {       JZ    Col1b            ;  skip tests}
  103.   /$88/$D8               {       MOV   AL,BL            ;Move char/attr in AL}
  104.   /$81/$F9/$90/$00       {       CMP   CX,$0090         ;If <145 Cols left,}
  105.   /$78/$AF               {       JS    Mono1            ;  do mono instead.}
  106.   /$EB/$0B               {       JMP   SHORT Col1c      ;  else store direct}
  107.   /$D0/$D8               {Col1b: RCR   AL,1             ;If #0 bit set ...}
  108.   /$72/$ED               {       JC    E4in1            ;  try again for $E4}
  109.   /$EC                   {E5in1: IN    AL,DX            ;Check CGA status}
  110.   /$D0/$D8               {       RCR   AL,1             ;If #0 bit clear ...}
  111.   /$73/$FB               {       JNC   E5in1            ;  try again for $E5}
  112.   /$88/$D8               {       MOV   AL,BL            ;Move char/attr in AL}
  113.   /$AA                   {Col1c: STOSB                  ;Put in dest & inc DI}
  114.   /$FB                   {       STI                    ;Enable interrupts}
  115.   /$47                   {       INC   DI               ;Pass up attr/char}
  116.   /$E2/$E0               {       LOOP  Col1a            ;Loop till CX=0}
  117.   /$C3                   {Done:  RET                    ;Return to call}
  118. );
  119. end;
  120.  
  121. { Qattr - Quick screen attribute change                     ver 1.3, 11-10-86 }
  122. procedure Qattr (Row, Col: byte; Attr, Cols: integer);
  123. begin
  124. Inline(
  125.    $31/$D2               {       XOR   DX,DX            ;Set DX=0}
  126.   /$8E/$C2               {       MOV   ES,DX            ;Set ES=0}
  127.   /$8A/$76/<ROW          {       MOV   DH,[BP+<Row]     ;Move row (Row*256)}
  128.   /$8B/$7E/<COL          {       MOV   DI,[BP+<Col]     ;Move col}
  129.   /$4F                   {       DEC   DI               ;Convert to 0-79 range}
  130.   /$D1/$E7               {       SHL   DI,1             ;Mult by 2}
  131.   /$47                   {       INC   DI               ;Pass up char}
  132.   /$8B/$5E/<ATTR         {       MOV   BX,[BP+<Attr]    ;Move attr to BX}
  133.   /$84/$FF               {       TEST  BH,BH            ;If Attr<0 ...}
  134.   /$78/$0A               {       JS    Exit2            ;  nothing to do.}
  135.   /$88/$D8               {       MOV   AL,BL            ;Move attr in AL}
  136.   /$B7/$80               {       MOV   BH,$80           ;Make BH negative}
  137.   /$8B/$4E/<COLS         {       MOV   CX,[BP+<Cols]    ;Move number of cols}
  138.   /$E8/$4B/$FF           {       CALL  NEAR Qdisp       ;Call Qdisp, address}
  139.                          {                              ;  is calculated!}
  140.                          {Exit2:}
  141. );
  142. end;