(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