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