arcus

( Pascal's triangle)

\ after finishing writing this, it occurs to me it might not be good
\ practice to assume the stack will hold nothing but a line of
\ pascal's triangle in make_pascal.  Could be obviated by using
\ copystack prior to making the triangle, although this is perhaps a
\ bit cumbersome. 

: copystack  ( n1 n2 ...  -- addr )
    ( unfortunately returns the stack in the reverse order - doesn't
    matter for pascal's triangle as the lines are symmetric ) 
    depth here dup >r
    over over !
    1 cells + swap ( ... here+ depth ) 
    dup 1+ cells allot  ( ... here+ depth)    
    cells over + swap 
    do i !
      1 cells +loop
    r> ; 
    

: movestackback ( addr -- n1 n2 ...)
    dup @ ( addr length )
    swap 1 cells + swap 
    cells over + swap
    do
	i @
    1 cells +loop ;
	
: pascaline ( addr -- pascaline )
    ( generates a line of pascal's triangle from the line stored at addr )
    0 swap 
    dup @ ( 0 addr length)
    swap 1 cells + swap
    cells over + swap
    do
	i @ dup -rot + swap
    1 cells +loop ;
    	
    
: make_pascal ( n -- addr )
    here >r 1 swap 1-
    0 do
	copystack
	pascaline loop
    copystack drop r> here ;

: print_array ( start -- finish )
    ( arrays assumed to have the length prepended to the data ) 
    dup @ ( start length )
    swap 1 cells + swap ( start+ length ) 
    cells over + dup rot
    do
	i @ .
    1 cells +loop
    cr ; 

: print_arrays ( start finish -- )
    swap cr
    begin
	print_array
	over over <=
    until  drop drop ; 

: output_triangle ( n -- )
    here >r
    make_pascal
    print_arrays
    r> here - allot ;