ð<  Syntax10.Scn.Fnt  ¦  Syntax10b.Scn.Fnt                  
        	            q                   ‰    Á   üÿÿÿÀÔ °­ MarkElems Alloc .a      c    üÿÿÿÀÔ °­ /a      5    üÿÿÿÀÔ °­ 0a      I    üÿÿÿÀÔ °­ 1a  	    O    üÿÿÿÀÔ °­ 2a      a    üÿÿÿÀÔ °­ 3a      N    üÿÿÿÀÔ °­ 4a      K    üÿÿÿÀÔ °­ 5a      O    üÿÿÿÀÔ °­ 6a      i    üÿÿÿÀÔ °­ 7a      a    üÿÿÿÀÔ °­ 8a      Q    üÿÿÿÀÔ °­ 9a      t    üÿÿÿÀÔ °­ :a  
    i    üÿÿÿÀÔ °­ ;a      T    üÿÿÿÀÔ °­ <a      °    üÿÿÿÀÔ °­ =a  o   üÿÿÿÀÔ °­ >a      ž   üÿÿÿÀÔ °­ ?a      Ú    üÿÿÿÀÔ °­ @a      I   Syntax8.Scn.Fnt      üÿÿÿÀÔ °­ Aa  "        üÿÿÿÀÔ °­ Ba  þ   üÿÿÿÀÔ °­ Ca  	    ×   üÿÿÿÀÔ °­ Da      T   üÿÿÿÀÔ °­ Ea         üÿÿÿÀÔ °­ Fa      7   üÿÿÿÀÔ °­ Ga      V   üÿÿÿÀÔ °­ Ha      üÿÿÿÀÔ °­ Ia  Ø   üÿÿÿÀÔ °­ Ja  a   üÿÿÿÀÔ °­ Ka  ¢   üÿÿÿÀÔ °­ La      <   üÿÿÿÀÔ °­ Ma         Syntax10i.Scn.Fnt  N        '                 7        /    	    °       <    /    Ë    b    &    ´   üÿÿÿÀÔ °­ Na      K    üÿÿÿÀÔ °­ Oa  â    üÿÿÿÀÔ °­ Pa  ù   C    µ    üÿÿÿÀÔ °­ Qa  •   üÿÿÿÀÔ °­ Ra  í        0    üÿÿÿÀÔ °­ Sa  (   üÿÿÿÀÔ °­ Ta  Ö   üÿÿÿÀÔ °­ Ua  è    üÿÿÿÀÔ °­ Va  4   üÿÿÿÀÔ °­ Wa  Ó    üÿÿÿÀÔ °­ Xa  $   üÿÿÿÀÔ °­ Ya      8   üÿÿÿÀÔ °­ Za  
    ”    üÿÿÿÀÔ °­ [a      ˜    üÿÿÿÀÔ °­ \a      Z       ™        Å   üÿÿÿÀÔ °­ ]a  I    üÿÿÿÀÔ °­ ^a  f    üÿÿÿÀÔ °­ _a  @       †        7           üÿÿÿÀÔ °­ `a  ]   üÿÿÿÀÔ °­ aa      <    üÿÿÿÀÔ °­ ba      ™    ”q  MODULE Printers;	(* Abstract Printer Interface / MH 13.4.94 *)	(* 17.6.95 changes in NewPage *)	(* CS 29.11.95, printing on 600 dpi printers *)	(* CS 18.6.96 Printer.Picture *)	(* CS 30.08.96 PageH, PageW and Unit moved down to Win32 *)	(* CS 30.08.96 SpecialString corrected, Math10.Scn.Fnt is still printed very small *)IMPORT S := SYSTEM, Registry, Kernel, Win32, Display, ShowError, Fonts, C := Console;TYPE	Printer* = POINTER TO PrinterDesc;	PrinterDesc* = RECORD		pageHeight*, pageWidth*: INTEGER;		res*: INTEGER;	END ;	StdPrinter = POINTER TO StdPrinterDesc;	StdPrinterDesc = RECORD (PrinterDesc)	END ;VAR	StdPrt-: StdPrinter;	Current-: Printer;	GetObject: PROCEDURE (hgdiobj: LONGINT; size: INTEGER; bufAdr: LONGINT): INTEGER;	GetDIBits: PROCEDURE (hdc: LONGINT; bitmap: LONGINT; startLine, scanLines: INTEGER; bufAdr,infoAdr: LONGINT; usage: INTEGER): INTEGER;	StretchBlt: PROCEDURE (hdc, x, y, w, h, hdcSrc, xSrc, ySrc, wSrc, hSrc, rop: LONGINT): BOOLEAN;	(* ---------------- standard printer: declarations -------------- *)CONST	Unit300 = LONG(3048); (* 300 dpi resolution *)	ScreenUnit = 10000; (* screen resolution *)	noerr = 0; noconnection = 1; (* Printer.res *)	NULL = 0;	MapSize = 10;	TrueType = 2; RasterType = 0; DeviceType = 1;	bold = Win32.Bold; italics = Win32.Italics;	HORSIZE = 4; HORZRES = 8; VERTRES = 10; (* device capabilities *)	N = 20; (* Splines *)TYPE	DocInfo = RECORD		size: LONGINT;		docName: LONGINT;		outputName: LONGINT;	END ;	LogFontPtr = POINTER TO LogFont; (* LPLOGFONT *)	LogFont = RECORD	(* LOGFONT *)		height, width: LONGINT;		escapement, orientation: LONGINT;		weight: LONGINT;		italic, underline, strikeout, charset: SHORTINT;		outprec, clipprec, quality: SHORTINT;		pitchAndFamily: SHORTINT;		facename: ARRAY 32 OF CHAR;	END ;	LPTEXTMETRIC =  POINTER TO TEXTMETRIC;	TEXTMETRIC = RECORD		height, ascent, descent: LONGINT;		intLead, extLead: LONGINT;		avgCharWidth, maxCharWidth: LONGINT;		weight, overhang: LONGINT;		aspectX, aspectY: LONGINT;		firstCh, lastCh, defaultCh, breakCh: CHAR;		italic, underlined, struckout: SHORTINT;		pitchAndFamily, charset: SHORTINT;	END ;	Size = RECORD w, h: LONGINT END ;	EnumFontsProc = PROCEDURE (logfont: LogFontPtr; tm: LPTEXTMETRIC; type: SET; raster: Win32.Font): LONGINT;	(*Splines*)	RealVector = ARRAY N OF REAL;	Poly = RECORD a, b, c, d, t: REAL END ;	PolyVector = ARRAY N OF Poly;VAR(*	now exported from Win32	PageH, PageW: LONGINT; (* in printer pixels *)	Unit: LONGINT;	(* printer resolution in 1/36000 mm per pixel *)*)	newPage: BOOLEAN;	hdc: LONGINT;	cachedFont: Fonts.Font; (* current font in device context *)	cachedMetrics: TEXTMETRIC;	family: ARRAY 32 OF CHAR;	hfont: LONGINT;	textX, textY: LONGINT; (* in 300 dpi *)	Map: ARRAY MapSize OF RECORD family, subst: ARRAY 32 OF CHAR END ; (* font substitution *)	printerName: ARRAY 32 OF CHAR;	sizes: ARRAY 256 OF Size;	MFont: Fonts.Font;	(* font with ABC metrics *)	Color: LONGINT; (*RGB*)	SetMapMode: PROCEDURE (hdc, mode: LONGINT);	MoveToEx: PROCEDURE (hdc: LONGINT; x, y: LONGINT; prev: LONGINT);	LineTo: PROCEDURE (hdc, x, y: LONGINT);	Ellipse0: PROCEDURE (hdc, left, top, right, bot: LONGINT);	CreateHatchBrush: PROCEDURE (style: LONGINT; col: LONGINT (*COLORREF*)): LONGINT;	CreatePen: PROCEDURE (style, width: LONGINT; color: LONGINT (*COLORREF*)): LONGINT;	StartDoc: PROCEDURE (hdc: LONGINT; docInfo: LONGINT);	EndDoc: PROCEDURE (hdc: LONGINT);	StartPage: PROCEDURE (hdc: LONGINT);	EndPage: PROCEDURE (hdc: LONGINT);	GetTextExtentPoint: PROCEDURE (hdc: LONGINT; str: LONGINT; nofchar: LONGINT; lpSize: LONGINT): BOOLEAN;	EnumFonts: PROCEDURE (hdc: LONGINT; faceName: LONGINT; callback: EnumFontsProc; data: S.PTR);	EnumFontFamilies: PROCEDURE (hdc: LONGINT; family: LONGINT; callback: EnumFontsProc; data: S.PTR);	CreateFontIndirect: PROCEDURE (logfont: LogFontPtr): LONGINT;	GetTextMetrics: PROCEDURE (hdc: LONGINT; lptm: LONGINT): BOOLEAN;	StretchDIBits: PROCEDURE (hdc, dx, dy, dw, dh, sx, sy, sw, sh, bits, bmi, use, rop: LONGINT): LONGINT;	CreateDC: PROCEDURE (driver, device, output, initData: LONGINT): LONGINT;	AbortDoc: PROCEDURE (hdc: LONGINT);	(* ------------------ abstract printer interface -------------------- *)PROCEDURE (P: Printer) Open* (name, user: ARRAY OF CHAR; password: LONGINT);BEGIN HALT(99)END Open;PROCEDURE (P: Printer) Close*;BEGIN HALT(99)END Close;PROCEDURE (P: Printer) Page* (nofcopies: INTEGER);BEGIN HALT(99)END Page;PROCEDURE (P: Printer) ReplConst* (x, y, w, h: INTEGER);BEGIN HALT(99)END ReplConst;PROCEDURE (P: Printer) ReplPattern* (x, y, w, h: INTEGER; patno: INTEGER);BEGIN HALT(99)END ReplPattern;PROCEDURE (P: Printer) Line* (x0, y0, x1, y1: INTEGER);BEGIN HALT(99)END Line;PROCEDURE (P: Printer) Circle* (x0, y0, r: INTEGER);BEGIN HALT(99)END Circle;PROCEDURE (P: Printer) Ellipse* (x0, y0, a, b: INTEGER);BEGIN HALT(99)END Ellipse;PROCEDURE (P: Printer) Spline* (x0, y0, n, open: INTEGER; X, Y: ARRAY OF INTEGER);BEGIN HALT(99)END Spline;PROCEDURE (P: Printer) Picture* (x, y, w, h, mode: INTEGER; adr: LONGINT);BEGIN HALT(99)END Picture;PROCEDURE (P: Printer) UseListFont* (name: ARRAY OF CHAR);BEGIN HALT(99)END UseListFont;PROCEDURE (P: Printer) String* (x, y: INTEGER; str: ARRAY OF CHAR; VAR fname: ARRAY OF CHAR);BEGIN HALT(99)END String;PROCEDURE (P: Printer) ContString* (str: ARRAY OF CHAR; VAR fname: ARRAY OF CHAR);BEGIN HALT(99)END ContString;PROCEDURE (P: Printer) UseColor* (red, green, blue: INTEGER);BEGIN HALT(99)END UseColor;PROCEDURE (P: Printer) GetChar* (f: Fonts.Font; ch: CHAR; VAR dx, x, y, w, h: INTEGER);BEGIN HALT(99)END GetChar;	(* ------------------ standard printer implementation-------------------- *)PROCEDURE GetPrinterDC (P: StdPrinter; VAR hdc: LONGINT);	CONST PdReturnDefault = 10; PdReturnDC = 8;	VAR done: BOOLEAN;BEGIN	P.res := noconnection; hdc := NULL;	Win32.PD.hDevMode := NULL; Win32.PD.hDevNames := NULL;	Win32.PD.hdc := NULL;	Win32.PD.flags := {PdReturnDC};	IF printerName # "QuickDraw" THEN		Win32.PD.hdc := CreateDC(S.ADR("WINSPOOL"), S.ADR(printerName), 0, 0)	END ;	IF (printerName = "QuickDraw") OR (Win32.PD.hdc = 0) THEN		INCL(Win32.PD.flags, PdReturnDefault);		done := Win32.PrintDlg(S.ADR(Win32.PD))	END ;	hdc := Win32.PD.hdc;	IF hdc # NULL THEN P.res := noerr;		Win32.PageW := Win32.GetDeviceCaps(hdc, HORZRES); Win32.PageH := Win32.GetDeviceCaps(hdc, VERTRES);		Win32.Unit := Win32.GetDeviceCaps(hdc, HORSIZE);		Win32.Unit := Win32.Unit * 36000 DIV Win32.PageW;		IF ABS(Win32.Unit - Unit300) < 30 THEN			Win32.Unit := Unit300; (* assume 300 dpi printer *)		END ;		P.pageWidth := SHORT(Win32.PageW * Win32.Unit DIV Unit300);		P.pageHeight := SHORT(Win32.PageH * Win32.Unit DIV Unit300);	ELSE P.pageWidth := 0; P.pageHeight := 0; Win32.Unit := 0;	END ;END GetPrinterDC;PROCEDURE (P: StdPrinter) Open* (name, user: ARRAY OF CHAR; password: LONGINT);	CONST TABaseline = 24; TALeft = 0; transparent = 1;	VAR docname: ARRAY 32 OF CHAR; doc: DocInfo;BEGIN	IF hdc # NULL THEN AbortDoc(hdc) END ;	COPY(name, printerName);	GetPrinterDC(P, hdc);	IF hdc # NULL THEN		cachedFont := NIL; MFont := NIL; newPage := TRUE; Color := 0 (*black*);		SetMapMode(hdc, 1); (* Text mapping mode *)		Win32.SetTextAlign(hdc, TABaseline + TALeft);		Win32.SetBkMode(hdc, transparent);		docname := "Oberon for Windows Document";		doc.size := SIZE(DocInfo); doc.docName := S.ADR(docname); doc.outputName := NULL;		StartDoc(hdc, S.ADR(doc));	END ;END Open;PROCEDURE (P: StdPrinter) Close*;BEGIN	EndDoc(hdc);	Win32.DeleteDC(hdc); hdc := NULL; cachedFont := NIL; MFont := NIL; hfont := 0; Color := 0 (*black*);	P.pageWidth := 0; P.pageHeight := 0; Win32.Unit := 0;END Close;PROCEDURE (P: StdPrinter) Page* (nofcopies: INTEGER);BEGIN	EndPage(hdc); newPage := TRUE;END Page;PROCEDURE ^ InstallFont (name: ARRAY OF CHAR);PROCEDURE NewPage;	CONST TABaseline = 24; TALeft = 0; transparent = 1;BEGIN StartPage(hdc); newPage := FALSE;	IF cachedFont # NIL THEN		InstallFont(cachedFont.name); (* because some printers seem to loose font information on new pages *)	END ;	(* 17.6.95: re-initialize also other non-deafault settings of hdc *)	SetMapMode(hdc, 1); (* Text mapping mode *)	Win32.SetTextAlign(hdc, TABaseline + TALeft);	Win32.SetBkMode(hdc, transparent);	(* end modifications 17.6.95 *)END NewPage;PROCEDURE (P: StdPrinter) ReplConst* (x, y, w, h: INTEGER);	VAR obj: LONGINT; X, Y, W, H: LONGINT;BEGIN	IF newPage THEN NewPage END ;	X := LONG(x) * Unit300 DIV Win32.Unit; Y := LONG(y) * Unit300 DIV Win32.Unit;	W := LONG(w) * Unit300 DIV Win32.Unit; H := LONG(h) * Unit300 DIV Win32.Unit;	obj := Win32.CreateSolidBrush(Color); obj := Win32.SelectObject(hdc, obj); Win32.DeleteObject(obj);	Win32.PatBlt(hdc, X, Win32.PageH-Y-H, W, H, 0F00021H (*PATCOPY*));END ReplConst;PROCEDURE (P: StdPrinter) ReplPattern* (x, y, w, h: INTEGER; patno: INTEGER);	VAR obj: LONGINT; X, Y, W, H: LONGINT;BEGIN	IF newPage THEN NewPage END ;	X := LONG(x) * Unit300 DIV Win32.Unit; Y := LONG(y) * Unit300 DIV Win32.Unit;	W := LONG(w) * Unit300 DIV Win32.Unit; H := LONG(h) * Unit300 DIV Win32.Unit;	Win32.SetTextColor(hdc, Color);	CASE patno OF		| 2: obj := Win32.GetStockObject(1);		| 3: obj := Win32.GetStockObject(2);		| 4: obj := Win32.GetStockObject(3);		| 5: obj := Win32.GetStockObject(4);		| 6: obj := CreateHatchBrush(3, 0);		| 7: obj := CreateHatchBrush(2, 0);		| 8: obj := CreateHatchBrush(1, 0);		| 9: obj := CreateHatchBrush(0, 0);	ELSE obj := Win32.GetStockObject(0);	END ;	obj := Win32.SelectObject(hdc, obj); Win32.DeleteObject(obj);	Win32.PatBlt(hdc, X, Win32.PageH-Y-H, W, H, 0F00021H (*PATCOPY*));END ReplPattern;PROCEDURE (P: StdPrinter) Line* (x0, y0, x1, y1: INTEGER);	VAR obj: LONGINT; X0, Y0, X1, Y1: LONGINT;BEGIN	IF newPage THEN NewPage END ;	X0 := LONG(x0) * Unit300 DIV Win32.Unit; Y0 := LONG(y0) * Unit300 DIV Win32.Unit;	X1 := LONG(x1) * Unit300 DIV Win32.Unit; Y1 := LONG(y1) * Unit300 DIV Win32.Unit;	obj := CreatePen(0 (*solid pen*), 0 (*width 1 pixel*), Color);	obj := Win32.SelectObject(hdc, obj); Win32.DeleteObject(obj);	MoveToEx(hdc, X0, Win32.PageH-Y0, NULL);	LineTo(hdc, X1, Win32.PageH-Y1);END Line;PROCEDURE (P: StdPrinter) Circle* (x0, y0, r: INTEGER);	VAR obj: LONGINT; X0, Y0, R: LONGINT;BEGIN	IF newPage THEN NewPage END ;	X0 := LONG(x0) * Unit300 DIV Win32.Unit; Y0 := LONG(y0) * Unit300 DIV Win32.Unit; R := LONG(r) * Unit300 DIV Win32.Unit;	obj := Win32.GetStockObject(5); (*NULL_BRUSH*)	obj := Win32.SelectObject(hdc, obj); Win32.DeleteObject(obj);	obj := CreatePen(0 (*solid pen*), 0 (*width 1 pixel*), Color);	obj := Win32.SelectObject(hdc, obj); Win32.DeleteObject(obj);	Ellipse0(hdc, X0-R, Win32.PageH-(Y0+R), X0+R, Win32.PageH-(Y0-R));END Circle;PROCEDURE (P: StdPrinter) Ellipse* (x0, y0, a, b: INTEGER);	VAR obj: LONGINT; X0, Y0, A, B: LONGINT;BEGIN	IF newPage THEN NewPage END ;	X0 := LONG(x0) * Unit300 DIV Win32.Unit; Y0 := LONG(y0) * Unit300 DIV Win32.Unit;	A := LONG(a) * Unit300 DIV Win32.Unit; B := LONG(b) * Unit300 DIV Win32.Unit;	obj := Win32.GetStockObject(5); (*NULL_BRUSH*)	obj := Win32.SelectObject(hdc, obj); Win32.DeleteObject(obj);	obj := CreatePen(0 (*solid pen*), 0 (*width 1 pixel*), Color);	obj := Win32.SelectObject(hdc, obj); Win32.DeleteObject(obj);	Ellipse0(hdc, X0-A, Win32.PageH-(Y0+B), X0+A, Win32.PageH-(Y0-B));END Ellipse;PROCEDURE ShowPoly (VAR p, q: Poly; lim: REAL; first: BOOLEAN);	VAR t: REAL; x, y, x1, y1: LONGINT;BEGIN t := 0;	x1 := ENTIER(p.d); y1 := ENTIER(q.d);	IF first THEN MoveToEx(hdc, x1, Win32.PageH-y1, NULL) END ;	REPEAT		x := ENTIER(((p.a * t + p.b) * t + p.c) * t + p.d);		y := ENTIER(((q.a * t + q.b) * t + q.c) * t + q.d);		IF (x1-x)*(x1-x)+(y1-y)*(y1-y) > 200 THEN			LineTo(hdc, x, Win32.PageH-y); x1 := x; y1 := y;		END ;		t := t + 1.0	UNTIL t >= lim;	IF (x#x1) OR (y#y1) THEN LineTo(hdc, x, Win32.PageH-y) END ;END ShowPoly;PROCEDURE SolveTriDiag(VAR a, b, c, y: RealVector; n: INTEGER);	VAR i: INTEGER; r: REAL;	(* simplified expressions for iOP2 *)BEGIN (*a, b, c of tri-diag matrix T; solve Ty' = y for y', assign y' to y*)	i := 1;	WHILE i < n DO r := y[i] - c[i-1]*y[i-1]; y[i] := r; (*y[i] := y[i] - c[i-1]*y[i-1];*) INC(i) END ;	i := n-1; y[i] := y[i]/a[i];	WHILE i > 0 DO DEC(i); r := (y[i] - b[i]*y[i+1]); y[i] := r/a[i]; (*y[i] := (y[i] - b[i]*y[i+1])/a[i]*) ENDEND SolveTriDiag;PROCEDURE OpenSpline(VAR x, y, d: RealVector; n: INTEGER);	VAR i: INTEGER; d1, d2: REAL;		a, b, c: RealVector;BEGIN (*from x, y compute d = y'*)	b[0] := 1.0/(x[1] - x[0]); a[0] := 2.0*b[0]; c[0] := b[0];	d1 := (y[1] - y[0])*3.0*b[0]*b[0]; d[0] := d1; i := 1;	WHILE i < n-1 DO		b[i] := 1.0/(x[i+1] - x[i]);		a[i] := 2.0*(c[i-1] + b[i]);		c[i] := b[i];		d2 := (y[i+1] - y[i])*3.0*b[i]*b[i];		d[i] := d1 + d2; d1 := d2; INC(i)	END ;	a[i] := 2.0*b[i-1]; d[i] := d1; i := 0;	WHILE i < n-1 DO c[i] := c[i]/a[i]; a[i+1] := a[i+1] - c[i]*b[i]; INC(i) END ;	SolveTriDiag(a, b, c, d, n)END OpenSpline;PROCEDURE ClosedSpline(VAR x, y, d: RealVector; n: INTEGER);	VAR i: INTEGER; d1, d2, hn, dn: REAL;		a, b, c, w: RealVector;BEGIN (*from x, y compute d = y'*)	hn := 1.0/(x[n-1] - x[n-2]);	dn := (y[n-1] - y[n-2])*3.0*hn*hn;	b[0] := 1.0/(x[1] - x[0]);	a[0] := 2.0*b[0] + hn;	c[0] := b[0];	d1 := (y[1] - y[0])*3.0*b[0]*b[0]; d[0] := dn + d1;	w[0] := 1.0; i := 1;	WHILE i < n-2 DO		b[i] := 1.0/(x[i+1] - x[i]);		a[i] := 2.0*(c[i-1] + b[i]);		c[i] := b[i];		d2 := (y[i+1] - y[i])*3.0*b[i]*b[i]; d[i] := d1 + d2; d1 := d2;		w[i] := 0; INC(i)	END ;	a[i] := 2.0*b[i-1] + hn; d[i] := d1 + dn;	w[i] := 1.0; i := 0;	WHILE i < n-2 DO c[i] := c[i]/a[i]; a[i+1] := a[i+1] - c[i]*b[i]; INC(i) END ;	SolveTriDiag(a, b, c, d, n-1); SolveTriDiag(a, b, c, w, n-1);	d1 := (d[0] + d[i])/(w[0] + w[i] + x[i+1] - x[i]); i := 0;	WHILE i < n-1 DO d[i] := d[i] - d1*w[i]; INC(i) END ;	d[i] := d[0]END ClosedSpline;PROCEDURE (P: StdPrinter) Spline* (x0, y0, n, open: INTEGER; X, Y: ARRAY OF INTEGER);	VAR i: INTEGER; dx, dy, ds: REAL;		x, xd, y, yd, s: RealVector;		p, q: PolyVector;		obj: LONGINT; first: BOOLEAN;BEGIN	IF newPage THEN NewPage END ;	x0 := SHORT(LONG(x0) * Unit300 DIV Win32.Unit); y0 := SHORT(LONG(y0) * Unit300 DIV Win32.Unit);	i := 0;	WHILE i < n DO		X[i] := SHORT(LONG(X[i]) * Unit300 DIV Win32.Unit); Y[i] := SHORT(LONG(Y[i]) * Unit300 DIV Win32.Unit);	END ;	obj := CreatePen(0 (*solid pen*), 0 (*width 1 pixel*), Color);	obj := Win32.SelectObject(hdc, obj); Win32.DeleteObject(obj);	x[0] := X[0] + x0; y[0] := Y[0] + y0; s[0] := 0; i := 1;	WHILE i < n DO		x[i] := X[i] + x0; dx := x[i] - x[i-1];		y[i] := Y[i] + y0; dy := y[i] - y[i-1];		s[i] := ABS(dx) + ABS(dy) + s[i-1]; INC(i)	END ;	IF open = 1 THEN OpenSpline(s, x, xd, n); OpenSpline(s, y, yd, n)	ELSE ClosedSpline(s, x, xd, n); ClosedSpline(s, y, yd, n)	END ;	(*compute coefficients from x, y, xd, yd, s*)	i := 0;	WHILE i < n-1 DO		ds := 1.0/(s[i+1] - s[i]);		dx := (x[i+1] - x[i])*ds;		p[i].a := ds*ds*(xd[i] + xd[i+1] - 2.0*dx);		p[i].b := ds*(3.0*dx - 2.0*xd[i] -xd[i+1]);		p[i].c := xd[i];		p[i].d := x[i];		p[i].t := s[i];		dy := ds*(y[i+1] - y[i]);		q[i].a := ds*ds*(yd[i] + yd[i+1] - 2.0*dy);		q[i].b := ds*(3.0*dy - 2.0*yd[i] - yd[i+1]);		q[i].c := yd[i];		q[i].d := y[i];		q[i].t := s[i]; INC(i)	END ;	p[i].t := s[i]; q[i].t := s[i];	(*display polynomials*)	i := 0; first := TRUE;	WHILE i < n-1 DO ShowPoly(p[i], q[i], p[i+1].t - p[i].t, first); INC(i); first := FALSE ENDEND Spline;PROCEDURE (P: StdPrinter) Picture* (x, y, w, h, mode: INTEGER; hbitmap: LONGINT);	CONST		DIBPALCOLORS = 1; DIBRGBCOLORS = 0; SRCCOPY = 0CC0020H;		PalSize = 256;	TYPE	RGBColor = RECORD blue, green, red, flag: CHAR END ;	BMPInfoHeader = RECORD			size, width, height: LONGINT;		planes, bits: INTEGER;		compression, sizeImage, xPelsPerMeter, yPelsPerMeter, clrUsed, clrImportant: LONGINT	END ;	BMPInfoColorTable = RECORD (BMPInfoHeader)		color: ARRAY 256 OF RGBColor	END ;	Picture = POINTER TO PictureDesc;		PictureDesc = RECORD		width, height, depth: INTEGER;	(* width, height in pixels, and depth in bits per pixel (1, 4, 8, 16, 24, or 32). *)		nofCols: LONGINT;	(* number of colors used (<= ASH(1, depth) *)		address: LONGINT;      (* address of bitmap data *)		handle: LONGINT;	(* handle to bitmap data, if allocated with GlobalAlloc *)		ptr: S.PTR;	(* pointer to bitmap data, if allocated with S.NEW *)		(*			depth	bits stored sequentially			1	each pixel is represented by one bit, bit is index in palette (not set => palIdx 0, set => palIdx 1)			4	each pixel is represented by 4 bits, bits are index in palette (0..15)			8	each pixel is represented by one byte, byte is index in palette (0..255)			16	each pixel is represented by two bytes			24	each pixel is represented by three bytes			32	each pixel is represented by four bytes		*)		wth: LONGINT;	(* width of one line of pixels including padding bits, in bytes *)		bmi: BMPInfoColorTable;		flags: SET;	(* palChanged IN flags, iff bmi.palette changed after initialisation,								bitsChanged IN flags iff SetPixel, ReplConst, or Copy has been performed								dithered IN flags iff picture has been dithered *)		f: LONGINT;	(* Files.File *)		col: INTEGER;		rgb: RGBColor;		rMask, gMask, bMask: SET	(* used for bmi.compression = BIBitFields *)	END ;	VAR dummy: LONGINT; p: Picture; X, Y, W, H: LONGINT;BEGIN	p := S.VAL(Picture, hbitmap);	X := LONG(x) * Unit300 DIV Win32.Unit; Y := LONG(y) * Unit300 DIV Win32.Unit;	W := LONG(w) * Unit300 DIV Win32.Unit; H := LONG(h) * Unit300 DIV Win32.Unit;	dummy := StretchDIBits(hdc, X, Win32.PageH - (H + Y), W, H, 0, 0, p.width, p.height, p.address,		S.ADR(p.bmi), DIBRGBCOLORS, SRCCOPY)END Picture;PROCEDURE (P: StdPrinter) UseListFont* (name: ARRAY OF CHAR); (* not implemented *)END UseListFont;PROCEDURE matches (s1, s2: ARRAY OF CHAR): BOOLEAN;	VAR i: INTEGER;BEGIN i := 0;	WHILE s1[i] # 0X DO		IF CAP(s1[i]) # CAP(s2[i]) THEN RETURN FALSE END ;		INC(i)	END ;	RETURN (s2[i] = 0X) OR (s2[i] = " ");END matches;PROCEDURE TTFontInstaller (f: LogFontPtr; tm: LPTEXTMETRIC; type: SET; raster: Win32.Font): LONGINT;	VAR EBX, ESI, EDI, res: LONGINT;BEGIN	S.GETREG(3, EBX); S.GETREG(6, ESI); S.GETREG(7, EDI); res := 1;	IF TrueType IN type THEN		IF (family = f.facename) & ((italics IN raster.style) = (f.italic # 0)) & ((bold IN raster.style) = (f.weight > 400)) THEN(*formerly used:			f.height := -(raster.size * ScreenUnit * 100 DIV Win32.Unit DIV 94);*)			f.height := -(raster.size * LONG(12700) DIV Win32.Unit);			(* is the same as -(raster.size * Win32.GetDeviceCaps(hdc, 90) DIV 72) *)			f.width := 0; res := 0;			hfont := CreateFontIndirect(f);		END ;	END ;	S.PUTREG(3, EBX); S.PUTREG(6, ESI); S.PUTREG(7, EDI);	RETURN res;END TTFontInstaller;PROCEDURE TTFontFamiliyHandler (f: LogFontPtr; tm: LPTEXTMETRIC; type: SET; raster: Win32.Font): LONGINT;	VAR EBX, ESI, EDI, res: LONGINT;BEGIN	S.GETREG(3, EBX); S.GETREG(6, ESI); S.GETREG(7, EDI); res := 1;	IF (TrueType IN type) & matches(family, f.facename) THEN COPY(f.facename, family); res := 0 END ;	S.PUTREG(3, EBX); S.PUTREG(6, ESI); S.PUTREG(7, EDI);	RETURN res;END TTFontFamiliyHandler;PROCEDURE MapFont (family: ARRAY OF CHAR; VAR replacement: ARRAY OF CHAR);	VAR i: INTEGER;BEGIN	COPY(family, replacement); i := 0;	WHILE (Map[i].family # "") & (i < MapSize) DO		IF family = Map[i].family THEN COPY(Map[i].subst, replacement); RETURN END ;		INC(i);	END ;END MapFont;PROCEDURE InstallFont (name: ARRAY OF CHAR);	VAR F: Fonts.Font; raster: Win32.Font; oldfont: LONGINT; ret: BOOLEAN;BEGIN	F := Fonts.This(name); raster := S.VAL(Win32.Font, F.raster);	MapFont(raster.family, family);	EnumFontFamilies(hdc, 0, TTFontFamiliyHandler, NIL);	EnumFonts(hdc, S.ADR(family), TTFontInstaller, raster);	IF hfont # NULL THEN		oldfont := Win32.SelectObject(hdc, hfont); Win32.DeleteObject(oldfont); cachedFont := F;		ret := GetTextMetrics(hdc, S.ADR(cachedMetrics));	END ;END InstallFont;PROCEDURE- RetVal (): BOOLEAN;PROCEDURE SpecialString (X, Y: LONGINT; VAR s: ARRAY OF CHAR; f: Fonts.Font; VAR width: LONGINT);	VAR p: Win32.PatternPtr; i, dx, xp, yp, w, h: INTEGER; dmmy, pat: LONGINT; hdcMem: LONGINT;		colref: LONGINT;BEGIN	hdcMem := Win32.CreateCompatibleDC(Win32.PD.hdc);	i := 0; width := 0;	WHILE s[i] # 0X DO		Display.GetChar(f.raster, s[i], dx, xp, yp, w, h, pat);		p := S.VAL(Win32.PatternPtr, pat);		colref := Win32.ColorRef(Display.white);		Win32.SetBackgCol(colref); Win32.SetTextCol(Win32.Backg);		dmmy := Win32.SelectObject(hdcMem, p.bitmap);(*		Win32.BitBlt(hdc, X+xp, Win32.PageH-(Y+yp+p.h), w, h, hdcMem, p.x, p.y, 0220326H);		IF ~RetVal() THEN ShowError.Do("Printers.SpecialString (BitBlt)") END ;*)		IF ~StretchBlt(hdc, X+xp, Win32.PageH-(Y+yp+p.h), w, h, hdcMem, p.x, p.y, w, h, 0220326H) THEN			ShowError.Do("Printers.SpecialString (StretchBlt)")		END ;		INC(X, LONG(dx)); INC(width, LONG(dx));		INC(i);	END ;	Win32.DeleteDC(hdcMem);END SpecialString;PROCEDURE isFamily (VAR fname: ARRAY OF CHAR; family: ARRAY OF CHAR): BOOLEAN;	VAR i: INTEGER;BEGIN i := 0;	WHILE family[i] # 0X DO		IF family[i] # fname[i] THEN RETURN FALSE END ;		INC(i);		END ;	RETURN TRUE;END isFamily;PROCEDURE BuildPr3Name (VAR fname, pfname: ARRAY OF CHAR);	VAR ext: ARRAY 12 OF CHAR; i, j: INTEGER;BEGIN	ext := ".Pr3.Fnt"; i := 0; j := 0;	WHILE (fname[i] # ".") & (fname[i] # 0X) DO pfname[i] := fname[i]; INC(i) END ;	WHILE ext[j] # 0X DO pfname[i] := ext[j]; INC(i); INC(j) END ;END BuildPr3Name;PROCEDURE TranslateString (VAR s: ARRAY OF CHAR);	VAR i: INTEGER;BEGIN	IF cachedFont # NIL THEN i := 0;		WHILE s[i] # 0X DO			s[i] := Win32.OberonToWin[ORD(s[i])]; INC(i)		END	ENDEND TranslateString;(*PROCEDURE TranslateString (VAR s: ARRAY OF CHAR);	VAR i: INTEGER; f: Win32.Font; translateS: BOOLEAN;BEGIN	IF cachedFont # NIL THEN i := 0;		IF isFamily(cachedFont.name, "Syntax") THEN			f := S.VAL(Win32.Font, cachedFont.raster);			translateS := f.oberon		ELSE translateS := FALSE		END ;		WHILE s[i] # 0X DO			IF translateS THEN				CASE ORD(s[i]) OF					170: s[i] := CHR(150)				| 150: s[i] := CHR(151)				ELSE				END			ELSE				s[i] := Win32.OberonToWin[ORD(s[i])]; INC(i)			END		END	ENDEND TranslateString;*)PROCEDURE (P: StdPrinter) String* (x, y: INTEGER; str: ARRAY OF CHAR; VAR fname: ARRAY OF CHAR);	VAR Y: LONGINT; (* in device coordinates *) len: LONGINT;		W: LONGINT; (* in 300 dpi *) size: Size; pfname: ARRAY 32 OF CHAR; ret: BOOLEAN;BEGIN	IF newPage THEN NewPage END ;	Y := LONG(y) * Unit300 DIV Win32.Unit;	IF isFamily(fname, "Elektra") OR isFamily(fname, "Math") THEN		BuildPr3Name(fname, pfname);		SpecialString(LONG(x) * Unit300 DIV Win32.Unit, Y, str, Fonts.This(pfname), W);		textX := x + W	ELSE		IF (cachedFont = NIL) OR (cachedFont.name # fname) THEN InstallFont(fname) END ;		TranslateString(str);		Win32.SetTextColor(hdc, Color);		len := 0; W := 0;		WHILE str[len] # 0X DO			ret := GetTextExtentPoint(hdc, S.ADR(str[len]), 1, S.ADR(size));			INC(W, ENTIER(size.w * Win32.Unit / Unit300 + 0.5)); INC(len)		END ;		ret := GetTextExtentPoint(hdc, S.ADR(str), len, S.ADR(size));		IF ABS(ENTIER(size.w * Win32.Unit / Unit300 + 0.5) - W) > 2 THEN			(* print characterwise if difference in length is greater than 2 300dpi pixels *)			len := 0; textX := x;			WHILE str[len] # 0X DO				Win32.TextOut(hdc, ENTIER(textX * Unit300 / Win32.Unit + 0.5), Win32.PageH-Y, S.ADR(str[len]), 1);				ret := GetTextExtentPoint(hdc, S.ADR(str[len]), 1, S.ADR(size));				INC(textX, ENTIER(size.w * Win32.Unit / Unit300 + 0.5)); INC(len)			END ;		ELSE (* print whole string as one *)			Win32.TextOut(hdc, ENTIER(LONG(x) * Unit300 / Win32.Unit + 0.5), Win32.PageH-Y, S.ADR(str), len);			textX := x + ENTIER(size.w * Win32.Unit / Unit300 + 0.5)		END	END ;	textY := yEND String;PROCEDURE (P: StdPrinter) ContString* (str: ARRAY OF CHAR; VAR fname: ARRAY OF CHAR);BEGIN P.String(SHORT(textX), SHORT(textY), str, fname) END ContString;PROCEDURE (P: StdPrinter) UseColor* (red, green, blue: INTEGER);BEGIN Color := 10000H * (blue MOD 256) + 100H * (green MOD 256) + (red MOD 256) END UseColor;PROCEDURE (P: StdPrinter) GetChar* (f: Fonts.Font; ch: CHAR; VAR dx, x, y, w, h: INTEGER); (* 300 dpi metrics *)	VAR i, n: INTEGER; opened: BOOLEAN; ret: BOOLEAN; f1: Fonts.Font; pat: LONGINT; c: CHAR; size: Size;		pfname: ARRAY 32 OF CHAR;BEGIN	IF f.name = "Elektra.Scn.Fnt" THEN f1 := Fonts.This("Elektra.Pr3.Fnt");		Display.GetChar(f1.raster, ch, dx, x, y, w, h, pat);		RETURN	ELSIF isFamily(f.name, "Math") THEN		BuildPr3Name(f.name, pfname); f1 := Fonts.This(pfname);		Display.GetChar(f1.raster, ch, dx, x, y, w, h, pat);		RETURN	END ;	opened := FALSE;	IF MFont # f THEN		IF hdc = NULL THEN opened := TRUE; GetPrinterDC(P, hdc) END ;		IF hdc # NULL THEN			InstallFont(f.name); i := 0;			WHILE i < 256 DO				IF (ORD(cachedMetrics.firstCh) <= i) & (i <= ORD(cachedMetrics.lastCh)) THEN					c := CHR(i);					ret := GetTextExtentPoint(hdc, S.ADR(c), 1, S.ADR(size)); sizes[i] := size;					ASSERT(ret)				ELSE sizes[i].w := 0; sizes[i].h := 0;				END ;				INC(i)			END ;			MFont := f;			IF opened THEN Win32.DeleteDC(hdc); hdc := NULL; cachedFont := NIL; hfont := 0 END ;		END	END ;	IF MFont = f THEN		n := ORD(Win32.OberonToWin[ORD(ch)]);		dx := SHORT(ENTIER(sizes[n].w * Win32.Unit / Unit300 + 0.5)); h := SHORT(sizes[n].h * Win32.Unit DIV Unit300); x := 0; w := dx;		y := -SHORT(cachedMetrics.descent * Win32.Unit DIV Unit300);	ELSE (* use screen font metrics and calculate metrics for a 300 dpi printer*)		Display.GetChar(f.raster, ch, dx, x, y, w, h, pat);		dx := SHORT(LONG(dx) * ScreenUnit DIV Unit300);		x := SHORT(LONG(x) * ScreenUnit  DIV Unit300); y := SHORT(LONG(y) * ScreenUnit DIV Unit300);		w := SHORT(LONG(w) * ScreenUnit DIV Unit300); h := SHORT(LONG(h) * ScreenUnit DIV Unit300);	ENDEND GetChar;PROCEDURE InitFontMapping;	VAR i, e: INTEGER; val: ARRAY 256 OF CHAR;	PROCEDURE SkipBlanks;	BEGIN WHILE (val[i] <= " ") & (val[i] # 0X) DO INC(i) END ;	END SkipBlanks;	PROCEDURE ReadName(VAR name: ARRAY OF CHAR);		VAR j: INTEGER;	BEGIN		SkipBlanks; j := 0;		WHILE (val[i] # 0X) & (val[i] # ";") & (val[i] > " ") DO name[j] := val[i]; INC(j); INC(i) END ;		name[j] := 0X;	END ReadName;BEGIN	Registry.Get("System", "Fontsubst", val);	i := 0; e := 0;	LOOP SkipBlanks;		IF val[i] = 0X THEN EXIT END ;		ReadName(Map[e].family); SkipBlanks;		IF (val[i] # 0X) THEN ReadName(Map[e].subst); SkipBlanks;		ELSE Map[e].family := ""; EXIT		END ;		INC(e);		IF val[i] = ";" THEN INC(i); ELSE EXIT END ;	END ;	(* standard substitutions: *)	Map[e].family := "Syntax"; Map[e].subst := "Arial"; INC(e);	Map[e].family := "Syndor"; Map[e].subst := "Arial"; INC(e);	WHILE e < MapSize DO Map[e].family := ""; Map[e].subst := ""; INC(e) END ;END InitFontMapping;PROCEDURE Init;	VAR mod: LONGINT;BEGIN	hdc := NULL; cachedFont := NIL; MFont := NIL;	mod := Kernel.LoadLibrary("GDI32");	Kernel.GetAdr(mod, "SetMapMode", S.VAL(LONGINT, SetMapMode));	Kernel.GetAdr(mod, "MoveToEx", S.VAL(LONGINT, MoveToEx));	Kernel.GetAdr(mod, "LineTo", S.VAL(LONGINT, LineTo));	Kernel.GetAdr(mod, "Ellipse", S.VAL(LONGINT, Ellipse0));	Kernel.GetAdr(mod, "CreateHatchBrush", S.VAL(LONGINT, CreateHatchBrush));	Kernel.GetAdr(mod, "CreatePen", S.VAL(LONGINT, CreatePen));	Kernel.GetAdr(mod, "StartDocA", S.VAL(LONGINT, StartDoc));	Kernel.GetAdr(mod, "EndDoc", S.VAL(LONGINT, EndDoc));	Kernel.GetAdr(mod, "StartPage", S.VAL(LONGINT, StartPage));	Kernel.GetAdr(mod, "EndPage", S.VAL(LONGINT, EndPage));	Kernel.GetAdr(mod, "GetTextExtentPointA", S.VAL(LONGINT, GetTextExtentPoint));	Kernel.GetAdr(mod, "EnumFontsA", S.VAL(LONGINT, EnumFonts));	Kernel.GetAdr(mod, "EnumFontFamiliesA", S.VAL(LONGINT, EnumFontFamilies));	Kernel.GetAdr(mod, "CreateFontIndirectA", S.VAL(LONGINT, CreateFontIndirect));	Kernel.GetAdr(mod, "GetTextMetricsA", S.VAL(LONGINT, GetTextMetrics));	Kernel.GetAdr(mod, "GetObjectA", S.VAL(LONGINT, GetObject));	Kernel.GetAdr(mod, "GetDIBits", S.VAL(LONGINT, GetDIBits));(*	Kernel.GetAdr(mod, "GetCharWidthA", S.VAL(LONGINT, GetCharWidth));*)	Kernel.GetAdr(mod, "StretchDIBits", S.VAL(LONGINT, StretchDIBits));	Kernel.GetAdr(mod, "StretchBlt", S.VAL(LONGINT, StretchBlt));	Kernel.GetAdr(mod, "CreateDCA", S.VAL(LONGINT, CreateDC));	Kernel.GetAdr(mod, "AbortDoc", S.VAL(LONGINT, AbortDoc));END Init;	(* --------- installing and de-installing of printers ------------- *)PROCEDURE Install* (P: Printer);BEGIN Current := P;END Install;PROCEDURE InstallDefault*;BEGIN Current := StdPrt;END InstallDefault;BEGIN	NEW(StdPrt); Current := StdPrt; printerName := "QuickDraw";	Init; InitFontMapping;END Printers.