home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 05 / grafsys / plothpgl.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-02-27  |  3.8 KB  |  163 lines
  1. {************************************************}
  2. {*                PLOTHPGL.PAS                  *}
  3. {* Plottertreiber des Grafiksystems für den     *}
  4. {*               HPGL-fähige Plotter            *}
  5. {*          (C) 1989 S.Szkaradnik & TOOLBOX     *}
  6. {************************************************}
  7. (* Overlay *) (* Bei Speichermangel in Turbo 3.0*)
  8.               (* als Overlay deklarieren !      *)
  9.  
  10.  
  11. PROCEDURE PlotterDriver ( VAR Par : Parameters );
  12.  
  13. TYPE
  14.   Blocks = ARRAY [ 0..1023 ] OF BYTE ;
  15.   Buffer = RECORD
  16.              Upd : BOOLEAN ;
  17.              Ind : BYTE ;
  18.              Blk : Blocks ;
  19.            END ;
  20.  
  21. VAR
  22.   Buffers : ARRAY [ 0..1 ] OF Buffer ;
  23.   Prev : BYTE ;
  24.  
  25. FUNCTION Block ( N : BYTE ) : BYTE ;
  26. BEGIN
  27.   IF ( Buffers [0].Ind <> N )
  28.      AND ( Buffers [1].Ind <> N ) THEN BEGIN
  29.     WITH Buffers [ Prev ] DO BEGIN
  30.       IF Upd THEN BEGIN
  31.         Seek ( BitMap, Ind SHL 3 ) ;
  32.         BlockWrite ( BitMap, Blk, 8 ) ;
  33.       END ;
  34.       Upd := FALSE ; Ind := N ;
  35.       Seek ( BitMap, Ind SHL 3 ) ;
  36.       BlockRead ( BitMap, Blk, 8 ) ;
  37.     END ;
  38.     Block := Prev ;
  39.     IF Prev = 0 THEN Prev := 1 ELSE Prev := 0 ;
  40.   END
  41.   ELSE
  42.     IF Buffers [0].Ind = N THEN
  43.       Block := 0
  44.     ELSE
  45.       Block := 1 ;
  46. END ;
  47.  
  48. FUNCTION Open : BOOLEAN ;
  49. VAR I : INTEGER ;
  50. BEGIN
  51.   Assign ( BitMap, 'BITMAP.PIC' ) ;
  52.   Reset ( BitMap ) ;
  53.   IF IOResult = 0 THEN BEGIN
  54.     Write ( LST, 'IN;SP1' ) ; (* Init und Stift *)
  55.     Device := Plotter ;
  56.     Xmin := 0 ; Xmax := 8000 ;
  57.     Ymin := 0 ; Ymax := 6000 ;
  58.     Write ( LST, 'PA', 0, ',', 0);
  59.     Write ( LST, 'EA', Xmax, ',', Ymax);
  60.     FOR I := 0 TO 1 DO WITH Buffers [I] DO BEGIN
  61.       Upd := FALSE ;
  62.       Ind := 255
  63.     END ;
  64.     Prev := 0 ;
  65.     Open := TRUE ;
  66.   END
  67.   ELSE
  68.     Open := FALSE ;
  69. END ;
  70.  
  71. PROCEDURE Calculate ( X, Y : INTEGER ;
  72.                       VAR Bit : BYTE ;
  73.                       VAR Adr, Blk : INTEGER ) ;
  74. BEGIN
  75.   Bit := X AND 7 ;
  76.   Adr := X SHR 3 + Y AND 7 SHL 7 ;
  77.   Blk := Y SHR 3 ;
  78. END ;
  79.  
  80. FUNCTION Point ( X, Y : INTEGER ) : BOOLEAN ;
  81. VAR
  82.   Bit : BYTE ;
  83.   Adr, Bl : INTEGER ;
  84. BEGIN
  85.   IF ( X >= Xmin ) AND ( X <= Xmax )
  86.     AND ( Y >= Ymin ) AND ( Y <= Ymax ) THEN BEGIN
  87.     Calculate ( X, Y, Bit, Adr, Bl ) ;
  88.     IF Buffers [ Block ( Bl ) ].Blk [ Adr ]
  89.        AND Pat [ Bit ] <> 0 THEN
  90.       Point := TRUE
  91.     ELSE
  92.       Point := FALSE ;
  93.   END
  94.   ELSE Fence ;
  95. END ;
  96.  
  97. VAR
  98.   Xprev, Yprev : INTEGER ;
  99.  
  100. FUNCTION Near ( X, Y : INTEGER ) : BOOLEAN ;
  101. BEGIN
  102.   IF ( Abs ( X - Xprev ) < 2 )
  103.     AND ( Abs ( Y - Yprev ) < 2 ) THEN
  104.     Near := TRUE
  105.   ELSE
  106.     Near := FALSE
  107. END ;
  108.  
  109. PROCEDURE Dot ( X, Y : INTEGER ) ;
  110. VAR
  111.   Bit : BYTE ;
  112.   Adr, Bl, I : INTEGER ;
  113. BEGIN
  114.   Control ( X, Y ) ;
  115.   Calculate ( X, Y, Bit, Adr, Bl ) ;
  116.   WITH Buffers [ Block ( Bl ) ] DO
  117.     IF Tool = Pen THEN BEGIN
  118.       Blk [ Adr ] := Blk [ Adr ] OR Pat [ Bit ] ;
  119.       Upd := TRUE ;
  120.     END ;
  121.   IF Near ( X, Y ) AND ((X DIV 2) = 0) THEN
  122.     WriteLn( LST, 'PA', X*8, ',', Y*10)
  123.   ELSE BEGIN
  124.     WriteLn( LST, 'PA', (X + 1) * 8, ',', Y*10);
  125.     WriteLn( LST, 'PA', X*8, ',', Y*10);
  126.   END ;
  127.   Xprev := X ;
  128.   Yprev := Y ;
  129. END ;
  130.  
  131. PROCEDURE Plot ( X, Y : INTEGER ) ;
  132. BEGIN
  133.   Control ( X, Y ) ;
  134.   WriteLn( LST, 'PU', X*8, ',', Y*10);
  135.   WriteLn( LST, 'PD');
  136.   Position.X := X ; Position.Y := Y ;
  137. END ;
  138.  
  139. PROCEDURE Clear ;
  140. VAR
  141.   I : INTEGER ;
  142.   Bl : Blocks ;
  143. BEGIN
  144.   FOR I := 0 TO 1023 DO Bl [I] := 0 ;
  145.   Reset ( BitMap ) ;
  146.   FOR I := 0 TO 89 DO BEGIN
  147.      Seek ( BitMap, I SHL 3 ) ;
  148.     BlockWrite ( BitMap, Bl, 8 ) ;
  149.   END ;
  150. END ;
  151.  
  152. BEGIN
  153.   WITH Par DO
  154.     CASE Command OF
  155.       OpenF  : Result := Open ;
  156.       PointF : Result := Point ( X, Y ) ;
  157.       DotF   : Dot ( X, Y ) ;
  158.       PlotF  : Plot ( X, Y ) ;
  159.       ClearF : Clear ;
  160.       CloseF : Close ( BitMap ) ;
  161.     END ;
  162. END ;
  163.