home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 10 / hercules.inc < prev    next >
Encoding:
Text File  |  1987-07-30  |  17.7 KB  |  467 lines
  1. (*--------------------------------------------------------------*)
  2. (*                      HERCULES.INC                            *)
  3. (*  Bibliothek, um unter Turbo Pascal mit der Hercules-Karte    *)
  4. (*             Grafiken programmieren zu koennen.               *)
  5. (*--------------------------------------------------------------*)
  6. (*   Konstanten, Typen und Variablen fuer die Hercules--Karte   *)
  7. TYPE HercStr = STRING[255];
  8.  
  9. CONST Segm:       ARRAY[0..1] OF INTEGER = ($B800, $B000);
  10.       BitPos:     ARRAY[1..8] OF BYTE = (1, 2, 4, 8,
  11.                                          16, 32, 64, 128);
  12.       BildGr = $7FFF;  (* Bildgröße 32767 Bytes *)
  13.       HercPage : INTEGER = 0; (* Gerade aktive Bildschirmseite *)
  14.       HercSeg : INTEGER = $B800; (* Segment d. Bildschirmseite *)
  15.       HercXOr : BOOLEAN = FALSE; (* Flag fuer XOr-Modus *)
  16.  
  17. VAR Bild:       ARRAY[0..BildGr] OF BYTE ABSOLUTE $B800:$00;
  18.     BildPuffer: ARRAY[0..BildGr] OF BYTE ABSOLUTE $B000:$00;
  19.  
  20. (*------------------------------------------------------------*)
  21. (*       Hochaufloesenden Grafik-Modus einschalten            *)
  22. PROCEDURE  HiRes;
  23.  
  24. CONST IndexReg = $03B4;    (* I    6845 Index Register        *)
  25.       DataReg  = $03B5;    (* I/O  6845 Data  Register        *)
  26.       ModeCont = $03B8;    (* O    Display Mode Control Port  *)
  27.       ConfigSw = $03BF;    (* O    Configuration Switch       *)
  28.       TextVal: ARRAY[0..11] OF BYTE = ($61, $50, $52, $0F, $19,
  29.                                        $06, $19, $19, $02, $0D,
  30.                                        $0B, $0C);
  31.       GrphVal: ARRAY[0..11] OF BYTE = ($35, $2D, $2E, $07, $5B,
  32.                                        $02, $57, $57, $02, $03,
  33.                                        $00, $00);
  34.  
  35. VAR on, graph, RegSel:    INTEGER;
  36.  
  37. BEGIN
  38.   graph:= $82;   on:= graph + $8; Port[ModeCont]:= graph;
  39.   FOR RegSel:=0 TO 11 DO BEGIN
  40.     Port[IndexReg]:= RegSel;  Port[DataReg]:= GrphVal[RegSel];
  41.   END;
  42.   Port[ConfigSw]:= 3;        (* Full Mode *)
  43.   Port[ModeCont]:= on;       (* Einschalten *)
  44. END;  (* Hires *)
  45. (*------------------------------------------------------------*)
  46. (*                Zurueck in den Textmodus                    *)
  47. PROCEDURE  TextMode;
  48.  
  49. CONST IndexReg = $03B4;    (* I    6845 Index Register        *)
  50.       DataReg  = $03B5;    (* I/O  6845 Data  Register        *)
  51.       ModeCont = $03B8;    (* O    Display Mode Control Port  *)
  52.       ConfigSw = $03BF;    (* O    Configuration Switch       *)
  53.       TextVal: ARRAY[0..11] OF BYTE = ($61, $50, $52, $0F, $19,
  54.                                        $06, $19, $19, $02, $0D,
  55.                                        $0B, $0C);
  56.       GrphVal: ARRAY[0..11] OF BYTE = ($35, $2D, $2E, $07, $5B,
  57.                                        $02, $57, $57, $02, $03,
  58.                                        $00, $00);
  59.  
  60. VAR on, txt, RegSel:    INTEGER;
  61.  
  62. BEGIN
  63.   txt := $20;   on:= txt + $8;  Port[ModeCont]:= txt;
  64.   FOR RegSel:=0 TO 11 DO BEGIN
  65.     Port[IndexReg]:= RegSel;  Port[DataReg]:= TextVal[RegSel];
  66.   END;
  67.   Port[ConfigSw]:= 1;        (* Diag Mode *)
  68.   Port[ModeCont]:= on;       (* Einschalten *)
  69. END;  (* TextMode *)
  70. (*------------------------------------------------------------*)
  71. (*              XOr-Modus Ein-/Ausschalten                    *)
  72. PROCEDURE HercXOrMode(flag : BOOLEAN);
  73.  
  74. BEGIN
  75.   HercXOr := flag;
  76. END;
  77. (*------------------------------------------------------------*)
  78. (*           Aktive Bildschirmseite waehlen                   *)
  79. PROCEDURE SelectPage(Page : INTEGER);
  80. BEGIN
  81.   HercPage := Page MOD 2;
  82.   HercSeg := Segm[HercPage];
  83. END;
  84. (*------------------------------------------------------------*)
  85. (*         Gerade aktive Bildschirmseite loeschen             *)
  86. PROCEDURE ClrScr;
  87. BEGIN
  88.   IF Odd(HercPage) THEN FillChar(BildPuffer, BildGr, $00)
  89.   ELSE  FillChar(Bild, BildGr, $00);
  90. END;  (* ClrScr *)
  91. (*------------------------------------------------------------*)
  92. (*      Gerade aktive Bildschirmseite hell schalten           *)
  93. PROCEDURE LightScreen;
  94. BEGIN
  95.   IF Odd(HercPage)  THEN  FillChar(BildPuffer, BildGr, $FF)
  96.   ELSE  FillChar(Bild, BildGr, $FF);
  97. END;  (* LightScreen *)
  98. (*------------------------------------------------------------*)
  99. (*      Gerade aktive Bildschirmseite invertieren             *)
  100. PROCEDURE InvertScreen;
  101.  
  102. VAR  B : INTEGER;
  103.      Puffer: ARRAY[0..BildGr] OF BYTE;
  104.  
  105. BEGIN
  106.   IF Odd(HercPage)  THEN BEGIN
  107.     FOR B:= 0 TO BildGr DO  Puffer[B]:= NOT BildPuffer[B];
  108.     Move(Puffer, BildPuffer, BildGr);
  109.   END
  110.   ELSE BEGIN
  111.     FOR B:= 0 TO BildGr DO  Puffer[B]:= NOT Bild[B];
  112.     Move(Puffer, Bild, BildGr);
  113.   END;
  114. END;  (* InvertScreen *)
  115. (*------------------------------------------------------------*)
  116. (*  Bildschirmseite "Page" (0 oder 1) in die andere kopieren. *)
  117. PROCEDURE CopyPage (Page:  INTEGER);
  118. BEGIN
  119.   IF Odd(Page) THEN  Move(BildPuffer, Bild, BildGr)
  120.   ELSE  Move(Bild, BildPuffer, BildGr);
  121. END;  (* CopyPage *)
  122. (*------------------------------------------------------------*)
  123. (*      Einige Hilfsfunktionen fuer Berechnungenn             *)
  124. FUNCTION  ByteOffset(x, y: INTEGER):  INTEGER;
  125. BEGIN
  126.   ByteOffset:= $2000 * (y MOD 4) + 90*(y SHR 2) + (x SHR 3);
  127. END;
  128. (*------------------------------------------------------------*)
  129. FUNCTION  BitOffset(x: INTEGER):  INTEGER;
  130. BEGIN
  131.   BitOffset:= 8 - (x MOD 8);
  132. END;
  133. (*------------------------------------------------------------*)
  134. (* Pruefen ob Pixel auf dem Bildschirm gesetzt ist (1=ja)     *)
  135. FUNCTION GetDotColor(x,y:  INTEGER): INTEGER;
  136. BEGIN
  137.   GetDotColor := Ord(NOT(((Mem[Segm[Ord(Odd(HercPage))]
  138.                               :ByteOffset(x,y)]
  139.                            AND BitPos[BitOffset(x)])    = 0)));
  140. END;  (* GetDotColor *)
  141. (*------------------------------------------------------------*)
  142. (*                     Punkt setzen                           *)
  143. PROCEDURE  Plot(x, y : INTEGER; Farbe : INTEGER);
  144.  
  145. VAR Offs : INTEGER;
  146.  
  147. BEGIN
  148.  Offs:= ByteOffset(x,y);
  149.  IF HercXOr THEN
  150.    Mem[HercSeg:Offs]:= Mem[HercSeg:Offs] XOR BitPos[BitOffset(x)]
  151.  ELSE
  152.    IF Farbe = 1 THEN
  153.      Mem[HercSeg:Offs]:= (Mem[HercSeg:Offs] OR  BitPos[BitOffset(x)])
  154.    ELSE
  155.      Mem[HercSeg:Offs]:=
  156.        (Mem[HercSeg:Offs] AND (255-BitPos[BitOffset(x)]));
  157. END;  (* Plot *)
  158. (*------------------------------------------------------------*)
  159. (*    Ganzes Byte in den Bildschirmspeicher schreiben         *)
  160. PROCEDURE  ByteHerc (x, y :  INTEGER;  Farbe : INTEGER);
  161. BEGIN
  162.    IF Farbe = 1 THEN  Mem[HercSeg:ByteOffset(x,y)]:= $FF
  163.    ELSE  Mem[HercSeg:ByteOffset(x,y)]:= $00;
  164. END;  (* ByteHerc *)
  165. (*------------------------------------------------------------*)
  166. (*     Ein Zeichen an die Position x,y schreiben              *)
  167. PROCEDURE  WriteChar (ch :  CHAR;
  168.                       x, y :  INTEGER;  invers : BOOLEAN);
  169.  
  170. VAR  OrdChar, i:    INTEGER;
  171.      Zeichensatz:   ARRAY[0..127,0..7] OF BYTE ABSOLUTE $FFA6:$E;
  172.  
  173. BEGIN
  174.   x := (x-1)*8;
  175.   CASE ch OF  (* Umlaute abfangen *)
  176.     #0..#127:   OrdChar:= Ord(ch);
  177.     'ä':        OrdChar:= Ord('a');
  178.     'ö':        OrdChar:= Ord('o');
  179.     'ü':        OrdChar:= Ord('u');
  180.     'Ä':        OrdChar:= Ord('A');
  181.     'Ö':        OrdChar:= Ord('O');
  182.     'Ü':        OrdChar:= Ord('U');
  183.     ELSE        OrdChar:= 0;
  184.   END;  (*case ch *)
  185.   FOR i:=0 TO 7 DO
  186.     Mem[HercSeg:ByteOffset(x,y+i)]:= Zeichensatz[OrdChar,i];
  187.   (* Fuer Umlaute noch Puenktchen setzen ! *)
  188.   CASE ch OF
  189.    'ä','ö','ü':  Mem[HercSeg:ByteOffset(x,y)]:= $66;
  190.    'Ä','Ö':      BEGIN
  191.                    Mem[HercSeg:ByteOffset(x,y)]:= $66;
  192.                    Mem[HercSeg:ByteOffset(x,y+1)]:= $1C;
  193.                    Mem[HercSeg:ByteOffset(x,y+2)]:= $66;
  194.                  END;
  195.    'Ü':          Mem[HercSeg:ByteOffset(x,y+1)]:= $00;
  196.    'ß':          BEGIN
  197.                    Mem[HercSeg:ByteOffset(x,y+0)]:= $00;
  198.                    Mem[HercSeg:ByteOffset(x,y+1)]:= $7C;
  199.                    Mem[HercSeg:ByteOffset(x,y+2)]:= $C6;
  200.                    Mem[HercSeg:ByteOffset(x,y+3)]:= $FC;
  201.                    Mem[HercSeg:ByteOffset(x,y+4)]:= $C6;
  202.                    Mem[HercSeg:ByteOffset(x,y+5)]:= $FC;
  203.                    Mem[HercSeg:ByteOffset(x,y+6)]:= $C0;
  204.                    Mem[HercSeg:ByteOffset(x,y+7)]:= $40;
  205.                  END;
  206.   END;  (* case ch *)
  207.   IF invers THEN
  208.     FOR i:=0 TO 7 DO
  209.       Mem[HercSeg:ByteOffset(x,y+i)] :=
  210.         NOT Mem[HercSeg:ByteOffset(x,y+i)];
  211. END;  (* WriteChar *)
  212. (*------------------------------------------------------------*)
  213. (*     Ein Zeichen von Position x,y lesen                     *)
  214. FUNCTION GetScreenChar (x, y:  INTEGER) : CHAR;
  215.  
  216. VAR  i, C:             INTEGER;
  217.      NumFind, invers,
  218.      endwhile        :  BOOLEAN;
  219.      Zeichen         : ARRAY[0..7] OF BYTE;
  220.      Zeichensatz     : ARRAY[0..127,0..7] OF BYTE ABSOLUTE $FFA6:$E;
  221.  
  222. LABEL  Inv;
  223.  
  224. BEGIN
  225.   x:= (x-1)*8;
  226.   invers:= FALSE;  endwhile := FALSE;
  227.   FOR i:=0 TO 7 DO  Zeichen[i] := Mem[HercSeg:ByteOffset(x,y+i)];
  228.   WHILE (NOT NumFind) AND (NOT endwhile) DO BEGIN
  229.     C:= 0;  NumFind:= FALSE;
  230.     WHILE NOT NumFind AND (C < 128) DO BEGIN
  231.       i:= 0;
  232.       WHILE (Zeichen[i] <> Zeichensatz[C,i]) AND (C < 128) DO C := C+1;
  233.       IF C < 128 THEN
  234.       WHILE (Zeichen[i] = Zeichensatz[C,i]) AND (i < 8) DO i := i+1;
  235.       IF i = 8 THEN  NumFind:= TRUE
  236.       ELSE  C := C+1;
  237.     END;
  238.     IF NumFind THEN GetScreenChar := Chr(C)
  239.     ELSE BEGIN (* Zeichen vielleicht invers ?! *)
  240.       FOR i:=0 TO 7 DO  Zeichen[i]:= NOT Zeichen[i];
  241.       endwhile := TRUE;
  242.     END
  243.   END; (* WHILE *)
  244.     IF NOT(NumFind) THEN GetScreenChar := Chr(0);
  245. END;  (* GetScreenChar *)
  246. (*------------------------------------------------------------*)
  247. (*           Kompletten String schreiben                      *)
  248. PROCEDURE  WriteString(Str : HercStr;
  249.                        x, y:  INTEGER; invers:  BOOLEAN);
  250.  
  251. VAR  i :  INTEGER;
  252.  
  253. BEGIN
  254.   FOR i := 1 TO Length(Str) DO
  255.     WriteChar(Str[i], x+i-1, y, invers);
  256. END;  (* WriteString *)
  257. (*------------------------------------------------------------*)
  258. (*     Kompletten String (Laenge n) vom Screen lesen          *)
  259. PROCEDURE  ReadScreenStr(VAR  Str : HercStr; x, y, n:  INTEGER);
  260.  
  261. VAR i :  INTEGER;
  262.     ch:  CHAR;
  263.  
  264. BEGIN
  265.   Str := '';
  266.   FOR i := 1 TO n DO Str := Str + GetScreenChar(x+i-1, y);
  267. END;  (* ReadScreenStr *)
  268. (*------------------------------------------------------------*)
  269. (* Text gepackt (Byte-Reihe) in Bildschirmspeicher schreiben  *)
  270. PROCEDURE  WritePacked(Str :  HercStr;  x, y :  INTEGER);
  271.  
  272. VAR   Offs, L, i:  INTEGER;
  273.  
  274. BEGIN
  275.    x:= (x - 1) * 8;   Offs:= ByteOffset(x,y);
  276.    FOR i := 1 TO Length(Str) DO
  277.      Mem[HercSeg:Offs+i-1]:= Ord(Str[i]);
  278. END;  (* WritePacked *)
  279. (*------------------------------------------------------------*)
  280. (*        Gepackten Text (Laenge n) wieder auslesen           *)
  281. PROCEDURE ReadPacked(VAR  Str:  HercStr;  x, y, n:  INTEGER);
  282.  
  283. VAR   Offs, i :  INTEGER;
  284.       ch : CHAR;
  285.  
  286. BEGIN
  287.    x:= (x - 1) * 8; Offs := ByteOffset(x,y);  Str := '';
  288.    FOR i := 1 TO n DO BEGIN
  289.      ch := Chr(Mem[HercSeg:Offs+i-1]);
  290.      IF ch > #0 THEN  Str := Str + ch;
  291.    END;
  292. END;  (* ReadLine *)
  293. (*------------------------------------------------------------*)
  294. (*                   Linie zeichnen                           *)
  295. PROCEDURE  Draw(x1, y1, x2, y2, Farbe :  INTEGER);
  296.  
  297. VAR delta_x, delta_y,                    (* Differenzen Anfangs-..Endpunkt *)
  298.     Zaehler,                             (* Zaehler fuer die Punkte        *)
  299.     Abweichung,                          (* Abweichung von der Linie       *)
  300.     x, y, temp        : INTEGER;         (* Plot-Koordinaten, Swap-Var.    *)
  301.  
  302. BEGIN                                                   (* Initialisierung *)
  303.   Abweichung := 0;
  304.   delta_x := x2 - x1;
  305.   delta_y := y2 - y1;
  306.   IF delta_y < 0 THEN  (* Anfangs- und Endpunkte muessen vertauscht werden *)
  307.   BEGIN
  308.     temp := x1;  x1 := x2;  x2 := temp;
  309.     temp := y1;  y1 := y2;  y2 := temp;
  310.     delta_y := -delta_y;                    (* Die Steigungen wechseln     *)
  311.     delta_x := -delta_x;                    (* entsprechend das Vorzeichen *)
  312.   END;
  313.   Plot(x1, y1, Farbe);                      (* Ersten Punkt setzen *)
  314.   x := x1;                                       (* x und y initialisieren *)
  315.   y := y1;
  316.   IF delta_x >= 0 THEN               (* Steigung positiv ==> Fall 1 oder 2 *)
  317.     IF delta_x < delta_y THEN        (* Steigung > 1 ==> Fall 1            *)
  318.       FOR Zaehler := 1 TO Pred(delta_y) DO
  319.         IF Abweichung < 0 THEN
  320.           BEGIN
  321.             x := Succ(x);
  322.             y := Succ(y);
  323.             Plot(x, y, Farbe);
  324.             Abweichung := Abweichung + delta_y - delta_x;
  325.           END
  326.         ELSE
  327.           BEGIN                                         (* Abweichung >= 0 *)
  328.             y := Succ(y);
  329.             Plot(x, y, Farbe);
  330.             Abweichung := Abweichung - delta_x;
  331.           END
  332.     ELSE                                  (* 0 <= Steigung <= 1 ==> Fall 2 *)
  333.       FOR Zaehler := 1 TO Pred(delta_x) DO
  334.         IF Abweichung <= 0 THEN
  335.           BEGIN
  336.             x := Succ(x);
  337.             Plot(x, y, Farbe);
  338.             Abweichung := Abweichung + delta_y;
  339.           END
  340.         ELSE
  341.           BEGIN                                          (* Abweichung > 0 *)
  342.             x := Succ(x);
  343.             y := Succ(y);
  344.             Plot(x, y, Farbe);
  345.             Abweichung := Abweichung + delta_y - delta_x;
  346.           END
  347.   ELSE                                             (* ==> Steigung negativ *)
  348.     IF abs(delta_x) >= delta_y THEN       (* 0 > Steigung >= -1 ==> Fall 3 *)
  349.       FOR Zaehler := 1 TO Pred(abs(delta_x)) DO
  350.         IF Abweichung <= 0 THEN
  351.           BEGIN
  352.             x := Pred(x);
  353.             Plot(x, y, Farbe);
  354.             Abweichung := Abweichung + delta_y;
  355.           END
  356.         ELSE
  357.           BEGIN
  358.             x := Pred(x);
  359.             y := Succ(y);
  360.             Plot(x, y, Farbe);
  361.             Abweichung := Abweichung + delta_x + delta_y;
  362.           END
  363.   ELSE                                       (* Steigung < -1 ==> Fall 4 *)
  364.     FOR Zaehler := 1 TO Pred(delta_y) DO
  365.       IF Abweichung < 0 THEN
  366.         BEGIN
  367.           x := Pred(x);
  368.           y := Succ(y);
  369.           Plot(x, y, Farbe);
  370.           Abweichung := Abweichung + delta_x + delta_y;
  371.         END
  372.       ELSE
  373.         BEGIN
  374.           y := Succ(y);
  375.           Plot(x, y, Farbe);
  376.           Abweichung := Abweichung + delta_x;
  377.         END;
  378.   Plot(x2, y2, Farbe)                          (* letzten Punkt setzen *)
  379. END;  (* Draw *)
  380. (*------------------------------------------------------------*)
  381. (*                  Rechteck zeichnen                         *)
  382. PROCEDURE  Rechteck (x1, y1, x2, y2, Farbe :  INTEGER);
  383.  
  384. VAR  x, y:  INTEGER;
  385.  
  386. BEGIN
  387.    IF x1 > x2 THEN BEGIN  x:= x2;  x2:= x1;  x1:= x;  END;
  388.    IF y1 > y2 THEN BEGIN  y:= y2;  y2:= y1;  y1:= y;  END;
  389.    FOR x:= x1+1 TO x2-1 DO BEGIN
  390.      Plot(x, y1, Farbe); Plot(x, y2, Farbe);
  391.    END;
  392.    FOR y:= y1 TO y2 DO BEGIN
  393.      Plot(x1, y, Farbe); Plot(x2, y, Farbe);
  394.    END;
  395. END;  (* Rechteck *)
  396. (*------------------------------------------------------------*)
  397. (*                      Kreise Zeichnen                       *)
  398. PROCEDURE  Circle (x_center, y_center,
  399.                    radius, Farbe :  INTEGER);
  400. CONST  Aspect_Ratio = 0.75;    (* Entzerrungsfaktor *)
  401.        Pi = 3.1415926;
  402.  
  403. VAR zwei_r_quadrat,                   (* 2 mal radius hoch 2. INTEGER !!!! *)
  404.     x_ende,                           (* Endwert x-Koordinate Achtel-Kreis *)
  405.     AspRX,                            (* round(Aspect_Ratio*x)             *)
  406.     AspRY,                            (* round(Aspect_Ratio*y)             *)
  407.     x, y              : INTEGER;      (* Berechnete Koordinaten            *)
  408.  
  409. BEGIN                                        (* Koordinaten initialisieren *)
  410.   x := 0;
  411.   y := radius;
  412.   x_ende := Round(radius*Cos(Pi/4));     (* Endwert x-Koordinate berechnen *)
  413.   zwei_r_quadrat := 2*radius*radius;
  414.   REPEAT
  415.     AspRX := Round(Aspect_Ratio*x);
  416.     AspRY := Round(Aspect_Ratio*y);
  417.     Plot(x_center + x, y_center + AspRY, Farbe);
  418.     Plot(x_center - x, y_center + AspRY, Farbe);
  419.     Plot(x_center + x, y_center - AspRY, Farbe);
  420.     Plot(x_center - x, y_center - AspRY, Farbe);
  421.     Plot(x_center + y, y_center + AspRX, Farbe);
  422.     Plot(x_center - y, y_center + AspRX, Farbe);
  423.     Plot(x_center + y, y_center - AspRX, Farbe);
  424.     Plot(x_center - y, y_center - AspRX, Farbe);
  425.                                           (* Neue x- und y-Werte berechnen *)
  426.     IF (2*Succ(x)*Succ(x) + y*y + Pred(y)*Pred(y) - zwei_r_quadrat) > 0 THEN
  427.       BEGIN                            (* naechster Punkt rechts unterhalb *)
  428.         x := Succ(x);
  429.         y := Pred(y);
  430.       END
  431.     ELSE                                   (* naechster Punkt rechts davon *)
  432.       x := Succ(x);
  433.   UNTIL (x > x_ende);
  434. END; (* Draw *)
  435. (*------------------------------------------------------------*)
  436. (*  Bildschirm-Hardcopy auf den Drucker (Epson-kompatible)    *)
  437. PROCEDURE HardCopy (invers:  BOOLEAN);
  438.  
  439. CONST XRes = 720;  (* Spalten- & Zeilenauflösung *)
  440.       YRes = 348;
  441.  
  442. VAR   x, y:  INTEGER;
  443.       ch:  CHAR;
  444.       PortVal:  BYTE;
  445.  
  446. LABEL Exit;
  447.  
  448. BEGIN
  449.   Write(Lst, #27#108#12);       (* Linker Rand in Spalte 12 *)
  450.   FOR x:=0 TO (XRes-1) SHR 3 DO BEGIN
  451.     Write(Lst, #27#75#92#1);    (* BitImageMode 348 Images *)
  452.     FOR y:=YRes-1 DOWNTO 0 DO BEGIN
  453.       PortVal:= Mem[HercSeg:ByteOffset(x*8,y)];
  454.       IF invers THEN  PortVal:= NOT PortVal;
  455.       Write(Lst, Chr(PortVal));
  456.     END;  (* for y *)
  457.     WriteLn(Lst, #27#106#12);    (* 12/216" Zeilenabstand zurück *)
  458.     (* Abbruch des Drucks *)
  459.     IF KeyPressed THEN  Read(Kbd, ch);
  460. IF ch = #27 THEN GOTO Exit;  (* Sorry, ist am einfachsten *)
  461.   END;  (* for x *)
  462. Exit: Write(Lst, #27#64);   (* Drucker - Reset *)
  463. END;  (* HardCopy *)
  464.  
  465. (*****************************************************************)
  466. (*                    Ende HERCULES.INC                          *)
  467.