<> <> <> <> <> <> <> <> 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; <> <> <<-------------------------------------------------------------------------->> 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; <<--------------------------------------------------------------------------------->> <> <> <> <> <> <> <<>> <<>> <<>> <<--------------------------------------------------------------------------------->> 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]; <> <> <> 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]; <> 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; <<--------------------------------------------------------------------------------->> <> <> <> <> <> <> <> <> <> < header.numfigs THEN SIGNAL GriffinFileError;>> <<>> <> <> < 1 THEN BEGIN>> <> <> <> <> <> <> <> <<>> <> <> <> <> <> <> <> <> <> <> <> <<(oldfigend - figbegin);>> <> <> <<[] _ WriteFigureContents [];>> <> <> <> <> <> <> <> <> <> <<--------------------------------------------------------------------------------->> <> <> <> <> <> <> <> <> <> < header.numfigs THEN SIGNAL GriffinFileError;>> <> <> <> <> <> <> <> <> <> <> <> <> <> <<>> <<>> <<>> <<--------------------------------------------------------------------------------->> WriteFigure: PUBLIC PROCEDURE = BEGIN <> 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; <> <> 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; <<--------------------------------------------------------------------------------->> <> <<--------------------------------------------------------------------------------->> 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]; <> 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.