home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / QWIK41.ZIP / QWIK41.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-05-01  |  6.2 KB  |  151 lines
  1. { QWIK41.PAS - Unit for quick, direct screen writing        ver 4.1, 05-01-88 }
  2. {  (c)1988 James H. LeMay                                                     }
  3. { For documentation on this file see QWIK41.DOC, QINIT.DOC and CURSOR.DOC.    }
  4.  
  5. {$R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }
  6.  
  7. UNIT Qwik;
  8.  
  9. INTERFACE
  10. var
  11.   VideoMode:   byte absolute $0040:$0049; { Video mode: Mono=7, Color=0-3 }
  12.   VideoPage:   byte absolute $0040:$0062; { Video page number }
  13.   EgaRows:     byte absolute $0040:$0084; { Rows on screen (0-based) }
  14.   EgaFontSize: word absolute $0040:$0085; { Character cell height (1-based) }
  15.   EgaInfo:     byte absolute $0040:$0087; { EGA info.  See QINIT.DOC }
  16.   CRTcolumns:  word absolute $0040:$004A; { Number of CRT columns (1-based) }
  17.  
  18.   SystemID,                   { Equipment ID.  See QINIT.DOC }
  19.   SubModelID,                 { Equipment ID.  See QINIT.DOC }
  20.   CRTrows,                    { Global variable of Rows/EgaRows (1-based!)}
  21.   CRTcols:           byte;    { Global variable of CRTcolumns (1-based) }
  22.   QnextOfs,                   { Offset available for Q*More procedures }
  23.   CardSeg,                    { Segment for page 0 for video card }
  24.   Page0seg,                   { Segment for page 0 for video card/buffer }
  25.   Qseg:              word;    { Segment for Q writing }
  26.   MaxPage:           byte;    { Maximum possible page }
  27.   CardSnow,                   { Wait-for-retrace (snow) for video card }
  28.   Qsnow,                      { Wait-for-retrace (snow) while Q writing }
  29.   HavePS2,                    { Using some type of IBM PS/2 equip }
  30.   Have3270:          boolean; { Using IBM 3270 PC workstation hard/software }
  31.   EgaSwitches,                { EGA card and monitor setup }
  32.   ActiveDispDev,              { Active Display Device }
  33.   ActiveDispDev3270,          { Active Display Device for IBM 3270 PC }
  34.   AltDispDev:        byte;    { Alternate Display Device }
  35.   AltDispDevPCC:     word;    { Alt Display Device for PC Convertible }
  36.   HercModel,                  { Model of Hercules card. }
  37.   CpuID:             byte;    { Model number of Intel CPU }
  38.  
  39. const
  40.   { Constants assigned by IBM:      }   { Arbitrarily assigned constants: }
  41.   NoDisplay = $00;   VgaMono   = $07;   NoHerc       = 0;
  42.   MdaMono   = $01;   VgaColor  = $08;   HgcMono      = 1;
  43.   CgaColor  = $02;   DCC9      = $09;   HgcPlus      = 2;
  44.   DCC3      = $03;   DCC10     = $0A;   HercInColor  = 3;
  45.   EgaColor  = $04;   McgaMono  = $0B;
  46.   EgaMono   = $05;   McgaColor = $0C;
  47.   PgcColor  = $06;   Unknown   = $FF;
  48.  
  49.   Cpu8086   = $00;   Cpu80286  = $02;
  50.   Cpu80186  = $01;   Cpu80386  = $03;
  51.  
  52.   { The following are background color constants.  With Turbo's constant
  53.     folding, you can do the following example:
  54.         Qwrite (1,1,white+BlueBG,'My string');
  55.     instead of    
  56.         Qwrite (1,1,Attr(white,blue),'My string');
  57.     This saves code (it's only one byte!) and is the fastest possible method
  58.     and not to mention it is WYSIWYG.  I would recommend using it over the
  59.     old Attr function.  You can also deliberately add "blink" without being
  60.     masked. }
  61.   BlackBG      = $00;   { Only needed for source code clarity. }
  62.   BlueBG       = $10;
  63.   GreenBG      = $20;
  64.   CyanBG       = $30;
  65.   RedBG        = $40;
  66.   MagentaBG    = $50;
  67.   BrownBG      = $60;
  68.   LightGrayBG  = $70;
  69.   SameAttr     =  -1;  { This will keep the attributes "as is" on the CRT }
  70.                        { Works for all QWIK attribute parameters. }
  71.  
  72.   { The following duplicates the TP4 CRT unit text color constants which }
  73.   { will automatically be used if the CRT unit is not USEd. }
  74.   Black        = $00;       DarkGray     = $08;
  75.   Blue         = $01;       LightBlue    = $09;
  76.   Green        = $02;       LightGreen   = $0A;
  77.   Cyan         = $03;       LightCyan    = $0B;
  78.   Red          = $04;       LightRed     = $0C;
  79.   Magenta      = $05;       LightMagenta = $0D;
  80.   Brown        = $06;       Yellow       = $0E;
  81.   LightGray    = $07;       White        = $0F;
  82.   Blink        = $80;
  83.  
  84. procedure  Qinit;
  85.  
  86. procedure  Qwrite  (Row,Col: byte; Attr: integer; aStr: string);
  87. procedure  QwriteC (Row,ColL,ColR: byte; Attr: integer; aStr: string);
  88. procedure  QwriteA (Row,Col: byte; Attr: integer; ArrayLength: word; VAR aStr);
  89. procedure  QwriteMore  (Attr: integer; aStr: string);
  90. procedure  QwriteMoreA (Attr: integer; ArrayLength: word; VAR aStr);
  91.  
  92. procedure  Qfill  (Row,Col,Rows,Cols: byte; Attr: integer; Ch: char);
  93. procedure  Qattr  (Row,Col,Rows,Cols: byte; Attr: integer);
  94. procedure  QfillC (Row,ColL,ColR,Rows,Cols: byte; Attr: integer; Ch: char);
  95. procedure  QattrC (Row,ColL,ColR,Rows,Cols: byte; Attr: integer);
  96. procedure  QfillMore (Rows,Cols: byte; Attr: integer; Ch: char);
  97. procedure  QattrMore (Rows,Cols: byte; Attr: integer);
  98.  
  99. procedure  QstoreToMem (Row,Col,Rows,Cols: byte; VAR Dest);
  100. procedure  QstoreToScr (Row,Col,Rows,Cols: byte; VAR Source);
  101.  
  102. procedure  QviewPage  (PageNum: byte);
  103. procedure  QwritePage (PageNum: byte);
  104.  
  105. procedure  GotoRC (Row,Col: byte);
  106. procedure  CursorChange (New: word; VAR Old: word);
  107. procedure  CursorOff;
  108. procedure  CursorOn;
  109. function   WhereR:  byte;
  110. function   WhereC:  byte;
  111.  
  112. IMPLEMENTATION
  113.  
  114. {$L qinit.obj}
  115. const
  116.   FirstQinit: boolean = true;  { True if Qinit is yet to be run }
  117. procedure  Qinit;          external;
  118. {$L qwrites.obj}
  119. procedure  Qwrite;         external;
  120. procedure  QwriteC;        external;
  121. procedure  QwriteA;        external;
  122. procedure  QwriteMore;     external;
  123. procedure  QwriteMoreA;    external;
  124. {$L qfills.obj}
  125. procedure  Qfill;          external;
  126. procedure  Qattr;          external;
  127. procedure  QfillC;         external;
  128. procedure  QattrC;         external;
  129. procedure  QfillMore;      external;
  130. procedure  QattrMore;      external;
  131. {$L qstores.obj}
  132. procedure  QstoreToMem;    external;
  133. procedure  QstoreToScr;    external;
  134. {$L qpages.obj}
  135. procedure  QviewPage;      external;
  136. procedure  QwritePage;     external;
  137. {$L cursor.obj}
  138. procedure  GotoRC;         external;
  139. procedure  CursorChange;   external;
  140. procedure  CursorOff;      external;
  141. procedure  CursorOn;       external;
  142. function   WhereR;         external;
  143. function   WhereC;         external;
  144. {$L cpuident.obj}
  145. procedure  GetCpuID;       external;
  146.  
  147. BEGIN
  148.   Qinit;
  149.   GetCpuID;        { Optional near procedure only }
  150. END.
  151.