implement Print; include "sys.m";	sys: Sys;include "draw.m";	draw: Draw;	Display, Font, Rect, Point, Image, Screen: import draw;include "bufio.m";	bufio: Bufio;include "string.m";	str: String;	include "print.m"; MAXNAME: con 80;DEFMODE: con 8r664; PAPER_CONFIG: con CONFIG_PATH + "paper.cfg";PTYPE_CONFIG: con CONFIG_PATH + "ptype.cfg";PMODE_CONFIG: con CONFIG_PATH + "pmode.cfg";POPT_CONFIG: con CONFIG_PATH + "popt.cfg";PRINTER_CONFIG: con CONFIG_PATH + "printer.cfg";DEFPRINTER: con CONFIG_PATH + "defprinter";  Cfg: adt {	name: string;	pairs: list of (string, string);}; DEBUG :=0;  all_papers: list of ref Paper;all_pmodes: list of ref Pmode;all_ptypes: list of ref Ptype;all_popts: list of ref Popt;all_printers: list of ref Printer;default_printer: ref Printer;stderr: ref Sys->FD;printfd: ref Sys->FD; # Initialization init(): int{	sys = load Sys Sys->PATH;	stderr = sys->fildes(2);	draw = load Draw Draw->PATH;	bufio = load Bufio Bufio->PATH;	str = load String String->PATH;	all_papers = read_paper_config();	if (all_papers == nil) return 1;	all_pmodes = read_pmode_config();	if (all_pmodes == nil) return 1;	all_ptypes = read_ptype_config();	if (all_ptypes == nil) return 1;	all_printers = read_printer_config();	if (all_printers == nil) return 1;	all_popts = read_popt_config();	for (pl:=all_printers; pl!=nil; pl=tl pl) {		p := hd pl;		opt := find_popt(all_popts, p.name);		if (opt != nil) p.popt = opt;		else {			p.popt = ref Popt (p.name, hd all_pmodes, hd all_papers, 0, 0);			all_popts = p.popt :: all_popts;		}	}	return 0;} # Set printer FD set_printfd(fd: ref Sys->FD){	printfd = fd;	}  # Get default printer get_defprinter(): ref Printer{	if (len all_printers == 1) return hd all_printers;		# If there's only 1 printer	df := sys->open(DEFPRINTER, Sys->OREAD);	if (df == nil) {		if (all_printers != nil) return hd all_printers;		else return nil;	}	a := array[MAXNAME] of byte;	nb := sys->read(df, a, MAXNAME);	if (nb < 2) return nil;	name := string a[:nb-1];	def := find_printer(all_printers, name);	if (def != nil) return def;	else return hd all_printers;} # Set default printer set_defprinter(p: ref Printer){	df := sys->create(DEFPRINTER, Sys->OWRITE, DEFMODE);	if (df == nil) return;	sys->fprint(df, "%s\n", p.name);} # Set paper size get_size(p: ref Printer): (int, int, int)	# dpi, xpixels, ypixels{	if (p == nil) return (0, 0, 0);	load_driver(p);	dpi := p.popt.mode.resx;	(xpix, ypix) := p.pdriver->printable_pixels(p);	# This takes account of orientation	return (dpi, xpix, ypix);}   # Get list of all printers get_printers(): list of ref Printer{	return all_printers;} # Return list of printer types get_ptypes(): list of ref Ptype{	return all_ptypes;} # Return list of print modes get_pmodes(): list of ref Pmode{	return all_pmodes;} # Return list of paper types get_papers(): list of ref Paper{	return all_papers;} # Return list of print options get_popts(): list of ref Popt{	return all_popts;} # Save option settings save_settings(): int{	return write_popt_config(all_popts); }  # Print an image print_image(p: ref Printer, display: ref Draw->Display, im: ref Draw->Image, pcwidth: int, cancel: chan of int): int{	if (p == nil || im == nil) return 1;	load_driver(p);	popen(p);	(xpix, ypix) := p.pdriver->printable_pixels(p);	imwidth := im.r.max.x - im.r.min.x;	imheight := im.r.max.y - im.r.min.y;	if (pcwidth > 0) pixwidth := int (real xpix * real pcwidth/100.0);	else pixwidth = imwidth;	lmar := (xpix - pixwidth)/2;	fpixwidth := pixwidth;	if (p.popt.orientation != PORTRAIT) {		lmar += pixwidth;		fpixwidth = pixwidth*imheight/imwidth;	}	if (lmar < 0) lmar = 0;	return p.pdriver->sendimage(p, printfd, display, im, fpixwidth, lmar, cancel);} # Print text print_textfd(p: ref Printer, fd: ref Sys->FD, ps: real, pr: int, wrap: int): int{	load_driver(p);	popen(p);	return p.pdriver->sendtextfd(p, printfd, fd, ps, pr, wrap); }  # Open printer device if necessary popen(p: ref Printer){	if (printfd != nil) return;	printfd = sys->create(p.device, Sys->OWRITE, DEFMODE);} # Find printer item find_printer(all: list of ref Printer, name: string): ref Printer{	for (p:=all; p!=nil; p=tl p) if ((hd p).name == name) return hd p;	return nil;} # Find popt item find_popt(all: list of ref Popt, name: string): ref Popt{	for (p:=all; p!=nil; p=tl p) if ((hd p).name == name) return hd p;	return nil;}  # Find paper item find_paper(all: list of ref Paper, name: string): ref Paper{	for (p:=all; p!=nil; p=tl p) if ((hd p).name == name) return hd p;	return nil;} # Find pmode item find_pmode(all: list of ref Pmode, name: string): ref Pmode{	for (p:=all; p!=nil; p=tl p) if ((hd p).name == name) return hd p;	return nil;} # Find ptype item find_ptype(all: list of ref Ptype, name: string): ref Ptype{	for (p:=all; p!=nil; p=tl p) if ((hd p).name == name) return hd p;	return nil;}  # Read paper config file read_paper_config(): list of ref Paper{	(clist, aliases) := read_config(PAPER_CONFIG);	rlist: list of ref Paper;	while (clist != nil) {		this := hd clist;		clist = tl clist;		item := ref Paper(this.name, "", 0.0, 0.0);		for (pairs:= this.pairs; pairs != nil; pairs = tl pairs) {			(name, value) := hd pairs;			case (name) {				"hpcode" =>					item.hpcode = value; 				"width_inches" =>					item.width_inches = real value; 				"height_inches" =>					item.height_inches = real value; 				* =>					sys->fprint(stderr, "Unknown paper config file option: %s\n", name);			}		}		rlist =item :: rlist;	}	for (al:=aliases; al!=nil; al=tl al) {		(new, old) := hd al;		olda := find_paper(rlist, old);		if (olda == nil) sys->fprint(stderr, "Paper alias %s not found\n", old);		else {			newa := ref *olda;			newa.name = new;			rlist = newa :: rlist;			}	}	return rlist;}  # Read pmode config file read_pmode_config(): list of ref Pmode{	(clist, aliases)  := read_config(PMODE_CONFIG);	rlist: list of ref Pmode;	while (clist != nil) {		this := hd clist;		clist = tl clist;		item := ref Pmode(this.name, "", 0, 0, 1, 1, 1);		for (pairs:= this.pairs; pairs != nil; pairs = tl pairs) {			(name, value) := hd pairs;			case (name) {				"desc" =>					item.desc = value; 				"resx" =>					item.resx = int value; 				"resy" =>					item.resy = int value; 				"coldepth" =>					item.coldepth = int value; 				"blackdepth" =>					item.blackdepth = int value; 				"blackresmult" =>					item.blackresmult = int value; 				* =>					sys->fprint(stderr, "Unknown pmode config file option: %s\n", name); 			}		}		rlist =item :: rlist;	}	for (al:=aliases; al!=nil; al=tl al) {		(new, old) := hd al;		olda := find_pmode(rlist, old);		if (olda == nil) sys->fprint(stderr, "Pmode alias %s not found\n", old);		else {			newa := ref *olda;			newa.name = new;			rlist = newa :: rlist;			}	}	return rlist;}    # Readp Ptype config file read_ptype_config(): list of ref Ptype{	(clist, aliases)  := read_config(PTYPE_CONFIG);	rlist: list of ref Ptype;	while (clist != nil) {		this := hd clist;		clist = tl clist;		item := ref Ptype(this.name, "", nil, "", "");		for (pairs:= this.pairs; pairs != nil; pairs = tl pairs) {			(name, value) := hd pairs;			case (name) {				"desc" =>					item.desc = value; 				"driver" =>					item.driver = value; 				"hpmapfile" =>					item.hpmapfile = value; 				"modes" =>					item.modes = make_pmode_list(value); 				* =>					sys->fprint(stderr, "Unknown ptype config file option: %s\n", name);			}		}		if (item.modes == nil) {			sys->fprint(stderr, "No print modes for ptype %s\n", item.name);			continue;		}					rlist = item :: rlist;	}	for (al:=aliases; al!=nil; al=tl al) {		(new, old) := hd al;		olda := find_ptype(rlist, old);		if (olda == nil) sys->fprint(stderr, "Ptype alias %s not found\n", old);		else {			newa := ref *olda;			newa.name = new;			rlist = newa :: rlist;			}	}	return rlist;}  # Make a list of pmodes from a string make_pmode_list(sl: string): list of ref Pmode{	pml: list of ref Pmode;	(n, toks) := sys->tokenize(sl, " \t");	if (n == 0) return nil;	for (i:=0; i<n; i++) {		pms := hd toks;		toks = tl toks;		pm := find_pmode(all_pmodes, pms);		if (pm == nil) {			sys->fprint(stderr, "unknown pmode: %s\n", pms);			continue;		}		pml = pm :: pml;	}	return pml;}  # Read popt config file read_popt_config(): list of ref Popt{	(clist, aliases)  := read_config(POPT_CONFIG);	rlist: list of ref Popt;	while (clist != nil) {		this := hd clist;		clist = tl clist;		item := ref Popt(this.name, nil, nil, 0, 0);		for (pairs:= this.pairs; pairs != nil; pairs = tl pairs) {			(name, value) := hd pairs;			case (name) { 				"mode" =>					item.mode = find_pmode(all_pmodes, value);					if (item.mode == nil) sys->fprint(stderr, "Config error: Pmode not found: %s\n", value); 				"paper" =>					item.paper = find_paper(all_papers, value);					if (item.paper == nil) sys->fprint(stderr, "Config error: paper not found: %s\n", value); 				"orientation" =>					item.orientation = int value;				"duplex" =>					item.duplex = int value; 				* =>					sys->fprint(stderr, "Unknown popt config file option: %s\n", name);			}		}		if (item.mode == nil) {			sys->fprint(stderr, "No print mode for printer %s\n", item.name);			continue;		}					if (item.paper == nil) {			sys->fprint(stderr, "No paper size for printer %s\n", item.name);			continue;		}					rlist = item :: rlist;	}	for (al:=aliases; al!=nil; al=tl al) {		(new, old) := hd al;		olda := find_popt(rlist, old);		if (olda == nil) sys->fprint(stderr, "Popt alias %s not found\n", old);		else {			newa := ref *olda;			newa.name = new;			rlist = newa :: rlist;			}	}	return rlist;}    # Read printer config file read_printer_config(): list of ref Printer{	(clist, aliases)  := read_config(PRINTER_CONFIG);	rlist: list of ref Printer;	while (clist != nil) {		this := hd clist;		clist = tl clist;		item := ref Printer(this.name, nil, "", nil, nil);		for (pairs:= this.pairs; pairs != nil; pairs = tl pairs) {			(name, value) := hd pairs;			case (name) {				"ptype" =>					item.ptype = find_ptype(all_ptypes, value);					if (item.ptype == nil) sys->fprint(stderr, "Config error: Ptype not found: %s\n", value); 				"device" =>					item.device = value; 				* =>					sys->fprint(stderr, "Unknown printer config file option: %s\n", name);			}		}		if (item.ptype == nil) {			sys->fprint(stderr, "No printer type for printer %s\n", item.name);			continue;		}					rlist = item :: rlist;

Lines 1–500 of 625. Load more