
    <<RoseWireFormatsImpl.Mesa>>
        <<Spreitzer, October 22, 1985 6:13:31 pm PDT>>

    DIRECTORY BitTwiddling, ImagerFont, IO, PrincOpsUtils, Real, RealFns, Rope, RoseBehavior, RoseControl, RoseWireFormats, 
    RoseWireTypes, VFonts;

    RoseWireFormatsImpl: CEDAR PROGRAM
        IMPORTS BitTwiddling, ImagerFont, IO, PrincOpsUtils, Real, RealFns, Rope, RoseControl
        EXPORTS RoseWireFormats
        =

    BEGIN OPEN RoseWireTypes;

    RN: PROC [n: NAT] RETURNS [REF ANY] = {RETURN [NEW [NAT _ n]]};

    numericBasicSwitchSequence: PUBLIC ARRAY --Lg[base]-- [1 .. 4] OF Format _ [
        NEW [FormatRep _ [FormatSwitchNum, ParseSwitchNum, MaxNumWidth, RN[1], "2"]],
        NEW [FormatRep _ [FormatSwitchNum, ParseSwitchNum, MaxNumWidth, RN[2], "4"]],
        NEW [FormatRep _ [FormatSwitchNum, ParseSwitchNum, MaxNumWidth, RN[3], "8"]],
        NEW [FormatRep _ [FormatSwitchNum, ParseSwitchNum, MaxNumWidth, RN[4], "16"]]
        ];

    FormatSwitchNum: PROC [rwt: RoseWireType, f: Format, p: Ptr] RETURNS [r: ROPE] = {
        refLgBase: REF NAT = NARROW[f.formatData];
        lgBase: INTEGER[1 .. 4] = refLgBase^;
        base: NAT = BitTwiddling.TwoToThe[lgBase];
        sig: NAT _ 1;
        acc: NAT _ 0;
        state: NAT _ 0;
        XIt: BOOL _ FALSE;
        IF rwt.class.dereference THEN p _ BitTwiddling.DeReferencePtr[p];
        r _ BaseSuffix[lgBase];
        FOR i: NAT DECREASING IN [0 .. rwt.length) DO
            bitOffset: NAT = rwt.class.super.SelectorOffset[rwt, [subscript[i]]];
            sp: Ptr = BitTwiddling.OffsetPtr[p, bitOffset];
            l: RoseBehavior.Level = RoseControl.ReadSwitch[sp].val;
            b: [0 .. 1] = IF l # L THEN sig ELSE 0;
            IF l = X THEN XIt _ TRUE;
            acc _ acc + b;
            state _ state + 1;
            IF state = lgBase OR i = 0
                THEN {
                    r _ (IF NOT XIt THEN Digit[acc] ELSE "X").Concat[r];
                    state _ 0;
                    XIt _ FALSE;
                    acc _ 0;
                    sig _ 1;
                    }
                ELSE {
                    sig _ sig + sig;
                    };
            ENDLOOP;
        r _ r;
        };

    ParseSwitchNum: PROC [rwt: RoseWireType, f: Format, p: Ptr, s: STREAM] RETURNS [ok: BOOL] = TRUSTED {
        ENABLE IO.Error, IO.EndOfStream => {ok _ FALSE; CONTINUE};
        toke: ROPE _ s.GetTokenRope[WireValBreak].token;
        lm1: NAT = toke.Length[]-1;
        lgBase: INTEGER[1 .. 4] = SELECT toke.Fetch[lm1] FROM
            'B => 1,
            'Q => 2,
            'O => 3,
            'H => 4,
            ENDCASE => ERROR;
        base: NAT = BitTwiddling.TwoToThe[lgBase];
        digits: NAT = (rwt.length + lgBase - 1)/lgBase;
        bi: INTEGER _ rwt.length;
        ci: INTEGER _ lm1;
        IF rwt.class.dereference THEN p _ BitTwiddling.DeReferencePtr[p];
        FOR di: NAT IN [0 .. digits) DO
            d: NAT _ 0;
            XIt: BOOL _ FALSE;
            ci _ ci - 1;
            IF ci >= 0 THEN {
                c: CHAR = toke.Fetch[ci];
                IF c = 'X
                    THEN XIt _ TRUE
                    ELSE d _ SELECT c FROM
                        IN ['0 .. '9] => c - '0,
                        IN ['A .. 'F] => c - 'A + 10,
                        ENDCASE => base;
                };
            FOR si: NAT IN [0 .. lgBase] DO
                bi _ bi - 1;
                IF bi >= 0 THEN {
                    bitOffset: NAT = rwt.class.super.SelectorOffset[rwt, [subscript[bi]]];
                    sp: Ptr = BitTwiddling.OffsetPtr[p, bitOffset];
                    b: BOOL = PrincOpsUtils.BITAND[d, 1] # 0;
                    RoseControl.WriteSwitch[sp, [s: [none, none, none], val: IF XIt THEN X ELSE IF b THEN H ELSE L]];
                d _ PrincOpsUtils.BITSHIFT[d, -1];
                    }
                ELSE IF d # 0 THEN RETURN [FALSE];
                ENDLOOP;
            IF d # 0 THEN RETURN [FALSE];
            ENDLOOP;
        IF ci > 0 THEN RETURN [FALSE];
        };

    MaxNumWidth: PROC [rwt: RoseWireType, f: Format, font: VFonts.Font] RETURNS [max: INT] = {
        refLgBase: REF NAT = NARROW[f.formatData];
        lgBase: INTEGER[1 .. 4] = refLgBase^;
        base: NAT = BitTwiddling.TwoToThe[lgBase];
        digits: NAT = (rwt.length + lgBase - 1)/lgBase;
        AddRope: PROC [r: ROPE, times: NAT _ 1] = {
            max _ max + Real.Round[times * ImagerFont.RopeWidth[font, r].x];
            };
        max _ 0;
        AddRope[BaseSuffix[lgBase], 1];
        AddRope["X", digits];
        };

    numericBasicSimpleSequence: PUBLIC ARRAY --Lg[base]-- [1 .. 4] OF Format _ [
        NEW [FormatRep _ [FormatSimpleNum, ParseSimpleNum, MaxNumWidth, RN[1], "2"]],
        NEW [FormatRep _ [FormatSimpleNum, ParseSimpleNum, MaxNumWidth, RN[2], "4"]],
        NEW [FormatRep _ [FormatSimpleNum, ParseSimpleNum, MaxNumWidth, RN[3], "8"]],
        NEW [FormatRep _ [FormatSimpleNum, ParseSimpleNum, MaxNumWidth, RN[4], "16"]]
        ];

    FormatSimpleNum: PROC [rwt: RoseWireType, f: Format, p: Ptr] RETURNS [r: ROPE] = {
        refLgBase: REF NAT = NARROW[f.formatData];
        lgBase: INTEGER[1 .. 4] = refLgBase^;
        base: NAT = BitTwiddling.TwoToThe[lgBase];
        sig: NAT _ 1;
        acc: NAT _ 0;
        state: NAT _ 0;
        IF rwt.class.dereference THEN p _ BitTwiddling.DeReferencePtr[p];
        r _ BaseSuffix[lgBase];
        FOR i: NAT DECREASING IN [0 .. rwt.length) DO
            bitOffset: NAT = rwt.class.super.SelectorOffset[rwt, [subscript[i]]];
            sp: Ptr = BitTwiddling.OffsetPtr[p, bitOffset];
            b: NAT = IF RoseControl.ReadBool[sp] THEN sig ELSE 0;
            acc _ acc + b;
            state _ state + 1;
            IF state = lgBase OR i = 0
                THEN {
                    r _ Digit[acc].Concat[r];
                    state _ 0;
                    acc _ 0;
                    sig _ 1;
                    }
                ELSE {
                    sig _ sig + sig;
                    };
            ENDLOOP;
        r _ r;
        };

    BaseSuffix: ARRAY [1 .. 4] OF ROPE = ["B", "Q", "O", "H"];

    ParseSimpleNum: PROC [rwt: RoseWireType, f: Format, p: Ptr, s: STREAM] RETURNS [ok: BOOL] = TRUSTED {
        ENABLE IO.Error, IO.EndOfStream => {ok _ FALSE; CONTINUE};
        toke: ROPE _ s.GetTokenRope[WireValBreak].token;
        lm1: NAT = toke.Length[]-1;
        lgBase: INTEGER[1 .. 4] = SELECT toke.Fetch[lm1] FROM
            'B => 1,
            'Q => 2,
            'O => 3,
            'H => 4,
            ENDCASE => ERROR;
        base: NAT = BitTwiddling.TwoToThe[lgBase];
        digits: NAT = (rwt.length + lgBase - 1)/lgBase;
        bi: INTEGER _ rwt.length;
        ci: INTEGER _ lm1;
        IF rwt.class.dereference THEN p _ BitTwiddling.DeReferencePtr[p];
        FOR di: NAT IN [0 .. digits) DO
            d: NAT _ 0;
            ci _ ci - 1;
            IF ci >= 0 THEN {
                c: CHAR = toke.Fetch[ci];
                d _ SELECT c FROM
                    IN ['0 .. '9] => c - '0,
                    IN ['A .. 'F] => c - 'A + 10,
                    ENDCASE => ERROR;
                };
            FOR si: NAT IN [0 .. lgBase] DO
                bi _ bi - 1;
                IF bi >= 0 THEN {
                    bitOffset: NAT = rwt.class.super.SelectorOffset[rwt, [subscript[bi]]];
                    sp: Ptr = BitTwiddling.OffsetPtr[p, bitOffset];
                    b: BOOL = PrincOpsUtils.BITAND[d, 1] # 0;
                    RoseControl.WriteBool[sp, b];
                d _ PrincOpsUtils.BITSHIFT[d, -1];
                    }
                ELSE IF d # 0 THEN RETURN [FALSE];
                ENDLOOP;
            IF d # 0 THEN RETURN [FALSE];
            ENDLOOP;
        IF ci > 0 THEN RETURN [FALSE];
        };

    MaxSimpleNumWidth: PROC [rwt: RoseWireType, f: Format, font: VFonts.Font] RETURNS [max: INT] = {
        refLgBase: REF NAT = NARROW[f.formatData];
        lgBase: INTEGER[1 .. 4] = refLgBase^;
        base: NAT = BitTwiddling.TwoToThe[lgBase];
        digits: NAT = (rwt.length + lgBase - 1)/lgBase;
        AddRope: PROC [r: ROPE, times: NAT _ 1] = {
            max _ max + Real.Round[times * ImagerFont.RopeWidth[font, r].x];
            };
        max _ 0;
        AddRope[BaseSuffix[lgBase], 1];
        AddRope["E", digits];
        };

    constructNumericSequence: PUBLIC ARRAY --Lg[base]-- [1 .. 4] OF Format _ [
        NEW [FormatRep _ [FormatSeqCons, ParseSeqCons, MaxSeqConsWidth, NIL, "2"]],
        NEW [FormatRep _ [FormatSeqCons, ParseSeqCons, MaxSeqConsWidth, NIL, "4"]],
        NEW [FormatRep _ [FormatSeqCons, ParseSeqCons, MaxSeqConsWidth, NIL, "8"]],
        NEW [FormatRep _ [FormatSeqCons, ParseSeqCons, MaxSeqConsWidth, NIL, "16"]]
        ];

    constructNumericRecord: PUBLIC ARRAY --Lg[base]-- [1 .. 4] OF Format _ [
        NEW [FormatRep _ [FormatRecCons, ParseRecCons, MaxRecConsWidth, NIL, "2"]],
        NEW [FormatRep _ [FormatRecCons, ParseRecCons, MaxRecConsWidth, NIL, "4"]],
        NEW [FormatRep _ [FormatRecCons, ParseRecCons, MaxRecConsWidth, NIL, "8"]],
        NEW [FormatRep _ [FormatRecCons, ParseRecCons, MaxRecConsWidth, NIL, "16"]]
        ];

    constructIdiosyncraticSequence: PUBLIC Format _ NEW [FormatRep _ [FormatSeqCons, ParseSeqCons, MaxSeqConsWidth, NIL, 
    "idiosyncratic"]];

    FormatSeqCons: PROC [rwt: RoseWireType, f: Format, p: Ptr] RETURNS [r: ROPE] = {
        to: STREAM = IO.ROS[];
        digits: NAT = DecimalDigits[rwt.length-1];
        formatString: ROPE = IO.PutFR["%%%gg: %%g", [cardinal[digits]]];
        to.PutRope["["];
        FOR i: NAT IN [0 .. rwt.length) DO
            subType: RoseWireType = rwt.class.super.SubType[rwt, [field[i]]];
            subFormat: Format = subType.class.super.GetFormat[subType, f.key];
            subPtr: Ptr = BitTwiddling.OffsetPtr[p, rwt.class.super.SelectorOffset[rwt, [field[i]]]];
            IF i # 0 THEN to.PutRope[", "];
            to.PutF[
                formatString,
                [cardinal[i]],
                [rope[subFormat.FormatValue[subType, subFormat, subPtr]]]
                ];
            ENDLOOP;
        to.PutRope["]"];
        r _ to.RopeFromROS[];
        };

    ParseSeqCons: PROC [rwt: RoseWireType, f: Format, p: Ptr, s: STREAM] RETURNS [ok: BOOL] = {
        ENABLE IO.Error, IO.EndOfStream => {ok _ FALSE; CONTINUE};
        Consume: PROC [goal: ROPE] = {
            toke: ROPE = s.GetTokenRope[WireValBreak].token;
            IF NOT toke.Equal[goal] THEN IO.Error[SyntaxError, s];
            };
        first: BOOL _ TRUE;
        ok _ TRUE;
        Consume["["];
        FOR discard: INT _ s.SkipWhitespace[], s.SkipWhitespace[] WHILE s.PeekChar # '] DO
            i: INT;
            IF first THEN first _ FALSE ELSE Consume[", "];
            i _ s.GetInt[];
            IF NOT i IN [0 .. rwt.length) THEN RETURN [FALSE];
            {
            subType: RoseWireType = rwt.class.super.SubType[rwt, [field[i]]];
            subFormat: Format = subType.class.super.GetFormat[subType, f.key];
            bitOffset: INT = rwt.class.super.SelectorOffset[rwt, [field[i]]];
            subPtr: Ptr = BitTwiddling.OffsetPtr[p, bitOffset];
            Consume[":"];
            IF
                NOT subFormat.ParseValue[
                    subType,
                    subFormat,
                    subPtr,
                    s
                    ]
                THEN RETURN [FALSE];
            };
            ENDLOOP;
        Consume["]"];
        };

    MaxSeqConsWidth: PROC [rwt: RoseWireType, f: Format, font: VFonts.Font] RETURNS [max: INT] = {
        AddRope: PROC [r: ROPE, count: INT _ 1] = {
            max _ max + Real.Round[ImagerFont.RopeWidth[font, r].x * count];
            };
        digits: NAT = DecimalDigits[rwt.length-1];
        formatString: ROPE = IO.PutFR["%%%gg: ", [cardinal[digits]]];
        intro: ROPE = IO.PutFR[formatString, [cardinal[0]]];
        max _ 0;
        AddRope["[]"];
        AddRope[intro, rwt.length];
        FOR i: NAT IN [0 .. rwt.length) DO
            subType: RoseWireType = rwt.class.super.SubType[rwt, [field[i]]];
            subFormat: Format = subType.class.super.GetFormat[subType, f.key];
            IF i # 0 THEN AddRope[", "];
            max _ max + subFormat.MaxWidth[
                subType,
                subFormat,
                font
                ];
            ENDLOOP;
        max _ max;
        };

    constructIdiosyncraticRecord: PUBLIC Format _ NEW [FormatRep _ [FormatRecCons, ParseRecCons, MaxRecConsWidth, NIL, 
    "idiosyncratic"]];

    FormatRecCons: PROC [rwt: RoseWireType, f: Format, p: Ptr] RETURNS [r: ROPE] = {
        to: STREAM = IO.ROS[];
        to.PutRope["["];
        FOR i: NAT IN [0 .. rwt.length) DO
            subType: RoseWireType = rwt.class.super.SubType[rwt, [field[i]]];
            subFormat: Format = subType.class.super.GetFormat[subType, f.key];
            fieldName: ROPE = rwt.class.super.FieldName[rwt.class, i];
            subPtr: Ptr = BitTwiddling.OffsetPtr[p, rwt.class.super.SelectorOffset[rwt, [field[i]]]];
            IF i # 0 THEN to.PutRope[", "];
            to.PutF[
                "%g: %g",
                [rope[fieldName]],
                [rope[subFormat.FormatValue[subType, subFormat, subPtr]]]
                ];
            ENDLOOP;
        to.PutRope["]"];
        r _ to.RopeFromROS[];
        };

    ParseRecCons: PROC [rwt: RoseWireType, f: Format, p: Ptr, s: STREAM] RETURNS [ok: BOOL] = {
        ENABLE IO.Error, IO.EndOfStream => {ok _ FALSE; CONTINUE};
        Consume: PROC [goal: ROPE] = {
            toke: ROPE = s.GetTokenRope[WireValBreak].token;
            IF NOT toke.Equal[goal] THEN IO.Error[SyntaxError, s];
            };
        ok _ TRUE;
        Consume["["];
        FOR i: NAT IN [0 .. rwt.length) DO
            subType: RoseWireType = rwt.class.super.SubType[rwt, [field[i]]];
            subFormat: Format = subType.class.super.GetFormat[subType, f.key];
            fieldName: ROPE = rwt.class.super.FieldName[rwt.class, i];
            bitOffset: INT = rwt.class.super.SelectorOffset[rwt, [field[i]]];
            subPtr: Ptr = BitTwiddling.OffsetPtr[p, bitOffset];
            toke: ROPE;
            IF i # 0 THEN Consume[", "];
            toke _ s.GetTokenRope[WireValBreak].token;
            IF NOT toke.Equal[fieldName] THEN RETURN [FALSE] --lazy implementor--;
            Consume[":"];
            IF
                NOT subFormat.ParseValue[
                    subType,
                    subFormat,
                    subPtr,
                    s
                    ]
                THEN RETURN [FALSE];
            ENDLOOP;
        Consume["]"];
        };

    WireValBreak: PUBLIC PROC [char: CHAR] RETURNS [IO.CharClass] --IO.BreakProc-- = {
        RETURN [SELECT char FROM
            IN [IO.NUL .. IO.SP] => sepr,
            ',, ':, '[, '] => break,
            ENDCASE => other
            ];
        };

    MaxRecConsWidth: PROC [rwt: RoseWireType, f: Format, font: VFonts.Font] RETURNS [max: INT] = {
        AddRope: PROC [r: ROPE] = {
            max _ max + Real.Round[ImagerFont.RopeWidth[font, r].x];
            };
        max _ 0;
        AddRope["[]"];
        FOR i: NAT IN [0 .. rwt.length) DO
            subType: RoseWireType = rwt.class.super.SubType[rwt, [field[i]]];
            subFormat: Format = subType.class.super.GetFormat[subType, f.key];
            fieldName: ROPE = rwt.class.super.FieldName[rwt.class, i];
            IF i # 0 THEN AddRope[", "];
            AddRope[fieldName];
            AddRope[": "];
            max _ max + subFormat.MaxWidth[
                subType,
                subFormat,
                font
                ];
            ENDLOOP;
        max _ max;
        };

    DecimalDigits: PROC [n: NAT] RETURNS [digits: NAT] = {
        digits _ Real.Fix[RealFns.Log[base: 10.0, arg: n+0.5]] + 1;
        };

    Digit: ARRAY [0 .. 16) OF ROPE = [
        "0",    "1",    "2",    "3",
        "4",    "5",    "6",    "7",
        "8",    "9",    "A",    "B",
        "C",    "D",    "E",    "F"];

    END.