CDAtomicObjectsImpl.mesa (part of ChipNDale)
Copyright © 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, March 13, 1985 9:49:28 am PST
Last Edited by: Christian Jacobi, April 20, 1987 6:13:16 pm PDT
DIRECTORY
CD,
CDAtomicObjects,
CDBasics,
CDPrivate,
CDProperties,
CDIO,
LRUCache,
RefTab,
Rope,
RuntimeError,
TokenIO;
CDAtomicObjectsImpl:
CEDAR
MONITOR
IMPORTS CD, CDBasics, CDIO, CDPrivate, CDProperties, LRUCache, RefTab, RuntimeError, TokenIO
EXPORTS CDAtomicObjects
SHARES CD = --want access technology of ObjectClass
BEGIN
DrawRec: TYPE = CDAtomicObjects.DrawRec;
DrawList: TYPE = CDAtomicObjects.DrawList;
AtomicObsSpecific: TYPE = CDAtomicObjects.AtomicObsSpecific;
AtomicObsRec: TYPE = CDAtomicObjects.AtomicObsRec;
FillObjectProc: TYPE = CDAtomicObjects.FillObjectProc;
----------
classTable: RefTab.Ref = RefTab.Create[41];
ClassEntry:
TYPE =
RECORD[
tech: CD.Technology,
fillProc: FillObjectProc,
class: CD.ObjectClass←NIL
];
GetClassEntry:
PROC [classKey:
ATOM, tech:
CD.Technology]
RETURNS [ce:
REF ClassEntry←
NIL] =
INLINE {
class: CD.ObjectClass = CD.FetchObjectClass[classKey, tech];
IF class#NIL THEN ce ← NARROW[ RefTab.Fetch[classTable, class].val ]
};
queue: LRUCache.Handle ← LRUCache.Create[255, CDPrivate.Hash, CDPrivate.Equal];
free: CD.Object ← NIL;
GiveOb:
ENTRY
PROC []
RETURNS [ob:
CD.Object] =
INLINE {
ob ← free; free ← NIL;
IF ob=NIL THEN ob ← NEW[CD.ObjectRep←[class: NIL, immutable: TRUE, specific: NEW[AtomicObsRec]]];
};
Create
AtomicOb:
PUBLIC
PROC [classKey:
ATOM, size:
CD.Position, tech:
CD.Technology, layer:
CD.Layer]
RETURNS [ob:
CD.Object←
NIL] = {
insert: BOOL; used: REF;
ob1: CD.Object ← GiveOb[];
aop: AtomicObsSpecific ← NARROW[ob1.specific];
ce: REF ClassEntry = GetClassEntry[classKey, tech];
IF ce=NIL THEN RETURN;
aop^ ← [NIL, CDBasics.empty];
ob1.class ← ce.class;
ob1.bbox ← CDPrivate.MinBBox[size];
ob1.layer ← layer;
ob1.specific ← aop;
IF ce.fillProc[ob1 ! RuntimeError.UNCAUGHT => GOTO xx].mustFail THEN RETURN [NIL];
[insert: insert, used: used] ← LRUCache.Include[queue, ob1];
IF ~insert
THEN {
free ← ob1;
ob ← NARROW[used];
}
ELSE {
ob ← ob1;
--as efficiencyhack, the object is now already in the lru cache, inspite
--of not yet beeing checked.
--If object is bad, however, the technology implementing code is bad, and therefore
--we do not really feel responsible for the design...
IF aop.rList=NIL OR ~CDBasics.NonEmpty[aop.ir] OR aop.ir.x1<0 OR aop.ir.y1<0 OR aop.ir.x2>ob.bbox.x2 OR aop.ir.y2>ob.bbox.y2 THEN GOTO xx;
};
EXITS xx =>
ERROR
CD.Error[other, "Error in technology, implementing creation of atomic object"];
};
Register
AtomicObClass:
PUBLIC
PROC [classKey:
ATOM, fillProc: FillObjectProc, description: Rope.
ROPE←
NIL, tech:
CD.Technology←
NIL]
RETURNS [type:
CD.ObjectClass ←
NIL] = {
--drawMe, quickDrawMe are considered variables and should not
--be changed by class implementor.
ce:
REF ClassEntry ←
NEW[ClassEntry←[
tech: tech,
fillProc: fillProc
]];
done: BOOL←TRUE;
ce.class ← type ←
CD.RegisterObjectClass[classKey, [
technology: tech,
drawMe: DrawAO,
quickDrawMe: DrawAO,
internalRead: ReadDLO,
internalWrite: WriteDLO,
interestRect: InsideAO,
showMeSelected: ShowSelectedAO,
wireTyped: FALSE,
atomicOb: TRUE,
description: description] ! CD.Error => {done ← FALSE; CONTINUE}];
IF ~done
THEN
RETURN WITH ERROR CD.Error[doubleRegistration];
done ← RefTab.Insert[classTable, type, ce];
};
Incorporate:
PUBLIC
PROC [ob:
CD.Object, r:
CD.Rect, layer:
CD.Layer, inside:
BOOL] = {
aop: AtomicObsSpecific = NARROW[ob.specific];
IF inside THEN aop.ir ← CDBasics.Surround[aop.ir, r];
ob.bbox ← CDBasics.Surround[ob.bbox, r];
aop.rList ← CONS[[r, layer], aop.rList];
};
------------
DrawAO: CD.DrawProc = {
FOR class: DrawList ←
NARROW[ob.specific, AtomicObsSpecific].rList, class.rest
WHILE class#
NIL
DO
pr.drawRect[pr, CDBasics.MapRect[class.first.r, trans], class.first.layer]
ENDLOOP;
};
anyAtomic:
CD.ObjectClass ←
CD.RegisterObjectClass[$Atomic, [
technology: NIL,
drawMe: DrawAO,
quickDrawMe: DrawAO,
internalRead: ReadDLO,
internalWrite: WriteDLO,
interestRect: InsideAO,
showMeSelected: ShowSelectedAO,
wireTyped: FALSE,
atomicOb: TRUE,
description: "unknown atomic object"
]];
OldReadAO:
CD.InternalReadProc = {
sz: CD.Position ← CDIO.ReadPos[h];
code: ATOM = TokenIO.ReadAtom[h];
layer: CD.Layer = CDIO.ReadLayer[h];
tech: CD.Technology = CDIO.DesignInReadOperation[h].technology;
ob: CD.Object ← CreateAtomicOb[code, sz, tech, layer];
IF
CDIO.VersionKey[h]<10
THEN {
--The very old way had the size instead the interest rect in the file
ob ← CreateAtomicOb[code, [sz.x - (ob.bbox.x2-ob.bbox.x1-sz.x), sz.y - (ob.bbox.y2-ob.bbox.y1-sz.y)], tech, layer];
};
RETURN [ob]
};
ReadDLO:
CD.InternalReadProc = {
ob: CD.Object; ir, bbox: CD.Rect; layer: CD.Layer;
key2: ATOM; cnt: INT; dr: DrawRec; rl: DrawList←NIL;
tech: CD.Technology = CDIO.DesignInReadOperation[h].technology;
IF h.oldVersion
AND
CDIO.VersionKey[h]<=17
THEN {
RETURN [OldReadAO[h, key]];
};
key2 ← TokenIO.ReadAtom[h];
ir ← CDIO.ReadRect[h]; bbox ← CDIO.ReadRect[h];
layer ← CDIO.ReadLayer[h]; cnt ← TokenIO.ReadInt[h];
FOR i:
INT
IN [0..cnt)
DO
dr.layer ← CDIO.ReadLayer[h]; dr.r ← CDIO.ReadRect[h];
rl ← CONS[dr, rl];
ENDLOOP;
ob ← CreateAtomicOb[key2, CDBasics.SizeOfRect[ir], tech, layer];
IF ob=
NIL
OR ob.bbox#bbox
OR
CD.InterestRect[ob]#ir
THEN {
ob ←
NEW[
CD.ObjectRep←[
bbox: bbox,
class: anyAtomic,
immutable: TRUE,
specific: NEW[AtomicObsRec←[rl, ir]],
layer: layer
]];
CDProperties.PutObjectProp[ob, $OriginalKey, key2];
CDProperties.PutObjectProp[ob, $OriginalSize, NEW[CD.Position�sics.SizeOfRect[ir]]];
};
RETURN [ob];
};
WriteDLO:
CD.InternalWriteProc = {
cnt: INT ← 0;
rList: DrawList ← NARROW[ob.specific, AtomicObsSpecific].rList;
TokenIO.WriteAtom[h, ob.class.objectType];
CDIO.WriteRect[h, CD.InterestRect[ob]];
CDIO.WriteRect[h, ob.bbox];
CDIO.WriteLayer[h, ob.layer];
FOR rl: DrawList ← rList, rl.rest WHILE rl#NIL DO cnt ← cnt+1 ENDLOOP;
TokenIO.WriteInt[h, cnt];
FOR rl: DrawList ← rList, rl.rest
WHILE cnt>0
DO
CDIO.WriteLayer[h, rl.first.layer];
CDIO.WriteRect[h, rl.first.r];
cnt𡤌nt-1;
ENDLOOP;
};
ShowSelectedAO: CD.DrawProc = {
aop: AtomicObsSpecific = NARROW[ob.specific];
pr.drawOutLine[pr, CDBasics.MapRect[aop.ir, trans], CD.selectionLayer]
};
InsideAO:
PROC [ob:
CD.Object]
RETURNS [
CD.Rect] = {
RETURN [NARROW[ob.specific, AtomicObsSpecific].ir]
};
END.