PACKET epson sq printer
 
(**************************************************************************)
(*                                                Stand   : 03.12.86      *)
(*   EPSON  SQ-2500                               Version : 4             *)
(*                                                Autor   : Rudolf Ruland *)
(**************************************************************************)
 
       DEFINES open,
               close,
               execute,
 
               paper size,
           (*  paper feed,    *)  (* <-- nicht getestet *)
               std typeface,
               std quality:
 
LET
(*  underline           =  1,
    bold                =  2,
    italics             =  4,
    reverse             =  8, *)
 
    underline linetype  =  1,
 
    c document          =  1,
    c page              =  2,
 
    c write text        =  1,           cmd draft      =  1,
    c write cmd         =  2,           cmd nlq        =  2,
    c carriage return   =  3,           cmd roman      =  3,
    c move              =  4,           cmd sansserif  =  4,
    c draw              =  5,           cmd courier    =  5,
    c on                =  6,           cmd prestige   =  6,
    c off               =  7,           cmd script     =  7,
    c type              =  8;
 
INT VAR font nr, x rest, high, low, font bits, modification bits, blank pitch,
        factor 1, factor 2, steps;
BOOL VAR is nlq, sheet feed;
REAL VAR x size, y size;
TEXT VAR std quality name, std typeface name, buffer, symbol, font text;
THESAURUS VAR commands := empty thesaurus;

insert (commands, "draft");
insert (commands, "nlq");
insert (commands, "roman");
insert (commands, "sansserif");
insert (commands, "courier");
insert (commands, "prestige");
insert (commands, "script");

. is prop        : bit (font bits, 1)
. is double      : bit (font bits, 5)
.;
 
(*********************************************************************)
 
paper size  (13.6 * 2.54, 12.0 * 2.54);
paper size  ( 8.0 * 2.54, 12.0 * 2.54);
paper feed ("tractor");
std typeface ("roman");
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 paper feed (TEXT CONST paper) :
 
  IF   pos (paper, "sheet") <> 0
       THEN sheet feed := TRUE;
  ELIF pos (paper, "tractor") <> 0
       THEN sheet feed := FALSE;
       ELSE errorstop ("unzulaessige Papiereinfuehrung")
  FI;
 
END PROC paper feed;
 
TEXT PROC paper feed :
 
  IF sheet feed
     THEN "sheet"
     ELSE "tractor"
  FI

END PROC paper feed;
 
 
PROC std typeface (TEXT CONST typeface) :
 
  buffer := typeface;
  changeall (buffer, " ", "");
  IF link (commands, buffer) >= cmd roman
     THEN std typeface name := buffer
     ELSE errorstop ("unzulaessige Schriftart")
  FI;
 
END PROC std typeface;
 
TEXT PROC std typeface : std typeface name END PROC std typeface;
 
 
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 :
    x steps := x step conversion ( x size );
    y steps := y step conversion ( y size );
    y steps := (y steps DIV 30) * 30;
    modification bits := 0;
    out (""24""27""64"");                  (* Reset des Druckers            *)
    out (""27"C" + code (y steps DIV 30)); (* Formularlaenge                *)
    out (""27"x"0"");                      (* Entwurfsqualität              *) 
    out (""27"R"0"");                      (* Amerikanischer Zeichensatz    *)
    out (""27"t"1""27"6");                 (* Erweiterung des Zeichensatzes *)
    IF sheet feed THEN out (""27""25"4") FI; (* Sheetmode ein               *)
    IF   pos (material, "roman") <> 0
         THEN out (""27"k"0"")
    ELIF pos (material, "sansserif") <> 0
         THEN out (""27"k"1"")
    ELIF pos (material, "courier") <> 0
         THEN out (""27"k"2"")
    ELIF pos (material, "prestige") <> 0
         THEN out (""27"k"3"")
    ELIF pos (material, "script") <> 0
         THEN out (""27"k"4"")
         ELSE out (""27"k" + code (link (commands, std typeface) - cmd roman));
    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;
 
 
. x start : param1
. y start : param2
. 
  open page :
    x start := 0;
    IF 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;
 
 
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   sheet feed
         THEN out (""27""25"R")
    ELIF 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);
    scan (buffer);
    next symbol (symbol);
    SELECT link (commands, symbol) OF
      CASE cmd draft     : IF     is nlq THEN switch to draft FI; is nlq := FALSE;
      CASE cmd nlq       : IF NOT is nlq THEN switch to nlq   FI; is nlq := TRUE;
      CASE cmd roman     : out (""27"k"0"")
      CASE cmd sansserif : out (""27"k"1"")
      CASE cmd courier   : out (""27"k"2"")
      CASE cmd prestige  : out (""27"k"3"")
      CASE cmd script    : out (""27"k"4"")
      OTHERWISE : out (buffer);
    END SELECT;
 
 
(*. x steps to left margin : param1*)
.
  carriage return :
    x rest := 0;
    out (""13"");
 
 
. x steps : param1
. y steps : param2
.
  move :
    IF x steps < 0 OR y steps < 0
       THEN stop
       ELSE IF x steps > 0 THEN x move FI;
            IF y steps > 0 THEN y move FI;
    FI;
 
    . 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 < blank pitch
               THEN stop
               ELSE low  := high MOD 127;
                    high := high DIV 127;
                    IF low >= blank pitch
                       THEN low  DECR blankpitch;
                       ELSE high DECR 1;
                            low  DECR (blankpitch - 127);
                    FI;
                    IF high > 0 
                       THEN out (""27" ");
                            out (code (127 - blankpitch));
                            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"); 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 :
        x rest INCR x steps;
        steps  := x rest DIV 6;
        x rest := x rest MOD 6;
        IF steps > 0
           THEN low  := steps MOD 256;
                high := steps DIV 256;
                out (""27"L");
                out (code (low));
                out (code (high));
                steps TIMESOUT ""1"";
        FI;
 
 
. 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
 
.
  type :
    font nr   := param1;
    buffer    := font string (font nr);
    font bits := code (buffer SUB 1);
    font text := subtext (buffer, 2);
    IF is prop
       THEN factor 1 := 4;
            factor 2 := 4;
       ELSE factor 1 := 6;
            factor 2 := 6;
    FI;
    IF is double THEN factor 2 INCR factor 2 FI;
    blank pitch := 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 NOT is prop
     THEN factor 1   := 4;
          factor 2   := (4 * factor 2) DIV 6;
          blankpitch := (6 * blankpitch) DIV 4;
          out (""27"x"1"");
     ELSE out (""27"x"0"");
  FI;
 
END PROC switch to nlq;
 
 
PROC switch to draft :
 
  IF NOT is prop
     THEN factor 1   := 6;
          factor 2   := (6 * factor 2) DIV 4;
          blankpitch := (4 * blankpitch) DIV 6;
          out (""27"x"0"");
  FI;
 
END PROC switch to draft;

 
END PACKET epson sq printer;
 
 
 
#page# 
(******************************************************************)
(***                                                            ***)
(***   Generierung des Printers                                 ***)
(***                                                            ***)
(******************************************************************)
 
LET printer name = "printer.epson.sq",
    up           = ""3""13""5"";
 
TEXT VAR fonttab name := "fonttab.epson.sq";
 
BOOL CONST multi user := (pcb (9) AND 255) <> 1;
 
INT VAR pr channel;
TEXT VAR buffer;
 
command dialogue (TRUE);
IF NOT multi user 
  THEN errorstop ("Dieser Treiber arbeitet nur mit Multi-Tasking-EUMEL") 
FI; 
ask for print channel;
ask for paper format;
ask for typeface;
ask for print quality;
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);
    do ("serverchannel(" + text (pr channel) + ")" ) ;
    line;
. 
  ask for paper format :
    SELECT paper format OF
      CASE 1 : papersize ( 8.0 * 2.54, 12.0 * 2.54)
      CASE 2 : papersize (13.6 * 2.54, 12.0 * 2.54)
      CASE 3 : papersize (21.0, 29.7)
    END SELECT

    . paper format :
        line;
        REP out (up);
            IF yes ("Papierformat : endlos, 8 Zoll breit")
               THEN LEAVE paper format WITH 1 FI;
            out (up);
            IF yes ("Papierformat : endlos, 13.6 Zoll breit")
               THEN LEAVE paper format WITH 2 FI;
            out (up);
            IF yes ("Papierformat : DINA 4")
               THEN LEAVE paper format WITH 3 FI;
        PER;
        0
.
  ask for typeface :
    line;
    std typeface (typeface)
 
    . typeface :
        REP out (up);
            IF yes ("standardmäßige Schriftart : roman")
               THEN LEAVE typeface WITH "roman" FI;
            out (up);
            IF yes ("standardmäßige Schriftart : sansserif")
               THEN LEAVE typeface WITH "sansserif" FI;
            out (up);
            IF yes ("standardmäßige Schriftart : courier")
               THEN LEAVE typeface WITH "courier" FI;
            out (up);
            IF yes ("standardmäßige Schriftart : prestige")
               THEN LEAVE typeface WITH "prestige" FI;
            out (up);
            IF yes ("standardmäßige Schriftart : script")
               THEN LEAVE typeface WITH "script" FI;
        PER;
        ""
.
  ask for print quality :
    line;
    std quality (quality);
 
    . quality :
        REP out (up);
            IF yes ("standardmäßige Druckqualität : draft quality")
               THEN LEAVE quality WITH "draft" FI;
            out (up);
            IF yes ("standardmäßige Druckqualität : near letter quality")
               THEN LEAVE quality WITH "nlq" 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;";