path: root/system/printer-laser/4/src/printer.nec.lc-08

PACKET nec lc 08 printer
 
(**************************************************************************)
(*                                                Stand   : 29.01.88      *)
(*  NEC Silentwriter LC-08                        Verison : 4             *)
(*                                                Autor   : Rudolf Ruland *)
(**************************************************************************)
 
       DEFINES open,
               close,
               execute,
 
               box commands,
               insert box command,
               delete box command,

               paper size,
               paper x size,
               paper y size:
 
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,

    tag type            =  1;
 
INT VAR symbol type;
REAL VAR x size, y size;
BOOL VAR is landscape, was cr;
TEXT VAR bold buffer, mod string, command, symbol;
THESAURUS VAR box cmds := empty thesaurus;

(*********************************************************************)
 
paper size (21.0, 29.7);
 
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;
 
REAL PROC paper x size : x size END PROC paper x size;
REAL PROC paper y size : y size END PROC paper y size;


THESAURUS PROC box commands : box cmds END PROC box commands;

PROC insert box command (TEXT CONST new command) :

  command := new command;
  change all (command, " ", "");
  insert (box cmds, command)

END PROC insert box command;

PROC delete box command (TEXT CONST old command) :

  INT VAR dummy;
  command := old command;
  change all (command, " ", "");
  delete (box cmds, command, dummy)

END PROC delete box command;

(*********************************************************************)
 
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 :
    out (""28"Cz");                      (* Diablo 630 Emulation    *)
    out (""27""13"P");                   (* Reset                   *)
    out (""28"$");                       (* Formatlaenge loeschen   *)
    out (""28"Ca"27"6"28"Cz");           (* Zeichensatz 2           *)
    out (""28"Ra");                      (* USA-Zeichensatz         *)
    out (""27""25"1");                   (* Sheet 1                 *)
    is landscape := pos (material, "landscape") > 0;
    IF is landscape
       THEN x steps := x step conversion ( y size );
            y steps := y step conversion ( x size );
            out (""28")"128""0"");       (* Landscape-Mode          *)
       ELSE x steps := x step conversion ( x size );
            y steps := y step conversion ( y size );
            out (""28")"001""0"");       (* Portait  -Mode          *)
    FI;
    was cr      := FALSE;
    bold buffer := "";

. x start : param1
. y start : param2
. 
  open page :
    IF is landscape
       THEN x start := x step conversion (0.45);
            y start := y step conversion (0.9);
       ELSE x start := x step conversion (0.7);
            y start := y step conversion (0.9);
    FI;
    IF   pos (material, "sheet1") > 0
         THEN out (""27""25"1")
    ELIF pos (material, "sheet2") > 0
         THEN out (""27""25"2")
    ELIF pos (material, "manual") > 0
         THEN out (""27""25"E")
    FI;
    out (""28"'a"0""0""28"&a"0""0"");  (* Positionierung auf den Nullpunkt *)
 
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
  OTHERWISE : put (param1)
END SELECT; 
 
. 
  close document :
 
 
(*. remaining y steps : param1*)
.
  close page :
    out (""12"") 
 
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 :
    IF was cr
       THEN was cr := FALSE;
            out (bold buffer);
    FI;
    out subtext (string, from, to)
 
.
  write cmd :
    IF was cr
       THEN was cr := FALSE;
            out (bold buffer);
    FI;
    command := subtext (string, from, to);
    IF is box cmd
       THEN disable stop;
            do (command);
            clear error;
       ELSE out (command);
    FI;
 
    . is box cmd :
        scan (command);
        next symbol (symbol, symbol type);
        (symbol type = tag type) CAND (box cmds CONTAINS symbol)


(*. x steps to left margin : param1*)
.
  carriage return :
    out (""13"");
    was cr := TRUE;
 
 
. x steps : param1
. y steps : param2
.
  move :
    IF x steps <> 0 THEN x move FI;
    IF y steps <> 0 THEN y move FI;

    . x move :
        IF x steps > 0  THEN out (""28"&c") ELSE out (""28"&d") FI;
        out (x steps low);
        out (x steps high);

        . x steps low  : code (abs (x steps) MOD 256)
        . x steps high : code (abs (x steps) DIV 256)

    . y move :
        IF y steps > 0  THEN out (""28"'c") ELSE out (""28"'d") FI;
        out (y steps low);
        out (y steps high);

        . y steps low  : code (abs (y steps) MOD 256)
        . y steps high : code (abs (y steps) DIV 256)
. 
  draw :
    stop
 
 
. modification : param1
.
  on :
    mod string := on string (modification);
    IF mod string <> ""
       THEN out (mod string);
            IF pos (""27"W"27"O", mod string) > 0
               THEN bold buffer CAT mod string;
            FI;
       ELSE stop
    FI
 
.
  off :
    mod string := off string (modification);
    IF mod string <> ""
       THEN out (mod string);
            IF pos (""27"&", mod string) > 0
               THEN bold buffer := subtext (bold buffer, 1, LENGTH bold buffer - 2);
                    out (bold buffer);
            FI;
       ELSE stop
    FI
 
 
. font nr : param1
.
  type :
    out (""28")");                            (* Font Identifikation *)
    command := font string (font nr);
    IF is landscape
       THEN out subtext (command, 3, 4);
       ELSE out subtext (command, 1, 2);
    FI;
    out (""28"E");                            (* Zeilenvorschub (VMI) *)
    out (code (font height (font nr) + font depth (font nr) + font lead (font nr)));
    out (""28"F");                            (* Zeichenabstand (HMI) *)
    out (code (char pitch (font nr, " ")));
    out (""27"P");                            (* proportional ein     *)
    out subtext (command, 5);

END PROC execute;
 
END PACKET nec lc 08 printer;
 
 
PACKET nec lc 08 box commands 

(**************************************************************************)
(*                                                                        *)
(*      Kommandos zum Zeichen von Boxen, Linien und Schraffuren           *)
(*                für den NEC Laserdrucker LC-08                          *)
(*                                                                        *)
(*                                                Autor   : Rudolf Ruland *)
(*                                                Stand   : 29.01.88      *)
(**************************************************************************)

       DEFINES line,
               x line,
               y line,

               box,
               box frame,
               box shade,

               cake,
               cake frame,
               cake shade,
               :

INT VAR x, y, h, w;

WHILE highest entry (box commands) > 0
  REP delete box command (name (box commands, highest entry (box commands))) PER;
insert box command ("line");
insert box command ("xline");
insert box command ("yline");
insert box command ("box");
insert box command ("boxshade");
insert box command ("boxframe");
insert box command ("cake");
insert box command ("cakeshade");
insert box command ("cakeframe");


PROC line (REAL CONST x offset, y offset, width, height, INT CONST line width) :

  IF line width > 0
     THEN graph on (x offset, y offset, width, height);
          out ("LW" + text (line width) + ";");
          out ("PR;");
          out ("PD" + text (+w) + "," + text (-h) + ";");
          graph off;
  FI;

END PROC line;

PROC x line (REAL CONST x offset, y offset, width, INT CONST line width) :

  IF line width > 0
     THEN graph on (x offset, y offset, width, 0.0);
          out ("LW" + text (line width) + ";");
          out ("PR;");
          out ("PD" + text (+w) + "," + "0;");
          graph off;
  FI;

END PROC x line;

PROC y line (REAL CONST x offset, y offset, height, INT CONST line width) :

  IF line width > 0
     THEN graph on (x offset, y offset, 0.0, height);
          out ("LW" + text (line width) + ";");
          out ("PR;");
          out ("PD0," + text (-h) + ";");
          graph off;
  FI;

END PROC y line;


PROC box (REAL CONST x offset, y offset, width, height,
          INT CONST pattern type, line width) :

  IF   pattern type = 0
       THEN box frame (x offset, y offset, width, height, line width)
  ELIF line width   = 0
       THEN box shade (x offset, y offset, width, height, pattern type)
       ELSE graph on (x offset, y offset, width, height);
            out ("LW" + text (line width) + ";");
            set pattern (pattern type);
            out ("ER" + text (+w) + "," + text (-h) + ";");
            graph off;
  FI;

END PROC box;


PROC box shade (REAL CONST x offset, y offset, width, height,
                INT CONST pattern type) :

  IF pattern type <> 0
     THEN graph on (x offset, y offset, width, height);
          set pattern (pattern type);
          out ("RR" + text (+w) + "," + text (-h) + ";");
          graph off;
  FI;

END PROC box shade;


PROC box frame (REAL CONST x offset, y offset, width, height,
                INT CONST line width) :

  IF line width <> 0
     THEN graph on (x offset, y offset, width, height);
          out ("LW" + text (line width) + ";");
          out ("PR;");
          out ("PD");
          out (text (+w) + "," +            "0,");
          out (           "0," + text (-h) + ",");
          out (text (-w) + "," +            "0,");
          out (           "0," + text (+h) + ";");
          graph off;
   FI;

END PROC box frame;


PROC cake (REAL CONST x offset, y offset, radius, start angle, sweep angle,
          INT CONST pattern type, line width) :

  IF   pattern type = 0
       THEN cake frame (x offset, y offset, radius, start angle, sweep angle, line width)
  ELIF line width   = 0
       THEN cake shade (x offset, y offset, radius, start angle, sweep angle, pattern type)
       ELSE graph on (x offset, y offset, radius, 0.0);
            out ("LW" + text (line width) + ";");
            set pattern (pattern type);
            out ("EW" + text (+w) + "," + text (start angle) + "," + text (sweep angle) + ";");
            graph off;
  FI;

END PROC cake;


PROC cake shade (REAL CONST x offset, y offset, radius, start angle, sweep angle,
                INT CONST pattern type) :

  IF pattern type > 0 CAND w > 0
     THEN graph on (x offset, y offset, radius, 0.0);
          set pattern (pattern type);
          out ("WG" + text (+w) + "," + text (start angle) + "," + text (sweep angle) + ";");
          graph off;
  FI;

END PROC cake shade;


PROC cake frame (REAL CONST x offset, y offset, radius, start angle, sweep angle,
                 INT CONST line width) :


  IF line width <> 0
     THEN REAL CONST xs := real (x) + cos (start angle*pi/180.0) * real (w),
                     ys := real (y) + sin (start angle*pi/180.0) * real (w);
          graph on (x offset, y offset, radius, 0.0);
          out ("LW" + text (line width) + ";");
          out ("MA"+ text (xs) + "," + text (ys) + ";");
          out ("FA"+ text ( x) + "," + text ( y) + "," + text (sweep angle) + ";");
          out ("MA"+ text ( x) + "," + text ( y) + ";");
          graph off;
   FI;

END PROC cake frame;


PROC graph on (REAL CONST x offset, y offset, width, height) :

  x := x pos + x step conversion (x offset);
  y := plot y size - (y pos + y step conversion (y offset));
  w := x step conversion (width);
  h := y step conversion (height);
  out (""28"Aa");
  out ("DF;");
  out ("MA"+ text (x) + "," + text (y) + ";");

  . plot y size : 3389 - y step conversion (1.0)

END PROC graph on;

PROC graph off :

  out (""28"Az");

END PROC graph off;


PROC set pattern (INT CONST pattern type) :

  out ("XX1;");
  out (pattern);

  . pattern :
      SELECT pattern type OF
        CASE  1 : "FT2,1,0;"
        CASE  2 : "FT2,1,90;"
        CASE  3 : "FT2,1,45;"
        CASE  4 : "FT3,1,0;"
        CASE  5 : "FT3,1,45;"
        CASE  6 : "FT2,100,0;"
        CASE  7 : "FT2,100,90;"
        CASE  8 : "FT2,100,45;"
        CASE  9 : "FT3,100,0;"
        CASE 10 : "FT3,100,45;"
        OTHERWISE : "FT1;"
      END SELECT

END PROC set pattern;


END PACKET nec lc 08 box commands;


 
#page# 
(******************************************************************)
(***                                                            ***)
(***   Generierung des Printers                                 ***)
(***                                                            ***)
(******************************************************************)
 
LET printer name = "printer.nec.lc-08";
 
TEXT VAR fonttab name := "fonttab.nec.lc-08";
 
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;
load font table;
forget (printer name, quiet);
IF multi user THEN generate printer spool FI;
command dialogue (TRUE);
check on;
.
  ask for print channel : 
    line;
    put ("gib Druckerkanal:");
    get (pr channel);
    do ("serverchannel(" + text (pr channel) + ")" ) ;
    line;
.
  load font table :
    IF NOT exists (fonttab name)
       THEN 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;";