Concatenative topics
Concatenative meta
Other languages
Meta
The Sierpinski triangle of order 4 should look like this:
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
( uxncli sierpinski.rom ) |100 @on-reset ( -> ) #10 STHk #01 SUB &ver ( -- ) DUP #00 EQUk ?{ &pad ( -- ) #2018 DEO INC GTHk ?&pad } POP #00 &fill ANDk #202a ROT ?{ SWP } POP #18 DEO #2018 DEO INC ADDk STHkr LTH ?&fill POP2 #0a18 DEO #01 SUB DUP #ff NEQ ?&ver POP POPr BRK
:N 16; N [ dup (y) [' .c] dotimes (print padding) N [ dup (x) over2 drop 1- (y' = y - 1) swap N !- (x' = N - x) & (x' & y') \' \'* ifte .c ' .c ] (print * or space) dotimes .nl] dotimes
: plot ( i j -- ) bitand zero? "* " " " ? write ; : pad ( n -- ) 1 - [ " " write ] times ; : plot-row ( n -- ) dup 1 + [ tuck - plot ] with each-integer ; : sierpinski ( n -- ) dup '[ _ over - pad plot-row nl ] each-integer ;
vocab each_int: define helper<+P> (Int32, Int32, (Int32 -> +P) -> +P): -> n, i, f ; if (i < n): i f call n (i + 1) f helper define each_int<+P> (Int32, (Int32 -> +P) -> +P): zero swap each_int::helper define with_arg<R1..., R2..., T, A, B, S..., +P2, +P1>(R1..., T, B, (R2..., T, A -> S... +P2) -> R1..., B, (R2..., A -> S... +P1) +P1): {swap} dip {{swap} dip call} apply apply define plot (Int32, Int32 -> +IO): (&) zero (=) if {"* " print} else {" " print} define over<A, B> (A, B -> A, B, A): -> a, b; a b a define tuck<A, B> (A, B -> B, A, B): swap over define times<+P> (Int32, (-> +P) -> +P): {drop} swap compose each_int define pad (Int32 -> +IO): 1 (-) {" " print} times define plot_row (Int32 -> +IO): dup 1 (+) {tuck (-) plot} with_arg each_int define sierpinski (Int32 -> +IO): dup {over (-) pad plot_row "\n" print} apply each_int 16 sierpinski
This revision created on Thu, 7 Mar 2024 23:48:52 by CapitalEx (Add Kitten and Factor)