home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / GA / GA028.ZIP / PLOT.INC < prev    next >
Text File  |  1986-08-27  |  14KB  |  415 lines
  1. {**** Include file containing EGA Graphics primitives. ****}
  2.  
  3. (****************************************************)
  4. (* COPYRIGHT (C) 1986 by Kevin McCarty.             *)
  5. (* All commercial use prohibited.                   *)
  6. (* Permission is granted for copying, distribution, *)
  7. (* adaptation, and incorporation into other works,  *)
  8. (* but for personal or educational use only,        *)
  9. (* and this notice is to be preserved.              *)
  10. (****************************************************)
  11.  
  12. CONST
  13.     XDOTMAX = 639;      { highest possible horizontal resolution }
  14.     YDOTMAX = 349;      { highest possible vertical resolution }
  15.  
  16. TYPE
  17.     Registers = RECORD
  18.         CASE integer OF
  19.         0:  (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer);
  20.         1:  (AL,AH, BL,BH, CL,CH, DL,DH : Byte);
  21.         END;
  22.  
  23.     Palette_Registers = array [0..16] of byte;
  24.     Rainbow = array [1..15] of byte;
  25.  
  26. CONST
  27.     EGA_10 : Palette_Registers = (    { For mode $10 ONLY (ECD) }
  28.            0,   1,   2,   3,   4,   5, $14,  7,
  29.          $38, $39, $3A, $3B, $3C, $3D, $3E, $3F, 0);
  30.     EGA_0E : Palette_Registers = (    { For mode $0E ONLY (COLOR DISP) }
  31.            0,   1,   2,   3,   4,   5,   6,   7,
  32.          $10, $11, $12, $13, $14, $15, $16, $17, 0);
  33.  
  34.     ColorList : rainbow = (
  35.              LightCyan,                 {start with some bright colors}
  36.              LightMagenta, Magenta,
  37.              Red, LightRed,
  38.              Brown, Yellow,
  39.              LightGreen, Green,
  40.              Blue, LightBlue,
  41.              White, LightGray, 
  42.              DarkGray, Cyan             { put all the dull colors last}
  43.              );
  44.  
  45.  
  46. VAR
  47.     Rec             : Registers;
  48.     Xaddr           : array [0..XDOTMAX] of integer;
  49.     Yaddr           : array [0..YDOTMAX] of integer;
  50.     Point           : array [0..XDOTMAX] of integer;
  51.     Hue             : Palette_Registers; { EGA palette values }
  52.  
  53.     MaxXdot         : integer;  { highest usable horizontal dot coordinate }
  54.     MaxYdot         : integer;  { highest usable vertical dot coordinate }
  55.     Mono            : boolean;  { only one color }
  56.     EGAthere        : boolean;  { true if EGA }
  57.     CGAthere        : boolean;  { true if CGA and not EGA }
  58.     XorDot          : boolean;  { if mono, XOR pixels, else use OR }
  59.     MaxColor        : integer;  { number of non-black colors available }
  60.     G_Mode          : integer;
  61.     T_Mode          : integer;
  62.     PaletteNo       : integer;  { for graphics mode 4-6 }
  63.     MaxPalette      : integer;
  64.     resp            : char;
  65.  
  66.  
  67. PROCEDURE Set_Palette;
  68. BEGIN
  69.     REPEAT
  70.     CASE G_Mode OF
  71.     4:  BEGIN
  72.         Writeln('Select Palette Number:');
  73.         Writeln('0) Green       Red             Brown');
  74.         Writeln('1) Cyan        Magenta         Light Grey');
  75.         Writeln('2) Light Green Light Red       Yellow');
  76.         Write  ('3) Light Cyan  Light Magenta   White     : ');
  77.         MaxPalette := 3;
  78.         END;
  79.     5:  BEGIN
  80.         Writeln('Select Palette Number:');
  81.         Writeln('0) Blue        Red             Light Grey');
  82.         Write  ('1) Light Blue  Light Red       White     :');
  83.         MaxPalette := 1;
  84.         END;
  85.     6:  BEGIN
  86.         Write  ('Select Background Color: (0 - 15):');
  87.         MaxPalette := 15;
  88.         END;
  89.     ELSE MaxPalette := 0;
  90.     END;    (* CASE *)
  91.  
  92.     IF MaxPalette > 0 THEN Readln(PaletteNo);
  93.     UNTIL (MaxPalette <= 0) OR (PaletteNo in [0..MaxPalette]);
  94. END;    (* Set_Palette *)
  95.  
  96.  
  97.  
  98. PROCEDURE Cycle_Palette;
  99. VAR
  100.     i, j1, j2 : integer;
  101.     c : byte;
  102. BEGIN
  103.     PaletteNo := (PaletteNo + 1) mod (MaxPalette + 1);
  104.     CASE G_Mode OF
  105.         4, 5:   Palette (PaletteNo);
  106.         6:      GraphBackground (PaletteNo);  { actually a color, not a palette }
  107.         $E, $10:    { 16-color EGA }
  108.             BEGIN
  109.             { cycle palette colors one step through the rainbow }
  110.             { black and overscan values stay put at 0 }
  111.             c := hue [ ColorList [1]];
  112.             FOR i := 1 TO 14 DO
  113.                 BEGIN
  114.                 j1 := ColorList [i];
  115.                 j2 := ColorList [i + 1];
  116.                  hue [j1] := hue [j2];
  117.                 END;
  118.             hue [j2] := c;
  119.             {now reprogram palette }
  120.             {don't worry-- mode set to text mode will
  121.             restore old values back to normal }
  122.             WITH rec DO
  123.                 BEGIN
  124.                 AX := $1002;    { program all registers }
  125.                 ES := Seg(Hue);
  126.                 DX := Ofs(Hue);
  127.                 Intr ($10, rec);
  128.                 END;
  129.             END; { 16-color EGA }
  130.         END;    { CASE }
  131. END;    (* Cycle_Palette *)
  132.  
  133.  
  134.  
  135. PROCEDURE Init_Graphics;
  136. { determine appropriate graphics mode to use }
  137. { If EGA present then
  138.         if mono then            mode $0F, 640x350,  1 color;
  139.         if color then           mode $0E, 640x200, 15 colors;
  140.         if ECD then             mode $10, 640x350, 15 colors; (256k)
  141.   Else if CGA present then
  142.         User choice of          mode $04, 320x200,  3 colors;
  143.         or                      mode $05, 320x200,  3 colors;
  144.         or                      mode $06, 640x200,  1 color;
  145.   Else you're out of luck
  146. }
  147.  
  148. VAR
  149.     i        : integer;
  150.     Equipflag: integer;
  151.     Switches : byte;
  152.     EGAInfo  : byte;
  153. BEGIN
  154.     PaletteNo := 0;
  155.     MaxPalette := 0;
  156.     MaxColor := 0;
  157.     EGAthere := false;
  158.     CGAthere := false;
  159.     WITH rec DO
  160.         BEGIN
  161.         { If EGA is present, then use it }
  162.         AX := $1200;    { EGA information }
  163.         BX := $0010;
  164.         CX := $00FF;    { preset CX in case EGA not there }
  165.         Intr ($10, rec);
  166.         Switches := CL AND $0F;
  167.         EGAthere := (Switches <> $0F);
  168.  
  169.         IF EGAthere THEN
  170.             BEGIN
  171.             EGAInfo  := Mem [$40 : $87];
  172.             Mono     := EGAthere AND ((EGAInfo AND 2) = 2);
  173.             T_Mode   := 3; { unless mono... }
  174.             IF Mono THEN
  175.                 BEGIN
  176.                 G_Mode := $0F;     { 640 X 350 monochrome }
  177.                 T_Mode := $07;
  178.                 MaxXdot := XDOTMAX; MaxYdot := YDOTMAX;
  179.                 MaxColor := 1;
  180.                 Write('XOR Dots (Y/N): ');
  181.                 Read(kbd,resp);
  182.                 XorDot := (UpCase(resp) = 'Y');
  183.                 END
  184.  
  185.             ELSE { Color Display or ECD }
  186.                 { see EGA Tech. Ref. p. 108 }
  187.                 CASE switches OF
  188.                 6 : BEGIN   { Color 40 X 25 -- 320 X 200 }
  189.                     G_Mode := $0D;
  190.                     MaxXdot := 319; MaxYdot := 199;
  191.                     MaxColor := 15;
  192.                     Hue := EGA_0E;
  193.                     END;
  194.                 7 : BEGIN   { Color 80 X 25 -- 640 X 200 }
  195.                     G_Mode := $0E;
  196.                     MaxXdot := 639; MaxYdot := 199;
  197.                     MaxColor := 3;
  198.                     Hue := EGA_0E;
  199.                     END;
  200.                 8,          { Enhanced color -- normal mode, or }
  201.                 9 : BEGIN   { Enhanced color -- enhanced mode }
  202.                     G_Mode := $10;
  203.                     MaxXdot := 639; MaxYdot := 349;
  204.                     MaxColor := 15;
  205.                     Hue := EGA_10;
  206.                     END;
  207.                 ELSE        { Default to 640 X 200 mode}
  208.                     BEGIN
  209.                     G_Mode := $0E;
  210.                     MaxXdot := 639; MaxYdot := 199;
  211.                     MaxColor := 15;
  212.                     Hue := EGA_0E;
  213.                     END;
  214.                 END; { CASE }
  215.             END { EGAthere}
  216.  
  217.         ELSE
  218.             BEGIN   { verify presence of CGA }
  219.             Intr ($11, rec); { determine hardware }
  220.             Equipflag := AL;
  221.             CGAthere  := (Equipflag AND $30) IN [$10,$20];
  222.  
  223.             IF CGAthere THEN
  224.                 BEGIN
  225.                 T_Mode := 3;
  226.                 REPEAT
  227.                     Writeln('Select Graphics Mode:');
  228.                     Writeln('4) 3-Color    Lo-Res (320x200)');
  229.                     Writeln('5) 3-Color    Lo-Res (320x200)');
  230.                     Write  ('6) Monochrome Hi-Res (640x200): ');
  231.                     Readln(G_Mode);
  232.                 UNTIL G_Mode in [4,5,6];
  233.                 CASE G_Mode OF
  234.                 4, 5:   BEGIN
  235.                         MaxXdot := 319; MaxYdot := 199;
  236.                         MaxColor := 3;
  237.                         MaxPalette := 3;
  238.                         END;
  239.                 6:      BEGIN
  240.                         MaxXdot := 639; MaxYdot := 199;
  241.                         MaxColor := 1;
  242.                         MaxPalette := 15;
  243.                         END;
  244.                     END; { CASE }
  245.                 Set_Palette;
  246.                 END { CGAthere }
  247.  
  248.             ELSE
  249.                 BEGIN
  250.                 Writeln('No graphics hardware detected!');
  251.                 Writeln('I give up!');
  252.                 Halt;
  253.                 END;
  254.             END; { not EGAthere }
  255.  
  256.         END; { WITH }
  257.  
  258.     Writeln;
  259.     Writeln('Using Graphics Mode      ',G_Mode:2);
  260.     Writeln(MaxXdot+1:3, ' x ',MaxYdot+1:3, ' Resolution with ',Maxcolor+1:2,
  261.             ' colors.');
  262.     Writeln('Will return to Text Mode ',T_Mode:2);
  263.  
  264.     {**** Arrays used to avoid repetitive address calculations.}
  265.     FOR i := 0 TO YDOTMAX DO Yaddr [i] := 80*i;
  266.     FOR i := 0 TO XDOTMAX DO Xaddr [i] := i DIV 8;
  267.     FOR i := 0 TO XDOTMAX DO Point [i] := $80 SHR (i MOD 8)
  268.  
  269. END;    (* Init_Graphics *)
  270.  
  271. Procedure Graphics_Mode;
  272. BEGIN
  273.     Write('Press any key when ready---');
  274.     Read(kbd,ch);
  275.     IF EGAthere THEN
  276.         BEGIN
  277.         rec.ax := G_Mode;
  278.         Intr ($10,rec);      { switch to graphics mode }
  279.         END
  280.     ELSE { must be CGA }
  281.         CASE G_Mode OF
  282.             6:  BEGIN
  283.                 Hires;
  284.                 HiResColor (PaletteNo);
  285.                 END;
  286.             4:  BEGIN
  287.                 GraphColorMode;
  288.                 Palette (PaletteNo);
  289.                 END;
  290.             5:  BEGIN
  291.                 GraphMode;
  292.                 Palette (PaletteNo);
  293.                 END;
  294.             END; { CASE }
  295. END;    (* Graphics_Mode *)
  296.  
  297.  
  298. Procedure Text_Mode;
  299. BEGIN
  300.     IF EGAthere THEN
  301.         BEGIN
  302.         rec.ax := T_Mode;
  303.         Intr ($10,rec);      { switch to text mode }
  304.         END
  305.     ELSE { must be CGA }
  306.         TextMode;
  307. END;    (* Text_Mode *)
  308.  
  309.  
  310.  
  311. PROCEDURE CgaPlot (x, y, color : INTEGER);
  312. BEGIN   (* Use Turbo's builtin CGA Plot *)
  313.     Plot (x, y, color);
  314. END;    (* CgaPlot *)
  315.  
  316.  
  317. PROCEDURE EgaPlot (bitmask, addr, color : integer);
  318. { plot a dot of given color at given pixel bit address }
  319. { based on EGA information in BYTE Magazine's
  320.   Special Issue on IBM PC, September 1985 }
  321. VAR scratch : byte;
  322. BEGIN
  323.     Port [$3CE] := 8;
  324.     Port [$3CF] := bitmask;
  325.     Mem [$A000:addr] := Mem [$A000:addr] AND 0; { latch bit planes }
  326.                                                 { set bit planes to zero }
  327.     Port [$3C4] := 2;                           { map mode }
  328.     Port [$3C5] := color;
  329.     Mem [$A000:addr] := Mem [$A000:addr] OR $FF;
  330.  
  331.     Port [$3C4] := 2;
  332.     Port [$3C5] := $F;
  333.     Port [$3CE] := 8;
  334.     Port [$3CF] := $FF;
  335. END;    (* EgaPlot *)
  336.  
  337.  
  338. PROCEDURE Plot (x, y, color : INTEGER);
  339. { NOTE: for mono displays, using XOR instead of OR below
  340.   can have quite a pleasant effect: instead of display getting
  341.   denser and denser, the image +glistens+ and ~coruscates~}
  342. { NOTE: There are actually THREE colors on an EGA-controlled
  343.   monochrome display: off, on, and bright (blinking doesn't count)}
  344. VAR
  345.    total : integer;
  346. BEGIN
  347.     { If out of range then don't plot anything }
  348.     IF (x >= 0) AND (x <= MaxXdot) AND (y >= 0) AND (y <= MaxYdot) THEN
  349.         IF EGAthere THEN
  350.             BEGIN
  351.             total := Xaddr [x] + Yaddr [y];
  352.             { EGA graphics memory is sequential starting at $A000 }
  353.             IF Mono THEN CASE XorDot OF
  354.                 true:  MEM [$A000: total] := point [x] XOR MEM [$A000: total];
  355.                 false: MEM [$A000: total] := point [x] OR  MEM [$A000: total];
  356.                 END
  357.             ELSE
  358.                 EgaPlot (point [x], total, color);
  359.             END
  360.         ELSE    { CGAthere }
  361.             CgaPlot (x, y, color);
  362. END;    (* Plot *)
  363.  
  364.  
  365. (**** PROCEDURES FOR GRAPHICS SCREEN DUMPS *****)
  366.  
  367. FUNCTION Pixels (addr : integer): byte;
  368. { return byte with bits set wherever nonzero pixel values at addr }
  369. { used for monochrome graphics screen dump }
  370. VAR
  371.     bits, mask : byte;
  372.     i : integer;
  373. BEGIN
  374.     bits := 0;
  375.     FOR i := 3 DOWNTO 0 DO
  376.         BEGIN
  377.         Port [$3CE] := 4;            { Read Map Select Register }
  378.         Port [$3CF] := i;            { bit plane number }
  379.         bits := bits OR Mem [$A000:addr];
  380.         END;
  381.     Pixels := bits
  382. END;    (* Pixels *)
  383.  
  384.  
  385. PROCEDURE Screen_Dump;
  386. { adapted from "Scientific Graphics with the EGA"
  387.  by Victor Mansfield, PC Tech Journal, v.3 n.9, Sept 1985
  388.  Copyright 1985 by Ziff-Davis Publishing Company }
  389. VAR
  390.     xindx, yindx : integer;
  391.     init_char : string [4];
  392. BEGIN
  393.  
  394.    { codes are for EPSON graphics modes }
  395.     IF EGAthere THEN 
  396.         BEGIN   { Do it the hard way }
  397.  
  398.         WRITELN(LST,CHR(27)+'A'+CHR(7));
  399.         INIT_CHAR := CHR(27)+'K'+CHR(94)+CHR(1);
  400.  
  401.         FOR xindx := 0 TO 79 DO
  402.             BEGIN
  403.             WRITE (LST, init_char);
  404.             FOR yindx:=YDOTMAX DOWNTO 0 DO
  405.                   WRITE (LST, CHR (Pixels (Yaddr [yindx] + xindx)));
  406.             WRITELN (LST);
  407.             END;
  408.         WRITELN(LST,CHR(12),CHR(27) + '@');  {**** Clear printer attributes.}
  409.         WRITELN(LST);
  410.         END
  411.     ELSE
  412.         Intr (5,rec); {***** ASSUME GRAPHICS.COM IS LOADED ***** }
  413. END;    (* Screen_Dump *)
  414. 
  415.