From 724cc003460ec67eda269911da85c9f9e40aa6cf Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Fri, 30 Sep 2016 16:57:23 +0200 Subject: Add extracted sources from floppy disk images Some files have no textual representation (yet) and were added as raw dataspaces. --- printer/laser/printer.nec.lc-08 | 626 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 626 insertions(+) create mode 100644 printer/laser/printer.nec.lc-08 (limited to 'printer/laser/printer.nec.lc-08') diff --git a/printer/laser/printer.nec.lc-08 b/printer/laser/printer.nec.lc-08 new file mode 100644 index 0000000..9ee2837 --- /dev/null +++ b/printer/laser/printer.nec.lc-08 @@ -0,0 +1,626 @@ +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;"; + -- cgit v1.2.3