Minor improvements to contrib/x11/examples/automata.factor

diff --git a/contrib/x11/examples/automata.factor b/contrib/x11/examples/automata.factor
index 2dff41f9007ed944e56bc1466afe87b738d164ba..64fd037efeed2f6bbd9e348a541f644b754a89af 100644 (file)
--- a/contrib/x11/examples/automata.factor
+++ b/contrib/x11/examples/automata.factor
@@ -6,7 +6,7 @@
 !   USE: automata setup-window random-gallery
 
 USING: parser kernel hashtables namespaces sequences lists math io
-math-contrib threads strings arrays prettyprint xlib x ;
+math-contrib threads strings arrays prettyprint x11 x ;
 
 IN: automata
 
@@ -14,31 +14,21 @@ IN: automata
 ! set-rule
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-SYMBOL: rule
+SYMBOL: rule   8 <hashtable> rule set-global
 
-8 <hashtable> rule set-global
-
-SYMBOL: char-0
+: rule-keys ( -- { ... } )
+{ { 0 0 0 }
+  { 0 0 1 }
+  { 0 1 0 }
+  { 0 1 1 }
+  { 1 0 0 }
+  { 1 0 1 }
+  { 1 1 0 }
+  { 1 1 1 } } ;
 
-48 char-0 set-global
+: rule-values ( n -- { ... } ) >bin 8 CHAR: 0 pad-left >array [ 48 - ] map ;
 
-: rule-keys ( -- { ... } )
-  { { 0 0 0 }
-    { 0 0 1 }
-    { 0 1 0 }
-    { 0 1 1 }
-    { 1 0 0 }
-    { 1 0 1 }
-    { 1 1 0 }
-    { 1 1 1 } } ;
-
-: rule-values ( n -- { ... } )
-  >bin 8 char-0 get pad-left
-  >array
-  [ 48 - ] map ;
-
-: set-rule ( n -- )
-  rule-values rule-keys [ rule get set-hash ] 2each ;
+: set-rule ( n -- ) rule-values rule-keys [ rule get set-hash ] 2each ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! step
@@ -46,65 +36,67 @@ SYMBOL: char-0
 
 : 3nth ( n seq -- slice ) >r dup 3 + r> <slice> ;
 
-: next-chunk ( << slice: a b c >>  - value )
-  >array rule get hash ;
+: next-chunk ( << slice: a b c >>  - value ) >array rule get hash ;
+
+: (step) ( line -- new-line ) dup length 2 - [ swap 3nth next-chunk ] map-with ;
 
-: (step) ( line -- new-line )
-  dup length 2 - [ swap 3nth next-chunk ] map-with ;
+: step-line ( line -- new-line ) >r { 0 } r> { 0 } append append (step) ;
 
-: step-line ( line -- new-line )
-  >r { 0 } r> { 0 } append append
-  (step) ;
+: last ( seq -- item ) dup length 1 - swap nth ;
+
+: step-line-wrapped ( line -- new-line )
+dup last 1array swap dup first 1array append append (step) ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! Display the rule
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-! SYMBOL: win
-
-: setup-window
-  f initialize-x
-  create-window win set
-  { 400 400 } resize-window
-  map-window
-  flush-dpy ;
+: setup-window ( -- )
+f initialize-x create-window win set
+{ 400 400 } resize-window map-window flush-dpy ;
 
-: random-line ( -- line )
-  0 400 <range>
-  [ drop 2 random-int ]
-  map ;
+: random-line ( -- line ) window-width [ drop 2 random-int ] map ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! show-line
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: show-point ( { x y } p -- )
-1 = [ draw-point ] [ drop ] if ;
+: show-point ( { x y } p -- ) 1 = [ draw-point ] [ drop ] if ;
 
-: (show-line) ( { x y } line -- )
-  [ >r dup r> show-point { 1 0 } v+ ] each drop ;
+: (show-line) ( { x y } line -- ) [ >r dup r> show-point { 1 0 } v+ ] each drop ;
 
-: show-line ( y line -- )
-  >r >r 0 r> 2array r> (show-line) ;
+: show-line ( y line -- ) >r >r 0 r> 2array r> (show-line) ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! Go
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: run-rule
-  clear-window
-  0 random-line
-  400
-  [ drop
-    2dup show-line >r
-    1 +
-    r> step-line ] each
-  flush-dpy ;
-
-: random-gallery
-  255 random-int 1 +
-  dup unparse print flush
-  set-rule
-  run-rule
-  5000 sleep
-  random-gallery ;
+: run-rule ( -- last-line ) clear-window
+0 random-line window-height [ drop 2dup show-line >r 1 + r> step-line ] each nip
+flush-dpy ;
+
+: run-rule-wrapped ( -- last-line ) clear-window
+0 random-line 400 [ drop 2dup show-line >r 1 + r> step-line-wrapped ] each nip
+flush-dpy ;
+
+: continue-rule ( first-line -- last-line ) clear-window
+0 swap 400 [ drop 2dup show-line swap 1 + swap step-line ] each nip
+flush-dpy ;
+
+: continue-rule-wrapped ( first-line -- last-line ) clear-window
+0 swap 400 [ drop 2dup show-line swap 1 + swap step-line-wrapped ] each nip
+flush-dpy ;
+
+: random-gallery ( -- )
+255 random-int 1 + dup unparse print flush
+set-rule run-rule 5000 sleep random-gallery ;
+
+SYMBOL: interesting
+
+{ 150 193 165 146 144 86 104 } interesting set-global
+
+: random-item ( seq -- item ) dup length random-int swap nth ;
+
+: random-interesting-gallery ( -- )
+interesting get random-item set-rule run-rule drop 10000 sleep
+random-interesting-gallery ;