Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/EGA_GRAF.ZIP/EGA_PRIM.INC

Text File | 1985-08-29 | 6.1 KB | 188 lines

{**** An include file that contains EGA Graphics primitives. ****}

TYPE
   RegisterPack = RECORD
          AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : INTEGER
       END;

VAR
   Rec : RegisterPack;
   Xaddr : ARRAY[0..639] OF INTEGER;
   Yaddr : ARRAY[0..349] OF INTEGER;
   Point : ARRAY[0..639] OF INTEGER;


PROCEDURE Init_graphics;
VAR
   indx     : INTEGER;
   switches : BYTE;
   info     : BYTE;
   mono     : BOOLEAN;
BEGIN
   switches := MEM[$40 : $88] AND $0F;
   info     := MEM[$40 : $87];
   { mono is TRUE if monochrome display attached to EGA }
   mono   := ODD((info AND $02) SHR 1);
   { now we set up registers for the mode set based on }
   { switch settings and information byte bits }
   IF mono THEN rec.ax := $000F  { 640 X 350 monochrome }
   ELSE WITH rec DO
     CASE switches OF
       6 : ax := $0D;   { Color 40 X 25 -- 320 X 200 }
       7 : ax := $0E;   { Color 80 X 25 -- 640 X 200 }
       8 : ax := $10;   { Enhanced color -- normal mode }
       9 : ax := $10;   { Enhanced color -- enhanced mode
       ELSE rec.ax := $0E;  { Default to "safe" 640 X 200 mode}
     END; { CASE }
   INTR($10,rec);
   {**** Arrays used to avoid repetitive address calculations.}
   FOR indx := 0 TO 349 DO Yaddr[indx] := 80*indx;
   FOR indx := 0 TO 639 DO Xaddr[indx] := indx DIV 8;
   FOR indx := 0 TO 639 DO Point[indx] := $80 SHR (indx MOD 8)
END;


PROCEDURE plot( x, y : INTEGER);
VAR
   total : INTEGER;
BEGIN
   total := Xaddr[x] + Yaddr[y];
   {**** EGA memory is sequential starting at $A000.}
   MEM[$A000: total] := point[x] OR MEM[$a000: total]
END;


PROCEDURE switch(VAR first, second : INTEGER);
VAR
   temp : INTEGER;
BEGIN
   temp := first;
   first := second;
   second := temp
END;


PROCEDURE draw( xx1, yy1, xx2, yy2 : INTEGER);
VAR
   Lg_delta, Sh_delta, Cycle, Lg_step, Sh_step, dtotal : INTEGER;
BEGIN
   {**** Set up deltas and steps according to the relationship of
                         (X1, Y1) and (X2, Y2).}
   Lg_delta := xx2 - xx1;   Sh_delta := yy2 - yy1;
   IF Lg_delta < 0 THEN
        BEGIN
           Lg_delta := -Lg_delta;   Lg_step := -1
        END
      ELSE  Lg_step := 1;
   IF Sh_delta < 0 THEN
        BEGIN
           Sh_delta := -Sh_delta;   Sh_step := -1
        END
      ELSE  Sh_step := 1;
   IF Sh_delta < Lg_delta THEN
      BEGIN
         {**** Here is the expected case of a longer X-axis so make
               cycle = large_delta/2 and do the normal increments.}
         cycle := lg_delta SHR 1;
         WHILE xx1 <> xx2 DO
            BEGIN
               {**** While the endpoints do not meet Plot and make
                                          the usual increments.}
               dtotal := Xaddr[xx1] + Yaddr[yy1];
               MEM[$A000: dtotal] := point[xx1] OR MEM[$a000: dtotal];
               xx1 := xx1 + Lg_step;   cycle := cycle + Sh_delta;
               IF cycle > Lg_delta THEN
                  BEGIN
                     yy1 := yy1 + Sh_step;  cycle := cycle - Lg_delta
                  END
            END
      END
    ELSE
      BEGIN
         {**** This is the reverse of what we expect so make the
              cycle = short_delta/2 and switch deltas and steps.}
         cycle := sh_delta SHR 1;
         switch(lg_delta, Sh_delta);
         switch(lg_step, sh_step);
         WHILE yy1 <> yy2 DO
            BEGIN
               {**** While the endpoints do not meet Plot and make the
                                           increments.}
               dtotal := Xaddr[xx1] + Yaddr[yy1];
               MEM[$A000: dtotal] := point[xx1] OR MEM[$A000: dtotal];
               yy1 := yy1 + lg_step;   cycle := cycle + sh_delta;
               IF cycle > lg_delta THEN
                  BEGIN
                     cycle := cycle - lg_delta;  xx1 := xx1 + sh_step
                  END
            END
      END
END;


FUNCTION isqrt( arg : INTEGER) : INTEGER;  {**** Returns the integer
                                           sqrt without using reals.}
VAR
   odd_int, old_arg, first_sqrt : INTEGER;
BEGIN
   odd_int := 1;  old_arg := arg;
   WHILE arg >= 0 DO
      BEGIN
         arg := arg - odd_int;
         odd_int := odd_int + 2;
      END;
   first_sqrt := odd_int SHR 1;
   {**** Now a fixup to take care of overshoots.}
   IF SQR(first_sqrt) - first_sqrt + 1 > old_arg
        THEN isqrt := first_sqrt - 1 ELSE isqrt := first_sqrt
END;


PROCEDURE circle( cx, cy, radius : INTEGER);
VAR
   a, af, b, bf, target, r2 : INTEGER;
BEGIN
    target := 0;   a := radius;   b := 0;   r2 := sqr(radius);
    WHILE a >= b DO
       BEGIN
          b := ROUND(sqrt(r2 - sqr(a))); {**** Use Isqrt(r2 - sqr(a)) here
                                         if you do not have the 8087 chip.}
          switch( target, b);
          WHILE b < target DO {**** Inner loop takes care of straight lines
                                      at cardinal points.}
             BEGIN
                {**** Put in aspect correction and make use of the symmetry
                    of a circle by plotting 8 points for each calculation.}
                af := 120*a DIV 100;   bf := 120*b DIV 100;
                plot(cx + af, cy + b);  plot(cx + bf, cy + a);
                plot(cx - af, cy + b);  plot(cx - bf, cy + a);
                plot(cx - af, cy - b);  plot(cx - bf, cy - a);
                plot(cx + af, cy - b);  plot(cx + bf, cy - a);
                b := b + 1;
             END;
          a := a - 1;
       END
END;


PROCEDURE Screen_dump;
VAR
    xindx, yindx : INTEGER;
    init_char : STRING[4];
BEGIN
   {**** The next two lines are for the Epson FX, JX, and MX with
                  GrafTrax+. }
   WRITELN(LST,CHR(27)+'A'+CHR(7));
   WRITELN(lst,chr(27)+'2');
   INIT_CHAR := CHR(27)+'K'+CHR(94)+CHR(1);
   FOR xindx := 0 TO 79 DO
     BEGIN
        WRITE(LST, init_char);
        FOR yindx:=349 DOWNTO 0 DO
              WRITE(LST,CHR(MEM[$A000: Yaddr[yindx]+xindx]));
        WRITELN(LST);
     END;
   WRITELN(LST,CHR(27) + '@');  {**** Clear printer attributes.}
   WRITELN(LST);
END;