DIRECTORY
Buttons USING [Button, ButtonProc, Create, SetDisplayStyle],
Commander USING [CommandProc, Register],
Imager USING [black, SetColor, MaskBox],
Labels USING [Create, SetDisplayStyle],
Rope USING [Flatten, ROPE, Size],
RuntimeError USING [BoundsFault],
VFonts USING [defaultFont, StringWidth, FontHeight, Font],
ViewerClasses USING [DestroyProc, PaintProc, Viewer, ViewerClass, ViewerClassRec],
ViewerOps USING [BlinkViewer, CreateViewer, DestroyViewer, EstablishViewerPosition, PaintViewer, RegisterViewerClass],
VTables
USING [Border, FullBorder, NullBorder, VTable];
VTablesImpl:
CEDAR
MONITOR
LOCKS data
USING data: TableData
IMPORTS Buttons, Commander, Imager, Labels, Rope, RuntimeError, VFonts, ViewerOps
EXPORTS VTables
= BEGIN OPEN VTables;
ROPE: TYPE = Rope.ROPE;
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 ← 12; -- 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
AND AcquireLock[data]
THEN {
ENABLE UNWIND => ReleaseLock[data, TRUE];
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 ← v.ww;
vh: INTEGER ← v.wh;
IF e.useMaxSize
THEN {
vw ← colWidth-ABS[e.xoff];
vh ← 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; reinstallation is required
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;
{
-- exchange the rows
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; reinstallation is required
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: ViewerClasses.Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOL] RETURNS [quit: BOOL ← FALSE]
Just paint the rules for the table; the children will be painted after this painting.
table: VTable ← self;
data: TableData ← NARROW[self.data];
IF data = NIL OR NOT AcquireLock[data, TRUE] THEN RETURN[quit: TRUE];
{
xPos: INTEGER ← 0;
xLim: INTEGER ← data.width;
yPos: INTEGER ← 0;
yLim: INTEGER ← data.height;
rows: NAT ← data.rows;
columns: NAT ← data.columns;
xWidth: INTEGER ← data.xRuleWidth;
yWidth: INTEGER ← data.yRuleWidth;
Imager.SetColor[context, Imager.black];
paint the horizontals
FOR row:
NAT
DECREASING
IN [0..rows]
DO
yLast: INTEGER ← yPos + xWidth;
xPos ← 0;
FOR col:
NAT
IN [0..columns)
DO
prev: Border ←
IF row = rows THEN NullBorder ELSE data.rowSeq[row][col].border;
this: Border ←
IF row = 0 THEN NullBorder ELSE data.rowSeq[row-1][col].border;
xLast: INTEGER ← xPos + data.colWidths[col] + yWidth;
IF prev.down
OR this.up
THEN {
include this edge
Imager.MaskBox[context, [xPos, yPos, xLast+yWidth, yLast]]};
xPos ← xLast;
ENDLOOP;
IF row = 0 THEN EXIT;
yPos ← yLast + data.rowWidths[row-1];
ENDLOOP;
paint the verticals
xPos ← 0;
FOR col:
NAT
IN [0..columns]
DO
xLast: INTEGER ← xPos + yWidth;
yPos ← 0;
FOR row:
NAT
DECREASING
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;
IF prev.right
OR this.left
THEN {
include this edge
Imager.MaskBox[context, [xPos, yPos, xLast, yLast + xWidth]]};
yPos ← yLast;
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.topDownCoordSys ← TRUE;
ViewerOps.RegisterViewerClass[$VTable, vTableClass]
};
ReleaseAndFault:
PROC [data: TableData] =
TRUSTED {
ReleaseLock[data];
ERROR RuntimeError.BoundsFault};
DummyButtonProc: Buttons.ButtonProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
WITH parent
SELECT
FROM
v: ViewerClasses.Viewer => ViewerOps.BlinkViewer[v];
ENDCASE;
};
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]
};
dummyCount: INT ← 0;
DummyCommandProc: Commander.CommandProc = {
IF (dummyCount ← dummyCount + 1) > 1
THEN msg ← "Reusing common instance of VTablesImpl."
ELSE msg ← "Started common instance of VTablesImpl."
};
Commander.Register[
"VTablesImpl", DummyCommandProc, "Hack to avoid multiple instances of VTablesImpl."];
MakeViewerClass[]
END.