
    <<RoseBoolImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Barth, September 5, 1985 6:37:22 pm PDT>>
        <<Spreitzer, September 22, 1985 4:36:24 pm PDT>>

    DIRECTORY Basics, ImagerFont, IO, Real, Rope, RoseTransduce, RoseWireClasses, RoseWireTypes, VFonts;

    RoseBoolImpl: CEDAR PROGRAM
        IMPORTS ImagerFont, IO, Real, Rope, RoseTransduce
        EXPORTS RoseWireClasses, RoseTransduce =

    BEGIN OPEN RoseWireTypes;

    GetBool: PUBLIC PROC RETURNS [RoseWireClass] = {RETURN[boolClass]};

    boolSuperClass: RoseWireSuperClass _ NEW[RoseWireSuperClassRec _ [
        GetType: BoolGetType,
        ListFormats: BoolListFormats,
        GetFormat: BoolGetFormat,
        SelectorOffset: NIL,
        SubType: NIL,
        SubClass: NIL,
        Bits: BoolBits,
        MesaRepresentation: BoolMesaRepresentation,
        MesaRepAux: NIL,
        flavor: simple,
        Initialize: BoolInitialize,
        Transduce: BoolTransduce
        ]];

    boolClass: RoseWireClass _ NEW[RoseWireClassRec _ [
        structure: atom,
        dereference: FALSE,
        addressContaining: FALSE,
        classData: NIL,
        super: boolSuperClass]];

    BoolGetType: PROC [rwc: RoseWireClass, wire: Wire] RETURNS [rwt: RoseWireType] = {
        IF wire.structure # atom THEN ERROR;
        RETURN[boolType];
        };

    boolType: PUBLIC RoseWireType _ NEW[RoseWireTypeRec _ [
        class: boolClass,
        typeData: NIL,
        length: 0,
        other: NIL]];

    BoolListFormats: PROC [rwt: RoseWireType] RETURNS [lor: LOR] = {
        lor _ LIST["numeric"];
        };

    BoolGetFormat: PROC [rwt: RoseWireType, formatName: ROPE] RETURNS [format: Format] = {
        format _ SELECT TRUE FROM
            formatName.Equal["numeric"], formatName=NIL => numericFormat,
            ENDCASE => ERROR;
        };

    BoolBits: PROC [rwt: RoseWireType] RETURNS [n: INT] = {RETURN[1]};

    BoolMesaRepresentation: PROC [rwc: RoseWireClass] RETURNS [mesa: Mesa] = {
        mesa _ [mesa: "BOOL"]};

    BoolInitialize: PROC [rwt: RoseWireType, p: Ptr, steady: BOOL] = {
        WriteBool[p, FALSE];
        };

    BoolTransduce: PROC [fromS: Strength, fromT, toT: RoseWireType, fromP, toP: Ptr] = {
        IF fromT # boolType THEN ERROR;
        IF toT # RoseTransduce.bitType THEN ERROR;
        RoseTransduce.WriteSwitch[
            toP,
            SELECT ReadBool[fromP] FROM
                FALSE => [s: [q: fromS, u: none, d: fromS], val: L],
                TRUE => [s: [q: fromS, u: fromS, d: none], val: H],
                ENDCASE => ERROR
            ];
        };

    numericFormat: Format _ NEW [FormatRep _ [
        FormatValue: NumericFormatValue,
        ParseValue: NumericParseValue,
        MaxWidth: NumericMaxWidth,
        key: "numeric"]];

    NumericFormatValue: PROC [rwt: RoseWireType, f: Format, p: Ptr] RETURNS [r: ROPE] = {
        r _ SELECT ReadBool[p] FROM
            FALSE => "0",
            TRUE => "1",
            ENDCASE => ERROR;
        };

    NumericParseValue: PROC [rwt: RoseWireType, f: Format, p: Ptr, s: STREAM] RETURNS [ok: BOOL] = {
        c: CHAR = s.GetChar[];
        val: BOOL;
        SELECT c FROM
            '0 => val _ FALSE;
            '1 => val _ TRUE;
            ENDCASE => RETURN [FALSE];
        WriteBool[p, val];
        ok _ TRUE;
        };

    NumericMaxWidth: PROC [rwt: RoseWireType, fmt: Format, font: VFonts.Font] RETURNS [max: INT] = {
        max _ Real.Round[ImagerFont.RopeWidth[font, "X"].x];
        };

    BoolArrayPtr: TYPE = LONG POINTER TO PACKED ARRAY [0 .. Basics.bitsPerWord) OF BOOL;

    ReadBool: PUBLIC PROC [p: Ptr] RETURNS [b: BOOL] = TRUSTED {
        bap: BoolArrayPtr = LOOPHOLE[p.word];
        b _ bap[p.bit];
        };

    WriteBool: PUBLIC PROC [p: Ptr, b: BOOL] = TRUSTED {
        bap: BoolArrayPtr = LOOPHOLE[p.word];
        bap[p.bit] _ b;
        };

    END.