CDAtomicObjectsImpl.mesa (part of ChipNDale)
Copyright © 1985, 1986 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, March 13, 1985 9:49:28 am PST
Last Edited by: Christian Jacobi, August 16, 1986 6:57:05 pm PDT
DIRECTORY
CD,
CDAtomicObjects,
CDBasics,
CDCallSpecific,
CDPrivate,
CDIO,
CDOrient,
LRUCache,
RefTab,
Rope,
RuntimeError,
TokenIO;
CDAtomicObjectsImpl:
CEDAR
MONITOR
IMPORTS CD, CDBasics, CDCallSpecific, CDIO, CDOrient, CDPrivate, LRUCache, RefTab, RuntimeError, TokenIO
EXPORTS CDAtomicObjects
SHARES CD = --want access technology of ObjectClass
BEGIN
DrawRec: TYPE = CDAtomicObjects.DrawRec;
DrawList: TYPE = CDAtomicObjects.DrawList;
AtomicObsPtr: TYPE = CDAtomicObjects.AtomicObsPtr;
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[ classTable.Fetch[class].val ]
};
----------
queue: LRUCache.Handle ← LRUCache.Create[255, CDPrivate.Hash, 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←[specificRef: NEW[AtomicObsRec]]];
};
Equal:
PROC[x, y:
REF]
RETURNS [
BOOL] = {
ob1: CD.Object = NARROW[x];
ob2: CD.Object = NARROW[y];
RETURN [
ob1.class=ob2.class AND ob1.size=ob2.size AND ob1.layer=ob2.layer AND
CD.InterestRect[ob1]=CD.InterestRect[ob2]
]
};
----------
Create
AtomicOb:
PUBLIC
PROC [classKey:
ATOM, size:
CD.Position, tech:
CD.Technology, lev:
CD.Layer]
RETURNS [ob:
CD.Object←
NIL] = {
insert: BOOL; used: REF;
ob1: CD.Object ← GiveOb[];
aop: AtomicObsPtr ← NARROW[ob1.specificRef];
ce: REF ClassEntry = GetClassEntry[classKey, tech];
IF ce=NIL THEN RETURN;
aop^ ← [NIL, CDBasics.empty];
ob1.class ← ce.class;
ob1.size ← CDBasics.MaxPoint[size, [1, 1]];
ob1.layer ← lev;
ob1.specificRef ← 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.size.x OR aop.ir.y2>ob.size.y THEN GOTO xx;
--now check if we should change the objectprocs to be more general
IF aop.ir#CDBasics.RectAt[[0, 0], ob.size]
THEN
IF ce.class.showMeSelected=XShowSelectedAO
THEN
ob.class.showMeSelected ← ShowSelectedAO;
};
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: ReadAO,
internalWrite: WriteAO,
interestRect: InsideAO,
showMeSelected: XShowSelectedAO,
wireTyped: FALSE,
description: description] ! CD.Error => {done ← FALSE; CONTINUE}];
IF ~done
THEN
RETURN WITH ERROR CD.Error[doubleRegistration];
done ← RefTab.Insert[classTable, type, ce];
CDCallSpecific.Register[$Lengthen, type, LengthenAO];
};
Incorporate:
PUBLIC
PROC [ob:
CD.Object, r:
CD.Rect, lev:
CD.Layer, inside:
BOOL] = {
aop: AtomicObsPtr = NARROW[ob.specificRef];
IF inside THEN aop.ir ← CDBasics.Surround[aop.ir, r];
aop.rList ← CONS[[r, lev], aop.rList];
};
------------
ReadAO:
CD.InternalReadProc
--PROC [] RETURNS [Object]-- = {
sz: CD.Position ← CDIO.ReadPos[];
code: ATOM = TokenIO.ReadAtom[];
lev: CD.Layer = CDIO.ReadLayer[];
tech: CD.Technology = CDIO.DesignInReadOperation[].technology;
ob: CD.Object ← CreateAtomicOb[code, sz, tech, lev];
IF
CDIO.VersionKey[]<10
THEN {
--The old way had the size instead the interest rect in the file
ob ← CreateAtomicOb[code, [sz.x - (ob.size.x-sz.x), sz.y - (ob.size.y-sz.y)], tech, lev];
};
RETURN [ob]
};
WriteAO:
CD.InternalWriteProc
-- PROC [me: Object] -- = {
CDIO.WritePos[CD.InterestSize[me]];
TokenIO.WriteAtom[me.class.objectType];
CDIO.WriteLayer[me.layer];
};
DrawAO:
PROC [inst:
CD.Instance, pos:
CD.Position, orient:
CD.Orientation, pr:
CD.DrawRef] = {
FOR class: DrawList ←
NARROW[inst.ob.specificRef, AtomicObsPtr].rList, class.rest
WHILE class#
NIL
DO
pr.drawRect[
CDOrient.MapRect[
itemInCell: class.first.r,
cellSize: inst.ob.size,
cellInstOrient: orient,
cellInstPos: pos],
class.first.lev,
pr]
ENDLOOP;
};
ShowSelectedAO:
PROC [inst:
CD.Instance, pos:
CD.Position, orient:
CD.Orientation, pr:
CD.DrawRef] = {
aop: AtomicObsPtr = NARROW[inst.ob.specificRef];
pr.drawOutLine[
CDOrient.MapRect[
itemInCell: aop.ir,
cellSize: inst.ob.size,
cellInstOrient: orient,
cellInstPos: pos],
CD.selectionLayer,
pr]
};
XShowSelectedAO:
PROC [inst:
CD.Instance, pos:
CD.Position, orient:
CD.Orientation, pr:
CD.DrawRef] = {
pr.drawOutLine[CDOrient.RectAt[pos, inst.ob.size, orient], CD.selectionLayer, pr]
};
InsideAO:
PROC [ob:
CD.Object]
RETURNS [
CD.Rect] = {
RETURN [NARROW[ob.specificRef, AtomicObsPtr].ir]
};
LengthenAO: CDCallSpecific.CallProc = {
--PROC [design: CD.Design, inst: CD.Instance, x: REF]
--RETURNS [done: BOOL←TRUE, removeMe: BOOL←FALSE, include: CD.InstanceList←NIL,
--repaintMe: BOOL←FALSE, repaintInclude: BOOL←FALSE]
ToPosition:
PROC [x:
REF]
RETURNS [class:
CD.Position] = {
--y field defaults to lambda, x field defaults to 0
--[0, 0] if not done
IF x=NIL THEN class ← [0, design.technology.lambda]
ELSE
WITH x
SELECT
FROM
rp: REF CD.Position => class ← rp^;
rn: REF CD.Number => class ← [0, rn^];
ENDCASE => class ← [0, 0];
};
--LengthenAO
amount: CD.Position = ToPosition[x];
IF amount.y=0 AND amount.x=0 THEN done ← FALSE
ELSE {
sz: CD.Position ← CDBasics.AddPoints[CD.InterestSize[inst.ob], amount];
new: CD.Object ← CreateAtomicOb[size: sz, classKey: inst.ob.class.objectType, lev: inst.ob.layer, tech: inst.ob.class.technology];
done ← new#NIL AND new#inst.ob AND new.size#inst.ob.size;
IF done
THEN {
inst.ob ← new;
repaintMe ← TRUE;
}
};
};
END.