%%HP: T(3)A(R)F(.);
DIR

  VPAR
  DIR
    Xleft
      0
    Xright
      3
    Ynear
      0
    Yfar
      3
    Zlow
      -1
    Zhigh
      2.5
    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
	\>>
      \>>
    \>>

  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 }

  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
    \>>

  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
   \<< \>>

@ Begin POSTSCRIPT Stuff @

  PSTOGGLE
    \<< "PS is "
	IF 'draw' RCL 'PSDRAW' SAME
	THEN {DRAW} 1 GET 'draw' STO
	     {LINE} 1 GET 'line' STO
	     \<<\>> 'tile' STO "Off" +
	ELSE 'PSDRAW' 'draw' STO
	     'PSLINE' 'line' STO
	     'PSTILE' 'tile' 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
      \>>
    \>>

  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
      \>>
    \>>

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