%%HP: T(3)A(R)F(.);
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
    \>>

  PARSURFACE
  \<< SetWindow 3 DROPN  EQ
      \-> xe ye ze  eq
      \<< 4 DROPN eq LIST\-> DROP
          SWAP ye - SWAP ze - OVER / ze + 'i' * 
          ROT xe -  ROT /  xe + +
          IFERR
            STEQ
            0 dogridmap
          THEN eq STEQ ERRM DOERR
          ELSE eq STEQ
          END
      \>>
  \>>

  GRIDMAP
 \<< 1 dogridmap \>>

  dogridmap
  \<< EQ PPAR VPAR XXright XXleft YYlow YYhigh
          Xleft Xright Ynear Yfar Nx Ny
      UPDIR 
      \-> setrng 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 
              IF setrng
              THEN
              xr1 xr2 XRNG 
              yr1 yr2 YRNG
              END
              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
      \>>
    \>>

  derFP
    \<< \-> K DK 'DK'    \>>
  derIP
    \<< \-> K DK '0'   \>>
  derIM
    \<< \-> K DK 'IM(DK)'   \>>
  derRE
    \<< \-> K DK 'RE(DK)'   \>>

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