CDDrawQueueImpl.mesa (part of ChipNDale)
Copyright © 1983, 1986 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi July 6, 1983 5:09 pm
Last edited by: Christian Jacobi, November 26, 1986 6:35:41 pm PST
DIRECTORY
CD USING [Rect, Design],
CDBasics,
CDDrawQueue;
CDDrawQueueImpl:
CEDAR
MONITOR
IMPORTS CDBasics
EXPORTS CDDrawQueue
SHARES CD =
DrawQueue: TYPE = REF DrawQueueRep;
Request: TYPE = CDDrawQueue.Request;
maxC: CARDINAL = 50;
DrawQueueRep:
PUBLIC
TYPE =
RECORD [
cnt, in, out: CARDINAL,
commandAvail: CONDITION,
desgn: CD.Design,
deviceClip: CD.Rect,
comm: ARRAY [0..maxC) OF Request,
stopFlag:
REF
BOOL,
-- must be monitored
-- request to stop the execution of (only!) the current command
inlist: BOOL ← FALSE,
deleted: BOOL ← FALSE,
alldoneToBeReported: BOOL ← FALSE,
inProgress: Request ← [NIL, CDBasics.universe]
];
TableList: TYPE = LIST OF DrawQueue;
queueEmpty: PUBLIC REF ← NEW[INT];
finishedForEver: PUBLIC REF ← NEW[INT];
InsertList:
INTERNAL
PROC [dq: DrawQueue] = {
IF
NOT dq.inlist
THEN {
list: TableList ← NARROW[dq.desgn.cdDrawQueuePriv];
list ← CONS[dq, list];
dq.desgn.cdDrawQueuePriv ← list;
dq.inlist ← TRUE;
};
};
RemoveList:
INTERNAL
PROC [dq: DrawQueue] = {
IF dq.inlist
THEN {
list: TableList ← NARROW[dq.desgn.cdDrawQueuePriv];
IF list=
NIL
THEN
RETURN;
-- list#NIL; otherwise nothing too delete! not dq.inlist; but don't be picky
IF list.first=dq THEN dq.desgn.cdDrawQueuePriv ← list.rest
ELSE
FOR l: TableList ← list, l.rest
WHILE l.rest#
NIL
DO
IF l.rest.first=dq THEN {l.rest ← l.rest.rest; EXIT}
ENDLOOP;
dq.inlist ← FALSE;
};
};
Create:
PUBLIC
ENTRY
PROC [design:
CD.Design, stopFlag:
REF
BOOL, clip:
CD.Rect←[1,1,0,0]]
RETURNS [DrawQueue] = {
--stopFlag^ tells any drawing process to stop volunterly and to fetch the next
--command.
--stopFlag^ must not be modified any more outside this monitor!!
--until DeleteCommandTable is called
--Users may request a stop by calling Flush.
ENABLE UNWIND => NULL; --catches eg on stopFlag=NIL
dq: DrawQueue = NEW[DrawQueueRep];
IF stopFlag=NIL THEN stopFlag ← NEW[BOOL←FALSE];
dq.cnt ← dq.in ← dq.out ← 0;
dq.deviceClip ← CDBasics.empty;
dq.desgn ← design;
dq.stopFlag ← stopFlag; -- assigns addresses
dq.deleted ← dq.inlist ← dq.alldoneToBeReported ← dq.stopFlag^ ← FALSE;
InternalChangeClipArea[dq, clip];
RETURN [dq]
};
ChangeClipArea:
PUBLIC
ENTRY
PROC [dq: DrawQueue, clip:
CD.Rect] = {
--changes the clipping aera
ENABLE UNWIND => NULL;
InternalChangeClipArea[dq, clip];
};
InternalChangeClipArea:
INTERNAL
PROC [dq: DrawQueue, clip:
CD.Rect] = {
--changes the clipping aera
InternalFlush[dq];
dq.deviceClip ← clip;
IF CDBasics.NonEmpty[clip] THEN InsertList[dq] ELSE RemoveList[dq]
};
Destroy:
PUBLIC
ENTRY
PROC [dq: DrawQueue] = {
--no more insertion calls on dq allowed!!
--redraw process must disapear from itself,
--when redraw process dispears and contains nomore
--reference of dq, it is subject for garbage collection
--The stopFlag is immediately set to TRUE and later
--reset to FALSE when the redraw
--process stopped the current command, if it then fetches another
--command it gets the disapearforever command.
ENABLE UNWIND => NULL;
IF dq#
NIL
THEN {
dq.deleted ← TRUE; InternalFlush[dq];
RemoveList[dq]; dq.desgn ← NIL;
}
};
QueueInsertDrawCommand:
PUBLIC
ENTRY
PROC [dq: DrawQueue, req: Request] = {
ENABLE UNWIND => NULL;
IF dq.inlist THEN InternalInsertCommand[dq, req]
};
InternalInsertCommand:
INTERNAL
PROC [dq: DrawQueue, req: Request] = {
--this procedure introduces redraw all if table is full
--and in removes certain rectangles contained by others
--this implies that the module knows some commands
IF dq.cnt>=maxC
THEN {
InternalFlush[dq];
InternalInsertCommand[dq, Request[$flushed, dq.deviceClip]];
InternalInsertCommand[dq, Request[$redraw, dq.deviceClip]];
RETURN;
};
dq.alldoneToBeReported ← TRUE;
IF req.key=$redraw
THEN {
--erase and draw
IF CDBasics.Intersect[req.rect, dq.deviceClip]
THEN {
j: CARDINAL ← dq.out;
req.rect ← CDBasics.Intersection[req.rect, dq.deviceClip];
--this search for similar commands could be made much better
THROUGH [0..dq.cnt)
DO
IF dq.comm[j].key=$redraw
OR dq.comm[j].key=$draw
THEN {
IF CDBasics.Inside[req.rect, dq.comm[j].rect]
THEN {
dq.comm[j].key ← $redraw;
RETURN
};
IF CDBasics.Inside[dq.comm[j].rect, req.rect]
THEN {
dq.comm[j].key ← $redraw; dq.comm[j].rect ← req.rect;
RETURN
};
};
j ← (j+1) MOD maxC;
ENDLOOP;
IF CDBasics.Inside[dq.inProgress.rect, req.rect]
AND (dq.inProgress.key=$redraw
OR dq.inProgress.key=$draw)
THEN
dq.stopFlag^ ← TRUE;
}
ELSE RETURN;
}
ELSE
IF req.key=$draw
THEN {
--draw on top of whats there
IF CDBasics.Intersect[req.rect, dq.deviceClip]
THEN {
j: CARDINAL ← dq.out;
req.rect ← CDBasics.Intersection[req.rect, dq.deviceClip];
--this search for similar commands could be made much better
THROUGH [0..dq.cnt)
DO
IF dq.comm[j].key=$redraw
OR dq.comm[j].key=$draw
THEN {
IF CDBasics.Inside[req.rect, dq.comm[j].rect] THEN RETURN;
IF CDBasics.Inside[dq.comm[j].rect, req.rect]
THEN {
dq.comm[j].rect ← req.rect;
RETURN
};
};
j ← (j+1) MOD maxC;
ENDLOOP;
IF dq.inProgress.key=$draw
AND CDBasics.Inside[dq.inProgress.rect, req.rect]
THEN
dq.stopFlag^ ← TRUE;
}
ELSE RETURN;
};
dq.cnt ← dq.cnt+1;
dq.comm[dq.in] ← req;
dq.in ← (dq.in+1) MOD maxC;
NOTIFY dq.commandAvail;
};
InsertDrawCommand:
PUBLIC
ENTRY
PROC [design:
CD.Design, req: Request] = {
ENABLE UNWIND => NULL;
FOR lst: TableList ←
NARROW[design.cdDrawQueuePriv], lst.rest
WHILE lst#
NIL
DO
InternalInsertCommand[lst.first, req];
ENDLOOP
};
FetchCommand:
PUBLIC
ENTRY
PROC [dq: DrawQueue]
RETURNS [req: Request] = {
--waits till command is available or DrawQueue deleted
ENABLE UNWIND => NULL;
dq.stopFlag^ ← FALSE;
WHILE dq.cnt<=0
DO
IF dq.deleted THEN InsertDisappear[dq]
ELSE
IF dq.alldoneToBeReported THEN InsertAlldone[dq] ELSE WAIT dq.commandAvail;
dq.stopFlag^ ← FALSE;
ENDLOOP;
dq.cnt ← dq.cnt-1;
dq.inProgress ← req ← dq.comm[dq.out];
dq.out ← (dq.out+1) MOD maxC;
};
Flush:
PUBLIC
ENTRY
PROC [dq: DrawQueue] = {
-- the drawing may stop after some time only,
-- and NOT immediately with procedure return
ENABLE UNWIND => NULL;
IF dq#NIL THEN InternalFlush[dq]
};
InternalFlush:
INTERNAL
PROC [dq: DrawQueue] = {
dq.cnt ← dq.in ← dq.out ← 0;
dq.stopFlag^ ← TRUE;
dq.alldoneToBeReported ← FALSE;
NOTIFY dq.commandAvail;
dq.inProgress ← [NIL, CDBasics.universe];
};
InsertDisappear:
INTERNAL
PROC [dq: DrawQueue] = {
dq.out ← 0; dq.cnt ← 1;
dq.comm[0] ← Request[finishedForEver, [1,1,0,0]];
dq.in ← (1 MOD maxC);
};
InsertAlldone:
INTERNAL
PROC [dq: DrawQueue] = {
dq.alldoneToBeReported ← FALSE;
dq.out ← 0; dq.cnt ← 1;
dq.comm[0] ← Request[queueEmpty, [1,1,0,0]];
dq.in ← (1 MOD maxC);
};
END.