(*************************************************************************) 
(*                                            Stand   : 03. 1.89         *) 
(*   Module-Datei für 24-Nadel-Drucker        Version : 0.9              *) 
(*                                            Autor   : hjh              *) 
(*************************************************************************) 
 
$begin$ 
PACKET printer driver 
 
       DEFINES printer,
               open,
               close,
               execute,
               paper size,
               std quality,

$headnecp6$    paper feed:
(* Treiber fuer NEC P6, automatisch generiert *)
LET underline linetype = 1; 
INT VAR factor 1, factor 2, draft factor 1, draft factor 2;

$headnecp5p7$  paper feed:
(* Treiber fuer NEC P5, P7 , automatisch generiert *)
LET underline linetype = 1; 
INT VAR factor 1, factor 2, draft factor 1, draft factor 2;

$headnecp6+$   std speed, 
               top margin, 
               paper feed, 
               std typeface:
(* Treiber für NEC P6 plus/P7 plus ,automatisch generiert *) 
 

$headlq850$    std speed, 
               top margin, 
               paper feed, 
               std typeface:
(* Treiber für EPSON LQ-850/1050 ,automatisch generiert *) 
 
$headbrotherm1724l$ 
               std speed, 
               top margin, 
               paper feed: 
INT VAR vertical factor := 1; 
(* Treiber für BROTHER M-1724L in IBM-Emulation, automatisch generiert *) 
 
$headoki390/391$ 
               std speed, 
               top margin, 
               paper feed, 
               std typeface:
INT VAR vertical factor := 1; 
(* Treiber für OKI MIKROLINE 390/391  ,automatisch generiert *) 
 
$headoki393/393Ceps$ 
               std speed, 
               top margin, 
               paper feed, 
               std typeface:
INT VAR vertical factor := 1; 
(* Treiber für OKI MIKROLINE 393/393C EPSON-kompatibel, automatisch generiert *) 
 
$headoki393/393Cibm$ 
               std speed, 
               top margin, 
               paper feed, 
               std typeface:
INT VAR vertical factor := 1; 
(* Treiber für OKI MIKROLINE 393/393C IBM-kompatibel, automatisch generiert *) 
 
$headtoshp321$   std speed, 
                 paper feed: 
(* Treiber für TOSHIBA P321, automatisch generiert *) 
 
$headstarnb24$ 
               std speed, 
               top margin, 
               paper feed, 
               std typeface:
(* Treiber für STAR NB 24-10/15 in Standard Betriebsart automatisch generiert *) 
 
$declarations$
INT VAR font nr, font bits, modification bits, 
        blankbreite, x rest, high, low, steps;
REAL VAR x size, y size;
TEXT VAR buffer :: "";
BOOL VAR is nlq ;
TEXT VAR font text :: "";
TEXT VAR std quality name :: "draft";
 
. is pica  : font bits = 0
. is elite : font bits = 1
.;

 
PROC paper size (REAL CONST x, y) :
 
  x size := x;
  y size := y;
END PROC paper size;
 
papersize (20.32, 30.48); 
 
PROC paper size : 
 
  line;
  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");
  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");
END PROC paper size;
 
 
 
PROC std quality (TEXT CONST quality) :
 
  IF quality = "nlq" OR quality = "draft"
     THEN std quality name := quality
     ELSE errorstop ("unzulässige Qualitätsbezeichnung")
  FI
END PROC std quality;
 
TEXT PROC std quality : 
 
  std quality name 
END PROC std quality;
                        
 
$topmargin$ 
REAL VAR  y margin := 0.0 ;
 
PROC top margin (REAL CONST margin): 
 
  y margin := margin 
END PROC top margin; 
 
REAL PROC top margin: 
 
  y margin 
END PROC top margin;
 
 
$speed$
BOOL VAR is slow :: TRUE; 
TEXT VAR std speed name :: "slow";
 
PROC std speed (TEXT CONST speed) :
 
  IF speed = "fast" OR speed = "slow"
     THEN std speed name := speed
     ELSE errorstop ("unzulässige Geschwindigkeit")
  FI
END PROC std speed;
 
TEXT PROC std speed : 
 
std speed name 
END PROC std speed;
 
 
$typefacelq850$ 
TEXT VAR act typeface name :: "";
TEXT VAR std typeface name :: "";
 
. is roman: 
  act typeface name = "roman". 
. is sansserif: 
  act typeface name = "sansserif"
.; 
 
PROC std typeface (TEXT CONST typeface) :
 
  IF typeface = "" OR typeface = "roman" OR typeface = "sansserif"
     THEN std typeface name := typeface
     ELSE errorstop ("unzulässige Schriftart")
  FI
END PROC std typeface;
 
TEXT PROC std typeface : 
 
  std typeface name 
END PROC std typeface;
 
 
 
$typefacep6+$ 
BOOL VAR is courier :: TRUE; 
TEXT VAR std typeface name :: "courier";
 
PROC std typeface (TEXT CONST typeface) :
 
  IF typeface = "courier" OR typeface = "souvenir" 
     THEN std typeface name := typeface
     ELSE errorstop ("unzulässige Schriftart")
  FI
END PROC std typeface;
 
TEXT PROC std typeface : 
 
  std typeface name 
END PROC std typeface;
 
$typefaceoki$ 
BOOL VAR is courier ; 
TEXT VAR std typeface name :: "";
 
PROC std typeface (TEXT CONST typeface) :
 
  IF typeface = "" OR typeface = "courier" OR typeface = "kassette" 
     THEN std typeface name := typeface
     ELSE errorstop ("unzulässige Schriftart")
  FI
END PROC std typeface;
 
TEXT PROC std typeface : 
 
  std typeface name 
END PROC std typeface;
 
$typefacestar$ 
BOOL VAR is roman ; 
TEXT VAR std typeface name :: "";
 
PROC std typeface (TEXT CONST typeface) :
 
  IF typeface = "" OR typeface = "roman" OR typeface = "font1" 
     THEN std typeface name := typeface
     ELSE errorstop ("unzulässige Schriftart")
  FI
END PROC std typeface;
 
TEXT PROC std typeface : 
 
  std typeface name 
END PROC std typeface;
 
$feed$ 
BOOL VAR is sheet feed :: FALSE;
 
PROC paper feed (TEXT CONST feeder) :
 
  IF feeder = "sheet"
    THEN is sheet feed := TRUE 
  ELIF feeder = "tractor" 
    THEN is sheet feed := FALSE 
    ELSE errorstop ("unzulässige Einzugsart")
  FI
END PROC paper feed;
 
TEXT PROC paper feed: 
  IF is sheet feed
    THEN "sheet" 
    ELSE "tractor" 
  FI 
END PROC paper feed;
 
$feedschacht$
BOOL VAR is sheet feed :: FALSE;
TEXT VAR feeder name :: "tractor";
 
PROC paper feed (TEXT CONST feeder) :
 
  IF feeder = "tractor" 
     THEN feeder name := "tractor"; 
          is sheet feed := FALSE
  ELIF feeder = "sheet" OR feeder = "schacht1" 
     THEN feeder name := "schacht1" ; 
          is sheet feed := TRUE
  ELIF feeder = "schacht2" 
     THEN feeder name := "schacht2" ; 
          is sheet feed := TRUE 
     ELSE errorstop ("unzulässige Einzugsart")
  FI
END PROC paper feed;
 
TEXT PROC paper feed: feeder name END PROC paper feed;
 
$open$
PROC open (INT CONST op code, INT VAR param1, param2):
 
  SELECT op code OF
    CASE 1: open document(param1,param2)
    CASE 2: open page    (param1,param2)
  END SELECT. 
END PROC open ; 
 
 
$opendoch$
PROC open document (INT VAR x steps,y steps): 
    modification bits := 0; 
    x steps := x step conversion ( x size );
    y steps := y step conversion ( y size );
    y steps := (y steps DIV 30) * 30;
 
$opendochtosh$
PROC open document (INT VAR x steps,y steps): 
    modification bits := 0; 
    x steps := x step conversion ( x size );
    y steps := y step conversion ( y size );
    y steps := (y steps DIV 36) * 36;
 
$initspeed$ 
    IF pos (material, "slow") <> 0 
         THEN is slow := TRUE;
    ELIF pos (material, "fast") <> 0 
         THEN is slow := FALSE;
         ELSE is slow := std speed name = "slow"
    FI;
 
$opendocp6+$ 
    out (""24""27""64"");                  (* Reset des Druckers *) 
    out (""27"t"1""27"6"27"R"0"");         (* Zeichentabelle 4 (Grafik) *) 
    out (""27"O"); 
    out (""27"2" + ""27"C" + code (y steps DIV 30));   (* Formularlaenge   *) 
    out (""27"x"0"");                                  (* Entwurfsqualität *) 
    IF is sheet feed
       THEN out (""27""25"4");             (* Sheetmode ein             *)
    FI;
    IF   pos (material, "nlq") <> 0 
         THEN is nlq := TRUE;
    ELIF pos (material, "draft") <> 0 
         THEN is nlq := FALSE;
         ELSE is nlq := std quality = "nlq"
    FI;
    IF pos (material, "courier") <> 0 
      THEN is courier := TRUE ; 
    ELIF pos (material, "souvenir") <> 0 
      THEN is courier := FALSE ; 
      ELSE is courier := std typeface name = "courier" 
    FI; 
END PROC open document ;
 
$opendocp5p7$ 
    out (""24""27""64"");                  (* Reset des Druckers         *)
    out (""27"R"0"");                      (* Amerikanischer Zeichensatz *)
    out (""27"C" + code (y steps DIV 30)); (* Formularlaenge             *)
    out (""27"x"0"");                      (* Entwurfsqualität           *) 
    IF   pos (material, "nlq") <> 0 
         THEN is nlq := TRUE;
    ELIF pos (material, "draft") <> 0 
         THEN is nlq := FALSE;
         ELSE is nlq := std quality = "nlq"
    FI;
    IF is sheet feed
       THEN out (""27""25"4");             (* Sheetmode ein             *)
            center paper ;
    FI;
 
    . center paper :
        INT CONST x steps in chars := x steps DIV x step conversion (2.54 / 10.0),
                  left margin      := (136 - x steps in chars) DIV 2;
        out (""27"P");
        out (""27"l"); out (code (left margin + 1));
END PROC open document ;

$opendocp6$ 
    out (""24""27""64"");                  (* Reset des Druckers         *)
    out (""27"R"0"");                      (* Amerikanischer Zeichensatz *)
    out (""27"C" + code (y steps DIV 30)); (* Formularlaenge             *)
    out (""27"x"0"");                      (* Entwurfsqualität           *) 
    IF   pos (material, "nlq") <> 0 
         THEN is nlq := TRUE;
    ELIF pos (material, "draft") <> 0 
         THEN is nlq := FALSE;
         ELSE is nlq := std quality = "nlq"
    FI;
    IF is sheet feed
       THEN out (""27""25"4");             (* Sheetmode ein              *)
    FI;
END PROC open document ;

$opendoclq850$ 
    out (""24""27""64"");                  (* Reset des Druckers *) 
    out (""27"t"1""27"6"27"R"0"");         (* Zeichentabelle 4 (Grafik) *) 
    out (""27"O"); 
    out (""27"2" + ""27"C" + code (y steps DIV 30));   (* Formularlaenge   *) 
    out (""27"x"0"");                                  (* Entwurfsqualität *) 
    IF is sheet feed
         THEN out (""27""25"4");                       (* Sheetmode ein    *)
    FI;
    IF   pos (material, "nlq") <> 0 
         THEN is nlq := TRUE;
    ELIF pos (material, "draft") <> 0 
         THEN is nlq := FALSE;
         ELSE is nlq := std quality = "nlq"
    FI;
    IF pos (material, "roman") <> 0 
      THEN act typeface name := "roman" 
    ELIF pos (material, "sansserif") <> 0 
      THEN act typeface name := "sansserif" 
      ELSE act typeface name := std typeface name  
    FI; 
END PROC open document ; 
 
$opendocokieps$ 
    out (""24""27""64"");                  (* Reset des Druckers *) 
    out (""27"t"1""27"6"27"R"0"");         (* Zeichentabelle 4 (Grafik) *) 
    out (""27"O"); 
    out (""27"2" + ""27"C" + code (y steps DIV 30));   (* Formularlaenge   *) 
    out (""27"x"0"");                                  (* Entwurfsqualität *) 
    IF is sheet feed
         THEN IF feeder name = "schacht2"
                 THEN out (""27""25"2")  
                 ELSE out (""27""25"1")
              FI 
    FI;                                                (* Sheetmode ein    *) 
    IF   pos (material, "nlq") <> 0 
         THEN is nlq := TRUE;
    ELIF pos (material, "draft") <> 0 
         THEN is nlq := FALSE;
         ELSE is nlq := std quality = "nlq"
    FI;
    IF pos (material, "courier") <> 0 
      THEN is courier := TRUE ; 
    ELIF pos (material, "kassette") <> 0 
      THEN is courier := FALSE ; 
      ELSE is courier := std typeface name = "courier" 
    FI; 
END PROC open document ; 
 
$opendoctosh$ 
    out (""24""27"5"0""27"4"27"O");             (* Reset des Druckers *) 
    out (""27"6");                              (* Zeichensatz *) 
    out (""27"A"12""27"2") ;
    out (""27"C" + code (y steps DIV 36));      (* Formularlaenge   *) 
    out (""27"x"0"");                                  (* Entwurfsqualität *) 
    IF   pos (material, "nlq") <> 0 
         THEN is nlq := TRUE;
    ELIF pos (material, "draft") <> 0 
         THEN is nlq := FALSE;
         ELSE is nlq := std quality = "nlq"
    FI;
END PROC open document ; 
 
$opendocbrother$ 
    out (""24""27"5"0""27"4"27"O");             (* Reset des Druckers *) 
    out (""27"6" + ""27"R"0"");                (* Zeichensatz II ascii *) 
    out (""27"A"10""27"2") ;                    (* Zeilenabstand *)
    out (""27"C" + code (y steps DIV 36));      (* Formularlaenge   *) 
    IF is sheet feed
       THEN out (""27""25"4")  
    FI;                                                (* Sheetmode ein    *) 
    IF   pos (material, "nlq") <> 0 
         THEN is nlq := TRUE;
    ELIF pos (material, "draft") <> 0 
         THEN is nlq := FALSE;
         ELSE is nlq := std quality = "nlq"
    FI;
END PROC open document ; 
 
$opendocokiibm$ 
    out (""24""27"5"0""27"4"27"O");             (* Reset des Druckers *) 
    out (""27"6" + ""27"!"64"");                (* Zeichensatz II ascii *) 
    out (""27""91""92""4""0""0""0""180"");      (* 1/180 *)
    out (""27"A"12""27"2") ;                    (* Zeilenabstand *)
    out (""27"C" + code (y steps DIV 36));      (* Formularlaenge   *) 
    IF is sheet feed
         THEN IF feeder name = "schacht2"
                 THEN out (""27""25"2")  
                 ELSE out (""27""25"1")
              FI 
    FI;                                                (* Sheetmode ein    *) 
    IF   pos (material, "nlq") <> 0 
         THEN is nlq := TRUE;
    ELIF pos (material, "draft") <> 0 
         THEN is nlq := FALSE;
         ELSE is nlq := std quality = "nlq"
    FI;
    IF pos (material, "courier") <> 0 
      THEN is courier := TRUE ; 
    ELIF pos (material, "kassette") <> 0 
      THEN is courier := FALSE ; 
      ELSE is courier := std typeface name = "courier" 
    FI; 
END PROC open document ; 
 
$opendocstar$ 
    out (""24""27""64"");                  (* Reset des Druckers *) 
    out (""27"R"0"");                  (* amerikanischer Zeichensatz *) 
    out (""27"O"); 
    out (""27"2" + ""27"C" + code (y steps DIV 30));   (* Formularlaenge   *) 
    out (""27"x"0"");                                  (* Entwurfsqualität *) 
    IF is sheet feed
         THEN IF feeder name = "schacht2"
                 THEN out (""27""25"2")  
                 ELSE out (""27""25"1")
              FI 
    FI;                                                (* Sheetmode ein    *) 
    IF   pos (material, "nlq") <> 0 
         THEN is nlq := TRUE;
    ELIF pos (material, "draft") <> 0 
         THEN is nlq := FALSE;
         ELSE is nlq := std quality = "nlq"
    FI;
    IF pos (material, "roman") <> 0 
      THEN is roman := TRUE ; 
    ELIF pos (material, "font1") <> 0 
      THEN is roman := FALSE ; 
      ELSE is roman := std typeface name = "roman" 
    FI; 
END PROC open document ; 
 
$openpagetosh$ 
PROC open page (INT VAR x start , y start): 
 
    x start := 0;
    IF is sheet feed
       THEN y start := y step conversion (2.54)    (* 1 Inch *)
       ELSE y start := 0;
    FI;
    x rest  := 0;
    out (""13"");
END PROC open page; 
 
$openpage$ 
PROC open page (INT VAR x start , y start): 
 
    x start := 0 ; 
    y start := y step conversion (y margin) ; 
    x rest := 0; 
    out (""13""). 
END PROC open page; 
 
$openpagep5-7$ 
PROC open page (INT VAR x start , y start): 
 
    x start := 0;
    IF is sheet feed
       THEN y start := y step conversion (8.466667e-1)    (* 2/6 Inch *)
       ELSE y start := 0;
    FI;
    x rest  := 0;
    out (""13"");
END PROC open page; 
 
$close$
 
PROC close (INT CONST op code, INT CONST param1) :
 
  SELECT op code OF
    CASE 1: close document 
    CASE 2: close page (param1)
  END SELECT.
 
close document : 
. 
END PROC close ; 
 
$closepage$ 
PROC close page (INT CONST remaining y steps) : 
    IF remaining y steps > 0
       THEN out (""12"")
    ELIF is sheet feed
       THEN out (""27""25"R")
    FI;
END PROC close page;

$closepagetosh$ 
PROC close page (INT CONST remaining y steps) : 
    IF   is sheet feed
         THEN out (""12"")
    ELIF remaining y steps > 0
         THEN out (""12"")
    FI;
END PROC close page;

$execute$
PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
 
SELECT op code OF
  CASE 1:  write text
  CASE 2:  write cmd
  CASE 3:  carriage return
  CASE 4:  move
  CASE 5:  draw
  CASE 6:  on
  CASE 7:  off
  CASE 8:  type
END SELECT.

from : param1. 
to   : param2. 
 
  write text :
    out subtext (string, from, to).
 
$cmdp6+$ 
  write cmd :
    buffer := subtext (string, from, to); 
    IF   buffer = "nlq"
      THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI;
    ELIF buffer = "draft"
      THEN IF is nlq THEN is nlq := FALSE; switch to draft FI;
    ELIF   buffer = "courier"
      THEN IF NOT is courier THEN is courier := TRUE; switch to courier FI;
    ELIF buffer = "souvenir"
      THEN IF is courier THEN is courier := FALSE; switch to souvenir FI;
    ELIF buffer = "schwarz" 
      THEN out (""27"r0")
    ELIF buffer = "rot" 
      THEN out (""27"r1")
    ELIF buffer = "blau" 
      THEN out (""27"r2")
    ELIF buffer = "violett" 
      THEN out (""27"r3")
    ELIF buffer = "gelb" 
      THEN out (""27"r4")
    ELIF buffer = "orange" 
      THEN out (""27"r5")
    ELIF buffer = "grün" 
      THEN out (""27"r6")
      ELSE out (buffer) 
    FI. 
 
$cmdp5-7$ 
  write cmd :
    buffer := subtext (string, from, to);
    IF   buffer = "nlq"
         THEN IF NOT is nlq THEN switch to nlq FI;
              is nlq := TRUE;
    ELIF buffer = "draft"
         THEN IF     is nlq THEN switch to draft FI;
              is nlq := FALSE;
         ELSE out (buffer);
    FI;.
 
$cmdlq850$ 
  write cmd :
    buffer := subtext (string, from, to); 
    IF   buffer = "nlq"
      THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI;
    ELIF buffer = "draft"
      THEN IF is nlq THEN is nlq := FALSE; switch to draft FI;
    ELIF   buffer = "roman"
      THEN IF NOT is roman THEN act typeface name := "roman" ; 
                                switch to roman FI;
    ELIF buffer = "sansserif"
      THEN IF NOT is sansserif THEN act typeface name := "sansserif"; 
                                    switch to sansserif FI;
      ELSE out (buffer) 
    FI. 
 
$cmdoki$ 
  write cmd :
    buffer := subtext (string, from, to); 
    IF   buffer = "nlq"
      THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI;
    ELIF buffer = "draft"
      THEN IF is nlq THEN is nlq := FALSE; switch to draft FI;
    ELIF   buffer = "courier"
      THEN IF NOT is courier THEN is courier := TRUE; switch to courier FI;
    ELIF buffer = "kassette"
      THEN IF is courier THEN is courier := FALSE; switch to kassette FI;
    ELIF buffer = "schwarz" 
      THEN out (""27"r0")
    ELIF buffer = "rot" 
      THEN out (""27"r1")
    ELIF buffer = "blau" 
      THEN out (""27"r2")
    ELIF buffer = "violett" 
      THEN out (""27"r3")
    ELIF buffer = "gelb" 
      THEN out (""27"r4")
    ELIF buffer = "orange" 
      THEN out (""27"r5")
    ELIF buffer = "grün" 
      THEN out (""27"r6")
      ELSE out (buffer) 
    FI. 
 
$cmdtosh$ 
  write cmd :
    buffer := subtext (string, from, to);
    IF   buffer = "nlq"
      THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI;
    ELIF buffer = "draft"
      THEN IF is nlq THEN is nlq := FALSE;  switch to draft FI;
      ELSE out (buffer);
    FI;.
 
$cmdstar$ 
  write cmd :
    buffer := subtext (string, from, to); 
    IF   buffer = "nlq"
      THEN IF NOT is nlq THEN is nlq := TRUE; switch to nlq FI;
    ELIF buffer = "draft"
      THEN IF is nlq THEN is nlq := FALSE; switch to draft FI;
    ELIF   buffer = "roman"
      THEN IF NOT is roman THEN is roman := TRUE; switch to roman FI;
    ELIF buffer = "font1"
      THEN IF is roman THEN is roman := FALSE; switch to font1 FI;
    FI. 
 
$crs$
  carriage return :
    x rest := 0;
    out (""13"").
 
$move$ 
x steps : param1.
y steps : param2.

move :
  IF x steps < 0 OR y steps < 0 THEN stop FI; 
  IF x steps > 0 THEN x move FI; 
  IF y steps > 0 THEN y move FI. 

$stdmove$ 
x move : 
  x rest INCR x steps;
  high   := (x rest) DIV blankbreite;
  x rest := (x rest) MOD blankbreite; 
  steps := x rest DIV 3;
  IF high   > 0 THEN high TIMESOUT " " FI;
  IF steps > 0 AND is slow
     THEN IF is underline THEN out (" "8"") FI;
          out (""27"Y" + code (steps) + ""0"");  (* 1/360 *)
          steps TIMESOUT ""0"";
          x rest := x rest MOD 3
  FI. 
 
is underline: 
  bit (modification bits,7). 
 
y move : 
  IF y steps > 0
     THEN high := y steps DIV 255;
          low  := y steps MOD 255;
          IF high > 0 THEN high TIMESOUT ""27"J"255"" FI;   (* 1/180 *)
          IF low  > 0 THEN out (""27"J" + code (low)) FI;
  FI. 
 
draw :
  IF x steps < 0 OR y steps <> 0 OR linetype <> 1 
    THEN stop
  ELIF x steps > 0
    THEN x draw
  FI. 
 
x draw : 
  x rest INCR x steps ; 
  steps := x steps DIV 3 ; 
  IF steps > 0 THEN 
    x rest := x steps MOD 3 ; 
    out (""27"Y");
    out (code (steps MOD 256));
    out (code (steps DIV 256));
    steps TIMESOUT ""1""; 
  FI.
 
$movep5-7$ 
      x move :
        x rest INCR x steps; 
        IF not is underline
           THEN simple x move
           ELSE underline x move
        FI;

        . not is underline :
            NOT bit (modification bits, 7)
 
        . simple x move :
            high   := x rest DIV factor 1;
            x rest := x rest MOD factor 1;
            out (""27"\");
            out (code (high MOD 256));
            out (code (high DIV 256));
 
        . underline x move :
            high   := x rest DIV factor 2;
            x rest := x rest MOD factor 2;
            IF high < blankbreite
               THEN stop
               ELSE low  := high MOD 127;
                    high := high DIV 127;
                    IF low >= blankbreite
                       THEN low  DECR blankbreite;
                       ELSE high DECR 1;
                            low  DECR (blankbreite - 127);
                    FI;
                    IF high > 0 
                       THEN out (""27" ");
                            out (code (127 - blankbreite));
                            high TIMESOUT " ";
                    FI;
                    out (""27" ");
                    out (code (low)); 
                    out (" "27" "0"");
            FI;
. y move:

  low  := y steps MOD 255;
  high := y steps DIV 255;
  IF high > 0 THEN high TIMESOUT (""27"J"255"") FI;
  IF low  > 0 THEN out (""27"J" + code (low))   FI;
 
. draw :
    IF   x steps < 0 OR y steps <> 0 
         THEN stop
    ELIF x steps > 0
         THEN x draw
    FI;
 
    . x draw :
        x rest INCR x steps;
        steps  := x rest DIV 4;
        x rest := x rest MOD 4;
        IF steps > 0
           THEN low  := steps MOD 256;
                high := steps DIV 256;
                out (""27"*"39"");
                out (code (low));
                out (code (high));
                steps TIMESOUT dot;
        FI;

        . dot :
            IF linetype = underline linetype
               THEN ""000""000""001""
               ELSE ""000""000""048""
            FI. 
 
 
$onoff$ 
  modification : param1
.
  on :
    buffer := on string (modification);
    IF buffer <> ""
       THEN modification bits := modification bits OR code (buffer);
            switch to font;
       ELSE stop
    FI
 
.
  off :
    buffer := off string (modification);
    IF buffer <> ""
       THEN modification bits := modification bits XOR code (buffer);
            switch to font;
       ELSE stop
    FI.
 
$typep6+$ 
   type : 
    font nr := param1 ; 
    buffer := font string (font nr);
    font bits   := code (buffer SUB 3);
    font text   := subtext (buffer, 4);
    blankbreite := char pitch (font nr, " ") ; 
    IF is courier 
      THEN switch to courier 
      ELSE switch to souvenir 
    FI ; 
    switch to font;
    IF is nlq 
      THEN switch to nlq 
      ELSE switch to draft 
    FI;
 
. switch to font :
    out (""27"!");
    out (code (font bits OR modification bits));
    out (font text);
 
. switch to nlq :
    out (""27"x"1"");
 
. switch to draft :
    out (""27"x"0"");
 
. switch to courier : 
    out (""27"k"0"") ; 

. switch to souvenir : 
    out (""27"k"15"") ; 
END PROC execute;
 
$typeplq850$ 
   type : 
    font nr := param1 ; 
    buffer := font string (font nr);
    font bits   := code (buffer SUB 3);
    font text   := subtext (buffer, 4);
    blankbreite := char pitch (font nr, " ") ; 
    IF is roman 
      THEN switch to roman 
      ELSE switch to sansserif 
    FI ; 
    switch to font;
    IF is nlq 
      THEN switch to nlq 
      ELSE switch to draft 
    FI;
 
. switch to font :
    out (""27"!");
    out (code (font bits OR modification bits));
    out (font text);
 
. switch to nlq :
    out (""27"x"1"");
 
. switch to draft :
    out (""27"x"0"");
 
. switch to roman : 
    out (""27"k"0"") ; 

. switch to sansserif : 
    out (""27"k"1"") ; 
END PROC execute;
 
$typeokieps$ 
   type : 
    font nr := param1 ; 
    buffer := font string (font nr);
    font bits   := code (buffer SUB 3);
    vertical factor := code (buffer SUB 1); 
    font text   := subtext (buffer, 4);
    blankbreite := char pitch (font nr, " ") ; 
    IF is courier 
      THEN switch to courier 
      ELSE switch to kassette 
    FI ; 
    switch to font;
    IF is nlq 
      THEN switch to nlq 
      ELSE switch to draft 
    FI;
 
. switch to font :
    out (""27"!");
    out (code (font bits OR modification bits));
    IF vertical factor = 2 
      THEN out (""27"w"1"") 
      ELSE out (""27"w"0"") 
    FI; 
    out (font text);
 
. switch to nlq :
    out (""27"x"1"");
 
. switch to draft :
    out (""27"x"0"");
 
. switch to courier : 
    out (""27"k"0"") ; 

. switch to kassette : 
    out (""27"k"127"") ; 
END PROC execute;
 
$typep5-7$ 
  type :
    font nr     := param1;
    buffer      := font string (font nr);
    factor 1    := code (buffer SUB 1);  (* 720 / Mikroschritte pro Inch mit ESC \ *)
    factor 2    := code (buffer SUB 2);  (* 720 / Mikroschritte pro Inch mit ESC Blank *)
    font bits   := code (buffer SUB 3);
    font text   := subtext (buffer, 4);
    blankbreite := char pitch (font nr, " ") DIV factor 2; 
    switch to font;
    IF is nlq THEN switch to nlq FI;
 
END PROC execute;
 
 
PROC switch to font :
 
  out (""27"!");
  out (code (font bits OR modification bits));
  out (font text);
 
END PROC switch to font;
 
 
PROC switch to nlq :
 
  IF is pica OR is elite
     THEN draft factor 1 := factor 1;
          factor 1       := 4;
          draft factor 2 := factor 2; 
          IF is pica
             THEN factor 2    := 4 * factor 2 DIV 6;
                  blankbreite := char pitch (font nr, " ") DIV factor 2;
          FI;
          out (""27"x"1"");
     ELSE out (""27"x"0"");
  FI;
 
END PROC switch to nlq;
 
 
PROC switch to draft :
 
  IF is pica OR is elite
     THEN factor 1 := draft factor 1;
          factor 2 := draft factor 2;
          out (""27"x"0"");
  FI;
 
END PROC switch to draft;

$typetosh$ 
   type : 
    font nr := param1 ; 
    buffer := font string (font nr);
    font bits   := code (buffer SUB 3);
    font text   := subtext (buffer, 4);
    blankbreite := char pitch (font nr, " ") ; 
    IF is nlq 
      THEN switch to nlq
      ELSE switch to draft 
    FI;
    switch to font;
 
. switch to font :
    INT VAR master select bits := font bits OR modification bits ; 
    IF bit (master select bits,0) 
       THEN out (""27":")
       ELSE out (""18"") 
    FI;
    IF bit (master select bits,1) 
       THEN out (""27"I"2""27"P"1"")
       ELSE out (""27"P"0"") 
    FI;
    IF bit (master select bits,2) 
       THEN out (""27""15"")
    FI;
    IF bit (master select bits,3) 
       THEN out (""27"E")
       ELSE out (""27"F") 
    FI;
    IF bit (master select bits,4) 
       THEN out (""27"G")
       ELSE out (""27"H") 
    FI;
    IF bit (master select bits,5) 
       THEN out (""27"W"1"")
       ELSE out (""27"W"0"") 
    FI;
    IF bit (master select bits,6) 
       THEN
       ELSE
    FI;
    IF bit (master select bits,7) 
       THEN out (""27"-"1"")
       ELSE out (""27"-"0"") 
    FI;
    out (font text);
 
 
. switch to nlq :
    out (""27"I"2"");
 
. switch to draft :
    out (""27"I"1"");
 
END PROC execute;
 
$typeokiibm$ 
   type : 
    font nr := param1 ; 
    buffer := font string (font nr);
    vertical factor := code (buffer SUB 1); 
    font bits   := code (buffer SUB 3);
    font text   := subtext (buffer, 4);
    blankbreite := char pitch (font nr, " ") ; 
    IF is courier 
      THEN switch to courier 
      ELSE switch to kassette 
    FI ; 
    IF is nlq 
      THEN switch to nlq
      ELSE switch to draft 
    FI;
    switch to font;
 
. switch to font :
    INT VAR master select bits := font bits OR modification bits ; 
    IF bit (master select bits,0) 
       THEN out (""27":")
       ELSE out (""18"") 
    FI;
    IF bit (master select bits,1) 
       THEN out (""27"I"2""27"P"1"")
       ELSE out (""27"P"0"") 
    FI;
    IF bit (master select bits,2) 
       THEN out (""27""15"")
    FI;
    IF bit (master select bits,3) 
       THEN out (""27"E")
       ELSE out (""27"F") 
    FI;
    IF bit (master select bits,4) 
       THEN out (""27"G")
       ELSE out (""27"H") 
    FI;
    IF bit (master select bits,5) 
       THEN out (""27"W"1"")
       ELSE out (""27"W"0"") 
    FI;
    IF bit (master select bits,6) 
       THEN  out(""27"%G")
       ELSE  out(""27"%H")
    FI;
    IF bit (master select bits,7) 
       THEN out (""27"-"1"")
       ELSE out (""27"-"0"") 
    FI;
    IF vertical factor = 2 
      THEN out (""27""91""64""4""0""0""0""2""0"") 
      ELSE out (""27""91""64""4""0""0""0""1""0"") 
    FI; 
    out (font text);
 
 
. switch to nlq :
    out (""27"I"2"");
 
. switch to draft :
    out (""27"I"0"");
 
. switch to courier : 
    out (""27"k"0"") ; 

. switch to kassette : 
    out (""27"k"127"") ; 
END PROC execute;
 
$typebrother$ 
   type : 
    font nr := param1 ; 
    buffer := font string (font nr);
    vertical factor := code (buffer SUB 1); 
    font bits   := code (buffer SUB 3);
    font text   := subtext (buffer, 4);
    blankbreite := char pitch (font nr, " ") ; 
    IF is nlq 
      THEN switch to nlq
      ELSE switch to draft 
    FI;
    switch to font;
 
. switch to font :
    INT VAR master select bits := font bits OR modification bits ; 
    IF bit (master select bits,0) 
       THEN out (""27":")
       ELSE out (""18"") 
    FI;
    IF bit (master select bits,1) 
       THEN out (""27"I"2""27"P"1"")
       ELSE out (""27"P"0"") 
    FI;
    IF bit (master select bits,2) 
       THEN out (""27""15"")
    FI;
    IF bit (master select bits,3) 
       THEN out (""27"E")
       ELSE out (""27"F") 
    FI;
    IF bit (master select bits,4) 
       THEN out (""27"G")
       ELSE out (""27"H") 
    FI;
    IF bit (master select bits,5) 
       THEN out (""27"W"1"")
       ELSE out (""27"W"0"") 
    FI;
    IF bit (master select bits,6) 
       THEN
       ELSE
    FI;
    IF bit (master select bits,7) 
       THEN out (""27"-"1"")
       ELSE out (""27"-"0"") 
    FI;
    IF vertical factor = 2 
      THEN out (""27""91""64""4""0""0""0""2""0"") 
      ELSE out (""27""91""64""4""0""0""0""1""0"") 
    FI; 
    out (font text);
 
. switch to nlq :
    out (""27"I"2"");
 
. switch to draft :
    out (""27"I"0"");
 
END PROC execute;
 
$typestar$ 
   type : 
    font nr := param1 ; 
    buffer := font string (font nr);
    font bits   := code (buffer SUB 3);
    font text   := subtext (buffer, 4);
    blankbreite := char pitch (font nr, " ") ; 
    IF is roman 
      THEN switch to roman 
      ELSE switch to font1 
    FI ; 
    switch to font;
    IF is nlq 
      THEN switch to nlq 
      ELSE switch to draft 
    FI;
 
. switch to font :
    out (""27"!");
    out (code (font bits OR modification bits));
    out (font text);
 
. switch to nlq :
    out (""27"x"1"");
 
. switch to draft :
    out (""27"x"0"");
 
. switch to roman : 
    out (""27"k"0"") ; 

. switch to font1 : 
    out (""27"k"1"") ; 
END PROC execute;
 
 

$printerlq1500$ 
PACKET printer driver
 
(**************************************************************************)
(*                                                Stand   : 29.07.86      *)
(*   EPSON   LQ-1500                              Version : 4             *)
(*                                                Autor   : Rudolf Ruland *)
(*   geändert am 15.12.88 hjh                                             *)
(**************************************************************************)
 
       DEFINES printer,
               open,
               close,
               execute,
 
               paper size,
               std quality:
 
LET
(*  underline           =  1,
    bold                =  2,
    italics             =  4,
    reverse             =  8, *)
 
    underline linetype  =  1,
 
    c document          =  1,
    c page              =  2,
 
    c write text        =  1,
    c write cmd         =  2,
    c carriage return   =  3, 
    c move              =  4,
    c draw              =  5,
    c on                =  6, 
    c off               =  7,
    c type              =  8;
 
INT VAR rest, high, low, factor;
BOOL VAR is nlq, factor was 6, condensed;
REAL VAR x size, y size;
TEXT VAR std quality name, buffer;
 
(*********************************************************************)
 
paper size  (13.6 * 2.54, 12.0 * 2.54);
std quality ("draft");
 
PROC paper size (REAL CONST x, y) :
 
  x size := x;
  y size := y;
 
END PROC paper size;
 
PROC paper size : 
 
  line;
  putline ("Papierbreite  =  " + text (x size, 5, 2) + " cm  =  " + text (x size / 2.54, 5, 2) + " Zoll");
  putline ("Papierlaenge  =  " + text (y size, 5, 2) + " cm  =  " + text (y size / 2.54, 5, 2) + " Zoll");
 
END PROC paper size;
 
 
PROC std quality (TEXT CONST quality) :
 
  IF quality = "nlq" OR quality = "draft"
     THEN std quality name := quality;
     ELSE errorstop ("unzulaessige Betriebsart")
  FI;
 
END PROC std quality;
 
TEXT PROC std quality : std quality name END PROC std quality;
 
(*********************************************************************)
 
PROC open (INT CONST op code, INT VAR param1, param2) :
 
SELECT op code OF
  CASE c document : open document 
  CASE c page     : open page
END SELECT; 
 
 
. x steps : param1
. y steps : param2
. 
  open document :
    IF   pos (material, "nlq") <> 0 
         THEN is nlq := TRUE;
    ELIF pos (material, "draft") <> 0 
         THEN is nlq := FALSE;
         ELSE is nlq := std quality = "nlq"
    FI;
    factor       := 0;
    factor was 6 := FALSE;
    condensed    := FALSE; 
    x steps := x step conversion ( x size );
    y steps := y step conversion ( y size );
    y steps := (y steps DIV 30) * 30;
    out (""27""64"");                      (* Reset des Druckers             *)
    out (""27"R"0"");                      (* Amerikanischer Zeichensatz     *)
    out (""27"C" + code (y steps DIV 30)); (* Formularlaenge                 *)
    out (""27"x"0"");                      (* Entwurfsqualität               *) 
 
 
. x start : param1
. y start : param2
. 
  open page :
    x start := 0;
    y start := 0;
    rest    := 0;
    out (""13"");
 
END PROC open;
 
 
PROC close (INT CONST op code, INT CONST param1) :
 
SELECT op code OF
  CASE c document : close document 
  CASE c page     : close page
END SELECT; 
 
. 
  close document :
 
 
. remaining y steps : param1
.
  close page :
    IF remaining y steps > 0 THEN out (""12"") FI
 
END PROC close;
 
 
PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) :
 
SELECT op code OF
  CASE c write text       :  write text
  CASE c write cmd        :  write cmd
  CASE c carriage return  :  carriage return
  CASE c move             :  move
  CASE c draw             :  draw
  CASE c on               :  on
  CASE c off              :  off
  CASE c type             :  type
END SELECT

 
. from : param1
. to   : param2
.
  write text :
    out subtext (string, from, to)
 
.
  write cmd :
    buffer := subtext (string, from, to);
    IF   buffer = "nlq"
         THEN is nlq := TRUE;
              near letter quality;
    ELIF buffer = "draft"
         THEN is nlq := FALSE;
              draft quality;
         ELSE out (buffer);
    FI;
 
    . near letter quality :
        IF factor = 6
           THEN factor was 6 := TRUE;
                factor       := 4; 
           ELSE factor was 6 := FALSE;
        FI;
        IF condensed
           THEN out (""27"x"0"")
           ELSE out (""27"x"1"") 
        FI;
 
    . draft quality :
        IF factor was 6
           THEN factor was 6 := FALSE;
                factor       := 6; 
        FI;
        out (""27"x"0"");
 
 
(*. x steps to left margin : param1*)
.
  carriage return :
    rest := 0;
    out (""13"");
 
 
. x steps : param1
. y steps : param2
.
  move :
    IF   x steps < 0 OR y steps < 0
         THEN stop
    ELIF x steps > 0
         THEN x move
    ELIF y steps > 0
         THEN y move
    FI;
 
    . x move :
        high := (x steps + rest) DIV factor;
        rest := (x steps + rest) MOD factor;
        out (""27"\");
        out (code (high MOD 256));
        out (code (high DIV 256));
 
    . y move :
        high := y steps DIV 255;
        low  := y steps MOD 255;
        IF high > 0 THEN high TIMESOUT ""27"J"255""      FI;
        IF low  > 0 THEN out (""27"J"); out (code (low)) FI;
 
. 
  draw :
    IF   x steps < 0 OR y steps <> 0 OR linetype <> underline linetype
         THEN stop
    ELIF x steps > 0
         THEN x draw
    FI;
 
    . x draw :
        high := (x steps + rest) DIV 6;
        rest := (x steps + rest) MOD 6;
        IF high > 0
           THEN low  := high MOD 255;
                high := high DIV 255;
                out (""27"V");
                out (code (low));
                out (""27"*"1""1""0""1""27"V"0"");
                FOR low FROM 1 UPTO high
                    REP out (""27"V"255""27"*"1""1""0""1""27"V"0"") PER; 
        FI;
 
 
. modification : param1
.
  on :
    IF on string (modification) <> "" 
       THEN out (on string (modification))
       ELSE stop
    FI
 
.
  off :
    IF off string (modification) <> ""
       THEN out (off string (modification))
       ELSE stop
    FI
 
 
. font nr : param1
.
  type :
    buffer := font string (font nr);
    out (buffer);
    factor := pitch factor;
    IF is nlq THEN near letter quality FI;
 
    . pitch factor :                           (*             Mikroschritt *)
        INT CONST font bits := code (buffer SUB 3);
        IF   bit (font bits, 1) 
             THEN condensed := FALSE;       2  (* proportional  1/360 Inch *)
        ELIF pos (buffer, ""27"x"1"") <> 0
             THEN condensed := FALSE;       4  (* near letter   1/180 Inch *)
        ELIF bit (font bits, 2) 
             THEN condensed := TRUE;        3  (* condensed     1/240 Inch *)
        ELIF bit (font bits, 0) 
             THEN condensed := FALSE;       4  (* elite         1/180 Inch *)
             ELSE condensed := FALSE;       6  (* pica          1/120 Inch *)
        FI
 
END PROC execute;


$end$
INT VAR reply; DATASPACE VAR ds; FILE VAR file;
 
PROC printer:
 
  disable stop;
  continue (server channel);
  check error (error message);
  ds := nilspace;
  REP forget (ds);
      execute print;
      IF is error AND online THEN put error; clear error; FI;
  PER;
END PROC printer;
 
PROC execute print:
 
  LET ack = 0, fetch code = 11, file type = 1003;
  enable stop;
  ds := nilspace;
  call (father, fetch code, ds, reply);
  IF reply = ack CAND type (ds) = file type
     THEN file := sequential file (input, ds);
          print (file,
            PROC (INT CONST, INT VAR, INT VAR) open,
            PROC (INT CONST, INT CONST) close,
            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
  FI;
END PROC execute print;
 
PROC check error(TEXT CONST message):
 
  IF is error
     THEN clear error; rename myself (message);
          IF is error THEN end(myself) FI;
          pause (9000); end(myself);
  FI;
END PROC check error;
 
END PACKET printerdriver