home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 07 / tricks / pats.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-03-22  |  1.4 KB  |  54 lines
  1. (* ------------------------------------------------------ *)
  2. (*                       PATS.PAS                         *)
  3. (*         Graustufen für die Hercules-Karte              *)
  4. (*         (c) 1989  D.Nashed   &   TOOLBOX               *)
  5. (* ------------------------------------------------------ *)
  6. UNIT Pats;
  7.  
  8. INTERFACE
  9.  
  10. USES Graph;
  11.  
  12. VAR pat : ARRAY [0..64] OF FillPatternType;
  13.  
  14. IMPLEMENTATION
  15.  
  16. CONST  dm : ARRAY [0..7,0..7] OF BYTE =
  17.               (( 0,32, 8,40, 2,34,10,42),
  18.                (48,16,56,24,50,18,58,26),
  19.                (12,44, 4,36,14,46, 6,38),
  20.                (60,28,52,20,62,30,54,22),
  21.                ( 3,35,11,43, 1,33, 9,41),
  22.                (51,19,59,27,49,17,57,25),
  23.                (15,47, 7,39,13,45, 5,37),
  24.                (63,31,55,23,61,29,53,21));
  25. VAR    t  : WORD;
  26.  
  27. PROCEDURE Pattern(farbe : WORD);
  28. VAR x, y : WORD;
  29.  
  30.   FUNCTION hoch_2(x : WORD) : LONGINT;
  31.   VAR h : LONGINT;
  32.   BEGIN
  33.     h := 1;
  34.     WHILE x > 0 DO BEGIN
  35.       h := h*2;  x := x-1;
  36.     END;
  37.     hoch_2 := h;
  38.   END;
  39.  
  40. BEGIN
  41.   FOR y := 0 TO 7 DO BEGIN
  42.     pat [farbe, y + 1] := 0;
  43.     FOR x := 0 TO 7 DO
  44.       IF farbe > dm [x, y] THEN
  45.         pat [farbe, y+1] := pat [farbe, y+1] OR hoch_2(x);
  46.   END;
  47. END;
  48.  
  49. BEGIN
  50.   FOR t := 0 TO 64 DO Pattern(t);
  51. END.
  52. (* ------------------------------------------------------ *)
  53. (*                  Ende von PATS.PAS                     *)
  54.