
<<ColorsImpl.mesa>>
<<Last Edited by: Arnon, July 19, 1985 2:54:46 pm PDT>>
<<>>
DIRECTORY
Rope,
Atom,
    IO,
    Convert,
    Imager,
    ImagerColor,
    MathExpr,
    MathConstructors,
AlgebraClasses,
Colors;

ColorsImpl: CEDAR PROGRAM
IMPORTS Atom, IO, Convert, ImagerColor, AlgebraClasses, MathConstructors
EXPORTS Colors =

BEGIN OPEN AC: AlgebraClasses, Colors;
<<Errors>>
SyntaxError: PUBLIC ERROR [reason: ATOM] = CODE;
BadElementStructure: PUBLIC ERROR [elementStructure: AC.Structure] = CODE;
TypeError: PUBLIC ERROR [message: ATOM _ $Unspecified] = CODE;
<<Class for Color Structures>>
ClassPrintName: AC.PrintNameProc = {
RETURN["Colors"];
};
ClassShortPrintName: AC.PrintNameProc = {
RETURN["Colors"];
};
ClassIsElementOf: AC.ElementOfProc = {
<<Assumes that if item is a color, then it really belongs to the domain pointed to by its structure field.>>
IF NOT structure.class.structureEqual[structure, item.structure] THEN RETURN[FALSE];
RETURN[ TRUE ]
}; 
ClassLegalFirstChar: AC.LegalFirstCharOp = {
    SELECT char FROM
        IN ['A..'Z] => RETURN[TRUE];
        ENDCASE;
    RETURN[FALSE];
};
ClassToExpr: AC.ToExprOp = {
inData: ColorData;
IF in=NIL THEN {
out _ MathConstructors.MakeVariable["NilColor"];
    RETURN;
    };
inData _ NARROW[in.data];
IF inData=NIL THEN {
out _ MathConstructors.MakeVariable["NilColor"];
    RETURN;
    };
out _ MathConstructors.MakeVariable[inData.name];
}; 

    colorProp: Atom.DottedPair _ NEW[Atom.DottedPairNode_ [$ColorStructure, NIL]];

colorStructureClass: AC.StructureClass _ NEW[AC.StructureClassRec _ [
category: set,
printName: ClassPrintName,
shortPrintName: ClassShortPrintName,
    structureEqual: AC.defaultStructureEqualityTest,

    isElementOf: ClassIsElementOf,

legalFirstChar: ClassLegalFirstChar,
read: Read,
fromRope: FromRope,
toRope: ToRope,
toIndexRope: ToRope,
write: Write,
toExpr: ClassToExpr,


    integralDomain: FALSE,
    gcdDomain: FALSE,
    euclideanDomain: FALSE,

propList: LIST[colorProp]
    ] ];

Colors: PUBLIC AC.Structure _ NEW[AC.StructureRec _ [
class: colorStructureClass,
instanceData: NIL
    ] ];
<<Predicate>>
    IsColorStructure: PUBLIC PROC [structure: AC.Structure] RETURNS [BOOL] ~ {
        IF Atom.GetPropFromList[structure.class.propList, $ColorStructure] # NIL THEN RETURN[TRUE] ELSE RETURN[FALSE];
        };

<<Conversion and IO>>
Read: PUBLIC AC.ReadOp ~ {
    token: Rope.ROPE _ in.GetID[];
    atom: ATOM _ Convert.AtomFromRope[token];
    outData: ColorData _ NEW[ColorDataRec _ [
        name: token,
        value: ImagerColor.ColorFromAtom[atom]
        ] ];
    out _ NEW[AC.ObjectRec _ [structure: structure, data: outData] ];
    RETURN[out];
    };

FromRope: PUBLIC AC.FromRopeOp ~ {
out _ Read[IO.RIS[in], structure];
};

ToRope: PUBLIC AC.ToRopeOp ~ { 
inData: ColorData;
IF in=NIL THEN RETURN["NilColor"];
inData _ NARROW[in.data];
IF inData=NIL THEN RETURN["NilColor"];
out _ inData.name;
    };

Write: PUBLIC AC.WriteOp ~ {
stream.PutRope[ToRope[in] ]
};  
END.