78 lines
1.8 KiB
Forth
Executable File
78 lines
1.8 KiB
Forth
Executable File
\ 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:
|