GriffinFile
Stone June 16, 1984 1:11:38 pm PDT
Stone Changed minor version September 30, 1980 1:40 PM
Tiberi January 20, 1980 7:38 PM
implementing module for griffin file creation
NOTE: Strange patch in ReplaceFigure to "cleanup" files with multiple figures
Last Edited by: Stone, March 20, 1984 10:52:10 am PST
Last Edited by: Pier, February 14, 1984 10:18:47 am PST
DIRECTORY
GriffinFileDefs: FROM "GriffinFileDefs",
GFileFormatDefs: FROM "GFileFormatDefs",
GriffinDefs: FROM "GriffinDefs" USING [UserMessage],
GriffinMemoryDefs: FROM "GriffinMemoryDefs",
ControllerDefs: FROM "ControllerDefs",
StyleDefs:
FROM "StyleDefs"
USING [Style, StyleHandle, Color],
ObjectDefs:
FROM "ObjectDefs"
USING [StartObject, ObjectHandle, Link, Trajectory,
ObjectType, ForAllObjects, ObjectProc, OpenCluster,
GetNextClusterID, View, GetCurrentView],
PointDefs: FROM "PointDefs" USING [ObjPt, ScrPt, X, Y, ObjPtSequence, ObjPtSequenceRec],
PrincOpsUtils USING [LongCOPY],
SplineDefs: FROM "SplineDefs" USING [SplineType],
IO,
FS,
UserCredentials USING [Get],
RealConvert: FROM "RealConvert" USING [Mesa5ToIeee],
BasicTime USING [Now],
GriffinFontDefs:
FROM "GriffinFontDefs"
USING [FontDescriptor, FontDescriptorHandle],
RelationDefs: FROM "RelationDefs",
Rope USING [ROPE, Length, FromProc, Fetch, Flatten, FromRefText, ToRefText];
GriffinFile:
PROGRAM
IMPORTS
IO,
FS, UserCredentials, Rope, BasicTime,
GriffinMemoryDefs, ControllerDefs, ObjectDefs,
GriffinDefs, RelationDefs, RealConvert, PrincOpsUtils
EXPORTS GriffinFileDefs =
BEGIN OPEN GFileFormatDefs, GriffinFileDefs, GriffinMemoryDefs;
---------------------------------------------------------------------------------
GriffinFileError: PUBLIC SIGNAL = CODE;
ROPE: TYPE = Rope.ROPE;
diskHandle: IO.STREAM;
GFileState: TYPE = {notopen, open};
gfileState: GFileState ← notopen;
majorVersion: BYTE = 2;
minorVersion: BYTE = 2;
maxCPairCount: CARDINAL = 2000; -- just for safety
realConvert: BOOLEAN ← FALSE;
version 2.0 is Cedar
version 2.1 is after string fix
--------------------------------------------------------------------------
GetReal: PROCEDURE [r: LONG UNSPECIFIED] RETURNS [out: REAL] =
BEGIN
IF realConvert THEN RETURN[RealConvert.Mesa5ToIeee[r]] ELSE RETURN[r];
END;
OpenFile:
PUBLIC
PROCEDURE [filename:
ROPE, write:
BOOLEAN ←
FALSE]
RETURNS [
BOOLEAN] =
BEGIN
newfile: BOOLEAN ←FALSE;
username: ROPE;
header: GFileHeader;
j: INTEGER; -- just a loop control variable
IF gfileState # notopen THEN SIGNAL GriffinFileError;
IF write
THEN BEGIN
OPEN header;
len: INTEGER;
diskHandle ← FS.StreamOpen[fileName: filename, accessOptions: $create, keep: 2];
Zero [@header, lGFileHeader];
majversion ← majorVersion;
minversion ← minorVersion;
createtime ← LOOPHOLE[BasicTime.Now[], LONG CARDINAL];--don't change the interface
numfigs ← 0;
nextsector ← SectorIndex [1];
Reset[diskHandle];
FOR j IN ValidFigRange DO header.figure [j] ← SectorIndex [0]; ENDLOOP;
[username,] ← UserCredentials.Get[];
len ← Rope.Length[username];
creatorname [0] ← LOOPHOLE [len, CHARACTER];
FOR j
IN [1 .. cNameChars]
DO
creatorname [j] ← IF j > len THEN 0C ELSE Rope.Fetch[username,j-1];
ENDLOOP;
len ← Rope.Length[filename];
portfolioname [0] ← LOOPHOLE [len, CHARACTER];
FOR j
IN [1 .. pNameChars]
DO
portfolioname[j] ← IF j > len THEN 0C ELSE Rope.Fetch[filename,j-1];
ENDLOOP;
WriteHeaderAndFlush [@header];
END
ELSE diskHandle ←
FS.StreamOpen[fileName: filename, accessOptions: $read !
FS.Error =>
TRUSTED {
IF error.group=user
AND error.code=$unknownFile
THEN SIGNAL GriffinDefs.UserMessage["unknown file"]
ELSE SIGNAL GriffinFileError}];
gfileState ← open;
RETURN [TRUE];
END;
---------------------------------------------------------------------------------
CloseFile:
PUBLIC
PROCEDURE =
BEGIN
fileheader: GFileHeader;
IF gfileState = notopen THEN RETURN;
ReadHeader [@fileheader];
MoveToSector [fileheader.nextsector];
IO.Close [diskHandle];
gfileState ← notopen;
END;
---------------------------------------------------------------------------------
DeletePortfolio: PUBLIC PROCEDURE = BEGIN
IF gfileState = notopen THEN RETURN;
this procedure should really delete the file, not just truncate it
gfileState ← notopen;
IO.Close[diskHandle];
END;
---------------------------------------------------------------------------------
ReadFigure:
PUBLIC
PROCEDURE =
BEGIN OPEN RelationDefs;
fileheader: GFileHeader;
hcontrol: GFileHardcopyController;
dcontrol: GFileDisplayController;
controlpair: GFileControlPair;
font: GFileFont;
figurename: GFileFigureName;
stylecount, fontcount, objectcount, i, slen, f, s: CARDINAL;
color: StyleDefs.Color;
fd: GriffinFontDefs.FontDescriptorHandle ← CZone.NEW[GriffinFontDefs.FontDescriptor];
fontMap, styleMap, clusterMap: Relation;
fignum: CARDINAL=1; --original plan involved multiple figures in a portfolio. Never used more than 1
IF gfileState # open THEN SIGNAL GriffinFileError;
ReadHeader [@fileheader];
IF fignum > fileheader.numfigs OR fignum = 0 THEN SIGNAL GriffinFileError;
MoveToSector [fileheader.figure [fignum]]; -- go to the right sector
ReadStructure [@figurename, lGFileFigureName];
allocate global string for figure name
name.length ← LOOPHOLE [figurename [0], BYTE];
FOR i IN [1 .. name.length] DO name [i] ← figurename.char [i] ENDLOOP;
ReadStructure [@hcontrol, lGFileHardcopyController];
ReadStructure [@dcontrol, lGFileDisplayController];
BEGIN
OPEN hcontrol;
ControllerDefs.SetHardcopyController [[hxcenter: GetReal[centerx],
hycenter: GetReal[centery], hwidth: GetReal[width],
hheight: GetReal[height],
pressxcenter: presscenterx, pressycenter: presscentery,
hscale: GetReal[scale]]];
END;
BEGIN
OPEN dcontrol;
ControllerDefs.SetDisplayController [[dxcenter: centerx,
dycenter: centery, dwidth: width, dheight: height,
dxscale: GetReal[xscale], dyscale: GetReal[yscale],
dxorigin: GetReal[gridxo],
dyorigin: GetReal[gridyo], dgridsize: gridsize]];
END;
IF dcontrol.numcontrolpairs > maxCPairCount THEN SIGNAL GriffinFileError;
THROUGH [1 .. dcontrol.numcontrolpairs]
DO
OPEN controlpair;
ReadStructure [@controlpair, lGFileControlPair];
color ← [hue: hue, brightness: brightness, saturation: saturation];
ControllerDefs.SetGreyOfColor [color, greytouse]; let Graphics default it
ENDLOOP;
fontcount ← ReadWord [];
fontMap ← CreateRelation[];
FOR f
IN [1 .. fontcount]
DO
fromProc: SAFE PROC RETURNS [CHAR] = CHECKED {i ← i+1; RETURN[ font.char [i]]};
ReadStructure [@font, lGFileFont];
slen ← LOOPHOLE [font.char [0], BYTE]; -- just a temp
i ← 0;
fd.name ← Rope.FromProc[slen,fromProc];
fd.rotation ← font.rotation;
fd.face ← font.face;
fd.points ← font.points;
AddPair[fontMap, f, ControllerDefs.AppendFont[fd]];
ENDLOOP;
stylecount ← ReadWord [];
styleMap ← CreateRelation[];
FOR s
IN [1 .. stylecount]
DO AddPair[styleMap, s, ReadStyle [fontMap]] ENDLOOP;
objectcount ← ReadWord [];
clusterMap ← CreateRelation[];
THROUGH [1 .. objectcount]
DO ReadObject [styleMap, clusterMap]; ENDLOOP;
DestroyRelation[fontMap];
DestroyRelation[styleMap];
DestroyRelation[clusterMap];
END;
---------------------------------------------------------------------------------
ReplaceFigure: PUBLIC PROCEDURE [fignum: FigureNumber] RETURNS [BOOLEAN] = BEGIN
Stone April 16, 1980 9:38 PM
figbegin, oldfigend: SectorIndex;
j: CARDINAL;
sectorsadded: INTEGER;
header: GFileHeader;
IF gfileState # open THEN SIGNAL GriffinFileError;
ReadHeader [@header];
IF header.numfigs = 0 THEN RETURN[AddFigure[fignum]];
IF fignum = 0 OR fignum > header.numfigs THEN SIGNAL GriffinFileError;
this is a cleanup proc for the bug that was adding figures instead of replacing them
it assumes there is no correct way to have multiple figures in a portfolio
IF header.numfigs > 1 THEN BEGIN
fig: FigureNumber ← header.numfigs;
UNTIL fig = 1 DO
DeleteFigure[fig];
fig ← fig-1;
ENDLOOP;
ReadHeader [@header];
END;
header.minversion ← minorVersion;
header.createtime ← LOOPHOLE[BasicTime.Now[], LONG CARDINAL];--don't change the interface
figbegin ← header.figure [fignum]; -- where figure begins
oldfigend ← header.figure [fignum+1]; --where figure ends, or 0
IF oldfigend = 0 THEN BEGIN -- last fig in file, no problem
MoveToSector [figbegin];
header.nextsector ← WriteFigureContents [];
END
ELSE BEGIN
MoveToSector [header.nextsector];
sectorsadded ← WriteFigureContents [] - header.nextsector -
(oldfigend - figbegin);
MoveSectors [oldfigend, sectorsadded, header.nextsector];
MoveToSector [figbegin];
[] ← WriteFigureContents [];
header.nextsector ← SectorIndex [header.nextsector + sectorsadded];
FOR j IN (fignum .. header.numfigs] DO
header.figure [j] ← SectorIndex [header.figure [j] +
sectorsadded];
ENDLOOP;
END;
WriteHeaderAndFlush [@header];
RETURN [TRUE];
END;
---------------------------------------------------------------------------------
DeleteFigure: PUBLIC PROCEDURE [fignum: FigureNumber] = BEGIN
figbegin, nextfigbegin: SectorIndex;
sectordelta: INTEGER;
i: CARDINAL;
header: GFileHeader;
IF gfileState # open THEN SIGNAL GriffinFileError;
ReadHeader [@header];
figbegin ← header.figure [fignum];
nextfigbegin ← header.figure [fignum+1];
IF fignum = 0 OR fignum > header.numfigs THEN SIGNAL GriffinFileError;
IF nextfigbegin = 0 THEN header.nextsector ← figbegin ELSE
BEGIN -- wasn't last fig in file
sectordelta ← figbegin - header.figure [fignum+1];
MoveSectors [nextfigbegin, sectordelta, header.nextsector];
header.nextsector ← SectorIndex [header.nextsector + sectordelta];
FOR i IN [fignum .. header.numfigs) DO header.figure [i] ←
SectorIndex [header.figure [i+1] + sectordelta];
ENDLOOP;
header.figure [header.numfigs] ← SectorIndex [0];
END;
header.numfigs ← header.numfigs - 1;
WriteHeaderAndFlush [@header];
END;
---------------------------------------------------------------------------------
WriteFigure: PUBLIC PROCEDURE = BEGIN
Stone April 16, 1980 9:38 PM
figbegin: SectorIndex;
i, figlength: CARDINAL;
header: GFileHeader;
fignum: CARDINAL=1; --was a plan involving multiple figures, now canceled
IF gfileState # open THEN SIGNAL GriffinFileError;
ReadHeader [@header];
IF fignum > header.numfigs + 1 THEN SIGNAL GriffinDefs.UserMessage["Invalid file."];
figbegin ← header.figure [fignum];
IF figbegin = 0 THEN figbegin ← header.figure [fignum] ← SectorIndex [1];
MoveToSector [header.nextsector];
figlength ← WriteFigureContents [] - header.nextsector;
FOR i
DECREASING
IN [fignum .. header.numfigs]
DO
header.figure [i+1] ← SectorIndex [header.figure [i] +figlength];
ENDLOOP;
MoveSectors [figbegin, figlength, header.nextsector];
header.nextsector ← SectorIndex [header.nextsector + figlength];
IF header.numfigs >= fignum
THEN
BEGIN
-- wasn't last fig, write it again
MoveToSector [figbegin];
[] ← WriteFigureContents [];
END;
header.numfigs ← header.numfigs + 1;
WriteHeaderAndFlush [@header];
END;
---------------------------------------------------------------------------------
ReadHeader:
PROCEDURE [h:
LONG
POINTER
TO GFileHeader] =
BEGIN
version,currentVersion: CARDINAL;
Reset[diskHandle];
ReadStructure [h, lGFileHeader];
realConvert ← FALSE;
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
IF version < 14 THEN realConvert ← TRUE;
IF version
NOT
IN [10..currentVersion]
THEN {
IO.Close[diskHandle];
gfileState ← notopen;
GriffinDefs.UserMessage["Incorrect file format."];
};
END;
---------------------------------------------------------------------------------
WriteHeaderAndFlush:
PROCEDURE [h:
LONG
POINTER
TO GFileHeader] =
BEGIN
Reset[diskHandle];
WriteStructure [h, lGFileHeader];
IO.Flush [diskHandle];
END;
---------------------------------------------------------------------------------
WriteFigureContents:
PROCEDURE
RETURNS [nextfree: SectorIndex] =
BEGIN
hcontroller: GFileHardcopyController;
dcontroller: GFileDisplayController;
figname: GFileFigureName;
hc: ControllerDefs.HardcopyController; -- temp
dc: ControllerDefs.DisplayController; -- temp
count: CARDINAL;
CountObject: ObjectDefs.ObjectProc =
BEGIN
SELECT obj.objectType
FROM
shape,caption => count ← count+1; ENDCASE;
END;
CountStyle:
PROCEDURE [s: StyleDefs.StyleHandle] =
BEGIN count ← count+1 END;
CountFont:
PROCEDURE [fd: GriffinFontDefs.FontDescriptorHandle] =
BEGIN count ← count+1 END;
CountPair: ControllerDefs.CPProcedure = BEGIN count ← count+1 END;
Zero [@figname, lGFileFigureName];
WriteStructure [@figname, lGFileFigureName];
Zero [@hcontroller, lGFileHardcopyController];
BEGIN
OPEN ControllerDefs, hcontroller;
[hxcenter: centerx, hycenter: centery, hwidth: width,
hheight: height, pressxcenter: presscenterx, pressycenter: presscentery,
hscale: scale] ← hc ← ReadHardcopyController [];
END;
Zero [@dcontroller, lGFileDisplayController];
BEGIN
OPEN ControllerDefs, dcontroller;
[dxcenter: centerx, dycenter: centery, dwidth: width,
dheight: height, dxscale: xscale, dyscale: yscale, dxorigin: gridxo,
dyorigin: gridyo, dgridsize: gridsize] ← dc ←
ReadDisplayController [];
END;
WriteStructure [@hcontroller, lGFileHardcopyController];
count ← 0;
ControllerDefs.ForAllControlPairs [CountPair]; dcontroller.numcontrolpairs ← count;
WriteStructure [@dcontroller, lGFileDisplayController];
ControllerDefs.ForAllControlPairs [WriteControlPair];
count ← 0; ControllerDefs.ForAllFonts [CountFont]; WriteWord [count];
ControllerDefs.ForAllFonts [WriteFont];
count ← 0; ControllerDefs.ForAllStyles [CountStyle]; WriteWord [count];
ControllerDefs.ForAllStyles [WriteStyle];
count ← 0; ObjectDefs.ForAllObjects [CountObject]; WriteWord [count];
ObjectDefs.ForAllObjects [WriteObject];
nextfree ← ZeroRestOfSector []
END;
---------------------------------------------------------------------------------
WriteControlPair:
PROCEDURE [color: StyleDefs.Color, grey:
CARDINAL [0 .. 255]] =
BEGIN
cp: GFileControlPair;
Zero [@cp, lGFileControlPair];
cp.hue ← color.hue;
cp.saturation ← color.saturation;
cp.brightness ← color.brightness;
cp.greytouse ← grey;
WriteStructure [@cp, lGFileControlPair];
END;
---------------------------------------------------------------------------------
WriteFont:
PROCEDURE [fd: GriffinFontDefs.FontDescriptorHandle] =
BEGIN
j,len: INTEGER;
font: GFileFont;
Zero [@font, 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.. fontChars]
DO
font.char[j] ← IF j<=len THEN Rope.Fetch[fd.name,j-1] ELSE 0C;
ENDLOOP;
WriteStructure [@font, lGFileFont];
END;
---------------------------------------------------------------------------------
---------------------------------------------------------------------------------
WriteStyle:
PROCEDURE [style: StyleDefs.StyleHandle] =
BEGIN
OPEN StyleDefs, style;
fstyle: GFileStyle;
j,len: INTEGER;
Zero [@fstyle, lGFileStyle];
fstyle.hue ← color.hue; fstyle.saturation ← color.saturation; fstyle.brightness ← color.brightness;
fstyle.dashedness ←
SELECT dashed
FROM
undashed => typeUnDashed,
dash1 => typeDash1,
dash2 => typeDash2,
dash3 => typeDash3,
dash4 => typeDash4,
dash5 => typeDash5,
ENDCASE => typeUnDashed;
fstyle.send ←
SELECT firstend.type
FROM
round => typeRoundEnd,
cyclic => typeCyclicEnd,
flat => typeFlatEnd,
angled => typeAngledEnd,
ENDCASE => typeRoundEnd;
fstyle.eend ←
SELECT lastend.type
FROM
round => typeRoundEnd,
cyclic => typeCyclicEnd,
flat => typeFlatEnd,
angled => typeAngledEnd,
ENDCASE => typeRoundEnd;
fstyle.bdx ← firstend.dx;
fstyle.bdy ← firstend.dy;
fstyle.ba ← firstend.a;
fstyle.bb ← firstend.b;
fstyle.bc ← firstend.c;
fstyle.edx ← lastend.dx;
fstyle.edy ← lastend.dy;
fstyle.ea ← lastend.a;
fstyle.eb ← lastend.b;
fstyle.ec ← lastend.c;
fstyle.thickness ← width;
fstyle.junction ←
SELECT junctiontype
FROM
round => typeRoundJunction,
square => typeSquareJunction,
angled => typeAngledJunction,
ENDCASE => typeRoundJunction;
fstyle.ahue ← fillcolor.hue;
fstyle.asaturation ← fillcolor.saturation;
fstyle.abrightness ← fillcolor.brightness;
fstyle.afilled ← filled;
fstyle.aoutlined ← outlined;
fstyle.fontid ← fontid;
fstyle.bhue ← backgndcolor.hue; fstyle.bsaturation ← backgndcolor.saturation; fstyle.bbrightness ← backgndcolor.brightness;
fstyle.background ← fillbackgnd;
fstyle.anchor ←
SELECT anchor
FROM
left => typeLeftAnchor,
center => typeCenterAnchor,
right => typeRightAnchor,
ENDCASE => typeLeftAnchor;
fstyle.torient ←
SELECT orientation
FROM
or0 => typeRot0,
or90 => typeRot90,
or180 => typeRot180,
or270 => typeRot270,
ENDCASE => typeRot0;
len ← Rope.Length[name];
fstyle.stylename [0] ← LOOPHOLE [len, CHARACTER];
FOR j
IN [1 .. sNameChars]
DO
fstyle.stylename [j] ← IF j > len THEN 0C ELSE Rope.Fetch[name, j-1];
ENDLOOP;
WriteStructure [@fstyle, lGFileStyle];
END;
---------------------------------------------------------------------------------
WriteObject: PROCEDURE [obj: ObjectDefs.ObjectHandle] =
BEGIN OPEN ObjectDefs;
fobject: GFileObject;
fcaptiontrailer: GFileCaptionTrailer;
flinks: REF Link;
fakelink: REF Link ← CZone.NEW[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, lGFileObject];
Zero [@fcaptiontrailer, lGFileCaptionTrailer];
fobject.hidewindow ← obj.view # ObjectDefs.GetCurrentView[];
fobject.visible ←
SELECT obj.cull
FROM
inside => typeWhollyVisible,
outside => typeNotVisible,
partial => typePartiallyVisible,
ENDCASE => typePartiallyVisible;
fobject.style ← ControllerDefs.NumberOfStyle [obj.style];
fobject.cluster ← obj.cluster;
fobject.bleft ← obj.tl [PointDefs.X];
fobject.bbottom ← obj.br [PointDefs.Y];
fobject.bright ← obj.br [PointDefs.X];
fobject.btop ← obj.tl [PointDefs.Y];
WITH object: obj SELECT FROM
shape =>
BEGIN OPEN SplineDefs;
fobject.objtype ← IF object.closed THEN typeAreaObject ELSE typeCurveObject;
fobject.splinetype ←
SELECT object.trajectory.splineType
FROM
SplineType [naturalUM] => typeNUMSpline,
SplineType [cyclicUM] => typeCUMSpline,
SplineType [naturalAL] => typeNALSpline,
SplineType [cyclicAL] => typeCALSpline,
SplineType [bezier] => typeBEZSpline,
SplineType [bsplineInterp] => typeBSISpline,
SplineType [bspline] => typeBSpline,
SplineType [crspline] => typeCRSpline,
ENDCASE => typeCRSpline;
WITH traj: object.trajectory
SELECT
FROM
linked =>
BEGIN
fobject.trajtype ← typeLinkedTraj;
flinkcount ← CountLinks [traj.links];
flinks ← traj.links;
END;
cyclic =>
BEGIN
fobject.trajtype ← typeCSTraj;
flinkcount ← 1;
flinks ← fakelink;
fakelink.knots ← traj.knots;
END;
ENDCASE => SIGNAL GriffinFileError;
WriteStructure [@fobject, lGFileObject];
WriteWord [flinkcount];
UNTIL flinks = NIL DO WriteLink [flinks]; flinks ← flinks.link; ENDLOOP;
END;
caption =>
BEGIN
fobject.objtype ← typeCaptionObject;
WriteStructure [@fobject, lGFileObject];
fcaptiontrailer.xanchor ← object.p0 [PointDefs.X];
fcaptiontrailer.yanchor ← object.p0 [PointDefs.Y];
WriteStructure [@fcaptiontrailer, lGFileCaptionTrailer];
WriteString [object.text];
END;
ENDCASE => ERROR;
END;
---------------------------------------------------------------------------------
---------------------------------------------------------------------------------
CountLinks: PROCEDURE [links: REF ObjectDefs.Link] RETURNS [count: CARDINAL] = BEGIN
count ← 0;
UNTIL links = NIL DO links ← links.link; count ← count + 1; ENDLOOP;
RETURN;
END;
---------------------------------------------------------------------------------
WriteLink: PROCEDURE [link: REF ObjectDefs.Link] = BEGIN
knotword: GFileKnotWord;
fpoint: GFilePoint;
freal: GFileReal;
j: CARDINAL;
Zero [@knotword, lGFileKnotWord];
Zero [@fpoint, lGFilePoint];
Zero [@freal, lGFileReal];
knotword.knotcount ← link.knots.length;
knotword.knottype ←
SELECT link.degree
FROM
D0 => typeFD0Knot,
D1 => typeFD1Knot,
D2 => typeFD2Knot,
D3 => typeFD3Knot,
ENDCASE => typeFD3Knot;
WriteStructure [@knotword, lGFileKnotWord];
FOR j
IN [0 .. knotword.knotcount)
DO
fpoint.x ← link.knots [j] [PointDefs.X];
fpoint.y ← link.knots [j] [PointDefs.Y];
WriteStructure [@fpoint, lGFilePoint];
ENDLOOP;
END;
---------------------------------------------------------------------------------
---------------------------------------------------------------------------------
ReadStyle: PROCEDURE [fontMap: RelationDefs.Relation] RETURNS [CARDINAL] =
BEGIN OPEN StyleDefs;
thisstyle: StyleHandle ← CZone.NEW[Style];
styleNum: CARDINAL;
fstyle: GFileStyle;
j, namelength: CARDINAL;
ReadStructure [@fstyle, lGFileStyle];
BEGIN OPEN thisstyle;
next ← NIL;
color ← Color [fstyle.hue, fstyle.saturation, fstyle.brightness];
dashed ←
SELECT fstyle.dashedness
FROM
typeUnDashed => undashed,
ENDCASE => undashed;
firstend.type ←
SELECT fstyle.send
FROM
typeRoundEnd => round,
typeCyclicEnd => cyclic,
typeFlatEnd => flat,
typeAngledEnd => angled,
ENDCASE => round; -- should be an error
lastend.type ←
SELECT fstyle.eend
FROM
typeRoundEnd => round,
typeCyclicEnd => cyclic,
typeFlatEnd => flat,
typeAngledEnd => angled,
ENDCASE => round; -- should be an error
firstend.dx ← GetReal[fstyle.bdx];
firstend.dy ← GetReal[fstyle.bdy];
firstend.a ← GetReal[fstyle.ba];
firstend.b ← GetReal[fstyle.bb];
firstend.c ← GetReal[fstyle.bc];
lastend.dx ← GetReal[fstyle.edx];
lastend.dy ← GetReal[fstyle.edy];
lastend.a ← GetReal[fstyle.ea];
lastend.b ← GetReal[fstyle.eb];
lastend.c ← GetReal[fstyle.ec];
width ← GetReal[fstyle.thickness];
junctiontype ←
SELECT fstyle.junction
FROM
typeRoundJunction => round,
typeSquareJunction => square,
typeAngledJunction => angled,
ENDCASE => round;
fillcolor ← Color [fstyle.ahue, fstyle.asaturation, fstyle.abrightness];
filled ← fstyle.afilled;
outlined ← fstyle.aoutlined;
fontid ← RelationDefs.Right[fontMap, fstyle.fontid];
backgndcolor ← Color [fstyle.bhue, fstyle.bsaturation, fstyle.bbrightness];
fillbackgnd ← fstyle.background;
anchor ←
SELECT fstyle.anchor
FROM
typeLeftAnchor => left,
typeCenterAnchor => center,
typeRightAnchor => right,
ENDCASE => left; -- should be an error
orientation ←
SELECT fstyle.torient
FROM
typeRot0 => or0,
typeRot90 => or90,
typeRot180 => or180,
typeRot270 => or270,
ENDCASE => or0; -- should be an error
namelength ← LOOPHOLE [fstyle.stylename [0], BYTE];
BEGIN
fromProc: SAFE PROC RETURNS [CHAR] = CHECKED {j ← j+1; RETURN[fstyle.stylename[j]]};
j ← 0;
name ← Rope.FromProc[namelength,fromProc];
END;
END;
styleNum ← ControllerDefs.AppendStyle [thisstyle]; -- appends a copy of the style
RETURN[styleNum];
END;
---------------------------------------------------------------------------------
---------------------------------------------------------------------------------
ReadObject: PROCEDURE[styleMap, clusterMap: RelationDefs.Relation] =
BEGIN OPEN ObjectDefs;
newobject: ObjectHandle;
fileobject: GFileObject;
fcaptiontrailer: GFileCaptionTrailer;
tl, br: PointDefs.ScrPt;
splinetype: SplineDefs.SplineType;
nlinks: CARDINAL;
stylenumber: CARDINAL;
ptr: REF Link;
xptr: REF Link;
currentView: ObjectDefs.View ← ObjectDefs.GetCurrentView[];
otherView: ObjectDefs.View
← IF currentView=main THEN alternate ELSE main;
ReadStructure [@fileobject, lGFileObject];
SELECT fileobject.objtype
FROM
typeAreaObject, typeCurveObject =>
newobject← StartObject[shape];
typeCaptionObject =>
newobject← StartObject[caption];
typeTokenObject =>
newobject← StartObject[token];
ENDCASE => SIGNAL GriffinFileError;
stylenumber ← RelationDefs.Right[styleMap, fileobject.style];
newobject.style ← ControllerDefs.StyleWithNumber [stylenumber];
IF fileobject.cluster <= ObjectDefs.OpenCluster
THEN newobject.cluster ← fileobject.cluster
ELSE
BEGIN
cluster: CARDINAL ← RelationDefs.Right[clusterMap, fileobject.cluster];
IF cluster = RelationDefs.notFound
THEN
BEGIN
cluster ← ObjectDefs.GetNextClusterID[];
RelationDefs.AddPair[clusterMap, fileobject.cluster, cluster];
END;
newobject.cluster ← cluster;
END;
newobject.view ←
IF fileobject.hidewindow
THEN otherView
ELSE currentView;
newobject.cull ←
SELECT fileobject.visible
FROM
typeNotVisible => outside,
typePartiallyVisible => partial,
typeWhollyVisible => inside,
ENDCASE => partial;
newobject.validEncoding ← FALSE;
tl [PointDefs.X] ← fileobject.bleft; tl [PointDefs.Y] ← fileobject.btop;
br [PointDefs.X] ← fileobject.bright; br [PointDefs.Y] ← fileobject.bbottom;
newobject.tl ← tl; newobject.br ← br;
WITH object: newobject
SELECT
FROM
shape =>
BEGIN OPEN SplineDefs;
object.closed ← fileobject.objtype = typeAreaObject;
splinetype ←
SELECT fileobject.splinetype
FROM
typeNUMSpline => SplineType [naturalUM],
typeCUMSpline => SplineType [cyclicUM],
typeNALSpline => SplineType [naturalAL],
typeCALSpline => SplineType [cyclicAL],
typeBEZSpline => SplineType [bezier],
typeBSISpline => SplineType [bsplineInterp],
typeBSpline => SplineType [bspline],
typeCRSpline => SplineType [crspline],
ENDCASE => SplineType [bspline];
SELECT fileobject.trajtype
FROM
typeLinkedTraj =>
BEGIN
nlinks ← ReadWord [];
IF nlinks =0 THEN object.trajectory ← CZone.NEW[Trajectory ← [splinetype, linked [NIL]]]
ELSE
BEGIN
ptr ← NewLink [];
object.trajectory ← CZone.NEW[Trajectory ← [splinetype, linked [ptr]]];
THROUGH (1..nlinks] DO ptr←ptr.link←NewLink[] ENDLOOP;
END;
END;
typeCSTraj =>
BEGIN
IF ReadWord [] # 1 THEN SIGNAL GriffinFileError;
xptr ← NewLink [];
object.trajectory ← CZone.NEW[Trajectory ← [splinetype, cyclic [xptr.knots]]];
END;
ENDCASE => SIGNAL GriffinFileError;
END;
caption =>
BEGIN
ReadStructure [@fcaptiontrailer, lGFileCaptionTrailer];
object.p0 [PointDefs.X] ← GetReal[fcaptiontrailer.xanchor];
object.p0 [PointDefs.Y] ← GetReal[fcaptiontrailer.yanchor];
object.text ← ReadString [];
END;
ENDCASE;
END;
---------------------------------------------------------------------------------
---------------------------------------------------------------------------------
NewLink:
PROCEDURE
RETURNS [lin:
REF ObjectDefs.Link] =
BEGIN
OPEN ObjectDefs;
knotword: GFileKnotWord;
knots: PointDefs.ObjPtSequence;
num, j: CARDINAL;
fpoint: GFilePoint;
lin ← CZone.NEW [Link];
ReadStructure [@knotword, lGFileKnotWord];
num ← knotword.knotcount;
SELECT knotword.knottype FROM
typeFD0Knot, typeFD1Knot, typeFD2Knot, typeFD3Knot =>
BEGIN
knots ← CZone.NEW[PointDefs.ObjPtSequenceRec[num]];
lin^ ← Link [
NIL, (
SELECT knotword.knottype
FROM
typeFD0Knot => D0,
typeFD1Knot => D1,
typeFD2Knot => D2,
typeFD3Knot => D3,
ENDCASE => D1), knots];
FOR j
IN [0 .. num)
DO
ReadStructure [@fpoint, lGFilePoint];
knots [j] ← PointDefs.ObjPt[GetReal[fpoint.x], GetReal[fpoint.y]];
ENDLOOP;
END;
ENDCASE => SIGNAL GriffinFileError;
END;
---------------------------------------------------------------------------------
private low-level disk access procedures
---------------------------------------------------------------------------------
WriteWord:
PROCEDURE [word:
CARDINAL] =
BEGIN
bytes: TWOBYTES ← LOOPHOLE[word];
IO.PutChar[diskHandle,bytes.high];
IO.PutChar[diskHandle,bytes.low];
END;
---------------------------------------------------------------------------------
ReadWord:
PROCEDURE
RETURNS [
CARDINAL] =
BEGIN
word: TWOBYTES;
word.high ← IO.GetChar[diskHandle];
word.low ← IO.GetChar[diskHandle];
RETURN[LOOPHOLE[word]];
END;
---------------------------------------------------------------------------------
TWOBYTES: TYPE = MACHINE DEPENDENT RECORD [high: CHARACTER, low: CHARACTER];
WriteString:
PROCEDURE [s:
ROPE] =
BEGIN
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];
END;
---------------------------------------------------------------------------------
stringHack: BOOLEAN ← FALSE; --for the old bug in WriteString
ReadString:
PROCEDURE
RETURNS [s:
ROPE] =
BEGIN
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 IF ~stringHack THEN [] ← IO.GetChar[diskHandle];
END;
---------------------------------------------------------------------------------
ZeroRestOfSector:
PROCEDURE
RETURNS [SectorIndex] =
BEGIN
UNTIL IO.GetIndex [diskHandle] MOD 512 = 0 DO WriteWord [0] ENDLOOP;
RETURN [SectorIndex [IO.GetIndex [diskHandle]/512]];
END;
---------------------------------------------------------------------------------
MoveToSector:
PROCEDURE [si: SectorIndex] =
BEGIN
IO.SetIndex [diskHandle, LONG[si.sector]*512];
END;
Reset:
PROCEDURE [d:
IO.
STREAM] =
BEGIN
IO.SetIndex [d, 0];
END;
---------------------------------------------------------------------------------
ReadStructure:
PROCEDURE [p:
LONG
POINTER, l:
CARDINAL] =
BEGIN
block: IO.UnsafeBlock ← [base: LOOPHOLE[p], startIndex: 0, count: l*2];
IF IO.UnsafeGetBlock [diskHandle, block] # l*2 THEN SIGNAL GriffinFileError;
END;
---------------------------------------------------------------------------------
WriteStructure:
PROCEDURE [p:
LONG
POINTER, l:
CARDINAL] =
BEGIN
block: IO.UnsafeBlock ← [base: LOOPHOLE[p], startIndex: 0, count: l*2];
IO.UnsafePutBlock [diskHandle, block];
END;
---------------------------------------------------------------------------------
MoveSectors:
PROCEDURE [source: SectorIndex, dist:
INTEGER, oldfileend: SectorIndex] =
BEGIN
j: CARDINAL;
sector: GFileSector;
p: LONG POINTER TO GFileSector = @sector;
block: IO.UnsafeBlock ← [base: LOOPHOLE[p], startIndex: 0, count: 512];
IF dist < 0
THEN
FOR j
DECREASING
IN [source .. oldfileend)
DO
MoveToSector [SectorIndex [j]];
IF IO.UnsafeGetBlock[diskHandle, block] # 512 THEN SIGNAL GriffinFileError;
MoveToSector [SectorIndex [j+dist]];
IO.UnsafePutBlock[diskHandle, block];
ENDLOOP
ELSE
FOR j
IN [source .. oldfileend)
DO
MoveToSector [SectorIndex [j]];
IF IO.UnsafeGetBlock[diskHandle, block] # 512 THEN SIGNAL GriffinFileError;
MoveToSector [SectorIndex [j+dist]];
IO.UnsafePutBlock[diskHandle, block];
ENDLOOP;
END;
-----------------------------------------------------------------
Zero:
PROC [block:
LONG
POINTER, length:
CARDINAL] = {
block^ ← 0;
PrincOpsUtils.LongCOPY[from: block, to: block+1, nwords: length-1];
};
END.