2 USING: kernel math math.parser random arrays hashtables assocs sequences
7 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
9 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
11 VAR: rule VAR: rule-number
13 : init-rule ( -- ) 8 <hashtable> >rule ;
15 : rule-keys ( -- array )
25 : rule-values ( n -- seq ) >bin 8 CHAR: 0 pad-head string>digits ;
28 dup >rule-number rule-values rule-keys [ rule> set-at ] 2each ;
30 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
33 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
35 : pattern>state ( {_a_b_c_} -- state ) rule> at ;
37 : cap-line ( line -- 0-line-0 ) { 0 } prepend { 0 } append ;
39 : wrap-line ( a-line-z -- za-line-za )
40 dup peek 1array swap dup first 1array append append ;
42 : step-line ( line -- new-line ) 3 <clumps> [ pattern>state ] map ;
44 : step-capped-line ( line -- new-line ) cap-line step-line ;
45 : step-wrapped-line ( line -- new-line ) wrap-line step-line ;
47 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
51 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
53 : random-line ( -- line ) width> [ drop 2 random ] map ;
55 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
57 : center-i ( -- i ) width> 2 / >fixnum ;
59 : center-line ( -- line ) center-i width> [ = 1 0 ? ] with map ;
61 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
63 : interesting ( -- seq )
64 { 18 22 26 30 41 45 54 60 73 75 82 86 89 90 97 101 102 105 106 107 109
65 110 120 121 122 124 126 129 137 146 147 149 150 151 153 154 161 165 } ;
67 : mild ( -- seq ) { 6 9 11 57 62 74 118 } ;
69 : set-interesting ( -- ) interesting random set-rule ;
71 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
78 last-line> height> [ drop step-capped-line dup ] map >bitmap >last-line ;
80 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
82 : start-random ( -- ) random-line >last-line run-rule ;
84 : start-center ( -- ) center-line >last-line run-rule ;
86 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
92 ! : (loop) ( -- ) run-rule 3000 sleep loop ;
94 ! : loop ( -- ) loop-flag> [ (loop) ] [ ] if ;
96 ! : start-loop ( -- ) t >loop-flag [ loop ] in-thread ;
98 ! : stop-loop ( -- ) f >loop-flag ;