-- Compiler GriffinFile/n
--Stone April 30, 1981 1:51 PM
--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

DIRECTORY
GriffinFileDefs: FROM "GriffinFileDefs",
GFileFormatDefs: FROM "GFileFormatDefs",
GriffinStartDefs: FROM "GriffinStartDefs",
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],
MiscDefs: FROM "MiscDefs" USING [Zero],
SplineDefs: FROM "SplineDefs" USING [SplineType],
StreamDefs: FROM "StreamDefs" USING [NewWordStream, Read, Write, Append,
GetIndex, FileLength, DiskHandle, StreamIndex, SetIndex,
TruncateDiskStream, ReadBlock, WriteBlock, CleanupDiskStream],
OsStaticDefs: FROM "OsStaticDefs" USING [OsStatics],
RealConvert: FROM "RealConvert" USING [Mesa5ToIeee],
TimeDefs: FROM "TimeDefs" USING [CurrentDayTime],
GriffinFontDefs: FROM "GriffinFontDefs"
USING [FontDescriptor],
RelationDefs: FROM "RelationDefs",
StringDefs: FROM "StringDefs" USING [AppendString, SubStringDescriptor, EquivalentSubStrings, BcplSTRING];


GriffinFile: PROGRAM IMPORTS StreamDefs, StringDefs, TimeDefs,
GriffinMemoryDefs, ControllerDefs, ObjectDefs, MiscDefs,
GriffinDefs, RelationDefs, RealConvert
EXPORTS GriffinFileDefs, GriffinStartDefs =

BEGIN OPEN GFileFormatDefs, GriffinFileDefs, GriffinMemoryDefs;

-- ---------------------------------------------------------------------------------


GriffinFileError: PUBLIC SIGNAL = CODE;

fileName: STRING = [51];
diskHandle: StreamDefs.DiskHandle;
GFileState: TYPE = {notopen, open};
gfileState: GFileState ← notopen;
majorVersion: BYTE = 1;
minorVersion: BYTE = 4;
maxCPairCount: CARDINAL = 2000; -- just for safety
realConvert: BOOLEAN ← FALSE;


-- --------------------------------------------------------------------------

GetReal: PROCEDURE [r: LONG UNSPECIFIED] RETURNS [out: REAL] =
BEGIN
IF realConvert THEN RETURN[RealConvert.Mesa5ToIeee[r]] ELSE RETURN[r];
END;

OpenPortfolio: PUBLIC PROCEDURE [filename: STRING, createok: BOOLEAN ← FALSE] RETURNS [BOOLEAN] =
BEGIN
newfile: BOOLEAN;
username: POINTER TO StringDefs.BcplSTRING;
creator: STRING = [cNameChars];
header: GFileHeader;
j: CARDINAL; -- just a loop control variable
IF gfileState # notopen THEN SIGNAL GriffinFileError;
gfileState ← open;
fileName.length ← 0;
StringDefs.AppendString [fileName, filename];
StringDefs.AppendString [fileName, ".Griffin"];
diskHandle ← StreamDefs.NewWordStream [fileName,
StreamDefs.Read + StreamDefs.Write + StreamDefs.Append];
newfile ← StreamDefs.FileLength [diskHandle] = StreamDefs.StreamIndex [0, 0];
IF ~ createok AND newfile THEN BEGIN DeletePortfolio []; RETURN [FALSE]; END;
IF newfile THEN BEGIN OPEN header;
MiscDefs.Zero [@header, lGFileHeader];
majversion ← majorVersion;
minversion ← minorVersion;
createtime ← TimeDefs.CurrentDayTime [];
numfigs ← 0;
nextsector ← SectorIndex [1];
diskHandle.reset [diskHandle];
FOR j IN ValidFigRange DO header.figure [j] ← SectorIndex [0]; ENDLOOP;
username ← OsStaticDefs.OsStatics↑.UserName;
creatorname [0] ← LOOPHOLE [username.length, CHARACTER];
FOR j IN [1 .. cNameChars] DO
creatorname [j] ← IF j > username.length THEN 0C
ELSE username.char [j-1];
ENDLOOP;
portfolioname [0] ← LOOPHOLE [fileName.length, CHARACTER];
FOR j IN [1 .. pNameChars] DO
portfolioname[j] ← IF j > fileName.length THEN 0C ELSE
fileName [j-1];
ENDLOOP;
WriteHeaderAndFlush [@header];
END;
RETURN [TRUE];
END;



-- ---------------------------------------------------------------------------------


ClosePortfolio: PUBLIC PROCEDURE =
BEGIN
fileheader: GFileHeader;
IF gfileState = notopen THEN RETURN;
ReadHeader [@fileheader];
MoveToSector [fileheader.nextsector];
StreamDefs.TruncateDiskStream [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;
diskHandle.reset [diskHandle];
StreamDefs.TruncateDiskStream [diskHandle];
END;



-- ---------------------------------------------------------------------------------


ReadFigure: PUBLIC PROCEDURE [fignum: FigureNumber] =
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.FontDescriptor;
fontMap, styleMap, clusterMap: Relation;

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];
ENDLOOP;
fontcount ← ReadWord [];
fontMap ← CreateRelation[];
FOR f IN [1 .. fontcount] DO
ReadStructure [@font, lGFileFont];
slen ← LOOPHOLE [font.char [0], BYTE]; -- just a temp
fd.name ← AllocateString [slen];
fd.name.length ← slen;
FOR i IN [1 .. slen] DO fd.name [i-1] ← font.char [i]; ENDLOOP;
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 ← TimeDefs.CurrentDayTime [];
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 ← WriteFigure [];
END
ELSE BEGIN
MoveToSector [header.nextsector];
sectorsadded ← WriteFigure [] - header.nextsector -
(oldfigend - figbegin);
MoveSectors [oldfigend, sectorsadded, header.nextsector];
MoveToSector [figbegin];
[] ← WriteFigure [];
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;



-- ---------------------------------------------------------------------------------


AddFigure: PUBLIC PROCEDURE [fignum: FigureNumber] RETURNS [BOOLEAN] = BEGIN
--Stone April 16, 1980 9:38 PM
figbegin: SectorIndex;
i, figlength: CARDINAL;
header: GFileHeader;
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 ← WriteFigure [] - 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];
[] ← WriteFigure [];
END;
header.numfigs ← header.numfigs + 1;
WriteHeaderAndFlush [@header];
RETURN [TRUE]
END;



-- ---------------------------------------------------------------------------------
ReadHeader: PROCEDURE [h: POINTER TO GFileHeader] =
BEGIN
diskHandle.reset [diskHandle];
ReadStructure [h, lGFileHeader];
realConvert ← FALSE;
IF h.majversion#majorVersion
OR h.minversion#minorVersion THEN
BEGIN
--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 h.majversion=1 AND h.minversion IN [0..3]
THEN realConvert ← TRUE
ELSE
{diskHandle.destroy[diskHandle];
gfileState ← notopen;
GriffinDefs.UserMessage["Incorrect file format."];
};
END;
END;
-- ---------------------------------------------------------------------------------
WriteHeaderAndFlush: PROCEDURE [h: POINTER TO GFileHeader] =
BEGIN
diskHandle.reset [diskHandle];
WriteStructure [h, lGFileHeader];
StreamDefs.CleanupDiskStream [diskHandle];
END;

-- ---------------------------------------------------------------------------------

WriteFigure: 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.FontDescriptor] =
BEGIN count ← count+1 END;
CountPair: ControllerDefs.CPProcedure = BEGIN count ← count+1 END;
MiscDefs.Zero [@figname, lGFileFigureName];
-- figname.char [0] ← LOOPHOLE [name.length, CHARACTER];
-- FOR j IN [1 .. figNameChars] DO
-- figname.char [j] ← IF j<name.length THEN name [j] ELSE 0C;
-- ENDLOOP;
WriteStructure [@figname, lGFileFigureName];
MiscDefs.Zero [@hcontroller, lGFileHardcopyController];
BEGIN OPEN ControllerDefs, hcontroller;
[hxcenter: centerx, hycenter: centery, hwidth: width,
hheight: height, pressxcenter: presscenterx, pressycenter: presscentery,
hscale: scale] ← hc ← ReadHardcopyController [];
END;
MiscDefs.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;
MiscDefs.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.FontDescriptor] = BEGIN
j: CARDINAL;
font: GFileFont;
MiscDefs.Zero [@font, lGFileFont];
font.points ← fd.points;
font.face ← fd.face;
font.rotation ← fd.rotation;
font.char [0] ← LOOPHOLE [fd.name.length, CHARACTER];
FOR j IN [1.. fontChars]
DO
font.char[j] ← IF j<=fd.name.length THEN fd.name[j-1] ELSE 0C;
ENDLOOP;
WriteStructure [@font, lGFileFont];
END;

-- ---------------------------------------------------------------------------------

-- ---------------------------------------------------------------------------------
WriteStyle: PROCEDURE [style: StyleDefs.StyleHandle] = BEGIN OPEN StyleDefs, style;
fstyle: GFileStyle;
j: CARDINAL;
MiscDefs.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;
fstyle.stylename [0] ← LOOPHOLE [name.length, CHARACTER];
FOR j IN [1 .. sNameChars] DO
fstyle.stylename [j] ← IF j > name.length THEN 0C ELSE name [j-1];
ENDLOOP;
WriteStructure [@fstyle, lGFileStyle];
END;

-- ---------------------------------------------------------------------------------


WriteObject: PROCEDURE [obj: ObjectDefs.ObjectHandle] =
BEGIN OPEN ObjectDefs;
fobject: GFileObject;
fcaptiontrailer: GFileCaptionTrailer;
flinks: POINTER TO Link;
fakelink: Link ← [link: NIL, degree: D3, knots: DESCRIPTOR [NIL, 0]];
flinkcount: CARDINAL;
SELECT obj.objectType FROM
shape,caption => NULL; --do these
ENDCASE => RETURN; --ignore the rest
MiscDefs.Zero [@fobject, lGFileObject];
MiscDefs.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: POINTER TO ObjectDefs.Link] RETURNS [count: CARDINAL] = BEGIN
count ← 0;
UNTIL links = NIL DO links ← links.link; count ← count + 1; ENDLOOP;
RETURN;
END;

-- ---------------------------------------------------------------------------------


WriteLink: PROCEDURE [link: POINTER TO ObjectDefs.Link] = BEGIN
knotword: GFileKnotWord;
fpoint: GFilePoint;
freal: GFileReal;
j: CARDINAL;
MiscDefs.Zero [@knotword, lGFileKnotWord];
MiscDefs.Zero [@fpoint, lGFilePoint];
MiscDefs.Zero [@freal, lGFileReal];
knotword.knotcount ← LENGTH [link.knots];
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: 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];
name ← AllocateString [namelength];
name.length ← namelength;
FOR j IN [0 .. namelength) DO name [j] ← fstyle.stylename [j+1]; ENDLOOP;
END;
styleNum ← ControllerDefs.AppendStyle [@thisstyle]; -- appends a copy of the style
FreeString[thisstyle.name];
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: POINTER TO Link;
xptr: POINTER TO 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: INTEGER ← 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 ← Trajectory [splinetype, linked [NIL]]
ELSE BEGIN
ptr ← NewLink [];
object.trajectory ← 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 ← Trajectory [splinetype, cyclic [xptr.knots]];
Free [xptr];
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: POINTER TO ObjectDefs.Link] = BEGIN OPEN ObjectDefs;
knotword: GFileKnotWord;
knots: DESCRIPTOR FOR ARRAY OF PointDefs.ObjPt;
num, j: CARDINAL;
fpoint: GFilePoint;
lin ← Allocate [SIZE [Link]];
ReadStructure [@knotword, lGFileKnotWord];
num ← knotword.knotcount;
SELECT knotword.knottype FROM
typeFD0Knot, typeFD1Knot, typeFD2Knot, typeFD3Knot =>
BEGIN
knots ← DESCRIPTOR [Allocate[num*SIZE[PointDefs.ObjPt]], 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
diskHandle.put [diskHandle, word];
END;
-- ---------------------------------------------------------------------------------
ReadWord: PROCEDURE RETURNS [CARDINAL] = BEGIN
RETURN [diskHandle.get [diskHandle]];
END;
-- ---------------------------------------------------------------------------------

TWOBYTES: TYPE = MACHINE DEPENDENT RECORD [high: CHARACTER, low: CHARACTER];

WriteString: PROCEDURE [s: STRING] = BEGIN
wd: TWOBYTES ← [0C, 0C];
j: CARDINAL;
wd.high ← LOOPHOLE [s.length, CHARACTER];
FOR j IN [0 .. s.length) DO
IF j MOD 2 = 0 THEN wd.low ← s [j] ELSE BEGIN
diskHandle.put [diskHandle, wd]; -- write old one
wd ← [s [j], 0C] END;
ENDLOOP;
diskHandle.put [diskHandle, wd];
END;
-- ---------------------------------------------------------------------------------

ReadString: PROCEDURE RETURNS [s: STRING] = BEGIN
wd: TWOBYTES;
j, length: CARDINAL;
wd ← diskHandle.get [diskHandle];
length ← LOOPHOLE [wd.high, CARDINAL];
s ← AllocateString [length];
s.length ← length;
FOR j IN [0 .. length) DO
IF j MOD 2 = 1 THEN wd ← diskHandle.get [diskHandle];
s [j] ← IF j MOD 2 = 1 THEN wd.high ELSE wd.low;
ENDLOOP;
END;
-- ---------------------------------------------------------------------------------


ZeroRestOfSector: PROCEDURE RETURNS [SectorIndex] = BEGIN
UNTIL StreamDefs.GetIndex [diskHandle].byte = 0 DO WriteWord [0] ENDLOOP;
RETURN [SectorIndex [StreamDefs.GetIndex [diskHandle].page]];
END;

-- ---------------------------------------------------------------------------------
MoveToSector: PROCEDURE [si: SectorIndex] = BEGIN OPEN StreamDefs;
SetIndex [diskHandle, StreamIndex [si, 0]];
END;



-- ---------------------------------------------------------------------------------
ReadStructure: PROCEDURE [p: POINTER, l: CARDINAL] = BEGIN
IF StreamDefs.ReadBlock [diskHandle, p, l] # l THEN SIGNAL GriffinFileError;
END;
-- ---------------------------------------------------------------------------------
WriteStructure: PROCEDURE [p: POINTER, l: CARDINAL] = BEGIN
IF StreamDefs.WriteBlock [diskHandle, p, l] # l THEN SIGNAL GriffinFileError;
END;

-- ---------------------------------------------------------------------------------
MoveSectors: PROCEDURE [source: SectorIndex, dist: INTEGER, oldfileend: SectorIndex] =
BEGIN OPEN StreamDefs;
j: CARDINAL;
sector: GFileSector;
p: POINTER TO GFileSector = @sector;
IF dist < 0 THEN FOR j DECREASING IN [source .. oldfileend) DO
MoveToSector [SectorIndex [j]];
IF ReadBlock[diskHandle, p, 256] # 256 THEN SIGNAL GriffinFileError;
MoveToSector [SectorIndex [j+dist]];
IF WriteBlock[diskHandle, p,256] # 256 THEN SIGNAL GriffinFileError;
ENDLOOP
ELSE FOR j IN [source .. oldfileend) DO
MoveToSector [SectorIndex [j]];
IF ReadBlock[diskHandle, p, 256] # 256 THEN SIGNAL GriffinFileError;
MoveToSector [SectorIndex [j+dist]];
IF WriteBlock[diskHandle, p,256] # 256 THEN SIGNAL GriffinFileError;
ENDLOOP;
END;

-- -----------------------------------------------------------------
IsTail: PUBLIC PROCEDURE [s1, s2: STRING] RETURNS [CARDINAL] =
BEGIN
s1len, s2len, s1stub: CARDINAL;
ss1, ss2: StringDefs.SubStringDescriptor;

s1len ← s1.length;
s2len ← s2.length;
s1stub ← s1len - s2len;
IF s1len < s2len THEN RETURN [0];
ss1 ← [s1, s1stub, s2len];
ss2 ← [s2, 0, s2len];
IF StringDefs.EquivalentSubStrings[@ss1, @ss2]
THEN RETURN [s1stub]
ELSE RETURN [0];
END;

END.