home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 14 / grafik / graph2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-10  |  2.6 KB  |  88 lines
  1. (* ------------------------------------------------------ *)
  2. (*                       GRAPH2.PAS                       *)
  3. (*   Prozeduren zur Beschleunigung der Hercules-Grafik    *)
  4. (*                  unter Turbo Pascal 4.0                *)
  5. (*         (c) 1989 Christian Ramsauer  & TOOLBOX         *)
  6. (* ------------------------------------------------------ *)
  7. UNIT Graph2;
  8.  
  9. INTERFACE
  10.  
  11.       (* Die Beschleunigung der Grafikausgabe wird durch  *)
  12.       (* direktes Beschreiben des Bildschirmspeichers     *)
  13.       (* erreicht (MEM-ARRAY)                             *)
  14.  
  15. USES Graph;
  16.  
  17. PROCEDURE Seite(x : BYTE);
  18.      (* Auswahl der Bildschirmseite in der gezeichnet     *)
  19.      (* werden soll (x=0 für Seite 1, x=1 für Seite 2)    *)
  20.  
  21. PROCEDURE Cls(x : BYTE);
  22.      (* Löschen einer gesamten Bildschirmseite            *)
  23.  
  24. PROCEDURE Plot(x, y, c : INTEGER);
  25.      (* Zeichnen eines Punktes (Ersatz für PutPixel)      *)
  26.      (* x,y: Koordinaten des Punktes, c: Zeichenfarbe     *)
  27.  
  28. PROCEDURE Waagerecht(y, x1, x2 : INTEGER);
  29.     (* Zeichnen einer waagerechten Linie                  *)
  30.     (* y: y-Koordinate, x1, x2: x-Koordinaten             *)
  31.  
  32. PROCEDURE Rechteck(x1, y1, x2, y2 : INTEGER);
  33.      (* Zeichnen eines Rechtecks (Ersatz für Rectangle)   *)
  34.      (* x1, x2: x-Koordinaten, y1, y2: y-Koordinaten      *)
  35.  
  36. IMPLEMENTATION
  37.  
  38. CONST HSeg : word = $B000;
  39.  
  40. PROCEDURE Seite(x : BYTE);
  41. BEGIN
  42.   IF x = 0 THEN HSeg := $B000 ELSE HSeg := $B800;
  43.   IF x = 0 THEN SetActivePage(0) ELSE SetActivePage(1);
  44. END;
  45.  
  46. PROCEDURE Cls(x : BYTE);
  47. VAR  a : BYTE ABSOLUTE $B000:0;
  48.      b : BYTE ABSOLUTE $B800:0;
  49. BEGIN
  50.   IF x = 0 THEN FillChar(a, 32768, 0)
  51.            ELSE FillChar(b, 32768, 0);
  52. END;
  53.  
  54. PROCEDURE Plot(x, y, c : INTEGER);
  55. VAR   ho, bx : INTEGER;
  56. CONST bit : ARRAY[1..8] OF BYTE=(1,2,4,8,16,32,64,128);
  57. BEGIN
  58.   ho := ((y AND 3) SHL 13) + (90*(y SHR 2)) + (x SHR 3);
  59.   bx := 8 - (x MOD 8);
  60.   IF c = 0 THEN
  61.     Mem[HSeg:ho] := Mem[HSeg:ho] AND (bit[bx] XOR $FF)
  62.   ELSE
  63.     Mem[HSeg:ho] := Mem[HSeg:ho] OR bit[bx];
  64. END;
  65.  
  66. PROCEDURE Waagerecht(y, x1, x2 : INTEGER);
  67. VAR c, i, xs, xe : INTEGER;
  68. BEGIN
  69.   c  := GetColor;
  70.   xs := x1 SHR 3;
  71.   xe := x2 SHR 3;
  72.   FOR i := x1 TO (xs SHL 3) + 7 DO Plot(i, y, c);
  73.   FOR i := xs + 1 TO xe - 1 DO
  74.     Mem[HSeg:((y AND 3) SHL 13) + 90*(y SHR 2)+i] := $FF*c;
  75.   FOR i := xe SHL 3 TO x2 DO Plot(i, y, c);
  76. END;
  77.  
  78. PROCEDURE Rechteck(x1, y1, x2, y2 : INTEGER);
  79. BEGIN
  80.   Line(x1, y1, x1, y2);
  81.   Waagerecht(y2, x1, x2);
  82.   Line(x2, y2, x2, y1);
  83.   Waagerecht(y1, x1, x2);
  84. END;
  85.  
  86. END.
  87. (* ------------------------------------------------------ *)
  88.