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