home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPEGA.ZIP / GPSHADE.P < prev    next >
Encoding:
Text File  |  1986-02-01  |  1.7 KB  |  63 lines
  1. {                                                                             }
  2. {       EGA Graphic Primitive for Turbo Pascal 3.01A, Version 01FEB86.        }
  3. {       (C) 1986 by Kent Cedola, 2015 Meadow Lake Ct., Norfolk, VA, 23518     }
  4. {                                                                             }
  5. {       Description: Set the current style for line drawing primitives.       }
  6. {       Setting the shading will set the shading flag on and setting the      }
  7. {       current color will reset it zero. If the shading flag is zero then    }
  8. {       the current color will be used, else the line style.                  }
  9. {                                                                             }
  10.  
  11. procedure GPSHADE(Var Shade);
  12. var
  13.   mx,my,x,y,x1,y1,i: Integer;
  14.   colors: array [0..65] of byte absolute Shade;
  15. begin
  16.  
  17.   GDSHADE := addr(Shade);
  18.  
  19.   mx := colors[0];
  20.   my := colors[1];
  21.  
  22.   x  := 0;
  23.   y  := 0;
  24.   x1 := 0;
  25.   y1 := 0;
  26.  
  27.   for i := 0 to 63 do
  28.     begin
  29.  
  30.       if x1 = 8 then
  31.         begin
  32.         x1 := 0;
  33.         y1 := y1 + 1;
  34.         y  := y + 1;
  35.         end;
  36.  
  37.       if x = mx then
  38.         begin
  39.         x := 0;
  40.         end;
  41.  
  42.       if y = my then
  43.         begin
  44.         y := 0;
  45.         end;
  46.  
  47.       GDSHADE1[y1*8+x1+2] := colors[y*mx+x+2];
  48.  
  49.       x  := x + 1;
  50.       x1 := x1 + 1;
  51.  
  52.     end;
  53.  
  54.     GDSHADE1[0] := 8;
  55.     GDSHADE1[1] := 8;
  56.  
  57.   inline
  58.     ($C7/$06/GDS_FLG/$FFFF /$BA/$03CE /$B8/$0205 /$EF /$B0/$08 /$EE /$42
  59.       /$8E/$06/GDGSEG /$8D/$36/GDSHADE1 /$46 /$46 /$8B/$3E/GDGSADR /$B9/>$40
  60.       /$B0/$80 /$EE /$26/$8A/$25 /$8A/$24 /$26/$88/$25 /$D0/$C8 /$83/$D7/$00
  61.       /$46 /$E2/$EF /$B0/$FF /$EE /$4A /$B8/>$05 /$EF);
  62. end;
  63.