PACKET epson fx printer
 
(*************************************************************************)
(*                                               Stand   : 29.07.86      *)
(*   EPSON    FX-80 / FX-100 / FX-100+           Version : 4             *)
(*                                               Autor   : Rudolf Ruland *)
(*************************************************************************)
 
       DEFINES open,
               close,
               execute,
 
               paper size,
               std speed :
 
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 blankbreite, x rest, y rest, high, low, small;
BOOL VAR is slow, is underline, is italics,
         double font, prop font, italics font; 
REAL VAR x size, y size;
TEXT VAR std speed name;
 
(*********************************************************************)
 
(* paper size ( 8.0 * 2.54, 12.0 * 2.54); *) (* FX-80  *)
   paper size (13.6 * 2.54, 12.0 * 2.54);    (* FX-100 *)
   std speed  ("fast");
 
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 speed (TEXT CONST speed) :
 
  IF speed = "fast" OR speed = "slow"
     THEN std speed name := speed;
     ELSE errorstop ("unzulaessige Geschwindigkeit")
  FI;
 
END PROC std speed;
 
TEXT PROC std speed : std speed name END PROC std speed;
 
(*********************************************************************)
 
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, "slow") <> 0 
         THEN is slow := TRUE;
    ELIF pos (material, "fast") <> 0 
         THEN is slow := FALSE;
         ELSE is slow := std speed name = "slow"
    FI;
    is underline := FALSE;
    is italics   := FALSE;
    x steps := x step conversion ( x size );
    y steps := y step conversion ( y size );
    y steps := (y steps DIV 36) * 36;
    out (""27""64"");                      (* Reset des Druckers             *)
    out (""27"R"0"");                      (* Amerikanischer Zeichensatz     *)
    out (""27"C" + code (y steps DIV 36)); (* Formularlaenge                 *)
    out (""27"I1"27"6");                   (* Erweiterung des Zeichensatzes  *)
    out (""27":"0""0""0""27"%"1""0"");     (* Ladbarer Zeichensatz           *)
    (* Definieren von Zeichen der Breiten 5, 6, 7, 8 und 9 Mikroschritte     *)
    out (""27"&"0""000""000""4""0""0""0""0""0""0""0""0""0""0""0"");
    out (""27"&"0""001""001""5""0""0""0""0""0""0""0""0""0""0""0"");
    out (""27"&"0""002""002""6""0""0""0""0""0""0""0""0""0""0""0"");
    out (""27"&"0""003""003""7""0""0""0""0""0""0""0""0""0""0""0"");
    out (""27"&"0""004""004""8""0""0""0""0""0""0""0""0""0""0""0"");
 
 
. x start : param1
. y start : param2
. 
  open page :
    x start := 0;
    y start := 0;
    x rest  := 0;
    y rest  := 0;
    small   := 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 :
    out subtext (string, from, to)
 
 
(*. x steps to left margin : param1*)
.
  carriage return :
    y rest INCR small;
    x rest := 0;
    small  := 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 :
        IF prop font
           THEN prop x move
           ELSE fest x move
        FI;
 
        . prop x move :
            high := (x steps + x rest) DIV 5 - 1;
            low  := (x steps + x rest) MOD 5 + 5;
            IF high < 0
               THEN x rest := low - 5;
               ELSE IF double font                THEN out (""27"W"0"")     FI; 
                    IF italics font OR is italics THEN out (""27"5")        FI;
                    IF high > 0                   THEN high TIMESOUT ""0""  FI;
                    IF low  > 0                   THEN out (code (low - 5)) FI;
                    IF double font                THEN out (""27"W"1"")     FI;
                    IF italics font OR is italics THEN out (""27"4")        FI;
                    x rest := 0;
           FI;
 
        . fest x move :
            high   := (x steps + x rest) DIV blankbreite;
            x rest := (x steps + x rest) MOD blankbreite;
            IF high   > 0 THEN high TIMESOUT " " FI;
            IF x rest > 0 AND is slow
               THEN IF is underline THEN out (" "8"") FI;
                    out (""27"Y"+ code (x rest) + ""0"");
                    x rest TIMESOUT ""0"";
                    x rest := 0;
            FI;
 
    . y move :
        y rest INCR y steps;
        IF y rest > 0
           THEN high := y rest DIV 255;
                low  := y rest MOD 255;
                IF high > 0 THEN high TIMESOUT ""27"J"255""      FI;
                IF low  > 0 THEN out (""27"J"); out (code (low)) FI;
                y rest := 0;
        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 DIV 256;
        low  := x steps MOD 256;
        out (""27"Y");
        out (code (low));
        out (code (high));
        x steps TIMESOUT ""1"";
 
 
. modification : param1
.
  on :
    IF on string (modification) <> ""
       THEN out (on string (modification));
            IF modification = underline THEN is underline := TRUE FI;
            IF modification = italics   THEN is italics   := TRUE FI;
       ELSE stop
    FI;
 
.
  off :
    IF off string (modification) <> ""
       THEN out (off string (modification));
            IF modification = underline THEN is underline := FALSE FI;
            IF modification = italics   THEN is italics   := FALSE FI;
       ELSE stop
    FI;
 
 
. font nr : param1
.
  type :
    TEXT CONST buffer := font string (font nr);
    out (buffer);
    IF is italics THEN out (""27"4") FI;
    blankbreite  := char pitch (font nr, " ");
    prop font    := pos (buffer, ""27"p") <> 0;
    italics font := pos (buffer, ""27"4") <> 0;
    double font  := blankbreite > 12;
    IF pos (string, ""27"S") <> 0 THEN small DECR 1 FI;
 
END PROC execute;
 
 
END PACKET epson fx printer;
 
 
PACKET print cmd for single user                (* Autor : Rudolf Ruland *)
                                                (* Stand : 18.02.86      *)
       DEFINES print,
               print channel :
 
INT VAR pr channel;
TEXT VAR buffer;
FILE VAR print file;
 
BOOL CONST multi user := (pcb (9) AND 255) <> 1;
 
 
PROC print channel (INT CONST channel) :
 
  IF multi user THEN do ("serverchannel(" + text (channel) + ")" ) FI;
  pr channel := channel;
 
END PROC print channel; 
 
INT PROC print channel : pr channel END PROC print channel; 
 
 
PROC print :

  print (last param)

ENDPROC print ;

PROC print (TEXT CONST file name) :

  INT CONST myself channel := channel (myself);
  last param (file name) ;
  print file := sequential file (input, file name) ;
  continue (print channel) ;
  disable stop ;
  execute print ;
  remember error message if neccessary;
  IF multi user THEN do ("break (quiet)") FI;
  continue (myself channel);
  clear error;
  put error message if neccessary;

  . remember error message if neccessary :
      IF is error
         THEN buffer := error message;
              clear error;
         ELSE buffer := "";
      FI;
 
  . put error message if neccessary :
      IF buffer <> "" THEN errorstop (buffer) FI;
 
ENDPROC print ;

PROC execute print :

  enable stop ;
  print (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);
 
ENDPROC execute print ;

ENDPACKET print cmd for single user;
 
#page# 
(******************************************************************)
(***                                                            ***)
(***   Generierung des Printers                                 ***)
(***                                                            ***)
(******************************************************************)
 
LET printer name = "printer.epson.fx",
    up           = ""3""13""5"";
 
TEXT VAR fonttab name := "fonttab.epson.fx";
 
BOOL CONST multi user := (pcb (9) AND 255) <> 1;
 
INT VAR pr channel;
TEXT VAR buffer;
 
command dialogue (TRUE);
ask for print channel;
ask for printer type;
ask for positioning;
load font table;
forget (printer name, quiet);
IF multi user THEN generate printer spool FI;
check on;
.
  ask for print channel : 
    line;
    put ("gib Druckerkanal:");
    get (pr channel);
    print channel (pr channel);
    line;
. 
  ask for printer type :
    line;
    SELECT printer type OF
      CASE 0 : papersize ( 8.0 * 2.54, 12.0 * 2.54);
      CASE 1 : papersize (13.6 * 2.54, 12.0 * 2.54);
      CASE 2 : papersize (13.6 * 2.54, 12.0 * 2.54);
               fonttab name CAT "+";
    END SELECT;
 
    . printer type :
        REP out (up); 
            IF yes ("Druckertyp : FX-80")
               THEN LEAVE printer type WITH 0 FI;
            out (up);
            IF yes ("Druckertyp : FX-100")
               THEN LEAVE printer type WITH 1 FI;
            out (up);
            IF yes ("Druckertyp : FX-100+")
               THEN LEAVE printer type WITH 2 FI;
        PER;
        0
. 
  ask for positioning :
    line;
    std speed (positioning);
 
    . positioning :
        REP out (up); 
            IF yes ("x - Positionierung : in Mikroschritten (genauer, aber langsamer)")
               THEN LEAVE positioning WITH "slow" FI;
            out (up);
            IF yes ("x - Positionierung : in Blanks (schneller, aber ungenauer)")
               THEN LEAVE positioning WITH "fast" FI;
        PER;
        ""
.
  load font table :
    IF NOT exists (fonttab name)
       THEN command dialogue (TRUE); 
            REP line (2); 
                putline ("Bitte Archiv mit der Fonttabelle """ +
                          fonttab name + """ einlegen!");
                line;
            UNTIL yes ("Archiv eingelegt") PER;
            reserve archive;
            fetch (fonttab name, archive);
            release (archive);
    FI;
    font table (fonttab name);
    IF multi user
       THEN command dialogue (FALSE); 
            do ("save(""" + font tab name + """,task(""configurator""))") 
    FI;
    forget (fonttab name, quiet);
 
    . reserve archive :
        INT VAR p1, p2;
        archive (" "31" ");
        disable stop;
        list (archive);
        IF is error
           THEN buffer := errormessage;
                p1 := pos (buffer, """", 1 ) + 1;
                p2 := pos (buffer, """", p1) - 1;
                IF p1 > 0 AND p2 > 0
                   THEN clear error;
                        buffer := subtext (buffer, p1, p2);
                        archive (buffer);
                FI;
        FI;
        enable stop;
 
. generate printer spool :
    eumel must advertise;
    cursor (1, 12);
    putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - muß");
    putline ("die Fonttabelle mit dem Kommando");
    line;
    putline ("      font table (""" + font tab name + """)");
    line;
    putline ("eingestellt werden!!!");
    line (4);
    putline ("Generierung beendet, weiter mit 'SV'");
    generate printer server;
    do (buffer);
 
. generate printer server :
    buffer :=  "break (quiet);";
    buffer CAT "spool manager (PROC printer);";
    buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;";
    buffer CAT "PROC printer:";
    buffer CAT "  disable stop;";
    buffer CAT "  continue (server channel);";
    buffer CAT "  check error (error message);";
    buffer CAT "  ds := nilspace;";
    buffer CAT "  REP forget (ds);";
    buffer CAT "      execute print;";
    buffer CAT "      IF is error AND online THEN put error; clear error; FI;";
    buffer CAT "  PER;";
    buffer CAT "END PROC printer;";
    buffer CAT "PROC execute print:";
    buffer CAT "  LET ack = 0, fetch code = 11, file type = 1003;";
    buffer CAT "  enable stop;";
    buffer CAT "  ds := nilspace;";
    buffer CAT "  call (father, fetch code, ds, reply);";
    buffer CAT "  IF reply = ack CAND type (ds) = file type";
    buffer CAT "     THEN file := sequential file (input, ds);";
    buffer CAT "          print (file,";
    buffer CAT "            PROC (INT CONST, INT VAR, INT VAR) open,";
    buffer CAT "            PROC (INT CONST, INT CONST) close,";
    buffer CAT "            PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);";
    buffer CAT "  FI;";
    buffer CAT "END PROC execute print;"; 
    buffer CAT "PROC check error(TEXT CONST message):";
    buffer CAT "  IF is error";
    buffer CAT "     THEN clear error; rename myself (message);";
    buffer CAT "          IF is error THEN end(myself) FI;"; 
    buffer CAT "          pause (9000); end(myself);";
    buffer CAT "  FI;";
    buffer CAT "END PROC check error;";