home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PVGA.ZIP / PVGA.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-01-04  |  32.3 KB  |  743 lines
  1. Program Paradise_VGA;                       (* Written: 01/09/1989  10:35:39 *)
  2.  
  3.  {
  4.  [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
  5.  []                        Program Paradise_VGA                        []
  6.  []                                                                    []
  7.  [] The intent of this program is to provide thoroughly tested text    []
  8.  [] and graphics display routines for Paradise VGA boards:             []
  9.  []                                                                    []
  10.  []  - Paradise VGA Plus                                               []
  11.  []  - Paradise VGA Plus 16                                            []
  12.  []  - Paradise VGA Professional                                       []
  13.  []                                                                    []
  14.  [] While standard CGA, EGA, MCGA, and VGA video routines are well     []
  15.  [] documented, video board manufacturers have extended both text and  []
  16.  [] graphics beyond the IBM standard. The problem is that routines to  []
  17.  [] identify a Super-VGA board and access the extended modes are       []
  18.  [] different for each manufacturer.                                   []
  19.  []                                                                    []
  20.  [] ------------------------------------------------------------------ []
  21.  [] It's hoped that this program will serve as authoritative           []
  22.  [] information for programmers wishing to write for the Paradise      []
  23.  [] VGAs, and also as a starting point for an exchange of information  []
  24.  [] about different VGA boards.                                        []
  25.  []                                                                    []
  26.  [] Hopefully, similar programs for other VGA boards will appear,      []
  27.  [] gradually building a Super-VGA "programmer's data base", and we    []
  28.  [] can all benefit from sharing this type of information.             []
  29.  []                                                                    []
  30.  [] If you program (text or) graphics routines for a Super-VGA, please []
  31.  [] consider sharing the information with the rest of us!              []
  32.  [] ------------------------------------------------------------------ []
  33.  []                                                                    []
  34.  [] I've included code for standard text and graphics modes so that    []
  35.  [] the program demonstrates a wide range of text and graphics         []
  36.  [] displays. However, of primary interest are the Paradise detect     []
  37.  [] routine and the Paradise extended ("Super-VGA") modes:             []
  38.  []                                                                    []
  39.  []   Text: 132x25         Graphics: 800x600x16                        []
  40.  []          80x50                   640x400x256                       []
  41.  []         132x43                   640x480x256                       []
  42.  []                                                                    []
  43.  [] All routines are written in Turbo Pascal (v/4 or 5), and also in   []
  44.  [] Turbo Assembler (MASM programmers will have no problem reading     []
  45.  [] TASM.) The compiler directive "UseAssemblerRoutines" determines    []
  46.  [] whether PVGA.ASM/PVGA.OBJ or the Pascal code will be used.         []
  47.  []                                                                    []
  48.  [] For Turbo Pascal programmers:                                      []
  49.  [] ----------------------------                                       []
  50.  [] The Turbo Pascal CRT unit is used to set text and background       []
  51.  [] color, position the cursor, and "fast write" text in text modes.   []
  52.  [] Note that the CRT.Window procedure does range checking, and        []
  53.  [] rejects attempts to set the window for the 132 column text modes.  []
  54.  [] However, setting CRT.WindMax circumvents the problem, so that the  []
  55.  [] cursor is positioned correctly via CRT.GotoXY.                     []
  56.  []                                                                    []
  57.  [] Bob Berry [76555,167]                                              []
  58.  []                                                                    []
  59.  [] 01/16/1989 - Version 2.0                                           []
  60.  [] ------------------------                                           []
  61.  [] 512k Detect: We can compare video RAM banks 0 and 1 while the      []
  62.  [] program is in text mode (at startup), to verify bank switching,    []
  63.  [] and identify a Paradise VGA. HOWEVER, the compare of banks 0 and   []
  64.  [] 64, to identify 512k FAILS in text mode. Apparently the attempt    []
  65.  [] to switch to bank 64 is rejected if the card is in text mode.      []
  66.  [] So, it's necessary to set a graphics mode before performing the    []
  67.  [] comparison of banks 0 and 64, or all cards will be identified as   []
  68.  [] having only 256k.                                                  []
  69.  []                                                                    []
  70.  [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
  71.  }
  72.  
  73. {$Define UseAssemblerRoutines }
  74. { change "$Define" to "$UnDef" to use Pascal code }
  75.  
  76. Uses DOS, CRT;
  77.  
  78. Const Video                           = $10;         { Video Interrupt }
  79.       ESCape                          = ^[;
  80.       Null                            = #0;
  81.       LeftArrowHead                   = #17;
  82.       RightArrowHead                  = #16;
  83.       UpArrowHead                     = #30;
  84.       DownArrowHead                   = #31;
  85.       HorizontalLine                  = #196;
  86.       VerticalLine                    = #179;
  87.  
  88.       Options                         = 16; { 0..16 }
  89.  
  90.       InfoLines                       = 17;
  91.       InfoLine: array[1..InfoLines] of String[36] = (
  92.         '╔══════════════════════════════════╗',
  93.         '║ Display modes identified as      ║',
  94.         '║ "SVGA" are "Super-VGA" modes,    ║',
  95.         '║ which will display on a Paradise ║',
  96.         '║ VGA adapter:                     ║',
  97.         '║                                  ║',
  98.         '║  - Paradise VGA Plus             ║',
  99.         '║  - Paradise VGA Plus 16          ║',
  100.         '║  - Paradise VGA Professional     ║',
  101.         '║                                  ║',
  102.         '║ NOTE:                            ║',
  103.         '║  800x600x16  requires multi-sync ║',
  104.         '║              monitor             ║',
  105.         '║  640x480x256 requires 512k       ║',
  106.         '║              VGA Professional    ║',
  107.         '║                                  ║',
  108.         '╚══════════════════════════════════╝');
  109.  
  110.       GoodbyLines                     = 17;
  111.       GoodbyLine: array[1..GoodbyLines] of String[76] = (
  112. 'PVGA: Version 2',
  113. 'This program (PVGA.EXE) and the source (PVGA.PAS and PVGA.ASM) are released',
  114. 'to the Public Domain, in hopes that it will encourage the exchange of',
  115. 'information about "Super-VGA" programming techniques.',
  116. '',
  117. 'The program source will be posted to the CompuServe Graphics Support forum',
  118. '(GO PICS) in the Video Adapters library (DL7) as PVGA.ARC. It is intended to',
  119. 'provide programmers with valid, tested routines for utilizing the extended',
  120. 'Paradise VGA text and graphics modes, as well as a number of the standard',
  121. 'text and graphics modes.',
  122. '',
  123. 'Anyone with Super-VGA programming routines for other boards is encouraged to',
  124. 'upload them to PICS DL7. Of particular interest (to me, anyway) is a',
  125. '"detect" routine for each Super-VGA, and the method used to set Super-VGA',
  126. 'modes and address video RAM, particularly in 256 color modes.',
  127. '',
  128. 'Bob Berry [76555,167]');
  129.  
  130. (*
  131. +----------------------------------------------------------------------+
  132. | NOTE for non-pascal programmers:                                     |
  133. | Turbo Pascal's "enumerated types" are used as a convenient shorthand |
  134. | method for establishing a "series of constants". For example:        |
  135. |                                                                      |
  136. |   Type VideoTypeType = (UnSupported,MDA, CGA, EGA, MCGA, VGA, PVGA); |
  137. |                                                                      |
  138. | is equivalent to:                                                    |
  139. |                                                                      |
  140. |   Const UnSupported = 0;  (or in assembler)  UnSupported equ 0       |
  141. |         MDA         = 1;                     MDA         equ 1       |
  142. |         CGA         = 2;                     CGA         equ 2       |
  143. | etc.                                                                 |
  144. +----------------------------------------------------------------------+
  145. *)
  146.  
  147. Type  VideoTypeType                   = (UnSupported,
  148.                                          MDA, CGA, EGA, MCGA, VGA, PVGA);
  149.       ModeType                        = (T_80x25x2,       { MDA            }
  150.                                          T_80x25x16,      {   CGA          }
  151.                                          T_80x43x16,      {     EGA        }
  152.                                          T_80x50x16,      {         VGA    }
  153.                                          T_132x25x16,     {           PVGA }
  154.                                          T_132x43x16,     {           PVGA }
  155.                                          G_640x200x2,     {   CGA          }
  156.                                          G_320x200x4,     {   CGA          }
  157.                                          G_320x200x16,    {     EGA        }
  158.                                          G_640x200x16,    {     EGA        }
  159.                                          G_640x350x16,    {     EGA        }
  160.                                          G_640x480x2,     {       MCGA     }
  161.                                          G_320x200x256,   {       MCGA     }
  162.                                          G_640x480x16,    {         VGA    }
  163.           { MultiSync required }         G_800x600x16,    {           PVGA }
  164.                                          G_640x400x256,   {           PVGA }
  165.           { 512k required }              G_640x480x256);  {           PVGA }
  166.       ModeSpecType                    = record
  167.                                           MaxX, MaxY,
  168.                                           MaxC, Mode:   Word;
  169.                                           Method, Desc: VideoTypeType;
  170.                                         end;
  171.  
  172. { ModeSpec identifies the maximum X, Y, and colors, the BIOS mode number,
  173.   method for writing (graphics) and the description of each mode. }
  174. Const ModeSpec: Array[ModeType] of ModeSpecType = (
  175.        (MaxX:  80; MaxY:  25; MaxC:   2; Mode:  7; Method: MDA;  Desc: MDA),
  176.        (MaxX:  80; MaxY:  25; MaxC:  16; Mode:  3; Method: CGA;  Desc: CGA),
  177.        (MaxX:  80; MaxY:  43; MaxC:  16; Mode:  3; Method: EGA;  Desc: EGA),
  178.        (MaxX:  80; MaxY:  50; MaxC:  16; Mode:  3; Method: VGA;  Desc: VGA),
  179.        (MaxX: 132; MaxY:  25; MaxC:  16; Mode: 85; Method: PVGA; Desc: PVGA),
  180.        (MaxX: 132; MaxY:  43; MaxC:  16; Mode: 84; Method: PVGA; Desc: PVGA),
  181.        (MaxX: 640; MaxY: 200; MaxC:   2; Mode:  6; Method: CGA;  Desc: CGA),
  182.        (MaxX: 320; MaxY: 200; MaxC:   4; Mode:  4; Method: CGA;  Desc: CGA),
  183.        (MaxX: 320; MaxY: 200; MaxC:  16; Mode: 13; Method: EGA;  Desc: EGA),
  184.        (MaxX: 640; MaxY: 200; MaxC:  16; Mode: 14; Method: EGA;  Desc: EGA),
  185.        (MaxX: 640; MaxY: 350; MaxC:  16; Mode: 16; Method: EGA;  Desc: EGA),
  186.        (MaxX: 640; MaxY: 480; MaxC:   2; Mode: 17; Method: EGA;  Desc: MCGA),
  187.        (MaxX: 320; MaxY: 200; MaxC: 256; Mode: 19; Method: MCGA; Desc: MCGA),
  188.        (MaxX: 640; MaxY: 480; MaxC:  16; Mode: 18; Method: EGA;  Desc: VGA),
  189.        (MaxX: 800; MaxY: 600; MaxC:  16; Mode: 88; Method: EGA;  Desc: PVGA),
  190.        (MaxX: 640; MaxY: 400; MaxC: 256; Mode: 94; Method: PVGA; Desc: PVGA),
  191.        (MaxX: 640; MaxY: 480; MaxC: 256; Mode: 95; Method: PVGA; Desc: PVGA) );
  192.  
  193. { ModeAvailable defines which modes are available on each type of adapter }
  194.       ModeAvailable: Array[MDA..PVGA,T_80x25x2..G_640x480x256] of Boolean = (
  195. {MDA}     (True, False,False,False,False,False,
  196.            False,False,False,False,False,False,False,False,False,False,False),
  197. {CGA}     (False,True, False,False,False,False,
  198.            True, True, False,False,False,False,False,False,False,False,False),
  199. {EGA}     (False,True, True, False,False,False,
  200.            True, True, True, True, True, False,False,False,False,False,False),
  201. {MCGA}    (False,True, False,False,False,False,
  202.            True, True, False,False,False,True, True, False,False,False,False),
  203. {VGA}     (False,True, False,True, False,False,
  204.            True, True, True, True, True, True, True, True, False,False,False),
  205. {PVGA}    (False,True, False,True, True, True,
  206.            True, True, True, True, True, True, True, True, True, True, True ));
  207.  
  208. Type  Palette256Type                  = Array[0..255,0..2] of Byte;
  209.  
  210. { Define types and variables to address CGA, MCGA, and EGA video RAM }
  211.       CGAPageType                     = Array[0..99,0..79] of Byte;
  212.       MCGAScreenType                  = Array[0..199,0..319] of Byte;
  213.       EGAScreenType                   = Array[0..59999] of Byte;
  214.  
  215. Var   CGA0: {even numbered lines}       CGAPageType    absolute $B800:$0000;
  216.       CGA1: { odd numbered lines}       CGAPageType    absolute $BA00:$0000;
  217.       MCGA0:                            MCGAScreenType absolute $A000:$0000;
  218.       EGA0:                             EGAScreenType  absolute $A000:$0000;
  219.  
  220.       VideoType:                        VideoTypeType;
  221.       VMode:                            ModeType;
  222.       ParadiseRam:                      Word;
  223.       P_VGA:                            Boolean;
  224.  
  225.       Regs:                             Registers;
  226.       Ch:                               Char;
  227.       TextModeNumber, SelectionLine:    Byte;
  228.       NeedNewScreen, Bypassed:          Boolean;
  229.  
  230.       Palette256:                       Palette256Type;
  231.       Pixels:                           Array[0..799] of Byte;
  232.  
  233.       N:                                Word;
  234.  
  235. (* .........................................................................
  236.   Video_ID.Obj procedure IdentifyVideo will identify the type of video
  237.   adapter attached to the system.
  238.   It's based on routines from Programmer's Guide to PC & PS/2 Video Systems
  239.   by Richard Wilton (ISBN 1-55615-103-9) from MicroSoft Press. Although
  240.   modified, the original source is copyrighted, and as such is not included.
  241.   .......................................................................... *)
  242.  
  243. Procedure IdentifyVideo; External; {$L Video_ID }
  244.  
  245. Procedure Wait;
  246.   Var C: Char;
  247.   begin
  248.     C:=ReadKey; If C=Null then C:=ReadKey;
  249.   end;   { Procedure Wait }
  250.  
  251. Function InterpretModeDescription(D: VideoTypeType): String;
  252.   begin
  253.     Case D of
  254.        MDA: InterpretModeDescription:=' MDA';
  255.        CGA: InterpretModeDescription:=' CGA';
  256.        EGA: InterpretModeDescription:=' EGA';
  257.        VGA: InterpretModeDescription:=' VGA';
  258.       MCGA: InterpretModeDescription:='MCGA';
  259.       PVGA: InterpretModeDescription:='SVGA';
  260.     end;   { Case D }
  261.   end;   { Function InterpretModeDescription }
  262.  
  263. {$IfDef UseAssemblerRoutines }
  264. { _____________________________ Assembler Routines _________________________ }
  265.  
  266. Procedure Paradise_Detect;                               External;
  267. Procedure Paradise_Unlock;                               External;
  268. Function  Paradise_Address(Row, Col: Word): Word;        External;
  269. Procedure SetVideoMode_(Mode: byte; TextLines: Word);    External;
  270. Procedure ClearTextScreenAndSetBorder(X, Y, A, B: Byte); External;
  271. Procedure SetMCGAPalette;                                External;
  272. Procedure SetEgaWriteMode(Mode: Byte);                   External; {$L PVGA }
  273.  
  274. Procedure SetVideoMode(ModeNumber, TextLines: Word);
  275.   begin
  276.     SetVideoMode_(Lo(ModeNumber),TextLines);
  277.     If P_VGA then Delay(750) else Delay(200);
  278.   end;   { Procedure SetVideoMode }
  279.  
  280. {$Else  }
  281. { _____________________________ Pascal Routines ____________________________ }
  282.  
  283. Procedure SetVideoMode(ModeNumber, TextLines: Word);
  284.   Var  InfoByte: Byte absolute $40:$87; { DOS data area at segment 0040h   }
  285.                                         { Video "Info Byte" at 0040h:0087h }
  286.   begin
  287.     With Regs do
  288.       begin
  289.         InfoByte:= InfoByte and $FE;
  290.         Ax:=ModeNumber; Intr(Video,Regs);
  291.         Case TextLines of
  292.           43: If VideoType=EGA then
  293.                 begin
  294.                   Ax:=$1112; Bl:=0; Intr(Video,Regs);
  295.                   InfoByte:=InfoByte or $01;
  296.                   Ax:=$0100; Cx:=$0600; Intr(Video,Regs);
  297.                   Ah:=$12;   Bl:=$20;   Intr(Video,Regs);
  298.                 end;
  299.           50: begin
  300.                 Ax:=$1112; Bl:=0; Intr(Video,Regs);
  301.               end;
  302.         end;   { Case TextLines }
  303.       end;
  304.     If P_VGA then Delay(750) else Delay(200);
  305.   end;   { Procedure SetVideoMode }
  306.  
  307. Procedure Paradise_Unlock;
  308.   begin
  309.     With Regs do
  310.       begin
  311.         Al:=$0F; Ah:=$05; PortW[$3CE]:=Ax; { "unlock write access" }
  312.       end;
  313.   end;   { Procedure Paradise_Unlock }
  314.  
  315. Procedure SelectBank(Bank: Byte);
  316.   begin
  317.     With Regs do begin Ah:=Bank; Al:=9; PortW[$3CE]:=Ax; end;
  318.   end;   { Procedure SelectBank }
  319.  
  320. Function BankDifferent(Bank1, Bank2: Byte; Segment: Word): Boolean;
  321.   Var   VideoByte:                    ^Byte;
  322.         Was1, Was2,
  323.         Set1, Set2,
  324.         Is1,  Is2:                    Byte;
  325.   begin
  326.     VideoByte:=Ptr(Segment,0);
  327.     Set1:=$11; Set2:=$22;
  328.     SelectBank(Bank1); Was1:=VideoByte^; VideoByte^:=Set1;
  329.     SelectBank(Bank2); Was2:=VideoByte^; VideoByte^:=Set2;
  330.     SelectBank(Bank1); Is1:=VideoByte^;  VideoByte^:=Was1;
  331.     SelectBank(Bank2); Is2:=VideoByte^;  VideoByte^:=Was2;
  332.     SelectBank(0);
  333.     BankDifferent:=(Is1=Set1) and (Is2=Set2);
  334.   end;   { Function BankDifferent }
  335.  
  336. Procedure Paradise_Detect;
  337.   begin
  338.     With Regs do
  339.       begin
  340.         Al:=          9;             { register 9 is a Paradise register }
  341.         Port[$3CE]:= Al;             { 3CE is the graphics controller port }
  342.         Al:=         Port[$3CF];     { try to read register 9 }
  343.         P_VGA:=(Al=0);               { if it's zero, looks like Paradise }
  344.         If P_VGA then
  345.           begin
  346.             Paradise_Unlock;
  347.             P_VGA:=BankDifferent(0,1,$B800); { if Bank0<>Bank1 this IS Paradise }
  348.           end;
  349.         If P_VGA then
  350.           begin
  351.             Ah:=$00; Al:=ModeSpec[G_640x400x256].Mode; Intr(Video,Regs);
  352.             If BankDifferent(0,64,$A000) then ParadiseRam:=512
  353.             else                              ParadiseRam:=256;
  354.             Ah:=$00; Al:=TextModeNumber; Intr(Video,Regs);
  355.           end;
  356.       end;
  357.   end;   { Procedure Paradise_Detect }
  358.  
  359. Function Paradise_Address(Row, Col: Word): Word;
  360.   Var   VideoAddress, VideoPage,
  361.         MemoryAddress:                  LongInt;
  362.         VP:                             Word;
  363.   begin
  364. { 640x400x256 and 640x480x256 video RAM is addressed in 4k banks. }
  365. { As each row is 640 bytes long, the address of the video RAM is  }
  366. { calculated as (row*640)+col, so row 479 is at         0004AD80  }
  367. { To write row 479, we need to select bank:                4A     }
  368. { and move the graphics data to:                       A000:0D80  }
  369.     With Regs do
  370.       begin
  371.         VideoAddress:= LongInt(Row)*640+Col;
  372.         VideoPage:=    (VideoAddress and $000FF000);
  373.         VideoPage:=    (VideoPage shr 12);
  374.         MemoryAddress:=(VideoAddress and $00000FFF);
  375.         VP:=VideoPage;
  376.         Al:=$09; Ah:=VP; PortW[$3CE]:=Ax;
  377.         Paradise_Address:=MemoryAddress;
  378.       end;
  379.   end;   { Function Paradise_Address }
  380.  
  381. Procedure ClearTextScreenAndSetBorder(X, Y, A, B: Byte);
  382.   begin
  383.     With Regs do
  384.       begin
  385.         Ax:=$0600; Bh:=A; Cx:=0; Dh:=Pred(Y); Dl:=Pred(X); Intr(Video,Regs);
  386.         Case VideoType of
  387.           MDA: begin end; { no MDA border }
  388.           EGA: begin end; { no EGA border.. it works, but is ugly! }
  389.           CGA: begin
  390.                  Ax:=$0B00; Bh:=0; Bl:=B; Intr(Video,Regs);
  391.                end;
  392.           else begin
  393.                  Ax:=$1001; Bh:=B;        Intr(Video,Regs);
  394.                end;
  395.         end;   { Case VideoType }
  396.       end;
  397.   end;   { Procedure ClearTextScreenAndSetBorder }
  398.  
  399. Procedure SetMCGAPalette;
  400.   begin
  401.     With Regs do
  402.       begin
  403.         Ax:=$1012; Bx:=32; Cx:=224;
  404.         Es:=Seg(Palette256); Dx:=Ofs(Palette256[32]);
  405.         Intr(Video,Regs);
  406.       end;
  407.   end;   { Procedure SetMCGAPalette }
  408.  
  409. Procedure SetEgaWriteMode(Mode: Byte);
  410.   begin
  411.     With Regs do
  412.       begin
  413.         Al:=$05;  Port[$3CE]:=Al;
  414.         Al:=Mode; Port[$3CF]:=Al;
  415.       end;
  416.   end;   { Procedure SetEgaWriteMode }
  417. {$EndIf }
  418.  
  419. { ________________________ TEXT ROUTINES ____________________________________}
  420.  
  421. Procedure WriteHorizontalRuler(L, Y: Byte);
  422.   Var  X: Byte;
  423.        S: String[3];
  424.   begin
  425.     TextColor(White); GotoXY(1,Succ(Y)); Write(LeftArrowHead);
  426.     For X:=2 to Pred(L) do Write(HorizontalLine);
  427.     Write(RightArrowHead);
  428.     For X:=1 to L do
  429.       begin
  430.         Str(X:3,S);
  431.         If (Pred(X) mod 5)=4 then
  432.           begin
  433.             If L>99 then begin GotoXY(X,Y-2); Write(S[1]); end;
  434.             GotoXY(X,Y-1); Write(S[2]);
  435.             GotoXY(X,Y);   Write(S[3]);
  436.           end
  437.         else
  438.           begin
  439.             If L>99 then begin GotoXY(X,Y-2); Write(' '); end;
  440.             GotoXY(X,Y-1); Write(' ');
  441.             GotoXY(X,Y);   Write('.');
  442.           end;
  443.       end;
  444.   end;   { Procedure WriteHorizontalRuler }
  445.  
  446. Procedure WriteVerticalRuler(L, X: Byte);
  447.   Var  Y: Byte;
  448.   begin
  449.     TextColor(Yellow); GotoXY(X+4,1); Write(UpArrowHead);
  450.     For Y:=2 to Pred(L) do begin GotoXY(X+4,Y); Write(VerticalLine); end;
  451.     GotoXY(X+4,L); Write(DownArrowHead);
  452.     For Y:=1 to L do begin GotoXY(X,Y); Write(Y:3); end;
  453.   end;   { Procedure WriteVerticalRuler }
  454.  
  455. Procedure DemonstrateTextMode(WhichMode: ModeType);
  456.   Var  HLine, VLine, BC, TC: Byte;
  457.   begin
  458.     With ModeSpec[WhichMode] do
  459.       begin
  460.         SetVideoMode(Mode,MaxY); WindMax:=(Pred(MaxY) shl 8)+Pred(MaxX);
  461.  
  462.         ClearTextScreenAndSetBorder(MaxX,MaxY,$1F,$04);
  463.   { $1F attribute is White on Blue, $04 border is red }
  464.  
  465.         GotoXY(1,1); TextBackground(Blue);
  466.         TextColor(LightCyan);
  467.         Write('Text mode: ',MaxX,' x ',MaxY,' x ',MaxC,' colors');
  468.         HLine:=MaxY shr 1; VLine:=MaxX shr 1;
  469.         For BC:=0 to 7 do
  470.           begin
  471.             GotoXY(2,MaxY-8+BC); TextBackground(BC);
  472.             For TC:=0 to 15 do begin TextColor(TC); Write(' *'); end;
  473.             Write(' ');
  474.           end;
  475.         TextBackground(Blue);
  476.         WriteVerticalRuler(MaxY,VLine); WriteHorizontalRuler(MaxX,HLine);
  477.         TextColor(LightRed);
  478.         GotoXY(MaxX-13,MaxY);
  479.         Write('Press a key >'); Wait;
  480.       end;
  481.   end;   { Procedure DemonstrateTextMode }
  482.  
  483. { ________________________ GRAPHICS ROUTINES ________________________________}
  484.  
  485. Procedure Calculate(Lines, Sections: Word; Var SectionSize, Offset: Word);
  486. { Based on the number of graphics lines on the screen, and the number of  }
  487. { sections we want, calculate the number of lines per section and the     }
  488. { "remainder", which we'll leave at the top of the screen.                }
  489.   begin
  490.     SectionSize:=Lines div Sections; Offset:=Lines-(Sections*SectionSize);
  491.   end;   { Procedure Calculate }
  492.  
  493. Procedure BuildMcgaPalette;
  494. { The default 256 color palette has the "standard" 16 colors, followed by a  }
  495. { 16 level gray scale. This is followed by three sets of 72 colors (in high, }
  496. { medium, and low intensity) which is not particularly interesting to see.   }
  497. { We'll build a color palette for colors 32..255 that's more appealing.      }
  498.   Var Color, Block, Col: Byte;
  499.   begin
  500.     For Block:=2 to 15 do
  501.       For Col:=0 to 15 do
  502.         begin
  503.           Color:=Block*16+Col;
  504.           Palette256[Color,0]:=4*(17-Block)+3; { Red: Decreasing vert. }
  505.           Palette256[Color,1]:=4*Col;          { Green: Increasing horiz. }
  506.           Palette256[Color,2]:=4*(15-Col)+3;   { Blue: Decreasing horiz. }
  507.         end;
  508.   end;   { Procedure BuildMcgaPalette }
  509.  
  510. Procedure WriteCGA(M, X, Y, C: Word);
  511.   Var   Block, Line, Color, Row, Row2: Byte;
  512.   Const Pat: Array[0..3,0..1] of Byte = (($11,$22),($96,$69),
  513.                                          ($AA,$55),($FF,$FF));
  514.   begin
  515.     SetVideoMode(M,Y);
  516.     If C=2 then            { if 2 colors, display four patterns }
  517.       For Block:= 0 to 3 do
  518.         For Line:=0 to 49 do
  519.           begin
  520.             Row:=Block*50+Line; Row2:=Row shr 1;
  521.             If Odd(Row) then FillChar(CGA1[Row2,0],80,Pat[Block,1])
  522.             else             FillChar(CGA0[Row2,0],80,Pat[Block,0]);
  523.           end
  524.     else
  525.       For Block:= 0 to 3 do
  526.         begin
  527.           Color:=Block*$55;
  528.           For Line:=0 to 49 do
  529.             begin
  530.               Row:=Block*50+Line; Row2:=Row shr 1;
  531.               If Odd(Row) then FillChar(CGA1[Row2,0],80,Color)
  532.               else             FillChar(CGA0[Row2,0],80,Color);
  533.             end;
  534.         end;
  535.   end;   { Procedure WriteCGA }
  536.  
  537. Procedure WriteEGA(M, X, Y, C: Word);
  538.   Var  Block, Line, Row, Col:        Word;
  539.        RowOfs, ColOfs, ByteOfs:      Word;
  540.        Lines, Offset:                Word;
  541.        AByte:                        Byte;
  542.   begin
  543.     SetVideoMode(M,Y);
  544.     Calculate(Y,16,Lines,Offset);
  545.     If C=2 then                    { 2 colors, display 16 patterns }
  546.       For Block:=0 to 15 do
  547.         For Line:=0 to Pred(Lines) do
  548.           begin
  549.             Row:=Block*Lines+Line+Offset;
  550.             RowOfs:=Row*(X div 8);
  551.             FillChar(EGA0[RowOfs],(X div 8),Block*$11);
  552.           end
  553.     else
  554.       For Block:=0 to 15 do
  555.         For Line:=0 to Pred(Lines) do
  556.           begin
  557.             Row:=Block*Lines+Line+Offset;
  558.             RowOfs:=Row*(X div 8); { address of row,0 }
  559.             SetEgaWriteMode(2);
  560.             FillChar(EGA0[RowOfs],(X div 8),Block);
  561.             SetEgaWriteMode(0);
  562.           end;
  563.   end;   { Procedure WriteEGA }
  564.  
  565. Procedure WriteMCGA(M, X, Y, C: Word);
  566.   Var  Block, Line, Row, Col, Color: Word;
  567.        Lines, Offset:                Word;
  568.   begin
  569.     SetVideoMode(M,Y);
  570.     SetMCGAPalette; Calculate(200,16,Lines,Offset);
  571.     For Block:=0 to 15 do
  572.       For Line:=0 to Pred(Lines) do
  573.         begin
  574.           Row:=Block*Lines+Line+Offset;
  575.           For Col:=0 to 15 do
  576.             begin
  577.               Color:=Block*16+Col;
  578.               FillChar(MCGA0[Row,Col*20],20,Color);
  579.             end;
  580.         end;
  581.   end;   { Procedure WriteMCGA }
  582.  
  583. Procedure WritePVGA(M, X, Y, C: Word);
  584.   Var  Block, Line, Row, Col, Color:  Word;
  585.        MA:                            Word;
  586.   begin
  587.     SetVideoMode(M,Y);
  588.     SetMCGAPalette;
  589.     Paradise_Unlock;          { unlock write access to extended registers }
  590.     For Block:=0 to 15 do
  591.       begin
  592.         For Col:=0 to 15 do
  593.           begin
  594.             Color:=Block*16+Col; FillChar(Pixels[Col*40],40,Color);
  595.           end;
  596.         For Line:=0 to 23 do
  597.           begin
  598.             Col:=0;
  599.             Row:=Block*24+Line+16;
  600.             MA:=Paradise_Address(Row, Col); { bank select, calc destination }
  601.             Move(Pixels,Mem[$A000:MA],X);
  602.           end;
  603.       end;
  604.     MA:=Paradise_Address(0, 0); { select bank 0 (before text write) }
  605.   end;   { Procedure WritePVGA }
  606.  
  607. Procedure DemonstrateGraphicsMode(WhichMode: ModeType);
  608.   begin
  609.     DirectVideo:=False; { CRT unit should not move text to video RAM,         }
  610.                         { but use BIOS calls to write text in graphics modes. }
  611.     With ModeSpec[WhichMode] do
  612.       begin
  613.         Case Method of
  614.            CGA: WriteCGA( Mode, MaxX, MaxY, MaxC);
  615.            EGA: WriteEGA( Mode, MaxX, MaxY, MaxC);
  616.           MCGA: WriteMCGA(Mode, MaxX, MaxY, MaxC);
  617.           PVGA: WritePVGA(Mode, MaxX, MaxY, MaxC);
  618.         end;   { Case Method }
  619.         GotoXY(1,1);
  620.         Write(InterpretModeDescription(Desc));
  621.         Write(' Graphics: ',MaxX,'x',MaxY,'x',MaxC,' colors.');
  622.         Wait;
  623.       end;
  624.   end;   { Procedure DemonstrateGraphicsMode }
  625.  
  626. { ________________________ GENERAL ROUTINES _________________________________}
  627.  
  628. Procedure WriteMainScreen;
  629.   begin
  630.     SetVideoMode(TextModeNumber,25); DirectVideo:=True;
  631.     ClearTextScreenAndSetBorder(80,25,$07,$00);
  632.     { attribute $07 = LightGray on Black, border $00 = black }
  633.  
  634.     GotoXY(1,1);
  635.     TextBackground(Black); TextColor(LightCyan); Write('Video system: ');
  636.     TextColor(LightGreen);
  637.     Case VideoType of
  638.        MDA: WriteLn('Monochrome Display Adapter (MDA)');
  639.        CGA: WriteLn('Color Graphics Adapter (CGA)');
  640.        EGA: WriteLn('Enhanced Graphics Adapter (EGA)');
  641.       MCGA: WriteLn('Multi-Color Graphics Array (MCGA)');
  642.        VGA: WriteLn('Video Graphics Array (VGA)');
  643.       PVGA: WriteLn(ParadiseRam,'k Paradise VGA adapter');
  644.     end;   { Case VideoType }
  645.     TextColor(Yellow);
  646.     WriteLn('┌','──────────────────────────────────','┐');
  647.     For VMode:=T_80x25x2 to G_640x480x256 do With ModeSpec[VMode] do
  648.       begin
  649.         Write('│  ');
  650.         If ModeAvailable[VideoType,VMode] then TextColor(White)
  651.         else                                  TextColor(LightGray);
  652.         Write(InterpretModeDescription(Desc));
  653.         If VMode in [T_80x25x2..T_132x43x16] then Write(' text:     ')
  654.         else                                     Write(' graphics: ');
  655.         Write(MaxX:4,' x ',MaxY:3,' x ',MaxC:3);
  656.         TextColor(Yellow);
  657.         WriteLn(' │');
  658.       end;
  659.     WriteLn('└','──────────────────────────────────','┘');
  660.     TextColor(LightRed);
  661.     WriteLn('Move to desired mode using cursor arrow keys.');
  662.     WriteLn('Press right arrow or carriage return to execute.');
  663.     WriteLn('Press ESCape to exit.');
  664.     TextBackground(LightGray); TextColor(Black);
  665.     For N:=1 to InfoLines do
  666.       begin GotoXY(45,N+2); Write(InfoLine[N]); end;
  667.     TextBackground(Black); TextColor(White); NeedNewScreen:=False;
  668.   end;   { Procedure WriteMainScreen }
  669.  
  670. Procedure DemonstrateMode(Which: Byte);
  671.   Var M: ModeType absolute Which;
  672.   begin
  673.     If ModeAvailable[VideoType,M] then
  674.       begin
  675.         TextColor(White);
  676.         If M>T_132x43x16 then DemonstrateGraphicsMode(M)
  677.         else                  DemonstrateTextMode(M);
  678.         NeedNewScreen:=True;
  679.       end;
  680.   end;   { Procedure DemonstrateMode }
  681.  
  682. Procedure ProcessKeyStroke;
  683.   begin
  684.     If NeedNewScreen then WriteMainScreen;
  685.     GotoXY(2,SelectionLine+3); Write(RightArrowHead);
  686.     GotoXY(2,SelectionLine+3);
  687.     Ch:=ReadKey;
  688.     If Ch=Null then             { extended key (eg. cursor key) }
  689.       begin
  690.         Ch:=ReadKey;
  691.         Case Ch of              { translate cursor keys }
  692.           #71: Ch:='7';
  693.           #72: Ch:='8';
  694.           #73: Ch:='9';
  695.           #77: Ch:='6';
  696.           #79: Ch:='1';
  697.           #80: Ch:='2';
  698.           #81: Ch:='3';
  699.         end;   { Case Ch }
  700.       end;
  701.     Write(' ');
  702.     Case Ch of
  703.       '7',                                                  { Home }
  704.       '9': SelectionLine:=0;                                { PgUp }
  705.       '8': If SelectionLine>0 then Dec(SelectionLine)       { Up   }
  706.            else SelectionLine:=Options;
  707.       '2': If SelectionLine<Options then Inc(SelectionLine) { Dn   }
  708.            else SelectionLine:=0;
  709.       '1',                                                  { End  }
  710.       '3': SelectionLine:=Options;                          { PgDn }
  711.       '6',                                                  { Rgt }
  712.        ^M: DemonstrateMode(SelectionLine);                  { carriage return }
  713.     end;   { Case Ch }
  714.   end;   { Procedure ProcessKeyStroke }
  715.  
  716.  {
  717.  [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
  718.  []                        Paradise_VGA MainLine                       []
  719.  [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
  720.  }
  721.  
  722. begin
  723.   P_VGA:=False; ParadiseRam:= 0; IdentifyVideo;
  724.   If VideoType=MDA then TextModeNumber:=7 else TextModeNumber:=3;
  725.   Case VideoType of
  726.     UnSupported: begin WriteLn('Un-supported video type.'); Halt(1); end;
  727.             VGA: begin
  728.                    Paradise_Detect;
  729.                    If P_VGA then
  730.                      begin
  731.                        VideoType:=PVGA;
  732.                        ModeAvailable[PVGA,G_640x480x256]:= (ParadiseRam>256);
  733.                      end;
  734.                  end;
  735.   end;   { Case VideoType }
  736.   BuildMCGAPalette; SelectionLine:=0; NeedNewScreen:=True;
  737.  
  738.   Repeat ProcessKeyStroke; Until Ch=ESCape;
  739.  
  740.   TextColor(LightGray);  SetVideoMode(TextModeNumber,25);
  741.   GotoXY(1,1);
  742.   For N:=1 to GoodbyLines do WriteLn(GoodbyLine[N]);
  743. end.