<> <> <> <> <> <> <<>> 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 KnotFix: TYPE = {none, version31, all}; --three cases majorVersion: GriffinFileFormat.BYTE = 3; minorVersion: GriffinFileFormat.BYTE = 3; <> <> <> <> <> <> <> 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; knotFix: KnotFix _ none; --for fixing up cyclic splines 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]; <> 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[]; <> <> IF fileheader.majversion < 3 THEN knotFix _ all; IF fileheader.majversion = 3.0 THEN SELECT fileheader.minversion FROM 0 => knotFix _ all; 1 => knotFix _ version31; ENDCASE => knotFix _ none; THROUGH [1 .. objectcount] DO ReadObject[newStyles, clusterMap, data, diskHandle, knotFix]; 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; <> <> 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]; <> 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]; <> 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]; <> 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, knotFix: KnotFix] = { 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 knotFix=version31 THEN knotFix _ IF (splinetype=cyclicAL OR splinetype=cyclicUM) THEN none ELSE all; IF knotFix=all 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; }; <> 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]; <> 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]; }; END.