DIRECTORY
BasicTime USING [Now],
CubicSplines USING [SplineType],
FS USING [Error, StreamOpen],
GriffinColor USING [ColorFromFileColor, FileColor, FileColorFromColor],
GriffinData USING [DataRec],
GriffinFile USING [DiskHandle],
GriffinFileFormat USING [BYTE, cNameChars, fontChars, GFileCaptionTrailer, GFileControlPair, GFileDisplayController, GFileFigureName, GFileFont, GFileHardcopyController, GFileHeader, GFileKnotWord, GFileObject, GFilePoint, GFileReal, GFileSector, GFileStyle, lGFileCaptionTrailer, lGFileControlPair, lGFileDisplayController, lGFileFigureName, lGFileFont, lGFileHardcopyController, lGFileHeader, lGFileKnotWord, lGFileObject, lGFilePoint, lGFileReal, lGFileStyle, pNameChars, SectorIndex, sNameChars, typeAngledEnd, typeAngledJunction, typeAreaObject, typeBEZSpline, typeBSISpline, typeBSpline, typeCALSpline, typeCaptionObject, typeCenterAnchor, typeCRSpline, typeCSTraj, typeCUMSpline, typeCurveObject, typeCyclicEnd, typeDash1, typeDash2, typeDash3, typeDash4, typeDash5, typeFD0Knot, typeFD1Knot, typeFD2Knot, typeFD3Knot, typeFlatEnd, typeLeftAnchor, typeLinkedTraj, typeNALSpline, typeNotVisible, typeNUMSpline, typePartiallyVisible, typeRightAnchor, typeRot0, typeRot180, typeRot270, typeRot90, typeRoundEnd, typeRoundJunction, typeSquareJunction, typeTokenObject, typeUnDashed, typeWhollyVisible, ValidFigRange],
GriffinKernel USING [Data, DataRec],
GriffinObject USING [EncodeObject, ForAllObjects, GetNextClusterID, Link, Object, ObjectHandle, ObjectProc, openCluster, StartObject, Trajectory, View],
GriffinPoint USING [ObjPt, ObjPtSequence, ObjPtSequenceRec, ScrPt, X, Y],
GriffinRelation USING [AddPair, CreateRelation, DestroyRelation, notFound, Relation, Right],
GriffinStyle USING [Color, ComputeStringType, CreateFontList, CreateStyleList, FindEquivalentStyle, FontDescriptor, FontDescriptorHandle, FontFromInternalFont, FontSequence, FontSequenceRec, InternalFontFromFont, NextName, NumberOfFont, NumberOfStyle, Style, StyleHandle, StyleSequence, StyleSequenceRec],
GriffinText USING [GetBoundingBox],
GriffinUserMessage USING [UserMessage],
IO USING [Close, Flush, GetBlock, GetChar, GetIndex, PutBlock, PutChar, SetIndex, STREAM, UnsafeBlock, UnsafeGetBlock, UnsafePutBlock],
PrincOpsUtils USING [LongCopy],
Real USING [RoundC],
RealConvert USING [Mesa5ToIeee],
Rope USING [Fetch, Flatten, FromProc, FromRefText, Length, ROPE, ToRefText],
UserCredentials USING [Get];
GriffinFileImpl:
PROGRAM
--cannot be CEDAR PROGRAM because of many @ operators
IMPORTS BasicTime, FS, GriffinColor, GriffinObject, GriffinRelation, GriffinStyle, GriffinText, GriffinUserMessage, IO, PrincOpsUtils, Real, RealConvert, Rope, UserCredentials
EXPORTS GriffinFile, GriffinKernel = BEGIN OPEN GriffinFile;
GriffinFileError: PUBLIC SIGNAL = CODE;
ROPE: TYPE = Rope.ROPE;
TWOBYTES: TYPE = MACHINE DEPENDENT RECORD [high: CHARACTER, low: CHARACTER];
DiskHandle: TYPE = GriffinFile.DiskHandle;
Data: TYPE = REF DataRec;
DataRec: PUBLIC TYPE = GriffinData.DataRec; --exported to GriffinKernel
X: NAT = GriffinPoint.X;
Y: NAT = GriffinPoint.Y;
maxCPairCount: CARDINAL = 2000; -- just for safety
majorVersion: GriffinFileFormat.BYTE = 3;
minorVersion: GriffinFileFormat.BYTE = 2;
version 2.0 is Cedar
version 2.1 is after string fix
version 2.2 is Cedar 5 ?
version 3.0 is cedar 6.0
version 3.1 is Cedar6.0 after modernization by Stone and Pier
version 3.2 is after fix to curve bug
GetReal:
PROC [r:
REAL, convert:
BOOL]
RETURNS [
REAL] = {
IF convert THEN RETURN[RealConvert.Mesa5ToIeee[LOOPHOLE[r]]]
ELSE RETURN[r];
};
OpenFile:
PUBLIC
PROC [filename:
ROPE, write:
BOOLEAN ←
FALSE]
RETURNS [diskHandle: DiskHandle ←
NIL] = {
newfile: BOOLEAN ← FALSE;
username: ROPE;
header: GriffinFileFormat.GFileHeader;
j: INTEGER; -- just a loop control variable
IF write
THEN {
len: INTEGER;
diskHandle ←
FS.StreamOpen[fileName: filename, accessOptions: $create, keep: 2 !
FS.Error => {
IF error.group=user
AND error.code=$unknownFile
THEN SIGNAL GriffinUserMessage.UserMessage["Unknown file"]
ELSE IF error.group=user AND error.code=$globalCreation
THEN SIGNAL GriffinUserMessage.UserMessage["Can't write on remote file"]
ELSE SIGNAL GriffinFileError
};
];
Zero[@header, GriffinFileFormat.lGFileHeader];
header.majversion ← majorVersion;
header.minversion ← minorVersion;
header.createtime ← LOOPHOLE[BasicTime.Now[], LONG CARDINAL];--don't change the interface
header.numfigs ← 0;
header.nextsector ← GriffinFileFormat.SectorIndex [1];
Reset[diskHandle];
FOR j IN GriffinFileFormat.ValidFigRange DO header.figure[j] ← GriffinFileFormat.SectorIndex [0]; ENDLOOP;
[username, ] ← UserCredentials.Get[];
len ← Rope.Length[username];
header.creatorname[0] ← LOOPHOLE [len, CHARACTER];
FOR j
IN [1 .. GriffinFileFormat.cNameChars]
DO
header.creatorname[j] ← IF j > len THEN 0C ELSE Rope.Fetch[username, j-1];
ENDLOOP;
len ← Rope.Length[filename];
header.portfolioname[0] ← LOOPHOLE [len, CHARACTER];
FOR j
IN [1 .. GriffinFileFormat.pNameChars]
DO
header.portfolioname[j] ← IF j > len THEN 0C ELSE Rope.Fetch[filename, j-1];
ENDLOOP;
WriteHeaderAndFlush[@header, diskHandle];
}
ELSE diskHandle ←
FS.StreamOpen[fileName: filename, accessOptions: $read !
FS.Error =>
{
IF error.group=user AND error.code=$unknownFile
THEN SIGNAL GriffinUserMessage.UserMessage["Unknown file"]
ELSE SIGNAL GriffinFileError
}];
};
CloseFile:
PUBLIC
PROC [diskHandle: DiskHandle] = {
fileheader: GriffinFileFormat.GFileHeader;
[] ← ReadHeader [@fileheader, diskHandle];
MoveToSector [fileheader.nextsector, diskHandle];
IO.Close[diskHandle];
};
ReadFigure:
PUBLIC
PROC [data: Data, diskHandle: DiskHandle] = {
fileheader: GriffinFileFormat.GFileHeader;
hcontrol: GriffinFileFormat.GFileHardcopyController;
dcontrol: GriffinFileFormat.GFileDisplayController;
controlpair: GriffinFileFormat.GFileControlPair;
font: GriffinFileFormat.GFileFont;
figurename: GriffinFileFormat.GFileFigureName;
stylecount, fontcount, objectcount, i, slen, f, s: CARDINAL;
fd: GriffinStyle.FontDescriptorHandle ← NEW[GriffinStyle.FontDescriptor];
clusterMap: GriffinRelation.Relation;
newStyles, oldStyles: GriffinStyle.StyleSequence;
fontList: GriffinStyle.FontSequence;
fignum: CARDINAL=1; --original plan involved multiple figures in a portfolio. Never used more than 1
data.oldVersion ← ReadHeader[@fileheader, diskHandle];
IF fignum > fileheader.numfigs OR fignum = 0 THEN SIGNAL GriffinFileError;
MoveToSector[fileheader.figure[fignum], diskHandle]; -- go to the right sector
ReadStructure[@figurename, GriffinFileFormat.lGFileFigureName, diskHandle];
ReadStructure[@hcontrol, GriffinFileFormat.lGFileHardcopyController, diskHandle];
ReadStructure[@dcontrol, GriffinFileFormat.lGFileDisplayController, diskHandle];
IF dcontrol.numcontrolpairs > maxCPairCount THEN SIGNAL GriffinFileError;
THROUGH [1 .. dcontrol.numcontrolpairs]
DO
ReadStructure[@controlpair, GriffinFileFormat.lGFileControlPair, diskHandle];
controlpairs are not used but must be read out of the file.
ENDLOOP;
fontcount ← ReadWord[diskHandle];
fontList ← NEW[GriffinStyle.FontSequenceRec[fontcount]];
FOR f
IN [0 .. fontcount)
DO
FProc: SAFE PROC RETURNS [CHAR] = CHECKED {i ← i+1; RETURN[ font.char [i]]};
ReadStructure[@font, GriffinFileFormat.lGFileFont, diskHandle];
slen ← LOOPHOLE [font.char [0], GriffinFileFormat.BYTE]; -- just a temp
i ← 0;
fd.name ← Rope.FromProc[slen, FProc];
fd.rotation ← font.rotation;
fd.face ← font.face;
fd.points ← font.points;
fontList[f] ← GriffinStyle.FontFromInternalFont[fd];
ENDLOOP;
stylecount ← ReadWord[diskHandle];
oldStyles ← GriffinStyle.CreateStyleList[data]; -- attempt to collapse existing styles/new styles
newStyles ← NEW[GriffinStyle.StyleSequenceRec[stylecount]];
FOR s
IN [0 .. stylecount)
DO
newStyles[s] ← ReadStyle[fontList, oldStyles, data, diskHandle]; --returns a style, reusing duplicates
ENDLOOP;
objectcount ← ReadWord[diskHandle];
clusterMap ← GriffinRelation.CreateRelation[];
N.B.: ReadObject calls StartObject which links each object into the object list in data
THROUGH [1 .. objectcount]
DO
ReadObject[newStyles, clusterMap, data, diskHandle,
check here for versions that need points added to cyclic curves
fileheader.majversion < 3 OR
(fileheader.majversion=3.0 AND (fileheader.minversion=0 OR fileheader.minversion=1))
];
ENDLOOP;
GriffinRelation.DestroyRelation[clusterMap];
};
WriteFigure:
PUBLIC
PROC [data: Data, diskHandle: DiskHandle] = {
figbegin: GriffinFileFormat.SectorIndex;
i, figlength: CARDINAL;
header: GriffinFileFormat.GFileHeader;
fignum: CARDINAL=1; --was a plan involving multiple figures, now canceled
[] ← ReadHeader[@header, diskHandle];
IF fignum > header.numfigs + 1 THEN SIGNAL GriffinUserMessage.UserMessage["Invalid Griffin file"];
figbegin ← header.figure[fignum];
IF figbegin=0 THEN figbegin ← header.figure[fignum] ← GriffinFileFormat.SectorIndex[1];
MoveToSector[header.nextsector, diskHandle];
figlength ← WriteFigureContents[data, diskHandle] - header.nextsector;
FOR i
DECREASING
IN [fignum .. header.numfigs]
DO
header.figure[i+1] ← GriffinFileFormat.SectorIndex[header.figure[i] +figlength];
ENDLOOP;
MoveSectors[figbegin, figlength, header.nextsector, diskHandle];
header.nextsector ← GriffinFileFormat.SectorIndex[header.nextsector + figlength];
IF header.numfigs >= fignum
THEN {
-- wasn't last fig, write it again
MoveToSector[figbegin, diskHandle];
[] ← WriteFigureContents[data, diskHandle];
};
header.numfigs ← header.numfigs + 1;
WriteHeaderAndFlush[@header, diskHandle];
};
ReadHeader:
PROC [h:
LONG
POINTER
TO GriffinFileFormat.GFileHeader, diskHandle: DiskHandle]
RETURNS [oldVersion:
BOOL ←
FALSE] = {
version, currentVersion: CARDINAL;
Reset[diskHandle];
ReadStructure[h, GriffinFileFormat.lGFileHeader, diskHandle];
version ← h.majversion*10+h.minversion;
currentVersion ← majorVersion*10+minorVersion;
version 1.4 is the first with the Ieee floating point format.
we need to set up to convert the reals for older versions
oldVersion ← (version < 14);
IF version
NOT
IN [10..currentVersion]
THEN {
IO.Close[diskHandle];
GriffinUserMessage.UserMessage["Incorrect file format"];
};
};
WriteHeaderAndFlush:
PROC [h:
LONG
POINTER
TO GriffinFileFormat.GFileHeader, diskHandle: DiskHandle] = {
Reset[diskHandle];
WriteStructure[h, GriffinFileFormat.lGFileHeader, diskHandle];
IO.Flush[diskHandle];
};
WriteFigureContents:
PROC [data: Data, diskHandle: DiskHandle]
RETURNS [nextfree: GriffinFileFormat.SectorIndex] = {
HardcopyController: TYPE = RECORD [hxcenter, hycenter, hwidth, hheight: REAL, pressxcenter, pressycenter: CARDINAL, hscale: REAL];
DisplayController: TYPE = RECORD [dxcenter, dycenter, dwidth, dheight: CARDINAL, dxscale, dyscale, dxorigin, dyorigin: REAL, dgridsize: CARDINAL];
PixelsToMicas: REAL = 32.0;
hc: HardcopyController = [hxcenter: 304*PixelsToMicas, hycenter: 404*PixelsToMicas, hwidth: 608*PixelsToMicas, hheight: 808*PixelsToMicas, pressxcenter: Real.RoundC[304*PixelsToMicas], pressycenter: Real.RoundC[404*PixelsToMicas], hscale: 1]; --obsolete but still in file format
dc: DisplayController = [dxcenter: 304, dycenter: 404, dwidth: 608, dheight: 808, dxscale: 1.0/PixelsToMicas, dyscale: 1.0/PixelsToMicas, dxorigin: 0, dyorigin: 0, dgridsize: 8]; --obsolete but still in file format
hcontroller: GriffinFileFormat.GFileHardcopyController; --obsolete but still in file format
dcontroller: GriffinFileFormat.GFileDisplayController; --obsolete but still in file format
figname: GriffinFileFormat.GFileFigureName;
count: CARDINAL ← 0;
fonts: GriffinStyle.FontSequence;
styles: GriffinStyle.StyleSequence;
DoWrite: GriffinObject.ObjectProc = TRUSTED { WriteObject[object, styles, data, diskHandle]; };
CountObject: GriffinObject.ObjectProc =
TRUSTED {
SELECT object.objectType FROM
shape, caption => count ← count+1; ENDCASE;
};
Zero[@figname, GriffinFileFormat.lGFileFigureName];
WriteStructure[@figname, GriffinFileFormat.lGFileFigureName, diskHandle];
Zero[@hcontroller, GriffinFileFormat.lGFileHardcopyController];
must write a legitimate dummy controller for backwards compatibility
hcontroller ← [centerx: hc.hxcenter, centery: hc.hycenter, width: hc.hwidth, height: hc.hheight, presscenterx: hc.pressxcenter, presscentery: hc.pressycenter, scale: hc.hscale];
Zero[@dcontroller, GriffinFileFormat.lGFileDisplayController];
must write a legitimate dummy controller for backwards compatibility
dcontroller ← [centerx: dc.dxcenter, centery: dc.dycenter, width: dc.dwidth, height: dc.dheight, xscale: dc.dxscale, yscale: dc.dyscale, gridxo: dc.dxorigin, gridyo: dc.dyorigin, gridsize: dc.dgridsize, numcontrolpairs: 0];
WriteStructure[@hcontroller, GriffinFileFormat.lGFileHardcopyController, diskHandle];
WriteStructure[@dcontroller, GriffinFileFormat.lGFileDisplayController, diskHandle];
there are NO control pairs in any Griffin file
styles ← GriffinStyle.CreateStyleList[data];
IF styles#
NIL
THEN {
--empty file if styles=NIL
fonts ← GriffinStyle.CreateFontList[styles];
WriteWord[fonts.length, diskHandle];
FOR i:
NAT
IN [0..fonts.length)
DO
WriteFont[GriffinStyle.InternalFontFromFont[fonts[i]], diskHandle];
ENDLOOP;
WriteWord[styles.length, diskHandle];
FOR i: NAT IN [0..styles.length) DO WriteStyle[styles[i], fonts, diskHandle]; ENDLOOP;
GriffinObject.ForAllObjects[data, CountObject];
WriteWord[count, diskHandle];
GriffinObject.ForAllObjects[data, DoWrite];
};
nextfree ← ZeroRestOfSector[diskHandle]
};
WriteFont:
PROC [fd: GriffinStyle.FontDescriptorHandle, diskHandle: DiskHandle] = {
j, len: INTEGER;
font: GriffinFileFormat.GFileFont;
Zero[@font, GriffinFileFormat.lGFileFont];
font.points ← fd.points;
font.face ← fd.face;
font.rotation ← fd.rotation;
len ← Rope.Length[fd.name];
font.char[0] ← LOOPHOLE[len, CHARACTER];
FOR j IN [1.. GriffinFileFormat.fontChars]
DO
font.char[j] ← IF j<=len THEN Rope.Fetch[fd.name, j-1] ELSE 0C;
ENDLOOP;
WriteStructure[@font, GriffinFileFormat.lGFileFont, diskHandle];
};
WriteStyle:
PROC [style: GriffinStyle.StyleHandle, fonts: GriffinStyle.FontSequence, diskHandle: DiskHandle] = {
fstyle: GriffinFileFormat.GFileStyle;
fcolor: GriffinColor.FileColor;
j, len: INTEGER;
Zero[@fstyle, GriffinFileFormat.lGFileStyle];
fcolor ← GriffinColor.FileColorFromColor[style.color];
fstyle.hue ← fcolor.hue;
fstyle.saturation ← fcolor.saturation;
fstyle.brightness ← fcolor.brightness;
fstyle.dashedness ←
SELECT style.dashed
FROM
undashed => GriffinFileFormat.typeUnDashed,
dash1 => GriffinFileFormat.typeDash1,
dash2 => GriffinFileFormat.typeDash2,
dash3 => GriffinFileFormat.typeDash3,
dash4 => GriffinFileFormat.typeDash4,
dash5 => GriffinFileFormat.typeDash5,
ENDCASE => GriffinFileFormat.typeUnDashed;
fstyle.send ←
SELECT style.firstend.type
FROM
round => GriffinFileFormat.typeRoundEnd,
cyclic => GriffinFileFormat.typeCyclicEnd,
flat => GriffinFileFormat.typeFlatEnd,
angled => GriffinFileFormat.typeAngledEnd,
ENDCASE => GriffinFileFormat.typeRoundEnd;
fstyle.eend ←
SELECT style.lastend.type
FROM
round => GriffinFileFormat.typeRoundEnd,
cyclic => GriffinFileFormat.typeCyclicEnd,
flat => GriffinFileFormat.typeFlatEnd,
angled => GriffinFileFormat.typeAngledEnd,
ENDCASE => GriffinFileFormat.typeRoundEnd;
fstyle.bdx ← style.firstend.dx;
fstyle.bdy ← style.firstend.dy;
fstyle.ba ← style.firstend.a;
fstyle.bb ← style.firstend.b;
fstyle.bc ← style.firstend.c;
fstyle.edx ← style.lastend.dx;
fstyle.edy ← style.lastend.dy;
fstyle.ea ← style.lastend.a;
fstyle.eb ← style.lastend.b;
fstyle.ec ← style.lastend.c;
fstyle.thickness ← style.width;
fstyle.junction ←
SELECT style.junctiontype
FROM
round => GriffinFileFormat.typeRoundJunction,
square => GriffinFileFormat.typeSquareJunction,
angled => GriffinFileFormat.typeAngledJunction,
ENDCASE => GriffinFileFormat.typeRoundJunction;
fcolor ← GriffinColor.FileColorFromColor[style.fillcolor];
fstyle.ahue ← fcolor.hue;
fstyle.asaturation ← fcolor.saturation;
fstyle.abrightness ← fcolor.brightness;
fstyle.afilled ← style.filled;
fstyle.aoutlined ← style.outlined;
fstyle.fontid ← GriffinStyle.NumberOfFont[style.font, fonts];
fcolor ← GriffinColor.FileColorFromColor[style.backgndcolor];
fstyle.bhue ← fcolor.hue;
fstyle.bsaturation ← fcolor.saturation;
fstyle.bbrightness ← fcolor.brightness;
fstyle.background ← style.fillbackgnd;
fstyle.anchor ←
SELECT style.anchor
FROM
left => GriffinFileFormat.typeLeftAnchor,
center => GriffinFileFormat.typeCenterAnchor,
right => GriffinFileFormat.typeRightAnchor,
ENDCASE => GriffinFileFormat.typeLeftAnchor;
fstyle.torient ←
SELECT style.stringRotation
FROM
or0 => GriffinFileFormat.typeRot0,
or90 => GriffinFileFormat.typeRot90,
or180 => GriffinFileFormat.typeRot180,
or270 => GriffinFileFormat.typeRot270,
ENDCASE => GriffinFileFormat.typeRot0;
len ← Rope.Length[style.name];
fstyle.stylename[0] ← LOOPHOLE[len, CHARACTER];
FOR j
IN [1 .. GriffinFileFormat.sNameChars]
DO
fstyle.stylename[j] ← IF j > len THEN 0C ELSE Rope.Fetch[style.name, j-1];
ENDLOOP;
WriteStructure[@fstyle, GriffinFileFormat.lGFileStyle, diskHandle];
};
WriteObject:
PROC [obj: GriffinObject.ObjectHandle, styles: GriffinStyle.StyleSequence, data: Data, diskHandle: DiskHandle] = {
fobject: GriffinFileFormat.GFileObject;
fcaptiontrailer: GriffinFileFormat.GFileCaptionTrailer;
flinks: REF GriffinObject.Link;
fakelink: REF GriffinObject.Link ← NEW[GriffinObject.Link ← [link: NIL, degree: D3, knots: NIL]];
flinkcount: CARDINAL;
SELECT obj.objectType
FROM
shape, caption => NULL; --do these
ENDCASE => RETURN; --ignore the rest
Zero[@fobject, GriffinFileFormat.lGFileObject];
Zero[@fcaptiontrailer, GriffinFileFormat.lGFileCaptionTrailer];
fobject.hidewindow ← obj.view # data.currentView;
fobject.visible ←
SELECT obj.cull
FROM
inside => GriffinFileFormat.typeWhollyVisible,
outside => GriffinFileFormat.typeNotVisible,
partial => GriffinFileFormat.typePartiallyVisible,
ENDCASE => GriffinFileFormat.typePartiallyVisible;
fobject.style ← GriffinStyle.NumberOfStyle[obj.style, styles];
fobject.cluster ← obj.cluster;
fobject.bleft ← obj.tl[X];
fobject.bbottom ← obj.br[Y];
fobject.bright ← obj.br[X];
fobject.btop ← obj.tl[Y];
WITH object: obj
SELECT
FROM
shape => {
fobject.objtype ← IF object.closed THEN GriffinFileFormat.typeAreaObject ELSE GriffinFileFormat.typeCurveObject;
fobject.splinetype ←
SELECT object.trajectory.splineType
FROM
CubicSplines.SplineType[naturalUM] => GriffinFileFormat.typeNUMSpline,
CubicSplines.SplineType[cyclicUM] => GriffinFileFormat.typeCUMSpline,
CubicSplines.SplineType[naturalAL] => GriffinFileFormat.typeNALSpline,
CubicSplines.SplineType[cyclicAL] => GriffinFileFormat.typeCALSpline,
CubicSplines.SplineType[bezier] => GriffinFileFormat.typeBEZSpline,
CubicSplines.SplineType[bsplineInterp] => GriffinFileFormat.typeBSISpline,
CubicSplines.SplineType[bspline] => GriffinFileFormat.typeBSpline,
CubicSplines.SplineType[crspline] => GriffinFileFormat.typeCRSpline,
ENDCASE => GriffinFileFormat.typeCRSpline;
WITH traj: object.trajectory
SELECT
FROM
linked => {
fobject.trajtype ← GriffinFileFormat.typeLinkedTraj;
flinkcount ← CountLinks[traj.links];
flinks ← traj.links;
};
cyclic => {
fobject.trajtype ← GriffinFileFormat.typeCSTraj;
flinkcount ← 1;
flinks ← fakelink;
fakelink.knots ← traj.knots;
};
ENDCASE => SIGNAL GriffinFileError;
WriteStructure[@fobject, GriffinFileFormat.lGFileObject, diskHandle];
WriteWord[flinkcount, diskHandle];
UNTIL flinks = NIL DO WriteLink[flinks, diskHandle]; flinks ← flinks.link; ENDLOOP;
};
caption => {
fobject.objtype ← GriffinFileFormat.typeCaptionObject;
WriteStructure[@fobject, GriffinFileFormat.lGFileObject, diskHandle];
fcaptiontrailer.xanchor ← object.p0[X];
fcaptiontrailer.yanchor ← object.p0[Y];
WriteStructure[@fcaptiontrailer, GriffinFileFormat.lGFileCaptionTrailer, diskHandle];
WriteString[object.text, diskHandle];
};
ENDCASE => ERROR;
};
CountLinks:
PROC [links:
REF GriffinObject.Link]
RETURNS [
CARDINAL] = {
count: CARDINAL ← 0;
UNTIL links = NIL DO links ← links.link; count ← count + 1; ENDLOOP;
RETURN [count];
};
WriteLink:
PROC [link:
REF GriffinObject.Link, diskHandle: DiskHandle] = {
knotword: GriffinFileFormat.GFileKnotWord;
fpoint: GriffinFileFormat.GFilePoint;
freal: GriffinFileFormat.GFileReal;
j: CARDINAL;
Zero[@knotword, GriffinFileFormat.lGFileKnotWord];
Zero[@fpoint, GriffinFileFormat.lGFilePoint];
Zero[@freal, GriffinFileFormat.lGFileReal];
knotword.knotcount ← link.knots.length;
knotword.knottype ←
SELECT link.degree
FROM
D0 => GriffinFileFormat.typeFD0Knot,
D1 => GriffinFileFormat.typeFD1Knot,
D2 => GriffinFileFormat.typeFD2Knot,
D3 => GriffinFileFormat.typeFD3Knot,
ENDCASE => GriffinFileFormat.typeFD3Knot;
WriteStructure[@knotword, GriffinFileFormat.lGFileKnotWord, diskHandle];
FOR j IN [0 .. knotword.knotcount)
DO
fpoint.x ← link.knots[j][X];
fpoint.y ← link.knots[j][Y];
WriteStructure[@fpoint, GriffinFileFormat.lGFilePoint, diskHandle];
ENDLOOP;
};
ReadStyle:
PROC [fonts: GriffinStyle.FontSequence, styles: GriffinStyle.StyleSequence, data: Data, diskHandle: DiskHandle]
RETURNS [GriffinStyle.StyleHandle] = {
oldVersion: BOOL ← data.oldVersion;
fstyle: GriffinFileFormat.GFileStyle;
thisstyle: GriffinStyle.StyleHandle ← NEW[GriffinStyle.Style];
ReadStructure[@fstyle, GriffinFileFormat.lGFileStyle, diskHandle];
thisstyle.color ← GriffinColor.ColorFromFileColor[[fstyle.hue, fstyle.saturation, fstyle.brightness]];
thisstyle.dashed ←
SELECT fstyle.dashedness
FROM
GriffinFileFormat.typeUnDashed => undashed,
ENDCASE => undashed;
thisstyle.firstend.type ←
SELECT fstyle.send
FROM
GriffinFileFormat.typeRoundEnd => round,
GriffinFileFormat.typeCyclicEnd => cyclic,
GriffinFileFormat.typeFlatEnd => flat,
GriffinFileFormat.typeAngledEnd => angled,
ENDCASE => round; -- should be an error
thisstyle.lastend.type ←
SELECT fstyle.eend
FROM
GriffinFileFormat.typeRoundEnd => round,
GriffinFileFormat.typeCyclicEnd => cyclic,
GriffinFileFormat.typeFlatEnd => flat,
GriffinFileFormat.typeAngledEnd => angled,
ENDCASE => round; -- should be an error
thisstyle.firstend.dx ← GetReal[fstyle.bdx, oldVersion];
thisstyle.firstend.dy ← GetReal[fstyle.bdy, oldVersion];
thisstyle.firstend.a ← GetReal[fstyle.ba, oldVersion];
thisstyle.firstend.b ← GetReal[fstyle.bb, oldVersion];
thisstyle.firstend.c ← GetReal[fstyle.bc, oldVersion];
thisstyle.lastend.dx ← GetReal[fstyle.edx, oldVersion];
thisstyle.lastend.dy ← GetReal[fstyle.edy, oldVersion];
thisstyle.lastend.a ← GetReal[fstyle.ea, oldVersion];
thisstyle.lastend.b ← GetReal[fstyle.eb, oldVersion];
thisstyle.lastend.c ← GetReal[fstyle.ec, oldVersion];
thisstyle.width ← GetReal[fstyle.thickness, oldVersion];
thisstyle.junctiontype ←
SELECT fstyle.junction
FROM
GriffinFileFormat.typeRoundJunction => round,
GriffinFileFormat.typeSquareJunction => square,
GriffinFileFormat.typeAngledJunction => angled,
ENDCASE => round;
thisstyle.fillcolor ← GriffinColor.ColorFromFileColor[[fstyle.ahue, fstyle.asaturation, fstyle.abrightness]];
thisstyle.filled ← fstyle.afilled;
thisstyle.outlined ← fstyle.aoutlined;
thisstyle.font ← fonts[fstyle.fontid-1]; --the first font is font number 1
thisstyle.backgndcolor ← GriffinColor.ColorFromFileColor[[fstyle.bhue, fstyle.bsaturation, fstyle.bbrightness]];
thisstyle.fillbackgnd ← fstyle.background;
thisstyle.anchor ←
SELECT fstyle.anchor
FROM
GriffinFileFormat.typeLeftAnchor => left,
GriffinFileFormat.typeCenterAnchor => center,
GriffinFileFormat.typeRightAnchor => right,
ENDCASE => left; -- should be an error
thisstyle.stringRotation ←
SELECT fstyle.torient
FROM
GriffinFileFormat.typeRot0 => or0,
GriffinFileFormat.typeRot90 => or90,
GriffinFileFormat.typeRot180 => or180,
GriffinFileFormat.typeRot270 => or270,
ENDCASE => or0; -- should be an error
thisstyle.stringType ← GriffinStyle.ComputeStringType[thisstyle.stringRotation, thisstyle.font];
{
--an attempt here to avoid the proliferation of identical styles
test: GriffinStyle.StyleHandle ← GriffinStyle.FindEquivalentStyle[thisstyle, styles];
IF test#
NIL
THEN thisstyle ← test
ELSE thisstyle.name ← GriffinStyle.NextName[data]; --change the name to reflect current scope
};
RETURN[thisstyle];
};
ReadObject:
PROC[styles: GriffinStyle.StyleSequence, clusterMap: GriffinRelation.Relation, data: Data, diskHandle: DiskHandle, addKnots:
BOOLEAN ←
FALSE] = {
newobject: GriffinObject.ObjectHandle;
fileobject: GriffinFileFormat.GFileObject;
fcaptiontrailer: GriffinFileFormat.GFileCaptionTrailer;
tl, br: GriffinPoint.ScrPt;
splinetype: CubicSplines.SplineType;
nlinks: CARDINAL;
ptr: REF GriffinObject.Link;
xptr: REF GriffinObject.Link;
currentView: GriffinObject.View ← data.currentView;
otherView: GriffinObject.View ← IF currentView=main THEN alternate ELSE main;
ReadStructure[@fileobject, GriffinFileFormat.lGFileObject, diskHandle];
SELECT fileobject.objtype
FROM
GriffinFileFormat.typeAreaObject, GriffinFileFormat.typeCurveObject =>
newobject ← GriffinObject.StartObject[data, shape];
GriffinFileFormat.typeCaptionObject =>
newobject ← GriffinObject.StartObject[data, caption];
GriffinFileFormat.typeTokenObject =>
newobject ← GriffinObject.StartObject[data, token];
ENDCASE => SIGNAL GriffinFileError;
newobject.style ← styles[fileobject.style-1]; --the first style is number 1
IF fileobject.cluster <= GriffinObject.openCluster THEN newobject.cluster ← fileobject.cluster
ELSE {
cluster: CARDINAL ← GriffinRelation.Right[clusterMap, fileobject.cluster];
IF cluster = GriffinRelation.notFound
THEN {
cluster ← GriffinObject.GetNextClusterID[data];
GriffinRelation.AddPair[clusterMap, fileobject.cluster, cluster];
};
newobject.cluster ← cluster;
};
newobject.view ← IF fileobject.hidewindow THEN otherView ELSE currentView;
newobject.cull ←
SELECT fileobject.visible
FROM
GriffinFileFormat.typeNotVisible => outside,
GriffinFileFormat.typePartiallyVisible => partial,
GriffinFileFormat.typeWhollyVisible => inside,
ENDCASE => partial;
tl[X] ← fileobject.bleft; tl[Y] ← fileobject.btop;
br[X] ← fileobject.bright; br[Y] ← fileobject.bbottom;
newobject.tl ← tl; newobject.br ← br;
WITH newobject
SELECT
FROM
object:
REF GriffinObject.Object[shape] => {
object.closed ← fileobject.objtype = GriffinFileFormat.typeAreaObject;
splinetype ←
SELECT fileobject.splinetype
FROM
GriffinFileFormat.typeNUMSpline => CubicSplines.SplineType[naturalUM],
GriffinFileFormat.typeCUMSpline => CubicSplines.SplineType[cyclicUM],
GriffinFileFormat.typeNALSpline => CubicSplines.SplineType[naturalAL],
GriffinFileFormat.typeCALSpline => CubicSplines.SplineType[cyclicAL],
GriffinFileFormat.typeBEZSpline => CubicSplines.SplineType[bezier],
GriffinFileFormat.typeBSISpline => CubicSplines.SplineType[bsplineInterp],
GriffinFileFormat.typeBSpline => CubicSplines.SplineType[bspline],
GriffinFileFormat.typeCRSpline => CubicSplines.SplineType[crspline],
ENDCASE => CubicSplines.SplineType[bspline];
SELECT fileobject.trajtype
FROM
GriffinFileFormat.typeLinkedTraj => {
nlinks ← ReadWord[diskHandle];
IF nlinks =0
THEN object.trajectory ←
NEW[GriffinObject.Trajectory ← [splinetype, linked [
NIL]]]
ELSE {
ptr ← NewLink[data, diskHandle];
object.trajectory ← NEW[GriffinObject.Trajectory ← [splinetype, linked [ptr]]];
THROUGH (1..nlinks] DO ptr←ptr.link←NewLink[data, diskHandle] ENDLOOP;
};
};
GriffinFileFormat.typeCSTraj => {
IF ReadWord[diskHandle] # 1 THEN SIGNAL GriffinFileError;
xptr ← NewLink[data, diskHandle];
IF addKnots
THEN {
nextra: NAT ← IF splinetype=bspline OR splinetype=crspline THEN 3 ELSE 1;
j: NAT ← 0;
new: GriffinPoint.ObjPtSequence ← NEW[GriffinPoint.ObjPtSequenceRec[xptr.knots.length+nextra]];
FOR i:
NAT
IN [0..xptr.knots.length)
DO
new[i] ← xptr.knots[i];
ENDLOOP;
FOR i:
NAT
IN [xptr.knots.length..new.length)
DO
new[i] ← xptr.knots[j];
j ← j+1;
ENDLOOP;
xptr.knots ← new;
};
object.trajectory ← NEW[GriffinObject.Trajectory ← [splinetype, cyclic [xptr.knots]]];
};
ENDCASE => SIGNAL GriffinFileError;
GriffinObject.EncodeObject[object];
};
object:
REF caption GriffinObject.Object => {
ReadStructure[@fcaptiontrailer, GriffinFileFormat.lGFileCaptionTrailer, diskHandle];
object.p0[X] ← GetReal[fcaptiontrailer.xanchor, data.oldVersion];
object.p0[Y] ← GetReal[fcaptiontrailer.yanchor, data.oldVersion];
object.text ← ReadString[diskHandle];
[object.tl, object.br] ← GriffinText.GetBoundingBox[object.text, object.style, object.p0];
};
ENDCASE;
newobject.validEncoding ← TRUE;
};
NewLink:
PROC [data: Data, diskHandle: DiskHandle]
RETURNS [lin:
REF GriffinObject.Link] = {
knotword: GriffinFileFormat.GFileKnotWord;
knots: GriffinPoint.ObjPtSequence;
num, j: CARDINAL;
fpoint: GriffinFileFormat.GFilePoint;
lin ← NEW[GriffinObject.Link];
ReadStructure[@knotword, GriffinFileFormat.lGFileKnotWord, diskHandle];
num ← knotword.knotcount;
SELECT knotword.knottype
FROM
GriffinFileFormat.typeFD0Knot, GriffinFileFormat.typeFD1Knot, GriffinFileFormat.typeFD2Knot, GriffinFileFormat.typeFD3Knot => {
knots ← NEW[GriffinPoint.ObjPtSequenceRec[num]];
lin^ ← GriffinObject.Link[
NIL, (
SELECT knotword.knottype
FROM
GriffinFileFormat.typeFD0Knot => D0,
GriffinFileFormat.typeFD1Knot => D1,
GriffinFileFormat.typeFD2Knot => D2,
GriffinFileFormat.typeFD3Knot => D3,
ENDCASE => D1), knots];
FOR j
IN [0 .. num)
DO
ReadStructure[@fpoint, GriffinFileFormat.lGFilePoint, diskHandle];
knots[j] ← GriffinPoint.ObjPt[GetReal[fpoint.x, data.oldVersion], GetReal[fpoint.y, data.oldVersion]];
ENDLOOP;
};
ENDCASE => SIGNAL GriffinFileError;
};
private low-level disk access procedures
WriteWord:
PROC [word:
CARDINAL, diskHandle: DiskHandle] = {
bytes: TWOBYTES ← LOOPHOLE[word];
IO.PutChar[diskHandle, bytes.high];
IO.PutChar[diskHandle, bytes.low];
};
ReadWord:
PROC [diskHandle: DiskHandle]
RETURNS [
CARDINAL] = {
word: TWOBYTES;
word.high ← IO.GetChar[diskHandle];
word.low ← IO.GetChar[diskHandle];
RETURN[LOOPHOLE[word]];
};
WriteString:
PROC [s:
ROPE, diskHandle: DiskHandle] = {
len: CARDINAL ← Rope.Length[s];
IO.PutChar[diskHandle, LOOPHOLE[len, CHARACTER]];
IO.PutBlock[diskHandle, Rope.ToRefText[Rope.Flatten[s]]];
IF (len+1) MOD 2 # 0 THEN IO.PutChar[diskHandle, 0C];
};
ReadString:
PROC [diskHandle: DiskHandle]
RETURNS [s:
ROPE ←
NIL] = {
t: REF TEXT;
length: CARDINAL;
length ← LOOPHOLE[IO.GetChar[diskHandle], CARDINAL];
t ← NEW[TEXT[length]];
IF IO.GetBlock[diskHandle, t, 0, length] # length
THEN SIGNAL GriffinFileError;
s ← Rope.FromRefText[t];
always read an even number of bytes: string length + string chars MOD 2 = 0
IF (length+1) MOD 2 # 0 THEN [] ← IO.GetChar[diskHandle];
};
ZeroRestOfSector:
PROC [diskHandle: DiskHandle]
RETURNS [GriffinFileFormat.SectorIndex] = {
UNTIL IO.GetIndex[diskHandle] MOD 512 = 0 DO WriteWord[0, diskHandle] ENDLOOP;
RETURN[GriffinFileFormat.SectorIndex[IO.GetIndex[diskHandle]/512]];
};
MoveToSector:
PROC [si: GriffinFileFormat.SectorIndex, diskHandle: DiskHandle] = {
IO.SetIndex[diskHandle, LONG[si.sector]*512];
};
Reset:
PROC [diskHandle: DiskHandle] = {
IO.SetIndex[diskHandle, 0];
};
ReadStructure:
PROC [p:
LONG
POINTER, l:
CARDINAL, diskHandle: DiskHandle] = {
block: IO.UnsafeBlock ← [base: LOOPHOLE[p], startIndex: 0, count: l*2];
IF IO.UnsafeGetBlock[diskHandle, block] # l*2 THEN SIGNAL GriffinFileError;
};
WriteStructure:
PROC [p:
LONG
POINTER, l:
CARDINAL, diskHandle: DiskHandle] = {
block: IO.UnsafeBlock ← [base: LOOPHOLE[p], startIndex: 0, count: l*2];
IO.UnsafePutBlock[diskHandle, block];
};
MoveSectors:
PROC [source: GriffinFileFormat.SectorIndex, dist:
INTEGER, oldfileend: GriffinFileFormat.SectorIndex, diskHandle: DiskHandle] = {
j: CARDINAL;
sector: GriffinFileFormat.GFileSector;
p: LONG POINTER TO GriffinFileFormat.GFileSector = @sector;
block: IO.UnsafeBlock ← [base: LOOPHOLE[p], startIndex: 0, count: 512];
IF dist < 0
THEN
FOR j
DECREASING
IN [source .. oldfileend)
DO
MoveToSector[GriffinFileFormat.SectorIndex[j], diskHandle];
IF IO.UnsafeGetBlock[diskHandle, block] # 512 THEN SIGNAL GriffinFileError;
MoveToSector[GriffinFileFormat.SectorIndex[j+dist], diskHandle];
IO.UnsafePutBlock[diskHandle, block];
ENDLOOP
ELSE
FOR j
IN [source .. oldfileend)
DO
MoveToSector[GriffinFileFormat.SectorIndex[j], diskHandle];
IF IO.UnsafeGetBlock[diskHandle, block] # 512 THEN SIGNAL GriffinFileError;
MoveToSector[GriffinFileFormat.SectorIndex[j+dist], diskHandle];
IO.UnsafePutBlock[diskHandle, block];
ENDLOOP;
};
Zero:
PROC [block:
LONG
POINTER, length:
CARDINAL] =
TRUSTED {
block^ ← 0;
PrincOpsUtils.LongCopy[from: block, to: block+1, nwords: length-1];
};