<> <> <> DIRECTORY Convert, CornerStitching, EditSpan, EditSpanSupport, IO, Real, Rope, TableBase, TextNode, TiogaFileOps, TSArtwork, TSGraphic, TSOutput, TSTypes; TableBaseImpl: CEDAR PROGRAM IMPORTS Convert, CornerStitching, EditSpan, EditSpanSupport, IO, Rope, TextNode, TiogaFileOps, TSTypes EXPORTS TableBase = { OPEN TableBase; ImplementationError: PUBLIC ERROR [ROPE] = CODE; UnimplementedCase: PUBLIC ERROR = CODE; <<>> <> < Rows Columns [EmptyNodeTemplate]>> <> <<>> <> <<>> <> <<. . .>> <<>> <> < and are in the range 0..LAST[CARDINAL],>> << is one of byRowThenColumn or byColumnThenRow,>> <> << is (a,b) (c,d) >> < is one of box, rule, or background>> <> << are >> BranchToTable: PUBLIC PROCEDURE [node: TextNode.Ref] RETURNS [table: RefTable] ~ { s: IO.STREAM _ IO.RIS[RopeOfNode[node].Concat["\n"]]; objects: ObjectList _ NEW[ObjectListRep _ [IO.GetRefAnyLine[s]]]; atom: ATOM; tableBoxHeader: TextNode.Ref _ TextNode.FirstChild[node]; table _ NEW[Table]; table.tableGrid _ CornerStitching.NewTesselation[]; table.branch _ node; IF FirstObject[objects] = NIL THEN ERROR ImplementationError["You have to supply some clues for me in the root node of the table."]; < Rows Columns>> IF NOT ISTYPE[FirstObject[objects], ATOM] THEN ERROR ImplementationError["Expecting Grid keyword first."]; atom _ NARROW[NextObject[objects]]; IF atom # $Grid AND atom # $grid THEN ERROR ImplementationError["Expecting Grid keyword first, found something else."]; IF NOT ISTYPE[FirstObject[objects], REF INT] THEN ERROR ImplementationError["Expecting number of row grids after Grid keyword."]; table.rowGrids _ NARROW[NextObject[objects], REF INT]^; IF NOT ISTYPE[FirstObject[objects], ATOM] THEN ERROR ImplementationError["Expecting Rows keyword after number of vertical grids."]; atom _ NARROW[NextObject[objects], ATOM]; IF atom # $Rows AND atom # $rows THEN ERROR ImplementationError["Expecting Rows keyword between the numbers."]; IF NOT ISTYPE[FirstObject[objects], REF INT] THEN ERROR ImplementationError["Expecting number of column grids after Rows keyword."]; table.columnGrids _ NARROW[NextObject[objects], REF INT]^; IF NOT ISTYPE[FirstObject[objects], ATOM] THEN ERROR ImplementationError["Expecting Columns keyword after number of vertical grids."]; atom _ NARROW[NextObject[objects], ATOM]; IF atom # $Columns AND atom # $columns THEN ERROR ImplementationError["Expecting Columns keyword between the numbers."]; << could be either byRowThenColumn or byColumnThenRow>> IF NOT ISTYPE[FirstObject[objects], ATOM] THEN ERROR ImplementationError["Expecting fill in order after grid specification."]; table.fillInOrder _ SELECT NARROW[NextObject[objects], ATOM] FROM $ByRowThenColumn => byRowThenColumn, $ByColumnThenRow => byColumnThenRow, ENDCASE => ERROR ImplementationError["Unrecognized fill-in-order keyword."]; << is optional>> IF FirstObject[objects] # NIL AND ISTYPE[FirstObject[objects], ATOM] AND NARROW[FirstObject[objects], ATOM] = $GridOverlay THEN { [] _ NextObject[objects]; table.gridOverlayThickness _ GetDimn[objects]; table.gridOverlayHue _ GetReal[objects]; table.gridOverlaySaturation _ GetReal[objects]; table.gridOverlayBrightness _ GetReal[objects]; }; <> <> IF FirstObject[objects] # NIL AND ISTYPE[FirstObject[objects], ATOM] AND NARROW[FirstObject[objects], ATOM] = $EmptyNodeTemplate THEN { table.emptyNodeTemplateRoot _ TextNode.NewTextNode[]; [] _ NextObject[objects]; [] _ EditSpan.Copy[ destRoot: table.emptyNodeTemplateRoot, sourceRoot: TextNode.Root[node], dest: TextNode.MakeNodeLoc[table.emptyNodeTemplateRoot], source: TextNode.MakeNodeSpan[tableBoxHeader, tableBoxHeader], nesting: 1]; tableBoxHeader _ TextNode.NthSibling[tableBoxHeader, 1]; }; <> IF FirstObject[objects] # NIL AND ISTYPE[FirstObject[objects], ATOM] AND NARROW[FirstObject[objects], ATOM] = $RowConstraints THEN { constraint: RefConstraint; WHILE (constraint _ ParseConstraints[table~table, node~tableBoxHeader, row~TRUE]) # NIL DO table.rowConstraints _ CONS[constraint, table.rowConstraints]; tableBoxHeader _ TextNode.NthSibling[tableBoxHeader, 1]; ENDLOOP; [] _ NextObject[objects]; }; IF FirstObject[objects] # NIL AND ISTYPE[FirstObject[objects], ATOM] AND NARROW[FirstObject[objects], ATOM] = $ColConstraints THEN { constraint: RefConstraint; WHILE (constraint _ ParseConstraints[table~table, node~tableBoxHeader, row~FALSE]) # NIL DO table.colConstraints _ CONS[constraint, table.colConstraints]; tableBoxHeader _ TextNode.NthSibling[tableBoxHeader, 1]; ENDLOOP; [] _ NextObject[objects]; }; IF FirstObject[objects] # NIL THEN ERROR ImplementationError["Extraneous objects on table header"]; <> WHILE tableBoxHeader # NIL DO entry: RefTableEntry _ ParseTableBox[table, tableBoxHeader]; InsertEntryInGrid[table, entry]; tableBoxHeader _ TextNode.Next[tableBoxHeader]; ENDLOOP; <> }; InsertEntryInGrid: PUBLIC PROCEDURE [table: RefTable, entry: RefTableEntry] ~ { WITH entry SELECT FROM box: RefTableBox => { rect: CornerStitching.Rect ~ InsideGridToRect[box.left, box.top, box.right, box.bottom]; CornerStitching.ChangeRect[plane~table.tableGrid, rect~rect, newvalue~box, checkOldvalue~TRUE, oldvalue~NIL ! CornerStitching.TileValue => ERROR ImplementationError["Box overlaps another box or rule"]]; }; rule: RefTableRule => { rect: CornerStitching.Rect ~ OnGridToRect[rule.left, rule.top, rule.right, rule.bottom]; overlap: BOOLEAN _ FALSE; CornerStitching.ChangeRect[plane~table.tableGrid, rect~rect, newvalue~rule, checkOldvalue~FALSE]; <> < {overlap _ TRUE; CONTINUE}];>> <> <> <> }; background: RefTableBackground => { table.backgrounds _ CONS[background, table.backgrounds]; }; ENDCASE => ERROR UnimplementedCase; }; ParseTableBox: PROCEDURE [table: RefTable, tableBoxHeader: TextNode.Ref] RETURNS [entry: RefTableEntry] ~ { s: IO.STREAM ~ IO.RIS[RopeOfNode[tableBoxHeader].Concat["\n"]]; objects: ObjectList _ NEW[ObjectListRep _ [IO.GetRefAnyLine[s]]]; gridList: LIST OF REF ANY; top, left, bottom, right: GridNumber; boxType: BoxType; <<>> << (a,b) (c,d) >> IF NOT ISTYPE[FirstObject[objects], ATOM] THEN ERROR ImplementationError["Expected keyword box type first in the table box header"]; SELECT NARROW[NextObject[objects], ATOM] FROM $Box => boxType _ box; $Rule => boxType _ rule; $Background => boxType _ background; ENDCASE => ERROR ImplementationError["Unrecognized box type keyword."]; <<>> IF NOT ISTYPE[FirstObject[objects], LIST OF REF ANY] THEN ERROR ImplementationError["Expected grid coordinates as first object in table box header"]; gridList _ NARROW[NextObject[objects], LIST OF REF ANY]; top _ NARROW[gridList.first, REF INT]^; left _ NARROW[gridList.rest.first, REF INT]^; IF NOT ISTYPE[FirstObject[objects], LIST OF REF ANY] THEN ERROR ImplementationError["Expected grid coordinates as second object in table box header"]; gridList _ NARROW[NextObject[objects], LIST OF REF ANY]; bottom _ NARROW[gridList.first, REF INT]^; right _ NARROW[gridList.rest.first, REF INT]^; IF top > table.rowGrids OR bottom > table.rowGrids OR left > table.columnGrids OR right > table.columnGrids THEN ERROR ImplementationError["Coordinates are outside the table grid."]; SELECT boxType FROM box => { box: RefTableBox _ NEW[TableBox _ [top~top, left~left, bottom~bottom, right~right, entrySpecs~box[]]]; IF FirstObject[objects] # NIL THEN { <> box.rowAlignment _ SELECT NARROW[NextObject[objects], ATOM] FROM $FlushTop => flushTop, $FlushBottom => flushBottom, $Center => center, $Centre => center, $TopBaseline => topBaseline, $BottomBaseline => bottomBaseline, $CenterOnTopBaseline => centerOnTopBaseline, $CentreOnTopBaseline => centerOnTopBaseline, $CenterOnBottomBaseline => centerOnBottomBaseline, $CentreOnBottomBaseline => centerOnBottomBaseline, ENDCASE => ERROR ImplementationError["expected vertical alignment as third object in table box header"]; }; IF FirstObject[objects] # NIL THEN { <> box.colAlignment _ SELECT NARROW[NextObject[objects], ATOM] FROM $FlushLeft => flushLeft, $FlushRight => flushRight, $Center => center, $Centre => center, ENDCASE => ERROR ImplementationError["expected horizontal alignment as fourth object in table box header"]; }; IF FirstObject[objects] # NIL AND ISTYPE[FirstObject[objects], ATOM] AND $CharAlign = NARROW[NextObject[objects], ATOM] THEN { <> box.alignOnChar _ TRUE; box.alignChar _ NARROW[NextObject[objects], REF CHAR]^; }; IF FirstObject[objects] # NIL THEN { <> box.bearoffExtents[left] _ GetDimn[objects]; box.bearoffExtents[right] _ GetDimn[objects]; box.bearoffExtents[up] _ GetDimn[objects]; box.bearoffExtents[down] _ GetDimn[objects]; }; box.node _ TextNode.FirstChild[tableBoxHeader]; entry _ box; }; rule => { rule: RefTableRule _ NEW[TableRule _ [top~top, left~left, bottom~bottom, right~right, entrySpecs~rule[]]]; IF top # bottom AND left # right THEN ERROR ImplementationError["Rules must be along a grid line with top = bottom or left = right"]; rule.orientation _ IF top = bottom THEN horizontal ELSE vertical; rule.thickness _ GetDimn[objects]; entry _ rule; }; background => { background: RefTableBackground _ NEW[TableBackground _ [top~top, left~left, bottom~bottom, right~right, entrySpecs~background[]]]; background.hue _ GetReal[objects]; background.saturation _ GetReal[objects]; background.brightness _ GetReal[objects]; entry _ background; }; ENDCASE => ERROR UnimplementedCase; IF FirstObject[objects] # NIL THEN ERROR ImplementationError["Extraneous objects for this table entry"]; }; ParseConstraints: PROC [table: RefTable, node: TextNode.Ref, row: BOOLEAN] RETURNS [constraint: RefConstraint] ~ { s: IO.STREAM ~ IO.RIS[RopeOfNode[node].Concat["\n"]]; sign: REAL _ +1.0; coeff: Coefficient; coeffs: LIST OF Coefficient; equality: BOOLEAN; tokenKind: IO.TokenKind; token: ROPE; charsSkipped: INT; <> [tokenKind, token, charsSkipped] _ IO.GetCedarTokenRope[s]; IF tokenKind # tokenID THEN ERROR ImplementationError["Expected constraint keyword to come first"]; IF row AND NOT token.Equal["RowConstraint"] OR ~row AND NOT token.Equal["ColConstraint"] THEN RETURN [NIL]; <> [tokenKind, token, charsSkipped] _ IO.GetCedarTokenRope[s]; IF token.Equal["-"] THEN { sign _ -1.0; [tokenKind, token, charsSkipped] _ IO.GetCedarTokenRope[s]; } ELSE sign _ +1.0; < <+|-> >> < is of the form: * >> DO SELECT tokenKind FROM tokenREAL => coeff.coefficient _ sign*Convert.RealFromRope[token]; tokenDECIMAL => coeff.coefficient _ sign*Convert.IntFromRope[token]; ENDCASE => ERROR ImplementationError["Expected numeric coefficient"]; [tokenKind, token, charsSkipped] _ IO.GetCedarTokenRope[s]; IF tokenKind # tokenSINGLE OR NOT token.Equal["*"] THEN ERROR ImplementationError["Expected multiply sign"]; [tokenKind, token, charsSkipped] _ IO.GetCedarTokenRope[s]; IF tokenKind # tokenID THEN ERROR ImplementationError["Expected identifier"]; coeff.unknown _ token; coeffs _ CONS[coeff, coeffs]; [tokenKind, token, charsSkipped] _ IO.GetCedarTokenRope[s]; SELECT TRUE FROM token.Equal["="] => { equality _ TRUE; EXIT; }; token.Equal[">="] => { equality _ FALSE; EXIT; }; token.Equal["+"] => sign _ +1.0; token.Equal["-"] => sign _ -1.0; ENDCASE => ERROR ImplementationError["Expected additive or relational operator"]; [tokenKind, token, charsSkipped] _ IO.GetCedarTokenRope[s]; ENDLOOP; [tokenKind, token, charsSkipped] _ IO.GetCedarTokenRope[s]; IF NOT token.Equal["0"] AND NOT token.Equal["0.0"] THEN ERROR ImplementationError["Expected right-hand side to always be 0 or 0.0"]; constraint _ NEW[Constraint _ [equality, coeffs]]; }; ObjectList: TYPE ~ REF ObjectListRep; ObjectListRep: TYPE ~ RECORD[list: LIST OF REF ANY]; FirstObject: PROCEDURE[objects: ObjectList] RETURNS [o: REF ANY] = { IF objects # NIL AND objects.list # NIL THEN o _ objects.list.first; }; NextObject: PROCEDURE[objects: ObjectList] RETURNS [o: REF ANY] = { IF objects = NIL OR objects.list = NIL THEN ERROR ImplementationError["prematurely exhausted the supply of objects for this table entry"]; o _ objects.list.first; objects.list _ objects.list.rest; }; GetDimn: PROC [objects: ObjectList] RETURNS [TSTypes.Dimn] ~ { object: REF ANY ~ NextObject[objects]; r: REAL; multiplier: REAL; IF ISTYPE[object, REF REAL] THEN r _ NARROW[object, REF REAL]^ ELSE IF ISTYPE[object, REF INT] THEN r _ NARROW[object, REF INT]^ ELSE ERROR ImplementationError["Expecting a real number and didn't get it"]; multiplier _ SELECT NARROW[NextObject[objects], ATOM] FROM $in => 72.0, $pt => 72.0/72.27, $cm => 72.0/2.54, $mm => 72.0/25.4, $bp => 1.0, ENDCASE => 1.0; RETURN [TSTypes.Pt[r*multiplier]]; }; GetReal: PROC [objects: ObjectList] RETURNS [r: REAL] ~ { object: REF ANY ~ NextObject[objects]; IF ISTYPE[object, REF REAL] THEN r _ NARROW[object, REF REAL]^ ELSE IF ISTYPE[object, REF INT] THEN r _ NARROW[object, REF INT]^ ELSE ERROR ImplementationError["Expecting a real number and didn't get it"]; }; TableToBranch: PUBLIC PROCEDURE [table: RefTable] RETURNS [nodeRef: TextNode.Ref] ~ { branchRoot, branch, prevLast: TiogaFileOps.Ref; nodeRope: ROPE; CopyNodeAsChildOfLastNode: PROCEDURE [node: TextNode.Ref, prevLast: TiogaFileOps.Ref] = { prevLastTextNode: TextNode.Ref; TRUSTED { prevLastTextNode _ LOOPHOLE[prevLast] }; prevLastTextNode.child _ EditSpanSupport.CopySpan[TextNode.MakeNodeSpan[node, TextNode.LastWithin[node]]].start.node; prevLastTextNode.child.next _ prevLastTextNode; }; InsertTableBox: EnumeratedEntryProc = { <> rope: ROPE _ TableEntryToRope[entry]; prevLast _ TiogaFileOps.InsertAsLastChild[branch, prevLast]; TiogaFileOps.SetContents[prevLast, rope]; TiogaFileOps.SetFormat[prevLast, "block"]; WITH entry SELECT FROM box: RefTableBox => CopyNodeAsChildOfLastNode[box.node, prevLast]; ENDCASE => NULL; }; branchRoot _ TiogaFileOps.CreateRoot[]; TRUSTED { branch _ LOOPHOLE[EditSpan.Copy[ destRoot: LOOPHOLE[branchRoot], sourceRoot: TextNode.Root[table.branch], dest: TextNode.MakeNodeLoc[LOOPHOLE[branchRoot]], source: TextNode.MakeNodeSpan[table.branch, table.branch], nesting: 1].start.node] }; prevLast _ NIL; nodeRope _ "Grid"; nodeRope _ nodeRope.Concat[IO.PutFR[" %g Rows %g Columns", IO.card[table.rowGrids], IO.card[table.columnGrids]]]; nodeRope _ nodeRope.Concat[SELECT table.fillInOrder FROM byRowThenColumn => " ByRowThenColumn", byColumnThenRow => " ByColumnThenRow", ENDCASE => ""]; IF table.gridOverlayThickness # TSTypes.nilDimn THEN { nodeRope _ nodeRope.Concat[" GridOverlay"]; nodeRope _ nodeRope.Concat[IO.PutFR[" %g pt", IO.real[table.gridOverlayThickness.texPts]]]; nodeRope _ nodeRope.Concat[IO.PutFR[" %g %g %g", IO.real[table.gridOverlayHue], IO.real[table.gridOverlaySaturation], IO.real[table.gridOverlayBrightness]]]; }; <> IF table.emptyNodeTemplateRoot # NIL THEN { nodeRope _ nodeRope.Concat[" EmptyNodeTemplate"]; CopyNodeAsChildOfLastNode[TextNode.FirstChild[table.emptyNodeTemplateRoot], branch]; TRUSTED { prevLast _ LOOPHOLE[TextNode.FirstChild[LOOPHOLE[branch]]] }; }; TiogaFileOps.SetContents[branch, nodeRope]; IF table.backgrounds # NIL THEN { FOR b: LIST OF RefTableBackground _ table.backgrounds, b.rest WHILE b # NIL DO background: RefTableBackground _ b.first; [] _ InsertTableBox[table, background]; ENDLOOP; }; <> IF table.fillInOrder = byRowThenColumn THEN EnumerateByRows[table, InsertTableBox] ELSE EnumerateByColumns[table, InsertTableBox]; TRUSTED { nodeRef _ LOOPHOLE[branch] }; }; <<>> TableEntryToRope: PUBLIC PROCEDURE [entry: RefTableEntry] RETURNS [rope: ROPE _ NIL] ~ { rope _ SELECT entry.boxType FROM box => "Box", rule => "Rule", background => "Background", ENDCASE => ""; rope _ rope.Concat[" "]; rope _ rope.Concat[IO.PutFR["(%g, %g) (%g, %g)", IO.card[entry.top], IO.card[entry.left], IO.card[entry.bottom], IO.card[entry.right]]]; rope _ rope.Concat[" "]; WITH entry SELECT FROM box: RefTableBox => { rope _ rope.Concat[SELECT box.rowAlignment FROM flushTop => "FlushTop", flushBottom => "FlushBottom", center => "Center", topBaseline => "TopBaseline", bottomBaseline => "BottomBaseline", centerOnTopBaseline => "CenterOnTopBaseline", centerOnBottomBaseline => "CenterOnBottomBaseline", ENDCASE => ""]; rope _ rope.Concat[" "]; rope _ rope.Concat[SELECT box.colAlignment FROM flushLeft => "FlushLeft", flushRight => "FlushRight", center => "Center", ENDCASE => ""]; IF box.alignOnChar THEN { rope _ rope.Concat[" CharAlign"]; rope _ rope.Cat["'", Rope.FromChar[box.alignChar]]; }; IF box.bearoffExtents[left] # TSTypes.nilDimn THEN { rope _ rope.Concat[" "]; rope _ rope.Concat[IO.PutFR["%g pt %g pt %g pt %g pt", IO.real[box.bearoffExtents[left]], IO.real[box.bearoffExtents[right]], IO.real[box.bearoffExtents[up]], IO.real[box.bearoffExtents[down]]]] }; }; rule: RefTableRule => { rope _ rope.Concat[IO.PutFR["%g pt", IO.real[rule.thickness.texPts]]]; }; background: RefTableBackground => { rope _ rope.Concat[IO.PutFR["%g %g %g", IO.real[background.hue], IO.real[background.saturation], IO.real[background.brightness]]]; }; ENDCASE => ERROR UnimplementedCase; }; RopeOfNode: PROCEDURE [node: TextNode.Ref] RETURNS [rope: ROPE _ NIL] ~ { WITH node SELECT FROM x: TextNode.RefTextNode => RETURN[x.rope]; ENDCASE => NULL; }; BoxFromTile: PUBLIC PROCEDURE [tile: CornerStitching.TilePtr] RETURNS [box: RefTableBox] ~ { IF tile.Value # NIL AND ISTYPE[tile.Value, RefTableBox] THEN box _ NARROW[tile.Value]; }; TileFromBox: PUBLIC PROCEDURE [box: RefTableBox] RETURNS [tile: CornerStitching.TilePtr] ~ { <> ERROR ImplementationError["TileFromBox not implemented yet"]; }; InsideGridToRect: PUBLIC PROCEDURE [left, top, right, bottom: GridNumber] RETURNS [CornerStitching.Rect] = { RETURN [[4*left+2, 4*top+2, 4*right-1, 4*bottom-1]] }; OnGridToRect: PUBLIC PROCEDURE [left, top, right, bottom: GridNumber] RETURNS [CornerStitching.Rect] = { RETURN [[4*left, 4*top, 4*right+1, 4*bottom+1]] }; <<>> EnumerateByRows: PUBLIC PROCEDURE [table: RefTable, entryProc: EnumeratedEntryProc] ~ { EnumerateTable[table~table, entryProc~entryProc, left~FIRST[GridNumber], right~LAST[GridNumber], top~FIRST[GridNumber], bottom~LAST[GridNumber]]; }; EnumerateByColumns: PUBLIC PROCEDURE [table: RefTable, entryProc: EnumeratedEntryProc] ~ { EnumerateByRows[table, entryProc]; }; EnumerateTable: PUBLIC PROCEDURE [table: RefTable, entryProc: EnumeratedEntryProc, left: GridNumber _ FIRST[GridNumber], right: GridNumber _ LAST[GridNumber], top: GridNumber _ FIRST[GridNumber], bottom: GridNumber _ LAST[GridNumber]] ~ { TileProc: CornerStitching.PerTileProc ~ { entry: RefTableEntry _ NARROW[CornerStitching.Value[tile]]; IF entry # NIL THEN [] _ entryProc[table, entry]; RETURN[NIL]; }; [] _ CornerStitching.EnumerateArea[plane~table.tableGrid, rect~OnGridToRect[left, top, right, bottom], perTile~TileProc]; }; WithinGridLines: PUBLIC PROCEDURE [entry: RefTableBox, which: RowOrColumn, grid1, grid2: GridNumber] RETURNS [BOOLEAN] ~ { RETURN [SELECT which FROM row => entry.top >= grid1 AND entry.bottom <= grid2, column => entry.left >= grid1 AND entry.right <= grid2, ENDCASE => FALSE] }; }.