PACKET canon lbp 8 printer (*************************************************************************) (* Stand : 29.07.86 *) (* CANON LBP-8 A1/A2 Version : 4 *) (* Autor : Rudolf Ruland *) (*************************************************************************) DEFINES open, close, execute, paper size : LET underline = 1, (* bold = 2, italics = 4, reverse = 8, underline linetype = 1, *) csi = ""155"", 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; REAL VAR x size, y size; BOOL VAR is underline; (*********************************************************************) 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; (*********************************************************************) 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 : is underline := FALSE; x steps := x step conversion ( x size - 0.8043333 ); y steps := y step conversion ( y size - 0.508); out (""27":"27"P"13""); (* Enable - Prop.Type *) out (""27";"27"<"155"11h"); (* Reset des Druckers *) out (""27"(B"); (* ACSII-Zeichensatz *) out (""155"1;4 D"); (* Char.Satz 1 = PICA *) . x start : param1 . y start : param2 . open page : x start := x step conversion (0.4064 ); y start := y step conversion (0.508 + 0.6345); 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 OTHERWISE : put (param1) END SELECT; . close document : (* out(""155"0q") von Standard-Cassette Papier holen *) (*. remaining y steps : param1*) . close page : out (""13""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 : INT VAR new from, new to; IF is underline THEN IF pos (string, " ", from, from) <> 0 THEN out ("_"); new from := from + 1; ELSE new from := from; FI; IF from < to AND pos (string, " ", to, to) <> 0 THEN new to := to - 1; ELSE new to := to; FI; out subtext (string, new from, new to); IF to <> new to THEN out ("_") FI; ELSE out subtext (string, from, to) FI; . write cmd : out subtext (string, from, to) (*. x steps to left margin : param1*) . carriage return : out (""13"") . x steps : param1 . y steps : param2 . move : IF x steps > 0 THEN out (csi); out (text ( x steps)); out ("a") ELIF x steps < 0 THEN out (csi); out (text (- x steps)); out ("j") FI; IF y steps > 0 THEN out (csi); out (text ( y steps)); out ("e") ELIF y steps < 0 THEN out (csi); out (text (- y steps)); out ("k") FI; . draw : stop . modification : param1 . on : IF on string (modification) <> "" THEN out (on string (modification)); IF modification = underline THEN is underline := TRUE FI; ELSE stop FI . off : IF off string (modification) <> "" THEN out (off string (modification)); IF modification = underline THEN is underline := FALSE FI; ELSE stop FI . font nr : param1 . type : out (font string (font nr)); END PROC execute; END PACKET canon lbp 8 printer; #page# (******************************************************************) (*** ***) (*** Generierung des Printers ***) (*** ***) (******************************************************************) LET printer name = "printer.canon.lbp-8"; TEXT VAR fonttab name := "fonttab.canon.lbp-8"; 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 font cartridge; 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 font cartridge : . 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;";