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: BOOL ← FALSE,
live: BOOL ← TRUE,
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: BOOL ← FALSE] 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:
BOOL ←
FALSE] = {
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: ROPE ← NIL,
parent: Viewer ← NIL,
xRuleWidth: INTEGER ← 1,
yRuleWidth: INTEGER ← 1,
x, y, w, h: INTEGER ← 0,
scrollable: BOOL ← FALSE]
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:
BOOL ←
TRUE] =
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];
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: BOOL ← FALSE] = 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: ROPE ← NIL,
flavor: ATOM ← NIL,
proc: Buttons.ButtonProc ← NIL,
clientData: REF ← NIL,
w, h: INTEGER ← 0,
xoff, yoff: INTEGER ← 0,
border: Border ← FullBorder,
font: VFonts.Font ← NIL,
displayStyle: ATOM ← NIL,
useMaxSize: BOOL ← FALSE] = 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:
BOOL ←
TRUE] = {
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.