Oberon/V2/Printer

MODULE Printer; (*NW 27.6.88 / 11.3.91*) IMPORT SYSTEM, Input, SCC; CONST maxfonts = 16; PakSize = 512; Broadcast = -1; T0 = 300; T1 = 1200; ACK = 10H; NAK = 25H; NRQ = 34H; NRS = 35H; PRT = 43H; NPR = 26H; TOT = 7FH; VAR res*: INTEGER; (*0 = done, 1 = not done*) PageWidth*, PageHeight*: INTEGER; nofonts: INTEGER; seqno: SHORTINT; head0: SCC.Header; (*sender*) head1: SCC.Header; (*receiver*) in: INTEGER; PrinterName: ARRAY 10 OF CHAR; fontname: ARRAY maxfonts, 32 OF CHAR; buf: ARRAY PakSize OF SYSTEM.BYTE; PROCEDURE ReceiveHead; VAR time: LONGINT; BEGIN time := Input.Time + T0; LOOP SCC.ReceiveHead(head1); IF head1.valid THEN IF head1.sadr = head0.dadr THEN EXIT ELSE SCC.Skip(head1.len) END ELSIF Input.Time >= time THEN head1.typ := TOT; EXIT END END END ReceiveHead; PROCEDURE FindPrinter(VAR name: ARRAY OF CHAR); VAR time: LONGINT; id: ARRAY 10 OF CHAR; BEGIN head0.typ := NRQ; head0.dadr := Broadcast; head0.len := 10; head0.destLink := 0; COPY(name, id); id[8] := 6X; id[9] := 0X; SCC.Skip(SCC.Available); SCC.SendPacket(head0, id); time := Input.Time + T1; LOOP SCC.ReceiveHead(head1); IF head1.valid THEN IF head1.typ = NRS THEN head0.dadr := head1.sadr; res := 0; EXIT ELSE SCC.Skip(head1.len) END ELSIF Input.Time >= time THEN res := 1; EXIT END END END FindPrinter; PROCEDURE SendPacket; BEGIN head0.typ := seqno; head0.len := in; REPEAT SCC.SendPacket(head0, buf); ReceiveHead; UNTIL head1.typ # seqno + ACK; seqno := (seqno+1) MOD 8; IF head1.typ # seqno + ACK THEN res := 1 END END SendPacket; PROCEDURE Send(x: SYSTEM.BYTE); BEGIN buf[in] := x; INC(in); IF in = PakSize THEN SendPacket; in := 0 END END Send; PROCEDURE SendInt(k: INTEGER); BEGIN Send(SHORT(k MOD 100H)); Send(SHORT(k DIV 100H)) END SendInt; PROCEDURE SendBytes(VAR x: ARRAY OF SYSTEM.BYTE; n: INTEGER); VAR i: INTEGER; BEGIN i := 0; WHILE i < n DO Send(x[i]); INC(i) END END SendBytes; PROCEDURE SendString(VAR s: ARRAY OF CHAR); VAR i: INTEGER; BEGIN i := 0; WHILE s[i] > 0X DO Send(s[i]); INC(i) END ; Send(0) END SendString; PROCEDURE Open*(VAR name, user: ARRAY OF CHAR; password: LONGINT); BEGIN nofonts := 0; in := 0; seqno := 0; SCC.Skip(SCC.Available); IF name # PrinterName THEN FindPrinter(name) ELSE res := 0 END ; IF res = 0 THEN SendString(user); SendBytes(password, 4); head0.typ := PRT; head0.len := in; SCC.SendPacket(head0, buf); in := 0; ReceiveHead; IF head1.typ = ACK THEN Send(0FCX) (*printfileid*) ELSIF head1.typ = NPR THEN res := 4 (*no permission*) ELSE res := 2 (*no printer*) END END END Open; PROCEDURE ReplConst*(x, y, w, h: INTEGER); BEGIN Send(2); Send(0); SendInt(x); SendInt(y); SendInt(w); SendInt(h) END ReplConst; PROCEDURE fontno(VAR name: ARRAY OF CHAR): SHORTINT; VAR i, j: INTEGER; BEGIN i := 0; WHILE (i < nofonts) & (fontname[i] # name) DO INC(i) END ; IF i = nofonts THEN IF nofonts < maxfonts THEN COPY(name, fontname[i]); INC(nofonts); Send(3); Send(SHORT(i)); j := 0; WHILE name[j] >= "0" DO Send(name[j]); INC(j) END ; Send(0) ELSE i := 0 END END ; RETURN SHORT(i) END fontno; PROCEDURE UseListFont*(VAR name: ARRAY OF CHAR); VAR i: INTEGER; listfont: ARRAY 10 OF CHAR; BEGIN listfont := "Gacha10l"; i := 0; WHILE (i < nofonts) & (fontname[i] # name) DO INC(i) END ; IF i = nofonts THEN COPY(name, fontname[i]); INC(nofonts); Send(3); Send(SHORT(i)); SendBytes(listfont, 9) END ; END UseListFont; PROCEDURE String*(x, y: INTEGER; VAR s, fname: ARRAY OF CHAR); VAR fno: SHORTINT; BEGIN fno := fontno(fname); Send(1); Send(fno); SendInt(x); SendInt(y); SendString(s) END String; PROCEDURE ContString*(VAR s, fname: ARRAY OF CHAR); VAR fno: SHORTINT; BEGIN fno := fontno(fname); Send(0); Send(fno); SendString(s) END ContString; PROCEDURE ReplPattern*(x, y, w, h, col: INTEGER); BEGIN Send(5); Send(SHORT(col)); SendInt(x); SendInt(y); SendInt(w); SendInt(h) END ReplPattern; PROCEDURE Line*(x0, y0, x1, y1: INTEGER); BEGIN Send(6); Send(0); SendInt(x0); SendInt(y0); SendInt(x1); SendInt(y1) END Line; PROCEDURE Circle*(x0, y0, r: INTEGER); BEGIN Send(9); Send(0); SendInt(x0); SendInt(y0); SendInt(r) END Circle; PROCEDURE Ellipse*(x0, y0, a, b: INTEGER); BEGIN Send(7); Send(0); SendInt(x0); SendInt(y0); SendInt(a); SendInt(b) END Ellipse; PROCEDURE Picture*(x, y, w, h, mode: INTEGER; adr: LONGINT); VAR a0, a1: LONGINT; b: SHORTINT; BEGIN Send(8); Send(SHORT(mode)); SendInt(x); SendInt(y); SendInt(w); SendInt(h); a0 := adr; a1 := LONG((w+7) DIV 8) * h + a0; WHILE (a0 < a1) & (res = 0) DO SYSTEM.GET(a0, b); Send(b); INC(a0) END END Picture; PROCEDURE Page*(nofcopies: INTEGER); BEGIN Send(4); Send(SHORT(nofcopies)) END Page; PROCEDURE Close*; BEGIN SendPacket; WHILE nofonts > 0 DO DEC(nofonts); fontname[nofonts, 0] := " " END END Close; BEGIN PageWidth := 2336; PageHeight := 3425; in := 0; PrinterName[0] := 0X END Printer.