\ 3dplot.4th - Forth source file template
\
\ Copyright 2015 David Meyer <papa@sdf.org> +JMJ
\ 
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\ 
\     http://www.apache.org/licenses/LICENSE-2.0
\ 
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.

\ Print 2-D graph of 3-D function:
\
\     z = f(x,y) = A * exp ((x**2 + y**2) / D) + B*y + C 
\
\ Ported from Creative Computing BASIC Games Collection

20 constant PLOTLINES
10 constant PLOTSECTS

PLOTLINES 2 / s>d d>f fconstant RADIUS

: header ( -- ) 25 spaces ." 3DPLOT / SLOTS" cr ;

: line>x ( u -- r ) PLOTLINES 2 / - s>d d>f ;

: col>y ( u -- r ) PLOTSECTS 2 / - s>d d>f ;

: x>upr-hemi ( rx -- ry ) fdup f* RADIUS fdup f* fswap f- fsqrt ; 

: x>low-hemi ( rx -- ry ) x>upr-hemi fnegate ; 

: xy>z ( rx ry -- rz ) fdrop fdrop 0e0 ;

: 3dplot ( -- )
    header cr
    PLOTLINES 0 ?do
	PLOTSECTS 0 ?do
	    2 spaces [char] * emit
\	    i col>y j line>x x>low-hemi f<
\	    i col>y j line>x x>upr-hemi f> or if
\		3 spaces
\	    else
\		2 spaces [char] * emit
\	    then
	loop
	cr
    loop
		
	    
\    20 1 u+do
\	i 11 - dup * 100 swap -
\	s>d d>f fsqrt 2e0 f*
\	f>d d>s
\	dup 20 swap - spaces
\	2* 0 u+do
\	    [char] * emit 
\	loop
\	cr
\    loop
;

\ Main **************************************************************

cr
3dplot 
bye

\ Emacs control *****************************************************
\Local variables:
\mode: forth
\End: