home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR9 / QWIK71A.ZIP / QWIK71A.PAS < prev    next >
Pascal/Delphi Source File  |  1993-09-23  |  12KB  |  316 lines
  1. { ========================================================================== }
  2. { QWIK71A.PAS - Unit for direct/virtual screen writing    ver 7.1a, 09-23-93 }
  3. {                                                                            }
  4. { For documentation on this file see QWIK71A.DOC and QWIKREF.DOC.            }
  5. { Only 48 bytes of global data is used.                                      }
  6. {   Copyright (c) 1986,1993 James H. LeMay, Eagle Performance Software       }
  7. { ========================================================================== }
  8.  
  9. { Note: you MUST use $A- for this unit. }
  10. { $A-,B-,D+,E-,F-,G-,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V-,X-}
  11. {$A-,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,S-,T-,V-,X-}
  12.  
  13. UNIT Qwik;
  14.  
  15. INTERFACE
  16.  
  17. const
  18.   SystemID:   byte = 0;       { Equipment ID.  See QWIKREF.DOC }
  19.   SubModelID: byte = 0;       { Equipment ID.  See QWIKREF.DOC }
  20.  
  21. var
  22.   VideoMode:   byte absolute $0040:$0049; { Video mode: Mono=7, Color=0-3 }
  23.   VideoPage:   byte absolute $0040:$0062; { Video page number }
  24.   EgaRows:     byte absolute $0040:$0084; { Rows on screen (0-based) }
  25.   EgaFontSize: word absolute $0040:$0085; { Character cell height (1-based) }
  26.   EgaInfo:     byte absolute $0040:$0087; { EGA info.  See QWIKREF.DOC }
  27.   CrtColumns:  word absolute $0040:$004A; { Number of CRT columns (1-based) }
  28.  
  29.   CpuID,                      { Model number of Intel CPU }
  30.   QvideoMode:        byte;    { Video mode detected by QWIK }
  31.  
  32.   { Keep the following seven variables in order for save pointers! }
  33.   CrtRows,                    { Global variable of Rows/EgaRows (1-based!)}
  34.   CrtCols:           byte;    { Global variable of CrtColumns (1-based) }
  35.   CrtSize:           word;    { Essentially size of CRT video buffer in bytes }
  36.   QEosOfs,                    { End Of String offset after QWIK writing }
  37.   QScrOfs,                    { Screen offset  for QWIK writing, normally = 0 }
  38.   QScrSeg:           word;    { Screen segment for QWIK writing }
  39.   Qsnow:             boolean; { Wait-for-retrace (snow) while QWIK writing }
  40.  
  41.   QvideoPage,                 { Video page to which QWIK is writing }
  42.   MaxPage:           byte;    { Maximum possible page }
  43.   Page0seg:          word;    { Segment for page 0 for video card/buffer }
  44.   CardSeg:           word;    { Segment for page 0 for video card }
  45.   CardSnow,                   { Wait-for-retrace (snow) for video card }
  46.   HavePS2,                    { Using some type of IBM PS/2 equip }
  47.   Have3270:          boolean; { Using IBM 3270 PC workstation hard/software }
  48.   EgaSwitches,                { EGA card and monitor setup }
  49.   ActiveDispDev,              { Active Display Device }
  50.   ActiveDispDev3270,          { Active Display Device for IBM 3270 PC }
  51.   AltDispDev:        byte;    { Alternate Display Device }
  52.   AltDispDevPCC:     word;    { Alt Display Device for PC Convertible }
  53.   HercModel:         byte;    { Model of Hercules card. }
  54.   ScrollAttr:        integer; { Attribute used to clear row in QEosLn }
  55.  
  56. type
  57.   VScrRecType =
  58.     record
  59.       Vrows,                  { Equivalent to CrtRows }
  60.       Vcols:       byte;      { Equivalent to CrtCols }
  61.       Vsize:       word;      { Equivalent to CrtSize }
  62.       VEosOfs:     word;      { Equivalent to QEosOfs }
  63.       VScrPtr:     pointer;   { Equivalent to QScrPtr }
  64.       Vsnow:       boolean;   { Equivalent to Qsnow   }
  65.     end;
  66.  
  67. var
  68.   QScrRec:  VScrRecType absolute CrtRows;
  69.   QScrPtr:  pointer     absolute QScrOfs;
  70.  
  71. const
  72.   { Constants assigned by IBM:      }   { Arbitrarily assigned constants: }
  73.   NoDisplay = $00;   VgaMono   = $07;   NoHerc       = 0;
  74.   MdaMono   = $01;   VgaColor  = $08;   HgcMono      = 1;
  75.   CgaColor  = $02;   DCC9      = $09;   HgcPlus      = 2;
  76.   DCC3      = $03;   DCC10     = $0A;   HercInColor  = 3;
  77.   EgaColor  = $04;   McgaMono  = $0B;
  78.   EgaMono   = $05;   McgaColor = $0C;
  79.   PgcColor  = $06;   Unknown   = $FF;
  80.  
  81.   Cpu8086    = $00;
  82.   Cpu80186   = $01;
  83.   Cpu80286   = $02;
  84.   Cpu80386   = $03;
  85.   Cpu80486   = $04;
  86.   CpuPentium = $05;
  87.  
  88.   { The following duplicates the CRT unit text color constants which }
  89.   { will automatically be used if the CRT unit is not used. }
  90.   Black        = $00;       DarkGray     = $08;
  91.   Blue         = $01;       LightBlue    = $09;
  92.   Green        = $02;       LightGreen   = $0A;
  93.   Cyan         = $03;       LightCyan    = $0B;
  94.   Red          = $04;       LightRed     = $0C;
  95.   Magenta      = $05;       LightMagenta = $0D;
  96.   Brown        = $06;       Yellow       = $0E;
  97.   LightGray    = $07;       White        = $0F;
  98.   Blink        = $80;
  99.  
  100.   { These are convenient background constants: }
  101.   BlackBG      = $00;   { Only needed for source code clarity. }
  102.   BlueBG       = $10;
  103.   GreenBG      = $20;
  104.   CyanBG       = $30;
  105.   RedBG        = $40;
  106.   MagentaBG    = $50;
  107.   BrownBG      = $60;
  108.   LightGrayBG  = $70;
  109.   SameAttr     =  -1;   { Suppresses attribute changes to the screen }
  110.  
  111.   { The following are constants used in SetCursor and ModCursor }
  112.   CursorOn     = $0000; { Turns cursor on  with same shape }
  113.   CursorOff    = $2000; { Turns cursor off with same shape }
  114.   CursorBlink  = $6000; { Creates erratic blinking for MDA/CGA }
  115.  
  116.   InMultiTask:  boolean = false;  { True if SetMultiTask detects MT environ. }
  117.   QscrollBlank: boolean = true;   { True to clear blank line after scroll. }
  118.   SegF000:      word    = $F000;  { For selector use for DOS/DPMI platforms }
  119.  
  120. var
  121.   { These Cursor modes are set by Qinit as detected for the video card: }
  122.   CursorInitial,              { Cursor detected at startup }
  123.   CursorUnderline,            { Standard underline cursor }
  124.   CursorHalfBlock,            { Usually used for Insert editing }
  125.   CursorBlock:       word;    { For those who have to squint }
  126.  
  127. procedure Qinit;
  128.  
  129. procedure QwriteV    (Row,Col: byte; Attr: integer; aStr: string);
  130. procedure QwriteVC   (RowT,RowB,Col: byte; Attr: integer; aStr: string);
  131. procedure QwriteC    (Row,ColL,ColR: byte; Attr: integer; aStr: string);
  132. procedure QwriteSub  (Row,Col: byte; Attr: integer; Count: word; var Chars);
  133. procedure QwriteSubC (Row,ColL,ColR: byte; Attr: integer; Count: word;
  134.                       var Chars);
  135. procedure QwriteEos    (Attr: integer; aStr: string);
  136. procedure QwriteEosV   (Attr: integer; aStr: string);
  137. procedure QwriteEosSub (Attr: integer; Count: word; var Chars);
  138.  
  139. procedure Qfill  (Row,Col,Rows,Cols: byte; Attr: integer; Ch: char);
  140. procedure Qattr  (Row,Col,Rows,Cols: byte; Attr: integer);
  141. procedure QfillC (Row,ColL,ColR,Rows,Cols: byte; Attr: integer; Ch: char);
  142. procedure QattrC (Row,ColL,ColR,Rows,Cols: byte; Attr: integer);
  143. procedure QfillEos (Rows,Cols: byte; Attr: integer; Ch: char);
  144. procedure QattrEos (Rows,Cols: byte; Attr: integer);
  145.  
  146. procedure QstoreToMem (Row,Col,Rows,Cols: byte; var Dest);
  147. procedure QstoreToScr (Row,Col,Rows,Cols: byte; var Source);
  148. procedure QScrToVscr  (Row,Col,Rows,Cols,Vrow,Vcol,Vwidth: byte; var VscrPtr);
  149. procedure QVscrToScr  (Row,Col,Rows,Cols,Vrow,Vcol,Vwidth: byte; var VscrPtr);
  150.  
  151. procedure QreadStr  (Row,Col,Cols: byte; var aStr: string);
  152. function  QreadChar (Row,Col: byte): char;
  153. function  QreadAttr (Row,Col: byte): byte;
  154.  
  155. procedure QscrollUp   (Row,Col,Rows,Cols: byte; BlankAttr: integer);
  156. procedure QscrollDown (Row,Col,Rows,Cols: byte; BlankAttr: integer);
  157.  
  158. procedure QviewPage  (PageNum: byte);
  159. procedure QwritePage (PageNum: byte);
  160.  
  161. function  GetCursor: word;
  162. Inline(
  163.   $8E/$06/>SEG0040/      { mov   es,[>Seg0040] ; Get video segment}
  164.   $26/                   { es:                 ; Seg override}
  165.   $A1/$60/$00);          { mov   ax,[$0060]    ; Get current cursor word}
  166.  
  167. procedure SetCursor (Cursor: word);
  168. procedure ModCursor (Bits13_14: word);
  169. procedure GotoRC (Row,Col: byte);
  170. function  WhereR: byte;
  171. function  WhereC: byte;
  172.  
  173. procedure GotoEos;
  174. function  EosR: byte;
  175. function  EosC: byte;
  176. procedure EosToRC    (Row,Col: byte);
  177. procedure EosToRCrel (Row,Col: integer);
  178. procedure EosToCursor;
  179. procedure EosLn;
  180. procedure QEosLn;
  181.  
  182. procedure GetSubModelID;  { Read docs before using. }
  183. procedure SetMultiTask;
  184. procedure Qwrite     (Row,Col: byte; Attr: integer; aStr: string);
  185.  
  186.  
  187. IMPLEMENTATION
  188.  
  189. {$ifdef DPMI } { Needed for Qinit }
  190. uses WinAPI;
  191. {$endif }
  192.  
  193. const
  194.   TestedHerc: boolean = false;  { True if Hercules test has been done. }
  195.  
  196. {$ifdef DPMI } { Needed for Qinit }
  197. {$L qinit.obp}
  198. procedure __F000H; far;   external 'KERNEL' index 194;  {173 }
  199. {$else }
  200. {$L qinit.obj}
  201. {$endif }
  202. procedure Qinit;          external;
  203.  
  204. {$L QwDsp.obj    }
  205. {$L Qwrite.obj   }
  206. {$L QwriteC.obj  }
  207. {$L QwSub.obj    }
  208. {$L QwSubC.obj   }
  209. {$L QwEos.obj    }
  210. {$L QwEosSub.obj }
  211. procedure QwDsp1;         external;  { local subroutine }
  212. procedure QwDsp2;         external;  { local subroutine }
  213. procedure Qwrite;         external;
  214. procedure QwriteV;        external;
  215. procedure QwriteC;        external;
  216. procedure QwriteSub;      external;
  217. procedure QwriteSubC;     external;
  218. procedure QwriteEos;      external;
  219. procedure QwriteEosSub;   external;
  220.  
  221. {$L QwDspV.obj   }
  222. {$L QwriteV.obj  }
  223. {$L QwriteVC.obj }
  224. {$L QwEosV.obj   }
  225. procedure QwDspV1;        external;  { local subroutine }
  226. procedure QwDspV2;        external;  { local subroutine }
  227. procedure QwriteVC;       external;
  228. procedure QwriteEosV;     external;
  229.  
  230. {$L QfDsp.obj    }
  231. {$L Qfill.obj    }
  232. {$L QfillC.obj   }
  233. {$L QfillEos.obj }
  234. {$L Qattr.obj    }
  235. {$L QattrC.obj   }
  236. {$L QattrEos.obj }
  237. procedure Qfill;          external;
  238. procedure Qattr;          external;
  239. procedure QfillC;         external;
  240. procedure QattrC;         external;
  241. procedure QfillEos;       external;
  242. procedure QattrEos;       external;
  243. procedure QfDsp;          external;  { local for Qattrs / Qfills }
  244. procedure QfDsp2;         external;  { local for QattrEos.obj / QfillEos.obj }
  245. procedure QfDsp3;         external;  { local for Qscroll.obj only }
  246.  
  247. {$L Qstore.obj }
  248. {$L QstoreV.obj }
  249. procedure QstoreToMem;    external;
  250. procedure QstoreToScr;    external;
  251. procedure SetRegs;        external;  { local for QstoreV.obj }
  252. procedure MemDsp;         external;  { local for QstoreV.obj }
  253. procedure ScrDsp;         external;  { local for QstoreV.obj }
  254. procedure QScrToVscr;     external;
  255. procedure QVscrToScr;     external;
  256.  
  257. {$L Qread.obj    }
  258. {$L QreadStr.obj }
  259. {$L QreadChr.obj }
  260. procedure Qread;          external;  { local for QreadStr.obj / QreadChr.obj }
  261. procedure QreadStr;       external;
  262. function  QreadChar;      external;
  263. function  QreadAttr;      external;
  264.  
  265. {$L qscrolls.obj}
  266. procedure QscrollUp;      external;
  267. procedure QscrollDown;    external;
  268.  
  269. {$L qpages.obj}
  270. procedure QviewPage;      external;
  271. procedure QwritePage;     external;
  272.  
  273. {$L Cursor.obj }
  274. {$L Where.obj  }
  275. {$L GotoRC.obj   }
  276. procedure SetCursor;      external;
  277. procedure ModCursor;      external;
  278. procedure GotoRC;         external;
  279. function  WhereR;         external;
  280. function  WhereC;         external;
  281.  
  282. {$L EosRC.obj    }
  283. {$L GotoEos.obj  }
  284. {$L EosR.obj     }
  285. {$L EosC.obj     }
  286. {$L EosToRC.obj  }
  287. {$L EosToRCr.obj }
  288. {$L EosToCur.obj }
  289. {$L EosLn.obj}
  290. procedure EosRC;          external;   { local subroutine only }
  291. procedure GotoEos;        external;
  292. function  EosR;           external;
  293. function  EosC;           external;
  294. procedure EosToRC;        external;
  295. procedure EosToRCrel;     external;
  296. procedure EosToCursor;    external;
  297. procedure EosLn;          external;
  298.  
  299. {$L QEosLn.obj}
  300. procedure QEosLn;         external;
  301.  
  302. {$L CpuIdent.obj}
  303. procedure GetCpuID;       external;  { Near }
  304.  
  305. {$L GetSubID.obj}
  306. procedure GetSubModelID;  external;  { Read docs before using! }
  307.  
  308. {$L SetMulti.obj }
  309. procedure SetMultiTask;   external;
  310.  
  311.  
  312. BEGIN
  313.   Qinit;
  314.   GetCpuID;           { Required for Qscroll* }
  315. END.
  316.