Plotify v2

(
PLOTIFY

A very silly sample FORTH vocabulary which provides a means to plot graphs in a
standard terminal.

Examples:

\ Plot axis
t-green xy-axis

\ y = x
t-red s" x" x-loop-equation xy-home

\ x = y
t-green s" y fnegate" y-loop-equation xy-home

\ y = sin x
t-blue s" x fsin" x-loop-equation xy-home

\ y = x^2 - 10
t-magenta s" x 2e f** 10e f-" x-loop-equation xy-home
)

\ TERMINAL CONTROL

    \ Standard ASCII Codes (not comprehensive)

        \ Emits a bell
        : t-bel 7 emit ;

        \ Emits a backspace
        : t-bs 8 emit ;

        \ Emits a tab
        : t-tab 9 emit ;

        \ Emits a line feed
        : t-lf 10 emit ;

        \ Emits a vertical tab
        : t-tab-v 11 emit ;

        \ Emits a form feed
        : t-ff 12 emit ;

        \ Emits a carriage return
        : t-cr 13 emit ;

        \ Emits an escape
        : t-esc 27 emit ;

        \ Emits a delete
        : t-del 127 emit ;

    \ Control Sequence Introducer (CSI) commands (not comprehensive)

        \ Emit CSI
        : t-csi ( -- ) t-esc '[' emit ;

        \ Returns cursor to top left
        : t-home ( -- ) t-csi 'H' emit ;

        \ Places cursor at the requested column and row
        : t-at ( col row -- ) t-csi .nb ';' emit .nb 'H' emit ;

        \ Erase from cursor until end of screen
        : t-cleol ( -- ) t-csi ." J" ;

        \ Clear the entire screen and move cursor to top left
        : t-cls ( -- ) t-csi ." 2J" t-home ;

        \ Sets cursor to default foreground
        : t-default t-csi ." 0;0m" ;

        \ Sets foreground color to black
        : t-red t-csi ." 0;30m" ;

        \ Sets foreground color to red
        : t-red t-csi ." 0;31m" ;

        \ Sets foreground color to green
        : t-green t-csi ." 0;32m" ;

        \ Sets foreground color to yellow
        : t-yellow t-csi ." 0;33m" ;

        \ Sets foreground color to blue
        : t-blue t-csi ." 0;34m" ;

        \ Sets foreground color to magenta
        : t-magenta t-csi ." 0;35m" ;

        \ Sets foreground color to cyan
        : t-cyan t-csi ." 0;36m" ;

        \ Sets foreground color to white
        : t-white t-csi ." 0;37m" ;

        \ Sets background color to black
        : t-red-bg t-csi ." 0;40m" ;

        \ Sets background color to red
        : t-red-bg t-csi ." 0;41m" ;

        \ Sets background color to green
        : t-green-bg t-csi ." 0;42m" ;

        \ Sets background color to yellow
        : t-yellow-bg t-csi ." 0;43m" ;

        \ Sets background color to blue
        : t-blue-bg t-csi ." 0;44m" ;

        \ Sets background color to magenta
        : t-magenta-bg t-csi ." 0;45m" ;

        \ Sets background color to cyan
        : t-cyan-bg t-csi ." 0;46m" ;

        \ Sets background color to white
        : t-white-bg t-csi ." 0;47m" ;

        \ Set custom foreground
        : t-rgb-fg ( r g b -- ) t-csi ." 38;2;" rot .nb ';' emit swap .nb ';' emit .nb 'm' emit ;

        \ Set custom background
        : t-rgb-bg ( r g b -- ) t-csi ." 48;2;" rot .nb ';' emit swap .nb ';' emit .nb 'm' emit ;

        \ Provides the terminal width
        : t-width ( -- cols ) cols ;

        \ Provides the terminal height
        : t-height ( -- rows ) rows ;

        \ Save the terminal position
        : t-save ( -- ) t-csi ." s" ;

        \ Returns position to previously saved
        : t-restore ( -- ) t-csi ." u" ;


\ GENERAL PURPOSE WORDS

    \ Negative pi for convenience
    : -pi ( -- F: -pi ) pi fnegate ;

    \ Order the top 2 ints on the stack such that the lowest value is tos
    : max-min ( a b -- a b | b a ) 2dup > if swap endif ;

    \ Duplicate the top two floats on the float stack
    : f2dup ( F: a F: b -- F: a F: b F: a F: b ) fover fover ;

    \ Order the top 2 floats on the stack such that the lowest value is tos
    : fmax-min ( F: a F: b -- F: a F: b | F: b F: a ) f2dup f> if fswap endif ;

    \ Create and assign a new variable
    : var! ( r "name" -- ) create , does> ;

    \ Create and assign a new float variable
    : fvar! ( r "name" -- ) create f, does> ;

    \ Check if value is between lower and upper inclusive
    : between ( value lower upper -- bool ) 2 pick >= swap rot <= and ;

    \ Check if x,y is in 2d range
    : in-range ( x y x-low x-up y-low y-up -- x y bool ) 4 pick -rot between -rot 4 pick -rot between and ;

    \ Obtain a random number
    2345 value seed0
    6789 value seed1

    : rand ( -- u )
        seed0
        seed1 to seed0
        dup 13 lshift xor
        dup 17 rshift xor
        dup 5 lshift xor
        dup seed1 xor to seed1
    ;

    \ Debug stack
    : .sd ( -- ) cr .s ;

    \ Debug float stack
    : f.sd ( -- ) cr f.s ;

\ GRAPH PLOTTING

    \ We'll use the following variables to define the ranges of x and y and specify
    \ the current plot character
    -10e fvar! x-lower
    10e  fvar! x-upper
    -10e fvar! y-lower
    10e  fvar! y-upper
    '*'  var!  xy-symbol

    \ Graphs are drawn in all but the last 5 rows of the terminal
    : xy-height ( -- rows ) t-height 5 - ;

    \ Returns the usable width of the terminal
    : xy-width ( -- cols ) t-width ;

    \ Places cursor below graph after rendering
    : xy-home ( -- ) 0 xy-height t-at t-default t-cleol ;

    \ Allows us to redefine the range of x
    : x-range ( F: lower F: upper -- ) x-upper f! x-lower f! ;

    \ Allows us to redefine the range of y
    : y-range ( F: lower F: upper -- ) y-upper f! y-lower f! ;

    \ Allows us to change the character plotted
    : set-xy-symbol ( char -- ) xy-symbol ! ;

    \ Determines the floating point increment of x
    : x-increment x-upper f@ x-lower f@ f- xy-width s>f f/ ;

    \ Determines the floating point increment of y
    : y-increment y-upper f@ y-lower f@ f- xy-height s>f f/ ;

    \ Determines the number of terminal columns covered by the value r
    : r-to-cols x-increment f/ fround f>s ;

    \ Maps x value to column
    : x-to-col ( F: x -- column ) x-lower f@ f- x-increment f/ fround f>s ;

    \ Maps y value to column
    : y-to-row ( F: y -- row ) y-lower f@ f- y-increment f/ fround f>s ;

    \ Determines if the given column and row are in the range of the graphs width and height
    : col-row-in-range ( col row -- col row bool ) 0 xy-width 0 xy-height in-range ;

    \ Render xy-symbol at col,row
    : col-row-at
        col-row-in-range
        if
            xy-height swap - t-at xy-symbol @ xemit
        else
            2drop
        endif
    ;

    \ Render associated to x,y
    : xy-plot
        y-lower f@ f- y-increment f/ xy-height s>f fswap f- fswap
        x-lower f@ f- x-increment f/
        f>s f>s col-row-at
    ;

    \ Map incoming col to x
    : col-to-x ( col -- F: x ) s>f x-increment f* x-lower f@ f+ ;

    \ Map incoming row to y
    : row-to-y ( row -- F: y ) s>f y-increment f* y-lower f@ f+ ;

    \ Create an equation
    : x-create-equation ( "equation" -- xt ) s" :noname { F: x } " 2swap s+ s"  ;" s+ evaluate ;

    \ Invoke x-equation for each x
    : x-loop-equation
        ( "equation" -- ) x-create-equation { equation }
        xy-width 0 do
            i col-to-x equation execute i y-to-row col-row-at
        loop
    ;

    \ Plots coordinates of equation
    : x-loop ( "equation" -- ) x-loop-equation xy-home ;

    \ Create an y-equation
    : y-create-equation ( "equation" -- xt ) s" :noname { F: y } " 2swap s+ s"  ;" s+ evaluate ;

    \ Invoke y-equation for each y
    : y-loop-equation ( "equation" -- )
        ( "equation" -- ) y-create-equation { equation }
        xy-height 0
        do
            i row-to-y equation execute x-to-col i col-row-at
        loop
    ;

    \ Plots coordinates of equation
    : y-loop ( "equation" -- ) y-loop-equation xy-home ;

    \ Draws the axis
    : xy-axis
        t-cls
        xy-symbol @
        '-' xy-symbol !
        s" 0e" x-loop-equation
        '|' xy-symbol !
        s" 0e" y-loop-equation
        xy-symbol !
        xy-home
    ;