CDXImpl:
CEDAR
MONITOR
IMPORTS CD, CDApplications, CDBasics, CDDirectoryExtras, CDEvents, CDObjectProcs, CDOrient, CDProperties, CDValue, CDX, TokenIO
EXPORTS CDX
SHARES CDDirectoryExtras =
BEGIN
--Public interface between chipndale and outside clients.
--Maps chipndales complex and mutable (but fast clippable) positioning
--mechanism to an immutable client cordinate system.
--The Origin is a hypothtical point of an object; the client's cordinate
--system origin.
--types
ClientPosition: TYPE = CD.Position;
ClientRect: TYPE = CD.Rect;
GetOriginProc: TYPE = PROC[ob: CD.ObPtr] RETURNS [CD.DesignPosition];
SetOriginProc: TYPE = PROC[design: CD.Design, ob: CD.ObPtr, new: CD.DesignPosition];
NotificationRec:
TYPE =
CDX.NotificationRec
;
--RECORD[me: CD.ObPtr, old, new: CD.DesignPosition];
CoordSystem:
TYPE =
CDX.CoordSystem;
--{outerCoordinates, innerCoordinates, clientCoordinates};
--data
notifierList: LIST OF OriginNotification←NIL;
--code
ClientOrigin:
PUBLIC PROC [ob:
CD.ObPtr]
RETURNS [pos:
CD.DesignPosition] =
--returns the position of the client's object origin in objects internal coords
BEGIN
WITH CDObjectProcs.FetchFurther[ob.p, $GetOrigin]
SELECT
FROM
sp: REF GetOriginProc => pos ← sp^[ob];
ENDCASE => pos ← CallDefaultGetOrigin[ob]
END;
CallDefaultGetOrigin:
PUBLIC
PROC[ob:
CD.ObPtr]
RETURNS [
CD.DesignPosition] =
BEGIN
WITH CDProperties.GetPropFromObject[from: ob, prop: originProperty]
SELECT
FROM
pp: REF CD.DesignPosition => RETURN [pp^]
ENDCASE => RETURN [ CDBasics.BaseOfRect[ob.p.insideRect[ob]] ]
END;
--Transfer between chipndale and client coordinates, both relative to the object
-- have all been inlines
--Transfer between client object relative coordinates and chipndale global coordinates
MapClientPos:
PUBLIC PROC [cPos: ClientPosition←[0, 0], app:
CD.ApplicationPtr]
RETURNS [globPos:
CD.DesignPosition] =
BEGIN
cPos ← CDX.ClientToCDPos[app.ob, cPos];
RETURN [CDOrient.MapPosition[
itemInCell: [cPos.x, cPos.y, cPos.x, cPos.y],
cellSize: app.ob.size,
cellInstOrient: app.orientation,
cellInstPos: app.location
]]
END;
DeMapClientPos:
PUBLIC PROC [globPos:
CD.DesignPosition, app:
CD.ApplicationPtr]
RETURNS [cPos: ClientPosition] =
BEGIN
itemInCell:
CD.DesignRect = CDOrient.DeMapRect[
itemInWorld: [globPos.x, globPos.y, globPos.x, globPos.y],
cellSize: app.ob.size,
cellInstOrient: app.orientation,
cellInstPos: app.location
];
RETURN [CDX.CDToClientPos[app.ob, [itemInCell.x1, itemInCell.y1]]]
END;
MapClientRect:
PUBLIC PROC [cRect: ClientRect, app:
CD.ApplicationPtr]
RETURNS [globRect:
CD.DesignRect] =
BEGIN
RETURN [CDOrient.MapRect[
itemInCell: CDX.ClientToCDRect[app.ob, cRect],
cellSize: app.ob.size,
cellInstOrient: app.orientation,
cellInstPos: app.location
]]
END;
DeMapClientRect:
PUBLIC PROC [globRect:
CD.DesignRect, app:
CD.ApplicationPtr]
RETURNS [cRect: ClientRect] =
BEGIN
RETURN [
CDX.CDToClientRect[app.ob,
CDOrient.DeMapRect[
itemInWorld: globRect,
cellSize: app.ob.size,
cellInstOrient: app.orientation,
cellInstPos: app.location
]
]]
END;
PositionFromPairO:
PUBLIC PROC [ob:
CD.ObPtr,
cPos: ClientPosition←[0,0],
correspondingGlobPos: CD.DesignPosition←[0,0],
orientation: CD.Orientation𡤀
]
RETURNS [appPos:
CD.DesignPosition] =
--Computes a position useable for an application, such that the
--client-origin relative point oPos is at the global position correspondingGlobPos
BEGIN
obCDPos: CD.DesignPosition = CDX.ClientToCDPos[ob, cPos];
fakeAppPos:
CD.DesignPosition = CDOrient.MapPosition[
itemInCell: [obCDPos.x, obCDPos.y, obCDPos.x, obCDPos.y],
cellSize: ob.size,
cellInstOrient: orientation,
cellInstPos: [0, 0]
];
RETURN [CDBasics.SubPoints[correspondingGlobPos, fakeAppPos]]
END;
PositionFromPairI:
PUBLIC PROC [ob:
CD.ObPtr,
cPos: ClientPosition←[0,0],
correspondingGlobPos: CD.DesignPosition←[0,0],
orientation: CD.Orientation𡤀
]
RETURNS [iPos:
CD.DesignPosition] =
--Computes the position of the innerrect, such that the client-origin
--relative point oPos is at the global position correspondingGlobPos
BEGIN
appOPos: CD.DesignPosition = PositionFromPairO[ob, cPos, correspondingGlobPos, orientation];
RETURN [CDBasics.BaseOfRect[CDOrient.MapRect[
itemInCell: ob.p.insideRect[ob],
cellSize: ob.size,
cellInstOrient: orientation,
cellInstPos: appOPos
]]]
END;
IncludeRelative:
PUBLIC PROC [design:
CD.Design←
NIL, cell:
CD.ObPtr←
NIL, ob:
CD.ObPtr,
cellPosition: CD.Position←[0, 0],
obPosition: CD.Position←[0, 0],
orientation: CD.Orientation𡤀,
coordSystem: CoordSystem𡤌lientCoordinates,
skipRepositioning: BOOL←FALSE] RETURNS [CD.ApplicationPtr] =
--design (NIL: allowed, if cell really is not yet part of a design)
--cell (NIL: include into design; assumes the designs origin at [0, 0])
-- (design&cell NIL: simply create an application)
--ob: object to include in cell
--cellPosition, obPosition: include is done such that these points will match
--orientation: of ob inside cell
--coordSystem: uses either clientCoordinates or cdCoordinates for both,
-- the reference point of the cell and the reference point of the object
--skipRepositioning: delays repositioning of the cell
-- caution: makes temporary a wrong coordinate system! cell is
-- not legal until CDDirectory.RepositionAnObject[cell] is called to clean up.
-- skipRepositioning has no effect if cell is NIL
--caution: procedure does NOT redraw the viewers; (use CDOps.DelayedRedraw...)
BEGIN
cp: CD.CellPtr;
cellOrigin: CD.DesignPosition←[0, 0];
aptr:
CD.ApplicationPtr =
NEW[
CD.Application ← [
ob: ob,
location: TRASH,
orientation: orientation,
selected: FALSE
]];
IF ob=NIL THEN ERROR CD.Error[callingError, "Include NIL ob"];
IF cell=
NIL
THEN {
IF design=NIL THEN cp ← NIL
ELSE cp ← design^.actual.first.specific;
}
ELSE {
cp ← NARROW[cell.specificRef];
IF coordSystem=clientCoordinates THEN cellOrigin ← ClientOrigin[cell];
};
--do not check if the application is already used: we want to use constant time
IF coordSystem=clientCoordinates
THEN
aptr.location ← PositionFromPairO[
ob: ob,
cPos: obPosition,
correspondingGlobPos: CDBasics.AddPoints[cellOrigin, cellPosition],
orientation: aptr.orientation
]
ELSE {
IF coordSystem=innerCoordinates
THEN
obPosition ← CDBasics.AddPoints[obPosition, CDBasics.BaseOfRect[ob.p.insideRect[ob]]];
aptr.location ← CDBasics.SubPoints[
cellPosition,
CDOrient.MapPosition[
itemInCell: [obPosition.x, obPosition.y, obPosition.x, obPosition.y],
cellSize: ob.size,
cellInstOrient: orientation,
cellInstPos: [0, 0]
]
]
};
IF cp#
NIL
THEN {
cp.contents ← CONS[aptr, cp.contents];
IF cell#
NIL
THEN {
IF ~skipRepositioning
AND ~CDBasics.Inside[CDApplications.ARectO[aptr], CDBasics.RectAt[[0, 0], cell.size]]
THEN {
[] ← CDDirectoryExtras.RepositionCell[cell, design];
};
[] ← CDEvents.ProcessEvent[changeEvent, design, cell]
}
};
RETURN [aptr]
END;
CallDefaultSetOrigin:
PUBLIC PROC[design:
CD.Design, ob:
CD.ObPtr, new:
CD.DesignPosition]=
--BUT does NOT do the notification
BEGIN
--we handle the val of the originProperty property as readonly; and may share records
normal: CD.DesignPosition = CDBasics.BaseOfRect[ob.p.insideRect[ob]];
IF new=normal THEN CDProperties.PutPropOnObject[onto: ob, prop: originProperty, val: NIL]
ELSE CDProperties.PutPropOnObject[onto: ob, prop: originProperty, val: NEW[CD.DesignPosition←new]]
END;
originMoveEvent: PUBLIC REF ← $ClientOriginChanged;
originChangeEvent: CDEvents.EventRegistration ~ CDEvents.RegisterEventType[originMoveEvent];
CallNotification:
PUBLIC
PROC[design:
CD.Design, me:
CD.ObPtr, old, new:
CD.DesignPosition] =
BEGIN
[] ← CDEvents.ProcessEvent[
ev: originChangeEvent,
design: design,
x: NEW[NotificationRec←[me: me, old: old, new: new]],
listenToDont: FALSE
];
FOR list: LIST OF OriginNotification ← notifierList, list.rest WHILE list#NIL DO
list.first[design, me, old, new ! RuntimeError.UNCAUGHT => CONTINUE]
ENDLOOP;
END;
DefaultSetOrigin:
PROC[design:
CD.Design, ob:
CD.ObPtr, new:
CD.DesignPosition]=
BEGIN
old: CD.DesignPosition = ClientOrigin[ob];
CallDefaultSetOrigin[design, ob, new];
CallNotification[design, ob, old, new];
END;
SetClientOrigin:
PUBLIC PROC [design:
CD.Design, ob:
CD.ObPtr, pos:
CD.DesignPosition] =
--Calls objects SetOriginProc.
--Sets the position of the client's object origin measured in objects
--internal coords.
--This procedure may also be called by the implementor of repositioning, and,
--rarely, restricted to certain object classes, interactively driven.
BEGIN
WITH CDObjectProcs.FetchFurther[ob.p, $SetOrigin]
SELECT
FROM
sp: REF SetOriginProc => sp^[design, ob, pos];
ENDCASE => DefaultSetOrigin[design, ob, pos];
END;
RegisterOriginProcs:
PUBLIC
ENTRY
PROC [class:
REF
CD.ObjectProcs,
set: SetOriginProc, --don't use CallDefaultSetOrigin; it would not notify !
get: GetOriginProc
] =
BEGIN
IF set=NIL OR get=NIL OR set=CallDefaultSetOrigin THEN ERROR;
CDObjectProcs.StoreFurther[class, $SetOrigin, NEW[SetOriginProc←set]];
CDObjectProcs.StoreFurther[class, $GetOrigin, NEW[GetOriginProc←get]];
END;
RegisterOriginNotification: PUBLIC ENTRY PROC [notify: OriginNotification] =
--notify is called whenever an object changes its origin.
BEGIN
list: LIST OF OriginNotification ← notifierList;
IF notify=NIL THEN ERROR;
IF list=NIL THEN notifierList←LIST[notify]
ELSE
DO --ASSERT: list#NIL
IF list.rest=NIL THEN {list.rest←LIST[notify]; EXIT};
list ← list.rest
ENDLOOP;
END;
changeEvent: CDEvents.EventRegistration ~ DangerousGetChangeEvent[];
DangerousGetChangeEvent:
ENTRY
PROC []
RETURNS [CDEvents.EventRegistration] =
remove this silly procedure as fast as possible
BEGIN
x: REF = CDValue.Fetch[key: $CDxPrivateAfterChange];
IF x#NIL THEN TRUSTED {RETURN [LOOPHOLE[x]]}
ELSE {
changeEvent: CDEvents.EventRegistration ~ CDEvents.RegisterEventType[$AfterChange];
CDValue.Store[key: $CDxPrivateAfterChange, value: changeEvent];
RETURN [changeEvent]
}
END;
InternalWriteProperty:
PROC [prop:
REF, val:
REF] =
BEGIN
p: REF CD.DesignPosition ← NARROW[val];
TokenIO.WriteInt[p.x];
TokenIO.WriteInt[p.y];
END;
InternalReadProperty:
PROC [prop:
ATOM]
RETURNS [val:
REF] =
BEGIN
x: INT = TokenIO.ReadInt[];
y: INT = TokenIO.ReadInt[];
val ← NEW[CD.DesignPosition←[x, y]]
END;
originProperty: ATOM = $origin;
[] ← CDProperties.RegisterProperty[originProperty];
CDProperties.InstallProcs[prop: originProperty,
new: CDProperties.PropertyProcsRec[
makeCopy: CDProperties.CopyVal, --because we treat the coordinates readonly
internalWrite: InternalWriteProperty,
internalRead: InternalReadProperty,
exclusive: TRUE
]
];
END.