
    <<Copyright Ó 1986 by Xerox Corporation.  All rights reserved.>>
        <<gbb December 24, 1986 11:00:54 am PST>>

    DIRECTORY
        Checksum USING [ComputeChecksum],
        Commander USING [CommandProc, Handle, Register],
        CommandTool USING [NextArgument],
        FS USING [defaultStreamOptions, Error, StreamOpen],
        HashTable USING [Create, EachPairAction, GetSize, Insert, Key, Pairs, Table],
        IO USING [Close, EndOfStream, GetReal, int, PutF, PutRope, real, STREAM],
        Rope USING [Cat, ROPE],
        Vector3d USING [Triple, TripleSequence, TripleSequenceRep];
NectarineMakeShapes: CEDAR PROGRAM
IMPORTS Checksum, Commander, CommandTool, FS, HashTable, IO, Rope
~ BEGIN
Point: TYPE ~ Vector3d.Triple;    -- RECORD [x, y, z: REAL]
    PointKey: TYPE ~ REF Point;
    Colors: TYPE ~ Vector3d.TripleSequence;
    ROPE: TYPE ~ Rope.ROPE;
fileNotFound: ERROR [reason: ROPE] = CODE;
rho: REAL _ 0.02;    -- inner radius of columns
Hash: PROC [k: HashTable.Key] RETURNS [CARDINAL] ~ BEGIN
    <<HashTable.HashProc>>
    TRUSTED BEGIN
        RETURN [Checksum.ComputeChecksum [0, SIZE [Point], LOOPHOLE [k]]]
        END
    END;    -- Hash
Match: PROC [a, b: HashTable.Key] RETURNS [BOOL] ~ BEGIN
<<HashTable.EqualProc>>
    k1: PointKey ~ NARROW [a]; k2: PointKey ~ NARROW [b];
    RETURN [(k1.x = k2.x) AND (k1.y = k2.y) AND (k1.z = k2.z)]
    END;    -- Match
ReadColors: PROC [file: ROPE] RETURNS [col: Colors] ~ BEGIN
    <<Parses the input file and creates the structure containing the colors with duplicates removed.>>
counter, total: NAT _ 0;
    NoteColor: HashTable.EachPairAction ~ BEGIN
        c: PointKey ~ NARROW [value];
        col[counter] _ c^;    counter _ counter.SUCC
        END;    -- NoteColor
    input: IO.STREAM ~ FS.StreamOpen [file.Cat [".data"] ! FS.Error => IF error.group#bug THEN ERROR fileNotFound [error.explanation]];
    colourTable: HashTable.Table ~ HashTable.Create [557, Match, Hash];
    skip: REAL;
    DO    -- read input file and insert in colourTable
        color: PointKey ~ NEW [Point];
        color.x _ IO.GetReal [input ! IO.EndOfStream => EXIT];
        color.y _ IO.GetReal [input ! IO.EndOfStream => ERROR fileNotFound ["File incomplete"]];
        color.z _ IO.GetReal [input ! IO.EndOfStream => ERROR fileNotFound ["File incomplete"]];
        [] _ colourTable.Insert [color, color];
        skip _ IO.GetReal [input ! IO.EndOfStream => ERROR fileNotFound ["File incomplete"]]    -- relative area
        ENDLOOP;
    total _ colourTable.GetSize;
    col _ NEW [Vector3d.TripleSequenceRep [total]];    col.length _ total;
    [] _ colourTable.Pairs [NoteColor]
    END;    -- ReadColors
WriteVertices: PROC [n: INT, p: Point, r: REAL, file: IO.STREAM] ~ BEGIN
    <<point is surrounded by a cube with inner radius r. n is the ordinal number of the pointas a vertex.>>
    format: ROPE ~ "%g\t\t%g\t%g\t%g\n";
    top: REAL ~ p.z + r;    bottom: REAL ~ p.z - r;
    <<Lower face, canonical order:>>
    file.PutF [format, IO.int [n+0], IO.real [p.x + r], IO.real [p.y - r], IO.real [bottom]];
    file.PutF [format, IO.int [n+1], IO.real [p.x + r], IO.real [p.y + r], IO.real [bottom]];
    file.PutF [format, IO.int [n+2], IO.real [p.x - r], IO.real [p.y + r], IO.real [bottom]];
    file.PutF [format, IO.int [n+3], IO.real [p.x - r], IO.real [p.y - r], IO.real [bottom]];
    <<Upper face, canonical order:>>
    file.PutF [format, IO.int [n+4], IO.real [p.x + r], IO.real [p.y - r], IO.real [top]];
    file.PutF [format, IO.int [n+5], IO.real [p.x + r], IO.real [p.y + r], IO.real [top]];
    file.PutF [format, IO.int [n+6], IO.real [p.x - r], IO.real [p.y + r], IO.real [top]];
    file.PutF [format, IO.int [n+7], IO.real [p.x - r], IO.real [p.y - r], IO.real [top]]
    END;    -- WriteVertices
WriteProjectionPlaneVertices: PROC [vertexNr: INT, r: REAL, file: IO.STREAM] ~ BEGIN
    format: ROPE ~ "%g\t\t%g\t%g\t%g\n";
    zero: REAL ~ - r;    one: REAL ~ 1.0 + r;
    <<Origin>>
    file.PutF [format, IO.int [vertexNr+0], IO.real [zero], IO.real [zero], IO.real [zero]];
    <<Horizontal plane>>
    file.PutF [format, IO.int [vertexNr+1], IO.real [zero], IO.real [one], IO.real [zero]];
    file.PutF [format, IO.int [vertexNr+2], IO.real [one], IO.real [one], IO.real [zero]];
    file.PutF [format, IO.int [vertexNr+3], IO.real [one], IO.real [zero], IO.real [zero]];
    <<Vertical plane>>
    file.PutF [format, IO.int [vertexNr+4], IO.real [zero], IO.real [zero], IO.real [one]];
    file.PutF [format, IO.int [vertexNr+5], IO.real [zero], IO.real [one], IO.real [one]];
    file.PutF [format, IO.int [vertexNr+6], IO.real [zero], IO.real [one], IO.real [zero]];
    <<Lateral plane>>
    file.PutF [format, IO.int [vertexNr+7], IO.real [one], IO.real [zero], IO.real [zero]];
    file.PutF [format, IO.int [vertexNr+8], IO.real [one], IO.real [zero], IO.real [one]];
    file.PutF [format, IO.int [vertexNr+9], IO.real [zero], IO.real [zero], IO.real [one]]
    END;    -- WriteProjectionPlaneVertices
WriteFaces: PROC [n: INT, color: Point, file: IO.STREAM] ~ BEGIN
    <<Write the colored faces for parallelepiped n into file.>>
    cFormat: ROPE ~ "%g\t%g\t%g\t\t";        -- color
    vFormat: ROPE ~ "%g\t%g\t%g\t%g\n";    -- vertices
    <<Negative order from normal to face:>>
    file.PutF [cFormat, IO.real [color.x],  IO.real [color.y], IO.real [color.z]];    -- bottom
    file.PutF [vFormat, IO.int [n+0],  IO.int [n+1], IO.int [n+2], IO.int [n+3]];    -- bottom
    file.PutF [cFormat, IO.real [color.x],  IO.real [color.y], IO.real [color.z]];    -- top
    file.PutF [vFormat, IO.int [n+4],  IO.int [n+5], IO.int [n+6], IO.int [n+7]];    -- top
    file.PutF [cFormat, IO.real [color.x],  IO.real [color.y], IO.real [color.z]];    -- front
    file.PutF [vFormat, IO.int [n+0],  IO.int [n+4], IO.int [n+5], IO.int [n+1]];    -- front
    file.PutF [cFormat, IO.real [color.x],  IO.real [color.y], IO.real [color.z]];    -- back
    file.PutF [vFormat, IO.int [n+2],  IO.int [n+6], IO.int [n+7], IO.int [n+3]];    -- back
    file.PutF [cFormat, IO.real [color.x],  IO.real [color.y], IO.real [color.z]];    -- left
    file.PutF [vFormat, IO.int [n+3],  IO.int [n+7], IO.int [n+4], IO.int [n+0]];    -- left
    file.PutF [cFormat, IO.real [color.x],  IO.real [color.y], IO.real [color.z]];    -- right
    file.PutF [vFormat, IO.int [n+1],  IO.int [n+5], IO.int [n+6], IO.int [n+2]]    -- right
    END;    -- WriteFaces
WriteProjectionPlanes: PROC [n: INT, color: Point, file: IO.STREAM] ~ BEGIN
    cFormat: ROPE ~ "%g\t%g\t%g\t\t";        -- color
    vFormat: ROPE ~ "%g\t%g\t%g\t%g\n";    -- vertices
    <<Negative order from normal to face:>>
    file.PutF [cFormat, IO.real [color.x],  IO.real [color.y], IO.real [color.z]];    -- horizontal
    file.PutF [vFormat, IO.int [n+0],  IO.int [n+1], IO.int [n+2], IO.int [n+3]];    -- horizontal
    file.PutF [cFormat, IO.real [color.x],  IO.real [color.y], IO.real [color.z]];    -- vertical
    file.PutF [vFormat, IO.int [n+0],  IO.int [n+4], IO.int [n+5], IO.int [n+6]];    -- vertical
    file.PutF [cFormat, IO.real [color.x],  IO.real [color.y], IO.real [color.z]];    -- lateral
    file.PutF [vFormat, IO.int [n+0],  IO.int [n+7], IO.int [n+8], IO.int [n+9]]    -- lateral
    END;    -- WriteProjectionPlanes
MakeShapes: Commander.CommandProc ~ BEGIN
<<[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]>>
    <<Reads a file of rgb values as it can be built using Nectarine and creates shapes to represent them graphically.>>
    ENABLE BEGIN
        fileNotFound => {msg _ reason; GOTO failure}
        END;
file: ROPE ~ CommandTool.NextArgument [cmd];
    colors: Colors ~ ReadColors [file];
    output: IO.STREAM ~ FS.StreamOpen ["///Temp/Nectarine/Colors.Shape", $create, FS.defaultStreamOptions, 2];
    output.PutRope ["SurfaceType ~ ConvexPolygon\n\n"];
    output.PutRope ["Vertices ~ index: integer xyzCoords: triple\n"];
    FOR i: NAT IN [0 .. colors.length) DO
        WriteVertices [i*8, colors.element[i], rho, output]
        ENDLOOP;
    WriteProjectionPlaneVertices [(colors.length * 8), rho, output];
    output.PutRope ["\nPolygons ~ color: triple vertices: nats\n"];
    FOR i: NAT IN [0 .. colors.length) DO WriteFaces [i*8, colors.element[i], output] ENDLOOP;
    WriteProjectionPlanes [(colors.length * 8), [0.9, 0.9, 0.9], output];
    output.Close;
    msg _ "Build shapes are in ///Temp/Nectarine/Colors.Shape";
    EXITS
        failure => result _ $Failure
    END;    -- MakeShapes
Commander.Register [key: "NShapes", proc: MakeShapes, doc: "Expects a file containing the Nectarine color statistics and builds a 
set of shapes in a file."]
END.