SchemeEdit.Mesa
Last Edited by: Spreitzer, February 12, 1984 0:32 am
DIRECTORY Basics, BiScrollers, FS, Graphics, InputFocus, IO, OrderedSymbolTableRef, Rope, Scheme, TIPUser, ViewerClasses, ViewerOps, ViewerTools, ViewRec;
SchemeEdit:
CEDAR
PROGRAM
IMPORTS BiScrollers, FS, Graphics, InputFocus, IO, OrderedSymbolTableRef, Rope, TIPUser, ViewerOps, ViewerTools, ViewRec =
BEGIN OPEN Scheme;
Viewer: TYPE = ViewerClasses.Viewer;
RecordViewer: TYPE = ViewRec.RecordViewer;
BiScroller: TYPE = BiScrollers.BiScroller;
Session:
TYPE =
REF SessionRep; SessionRep:
TYPE =
RECORD [
name: ROPE,
typesMenu: Viewer,
ctlRV: RecordViewer,
ctlPanel: CtlPanel,
editors: LIST OF Editor ← NIL,
mostRecentEditor: Editor ← NIL,
typesTable: Table,
picsTable: Table
];
Editor:
TYPE =
REF EditorRep; EditorRep:
TYPE =
RECORD [
session: Session,
bs: BiScroller,
v: Viewer,
subjectPic: PictureDef,
subjectCell: CellType,
subjectClass: SubjectClass,
oldHor: BOOLEAN ← TRUE,
primary, secondary: PointBack,
moveSubject: Vertex ← [NIL, NIL],
strandGoal: Point ← NIL];
SubjectClass: TYPE = {icon, expansion};
PointBack:
TYPE =
REF PointBackRep; PointBackRep:
TYPE =
RECORD [
x, y: REAL ← 0,
sx, sy: REAL ← 1,
primary: BOOLEAN,
cx, cy: Coord ← NIL,
point: Point ← NIL];
CtlPanel:
TYPE =
REF CtlPanelRep; CtlPanelRep:
TYPE =
RECORD [
ReadFile: PROC [session: Session, file: ROPE],
WriteFile: PROC [session: Session, file: ROPE],
WriteAllFiles: PROC [session: Session],
CreateCellType: PROC [session: Session, file, name: ROPE],
CreateIcon: PROC [session: Session, cellType, iconName: ROPE],
EditType: PROC [session: Session, cellTypeName, iconName: ROPE, part: SubjectClass],
Export: PROC [session: Session, portName: ROPE],
action: Action ← create,
iconAction: IconWhat ← line,
expansionAction: ExpansionAction ← strand,
cellType, icon, name: ROPE ← NIL];
Action: TYPE = {create, delete};
IconWhat: TYPE = {line, text, instance};
ExpansionAction: TYPE = {component, port, strand};
editorClasses:
ARRAY SubjectClass
OF BiScrollers.BiScrollerClass ← [
BiScrollers.NewBiScrollerClass[
flavor: $SchemeIconEditor,
extrema: PicExtrema,
notify: NotifyScheme,
paint: PaintScheme,
tipTable: TIPUser.InstantiateNewTIPTable["SchemeIcon.TIP"]],
BiScrollers.NewBiScrollerClass[
flavor: $SchemeExpansionEditor,
extrema: PicExtrema,
notify: NotifyScheme,
paint: PaintScheme,
tipTable: TIPUser.InstantiateNewTIPTable["SchemeExpansion.TIP"]]
];
CompareNames: OrderedSymbolTableRef.CompareProc
--PROC [r1, r2: Item] RETURNS [Comparison]-- =
BEGIN
ToRope:
PROC [any:
REF
ANY]
RETURNS [k:
ROPE] =
{k ←
WITH any
SELECT
FROM
r: ROPE => r,
ct: CellType => ct.name,
p: Port => p.name,
n: Net => n.name,
c: Component => c.name,
pic: PictureDef => pic.name,
pdp: PictureDefPort => pdp.portName,
c: Coord => c.name,
pt: Point => pt.name,
ENDCASE => ERROR};
k1: ROPE ← ToRope[r1];
k2: ROPE ← ToRope[r2];
RETURN [k1.Compare[k2]];
END;
CompareCoords: OrderedSymbolTableRef.CompareProc
--PROC [r1, r2: Item] RETURNS [Comparison]-- =
BEGIN
k1:
REAL ←
WITH r1
SELECT
FROM
c: Coord => c.z,
l: LORA => NARROW[l.first, Coord].z,
r: REF REAL => r^,
ENDCASE => ERROR;
k2:
REAL ←
WITH r2
SELECT
FROM
c: Coord => c.z,
l: LORA => NARROW[l.first, Coord].z,
r: REF REAL => r^,
ENDCASE => ERROR;
RETURN [IF k1 < k2 THEN less ELSE IF k1 > k2 THEN greater ELSE equal];
END;
NotifyCoord:
PROC [coord: Coord, editor: Editor] =
BEGIN
ViewerOps.PaintViewer[viewer: editor.v, hint: client, clearClient: FALSE, whatChanged: coord];
END;
ReadFile:
PROC [session: Session, file:
ROPE]
RETURNS [collisions:
ROPE] =
BEGIN
in: IO.STREAM ← FS.StreamOpen[fileName: file];
collisions ← NIL;
DO
collision: ROPE;
[] ← in.SkipWhitespace[];
IF in.EndOf[] THEN EXIT;
IF (collision ← ReadCellType[in, file, session]) # NIL THEN collisions ← collisions.Cat[" ", collision];
ENDLOOP;
END;
ReadCellType:
PROC [from:
IO.
STREAM, sourceName:
ROPE, session: Session]
RETURNS [collision:
ROPE] =
BEGIN
cellTypeName: ROPE ← from.GetRopeLiteral[];
IF session.typesTable.Lookup[cellTypeName] #
NIL
THEN {collision ← cellTypeName; cellTypeName ← NewName[]; collision ← collision.Cat["->", cellTypeName]}
ELSE collision ← NIL;
cellType ← NewCellType[session, sourceName, cellTypeName, TRUE];
cellType.otherProps ← ReadPropList[from];
cellType.expansion ← ReadPictureDef[from];
WHILE NotDot[from] DO ReadIcon[from, session, cellType] ENDLOOP;
EatDot[from];
WHILE NotDot[from] DO ReadPort[from, session, cellType] ENDLOOP;
EatDot[from];
WHILE NotDot[from] DO ReadNet[from, session, cellType] ENDLOOP;
EatDot[from];
WHILE NotDot[from] DO ReadComponent[from, session, cellType] ENDLOOP;
EatDot[from];
END;
ReadIcon:
PROC [from:
IO.
STREAM, session: Session, cellType: CellType] =
BEGIN
pic: PictureDef ← ReadPictureDef[from];
cellType.icons.Insert[pic];
END;
ReadPort:
PROC [from:
IO.
STREAM, session: Session, cellType: CellType] =
BEGIN
portName: ROPE ← from.GetRopeLiteral[];
props: PropList ← ReadPropList[from];
pointName: ROPE ← from.GetRopeLiteral[];
labelFlag: ROPE ← from.GetRopeLiteral[];
port: Port ← CreatePort[cellType, portName, NARROW[cellType.expansion.points.Lookup[pointName]]];
port.otherProps ← props;
IF labelFlag.Equal["noLabel"] THEN NULL
ELSE
IF labelFlag.Equal["label"]
THEN
BEGIN
labelName: ROPE ← from.GetRopeLiteral[];
port.label ← NARROW[cellType.expansion.objects.Lookup[labelName]];
END
ELSE ERROR;
END;
ReadNet:
PROC [from:
IO.
STREAM, session: Session, cellType: CellType] =
BEGIN
name: ROPE ← from.GetRopeLiteral[];
props: PropList ← ReadPropList[from];
net: Net ← NEW [NetRep ← [name: name, otherProps: props]];
cellType.nets.Insert[net];
WHILE NotDot[from]
DO
class: ROPE ← from.GetTokenRope[].token;
IF class.Equal["port"]
THEN {name:
ROPE ← from.GetRopeLiteral[];
net.stuff ← CONS[cellType.ports.Lookup[name], net.stuff]}
ELSE
IF class.Equal["point"]
THEN {cName:
ROPE ← from.GetRopeLiteral[];
pName: ROPE ← from.GetRopeLiteral[];
comp: Component ← NARROW[cellType.components.Lookup[cName]];
net.stuff ← CONS[ERROR, net.stuff]}
ELSE
IF class.Equal["point"]
THEN {name:
ROPE ← from.GetRopeLiteral[];
net.stuff ← CONS[cellType.expansion.points.Lookup[name], net.stuff]}
ELSE
IF class.Equal["line"]
THEN {name:
ROPE ← from.GetRopeLiteral[];
net.stuff ← CONS[cellType.expansion.objects.Lookup[name], net.stuff]}
ELSE
IF class.Equal["text"]
THEN {name:
ROPE ← from.GetRopeLiteral[];
net.stuff ← CONS[cellType.expansion.objects.Lookup[name], net.stuff]}
ELSE ERROR;
ENDLOOP;
END;
ReadComponent:
PROC [from:
IO.
STREAM, session: Session, cellType: CellType] =
BEGIN
name: ROPE ← from.GetRopeLiteral[];
typeName: ROPE ← from.GetRopeLiteral[];
of: CellType ← NARROW[session.typesTable.Lookup[typeName]];
instName: ROPE ← from.GetRopeLiteral[];
inst: PictureInstance ← NARROW[cellType.expansion.objects.Lookup[instName]];
props: PropList ← ReadPropList[from];
comp: Component ← CreateComponent[in: cellType, of: of, name: name, inst: inst];
labelFlag: ROPE ← from.GetTokenRope[].token;
comp.otherProps ← props;
IF labelFlag.Equal["noLabel"] THEN NULL
ELSE IF labelFlag.Equal["label"] THEN comp.label ← NARROW[cellType.expansion.objects.Lookup[from.GetRopeLiteral[]]]
ELSE ERROR;
END;
ReadPictureDef:
PROC [from:
IO.
STREAM, session: Session]
RETURNS [pic: PictureDef] =
BEGIN
name: ROPE ← from.GetRopeLiteral[];
pic ← NewPicture[session, name];
WHILE NotDot[from] DO ReadCoord[from, pic] ENDLOOP; EatDot[from];
WHILE NotDot[from] DO ReadPoint[from, pic] ENDLOOP; EatDot[from];
WHILE NotDot[from] DO ReadPDP[from, pic] ENDLOOP; EatDot[from];
WHILE NotDot[from] DO ReadObject[from, pic] ENDLOOP; EatDot[from];
END;
ReadCoord:
PROC [from:
IO.
STREAM, pic: PictureDef] =
BEGIN
name, axisName, parentCode, parentName: ROPE;
axis: Axis;
z, dz, org: REAL;
parent: REF ANY;
name ← from.GetRopeLiteral[];
axisName ← from.GetTokenRope[].token;
IF axisName.Equal["X"] THEN axis ← X ELSE IF axisName.Equal["Y"] THEN axis ← Y ELSE ERROR;
z ← from.GetReal[];
dz ← from.GetReal[];
parentCode ← from.GetTokenRope[].token;
parentName ← from.GetRopeLiteral[];
IF parentCode.Equal["n"] THEN parent ← NIL
ELSE IF parentCode.Equal["c"] THEN parent ← EnsureCoord[pic, parentName]
ELSE IF parentCode.Equal["p"] THEN parent ← EnsurePictureInstance[pic, parentName]
ELSE ERROR;
[] ← NewCoord[axis: axis, at: z, pic: pic, parent: parent, name: name];
END;
EnsureCoord:
PROC [pic: PictureDef, name:
ROPE]
RETURNS [coord: Coord] =
BEGIN
coord ← NARROW[pic.coordsByName.Lookup[name]];
IF coord = NIL THEN pic.coordsByName.Insert[coord ← NEW [CoordRep ← [name: name]]];
END;
EnsurePictureInstance:
PROC [pic: PictureDef, name:
ROPE]
RETURNS [pi: PictureInstance] =
BEGIN
pi ← FindObject[pic.objects, name];
IF pi = NIL THEN pic.objects ← CONS[pi ← NEW [PictureInstanceRep ← [name: name]], pic.objects];
END;
ReadPoint:
PROC [from:
IO.
STREAM, pic: PictureDef] =
BEGIN
name: ROPE ← from.GetRopeLiteral[];
xName: ROPE ← from.GetRopeLiteral[];
yName: ROPE ← from.GetRopeLiteral[];
[] ← NewPoint[pic, name, [NARROW[pic.coordsByName.Lookup[xName]], NARROW[pic.coordsByName.Lookup[yName]]]];
END;
ReadPDP:
PROC [from:
IO.
STREAM, pic: PictureDef] =
BEGIN
portName: ROPE ← from.GetRopeLiteral[];
pointName: ROPE ← from.GetRopeLiteral[];
EnsurePDP[pic, portName, NARROW[pic.points.Lookup[pointName]]];
END;
ReadObject:
PROC [from:
IO.
STREAM, pic: PictureDef, session: Session] =
BEGIN
class: ROPE ← from.GetTokenRope[].token[];
IF class.Equal["line"] THEN ReadLine[from, pic]
ELSE IF class.Equal["text"] THEN ReadText[from, pic]
ELSE IF class.Equal["pi"] THEN ReadPictureInstance[from, pic, session]
ELSE ERROR;
END;
ReadLine:
PROC [from:
IO.
STREAM, pic: PictureDef] =
BEGIN
name: ROPE ← from.GetRopeLiteral[];
aName: ROPE ← from.GetRopeLiteral[];
bName: ROPE ← from.GetRopeLiteral[];
[] ← NewLine[pic, NARROW[pic.points.Lookup[aName]], NARROW[pic.points.Lookup[bName]]];
END;
ReadText:
PROC [from:
IO.
STREAM, pic: PictureDef] =
BEGIN
name: ROPE ← from.GetRopeLiteral[];
orgName: ROPE ← from.GetRopeLiteral[];
rope: ROPE ← from.GetRopeLiteral[];
NewText[pic, NARROW[pic.points.Lookup[orgName]], rope];
END;
ReadPictureInstance:
PROC [from:
IO.
STREAM, pic: PictureDef, session: Session] =
BEGIN
name: ROPE ← from.GetRopeLiteral[];
orgName: ROPE ← from.GetRopeLiteral[];
defName: ROPE ← from.GetRopeLiteral[];
def: PictureDef ← NARROW[session.picsTable.Lookup[defName]];
[] ← CreateInstance[in: pic, of: def, org: NARROW[pic.points.Lookup[orName]]];
END;
ReadPropList:
PROC [from:
IO.
STREAM]
RETURNS [propList: PropList] =
BEGIN
propList ← NIL;
WHILE NotDot[from]
DO
key, value: REF ANY;
key ← from.GetRefAny[];
value ← from.GetRefAny[];
propList ← List.PutAssoc[key: propList, val: value, aList: propList];
ENDLOOP;
EatDot[from];
END;
NotDot:
PROC [from:
IO.
STREAM]
RETURNS [not:
BOOLEAN] =
{[] ← from.SkipWhitespace[];
not ← from.PeekChar[] # '.};
EatDot:
PROC [from:
IO.
STREAM] = {
char: CHAR ← from.GetChar[];
IF char # '. THEN ERROR};
WriteFile:
PROC [session: Session, file:
ROPE] =
BEGIN
Write:
PROC [any:
REF
ANY]
RETURNS [stop:
BOOLEAN] =
BEGIN
cellType: CellType ← NARROW[any];
stop ← FALSE;
IF cellType.file.Equal[file] THEN WriteCellType[out, cellType];
END;
out: IO.STREAM ← FS.StreamOpen[fileName: file, accessOptions: create];
session.typeTable.EnumerateIncreasing[Write];
out.Close[];
END;
WriteAllFiles: PROC [session: Session] = {};
WriteCellType:
PROC [to:
IO.
STREAM, cellType: CellType] =
BEGIN
WriteIcon:
PROC [any:
REF
ANY]
RETURNS [stop:
BOOLEAN] =
BEGIN
pic: PictureDef ← NARROW[any];
stop ← FALSE;
WritePictureDef[to, pic];
END;
WritePort:
PROC [any:
REF
ANY]
RETURNS [stop:
BOOLEAN] =
{port: Port ← NARROW[any];
stop ← FALSE;
IO.PutF[" \"%q\"", IO.rope[port.name]];
WritePropList[to, port.otherProps];
IO.PutF[" \"%q\"", IO.rope[port.point.name]];
IF port.label # NIL THEN to.PutF[" label \"%q\"", IO.rope[port.label.name]] ELSE to.PutRope[" noLabel"]};
WriteNet:
PROC [any:
REF
ANY]
RETURNS [stop:
BOOLEAN] =
{net: Net ← NARROW[any];
stop ← FALSE;
IF net.eatenBy # NIL THEN RETURN;
IO.PutF[" \"%q\"", IO.rope[net.name]];
WritePropList[to, net.otherProps];
FOR l:
LORA ← net.stuff, l.rest
WHILE l #
NIL
DO
WITH l.first
SELECT
FROM
port: Port => to.PutF[" port \"%q\"", IO.rope[port.name]];
cp: ComponentPort => to.PutF[" cp \"%q\" \"%q\"", IO.rope[cp.component.name], IO.rope[cp.port.name]];
point: Point => to.PutF[" point \"%q\"", IO.rope[point.name]];
line: Line => to.PutF[" line \"%q\"", IO.rope[line.name]];
label: Text => to.PutF[" text \"%q\"", IO.rope[label.name]];
ENDCASE => ERROR;
ENDLOOP;
to.PutRope[" ."]};
WriteComponent:
PROC [any:
REF
ANY]
RETURNS [stop:
BOOLEAN] =
{component: Component ← NARROW[any];
stop ← FALSE;
to.PutF[" %g %g %g", IO.refAny[component.name], IO.refAny[component.type.name], IO.refAny[component.inst.name]];
WritePropList[to, component.otherProps];
IF component.label # NIL THEN to.PutF[" label \"%q\"", IO.rope[component.label.name]] ELSE to.PutRope[" noLabel"]};
to.PutF[" \"%q\"", IO.rope[cellType.name]];
WritePropList[to, cellType.otherProps];
WritePictureDef[to, cellType.expansion];
cellType.icons.EnumerateIncreasing[WriteIcon];
to.PutRope[" ."];
cellType.ports.EnumerateIncreasing[WritePort];
to.PutRope[" ."];
cellType.nets.EnumerateIncreasing[WriteNet];
to.PutRope[" ."];
cellType.nets.EnumerateIncreasing[WriteComponent];
to.PutRope[" ."];
END;
axisNames: ARRAY Axis OF ROPE = ["X", "Y"];
WritePictureDef:
PROC [to:
IO.
STREAM, pic: PictureDef] =
BEGIN
WriteCoord:
PROC [any:
REF
ANY]
RETURNS [stop:
BOOLEAN] =
{coord: Coord ← NARROW[any]; stop ← FALSE;
to.PutF[" %g %g %g %g", IO.refAny[coord.name], IO.rope[axisNames[coord.axis]], IO.real[coord.z], IO.real[coord.dz]];
IF coord.parent #
NIL
THEN
WITH coord.parent
SELECT
FROM
c: Coord => to.PutF[" c %g", IO.refAny[c.name]];
pi: PictureInstance => to.PutF[" p %g", IO.refAny[pi.name]];
ENDCASE => ERROR
ELSE to.PutRope[" n NIL"]};
WritePoint:
PROC [any:
REF
ANY]
RETURNS [stop:
BOOLEAN] =
{point: Point ← NARROW[any];
stop ← FALSE;
to.PutF[" \"%q\" \"%q\" \"%q\"", IO.rope[point.name], IO.rope[point.c[X].name], IO.rope[point.c[Y].name]]};
WritePictureDefPort:
PROC [any:
REF
ANY]
RETURNS [stop:
BOOLEAN] =
{pdp: PictureDefPort ← NARROW[any];
stop ← FALSE;
to.PutF[" \"%q\" \"%q\"", IO.rope[pdp.portName], IO.rope[pdp.point.name]]};
WriteObject:
PROC [any:
REF
ANY]
RETURNS [stop:
BOOLEAN] =
{stop ← FALSE;
WITH any
SELECT
FROM
line: Line => to.PutF[" line \"%q\" \"%q\" \"%q\"", IO.rope[line.name], IO.rope[line.a.name], IO.rope[line.b.name]];
text: Text => to.PutF[" text \"%q\" \"%q\" \"%q\"", IO.rope[text.name], IO.rope[text.org.name], IO.rope[text.rope]];
pi: PictureInstance => to.PutF[" pi \"%q\" \"%q\" \"%q\"", IO.rope[pi.name], IO.rope[pi.org.name], IO.rope[pi.pic.name]];
ENDCASE => ERROR};
to.PutF[" \"%q\"", IO.rope[pic.name]];
pic.coordsByName.EnumerateIncreasing[WriteCoord];
to.PutRope[" ."];
pic.points.EnumerateIncreasing[WritePoint];
to.PutRope[" ."];
pic.exports.EnumerateIncreasing[WritePictureDefPort];
to.PutRope[" ."];
pic.objects.EnumerateIncreasing[WriteObject];
to.PutRope[" ."];
END;
WritePropList:
PROC [to:
IO.
STREAM, propList: PropList] =
BEGIN
FOR propList ← propList, propList.rest
WHILE propList #
NIL
DO
to.PutF[" %g %g", IO.refAny[propList.key], IO.refAny[propList.value]];
ENDLOOP;
to.PutRope[" ."];
END;
CreateCellType:
PROC [session: Session, file, name:
ROPE] =
BEGIN
session.ctlRV.DisplayMessage[ViewRec.clearMessagePlace];
IF session.typesTable.Lookup[name] # NIL THEN {session.ctlRV.DisplayMessage["Already exists"]; RETURN};
[] ← NewCellType[session, file, name, FALSE];
END;
NewCellType:
PROC [session: Session, file, name:
ROPE, skeletal:
BOOLEAN]
RETURNS [cellType: CellType] =
BEGIN
picName: ROPE ← name.Cat["[expansion]"];
cellType ←
NEW [CellTypeRep ← [
file: file, name: name,
icons: OrderedSymbolTableRef.CreateTable[CompareNames],
expansion: NIL,
ports: OrderedSymbolTableRef.CreateTable[CompareNames],
nets: OrderedSymbolTableRef.CreateTable[CompareNames],
components: OrderedSymbolTableRef.CreateTable[CompareNames]]];
IF NOT skeletal THEN cellType.expansion ← NewPicture[session, picName];
session.typesTable.Insert[cellType];
ViewerTools.SetContents[session.typesMenu, ViewerTools.GetContents[session.typesMenu].Cat[" ", file, ":", name]];
END;
NewPicture:
PROC [session: Session, name:
ROPE]
RETURNS [pic: PictureDef] =
BEGIN
pic ←
NEW [PictureDefRep ← [
name: name,
coordsByValue: [
OrderedSymbolTableRef.CreateTable[CompareCoords],
OrderedSymbolTableRef.CreateTable[CompareCoords]],
coordsByName: OrderedSymbolTableRef.CreateTable[CompareNames],
exports: OrderedSymbolTableRef.CreateTable[CompareNames]
]];
session.picsTable.Insert[pic];
END;
CreateIcon:
PROC [session: Session, cellType, iconName:
ROPE] =
BEGIN
cellType: CellType ← NARROW[session.typesTable.Lookup[cellType]];
pic: PictureDef;
session.ctlRV.DisplayMessage[ViewRec.clearMessagePlace];
IF cellType = NIL THEN {session.ctlRV.DisplayMessage["No such CellType"]; RETURN};
pic ← NARROW[cellType.icons.Lookup[iconName]];
IF pic # NIL THEN {session.ctlRV.DisplayMessage["Icon name taken"]; RETURN};
pic ← NewPicture[session, cellType.Cat["[", iconName, "]"]];
cellType.icons.Insert[pic];
END;
EditType:
PROC [session: Session, cellTypeName, iconName:
ROPE, part: SubjectClass] =
BEGIN
cellType: CellType;
editor: Editor;
session.ctlRV.DisplayMessage[ViewRec.clearMessagePlace];
cellType ← NARROW[session.typesTable.Lookup[cellTypeName]];
IF cellType = NIL THEN {session.ctlRV.DisplayMessage["No such type"]; RETURN};
editor ←
NEW [EditorRep ← [
session: session,
bs: NIL,
v: NIL,
subjectPic:
SELECT part
FROM
icon =>
NARROW[
IF cellType.icons.Size[] = 1
THEN cellType.icons.LookupSmallest[]
ELSE cellType.icons.Lookup[iconName]],
expansion => cellType.expansion,
ENDCASE => ERROR,
subjectCell: cellType,
subjectClass: part,
primary: NIL, secondary: NIL]];
IF editor.subjectPic = NIL THEN {session.ctlRV.DisplayMessage["No such icon"]; RETURN};
IF editor.subjectPic.editor # NIL THEN {session.ctlRV.DisplayMessage["Already being edited"]; RETURN};
editor.subjectPic.editor ← editor;
session.editors ← CONS[editor, session.editors];
editor.primary ← NEW [PointBackRep ← [primary: TRUE]];
editor.secondary ← NEW [PointBackRep ← [primary: FALSE]];
editor.bs ← BiScrollers.CreateBiScroller[class: editorClasses[part], info: [name: IO.PutFR["%g.%g[%g]", IO.rope[session.name], IO.rope[cellTypeName], IO.rope[editor.subjectPic.name]], data: editor, iconic: FALSE]];
editor.v ← editor.bs.QuaViewer[];
END;
Export:
PROC [session: Session, portName:
ROPE] =
BEGIN
editor: Editor ← session.mostRecentEditor;
session.ctlRV.DisplayMessage[ViewRec.clearMessagePlace];
IF editor.primary.point = NIL THEN {Complain[editor, "No point selected"]; RETURN};
EnsurePDP[editor.subjectPic, portName, editor.primary.point];
END;
EnsurePDP:
PROC [pic: PictureDef, portName:
ROPE, point: Point] =
BEGIN
pdp: PictureDefPort ← NARROW[pic.exports.Lookup[portName]];
IF pdp =
NIL
THEN pic.exports.Insert[
pdp ← NEW [PictureDefPortRep ← [pic: pic, portName: portName, point: NIL]]];
pdp.point ← point;
END;
PicExtrema: BiScrollers.ExtremaProc
--PROC [clientData: REF ANY, direction: Vec] RETURNS [min, max: Geom2D.Vec]-- =
{editor: Editor ← NARROW[clientData];
smallestX:Coord ← PikCoord[editor.subjectPic.coordsByValue[X].LookupSmallest[]];
smallestY:Coord ← PikCoord[editor.subjectPic.coordsByValue[Y].LookupSmallest[]];
largestX: Coord ← PikCoord[editor.subjectPic.coordsByValue[X].LookupLargest[]];
largestY: Coord ← PikCoord[editor.subjectPic.coordsByValue[Y].LookupLargest[]];
min ← [
IF smallestX # NIL THEN smallestX.z ELSE -10,
IF smallestY # NIL THEN smallestY.z ELSE -10];
max ← [
IF largestX # NIL THEN largestX.z ELSE 10,
IF largestY # NIL THEN largestY.z ELSE 10];
};
PikCoord:
PROC [any:
REF
ANY]
RETURNS [coord: Coord] = {
coord ←
IF any #
NIL
THEN
WITH any
SELECT
FROM
c: Coord => c,
cl: LORA => NARROW[cl.first],
ENDCASE => ERROR
ELSE NIL};
PaintScheme: ViewerClasses.PaintProc
--PROC [self: Viewer, context: Graphics.Context, whatChanged: REF ANY, clear: BOOL]-- =
BEGIN
editor: Editor ← NARROW[BiScrollers.QuaBiScroller[self].ClientDataOf[]];
[] ← Graphics.SetPaintMode[context, invert];
IF whatChanged =
NIL
THEN {
DrawPic[editor.subjectPic, context, [0, 0]];
SetBack[editor.primary]; DrawBack[editor.primary, context];
SetBack[editor.secondary]; DrawBack[editor.secondary, context]}
ELSE
WITH whatChanged
SELECT
FROM
coord: Coord => UpdateCoord[coord, context];
pb: PointBack => IF pb.x # pb.sx OR pb.y # pb.sy THEN {DrawBack[pb, context]; SetBack[pb]; DrawBack[pb, context]};
line: Line => {SetLine[line]; DrawLine[line, context]};
text: Text => {SetText[text]; DrawText[text, context]};
pi: PictureInstance => {SetInstance[pi]; DrawPic[pi.pic, context, pi.s]};
ENDCASE => ERROR;
END;
SetInstance:
PROC [pi: PictureInstance] =
{pi.s[X] ← pi.org.c[X].z; pi.s[Y] ← pi.org.c[Y].z};
DrawPic:
PROC [pic: PictureDef, context: Graphics.Context, at: VertexReals] =
BEGIN
org: Graphics.Mark ← Graphics.Save[context];
Graphics.Translate[self: context, tx: at[X], ty: at[Y]];
FOR lo:
LORA ← pic.objects, lo.rest
WHILE lo #
NIL
DO
WITH lo.first
SELECT
FROM
line: Line => {SetLine[line]; DrawLine[line, context]};
text: Text => {SetText[text]; DrawText[text, context]};
pi: PictureInstance => {SetInstance[pi]; DrawPic[pi.pic, context, pi.s]};
ENDCASE => ERROR;
ENDLOOP;
Graphics.Restore[context, org];
END;
UpdateCoord:
PROC [coord: Coord, context: Graphics.Context] =
BEGIN
coord.z ← coord.dz + (
IF coord.parent #
NIL
THEN
WITH coord.parent
SELECT
FROM
pi: PictureInstance => pi.org.c[coord.axis].z,
c: Coord => c.z,
ENDCASE => ERROR
ELSE 0);
IF coord.z = coord.sz THEN RETURN;
coord.sz ← coord.z;
FOR dl:
LORA ← coord.dependents, dl.rest
WHILE dl #
NIL
DO
WITH dl.first
SELECT
FROM
c2: Coord => UpdateCoord[c2, context];
back: PointBack => --IF back.sx # back.x OR back.sy # back.y THEN {DrawBack[back, context]; SetBack[back]; DrawBack[back, context]}-- ERROR;
pt: Point =>
FOR l:
LORA ← pt.dependents, l.rest
WHILE l #
NIL
DO
WITH l.first
SELECT
FROM
line: Line =>
IF line.sa # [line.a.c[
X].z, line.a.c[
Y].z]
OR line.sb # [line.b.c[
X].z, line.b.c[
Y].z]
THEN {DrawLine[line, context]; SetLine[line]; DrawLine[line, context]};
text: Text =>
IF text.s # [text.org.c[
X].z, text.org.c[
Y].z]
THEN {DrawText[text, context]; SetText[text]; DrawText[text, context]};
pi: PictureInstance =>
IF pi.s # [pi.org.c[
X].z, pi.org.c[
Y].z]
THEN {
DrawPic[pi.pic, context, pi.s];
SetInstance[pi];
DrawPic[pi.pic, context, pi.s]};
ENDCASE => ERROR;
ENDLOOP;
ENDCASE => ERROR;
ENDLOOP;
END;
SetLine:
PROC [line: Line] = {
line.sa ← [line.a.c[X].z, line.a.c[Y].z];
line.sb ← [line.b.c[X].z, line.b.c[Y].z]};
DrawLine:
PROC [line: Line, context: Graphics.Context] =
BEGIN
Graphics.SetCP[context, line.sa[X], line.sa[Y]];
Graphics.DrawTo[context, line.sb[X], line.sb[Y]];
END;
SetText: PROC [text: Text] = {text.s ← [text.org.c[X].z, text.org.c[Y].z]};
DrawText:
PROC [text: Text, context: Graphics.Context] =
BEGIN
Graphics.SetCP[context, text.s[X], text.s[Y]];
Graphics.DrawRope[context, text.rope];
END;
SetBack: PROC [back: PointBack] = {back.sx ← back.x; back.sy ← back.y};
DrawBack:
PROC [back: PointBack, context: Graphics.Context] =
BEGIN
org: Graphics.Mark ← Graphics.Save[context];
Graphics.Translate[self: context, tx: back.sx, ty: back.sy];
Graphics.DrawStroke[self: context,
path: (IF back.primary THEN primaryPath ELSE secondaryPath)];
Graphics.Restore[context, org];
END;
gray: CARDINAL = 257*18*5;
primaryPath: Graphics.Path ← Graphics.NewPath[];
secondaryPath: Graphics.Path ← Graphics.NewPath[];
NotifyScheme: ViewerClasses.NotifyProc
--PROC [self: Viewer, input: LIST OF REF ANY]-- =
BEGIN
editor: Editor ← NARROW[BiScrollers.QuaBiScroller[self].ClientDataOf[]];
WHILE input #
NIL
DO
WITH input.first
SELECT
FROM
a:
ATOM =>
SELECT a
FROM
$StartSelect => input ← StartSelect[editor, FALSE, input];
$TrackSelect => input ← TrackSelect[editor, FALSE, input];
$FinalSelect => input ← FinalSelect[editor, FALSE, input];
$StartDraw => input ← StartSelect[editor, TRUE, input];
$TrackDraw => input ← TrackSelect[editor, TRUE, input];
$FinalDraw => input ← FinalSelect[editor, TRUE, input];
$Move => input ← Move[editor, input];
$EndMove => {EndMove[editor]; input ← input.rest};
$SetGoal => {editor.strandGoal ← editor.primary.point; input ← input.rest};
$FinishWire => {NewStrand[editor, TRUE]; input ← input.rest};
$DownShift => {editor.oldHor ← FALSE; input ← input.rest};
$DownCtrl => {editor.oldHor ← TRUE; input ← input.rest};
ENDCASE => ERROR;
ENDCASE => ERROR;
ENDLOOP;
END;
NotifyBack:
PROC [pb: PointBack, editor: Editor] =
{ViewerOps.PaintViewer[viewer: editor.v, hint: client, clearClient: FALSE, whatChanged: pb]};
EndMove:
PROC [editor: Editor] =
BEGIN
IF editor.moveSubject[X] # NIL THEN {RestoreCoords[editor.subjectPic, editor.moveSubject[X]]; editor.moveSubject[X] ← NIL};
IF editor.moveSubject[Y] # NIL THEN {RestoreCoords[editor.subjectPic, editor.moveSubject[Y]]; editor.moveSubject[Y] ← NIL};
END;
Move:
PROC [editor: Editor, input:
LORA]
RETURNS [output:
LORA] =
BEGIN
rawCoords: BiScrollers.ClientCoords = NARROW[input.rest.first];
moveX: BOOLEAN = DecodeBool[$NoShift, $Shift, input.rest.rest.first];
moveY: BOOLEAN = DecodeBool[$NoCtrl, $Ctrl, input.rest.rest.rest.first];
output ← input.rest.rest.rest.rest;
editor.session.mostRecentEditor ← editor;
IF editor.moveSubject # [editor.primary.cx, editor.primary.cy]
THEN {
EndMove[editor];
editor.moveSubject ← [editor.primary.cx, editor.primary.cy];
UntableCoords[editor.subjectPic, editor.moveSubject[X]];
UntableCoords[editor.subjectPic, editor.moveSubject[Y]];
};
IF moveX
THEN {
editor.moveSubject[X].dz ← rawCoords.x - Org[editor.moveSubject[X]];
NotifyCoord[editor.moveSubject[X], editor]};
IF moveY
THEN {
editor.moveSubject[Y].dz ← rawCoords.y - Org[editor.moveSubject[Y]];
NotifyCoord[editor.moveSubject[Y], editor]};
END;
UntableCoord:
PROC [table: Table, coord: Coord] =
BEGIN
found: REF ANY ← table.Lookup[coord];
IF found = coord
THEN {IF table.Delete[coord] # coord THEN ERROR}
ELSE {cl:
LORA ←
NARROW[found];
cl2: LORA ← Filter[cl, coord];
IF cl2.rest =
NIL
THEN
{IF table.Delete[coord] # cl THEN ERROR; table.Insert[cl2.first]}
ELSE
IF cl2 # cl
THEN
{IF table.Delete[coord] # cl THEN ERROR; table.Insert[cl2]}
};
END;
UntableCoords:
PROC [pic: PictureDef, root: Coord] =
BEGIN
UntableCoord[pic.coordsByValue[root.axis], root];
FOR l:
LORA ← root.dependents, l.rest
WHILE l #
NIL
DO
WITH l.first
SELECT
FROM
c: Coord => UntableCoords[pic, c];
ENDCASE;
ENDLOOP;
END;
Filter:
PROC [list:
LORA, elt:
REF
ANY]
RETURNS [filtered:
LORA] =
BEGIN
IF list.first = elt THEN RETURN [list.rest];
filtered ← list;
FOR list ← list, list.rest
WHILE list.rest #
NIL
DO
IF list.rest.first = elt THEN {list.rest ← list.rest.rest; RETURN};
ENDLOOP;
ERROR;
END;
EntableCoord:
PROC [table: Table, coord: Coord] =
BEGIN
old: REF ANY;
old ← table.Lookup[coord];
IF old #
NIL
THEN
WITH old
SELECT
FROM
c: Coord => {IF table.Delete[coord] # c THEN ERROR; table.Insert[LIST[c, coord]]};
l: LORA => l.rest ← CONS[coord, l.rest];
ENDCASE => ERROR
ELSE table.Insert[coord];
END;
RestoreCoords:
PROC [pic: PictureDef, root: Coord] =
BEGIN
EntableCoord[pic.coordsByValue[root.axis], root];
FOR l:
LORA ← root.dependents, l.rest
WHILE l #
NIL
DO
WITH l.first
SELECT
FROM
c: Coord => RestoreCoords[pic, c];
ENDCASE;
ENDLOOP;
END;
StartSelect:
PROC [editor: Editor, drawing:
BOOLEAN, input:
LORA]
RETURNS [output:
LORA] =
BEGIN
editor.session.ctlRV.DisplayMessage[ViewRec.clearMessagePlace];
editor.secondary.x ← editor.primary.x;
editor.secondary.y ← editor.primary.y;
editor.secondary.cx ← editor.primary.cx;
editor.secondary.cy ← editor.primary.cy;
editor.secondary.point ← editor.primary.point;
NotifyBack[editor.secondary, editor];
output ← TrackSelect[editor, drawing, input]
END;
TrackSelect:
PROC [editor: Editor, drawing:
BOOLEAN, input:
LORA]
RETURNS [output:
LORA] =
BEGIN
rawCoords: BiScrollers.ClientCoords = NARROW[input.rest.first];
snapX: BOOLEAN = DecodeBool[$NoShift, $Shift, input.rest.rest.first];
snapY: BOOLEAN = DecodeBool[$NoCtrl, $Ctrl, input.rest.rest.rest.first];
output ← input.rest.rest.rest.rest;
editor.session.mostRecentEditor ← editor;
IF drawing
AND editor.subjectClass = expansion
AND editor.session.ctlPanel.expansionAction = strand
THEN
--strange snapping
SnapWire[editor, snapX, snapY, rawCoords]
ELSE
IF editor.subjectClass = expansion
AND
NOT drawing
THEN
--snap to point
SnapToPoint[editor, rawCoords, editor.primary]
ELSE
BEGIN
IF snapX
THEN [editor.primary.x, editor.primary.cx] ← SnapToCoord[rawCoords.x, editor.subjectPic.coordsByValue[X]]
ELSE {editor.primary.x ← rawCoords.x; editor.primary.cx ← NIL};
IF snapY
THEN [editor.primary.y, editor.primary.cy] ← SnapToCoord[rawCoords.y, editor.subjectPic.coordsByValue[Y]]
ELSE {editor.primary.y ← rawCoords.y; editor.primary.cy ← NIL};
END;
NotifyBack[editor.primary, editor];
END;
SnapWire:
PROC [editor: Editor, snapX, snapY:
BOOLEAN, rawCoords: BiScrollers.ClientCoords] =
BEGIN
IF editor.secondary.point = NIL THEN {Complain[editor, " no secondary point!"]; RETURN};
IF snapX
AND snapY
THEN {
IF editor.strandGoal = NIL THEN {Complain[editor, " no strand goal!"]; RETURN};
IF editor.oldHor
THEN {
editor.primary.x ← (editor.primary.cx ← editor.secondary.cx).z;
editor.primary.y ← (editor.primary.cy ← editor.strandGoal.c[Y]).z}
ELSE {
editor.primary.x ← (editor.primary.cx ← editor.strandGoal.c[X]).z;
editor.primary.y ← (editor.primary.cy ← editor.secondary.cy).z}}
ELSE
IF snapX
THEN {
editor.primary.x ← (editor.primary.cx ← editor.secondary.cx).z;
editor.primary.y ← rawCoords.y; editor.primary.cy ← NIL}
ELSE
IF snapY
THEN {
editor.primary.x ← rawCoords.x; editor.primary.cx ← NIL;
editor.primary.y ← (editor.primary.cy ← editor.secondary.cy).z}
ELSE {
editor.primary.x ← rawCoords.x; editor.primary.cx ← NIL;
editor.primary.y ← rawCoords.y; editor.primary.cy ← NIL};
END;
SnapToPoint:
PROC [editor: Editor, rawCoords: BiScrollers.ClientCoords, back: PointBack] =
BEGIN
Nearest:
PROC [raw:
REF
ANY, r:
REF
REAL]
RETURNS [p: Point, d:
REAL] =
BEGIN
Account:
PROC [deps:
LORA] =
BEGIN
FOR deps ← deps, deps.rest
WHILE deps #
NIL
DO
WITH deps.first
SELECT
FROM
point: Point => {dx, dy, d2:
REAL;
dx ← point.c[X].z - rawCoords.x;
dy ← point.c[Y].z - rawCoords.y;
d2 ← dx*dx + dy*dy;
IF p = NIL OR d2 < d THEN {p ← point; d ← d2}};
c: Coord => NULL;
ENDCASE => ERROR;
ENDLOOP;
END;
p ← NIL;
d ← 0;
WITH raw
SELECT
FROM
c: Coord => {IF r # NIL THEN r^ ← c.z; Account[c.dependents]};
la:
LORA => {
c: Coord;
FOR l:
LORA ← la, l.rest
WHILE l #
NIL
DO
c ← NARROW[l.first];
Account[c.dependents];
ENDLOOP;
IF r # NIL THEN r^ ← c.z};
ENDCASE => ERROR;
END;
rawHi, rawLo: REF ANY;
ans: Point ← NIL;
rr^ ← rl^ ← rawCoords.x;
IF (rawHi ← editor.subjectPic.coordsByValue[
X].Lookup[rr]) #
NIL
THEN [ans,] ← Nearest[rawHi, NIL];
WHILE ans =
NIL
DO
ansLo, ansHi: Point ← NIL;
dl, dr: REAL;
rawLo ← editor.subjectPic.coordsByValue[X].LookupNextSmaller[rl];
rawHi ← editor.subjectPic.coordsByValue[X].LookupNextLarger[rr];
IF rawLo = NIL AND rawHi = NIL THEN {Complain[editor, " no points!"]; RETURN};
IF rawLo # NIL THEN [ansLo, dl] ← Nearest[rawLo, rl];
IF rawHi # NIL THEN [ansHi, dr] ← Nearest[rawHi, rr];
IF ansLo # NIL AND ansHi = NIL THEN ans ← ansLo ELSE
IF ansLo = NIL AND ansHi # NIL THEN ans ← ansHi ELSE
IF ansLo # NIL AND ansHi # NIL THEN ans ← IF dl < dr THEN ansLo ELSE ansHi;
ENDLOOP;
back.x ← (back.cx ← ans.c[X]).z;
back.y ← (back.cy ← ans.c[Y]).z;
END;
DecodeBool:
PROC [false, true:
ATOM, any:
REF
ANY]
RETURNS [
BOOL] = {
IF any = false THEN RETURN [FALSE];
IF any = true THEN RETURN [TRUE];
ERROR};
rl: REF REAL ← NEW [REAL ← 86];
rr: REF REAL ← NEW [REAL ← 47];
SnapToCoord:
PROC [raw:
REAL, table: Table]
RETURNS [nearest:
REAL, coord: Coord] =
BEGIN
l, m, h: REF ANY;
low, high: Coord;
rr^ ← raw;
[l, m, h] ← table.Lookup3[rr];
IF m # NIL THEN {coord ← PikCoord[m]; RETURN [coord.z, coord]} ELSE
IF l = NIL AND h = NIL THEN RETURN [0, NIL];
low ← PikCoord[l];
high ← PikCoord[h];
IF low = NIL THEN coord ← high ELSE
IF high = NIL THEN coord ← low ELSE
IF raw-low.z < high.z-raw THEN coord ← low
ELSE coord ← high;
nearest ← coord.z;
END;
FinalSelect:
PROC [editor: Editor, drawing:
BOOLEAN, input:
LORA]
RETURNS [output:
LORA] =
BEGIN
output ← TrackSelect[editor, drawing, input];
IF editor.primary.cx = NIL THEN editor.primary.cx ← NewCoord[X, editor.primary.x, editor.subjectPic];
IF editor.primary.cy = NIL THEN editor.primary.cy ← NewCoord[Y, editor.primary.y, editor.subjectPic];
editor.primary.point ← MakePoint[editor.subjectPic, [editor.primary.cx, editor.primary.cy]];
IF drawing THEN Draw[editor];
InputFocus.SetInputFocus[self: editor.v];
END;
MakePoint:
PROC [pic: PictureDef, vertex: Vertex, name:
ROPE ←
NIL]
RETURNS [point: Point] =
BEGIN
Try:
PROC [x: Coord]
RETURNS [found:
BOOLEAN ←
FALSE] =
BEGIN
FOR l:
LORA ← x.dependents, l.rest
WHILE l #
NIL
DO
WITH l.first
SELECT
FROM
c: Coord => NULL;
p: Point => IF p.c[Y] = vertex[Y] THEN {point ← p; RETURN [TRUE]};
ENDCASE => ERROR;
ENDLOOP;
END;
atX: REF ANY ← pic.coordsByValue[X].Lookup[vertex[X]];
WITH atX
SELECT
FROM
c: Coord => IF Try[c] THEN RETURN;
la:
LORA =>
FOR l:
LORA ← la, l.rest
WHILE l #
NIL
DO
IF Try[NARROW[l.first]] THEN RETURN;
ENDLOOP;
ENDCASE => ERROR;
IF name = NIL THEN name ← NewName[];
point ← NewPoint[pic, name, vertex];
END;
NewPoint:
PROC [pic: PictureDef, name:
ROPE, vertex: Vertex]
RETURNS [point: Point] =
BEGIN
point ← NEW [PointRep ← [c: vertex, name: name, pic: pic, dependents: NIL]];
pic.points.Insert[point];
vertex[X].dependents ← CONS[point, vertex[X].dependents];
vertex[Y].dependents ← CONS[point, vertex[Y].dependents];
END;
Draw:
PROC [editor: Editor] =
BEGIN
SELECT editor.subjectClass
FROM
icon =>
SELECT editor.session.ctlPanel.iconAction
FROM
line => [] ← NewLine[editor.subjectPic, editor.secondary.point, editor.primary.point];
text => NewText[editor.subjectPic, editor.primary.point, editor.session.ctlPanel.instance];
instance => NewInstance[editor.subjectPic, editor.primary.point, editor.session.ctlPanel.class, editor.session.ctlPanel.icon];
ENDCASE => ERROR;
expansion =>
SELECT editor.session.ctlPanel.expansionAction
FROM
component => NewComponent[editor];
port => NewPort[editor];
strand => NewStrand[editor, FALSE];
ENDCASE => ERROR;
ENDCASE => ERROR;
END;
NewComponent:
PROC [editor: Editor] =
BEGIN
cellType: CellType ← NARROW[editor.session.typesTable.Lookup[editor.session.ctlPanel.class]];
icon: PictureDef;
comp: Component;
inst: PictureInstance;
editor.session.ctlRV.DisplayMessage[ViewRec.clearMessagePlace];
IF cellType = NIL THEN {Complain[editor, "No such cell type"]; RETURN};
icon ← NARROW[cellType.icons.Lookup[editor.session.ctlPanel.icon]];
IF icon = NIL THEN {Complain[editor, "No such icon"]; RETURN};
IF editor.subjectCell.components.Lookup[editor.session.ctlPanel.instance] #
NIL
THEN {Complain[editor, "Instance name taken"]; RETURN};
inst ← CreateInstance[in: editor.subjectPic, of: icon, org: editor.primary.point];
comp ← CreateComponent[editor.subjectCell, cellType, editor.session.ctlPanel.name, inst];
END;
CreateComponent:
PROC [in, of: CellType, name:
ROPE, inst: PictureInstance]
RETURNS [comp: Component] =
BEGIN
comp ← NEW [ComponentRep ← [name: name, type: of, inst: inst]];
comp.inst.asComponent ← comp;
in.components.Insert[comp];
END;
NewPort:
PROC [editor: Editor] =
BEGIN
editor.session.ctlRV.DisplayMessage[ViewRec.clearMessagePlace];
port ← NARROW[editor.subjectCell.ports.Lookup[editor.session.ctlPanel.instance]];
IF port # NIL THEN {Complain[editor, "Name taken"]; RETURN};
[] ← CreatePort[editor.subjectCell, editor.session.ctlPanel.name, editor.primary.point];
END;
CreatePort:
PROC [cellType: CellType, name:
ROPE, point: Point]
RETURNS [port: Port] =
BEGIN
port ← NEW [PortRep ← [name: name, pt: point]];
cellType.ports.Insert[port];
END;
NewStrand:
PROC [editor: Editor, final:
BOOLEAN] =
BEGIN
strand: Line;
net: Net;
editor.session.ctlRV.DisplayMessage[ViewRec.clearMessagePlace];
IF final
THEN strand ← NewLine[editor.subjectPic, editor.primary.point, editor.strandGoal]
ELSE strand ← NewLine[editor.subjectPic, editor.secondary.point, editor.primary.point];
IF strand.a.net # NIL THEN net ← strand.a.net
ELSE IF strand.b.net # NIL THEN net ← strand.b.net
ELSE net ← NEW [NetRep ← [name: NewName[], lines: LIST[strand]]];
strand.net ← net;
IF strand.a.net # NIL AND strand.a.net # net THEN JoinNet[strand.a.net, net];
IF strand.b.net # NIL AND strand.b.net # net THEN JoinNet[strand.b.net, net];
END;
JoinNet:
PROC [from, to: Net] =
BEGIN
Process:
PROC [l:
LORA]
RETURNS [m:
LORA] = {
FOR l ← l, l.rest
WHILE l #
NIL
DO
WITH l.first
SELECT
FROM
point: Point =>
IF point.net # to
THEN
{to.midPoints ← CONS[point, to.midPoints]; point.net ← to};
line: Line =>
IF line.net # to
THEN
{to.lines ← CONS[line, to.lines]; line.net ← to};
label: Text =>
IF label.labelOf = from
THEN
{to.labels ← CONS[label, to.labels]; label.labelOf ← to;
label.rope ← to.name};
ENDCASE => ERROR;
ENDLOOP;
m ← NIL};
from.endPoints ← Process[from.endPoints];
from.midPoints ← Process[from.midPoints];
from.lines ← Process[from.lines];
from.labels ← Process[from.labels];
from.eatenBy ← to;
END;
nameCount: INT ← 0;
NewName:
PROC
RETURNS [name:
ROPE] =
{name ← IO.PutFR["z %g", IO.int[nameCount ← nameCount + 1]]};
Org:
PROC [coord: Coord]
RETURNS [z:
REAL] =
{z ←
IF coord.parent #
NIL
THEN
WITH coord.parent
SELECT
FROM
c2: Coord => c2.z,
pi: PictureInstance => pi.org.c[coord.axis].z,
ENDCASE => ERROR
ELSE 0};
NewCoord:
PROC [axis: Axis, at:
REAL, pic: PictureDef, parent:
REF
ANY ←
NIL, name:
ROPE ←
NIL]
RETURNS [new: Coord] =
BEGIN
org:
REAL ←
IF parent #
NIL
THEN
WITH parent
SELECT
FROM
coord: Coord => coord.z,
pi: PictureInstance => pi.org.c[axis].z,
ENDCASE => ERROR
ELSE 0;
IF name = NIL THEN name ← NewName[];
new ← EnsureCoord[pic, name];
new^ ← [name: new.name, pic: pic, axis: axis, z: at, sz: at, dependents: NIL, parent: parent, dz: at - org];
EntableCoord[pic.coordsByValue[axis], new];
IF parent #
NIL
THEN
WITH parent
SELECT
FROM
coord: Coord => coord.dependents ← CONS[new, coord.dependents];
pi: PictureInstance => {pi.org.c[axis].dependents ← CONS[new, pi.org.c[axis].dependents]; new.editable ← FALSE};
ENDCASE => ERROR;
END;
NewLine:
PROC [pic: PictureDef, a, b: Point]
RETURNS [line: Line] =
BEGIN
editor: Editor ← NARROW[pic.editor];
line ← NEW [LineRep ← [a: a, b: b, sa: [0, 0], sb: [0, 0]]];
pic.objects ← CONS[line, pic.objects];
a.dependents ← CONS[line, a.dependents];
b.dependents ← CONS[line, b.dependents];
IF editor # NIL THEN ViewerOps.PaintViewer[viewer: editor.v, hint: client, clearClient: FALSE, whatChanged: line];
END;
NewText:
PROC [pic: PictureDef, p: Point, rope:
ROPE] =
BEGIN
editor: Editor ← NARROW[pic.editor];
text: Text;
text ← NEW [TextRep ← [org: p, s: [0, 0], rope: rope]];
pic.objects ← CONS[text, pic.objects];
p.dependents ← CONS[text, p.dependents];
ViewerOps.PaintViewer[viewer: editor.v, hint: client, clearClient: FALSE, whatChanged: text];
END;
NewInstance:
PROC [pic: PictureDef, p: Point, className, iconName:
ROPE] =
BEGIN
editor: Editor ← NARROW[pic.editor];
ct: CellType ← NARROW[editor.session.typesTable.Lookup[className]];
def: PictureDef;
IF ct = NIL THEN {Complain[editor, "No such cellType"]; RETURN};
def ← NARROW[ct.icons.Lookup[iconName]];
IF def = NIL THEN {Complain[editor, "No such icon"]; RETURN};
[] ← CreateInstance[in: pic, of: def, org: p];
END;
CreateInstance:
PROC [in, of: PictureDef, org: Point]
RETURNS [pi: PictureInstance] =
BEGIN
AddPort:
PROC [any:
REF
ANY]
RETURNS [stop:
BOOLEAN] =
BEGIN
Do:
PROC [defCoord: Coord]
RETURNS [new: Coord] =
BEGIN
IF defCoord.exportedTo = pi
THEN
RETURN [Find[
in.coordsByValue[defCoord.axis],
defCoord.z + pi.org.c[defCoord.axis].z,
pi]];
defCoord.exportedTo ← pi;
new ← NewCoord[defCoord.axis, defCoord.z+pi.org.c[defCoord.axis].z, in, pi];
END;
pdp: PictureDefPort ← NARROW[any];
new: Vertex;
stop ← FALSE;
new[X] ← Do[pdp.point.c[X]];
new[Y] ← Do[pdp.point.c[Y]];
[] ← MakePoint[in, new];
END;
Find:
PROC [table: Table, z:
REAL, parent:
REF
ANY]
RETURNS [coord: Coord] =
BEGIN
raw: REF ANY;
rr^ ← z;
raw ← table.Lookup[rr];
WITH raw
SELECT
FROM
c: Coord => IF c.parent # parent THEN ERROR ELSE coord ← c;
la:
LORA => {
FOR l:
LORA ← la, l.rest
WHILE l #
NIL
DO
c: Coord ← NARROW[l.first];
IF c.parent = parent THEN RETURN [c];
ENDLOOP;
ERROR};
ENDCASE => ERROR;
END;
editor: Editor ← NARROW[in.editor];
pi ← EnsurePictureInstance[of, NewName[]];
pi^ ← [name: pi.name, pic: of, org: org, s: [0, 0]];
in.objects ← CONS[pi, in.objects];
org.dependents ← CONS[pi, org.dependents];
of.exports.EnumerateIncreasing[AddPort];
IF editor # NIL THEN ViewerOps.PaintViewer[viewer: editor.v, hint: client, clearClient: FALSE, whatChanged: pi];
END;
Complain:
PROC [editor: Editor, complaint:
ROPE] =
{editor.session.ctlRV.DisplayMessage[complaint]};
CreateSession:
PROC [name:
ROPE]
RETURNS [session: Session] =
BEGIN
ctl: CtlPanel ←
NEW [CtlPanelRep ← [
ReadFile: ReadFile,
WriteFile: WriteFile,
WriteAllFiles: WriteAllFiles,
CreateCellType: CreateCellType,
CreateIcon: CreateIcon,
EditType: EditType,
Export: Export,
name: "x"]];
session ←
NEW [SessionRep ← [
name: name,
typesMenu: ViewerTools.MakeNewTextViewer[info: [name: name.Cat[" Types"], iconic: FALSE]],
ctlRV: NIL,
ctlPanel: ctl,
editors: NIL,
typesTable: OrderedSymbolTableRef.CreateTable[CompareNames],
picsTable: OrderedSymbolTableRef.CreateTable[CompareNames]]];
session.ctlRV ← ViewRec.ViewRef[
agg: ctl,
specs: ViewRec.BindAllOfATypeFromRefs[rec: ctl, handle: NEW [Session ← session]],
viewerInit: [name: name.Cat[" Ctl"], iconic: FALSE]];
END;
Start:
PROC =
BEGIN
Graphics.MoveTo[primaryPath, -5, 5, TRUE];
Graphics.LineTo[primaryPath, 5, -5];
Graphics.MoveTo[primaryPath, -5, 0, FALSE];
Graphics.LineTo[primaryPath, 0, 0];
Graphics.LineTo[primaryPath, 0, -5];
Graphics.MoveTo[secondaryPath, -3, -3, TRUE];
Graphics.LineTo[secondaryPath, 3, 3];
Graphics.MoveTo[secondaryPath, 0, 3, FALSE];
Graphics.LineTo[secondaryPath, 0, 0];
Graphics.LineTo[secondaryPath, 3, 0];
END;
Start[];
END.