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];
~
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."]