DIRECTORY FileIO USING [Open, OpenFailed], IPEncodingOut, IPXeroxEncoding, IO USING [Close, PutChar], Inline USING [BITSHIFT], Real USING [Fix], Rope USING [ActionType, Fetch, Length, Map, MaxLen, ROPE], Ieee USING [Ext, Unpack]; IPEncodingOutImpl: CEDAR PROGRAM IMPORTS FileIO, Ieee, Inline, IO, IPEncodingOut, Real, Rope EXPORTS IPEncodingOut = BEGIN OPEN IPEncodingOut, IPX: IPXeroxEncoding; OpenOutputMaster: PUBLIC PROCEDURE[name: Rope.ROPE] RETURNS [h: Handle] = { h _ Handle[FileIO.Open[name, overwrite ! FileIO.OpenFailed => CHECKED {ERROR Error[FileNotAvailable]}]]; h.WriteInterpressHeader[]; }; CloseMaster: PUBLIC PROCEDURE[h: Handle] = { h.Close[]; }; AppendOp: PUBLIC PROCEDURE[h: Handle, op: IPX.EncodingValue] = { val: CARDINAL _ LOOPHOLE[op]; IF val <= 31 THEN h.AppendByte[128+val] ELSE { h.AppendByte[160+val/256]; h.AppendByte[val MOD 256]; }; }; AppendByte: PUBLIC PROCEDURE[h: Handle, val: CARDINAL] = { h.PutChar[LOOPHOLE[val, CHAR]]; }; AppendSequenceDescriptor: PUBLIC PROCEDURE[h: Handle, type: IPX.SequenceType, length: NAT] = { val: CARDINAL _ LOOPHOLE[type]; IF length < 0 OR length > 16777215 THEN EncodingRangeError[]; IF length < 255 THEN { h.AppendByte[192+val]; h.AppendByte[length]; } ELSE { h.AppendByte[224+val]; h.AppendInt[length, 3]; }; }; AppendString: PUBLIC PROCEDURE[h: Handle, length: NAT, proc: PROC RETURNS[c: [0..255]]] = { i: NAT; h.AppendSequenceDescriptor[sequenceString, length]; FOR i IN [0..length) DO h.AppendByte[proc[]]; ENDLOOP; }; AppendRope: PUBLIC PROCEDURE [h: Handle, rope: Rope.ROPE, start: INT _ 0, len: INT _ Rope.MaxLen] = { length: INT _ MIN[len, rope.Length[]-start]; index: INT; BlowIfEscape: PROCEDURE [c: CHAR] RETURNS [BOOL] = {RETURN [c = 377C];}; IF Rope.Map[rope, start, len, LOOPHOLE[BlowIfEscape, Rope.ActionType]] OR (length = 0) THEN ERROR Error[RopeEncodingError] ELSE { h.AppendSequenceDescriptor[sequenceString, length]; FOR index IN [start..start+length) DO h.AppendByte[LOOPHOLE[rope.Fetch[index], CARDINAL]]; ENDLOOP; }; }; AppendReal: PUBLIC PROCEDURE[h: Handle, n: REAL] = { f: INT; i: INT; ex: INTEGER; e: Ieee.Ext _ Ieee.Unpack[n]; --UnPack returns frac and exp : n = frac*2^(exp-31) not signed. f _ IF e.det.sign THEN -(e.frac.lc/256) ELSE e.frac.lc/256; IF (e.exp >= 0) AND (e.exp <= 25) AND (n = (i_Real.Fix[n])) THEN h.AppendInteger[i] -- number is vanilla integer ELSE { ex _ e.exp-23; --adjust exponent so that mantissa is integer. IF ex < 0 THEN h.Append2Rational[f, ABS[ex]] -- must divide integer by power of 2. ELSE h.AppendLongInteger[f, ex] -- must add extra bits to integer. }; }; AppendInteger: PUBLIC PROCEDURE[h: Handle, i: INT] = { bn: CARDINAL; IF i IN [-4000..28767] THEN h.AppendInt[4000+i, 2] ELSE { bn _ BytesInInteger[i]; h.AppendSequenceDescriptor[sequenceInteger, bn]; h.AppendInt[i, bn]; }; }; AppendRational: PUBLIC PROCEDURE [h: Handle, i, j: INT] = { c, bn, bd: CARDINAL; bn _ BytesInInteger[i]; bd _ BytesInInteger[j]; c _ MAX[bn,bd]; h.AppendSequenceDescriptor[sequenceRational, 2*c]; h.AppendInt[i, c]; h.AppendInt[j, c]; }; Append2Rational: PUBLIC PROCEDURE [h: Handle, i: INT, e: INTEGER] = { d, c, bn, bd: CARDINAL; j: INT _ i; d _ 0; IF j = 0 THEN { h.AppendInteger[0]; RETURN; }; UNTIL j MOD 256 # 0 DO j _ j/256; d _ d+1; ENDLOOP; bn _ BytesInInteger[j]; bd _ e/8+1-d; c _ MAX[bn,bd]; h.AppendSequenceDescriptor[sequenceRational, 2*c]; h.AppendInt[j, c]; h.Append2Int[e-8*d, c]; }; AppendLongInteger: PUBLIC PROCEDURE [h: Handle, f: INT, e: CARDINAL] = { bn, bt: INTEGER; i, j: INT; i _ e MOD 8; j _ f*LOOPHOLE[Inline.BITSHIFT[1,i], INTEGER]; bn _ BytesInInteger[j]; bt _ e/8; h.AppendSequenceDescriptor[sequenceInteger, bn+bt]; h.AppendInt[j, bn]; THROUGH [0..bt) DO h.AppendByte[0]; ENDLOOP; }; AppendInt: PUBLIC PROCEDURE [h: Handle, i: INT, c: CARDINAL] = { a: PACKED ARRAY [0..3] OF [0..255]; bi: CARDINAL _ BytesInInteger[i]; IF bi > c THEN EncodingRangeError[]; THROUGH [0..c-bi) DO IF i < 0 THEN h.AppendByte[255] ELSE h.AppendByte[0];--store leading 1's or 0's ENDLOOP; a _ LOOPHOLE[i]; IF bi > 3 THEN h.AppendByte[a[2]]; IF bi > 2 THEN h.AppendByte[a[3]]; IF bi > 1 THEN h.AppendByte[a[0]]; IF bi > 0 THEN h.AppendByte[a[1]]; }; Append2Int: PUBLIC PROCEDURE [h: Handle, e: CARDINAL, c: CARDINAL] = { bi: CARDINAL _ e/8+1; IF bi > c THEN EncodingRangeError[]; THROUGH [0..c-bi) DO h.AppendByte[0]; ENDLOOP; -- store leading 0's h.AppendByte[Inline.BITSHIFT[1,e MOD 8]]; THROUGH [0..bi-1) DO h.AppendByte[0]; ENDLOOP; -- store trailing 0's }; AppendIdentifier: PUBLIC PROCEDURE [h: Handle, id: Rope.ROPE, start: INT _ 0, len: INT _ Rope.MaxLen] = { length: INT _ MIN[len, id.Length[]-start]; j: NAT; h.AppendSequenceDescriptor[sequenceIdentifier, length]; FOR j IN [start..start+length) DO h.AppendByte[LOOPHOLE[Rope.Fetch[id, j], CARDINAL]]; ENDLOOP; }; BytesInInteger: PUBLIC PROCEDURE [n: INT] RETURNS [CARDINAL] = { IF ABS[n] = 0 THEN RETURN[0]; IF ABS[n] > 37777777B AND LOOPHOLE[n, LONG CARDINAL] # 37740000000B THEN RETURN[4]; IF ABS[n] > 77777B AND LOOPHOLE[n, LONG CARDINAL] # 37777700000B THEN RETURN[3]; IF ABS[n] > 127 AND n # -128 THEN RETURN[2]; RETURN[1]; }; WriteInterpressHeader: PUBLIC PROCEDURE [h: Handle] = { --Interpress/Xerox/1.0 -- h.AppendByte[73]; -- I h.AppendByte[110]; -- n h.AppendByte[116]; -- t h.AppendByte[101]; -- e h.AppendByte[114]; -- r h.AppendByte[112]; -- p h.AppendByte[114]; -- r h.AppendByte[101]; -- e h.AppendByte[115]; -- s h.AppendByte[115]; -- s h.AppendByte[47]; -- / h.AppendByte[88]; -- X h.AppendByte[101]; -- e h.AppendByte[114]; -- r h.AppendByte[111]; -- o h.AppendByte[120]; -- x h.AppendByte[47]; -- / h.AppendByte[50]; -- 2 h.AppendByte[46]; -- . h.AppendByte[48]; -- 0 h.AppendByte[32]; -- }; EncodingRangeError: SIGNAL = CODE; Error: PUBLIC ERROR [errorCode: ErrorCode] = CODE; END. žIPEncodingOutImpl.mesa Written by J. Warnock, Mar 1982 Last edited by Andy Shore, February 14, 1983 3:57 pm -- adjust sign on mantissa and shift down to get 24 bits of mantissa. -- right shift off zeros and decrement byte count of denom. Change Log Created by Warnock; Mar 1982 as IPEncodingImpl Changed by Shore; August 27, 1982 11:30 am segmented Output routines and Cedarized Changed by Shore; September 4, 1982 3:08 pm modified to use Doug's latest IPXeroxEncoding Changed by Shore; September 24, 1982 1:27 pm made changes suggested by Sproull -- AppendRope now here, etc. Changed by Shore; October 12, 1982 10:16 pm updated for Cedar 3.4 Change by Shore; November 11, 1982 2:17 pm change to Cedar.Style and added node styles Changed by Shore; January 19, 1983 4:04 pm changed to CEDAR, Interpress 2.0 and new node styles Changed by Shore; January 30, 1983 1:11 pm fixed bug in AppendRope with empty string Κ 5– "Cedar" style˜headšœ™JšΟc™Jš4™4unitšΟk ˜ Jšœžœ˜ Jšœ˜J˜Jšžœžœ˜Jšœžœžœ˜Jšœžœ˜Jšœžœ*žœ˜:Jšœžœ˜——šœžœž˜ Jšžœžœ˜;Jšžœ˜Jšœž˜J˜Jšžœžœ˜)š Οnœžœž œ žœžœ˜Kšœ(˜(Jšœžœžœ˜?—Jšœ˜J˜—šŸ œžœž œ˜,Jšœ ˜ J˜—šŸœžœž œžœ˜@Jšœžœžœ˜Jšžœ žœ˜'šžœ˜Jšœ˜Jšœžœ˜J˜—J˜—šŸ œžœž œžœ˜:Jšœ žœžœ˜J˜—š Ÿœžœž œžœžœ˜^Jšœžœžœ˜Jšžœ žœžœ˜=šžœžœ˜Jšœ˜Jšœ˜—šžœ˜Jšœ˜Jšœ˜—J˜—š Ÿ œžœž œžœžœžœ˜[Jšœžœ˜Jšœ3˜3šžœžœ ž˜Jšœ˜Jšžœ˜—J˜—š Ÿ œžœž œžœ žœ žœ˜eJšœžœžœ˜,Jšœžœ˜ Lš Ÿ œž œžœžœžœžœ˜HJ˜šžœžœ!žœž˜[Jšžœ˜—šžœ˜Jšœ3˜3šžœžœž˜%Jšœ žœžœ˜4Jšžœ˜—J˜—J˜—šŸ œžœž œžœ˜4Jšœžœ˜Jšœžœ˜Jšœžœ˜ Jšœ?˜]JšE™EJšœžœ žœžœ˜;šžœžœžœž˜@Jšœ˜/—šžœ˜Jšœ.˜=Jšžœžœžœ%˜RJšžœ"˜BJ˜—J˜—šŸ œžœž œžœ˜6Jšœžœ˜ Jšžœžœžœ˜2šžœ˜Jšœ˜Jšœ0˜0Jšœ˜J˜—J˜—šŸœžœž œžœ˜;Jšœ žœ˜Jšœ˜Jšœ˜Jšœžœ˜Jšœ2˜2Jšœ˜Jšœ˜J˜—š Ÿœžœž œžœžœ˜EJšœžœ˜Jšœžœ˜ Jšœ˜Jš<™<šžœžœ˜J˜Jšžœ˜J˜—Jšžœžœ žœžœ˜3Jšœ˜Jšœ ˜ Jšœžœ˜Jšœ2˜2Jšœ˜Jšœ˜J˜—š Ÿœžœž œžœžœ˜HJšœžœ˜Jšœžœ˜ Jšœžœ˜ Jšœžœžœžœ˜.Jšœ˜Jšœ ˜ Jšœ3˜3Jšœ˜Jšžœ žœžœ˜,J˜—š Ÿ œžœž œžœžœ˜@Jšœžœžœžœ ˜#Jšœžœ˜!Jšžœžœ˜$šžœ ž˜Jšžœžœžœ˜OJšžœ˜—Jšœžœ˜Jšžœžœ˜"Jšžœžœ˜"Jšžœžœ˜"Jšžœžœ˜#J˜—š Ÿ œžœž œžœžœ˜FJšœžœ ˜Jšžœžœ˜$Jšžœ žœžœ˜FJšœžœžœ˜)Jšžœ žœžœ˜FJ˜—š Ÿœžœž œžœ žœ žœ˜iJšœžœžœ˜*Jšœžœ˜Jšœ7˜7šžœžœž˜!Jšœ žœžœ˜4Jšžœ˜—J˜—š Ÿœžœž œžœžœžœ˜@Jšžœžœžœžœ˜Jšžœžœžœžœžœžœžœžœ˜SJšžœžœ žœžœžœžœžœžœ˜PJš žœžœ žœ žœžœ˜,Jšžœ˜ J˜—šŸœžœž œ˜RJšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜J˜—J˜Jšœžœžœ˜"J˜Jšœžœžœžœ˜2J˜Jšžœ˜—šœ ™ Jšœ.™.J™šœ*™*J™'—J™šœ+™+J™-—J™™,J™>—J™™+J™—J™™*J™+—J™™*J™4—J™™*J™)—J™——…—€#w