(ObjectEdit.JaM) =
(December 9, 1982 10:28 am) = % Michael Plass
% Written by John Warnock
%This file contains the commands that capture all graphics commands with parameters and
%store the commands in an Array (Display List).

(ObjectEditJaM) .loadbcd

%MakeOb enables a dictionary that captures all graphics commands.

(MakeOb)
 {$makeob .begin (nextindex) 0 .def}.cvx .def

%StopOb ends the MakeOb context (if it is in the MakeOb context) and returns an
%Array representing all the graphics commands on the stack.

(StopOb)
 {(No corresponding "makeob")=}.cvx .def

%DrawOb takes an array constructed with MakeOb and StopOb, and executes it.

(DrawOb)
 {.pushdc .dup pushOb .cvx .exec popOb .popdc}.cvx .def

%pushOb, popOb, topOb support DrawOb

(pushOb)
 {(obIndex) obIndex 1 .add .store obArray .exch obIndex .exch .aput}.cvx .def

(popOb)
 {(obIndex) obIndex 1 .sub .store}.cvx .def
 
(topOb)
 {obArray obIndex .aget }.cvx .def

(obArray)
 .dup .where .not {20 .array .store}.cvx{.pop .pop}.cvx .ifelse

(obIndex)
 0 .def
 
(olderase)(.erase) .load .def
(.erase){.pushdc .true .setopaque olderase .popdc}.cvx .def

(greyEdit){.false .setopaque 0 0 .5 .hsvcolor EditObject}.cvx .def

%begin dictionary that will hold all the graphics definitions

($makeob) .dup .where .not {128 .dict .store}.cvx{.pop .pop}.cvx .ifelse

(graphicsdict) (.initdc) .where {.def}.cvx{(No graphics loaded)= .end}.cvx .ifelse
graphicsdict (DrawOb) .dup .load .put
$makeob .begin

(StopOb)
 {(at) nextindex .array .def
 0 1 nextindex 1 .sub {.dup temparray .exch .aget at 3 1 .roll .aput}.cvx .for at .end}.cvx .def

(MakeOb)
 {(makeob is illegal here "makeob" in progress)=}.cvx .def


(save)
 {app apc agp 1 .sub -1 0 {.index putparam}.cvx .for aglc putparam agc .exec}.cvx .def

(saveg)
 {app apc agp 1 .sub -1 0 {.index putparam}.cvx .for aglc putparam agc
 .end .exec $makeob .begin}.cvx .def

(savep)
 {app apc agp 1 .sub -2 0 {putpoint}.cvx .for aglc putparam agc .exec}.cvx .def

(savet)
 {app apc agp 1 .sub -2 0 {puttrans}.cvx .for aglc putparam agc .exec}.cvx .def

(putpoint)
 {nextindex (ni) .exch .def .dup 1 .add .index putparam 1 .sub .index putparam ni putparam
 (pointname) .load .cvx putparam}.cvx .def

(puttrans)
 {nextindex (ni) .exch .def .dup 1 .add .index putparam 1 .sub .index putparam ni putparam
 (transname) .load .cvx putparam}.cvx .def

(app)
 {local .exch 0 .exch .aput }.cvx .def %puts parameter count in local.

(apc)
 {0 .aget local .exch 1 .exch .aput }.cvx .def %puts command in local.

(agp)
 {local 0 .aget }.cvx .def %gets parameter count.

(aglc)
 {local 1 .aget }.cvx .def %gets the definition of command.

(agc)
 {local 1 .aget graphicsdict .exch .get }.cvx .def %gets the definition of command.

(local) 2 .array .def

(temparray)
.dup .where .not {2000 .array .store}.cvx{.pop .pop}.cvx .ifelse

(nextindex)
0 .def

(putparam)
 {temparray .exch nextindex .exch .aput (nextindex) nextindex 1 .add .store}.cvx .def


(.initdc)  {{.initdc} 0 save}.cvx .def
(.pushdc)  {{.pushdc} 0 save}.cvx .def
(.popdc)  {{.popdc} 0 save}.cvx .def
(.setview)  { }.cvx .def
(.translate)  {{.translate} 2 savet}.cvx .def
(.scale)   {{.scale} 2 save}.cvx .def
(.rotate)   {{.rotate} 1 save}.cvx .def
(.sixpoint)  {{.sixpoint} 6 save}.cvx .def
(.concat)  { }.cvx .def
(.setpos)  {{.setpos} 2 save}.cvx .def
(.moveto)  {{.moveto} 2 savep}.cvx .def
(.movetonext){{.movetonext} 2 savep}.cvx .def
(.rmoveto)  {{.rmoveto} 2 savep}.cvx .def
(.drawto)  {{.drawto} 2 savep}.cvx .def
(.rdrawto)  {{.rdrawto} 2 savep}.cvx .def
(.drawbox)  {{.drawbox} 4 savep}.cvx .def
(.cover)  { }.cvx .def
(.setinvert)  {{.setinvert} 1 save}.cvx .def
(.setfat)   {{.setfat} 1 save}.cvx .def
(.setopaque) {{.setopaque} 1 save}.cvx .def
(.erase)   {{.erase} 0 save}.cvx .def
(.setfont)  {{.setfont} 1 save}.cvx .def
(.drawcchar) {{.drawcchar} 1 save}.cvx .def
(.drawcstring){{.drawcstring} 1 save}.cvx .def
(.drawchar) {{.drawchar} 1 save}.cvx .def
(.drawtext)  {{.drawtext} 1 save}.cvx .def
(.charbox)  { }.cvx .def
(.textbox)  { }.cvx .def
(.initboxer)  { }.cvx .def
(.stopboxer) { }.cvx .def
(.pushbox)  { }.cvx .def
(.popbox)  { }.cvx .def
(.knot)   {{.knot} 2 savep}.cvx .def
(.spline)  {{.spline} 0 save}.cvx .def
(.cspline)  {{.cspline} 0 save}.cvx .def
(.cliparea) {{.cliparea} 0 save}.cvx .def
(.clipbox)  {{.clipbox} 0 save}.cvx .def
(.clipeoarea) {{.clipeoarea} 0 save}.cvx .def
(.clipxarea)  {{.clipxarea} 0 save}.cvx .def
(.clipxbox)  {{.clipxbox} 0 save}.cvx .def
(.lineto)  {{.lineto} 2 savep}.cvx .def
(.curveto)  {{.curveto} 6 savep}.cvx .def
(.rect)   {{.rect} 4 savep}.cvx .def
(.drawarea)  {{.drawarea} 0 save}.cvx .def
(.draweoarea) {{.draweoarea} 0 save}.cvx .def
(.drawpath) {{.drawpath} 1 save}.cvx .def
(.drawstroke) {{.drawstroke} 2 save}.cvx .def
(.drawstrokeclosed) {{.drawstrokeclosed} 1 save}.cvx .def
(.bitmap)  { }.cvx .def
(.getymode) { }.cvx .def
(.setymode) { }.cvx .def
(.settarget)  { }.cvx .def
(.hsvcolor) {{.hsvcolor} 3 save}.cvx .def
(DrawOb) {{DrawOb} 1 saveg}.cvx .def
.end

%TextOb takes an array an constructs the equivalent text program from the Object.

(TextOb)
 {.mark .exch
 ({ ) .print {.dup .type $atypes .exch .get .exec}.cvx .arrayforall ( }) = .clrtomrk }.cvx .def

($atypes) .dup .where .not {20 .dict .store}.cvx{.pop .pop}.cvx .ifelse
($pntnames) .dup .where .not {20 .dict .store}.cvx{.pop .pop}.cvx .ifelse

$pntnames .begin
 (point) {}.cvx .def
 (trans) {}.cvx .def
.end

$atypes .begin
 (.nulltype) {.pop /cr}.cvx .def
 (.integertype){}.cvx .def
 (.realtype) {}.cvx .def
 (.booleantype){PrintSp}.cvx .def
 (.nametype) {.dup $pntnames .exch .known {.pop .pop}.cvx {.cvlit (cname) .exch .store
     DumpStk cname =}.cvx .ifelse}.cvx .def
 (.stringtype) {/lp .print /rp /cr}.cvx .def
 (.streamtype) {.pop /cr}.cvx .def
 (.commandtype){.commandname PrintSp}.cvx .def
 (.arraytype) {({) .print TextOb (}) =}.cvx .def
 (.marktype) {.pop /cr}.cvx .def
 (.exectype) {.pop /cr}.cvx .def
 (.looptype) {.pop /cr}.cvx .def
 (.scopetype) {.scopename =}.cvx .def
.end

(PrintSp)
 {( ).cvis .print ( ) .print}.cvx .def
 
(DumpStk)
 {.cnttomrk 1 .sub -1 0 {.index PrintSp}.cvx .for .cnttomrk {.pop}.cvx .rept}.cvx .def
 

%The following routines are for editing objects that have been constructed.

%EditObject accepts an array (constructed with MakeOb and StopOb) on the stack
 %The yellow button selects a point the red button moves it.
 
(EditObject)
 {(eobj) .exch .def
 (editInstance) NIL .def
 (obIndex) 0 .store
 (instance) 0 .def
 (point) (pointshow) .load .def
 (trans) (transshow) .load .def
 eobj DrawOb
 ButtonsDef}.cvx .def

(SetView)
 {.touch 2 .copy .screencoords .pop .touch .screencoords .pop .exch .sub 590 .exch .div .dup .scale
 .neg .exch .neg .exch .translate
 (point) (pointshow).load .store
 .erase eobj DrawOb}.cvx .def
 
(Horizontal)
 {OldButtonsDef
 (teditPoint) editPoint .def
 .touch FindNearest
 (hzy) yMin .def
 .touch FindNearest
 (hzx) xMin .def
 hzx hzy PointUpdate
 ButtonsDef}.cvx .def
 
(Vertical)
 {OldButtonsDef
 (teditPoint) editPoint .def
 .touch FindNearest
 (vtx) xMin .def
 .touch FindNearest
 (vty) yMin .def
 vtx vty PointUpdate
 ButtonsDef}.cvx .def
 
%Congruent takes four touches and moves the last point touched so that its distance
% from the third point is equal to the distance between the first two points.

(Congruent)
 {OldButtonsDef
 (teditPoint) editPoint .def
 .touch FindNearest
 (cgx1) xMin .def (cgy1) yMin .def
 .touch FindNearest
 (cgx2) xMin .def (cgy2) yMin .def
 .touch FindNearest
 (cgx3) xMin .def (cgy3) yMin .def
 .touch FindNearest
 (cgx4) xMin .def (cgy4) yMin .def
 cgx2 cgy2 cgx1 cgy1 v2sub v2mag (cgs).exch .store
 cgx4 cgy4 cgx3 cgy3 v2sub v2norm cgs v2scale cgx3 cgy3 v2add PointUpdate
 ButtonsDef}.cvx .def
 
%Split takes four touches and moves 2nd and last point touched so that the distances
% between the third and fourth is equal to the distance between the first two points.

(Split)
 {OldButtonsDef
 (teditPoint) editPoint .def
 .touch FindNearest
 (cgx1) xMin .def (cgy1) yMin .def
 .touch FindNearest
 (cgx2) xMin .def (cgy2) yMin .def
 (cgedloc) editLoc .def (cgedin) editInstance .def (cgmnob) minObject .def
 .touch FindNearest
 (cgx3) xMin .def (cgy3) yMin .def
 .touch FindNearest
 (cgx4) xMin .def (cgy4) yMin .def
 cgx2 cgy2 cgx1 cgy1 v2sub v2mag (cgs1).exch .store
 cgx4 cgy4 cgx3 cgy3 v2sub v2mag (cgs2) .exch .store
 cgs1 cgs2 .add 2. .div (cgs) .exch .def
 cgx4 cgy4 cgx3 cgy3 v2sub v2norm cgs v2scale cgx3 cgy3 v2add PointUpdate
 (xMin) cgx2 .def (yMin) cgy2 .def
 (editLoc) cgedloc .def (editInstance) cgedin .def (minObject) cgmnob .def
 cgx2 cgy2 cgx1 cgy1 v2sub v2norm cgs v2scale cgx1 cgy1 v2add PointUpdate
 ButtonsDef}.cvx .def
 
 
(PrintPoint)
 {editPoint .dup 0 .aget PrintSp 1 .aget =}.cvx .def

(StorePoint)
 {editPoint .exch 1 .exch .aput
 editPoint .exch 0 .exch .aput}.cvx .def



(MinDist)
{2 .copy !eox !eoy v2sub v2mag .dup mindist .lt
 { (mindist) .exch .def
  (minLoc) loc .def  
  (minInstance) instance .def
  (minObject) topOb .def
  (yMin) .exch .def (xMin) .exch .def}.cvx
 {.pop .pop .pop}.cvx
 .ifelse }.cvx .def

(v2add)
 {3 -1 .roll .exch .add 3 1 .roll .add .exch} .cvx .def

(v2sub)
 {3 -1 .roll .exch .sub 3 1 .roll .sub .exch} .cvx .def

(v2mag)
 {.dup .mul .exch .dup .mul .add .sqrt}.cvx .def

(v2neg)
 {.neg .exch .neg .exch}.cvx .def

(v2scale)
 {.dup v2mul}.cvx .def

(v2mul)
 {3 -1 .roll .mul 3 1 .roll .mul .exch} .cvx .def

(v2norm)
 {v2dup v2mag .dup 3 1 .roll .div 3 1 .roll .div .exch}.cvx .def

(v2dup)
 {2 .copy} .cvx .def
 

(crosstoken)
 {.pushdc .translate
 0 0 0 .hsvcolor
 0 4 .usercoords 0 0 .usercoords v2sub 2 .copy .setpos v2neg .drawto
 4 0 .usercoords 0 0 .usercoords v2sub 2 .copy .setpos v2neg .drawto
 -1 -1 .usercoords 0 0 .usercoords v2sub 2 .copy v2neg .drawbox
 .popdc}.cvx .def

(BumpInstance)
 {(instance) instance 1 .add .store}.cvx .def
 
(pointtest)
 {(loc) .exch .def 2 .copy .screencoords MinDist BumpInstance}.cvx .def

(pointshow)
 {(myLoc) .exch .store
 editInstance instance .eq {.pop .pop !eox !eoy .usercoords 2 .copy editPoint .astore .pop
 firstInstance {(redraw) .true .store}.cvx .if}.cvx .if
 2 .copy .dottoken BumpInstance myLoc editLoc .eq {(firstInstance) .true .def}.cvx .if }.cvx .def

(pointnil)
 {.pop}.cvx .def

(pointname)
 {point} 0 .aget .cvlit .def

(transtest)
 {(loc) .exch .def 2 .copy .screencoords MinDist BumpInstance}.cvx .def

(transshow)
 {(myLoc) .exch .store
 editInstance instance .eq {.pop .pop !eox !eoy .usercoords 2 .copy editPoint .astore .pop
 firstInstance {(redraw) .true .store}.cvx .if}.cvx .if
 2 .copy crosstoken BumpInstance myLoc editLoc .eq {(firstInstance) .true .def}.cvx .if }.cvx .def

(transnil)
 {.pop}.cvx .def

(transname)
 {trans} 0 .aget .cvlit .def

(NIL)
 20000 .def
 
%The following definitions enable the editing functions:
 %the Red button controls the moving of points.
 %the Yellow button selects a point.
 
(ButtonsDef)
 {(editPoint) editPointArray .def %initialize editPoint.
 (.redup){.screencoords PointUpdate}.cvx .def
 (.yellowup){FindNearest}.cvx .def
(.blueup){.pop .pop OldButtonsDef
   (point) (pointnil) .load .def
   (trans) (transnil) .load .def
   .erase
   eobj DrawOb
   (editPoint) editPointArray .def
   (editInstance) NIL .store
   (editLoc) NIL .store
   (eobj) nilObject .store }.cvx .def
}.cvx .def

(OldButtonsDef)
 {(.reddown){.pop .pop}.cvx .def
 (.redup){.pop .pop}.cvx .def
 (.yellowdown){.pop .pop}.cvx .def
 (.yellowup){.pop .pop}.cvx .def
 (.blueup){.pop .pop}.cvx .def
 (.bluedown){.pop .pop}.cvx .def
 }.cvx .def

(!eox)
 0 .def
(!eoy)
 0 .def

(editPointArray)
  [ 0 0 ] .def % initial value of editPoint

%The following are useful utilities
(FindNearest)
 {.screencoords (!eoy) .exch .store (!eox) .exch .store
 (point)(pointtest).load .def
 (trans)(transtest).load .def
 (mindist) 10000 .def
 (instance) 0 .def
 eobj DrawOb
 (editLoc) minLoc .def
 (editInstance) minInstance .def
 minObject minLoc 2 .subarray (editPoint) .exch .def
 (point)(pointnil).load .def
 (trans)(transnil).load .def
  }.cvx .def

(PointUpdate)
 {(!eoy) .exch .store (!eox) .exch .store
(instance) 0 .store
(firstInstance) .false .store
(redraw) .false .store
.erase
(point) (pointshow) .load .def
(trans) (transshow) .load .def
 eobj DrawOb
redraw {.erase eobj DrawOb}.cvx .if  
}.cvx .def
  
(point)
 (pointnil) .load .def
  
(trans)
 (transnil) .load .def

(editLoc)
 NIL .def

(minLoc)
 NIL .def

(minInstance)
 NIL .def

(nilObject)
 [ ] .def