DIRECTORY
Atom USING [GetPropFromList],
Basics USING [LowHalf],
BasicTime USING [GMT, nullGMT],
FS USING [Error, StreamOpen],
Graph USING [CaretIndex, CaretSpec, ColorIndex, Entity, EntityGroup, EntityGroupList, EntityGroupRec, EntityList, FontIndex, GRAPH, GraphHandle, NestedEntities, NestedEntitiesList, ROPE, SegmentDataList, TargetSpec, Text, Texts, ValueList, XY],
GraphConvert USING [VLFromSDL],
GraphFileKeys,
GraphPrivate USING [CharPair, FourChars, GraphStreamProc, LVL, STREAM],
GraphUtil USING [FullName, LengthOfSDL, LengthOfVL, ReverseValueList],
IO USING [Close, Error, Flush, PutBlock, PutChar, PutF, real, rope, STREAM],
List USING [Kill],
Rope USING [IsEmpty, Length, ToRefText];
WriteGraphFile:
PUBLIC
PROC [handle: GraphHandle ←
NIL, file:
ROPE ←
NIL, plottedOnly:
BOOL ←
TRUE]
RETURNS[msg, newName:
ROPE ←
NIL] = {
IF handle = NIL THEN RETURN["handle = NIL IN WriteGraphFile"]
ELSE IF file.IsEmpty THEN RETURN ["File name is empty."]
ELSE {
OPEN handle;
ok: BOOL ← TRUE;
s: STREAM ← NIL;
nVector: CARDINAL ← 0;
s ←
FS. StreamOpen[fileName: file, accessOptions: $create, keep: 10
! FS.Error => {msg ← error.explanation; ok ← FALSE; CONTINUE} ];
IF ok
THEN {
ENABLE
IO.Error => {
msg ← "Write Error.";
ok ← FALSE;
CONTINUE };
PutRope[s, "binary graph"]; -- format id
PutTexts[s, IF plottedOnly THEN graph.texts ELSE handle.allTexts];
PutCarets[s, graph];
PutByte[s, ShowSlopeKey]; PutBool[s, graph.showSlope];
PutTargets[s, graph];
PutGrids[s, graph];
PutDivisions[s, graph];
PutBounds[s, graph];
PutColors[s, graph];
PutFonts[s, graph];
PutEntityGroupList[s, handle, plottedOnly];
PutByte[s, EndOfRecordKey];
};
IF s #
NIL
THEN {
s.Flush[];
s.Close[];
newName ← NARROW[Atom.GetPropFromList[s.propList, $Name]]
};
};
}; -- WriteGraphFile
PutTexts:
PROC [s:
STREAM, texts: Texts] = {
PutByte[s, TextsKey];
FOR ts: Texts ← texts, ts.rest
UNTIL ts =
NIL
DO
text: Text ← ts.first;
PutByte[s, TextKey];
PutByte[s, NameKey]; PutRope[s, text.text];
PutByte[s, PlaceKey]; PutReal[s, text.place.x]; PutReal[s, text.place.y];
PutByte[s, FontIndexKey]; PutByte[s, text.fontIndex];
PutByte[s, ColorIndexKey]; PutByte[s, text.colorIndex];
PutByte[s, RotationKey]; PutReal[s, text.rotation];
PutByte[s, JustificationsKey];
PutByte[s, XKey]; PutByte[s,
SELECT text.justifX FROM left => 1, center => 2, ENDCASE => 3];
PutByte[s, YKey]; PutByte[s,
SELECT text.justifY FROM top => 1, center => 2, ENDCASE => 3];
PutByte[s, EndOfRecordKey];
PutByte[s, TextIdKey]; PutInt[s, text.id];
PutByte[s, EndOfRecordKey];
ENDLOOP;
PutByte[s, EndOfListKey];
}; -- PutTexts
PutCarets: GraphStreamProc = {
PutByte[s, CaretsKey];
FOR index: CaretIndex
IN CaretIndex
DO
PutByte[s,
SELECT index
FROM
primary => PrimaryKey, secondary => SecondaryKey, ENDCASE => TextCaretKey];
PutByte[s, PlaceKey];
PutReal[s, graph.caret[index].place.x];
PutReal[s, graph.caret[index].place.y];
PutByte[s, OnKey];
PutBool[s, graph.caret[index].on];
PutByte[s, EndOfRecordKey];
ENDLOOP;
PutByte[s, EndOfRecordKey];
}; -- PutCarets
PutTargets: GraphStreamProc = {
PutByte[s, TargetsKey];
FOR xy:
XY
IN
XY
DO
OPEN graph.target[xy];
PutByte[s, IF xy = x THEN XKey ELSE YKey];
PutByte[s, ValueKey]; PutReal[s, value];
PutByte[s, WidthKey]; PutReal[s, width];
PutByte[s, ColorIndexKey]; PutByte[s, colorIndex];
PutByte[s, OnKey]; PutBool[s, on];
PutByte[s, EndOfRecordKey];
ENDLOOP;
PutByte[s, EndOfRecordKey];
}; -- PutTargets
PutGrids: GraphStreamProc = {
PutByte[s, GridsKey];
FOR xy:
XY
IN
XY
DO
PutByte[s, IF xy = x THEN XKey ELSE YKey];
PutByte[s, OnKey]; PutBool[s, graph.grids[xy]];
PutByte[s, EndOfRecordKey];
ENDLOOP;
PutByte[s, EndOfRecordKey];
}; -- PutGrids
PutDivisions: GraphStreamProc = {
PutByte[s, DivisionsKey];
FOR xy:
XY
IN
XY
DO
PutByte[s, IF xy = x THEN XKey ELSE YKey];
PutByte[s, AutoKey]; PutBool[s, graph.auto[divisions]];
PutByte[s, DivisionsKey]; PutByte[s, graph.division[xy]];
PutByte[s, EndOfRecordKey];
ENDLOOP;
PutByte[s, EndOfRecordKey];
}; -- PutDivisions
PutBounds: GraphStreamProc = {
PutByte[s, BoundsKey];
FOR xy:
XY
IN
XY
DO
OPEN graph.bounds;
PutByte[s, IF xy = x THEN XKey ELSE YKey];
PutByte[s, AutoKey]; PutBool[s, graph.auto[bounds]];
PutByte[s, MaxKey]; PutReal[s, IF xy = x THEN xmax ELSE ymax];
PutByte[s, MinKey]; PutReal[s, IF xy = x THEN xmin ELSE ymin];
PutByte[s, EndOfRecordKey];
ENDLOOP;
PutByte[s, EndOfRecordKey];
}; -- PutBounds
PutColors: GraphStreamProc = {
PutByte[s, ColorsKey];
FOR i: ColorIndex
IN ColorIndex
DO
OPEN graph.color[i];
PutByte[s, i+1];
PutByte[s, RKey]; PutReal[s, R];
PutByte[s, GKey]; PutReal[s, G];
PutByte[s, BKey]; PutReal[s, B];
PutByte[s, EndOfRecordKey];
ENDLOOP;
PutByte[s, EndOfRecordKey];
}; -- PutColors
PutFonts: GraphStreamProc = {
PutByte[s, FontsKey];
FOR i: FontIndex
IN FontIndex
DO
OPEN graph.font[i];
PutByte[s, i+1];
PutByte[s, NameKey]; PutRope[s, family];
PutByte[s, BoldKey]; PutBool[s, bold];
PutByte[s, ItalicKey]; PutBool[s, italic];
PutByte[s, VFontSizeKey]; PutInt[s, vFontSize];
PutByte[s, PFontScaleKey]; PutReal[s, pFontScale];
PutByte[s, EndOfRecordKey];
ENDLOOP;
PutByte[s, EndOfRecordKey];
}; -- PutFonts
PutEntityGroupList:
PROC [s:
STREAM, handle: GraphHandle, plottedOnly:
BOOL ←
TRUE] = {
PutByte[s, EntityGroupListKey];
FOR egl: EntityGroupList ← handle.entityGroupList, egl.rest
UNTIL egl =
NIL
DO
eg: EntityGroup ← egl.first;
PutByte[s, EntityGroupKey];
PutEntity[s, eg.x, plottedOnly];
IF plottedOnly THEN PutPlottedNE[s, handle.graph.entityList, eg]
ELSE PutAllNE[s, eg.ys];
PutByte[s, GroupIdKey]; PutInt[s, eg.id];
PutByte[s, LengthKey]; PutInt[s, eg.length];
PutCrossSections[s, eg];
PutByte[s, EndOfRecordKey];
ENDLOOP;
PutByte[s, EndOfListKey];
}; -- PutEntityGroupList
PutEntity:
PROC [s:
STREAM, entity: Entity, plottedOnly:
BOOL ←
TRUE] = {
PutByte[s, EntityKey];
PutByte[s, NameKey];
PutRope[s, IF plottedOnly THEN FullName[entity] ELSE entity.name];
PutByte[s, CommentKey];
PutRope[s, IF plottedOnly THEN "" ELSE entity.comment];
PutByte[s, ColorIndexKey]; PutByte[s, entity.colorIndex];
PutByte[s, MarkKey]; PutByte[s,
SELECT entity.mark
FROM
none => NoneKey, round => RoundKey, square => SquareKey,
diamond => DiamondKey, cross => CrossKey, dollar => DollarKey,
ENDCASE => PercentKey];
PutByte[s, WidthKey]; PutReal[s, entity.width];
IF plottedOnly THEN PutValuesForSDL[s, entity.segments]
ELSE PutValuesForVL[s, entity.oldValues];
PutByte[s, EntityIdKey]; PutInt[s, entity.id];
PutByte[s, EndOfRecordKey];
}; -- PutEntity
PutAllEL:
PROC [s:
STREAM, entityList: EntityList] = {
PutByte[s, EntityListKey];
FOR el: EntityList ← entityList, el.rest
UNTIL el =
NIL
DO
PutEntity[s, el.first, FALSE];
ENDLOOP;
PutByte[s, EndOfListKey];
}; -- PutAllEL
PutPlottedEL:
PROC [s:
STREAM, entityList: EntityList, group: EntityGroup] = {
PutByte[s, EntityListKey];
FOR el: EntityList ← entityList, el.rest
UNTIL el =
NIL
DO
IF el.first.group = group THEN PutEntity[s, el.first, TRUE];
ENDLOOP;
PutByte[s, EndOfListKey];
}; -- PutPlottedEL
PutPlottedNE:
PROC [s:
STREAM, plottedEL: EntityList, group: EntityGroup] = {
PutByte[s, NestedEntitiesKey];
PutByte[s, NameKey]; PutRope[s, group.ys.name];
PutByte[s, CommentKey]; PutRope[s, group.ys.comment];
PutPlottedEL[s, plottedEL, group];
PutNEL[s, NIL];
PutByte[s, EndOfRecordKey];
}; -- PutPlottedNE
PutAllNE:
PROC [s:
STREAM, ne: NestedEntities] = {
PutByte[s, NestedEntitiesKey];
PutByte[s, NameKey]; PutRope[s, ne.name];
PutByte[s, CommentKey]; PutRope[s, ne.comment];
PutAllEL[s, ne.entityList];
PutNEL[s, ne.children];
PutByte[s, EndOfRecordKey];
}; -- PutAllNE
PutNEL:
PROC [s:
STREAM, nestedEL: NestedEntitiesList] = {
PutByte[s, NELKey];
FOR nel: NestedEntitiesList ← nestedEL, nel.rest
UNTIL nel =
NIL
DO
PutAllNE[s, nel.first];
ENDLOOP;
PutByte[s, EndOfListKey];
}; -- PutNEL
PutValuesForVL:
PROC [s:
STREAM, valueList: ValueList] = {
PutByte[s, ValuesKey];
PutInt[s, LengthOfVL[valueList]];
FOR vl: ValueList ← valueList, vl.rest
UNTIL vl =
NIL
DO
PutReal[s, vl.first];
ENDLOOP;
}; -- PutValuesForVL
PutValuesForSDL:
PROC [s:
STREAM, segmentDataList: SegmentDataList] = {
PutByte[s, ValuesKey];
PutInt[s, LengthOfSDL[segmentDataList]];
FOR sdl: SegmentDataList ← segmentDataList, sdl.rest
UNTIL sdl =
NIL
DO
PutReal[s, sdl.first.end];
ENDLOOP;
PutCrossSections:
PROC [s:
STREAM, eg: EntityGroup] = {
vllR, vll, tvll: LVL ← NIL;
GetVLfromSDL:
PROC [segmentDataList: SegmentDataList]
RETURNS [vl: ValueList ←
NIL] = {
FOR sdl: SegmentDataList ← segmentDataList, sdl.rest
UNTIL sdl =
NIL
DO
vl ← CONS[sdl.first.end, vl];
ENDLOOP;
[vl, ] ← ReverseValueList[vl];
}; -- GetVLfromSDL
GetVLsFromNE:
PROC [ne: NestedEntities, old:
LVL]
RETURNS [new:
LVL ←
NIL] = {
result is in reverse order !!
new ← old;
FOR el: EntityList ← ne.entityList, el.rest
UNTIL el =
NIL
DO
new ←
CONS[
IF el.first.segments = NIL THEN el.first.oldValues
ELSE GetVLfromSDL[el.first.segments],
new]
ENDLOOP;
new ← GetVLsFromNEL[ne.children, new];
}; -- GetVLsFromNE
GetVLsFromNEL:
PROC [nestedEntitiesList: NestedEntitiesList, old:
LVL]
RETURNS [new:
LVL ←
NIL] = {
-- result is in reverse order !!
new ← old;
FOR nel: NestedEntitiesList ← nestedEntitiesList, nel.rest
UNTIL nel =
NIL
DO
new ← GetVLsFromNE[nel.first, new];
ENDLOOP;
}; -- GetVLsFromNEL
CleanUpLVL:
PROC [old:
LVL]
RETURNS [
LVL] = {
WHILE old #
NIL
DO
next: LVL ← old.rest;
old.first ← NIL;
old.rest ← NIL;
old ← next;
ENDLOOP;
RETURN[NIL];
}; -- CleanUpLVL
vllR ← CONS[GetVLfromSDL[eg.x.segments], NIL]; -- list of vl in reverse order.
vllR ← GetVLsFromNE[eg.ys, vllR];
copy to vll in the correct order.
FOR tvll ← vllR, tvll.rest
UNTIL tvll =
NIL
DO
vll ← CONS[tvll.first, vll];
ENDLOOP;
clean up the reversed one.
vllR ← CleanUpLVL[vllR];
start to work.
PutByte[s, CrossSectionsKey];
IF vll #
NIL
THEN
UNTIL vll.first =
NIL
DO
PutByte[s, TailsKey]; -- keyword before each set of tails
FOR tvll ← vll, tvll.rest
UNTIL tvll =
NIL
DO
vl: ValueList ← tvll.first;
IF vl = NIL THEN EXIT;
PutReal[s, vl.first];
tvll.first ← vl.rest;
ENDLOOP;
ENDLOOP;
PutByte[s, EndOfListKey];
clean up.
vll ← CleanUpLVL[vll];
}; -- PutCrossSections
WriteTextFile:
PUBLIC
PROC [handle: GraphHandle, file:
ROPE]
RETURNS [msg:
ROPE ←
NIL] = {
write simple data table for the graph
IF handle = NIL THEN RETURN["handle is nil"]
ELSE IF file.IsEmpty[] THEN RETURN["File name is empty."]
ELSE {
OPEN handle;
s: STREAM ← NIL;
s ←
FS. StreamOpen[fileName: file, accessOptions: $create, keep: 10
! FS.Error => {
msg ← error.explanation;
CONTINUE} ];
IF msg =
NIL
THEN {
ENABLE IO.Error => {msg ← "WriteText Error."; CONTINUE };
first: BOOL ← TRUE;
s.PutF["-- %g\n", IO.rope[file]];
FOR egl: EntityGroupList ← entityGroupList, egl.rest
UNTIL egl =
NIL
DO
group: EntityGroup ← egl.first;
plotted: BOOL ← FALSE;
FOR el: EntityList ← graph.entityList, el.rest
UNTIL el =
NIL
DO
IF el.first.group = group THEN {plotted ← TRUE; EXIT};
ENDLOOP;
IF plotted
THEN {
s.PutF["\nvariables:\n\n\"%g%g\" ", IO.rope[group.x.name], IO.rope[group.x.comment]];
FOR el: EntityList ← graph.entityList, el.rest
UNTIL el =
NIL
DO
IF el.first.group = group
THEN {
IF first THEN first ← FALSE ELSE s.PutF[", "];
s.PutF["\"%g\" ", IO.rope[FullName[el.first]]];
};
ENDLOOP;
s.PutF["\n\nvalues:\n\n"];
WriteCrossSections[s, graph.entityList, group];
};
ENDLOOP;
};
IF s # NIL THEN {s.Flush[]; s.Close[]};
};
}; -- WriteTextFile
WriteCrossSections:
PROC [s:
IO.
STREAM, entityList: EntityList, group: EntityGroup] = {
write plotted curves in texts, so caller is responsible to make sure that segments of each entity is not nil.
vll, vllLast: LVL ← NIL;
FOR el: EntityList ← entityList, el.rest
UNTIL el =
NIL
DO
IF el.first.group = group
THEN {
tvl: LVL ← CONS[GraphConvert.VLFromSDL[el.first.segments], NIL];
IF vllLast =
NIL
THEN {
xvl: LVL ← CONS[GraphConvert.VLFromSDL[group.x.segments], NIL];
vll ← vllLast ← xvl;
vllLast.rest ← tvl;
vllLast ← tvl;
}
ELSE {vllLast.rest ← tvl; vllLast ← tvl};
};
ENDLOOP;
IF vll #
NIL
THEN
UNTIL vll.first =
NIL
DO
FOR tvl:
LVL ← vll, tvl.rest
UNTIL tvl =
NIL
DO
vl: ValueList ← tvl.first;
IF vl = NIL THEN EXIT;
s.PutF[IF tvl.rest = NIL THEN "%g\n" ELSE "%g ", IO.real[vl.first]];
tvl.first ← vl.rest;
ENDLOOP;
ENDLOOP;
TRUSTED{List.Kill[LOOPHOLE[vll]]};
TRUSTED{List.Kill[LOOPHOLE[vllLast]]};
}; -- WriteCrossSections
writing routines
PutRope:
PROC [stream:
STREAM, rope:
ROPE ←
NIL] = {
length: CARDINAL ← Basics.LowHalf[rope.Length[]];
PutCardinal[stream, length];
stream.PutBlock[Rope.ToRefText[rope], 0, length];
}; -- PutRope
PutTime:
PROC [stream:
STREAM, time: BasicTime.
GMT ← BasicTime.nullGMT] = {
PutLongWord[stream, LOOPHOLE[time, FourChars]];
}; -- PutTime
PutBool:
PROC[stream:
STREAM, bool:
BOOL ←
TRUE] = {
PutByte[stream, IF bool THEN TrueKey ELSE FalseKey];
}; -- PutBool
PutByte:
PROC [stream:
STREAM, byte:
BYTE ← 0] = {
stream.PutChar[LOOPHOLE[byte, CHAR]];
}; -- PutByte
PutInt:
PROC [stream:
STREAM, int:
INT ← 0] = {
PutLongWord[stream, LOOPHOLE[int, FourChars]];
}; -- PutInt
PutReal:
PROC [stream:
STREAM, real:
REAL ← 0] = {
PutLongWord[stream, LOOPHOLE[real, FourChars]];
}; -- PutReal
PutCardinal:
PROC [stream:
STREAM, word:
CARDINAL ← 0] = {
pair: CharPair ← LOOPHOLE[word, CharPair];
stream.PutChar[pair.high];
stream.PutChar[pair.low];
}; -- PutCardinal
PutLongWord:
PROC [stream:
STREAM, long: FourChars] =
INLINE {
stream.PutChar[long.lh];
stream.PutChar[long.ll];
stream.PutChar[long.hh];
stream.PutChar[long.hl];
}; -- PutLongCard
}.