VTablesImpl.mesa
Russ Atkinson, April 6, 1983 6:08 pm
DIRECTORY
Buttons USING
[Button, ButtonProc, Create, SetDisplayStyle],
Graphics USING
[black, DrawBox, SetColor],
Labels USING
[Create, SetDisplayStyle],
Rope USING
[Flatten, ROPE, Size],
Runtime USING
[BoundsFault],
UserTerminal USING
[BlinkDisplay],
VFonts USING
[defaultFont, StringWidth, FontHeight, Font],
ViewerClasses USING
[DestroyProc, PaintProc, Viewer, ViewerClass, ViewerClassRec],
ViewerOps USING
[CreateViewer, DestroyViewer,
EstablishViewerPosition, PaintViewer, RegisterViewerClass],
VTables USING
[Border, FullBorder, NullBorder, VTable];
VTablesImpl: CEDAR MONITOR LOCKS data USING data: TableData
IMPORTS VFonts, Buttons, Graphics, Labels, Rope, Runtime,
ViewerOps, UserTerminal
EXPORTS VTables
= BEGIN OPEN Rope, VTables;
Viewer: TYPE = ViewerClasses.Viewer;
TableData: TYPE = REF TableDataRep;
TableDataRep: TYPE =
MONITORED RECORD
[rows, columns: NAT ← 0,
installed, locked, staticSize: BOOLFALSE,
live: BOOLTRUE,
condition: CONDITION,
xRuleWidth: INTEGER ← 1,
yRuleWidth: INTEGER ← 1,
rowWidths: WidthSeq ← NIL,
colWidths: WidthSeq ← NIL,
width: INTEGER ← 0,
height: INTEGER ← 0,
request: INTEGER ← 0,
rowSeq: RowSeq];
RowSeq: TYPE = REF RowSeqRep;
RowSeqRep: TYPE = RECORD
[rowData: SEQUENCE nRows: NAT OF RowData];
RowData: TYPE = REF RowDataRep;
RowDataRep: TYPE = RECORD [colData: SEQUENCE nCols: NAT OF Entry];
Entry: TYPE = RECORD
[border: Border, useMaxSize: BOOL,
xoff,yoff: Offset, viewer: Viewer] ← NullEntry;
NullEntry: Entry = [NullBorder, TRUE, 0, 0, NIL];
Offset: TYPE = INTEGER;
textXoff: Offset ← 4; -- hack for $Text x offset
textYoff: Offset ← 1; -- hack for $Text y offset
wHack: INTEGER ← 8; -- hack for entry size calculated by text
hHack: INTEGER ← 3; -- hack for entry size calculated by text
WidthSeq: TYPE = REF WidthSeqRep;
WidthSeqRep: TYPE = RECORD [widths: SEQUENCE size: NAT OF INTEGER];
AcquireLock: ENTRY PROC
[data: TableData, painting: BOOLFALSE] RETURNS [BOOL] = {
acquire the lock on the data
if requireInstalled then we wait for installation as well
return the live flag
if FALSE is returned, the lock is not held
ENABLE UNWIND => NULL;
DO
IF data = NIL OR NOT data.live THEN RETURN [FALSE];
IF painting AND NOT data.installed THEN
{data.request ← data.request + 1; RETURN [FALSE]};
IF NOT data.locked THEN {data.locked ← TRUE; RETURN [TRUE]};
WAIT data.condition;
ENDLOOP;
};
ReleaseLock: ENTRY PROC [data: TableData, install: BOOLFALSE] = {
release the data lock
if install, then set the installed flag as well
then notify everyone else that the world is OK
data.locked ← FALSE;
IF install THEN data.installed ← TRUE;
BROADCAST data.condition;
};
NewRowSeq: PROC [rows,columns: NAT] RETURNS [RowSeq] = {
rowSeq: RowSeq ← NEW[RowSeqRep[rows]];
FOR i: NAT IN [0..rows) DO
rowSeq[i] ← NEW[RowDataRep[columns]]
ENDLOOP;
RETURN [rowSeq];
};
NewWidthSeq: PROC [width: NAT] RETURNS [ws: WidthSeq] = {
ws ← NEW[WidthSeqRep[width]];
FOR i: NAT IN [0..width) DO
ws[i] ← 0
ENDLOOP
};
RecalculateWidths: PROC [data: TableData] = {
rowWidths: WidthSeq ← data.rowWidths;
colWidths: WidthSeq ← data.colWidths;
FOR row: NAT IN [0..data.rows) DO
rowWidths[row] ← 0;
FOR col: NAT IN [0..data.columns) DO
ent: Entry ← data.rowSeq[row][col];
v: Viewer ← ent.viewer;
IF row = 0 THEN colWidths[col] ← 0;
IF v # NIL THEN
{w: INTEGER ← v.ww + ABS[ent.xoff];
h: INTEGER ← v.wh + ABS[ent.yoff];
IF w > colWidths[col] THEN colWidths[col] ← w;
IF h > rowWidths[row] THEN rowWidths[row] ← h};
ENDLOOP;
ENDLOOP;
};
Create: PUBLIC PROC
[columns, rows: INTEGER ← 1,
name: ROPENIL,
parent: Viewer ← NIL,
xRuleWidth: INTEGER ← 1,
yRuleWidth: INTEGER ← 1,
x, y, w, h: INTEGER ← 0,
scrollable: BOOLFALSE]
RETURNS [table: VTable] = TRUSTED {
data: TableData ← NIL;
IF columns <= 0 OR rows <= 0 THEN RETURN [NIL];
IF name = NIL THEN name ← " ";
data ← NEW[TableDataRep];
data.rows ← rows;
data.columns ← columns;
data.rowSeq ← NewRowSeq[rows, columns];
data.rowWidths ← NewWidthSeq[rows];
data.colWidths ← NewWidthSeq[columns];
data.xRuleWidth ← xRuleWidth;
data.yRuleWidth ← yRuleWidth;
data.staticSize ← w > 0 OR h > 0;
data.width ← w;
data.height ← h;
IF parent = NIL THEN
{parent ←
ViewerOps.CreateViewer
[flavor: $Container,
info: [name: name, column: right, iconic: TRUE],
paint: TRUE]};
table ←
ViewerOps.CreateViewer
[flavor: $VTable,
info: [name: name, parent: parent, wx: x, wy: y, ww: w,
wh: h, data: data, border: FALSE, scrollable: scrollable],
paint: FALSE]
};
SetRowsAndColumns: PUBLIC PROC [table: VTable, rows, columns: NAT ← 0] = TRUSTED {
sets the number of rows and columns
can be used to either grow or shrink the table
data: TableData ← NARROW[table.data];
IF data = NIL OR NOT AcquireLock[data] THEN RETURN;
IF rows # data.rows OR columns # data.columns THEN
{newRowSeq: RowSeq ← NewRowSeq[rows, columns];
data.installed ← FALSE; -- demand installation
IF rows # data.rows THEN {
newRowWidths: WidthSeq ← NewWidthSeq[rows];
FOR i: NAT IN [0..MIN[rows, data.rows]) DO
newRowWidths[i] ← data.rowWidths[i];
ENDLOOP;
data.rowWidths ← newRowWidths;
};
IF columns # data.columns THEN {
newColWidths: WidthSeq ← NewWidthSeq[columns];
FOR i: NAT IN [0..MIN[columns, data.columns]) DO
newColWidths[i] ← data.colWidths[i];
ENDLOOP;
data.colWidths ← newColWidths;
};
FOR row: NAT IN [0..data.rows) DO
FOR col: NAT IN [0..data.columns) DO
oldEntry: Entry ← data.rowSeq[row][col];
IF row < rows AND col < columns
THEN
{-- copy the entry (if any) from the old world
newRowSeq[row][col] ← oldEntry;
}
ELSE
{-- delete the old viewer
IF oldEntry.viewer # NIL THEN
ViewerOps.DestroyViewer[oldEntry.viewer, FALSE];
};
ENDLOOP;
ENDLOOP;
data.rows ← rows;
data.columns ← columns;
data.rowSeq ← newRowSeq; -- make this the last gasp
};
ReleaseLock[data];
};
Install: PUBLIC PROC [table: VTable, paint: BOOLTRUE] = TRUSTED {
data: TableData ← NARROW[table.data];
IF data = NIL OR NOT AcquireLock[data] THEN RETURN;
{rows: NAT ← data.rows;
columns: NAT ← data.columns;
minX: INTEGER ← 0;
minY: INTEGER ← 0;
maxX: INTEGER ← minX;
maxY: INTEGER ← minY;
xRule: CARDINAL ← data.xRuleWidth;
yRule: CARDINAL ← data.yRuleWidth;
rowWidths: WidthSeq ← data.rowWidths;
colWidths: WidthSeq ← data.colWidths;
w: INTEGER ← table.ww;
h: INTEGER ← table.wh;
RecalculateWidths[data];
determine the row spacing
minY ← xRule;
FOR i: NAT IN [0..rows) DO
row: RowData ← data.rowSeq[i];
rowWidth: INTEGER ← rowWidths[i];
minX ← yRule;
FOR j: NAT IN [0..columns) DO
e: Entry ← row[j];
v: Viewer ← e.viewer;
colWidth: INTEGER ← colWidths[j];
IF v # NIL THEN
{vw: INTEGER ← colWidth-ABS[e.xoff];
vh: INTEGER ← rowWidth-ABS[e.yoff];
IF NOT e.useMaxSize THEN
{vh ← v.wh;
vw ← v.ww};
ViewerOps.EstablishViewerPosition
[v, minX+e.xoff, minY+e.yoff, vw, vh]};
minX ← minX + colWidth + yRule
ENDLOOP;
minY ← minY + rowWidth + xRule
ENDLOOP;
data.width ← minX;
data.height ← minY;
IF NOT data.staticSize THEN
{w ← data.width; h ← data.height};
ViewerOps.EstablishViewerPosition
[table, table.wx, table.wy, w, h];
ReleaseLock[data, TRUE];
IF paint OR data.request # 0 THEN ViewerOps.PaintViewer[table, client];
}};
GetTableEntry: PUBLIC PROC
[table: VTable, row, column: NAT ← 0] RETURNS [v: Viewer] = TRUSTED {
retrieve the viewer at the given row and column
data: TableData ← NARROW[table.data];
v ← NIL;
IF data = NIL OR NOT AcquireLock[data] THEN RETURN;
IF row >= data.rows OR column >= data.columns THEN
ReleaseAndFault[data];
v ← data.rowSeq[row][column].viewer;
ReleaseLock[data];
};
SwapTableEntries: PUBLIC PROC
[table: VTable, row1, column1, row2, column2: NAT ← 0,
swapBorders: BOOLFALSE] = TRUSTED {
swap the given table entries
data: TableData ← NARROW[table.data];
v: Viewer ← NIL;
IF data = NIL OR NOT AcquireLock[data] THEN RETURN;
IF row1 >= data.rows OR column1 >= data.columns OR
row2 >= data.rows OR column2 >= data.columns THEN
ReleaseAndFault[data];
{e1: Entry ← data.rowSeq[row1][column1];
e2: Entry ← data.rowSeq[row2][column2];
IF swapBorders
THEN
{data.rowSeq[row1][column1] ← e2;
data.rowSeq[row2][column2] ← e1}
ELSE
{data.rowSeq[row1][column1].viewer ← e2.viewer;
data.rowSeq[row2][column2].viewer ← e1.viewer}};
data.installed ← FALSE; -- demand installation
ReleaseLock[data];
};
SetTableEntry: PUBLIC PROC
[table: VTable,
row, column: NAT ← 0,
name: ROPENIL,
flavor: ATOMNIL,
proc: Buttons.ButtonProc ← NIL,
clientData: REFNIL,
w, h: INTEGER ← 0,
xoff, yoff: INTEGER ← 0,
border: Border ← FullBorder,
font: VFonts.Font ← NIL,
displayStyle: ATOMNIL,
useMaxSize: BOOLFALSE] = TRUSTED {
v: Viewer ← NIL;
parent: Viewer ← table;
data: TableData ← NARROW[table.data];
flat: ROPE ← name.Flatten[];
textH, textW: INTEGER ← 0;
old: Entry ← NullEntry;
new: Entry ← NullEntry;
IF data = NIL OR NOT AcquireLock[data] THEN RETURN;
IF row >= data.rows OR column >= data.columns THEN
ReleaseAndFault[data];
old ← data.rowSeq[row][column];
IF font = NIL THEN font ← VFonts.defaultFont;
IF flat.Size[] # 0 THEN
{textW ← VFonts.StringWidth[flat, font];
textH ← VFonts.FontHeight[font]};
data.installed ← FALSE; -- demand installation
IF flavor = NIL THEN flavor ← $Label;
IF proc # NIL THEN flavor ← $Button;
IF name = NIL THEN name ← "";
IF textW > w THEN w ← textW + wHack;
IF textH > h THEN h ← textH + hHack;
new.xoff ← xoff;
new.yoff ← yoff;
new.useMaxSize ← useMaxSize;
SELECT flavor FROM
$Button =>
{v ←
Buttons.Create
[info: [name: name, parent: parent, wx: 0, wy: 0, ww: w, wh: h, border: FALSE],
proc: proc,
clientData: clientData,
fork: TRUE,
paint: FALSE,
font: font];
IF displayStyle # NIL THEN
Buttons.SetDisplayStyle[v, displayStyle, FALSE]};
$Label =>
{v ←
Labels.Create
[info: [parent: parent, name: name, wx: 0, wy: 0, ww: w, wh: h,
border: FALSE], font: font, paint: FALSE];
IF displayStyle # NIL THEN
Labels.SetDisplayStyle[v, displayStyle, FALSE]};
$Text =>
{h ← h - textYoff; -- make height of text, labels & buttons similar
v ←
ViewerOps.CreateViewer
[flavor: $Text,
info: [parent: parent, wx: 0, wy: 0, ww: w, wh: h,
scrollable: FALSE, border: FALSE],
paint: FALSE];
v.class.set[v, name, FALSE];
new.xoff ← textXoff + xoff;
new.yoff ← textYoff + yoff};
$Viewer =>
v ← NARROW[clientData];
ENDCASE =>
v ←
ViewerOps.CreateViewer
[flavor: flavor,
info: [name: name, parent: parent, wx: 0, wy: 0,
ww: w, wh: h, data: clientData, border: FALSE]];
IF old.viewer # v AND old.viewer # NIL THEN
ViewerOps.DestroyViewer[old.viewer, FALSE];
new.viewer ← v;
new.border ← border;
data.rowSeq[row][column] ← new;
ReleaseLock[data];
};
GetEntryBorder: PUBLIC PROC
[table: VTable, row, column: NAT ← 0] RETURNS [border: Border] = {
get the current table entry at the given row and column
data: TableData ← NARROW[table.data];
border ← NullBorder;
IF data = NIL OR NOT AcquireLock[data] THEN RETURN;
IF row >= data.rows OR column >= data.columns THEN
ReleaseAndFault[data];
border ← data.rowSeq[row][column].border;
ReleaseLock[data];
};
SetEntryBorder: PUBLIC PROC
[table: VTable, row, column: NAT ← 0, border: Border ← FullBorder] = {
get the current table entry at the given row and column
data: TableData ← NARROW[table.data];
IF data = NIL OR NOT AcquireLock[data] THEN RETURN;
IF row >= data.rows OR column >= data.columns THEN
ReleaseAndFault[data];
data.installed ← FALSE;
data.rowSeq[row][column].border ← border;
ReleaseLock[data];
};
GetEntryOffset: PUBLIC PROC
[table: VTable, row, column: NAT ← 0] RETURNS [xoff,yoff: INTEGER] = {
get the current offsets of the given entry
data: TableData ← NARROW[table.data];
IF data = NIL OR NOT AcquireLock[data] THEN RETURN;
IF row >= data.rows OR column >= data.columns THEN
ReleaseAndFault[data];
xoff ← data.rowSeq[row][column].xoff;
yoff ← data.rowSeq[row][column].yoff;
ReleaseLock[data];
};
SetEntryOffset: PUBLIC PROC
[table: VTable, row, column: NAT ← 0, xoff,yoff: INTEGER ← 0] = {
set the current table border at the given row and column
reinstallation is required
data: TableData ← NARROW[table.data];
IF data = NIL OR NOT AcquireLock[data] THEN RETURN;
IF row >= data.rows OR column >= data.columns THEN
ReleaseAndFault[data];
data.installed ← FALSE;
data.rowSeq[row][column].xoff ← xoff;
data.rowSeq[row][column].yoff ← yoff;
ReleaseLock[data];
};
GetRowsAndColumns: PUBLIC PROC
[table: VTable] RETURNS [rows, columns: NAT] = {
data: TableData ← NARROW[table.data];
IF data = NIL OR NOT AcquireLock[data] THEN RETURN;
rows ← data.rows;
columns ← data.columns;
ReleaseLock[data];
};
ExchangeRows: PUBLIC PROC [table: VTable, row1,row2: NAT ← 0] = {
exchange the two given rows
re-installation will be necessary
data: TableData ← NARROW[table.data];
IF data = NIL OR NOT AcquireLock[data] THEN RETURN;
IF row1 >= data.rows OR row2 >= data.rows THEN
ReleaseAndFault[data];
data.installed ← FALSE;
{temp: RowData ← data.rowSeq[row1];
data.rowSeq[row1] ← data.rowSeq[row2];
data.rowSeq[row2] ← temp};
ReleaseLock[data];
};
ExchangeColumns: PUBLIC PROC [table: VTable, column1,column2: NAT ← 0] = {
exchange the two given columns
re-installation will be necessary
data: TableData ← NARROW[table.data];
IF data = NIL OR NOT AcquireLock[data] THEN RETURN;
IF column1 >= data.columns OR column2 >= data.columns THEN
ReleaseAndFault[data];
data.installed ← FALSE;
FOR row: NAT IN [0..data.rows) DO
temp: Entry ← data.rowSeq[row][column1];
data.rowSeq[row][column1] ← data.rowSeq[row][column2];
data.rowSeq[row][column2] ← temp;
ENDLOOP;
ReleaseLock[data];
};
paint and destroy procedures
TablePainter: ViewerClasses.PaintProc = TRUSTED {
[self: Viewer, context: Graphics.Context,
whatChanged: REF ANY, clear: BOOLEAN]
just paint the rules for the table
the children will be painted after us
table: VTable ← self;
data: TableData ← NARROW[self.data];
IF data = NIL OR NOT AcquireLock[data, TRUE] THEN RETURN;
{xPos: INTEGER ← 0;
xLim: INTEGER ← data.width;
yPos: INTEGER ← 0;
yLim: INTEGER ← data.height;
rows: NAT ← data.rows;
columns: NAT ← data.columns;
xWidth: CARDINAL ← data.xRuleWidth;
yWidth: CARDINAL ← data.yRuleWidth;
Graphics.SetColor[context, Graphics.black];
paint the horizontals
FOR row: NAT IN [0..rows] DO
yLast: INTEGER ← yPos + xWidth;
xPos ← 0;
FOR col: NAT IN [0..columns) DO
prev: Border ←
IF row = 0 THEN NullBorder ELSE data.rowSeq[row-1][col].border;
this: Border ←
IF row = rows THEN NullBorder ELSE data.rowSeq[row][col].border;
xLast: INTEGER ← xPos + data.colWidths[col] + yWidth + yWidth;
IF prev.down OR this.up THEN
{-- include this edge
Graphics.DrawBox[context, [xPos, yPos, xLast, yLast]]};
xPos ← xLast - yWidth;
ENDLOOP;
IF row = rows THEN EXIT;
yPos ← yLast + data.rowWidths[row];
ENDLOOP;
paint the verticals
xPos ← 0;
FOR col: NAT IN [0..columns] DO
xLast: INTEGER ← xPos + yWidth;
yPos ← 0;
FOR row: NAT IN [0..rows) DO
prev: Border ←
IF col = 0 THEN
NullBorder ELSE
data.rowSeq[row][col-1].border;
this: Border ←
IF col = columns
THEN NullBorder
ELSE data.rowSeq[row][col].border;
yLast: INTEGER ← yPos + data.rowWidths[row] + xWidth + xWidth;
IF prev.right OR this.left THEN
{-- include this edge
Graphics.DrawBox[context, [xPos, yPos, xLast, yLast]]};
yPos ← yLast - yWidth;
ENDLOOP;
IF col = columns THEN EXIT;
xPos ← xLast + data.colWidths[col];
ENDLOOP;
data.request ← 0;
ReleaseLock[data];
}};
TableDestroy: ViewerClasses.DestroyProc = {
[self: Viewer]
data: TableData ← NARROW[self.data];
IF data = NIL OR NOT AcquireLock[data] THEN RETURN;
data.live ← FALSE;
self.data ← NIL;
ReleaseLock[data];
};
other procedures
MakeViewerClass: PROC = TRUSTED {
vTableClass: ViewerClasses.ViewerClass ← NEW[ViewerClasses.ViewerClassRec];
vTableClass.icon ← tool;
vTableClass.paint ← TablePainter;
vTableClass.destroy ← TableDestroy;
vTableClass.coordSys ← top;
ViewerOps.RegisterViewerClass[$VTable, vTableClass]
};
ReleaseAndFault: PROC [data: TableData] = TRUSTED {
ReleaseLock[data];
ERROR Runtime.BoundsFault};
DummyButtonProc: Buttons.ButtonProc = TRUSTED {
UserTerminal.BlinkDisplay[]
};
instance: Viewer ← NIL;
TestInstance: PROC [useText: BOOLTRUE] = {
instance ← Create[3, 3, "test"];
SetTableEntry[instance, 0, 0, "0-0 button *", $Button, DummyButtonProc];
IF useText THEN
SetTableEntry[instance, 0, 1, "0-1 text **", $Text];
SetTableEntry[instance, 0, 2, "0-2 label ***"];
SetTableEntry[instance, 1, 0, "1-0 label ****"];
SetTableEntry[instance, 1, 1, "1-1 button *", $Button, DummyButtonProc];
IF useText THEN
SetTableEntry[instance, 1, 2, "1-2 text **", $Text];
IF useText THEN
SetTableEntry[instance, 2, 0, "2-0 text ***", $Text];
SetTableEntry[instance, 2, 1, "2-1 label ****"];
SetTableEntry[instance, 2, 2, "2-2 button ****", $Button, DummyButtonProc];
SetEntryBorder[instance, 2, 2, NullBorder];
Install[instance]
};
MakeViewerClass[]
END.