%%HP: T(3)A(R)F(.);
@ SUITE3D by Charles Patton
DIR

  VPAR
  DIR
    Xleft
      0
    Xright
      3
    Ynear
      0
    Yfar
      3
    Zlow
      -1
    Zhigh
      2.5
    XXleft
      0
    XXright
      3
    YYlow
      0
    YYhigh
      3
    Xe
      2.5
    Ye
      -1.5
    Ze
      2
    Nx
      13
    Ny
      8
    Hidden
      0
  END

  SlopeField
    \<< {VPAR Nx} RCL
        {VPAR Ny} RCL
        {VPAR Xleft} RCL {VPAR Xright} RCL DUP2  XRNG
        {VPAR Ynear} RCL {VPAR Yfar} RCL DUP2 YRNG
        EQ
        0 0 0 0 0 0 0
          \-> numx numy left right bot top der hstp vstp hofs vofs x y d
      \<< ERASE {# 0d # 0d } PVIEW
          right left - numx / 'hstp' STO
            top bot - numy / 'vstp' STO
            hstp .4 * 'hofs' STO
            vstp .4 * 'vofs' STO
            bot vstp 2 / + top
        FOR y
              y 'Y' STO
              left hstp 2 / +
              right
          FOR x
                x 'X' STO
                der \->NUM  'd' STO
                'IFTE(ABS(d*hofs)>vofs,vofs/d+i*vofs,hofs+i*hofs*d)' \->NUM
                x y R\->C DUP2 + 3 ROLLD SWAP - line
                hstp
          STEP
            vstp
        STEP
      \>>
      { X Y } PURGE { } PVIEW
    \>>

  psContour
    \<<         EQ
      \<< \-> dx dy 'IFTE(dy==0,MAXR,-dx/dy)' \>>
      \-> eq slp
      \<<
        IFERR eq X \.d
                eq Y \.d
                2 \->LIST
                'slp' APPLY
                { X Y } SHOW STEQ
                SlopeField
        THEN eq STEQ ERRM DOERR
        END eq STEQ
      \>>
    \>>

  YView
    \<< SetWindow 0
      \<< \-> K
        \<<
          CASE
                   K TYPE DUP 0 ==
            THEN
                   DROP X K R\->C
                     X -50 R\->C
                     DUP2 LINE TLINE
                     K
            END
                   1 ==
            THEN K
            END
                  K EVAL 1 \->LIST
                    'PRASE' APPLY
          END
        \>>
      \>> \-> Xleft Xright Ynear Yfar Xe Ye Ze Nx Ny  prase u hline
      \<< 'EQ' RCL
          'u' \-> eq u
        \<< eq { X '(X-Xe)*u+Xe' Y 'u+Ye' } |
              Ze - 'u' / Ze +
              { X u } SHOW
              COLCT
          IF prase
          THEN { & 'hline(&)' } \|vMATCH DROP
          END
          IFERR
               'EQ' STO 'X' INDEP
               ERASE
               Ynear Yfar - 8 /
               \-> stp
            \<< Yfar Ye -
                  Ynear Ye -
              FOR u
                    draw
                      IF KEY
                      THEN DROP
                      "outa here" DOERR
                      END
                      stp
              STEP
            \>>
          THEN eq STEQ ERRM DOERR
          ELSE eq STEQ
          END
            { } PVIEW
        \>>
      \>>
    \>>


  WIREFRAME
    \<<  SetWindow 0 0 0 0
          \->  Xmin Xmax Ynear Yfar Xe Ye Ze numx numy prase u v bd1 bd2
      \<< 'u' 'v' \-> u v
        \<< EQ { X v Y 'u+Ye' } |
              Ze - 'u' / Ze +
              { v u } SHOW COLCT ERASE
              { # 0d # 0d } PVIEW
              Ynear Yfar - numy /
              Xmax Xmin - numx /
              \-> eq stpu stpx
          \<< Yfar Ye -
                Ynear Ye -
            FOR u
                  0 'bd1' STO
                    Xmin 'v' STO
                    0 numx
              START
                  v Xe - u / Xe +
                    eq \->NUM R\->C
                    IF bd1
                    THEN DUP2 line
                    ELSE 1 'bd1' STO
                    END
                    IF bd2
                    THEN numx 2 + ROLL OVER line
                    END
                    stpx 'v' STO+
              NEXT
                1 'bd2' STO
                stpu
            STEP
              numx 1 + DROPN
          \>> { } PVIEW
        \>>
      \>>
    \>>

  ShapeToShade
    \<< {VPAR Xleft} RCL
        {VPAR Xright} RCL
        {VPAR Ynear} RCL
        {VPAR Yfar} RCL
          0 0 0 \-> xmin xmax ymin ymax x y eq
      \<< xmax xmin - 32 /
          ymin ymax - 15.001 /
            'x' 'y'
            \-> xstp ystp x y
        \<< EQ DUP
              X \.d .4 - 2 ^ SWAP
              Y \.d .4 + 2 ^ +
              1 + -.35 ^
              { X x Y y } | COLCT
              'eq' STO
              ERASE {# 0d # 0d } PVIEW
              # 0d
              ymax ymin
          FOR y
                # 0d
                xmin xmax
            FOR x
                  DUP2 SWAP 2 \->LIST
                    PICT SWAP
                    eq \->NUM
              IF
                  DUP TYPE 0 \=/
              THEN
                  DROP 1
              END
                    tile
                    15.99 * IP
                    DPAR SWAP 16 - NEG GET
                    REPL
                    4 +
                    xstp
            STEP
              DROP
              4 +
              ystp
          STEP DROP { } PVIEW
        \>>
      \>>
    \>>

  Movie
    \<< {VPAR Xleft} RCL {VPAR Xright} RCL XRNG
        {VPAR Zlow} RCL {VPAR Zhigh} RCL YRNG
        {VPAR Ynear} RCL {VPAR Yfar} RCL
        {VPAR Ny} RCL
        EQ
          0 0
          \->  ynear yfar numy eq ystp y
      \<< 'y' 'y' STO
          eq { X Y } SHOW
            { Y y } |
            ynear yfar - numy / 'ystp' STO
        IFERR STEQ
               'X' INDEP
               FUNCTION
               0 yfar ynear
          FOR y
                ERASE draw
                y PICT RCL ROT 2 +
            IF KEY
            THEN
                DROP "outa here"
                DOERR
            END
              ystp
          STEP
        THEN
               eq STEQ
               ERRM DOERR
        END
          eq STEQ
      \>> uSMOV
    \>>

  uSMOV
    \<< \-> n
      \<< { # 0d # 0d } PVIEW
        DO n ROLL
             n ROLL
             DUP PICT {# 0d # 0d } ROT REPL
        UNTIL KEY
        END DROP n
      \>>
    \>>

  SSTMovie
    \<<
      DO
        \-> n
        \<< n ROLL n ROLL DUP PICT
              {# 0d # 0d } ROT REPL n
              { # 0d # 0d } PVIEW
        \>>
      UNTIL 0 WAIT
            51.1 ==
      END
    \>>

  GRIDMAP
  \<< EQ PPAR VPAR Xleft Xright Ynear Yfar
        XXright XXleft YYlow YYhigh Nx Ny
      UPDIR 
      \-> eq pp X1 X2 Y1 Y2 xr1 xr2 yr1 yr2 NX NY
    \<< X2 X1 - 
        Y2 Y1 -
        \-> DX DY
      \<< eq { X 
               'X1+DX*(1+INV(NX-1))*
               (.5+(-1)^IP(NY*((1-INV(NX*NY))*TTT+.5/(NX*NY)))*
               (-.5+FP(NY*((1-INV(NX*NY))*TTT+.5/(NX*NY)))))-
               .5*(DX/(NX-1))' 
               Y 
               'Y1+DY/(NY-1)*IP(NY*((1-INV(NX*NY))*TTT+.5/(NX*NY)))'
              } | { TTT } SHOW 
           eq { X 
               'X1+DX/(NX-1)*IP(NX*((1-INV(NY*NX))*TTT+.5/(NY*NX)))' 
               Y 
               'Y1+DY*(1+INV(NY-1))*
               (.5+(-1)^IP(NX*((1-INV(NY*NX))*TTT+.5/(NY*NX)))*
               (-.5+FP(NX*((1-INV(NY*NX))*TTT+.5/(NY*NX)))))-
               .5*(DY/(NY-1))'
               } | { TTT } SHOW 
          SWAP
        IFERR { TTT 0 1 } INDEP
              PARAMETRIC 
              xr1 xr2 XRNG 
              yr1 yr2 YRNG
              NX NY * 1 - INV RES
              STEQ 
              ERASE pardraw
              STEQ pardraw 
              { } PVIEW 
              pp 'PPAR' STO eq STEQ
        THEN eq STEQ pp 'PPAR' STO 
              ERRM DOERR
        END
      \>>
    \>>
  \>>

  DPAR {
GROB 4 4 00400000
GROB 4 4 00402000
GROB 4 4 90000080
GROB 4 4 40104010
GROB 4 4 20802090
GROB 4 4 8050A010
GROB 4 4 50A05080
GROB 4 4 A050A050
GROB 4 4 50A050A0
GROB 4 4 A050A070
GROB 4 4 70A050E0
GROB 4 4 D070D060
GROB 4 4 B0E0B0E0
GROB 4 4 70D0F0B0
GROB 4 4 F0B0D0F0
GROB 4 4 F0B0F0F0 }

  EQ
    '2*(2-Y)*EXP(-((X-.5)^2+(Y-1.2)^2))+Y*EXP(-2*((X-2)^2+(Y-2)^2))'

  PPAR
    { (-2,0) (2,5) X # 8d (0,0) FUNCTION Y }

  SetWindow
    \<< PATH
        VPAR
        Xleft Xright Ynear Yfar Zlow Zhigh Xe Ye Ze Nx Ny Hidden 0
       \-> Xleft Xright Ynear Yfar Zlow Zhigh Xe Ye Ze Nx Ny Hidden Ue
       \<< EVAL
           \<< \-> u y '(u-Ue)/(y-Ye)+Ue' SWAP OVER MAX ROT ROT MIN SWAP \>>
           \-> proj
           \<< Xe 'Ue' STO
               MAXR \->NUM DUP NEG
               Xleft Ynear proj EVAL
               Xleft Yfar proj EVAL
               Xright Ynear proj EVAL
               Xright Yfar proj EVAL
               XRNG
               Ze 'Ue' STO
               MAXR \->NUM DUP NEG
               Zlow Ynear proj EVAL
               Zlow Yfar proj EVAL
               Zhigh Ynear proj EVAL
               Zhigh Yfar proj EVAL
               YRNG
           \>>
           Xleft Xright Ynear Yfar Xe Ye Ze Nx Ny Hidden
      \>>
   \>>


  draw
    DRAW

  line
    LINE

  tile
   \<< \>>

  pardraw
    DRAW

@ Begin POSTSCRIPT Stuff @

  PSTOGGLE
   \<< "PS is "
     IF 'draw' RCL 'PSDRAW' SAME
     THEN { DRAW } 1    GET DUP 'draw' STO
          'pardraw' STO 
          { LINE } 1 GET 'line'    STO
          \<<  \>> 'tile' STO
         "Off" +
     ELSE 'PSDRAW' 'draw' STO 
          'PSLINE'  'line' STO 
          'PSTILE'  'tile' STO
          'PSPARDRAW'  'pardraw' STO 
          "On" +
     END 1 DISP
   \>>
   
  PSRESET
    \<< "'PSOUT" 'PSOUT'
        DO "" SWAP STO
             "&" + DUP STR\-> DUP
          UNTIL VTYPE -1 ==
          END
          DROP2 'PSOUT' 'CURRENTOUT' STO
    \>>

  PSTILE
    \<< DUP \->STR
        " g
"
          + 5 PICK B\->R
          DUP 4 + \->STR " " +
          SWAP \->STR " " +
          8 PICK # 64d SWAP - B\->R
          DUP 4 - \->STR
          " " + SWAP \->STR " " +
          \-> X2 X1 Y1 Y2
      \<< X2 + Y1 +
"m
"
      + X2 + Y2 +
"L
"
      + X1 + Y2 +
"L
"
      + X1 + Y1 +
"L
"
      + X2 + Y1 +
"L
f
"
      +
      \>> PSADDTO
    \>>

  PSADDTO
    \<<
      IF CURRENTOUT SIZE 4000 >
      THEN 'CURRENTOUT' RCL \->STR
           1 OVER SIZE 1 - SUB "&" + STR\->
             DUP 'CURRENTOUT' STO STO
      ELSE
           'CURRENTOUT' RCL SWAP STO+
      END
    \>>

  CURRENTOUT
    PSOUT

  PSCOPAIR
    \<< 'PPAR(1)' EVAL DUP
        'PPAR(2)' EVAL SWAP -
          \-> p1 p2 o d
      \<< p2 o - C\->R
          d C\->R ROT SWAP / 64 *
            ROT ROT / 131 *
            p1 o - C\->R d C\->R
            ROT SWAP / 64 *
            ROT ROT / 131 *
      \>> \-> y2 x2 y1 x1
      \<< x1 \->STR " " +
          y1 \->STR " " + +
            x2 \->STR " " + +
            y2 \->STR " " + +
            x2 x1 - x2 + \->STR " " +
            y2 y1 - y2 + \->STR " " + +
      \>>
    \>>

  PSDRAW
    \<< PPAR OBJ\-> 4 DROPN
        0 0
          \-> hm vm indp rs flop \Gdx
      \<<
        IF rs TYPE 10 ==
        THEN rs # 0d 2 \->LIST PX\->C hm - RE
        ELSE
          IF rs 0 ==
          THEN { # 1d # 0d } PX\->C hm - RE
          ELSE rs
          END
        END
          3 / '\Gdx' STO
          'EQ' RCL 'vm' STO
        \<< \-> vl
          \<< vl \->NUM
                indp \->NUM
                \-> vlu indv
            \<<
              IF flop
              THEN indv \Gdx - vl indp \.d \->NUM
                     \Gdx *
                       vlu SWAP - R\->C
                       'indp+vl*i' \->NUM PSCOPAIR
                       3 ROLLD + "c
"
                     +
                       PSADDTO
              ELSE
                     'indp+vl*i' \->NUM
                       PSCO "m
"
                   +
                       indv \Gdx +
                       vl indp \.d \->NUM
                       \Gdx * vlu + R\->C PSCO +
                       1 'flop' STO
              END
                vlu
            \>>
          \>>
        \>> 'hm' STO
        IFERR vm {& 'hm(QUOTE(&))' } \|vMATCH DROP STEQ
                DRAW vm STEQ
        THEN vm STEQ ERRM DOERR
        END "S
"
        PSADDTO
      \>>
    \>>

  PSPARDRAW
    \<< 'PPAR(3)' EVAL OBJ\-> DROP 'PPAR(4)' EVAL 0 0
        \->indp hm vm rs flop \Gdx
      \<<
        IF rs 0 ==
        THEN # 1d 'rs' STO
        END
        IF rs TYPE 10 ==
        THEN rs B\->R 131 / vm hm - *
        ELSE rs
        END 3 / '\Gdx' STO 'EQ' RCL 'vm' STO
        \<< \-> vl
          \<< vl \->NUM indp \->NUM
              \-> vlu indv
            \<<
              IF flop
              THEN vl indp \.d \->NUM \Gdx * vlu SWAP - (0,0) + vlu (0,0) +
                   PSCOPAIR 3 ROLLD +
"c
"                  + PSADDTO
              ELSE vlu (0,0) + PSCO
"m
"
                   + vl indp \.d \->NUM \Gdx * vlu + (0,0) + PSCO +
                    1 'flop' STO
              END
              vlu
            \>>
          \>>
        \>> 'hm' STO
        IFERR vm { & 'hm(QUOTE(&))' } \|vMATCH DROP STEQ
              DRAW vm STEQ
        THEN vm STEQ ERRM DOERR
        END
"S
"
        PSADDTO
      \>>
    \>>

  PSCO
    \<< 'PPAR(1)' EVAL - C\->R
        'PPAR(2)-PPAR(1)' EVAL C\->R
          ROT SWAP / 64 *
          ROT ROT / 131 * \->STR
          " " + SWAP \->STR
          " " + +
    \>>

  PSLINE
    \<< \-> C1 C2
      \<< C1 PSCO
"m
"
          + C2 PSCO +
"l
S
"
          + PSADDTO
            C1 C2 LINE
      \>>
    \>>

  derMOD
    \<< \-> K L DK DL 'DK'    \>>
  derIP
    \<< \-> K DK '0'   \>>
  derIM
    \<< \-> K DK 'IM(DK)'   \>>
  derRE
    \<< \-> K DK 'RE(DK)'   \>>

  PSOUT
   ""
  PSOUT&
   ""
  PSOUT&&
   ""
  PSOUT&&&
   ""
  PSOUT&&&&
   ""
  PSOUT&&&&&
   ""
  PSOUT&&&&&&
   ""
END

