home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 02 / hardcopy.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1979-12-31  |  4.1 KB  |  121 lines
  1. { Diese Grafik-Hardcopy-Routine basiert auf Turbo-Pascal mit Grafik-Tool und
  2.   ersetzt HARDCOPY in KERNEL1.SYS. Sie ist fuer die Kombination CPC 6128/
  3.   Riteman F+ angepasst, kippt das Monitorbild um 90 Grad, rueckt es in die
  4.   Mitte einer DIN A4-Seite und beruecksichtigt den Mangel des CPC 6128,
  5.   nur 7 Datenbits an den Drucker zu schicken (aus 8 Bits werden 2 mal
  6.   4 Bits).
  7.  
  8.   Parameter 1 (inverse): true:    Der Ausdruck erfolgt invers
  9.                          false:   Der Ausdruck erfolgt normal
  10.   Parameter 2 (leer):    true:    Der Stauchung in Y-Richtung wird durch
  11.                                   ein Leerpixel ($0) entgegengewirkt
  12.                          false:   Das aktuelle Pixel wird zweimal gedruckt
  13.   Parameter 3 (mode):
  14.       Der Riteman F+ bietet 7 Modi:
  15.           0: einfache Dichte                  480 Punkte/Zoll
  16.           1: doppelte Dichte                  960      "
  17.           2: doppelte Dichte und
  18.              doppelte Geschwindigkeit         960      "
  19.           3: vierfache Dichte                1920      "
  20.           4: CRT Grafik                       640      "
  21.           5: Plotter Grafik                   576      "
  22.           6: CRT Grafik                       720      "
  23.       Von den 7 Moeglichkeiten kommt Modus 5 dem Monitorbild am naechsten.
  24.  
  25.   Musteraufrufe: HardCopy(false, false, 5) --> Doppeldruck
  26.                  HardCopy(false, true, 5)  --> Leerpixel                     }
  27.  
  28. PROCEDURE hardcopy (inverse, leer: BOOLEAN; mode: BYTE);
  29.  
  30. VAR i, j, top, x1: INTEGER;
  31.     PrintByte, FuellByte: BYTE;
  32.  
  33. {----------------------------------------------------------------------------}
  34. { folgende Variablen sowie die Prozedur 'System' und die Funktion 'PD' sind
  35.   n u r   notwendig, wenn keine Toolbox zur Verfuegung steht!                }
  36.  
  37. VAR systc: ARRAY[0..5] OF BYTE;
  38.     akku, h, l, d, e, b, c: BYTE;
  39.     hl: INTEGER ABSOLUTE l;
  40.     de: INTEGER ABSOLUTE e;
  41.     bc: INTEGER ABSOLUTE c;
  42.  
  43.  
  44.   PROCEDURE System (address: INTEGER);
  45.  
  46.   BEGIN
  47.     systc[0] := $cd;          systc[1] := $5a;          systc[2] := $fc;
  48.     systc[3] := Lo(address);  systc[4] := Hi(address);  systc[5] := $c9;
  49.     InLine($3a/akku/$ed/$4b/bc/$ed/$5b/de/$2a/hl/$cd/systc/
  50.            $32/akku/$ed/$43/bc/$ed/$53/de/$22/hl);
  51.   END;
  52.  
  53.  
  54.   FUNCTION PD (x, y: INTEGER): BOOLEAN;
  55.  
  56.   BEGIN
  57.     hl := (199-y) Shl 1;   de := x;
  58.     System($bbf0);
  59.     PD := akku <> 0;
  60.   END;
  61.  
  62. {----------------------------------------------------------------------------}
  63. {                die eigentliche Hardcopy-Routine:                           }
  64.  
  65.   PROCEDURE DoLine (top: INTEGER);
  66.  
  67.  
  68.     FUNCTION ConstructByte (j, i: INTEGER): BYTE;
  69.  
  70.     CONST Bits: ARRAY[0..3] OF BYTE = (8, 4, 2, 1);
  71.     VAR   CByte, k: BYTE;
  72.  
  73.     BEGIN
  74.       i := i Shl 2;  CByte := 0;
  75.       FOR k := 0 TO top DO
  76.         IF PD(i+k,j) THEN
  77.           CByte := CByte OR Bits[k];
  78.       ConstructByte := CByte;
  79.     END;
  80.  
  81.  
  82.   BEGIN { DoLine }
  83.     FOR j := 199 DOWNTO 0 DO
  84.     BEGIN
  85.       CASE j OF
  86.         199, 136, 73: Write(lst, #$1B#$2A, Chr(mode), #$7E#$00);
  87.                   10: Write(lst, #$1B#$2A, Chr(mode), #$16#$00);
  88.       END;
  89.       PrintByte := ConstructByte(j, i);
  90.       IF inverse THEN
  91.         BEGIN
  92.           PrintByte := NOT PrintByte;
  93.           PrintByte := PrintByte AND 15;          { linkes Halbbyte auf Null }
  94.           FuellByte := 15;
  95.         END
  96.       ELSE
  97.         FuellByte := 0;
  98.       IF leer THEN
  99.         Write(lst, Chr(PrintByte), Chr(FuellByte))
  100.       ELSE
  101.         Write(lst, Chr(PrintByte), Chr(PrintByte));
  102.     END;
  103.     Write(lst, #$1B#$4A, Chr(11), #$0D);
  104.   END;
  105.  
  106.  
  107. BEGIN { HardCopy }
  108.   Write(lst, #$1B#$43#$00, Chr(12));                { Seitenlaenge = 12 Zoll }
  109.   FOR x1 := 1 TO 11 DO
  110.     WriteLn(lst);
  111.   top := 3;
  112.   Write(lst, #$1B#$33, CHR(11));               { Einstellung auf 11/216 Zoll }
  113.   FOR i := 0 TO 159 DO
  114.   BEGIN
  115.     Write(lst, ' ':13);
  116.     DoLine(3);
  117.   END;
  118.   WriteLn(lst, #$1B#$32);                      { zurueckstellen auf 1/6 Zoll }
  119.   Write(lst, #$0C);                        { Vorschub auf die naechste Seite }
  120. END; { HardCopy }
  121.