-- [iris]<mesalib>writeformatted>WFimpl.mesa
-- last edit schmidt, May 29, 1980  6:06 PM
-- Mesa 5.0
-- implements the interface whose definitions module is "wf.mesa"

			DIRECTORY
			InlineDefs: FROM "InlineDefs" USING [DIVMOD, LowHalf],
			IODefs: FROM "IODefs" USING [WriteChar],
			StreamDefs: FROM "StreamDefs",
			StringDefs: FROM "StringDefs" USING
				[AppendChar, AppendString, StringToDecimal],
			TimeDefs: FROM "TimeDefs",
			WF: FROM "WF" USING [Unbound];

WFImpl: PROGRAM IMPORTS InlineDefs, IODefs, StringDefs, TimeDefs EXPORTS WF =
BEGIN

longProcArray: ARRAY[1 .. 26] OF
	PROCEDURE[UNSPECIFIED,STRING,PROCEDURE[CHARACTER]];
procArray: ARRAY[1 .. 26] OF
	PROCEDURE[UNSPECIFIED,STRING,PROCEDURE[CHARACTER]];
saveProcArray: ARRAY[1 .. 26] OF
	PROCEDURE[UNSPECIFIED,STRING,PROCEDURE[CHARACTER]];
GlobalWC: PROCEDURE[CHARACTER];
GlobalString: STRING;
swfstring: STRING;
fwfstream: StreamDefs.StreamHandle;

WFError: PUBLIC SIGNAL[STRING] = CODE;

WFNInternal: PROCEDURE [s: STRING, param: DESCRIPTOR FOR ARRAY OF UNSPECIFIED, WC: PROCEDURE[CHARACTER]] = BEGIN
form: STRING ← [10];
n,z,i,pnum: CARDINAL;
ch: CHARACTER;
f: CARDINAL;
p: PROCEDURE[UNSPECIFIED,STRING,PROCEDURE[CHARACTER]];
longop: BOOLEAN;

pnum ← 0;
BEGIN
FOR i IN [0 .. s.length) DO
	SELECT s[i] FROM
	'% => BEGIN
		i ← i + 1;
		f ← 0;
		WHILE s[i] = '- OR s[i] = '. OR s[i] IN ['0 .. '9] DO
			form[f] ← s[i];
			i ← i+1;
			f←f+1;
			ENDLOOP;
		form.length ← f;
		longop ← FALSE;
		IF s[i] = 'l OR s[i] = 'L THEN BEGIN
			longop ← TRUE;
			i ← i + 1;
			END;
		-- s[i] is a control character,
		-- and form is the stuff between % and s[i]
		ch ← s[i];
		IF ch IN ['A .. 'Z] THEN ch← ch + 40B;
		IF ch IN ['a .. 'z]  THEN BEGIN
			p ← IF longop THEN
				longProcArray[LOOPHOLE[ch,CARDINAL]-140B]
				ELSE procArray[LOOPHOLE[ch,CARDINAL]-140B];
			IF longop AND LOOPHOLE[p, UNSPECIFIED] = WF.Unbound
				THEN
				p ← procArray[LOOPHOLE[ch,CARDINAL]-140B];
			IF LOOPHOLE[p, UNSPECIFIED] ~= WF.Unbound THEN
				p[param[pnum],form, WC]
			ELSE WC[ch];
			END;
		pnum ← pnum + 1;
		IF ch = '% THEN BEGIN
			WC['%];
			pnum ← pnum - 1;
			END
		ELSE IF pnum > LENGTH[param] THEN GOTO bad;
		END;
	'* => BEGIN
		i ← i + 1;
		SELECT s[i] FROM
		'N, 'R, 'n,'r => WC[15C];
		'B,'b =>   WC[10C];
		'T,'t =>    WC[11C];
		'F,'f =>    WC[14C];
		IN ['0..'9] => BEGIN    --- octal constant, exactly 3 digits
			IF s[i+1] IN ['0 .. '9] AND s[i+2] IN ['0 .. '9]
			THEN BEGIN
				z ← LOOPHOLE['0];
				n ← (LOOPHOLE[s[i],CARDINAL]-z) * 64;
				n ← n + (LOOPHOLE[s[i+1],CARDINAL]-z) * 8;
				n ← n + LOOPHOLE[s[i+2],CARDINAL]-z;
				WC[LOOPHOLE[n]];
				i ← i + 2;
				END
			ELSE SIGNAL WFError["Bad character to WF"];
			END;
		ENDCASE => WC[s[i]];
		END;
	ENDCASE => WC[s[i]];
	ENDLOOP;
IF pnum < LENGTH[param] THEN GOTO bad;
EXITS
bad => SIGNAL WFError["Wrong # of parameters to WF"];
END;
RETURN;
END;


SetCode: PUBLIC PROCEDURE[char: CHARACTER, p: PROCEDURE[UNSPECIFIED,STRING, PROCEDURE[CHARACTER]]] =
BEGIN
IF char IN ['A .. 'Z] THEN char ← char + 40B;
IF char ~IN ['a .. 'z] OR char = 'l THEN SIGNAL WFError["Invalid SetCode"];
procArray[LOOPHOLE[char,CARDINAL]-140B] ← p;
END;

ResetCode: PUBLIC PROCEDURE[char: CHARACTER] =
BEGIN
i: [1 .. 26];
IF char IN ['A .. 'Z] THEN char ← char + 40B;
IF char ~IN ['a .. 'z] OR char = 'l THEN
	SIGNAL WFError["Invalid ResetCode"];
i ← LOOPHOLE[char,CARDINAL] - 140B;
procArray[i] ← saveProcArray[i];
END;

WriteToString: PUBLIC PROCEDURE[s: STRING]
	RETURNS[op: PROCEDURE[CHARACTER]] = BEGIN
op ← GlobalWC;
GlobalWC ← GoToString;
GlobalString ← s;
END;

GoToString: PROCEDURE[ch: CHARACTER] = BEGIN
StringDefs.AppendChar[GlobalString,ch];
END;

SetWriteProcedure: PUBLIC PROCEDURE[p: PROCEDURE[CHARACTER]]
	RETURNS [op: PROCEDURE[CHARACTER]] = BEGIN
op ← GlobalWC;
GlobalWC ← p;
RETURN[op];
END;

GetWriteProcedure: PUBLIC PROCEDURE
	RETURNS [PROCEDURE[CHARACTER]] = BEGIN
RETURN[GlobalWC];
END;

PrintUnsigned: PROCEDURE [data: CARDINAL, sto: STRING, base: CARDINAL] = BEGIN
ms: STRING ← [20];
char: CHARACTER;
digit: CARDINAL;
IF data=0 OR base NOT IN [2..16] THEN StringDefs.AppendChar[ms, '0]
ELSE DO
	[data, digit] ← InlineDefs.DIVMOD[data, base];
	char ← IF digit IN [10 .. 15] THEN (digit-10)+'A ELSE digit+'0;
	StringDefs.AppendChar[ms, char];
	IF data=0 THEN EXIT;  -- cannot run more than 20 repititions
	ENDLOOP;
FOR digit DECREASING IN [0..ms.length) DO
	StringDefs.AppendChar[sto, ms[digit]];
	ENDLOOP;
END;

PrintLongUnsigned: PROCEDURE[data:LONG CARDINAL,sto:STRING,base:CARDINAL]=
BEGIN
ms: STRING ← [34];
char: CHARACTER;
digit: CARDINAL;
IF data=0 OR base NOT IN [2..16] THEN StringDefs.AppendChar[ms, '0]
ELSE DO
	digit ← InlineDefs.LowHalf[data MOD base];
	data ← data/base;
	char ← IF digit IN [10 .. 15] THEN (digit-10)+'A ELSE digit+'0;
	StringDefs.AppendChar[ms, char];
	IF data=0 THEN EXIT;  -- cannot run more than 34 repititions
	ENDLOOP;
FOR digit DECREASING IN [0..ms.length) DO
	StringDefs.AppendChar[sto, ms[digit]];
	ENDLOOP;
END;

PrintSigned: PROCEDURE[data: INTEGER,sto: STRING,base: CARDINAL] = BEGIN
ndata: CARDINAL;
sto.length ← 0;
IF data < 0 THEN BEGIN
	StringDefs.AppendChar[sto, '-];
	ndata ← -data;
	END
ELSE ndata ← data;
PrintUnsigned[ndata,sto,base];
END;

PrintLongSigned: PROCEDURE[data: LONG INTEGER,sto: STRING,base: CARDINAL] =
BEGIN
ndata: LONG CARDINAL;
sto.length ← 0;
IF data < 0 THEN BEGIN
	StringDefs.AppendChar[sto, '-];
	ndata ← -data;
	END
ELSE ndata ← data;
PrintLongUnsigned[ndata,sto,base];
END;

BRoutine: PROCEDURE[data: UNSPECIFIED, form: STRING, wp: PROCEDURE[CHARACTER]] = BEGIN
sto: STRING ← [20];
PrintUnsigned[data,sto,8];
SRoutine[sto,form,wp];
END;

CRoutine: PROCEDURE[data: UNSPECIFIED, form: STRING, wp: PROCEDURE[CHARACTER]] = BEGIN
sto: STRING ← [20];
sto[0] ← LOOPHOLE[data,CHARACTER];
sto.length ← 1;
SRoutine[sto,form,wp];
END;

DRoutine: PROCEDURE[data: UNSPECIFIED, form: STRING, wp: PROCEDURE[CHARACTER]] = BEGIN
sto: STRING ← [20];
PrintSigned[data,sto,10];
SRoutine[sto,form,wp];
END;

SRoutine: PROCEDURE[data: UNSPECIFIED,form: STRING, wp: PROCEDURE[CHARACTER]] = BEGIN
ladj: BOOLEAN ← FALSE;
fill0: BOOLEAN ← FALSE;
w: CARDINAL;
k: INTEGER;
s: STRING ← data;
j: CARDINAL;
IF s = NIL THEN BEGIN wp['{]; wp['N]; wp['I]; wp['L]; wp['}]; RETURN END;
IF form.length > 0 THEN BEGIN
	IF form[0] = '0 THEN fill0 ← TRUE;
	IF form[0] = '- THEN BEGIN
		form[0] ← '0;
		ladj ← TRUE;
		END;
	w ← StringDefs.StringToDecimal[form];
	END
ELSE w ← s.length;
-- w is field width, k is # chars to fill
k ← w - s.length;
k ← MAX[0, k];
IF ~ladj THEN THROUGH [1..k] DO
	wp[IF fill0 THEN '0 ELSE ' ]
	ENDLOOP;
FOR j IN [0 .. MIN[w,s.length]) DO
	wp[s[j]]
	ENDLOOP;
IF ladj THEN THROUGH [1..k] DO
	wp[' ]
	ENDLOOP;
END;

URoutine: PROCEDURE[data: UNSPECIFIED, form: STRING, wp: PROCEDURE[CHARACTER]] = BEGIN
sto: STRING ← [20];
PrintUnsigned[data,sto,10];
SRoutine[sto,form,wp];
END;

XRoutine: PROCEDURE[data: UNSPECIFIED, form: STRING, wp: PROCEDURE[CHARACTER]] = BEGIN
sto: STRING ← [20];
PrintUnsigned[data,sto,16];
SRoutine[sto,form,wp];
END;

LongBRoutine: PROCEDURE[data: UNSPECIFIED, form: STRING, wp: PROCEDURE[CHARACTER]] = BEGIN
sto: STRING ← [20];
ndata: LONG CARDINAL ← LOOPHOLE[data,POINTER TO LONG CARDINAL]↑;
PrintLongUnsigned[ndata, sto, 8];
SRoutine[sto,form,wp];
END; 

LongDRoutine: PROCEDURE[data: UNSPECIFIED, form: STRING, wp: PROCEDURE[CHARACTER]] = BEGIN
sto: STRING ← [20];
ndata: LONG INTEGER ← LOOPHOLE[data,POINTER TO LONG INTEGER]↑;
PrintLongSigned[ndata,sto,10];
SRoutine[sto,form,wp];
END;

-- Interpret rp as a pointer to a long cardinal representing an interval
-- in seconds and print it as hrs:min:sec.
LongRRoutine: PROCEDURE [rp: UNSPECIFIED, f: STRING, wp: PROCEDURE [CHARACTER]] = BEGIN
et: LONG CARDINAL ← LOOPHOLE[rp,POINTER TO LONG CARDINAL]↑;
rear: STRING ← [20];
time: STRING ← [20];
hours1, minutes, seconds: LONG CARDINAL;
seconds ← et MOD 60;
et ← et/60;
minutes ← et MOD 60;
et ← et/60;
hours1 ← et MOD 100;
et ← et/100;
IF et#0 THEN SWF1[time,"%ld",@et];
SWF3[rear,"%02ld:%02ld:%02ld"L, @hours1, @minutes, @seconds];
StringDefs.AppendString[time,rear];
SRoutine[time,f,wp];
END;

-- Interpret rp as a pointer to a TimeDefs.PackedTime and print it.
LongTRoutine: PROCEDURE [rp: UNSPECIFIED, f: STRING, wp: PROCEDURE [CHARACTER]] =
BEGIN OPEN TimeDefs;
timeP: POINTER TO PackedTime ← rp;
time: STRING ← [30];
AppendDayTime[time, UnpackDT[timeP↑]];
SRoutine[time,f,wp];
END;


LongURoutine: PROCEDURE[data: UNSPECIFIED, form: STRING, wp: PROCEDURE[CHARACTER]] =
BEGIN
sto: STRING ← [20];
ndata: LONG CARDINAL ← LOOPHOLE[data,POINTER TO LONG CARDINAL]↑;
PrintLongUnsigned[ndata, sto, 10];
SRoutine[sto,form,wp];
END; 

LongXRoutine: PROCEDURE[data: UNSPECIFIED, form: STRING, wp: PROCEDURE[CHARACTER]] =
BEGIN
sto: STRING ← [20];
ndata: LONG CARDINAL ← LOOPHOLE[data,POINTER TO LONG CARDINAL]↑;
PrintLongUnsigned[ndata, sto, 16];
SRoutine[sto,form,wp];
END; 

IRoutineError: PROCEDURE[data: UNSPECIFIED, form: STRING, wp: PROCEDURE[CHARACTER]] =
BEGIN
SRoutine["Error - use %ld rather than %i*n",form,wp];
END; 

WF0: PUBLIC PROCEDURE [s: STRING] = BEGIN
nparam: ARRAY [0 .. 4] OF UNSPECIFIED;
WFNInternal[s,DESCRIPTOR[BASE[nparam],0],GlobalWC];
END;

WF1: PUBLIC PROCEDURE [s: STRING, a: UNSPECIFIED] = BEGIN
nparam: ARRAY [0 .. 4] OF UNSPECIFIED;
nparam[0] ← a;
WFNInternal[s,DESCRIPTOR[BASE[nparam],1],GlobalWC];
END;

WF2: PUBLIC PROCEDURE [s: STRING, a,b: UNSPECIFIED] = BEGIN
nparam: ARRAY [0 .. 4] OF UNSPECIFIED;
nparam[0] ← a; nparam[1] ← b;
WFNInternal[s,DESCRIPTOR[BASE[nparam],2],GlobalWC];
END;

WF3: PUBLIC PROCEDURE [s: STRING, a,b,c: UNSPECIFIED] = BEGIN
nparam: ARRAY [0 .. 4] OF UNSPECIFIED;
nparam[0] ← a; nparam[1] ← b; nparam[2] ← c;
WFNInternal[s,DESCRIPTOR[BASE[nparam],3],GlobalWC];
END;

WF4: PUBLIC PROCEDURE [s: STRING, a,b,c,d: UNSPECIFIED] = BEGIN
nparam: ARRAY [0 .. 4] OF UNSPECIFIED;
nparam[0] ← a; nparam[1] ← b; nparam[2] ← c; nparam[3] ← d;
WFNInternal[s,DESCRIPTOR[BASE[nparam],4],GlobalWC];
END;

WFN: PUBLIC PROCEDURE[s: STRING, array: DESCRIPTOR FOR ARRAY OF UNSPECIFIED] =
BEGIN
WFNInternal[s,array,GlobalWC];
END;

WFC: PUBLIC PROCEDURE [c: CHARACTER] = BEGIN
GlobalWC[c];
END;

WFCR: PUBLIC PROCEDURE = BEGIN
GlobalWC[15C];
END;


SWFAppendChar: PROCEDURE[ch: CHARACTER] = BEGIN
StringDefs.AppendChar[swfstring,ch];
END;

SWF0: PUBLIC PROCEDURE [sto: STRING, s: STRING] = BEGIN
nparam: ARRAY [0 .. 4] OF UNSPECIFIED;
sto.length ← 0;
swfstring ← sto;
WFNInternal[s,DESCRIPTOR[BASE[nparam],0],SWFAppendChar];
END;

SWF1: PUBLIC PROCEDURE [sto: STRING, s: STRING, a: UNSPECIFIED] = BEGIN
nparam: ARRAY [0 .. 4] OF UNSPECIFIED;
sto.length ← 0;
swfstring ← sto;
nparam[0] ← a;
WFNInternal[s,DESCRIPTOR[BASE[nparam],1],SWFAppendChar];
END;

SWF2: PUBLIC PROCEDURE [sto: STRING, s: STRING, a,b: UNSPECIFIED] = BEGIN
nparam: ARRAY [0 .. 4] OF UNSPECIFIED;
sto.length ← 0;
swfstring ← sto;
nparam[0] ← a; nparam[1] ← b;
WFNInternal[s,DESCRIPTOR[BASE[nparam],2],SWFAppendChar];
END;

SWF3: PUBLIC PROCEDURE [sto: STRING, s: STRING, a,b,c: UNSPECIFIED] = BEGIN
nparam: ARRAY [0 .. 4] OF UNSPECIFIED;
sto.length ← 0;
swfstring ← sto;
nparam[0] ← a; nparam[1] ← b; nparam[2] ← c;
WFNInternal[s,DESCRIPTOR[BASE[nparam],3],SWFAppendChar];
END;

SWF4: PUBLIC PROCEDURE [sto: STRING, s: STRING, a,b,c,d: UNSPECIFIED] = BEGIN
nparam: ARRAY [0 .. 4] OF UNSPECIFIED;
sto.length ← 0;
swfstring ← sto;
nparam[0] ← a; nparam[1] ← b; nparam[2] ← c; nparam[3] ← d;
WFNInternal[s,DESCRIPTOR[BASE[nparam],4],SWFAppendChar];
END;

SWFN: PUBLIC PROCEDURE[sto: STRING, s: STRING,
	array: DESCRIPTOR FOR ARRAY OF UNSPECIFIED] = BEGIN
sto.length ← 0;
swfstring ← sto;
WFNInternal[s,array,SWFAppendChar];
END;

FWFPutStream: PROCEDURE[ch: CHARACTER] = BEGIN
fwfstream.put[fwfstream,ch];
END;

FWF0: PUBLIC PROCEDURE [stream: StreamDefs.StreamHandle, s: STRING] = BEGIN
nparam: ARRAY [0 .. 4] OF UNSPECIFIED;
fwfstream ← stream;
WFNInternal[s,DESCRIPTOR[BASE[nparam],0],FWFPutStream];
END;

FWF1: PUBLIC PROCEDURE [stream: StreamDefs.StreamHandle, s: STRING, a: UNSPECIFIED] = BEGIN
nparam: ARRAY [0 .. 4] OF UNSPECIFIED;
fwfstream ← stream;
nparam[0] ← a;
WFNInternal[s,DESCRIPTOR[BASE[nparam],1],FWFPutStream];
END;

FWF2: PUBLIC PROCEDURE [stream: StreamDefs.StreamHandle, s: STRING, a,b: UNSPECIFIED] = BEGIN
nparam: ARRAY [0 .. 4] OF UNSPECIFIED;
fwfstream ← stream;
nparam[0] ← a; nparam[1] ← b;
WFNInternal[s,DESCRIPTOR[BASE[nparam],2],FWFPutStream];
END;

FWF3: PUBLIC PROCEDURE [stream: StreamDefs.StreamHandle, s: STRING, a,b,c: UNSPECIFIED] = BEGIN
nparam: ARRAY [0 .. 4] OF UNSPECIFIED;
fwfstream ← stream;
nparam[0] ← a; nparam[1] ← b; nparam[2] ← c;
WFNInternal[s,DESCRIPTOR[BASE[nparam],3],FWFPutStream];
END;

FWF4: PUBLIC PROCEDURE [stream: StreamDefs.StreamHandle, s: STRING, a,b,c,d: UNSPECIFIED] = BEGIN
nparam: ARRAY [0 .. 4] OF UNSPECIFIED;
fwfstream ← stream;
nparam[0] ← a; nparam[1] ← b; nparam[2] ← c; nparam[3] ← d;
WFNInternal[s,DESCRIPTOR[BASE[nparam],4],FWFPutStream];
END;

FWFN: PUBLIC PROCEDURE[stream: StreamDefs.StreamHandle, s: STRING,
	array: DESCRIPTOR FOR ARRAY OF UNSPECIFIED] = BEGIN
fwfstream ← stream;
WFNInternal[s,array,FWFPutStream];
END;



-- INITIALIZATION CODE
BEGIN
Temp: CARDINAL;
FOR Temp IN [1 .. 26]
DO
	saveProcArray[Temp] ← procArray[Temp] ← longProcArray[Temp]
		← WF.Unbound;
	ENDLOOP;
-- for 16 bit numbers
SetCode['b,BRoutine];
saveProcArray[LOOPHOLE['b,CARDINAL]-140B] ← BRoutine;
SetCode['c,CRoutine];
saveProcArray[LOOPHOLE['c,CARDINAL]-140B] ← CRoutine;
SetCode['d,DRoutine];
saveProcArray[LOOPHOLE['d,CARDINAL]-140B] ← DRoutine;
SetCode['i,IRoutineError];
saveProcArray[LOOPHOLE['i,CARDINAL]-140B] ← IRoutineError;
SetCode['s,SRoutine];
saveProcArray[LOOPHOLE['s,CARDINAL]-140B] ← SRoutine;
SetCode['u,URoutine];
saveProcArray[LOOPHOLE['u,CARDINAL]-140B] ← URoutine;
SetCode['x,XRoutine];
saveProcArray[LOOPHOLE['x,CARDINAL]-140B] ← XRoutine;
-- for LONGS
longProcArray[LOOPHOLE['b,CARDINAL]-140B] ← LongBRoutine;
longProcArray[LOOPHOLE['d,CARDINAL]-140B] ← LongDRoutine;
longProcArray[LOOPHOLE['r,CARDINAL]-140B] ← LongRRoutine;
longProcArray[LOOPHOLE['t,CARDINAL]-140B] ← LongTRoutine;
longProcArray[LOOPHOLE['u,CARDINAL]-140B] ← LongURoutine;
longProcArray[LOOPHOLE['x,CARDINAL]-140B] ← LongXRoutine;
--
[] ← SetWriteProcedure[IODefs.WriteChar];
END;
END.

	MODULE HISTORY
Created by Schmidt, July 1977

Changed by Schmidt, August 19, 1977  8:06 PM
Reason: to delete wf5 - wf9, put in setwriteprocedure, and add a test for a NIL string

Changed by Schmidt, August 19, 1977  8:23 PM
Reason:  deconvert from dboss

Changed by Mitchell, June 13, 1978  9:48 PM
Reason:  Convert to Mesa 4.0

Chnaged by Schmidt, June 26, 1978  11:21 PM
Reason: add %i, %l to handle 32-bit integers

Changed by LStewart, June 19, 1979  11:04 AM
Reason:  Convert to Mesa 5.0

Changed by LStewart, July 10, 1979  5:10 PM
Reason:  Field width on long octal.  Non-recursive number printer

Changed by LStewart, September 12, 1979  12:13 PM
Reason:  add '. to Forms, add WriteProcedure as argument to code procs.

Changed by Schmidt, April 21, 1980  12:10 AM
Reason: change %i, %l to be %ld, %lb, etc.  Add SWF, FWF.

Changed by Schmidt, May 29, 1980  6:10 PM
Reason: use procArray if longProcArray[] = NIL.