home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / QWIK55.ZIP / QWIK55.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-08-24  |  9.4 KB  |  234 lines
  1. { =========================================================================== }
  2. { QWIK55.PAS - Unit for direct/virtual screen writing       ver 5.5, 08-24-89 }
  3. {   Copyright (c) 1986-1989 James H. LeMay, Eagle Performance Software        }
  4. { For documentation on this file see QWIK55.DOC and QWIKREF.DOC.              }
  5. { Only 46 bytes of global data is used.                                       }
  6. { =========================================================================== }
  7.  
  8. { R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }       { TP4 directives }
  9. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}  { TP5 directives }
  10.  
  11. UNIT Qwik;
  12.  
  13. INTERFACE
  14.  
  15. var
  16.   VideoMode:   byte absolute $0040:$0049; { Video mode: Mono=7, Color=0-3 }
  17.   VideoPage:   byte absolute $0040:$0062; { Video page number }
  18.   EgaRows:     byte absolute $0040:$0084; { Rows on screen (0-based) }
  19.   EgaFontSize: word absolute $0040:$0085; { Character cell height (1-based) }
  20.   EgaInfo:     byte absolute $0040:$0087; { EGA info.  See QWIKREF.DOC }
  21.   CRTcolumns:  word absolute $0040:$004A; { Number of CRT columns (1-based) }
  22.  
  23.   SystemID,                   { Equipment ID.  See QWIKREF.DOC }
  24.   SubModelID,                 { Equipment ID.  See QWIKREF.DOC }
  25.   CpuID,                      { Model number of Intel CPU }
  26.   QvideoMode:        byte;    { Video mode detected by QWIK }
  27.  
  28.   { Keep the following seven variables in order for save pointers. }
  29.   CRTrows,                    { Global variable of Rows/EgaRows (1-based!)}
  30.   CRTcols:           byte;    { Global variable of CRTcolumns (1-based) }
  31.   CRTsize:           word;    { Essentially size of CRT video buffer in bytes }
  32.   Qsnow:             boolean; { Wait-for-retrace (snow) while QWIK writing }
  33.   QEosOfs,                    { End Of String offset after QWIK writing }
  34.   QScrOfs,                    { Screen offset  for QWIK writing, normally = 0 }
  35.   QScrSeg:           word;    { Screen segment for QWIK writing }
  36.  
  37.   QvideoPage,                 { Video page to which QWIK is writing }
  38.   MaxPage:           byte;    { Maximum possible page }
  39.   Page0seg:          word;    { Segment for page 0 for video card/buffer }
  40.   CardSeg:           word;    { Segment for page 0 for video card }
  41.   CardSnow,                   { Wait-for-retrace (snow) for video card }
  42.   HavePS2,                    { Using some type of IBM PS/2 equip }
  43.   Have3270:          boolean; { Using IBM 3270 PC workstation hard/software }
  44.   EgaSwitches,                { EGA card and monitor setup }
  45.   ActiveDispDev,              { Active Display Device }
  46.   ActiveDispDev3270,          { Active Display Device for IBM 3270 PC }
  47.   AltDispDev:        byte;    { Alternate Display Device }
  48.   AltDispDevPCC:     word;    { Alt Display Device for PC Convertible }
  49.   HercModel:         byte;    { Model of Hercules card. }
  50.   ScrollAttr:        integer; { Attribute used to clear row in QEosLn }
  51.  
  52. type
  53.   VScrRecType =
  54.     record
  55.       Vrows,                  { Equivalent to CRTrows }
  56.       Vcols:       byte;      { Equivalent to CRTcols }
  57.       Vsize:       word;      { Equivalent to CRTsize }
  58.       Vsnow:       boolean;   { Equivalent to Qsnow }
  59.       VEosOfs:     word;      { Equivalent to QEosOfs }
  60.       VScrPtr:     pointer;   { Equivalent to QScrPtr }
  61.     end;
  62.  
  63. var
  64.   QScrRec:  VScrRecType absolute CRTrows;
  65.   QScrPtr:  pointer     absolute QScrOfs;
  66.  
  67. const
  68.   { Constants assigned by IBM:      }   { Arbitrarily assigned constants: }
  69.   NoDisplay = $00;   VgaMono   = $07;   NoHerc       = 0;
  70.   MdaMono   = $01;   VgaColor  = $08;   HgcMono      = 1;
  71.   CgaColor  = $02;   DCC9      = $09;   HgcPlus      = 2;
  72.   DCC3      = $03;   DCC10     = $0A;   HercInColor  = 3;
  73.   EgaColor  = $04;   McgaMono  = $0B;
  74.   EgaMono   = $05;   McgaColor = $0C;
  75.   PgcColor  = $06;   Unknown   = $FF;
  76.  
  77.   Cpu8086   = $00;   Cpu80286  = $02;
  78.   Cpu80186  = $01;   Cpu80386  = $03;
  79.  
  80.   { The following duplicates the TP4 CRT unit text color constants which }
  81.   { will automatically be used if the CRT unit is not used. }
  82.   Black        = $00;       DarkGray     = $08;
  83.   Blue         = $01;       LightBlue    = $09;
  84.   Green        = $02;       LightGreen   = $0A;
  85.   Cyan         = $03;       LightCyan    = $0B;
  86.   Red          = $04;       LightRed     = $0C;
  87.   Magenta      = $05;       LightMagenta = $0D;
  88.   Brown        = $06;       Yellow       = $0E;
  89.   LightGray    = $07;       White        = $0F;
  90.   Blink        = $80;
  91.  
  92.   { These are convenient background constants: }
  93.   BlackBG      = $00;   { Only needed for source code clarity. }
  94.   BlueBG       = $10;
  95.   GreenBG      = $20;
  96.   CyanBG       = $30;
  97.   RedBG        = $40;
  98.   MagentaBG    = $50;
  99.   BrownBG      = $60;
  100.   LightGrayBG  = $70;
  101.   SameAttr     =  -1;   { Suppresses attribute changes to the screen }
  102.  
  103.   { The following are constants used in SetCursor and ModCursor }
  104.   CursorOn     = $0000; { Turns cursor on  with same shape }
  105.   CursorOff    = $2000; { Turns cursor off with same shape }
  106.   CursorBlink  = $6000; { Creates erratic blinking for MDA/CGA }
  107.  
  108.   InMultiTask: boolean = false;  { True if SetMultiTask detects MT environ. }
  109.  
  110. var
  111.   { These Cursor modes are set by Qinit as detected for the video card: }
  112.   CursorInitial,              { Cursor detected at startup }
  113.   CursorUnderline,            { Standard underline cursor }
  114.   CursorHalfBlock,            { Usually used for Insert editing }
  115.   CursorBlock:       word;    { For those who have to squint }
  116.  
  117. procedure  Qinit;
  118.  
  119. procedure  Qwrite   (Row,Col: byte; Attr: integer; aStr: string);
  120. procedure  QwriteC  (Row,ColL,ColR: byte; Attr: integer; aStr: string);
  121. procedure  QwriteA  (Row,Col: byte; Attr: integer; ArrayLength: word; VAR aStr);
  122. procedure  QwriteEos  (Attr: integer; aStr: string);
  123. procedure  QwriteEosA (Attr: integer; ArrayLength: word; VAR aStr);
  124.  
  125. procedure  Qfill  (Row,Col,Rows,Cols: byte; Attr: integer; Ch: char);
  126. procedure  Qattr  (Row,Col,Rows,Cols: byte; Attr: integer);
  127. procedure  QfillC (Row,ColL,ColR,Rows,Cols: byte; Attr: integer; Ch: char);
  128. procedure  QattrC (Row,ColL,ColR,Rows,Cols: byte; Attr: integer);
  129. procedure  QfillEos (Rows,Cols: byte; Attr: integer; Ch: char);
  130. procedure  QattrEos (Rows,Cols: byte; Attr: integer);
  131.  
  132. procedure  QstoreToMem (Row,Col,Rows,Cols: byte; VAR Dest);
  133. procedure  QstoreToScr (Row,Col,Rows,Cols: byte; VAR Source);
  134. procedure  QScrToVscr  (Row,Col,Rows,Cols,Vrow,Vcol,Vwidth: byte; VAR VscrPtr);
  135. procedure  QVscrToScr  (Row,Col,Rows,Cols,Vrow,Vcol,Vwidth: byte; VAR VscrPtr);
  136.  
  137. function   QreadStr  (Row,Col,Cols: byte): string;
  138. function   QreadChar (Row,Col: byte): char;
  139. function   QreadAttr (Row,Col: byte): byte;
  140.  
  141. procedure  QscrollUp   (Row,Col,Rows,Cols: byte; BlankAttr: integer);
  142. procedure  QscrollDown (Row,Col,Rows,Cols: byte; BlankAttr: integer);
  143.  
  144. procedure  QviewPage  (PageNum: byte);
  145. procedure  QwritePage (PageNum: byte);
  146.  
  147. function   GetCursor: word;
  148. procedure  SetCursor (Cursor: word);
  149. procedure  ModCursor (Bits13_14: word);
  150. procedure  GotoRC (Row,Col: byte);
  151. function   WhereR: byte;
  152. function   WhereC: byte;
  153.  
  154. procedure  GotoEos;
  155. function   EosR: byte;
  156. function   EosC: byte;
  157. procedure  EosToRC    (Row,Col: byte);
  158. procedure  EosToRCrel (Row,Col: integer);
  159. procedure  EosToCursor;
  160. procedure  EosLn;
  161. procedure  QEosLn;
  162.  
  163. procedure  GetSubModelID;  { Read docs before using! }
  164. procedure  SetMultiTask;
  165.  
  166.  
  167. IMPLEMENTATION
  168.  
  169. var
  170.   FirstQinit:  boolean;  { True if Qinit is yet to be run }
  171.  
  172. {$L qinit.obj}
  173. procedure  Qinit;          external;
  174. {$L qwrites.obj}
  175. procedure  Qwrite;         external;
  176. procedure  QwriteC;        external;
  177. procedure  QwriteA;        external;
  178. procedure  QwriteEos;      external;
  179. procedure  QwriteEosA;     external;
  180. {$L qfills.obj}
  181. procedure  Qfill;          external;
  182. procedure  Qattr;          external;
  183. procedure  QfillC;         external;
  184. procedure  QattrC;         external;
  185. procedure  QfillEos;       external;
  186. procedure  QattrEos;       external;
  187. procedure  QfillsDisp3;    external;   { for Qscroll.obj only }
  188. {$L qstores.obj}
  189. procedure  QstoreToMem;    external;
  190. procedure  QstoreToScr;    external;
  191. procedure  QScrToVscr;     external;
  192. procedure  QVscrToScr;     external;
  193. {$L qreads.obj}
  194. function   QreadStr;       external;
  195. function   QreadChar;      external;
  196. function   QreadAttr;      external;
  197. {$L qscrolls.obj}
  198. procedure  QscrollUp;      external;
  199. procedure  QscrollDown;    external;
  200. {$L qpages.obj}
  201. procedure  QviewPage;      external;
  202. procedure  QwritePage;     external;
  203. {$L cursor.obj}
  204. function   GetCursor;      external;
  205. procedure  SetCursor;      external;
  206. procedure  ModCursor;      external;
  207. procedure  GotoRC;         external;
  208. function   WhereR;         external;
  209. function   WhereC;         external;
  210. {$L eos.obj}
  211. procedure  EosRC;          external;   { for QEosLn.obj only }
  212. procedure  GotoEos;        external;
  213. function   EosR;           external;
  214. function   EosC;           external;
  215. procedure  EosToRC;        external;
  216. procedure  EosToRCrel;     external;
  217. procedure  EosToCursor;    external;
  218. procedure  EosLn;          external;
  219. {$L QEosLn.obj}
  220. procedure  QEosLn;         external;
  221. {$L cpuident.obj}
  222. procedure  GetCpuID;       external;  { Near }
  223. {$L getsubid.obj}
  224. procedure  GetSubModelID;  external;  { Read docs before using! }
  225. {$L SetMulti.obj }
  226. procedure  SetMultiTask;   external;
  227.  
  228. BEGIN
  229.   SubModelID := 0;    { Default to 0 }
  230.   FirstQinit := true; { True for first time to be run }
  231.   Qinit;
  232.   GetCpuID;           { Required for Qscroll.obj }
  233. END.
  234.