steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Make automata-gadget and add keyboard interface

darcs
wayo.cavazos 2006-10-23 21:33:35 +00:00
parent edf6129157
commit 6d5b94ed6c
1 changed files with 42 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
contrib/automata.factor
View File

@ -1,6 +1,7 @@
REQUIRES: contrib/vars contrib/slate contrib/lindenmayer/opengl ; REQUIRES: contrib/vars contrib/slate contrib/lindenmayer/opengl ;
USING: kernel namespaces hashtables sequences math arrays opengl gadgets USING: kernel namespaces hashtables sequences generic math arrays
threads opengl gadgets
vars slate opengl-contrib ; vars slate opengl-contrib ;
IN: automata IN: automata
@ -91,6 +92,8 @@ dup peek 1array swap dup first 1array append append ;
: mild ( -- seq ) : mild ( -- seq )
{ 6 9 11 57 62 74 118 } ; { 6 9 11 57 62 74 118 } ;
: set-interesting ( -- ) interesting random-item set-rule ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
VAR: bitmap VAR: bitmap
@ -123,13 +126,45 @@ GL_COLOR_BUFFER_BIT glClear black gl-color bitmap> draw-bitmap ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: init-slate ( -- ) : init-slate ( -- )
<slate> >slate <slate> >slate namespace slate> set-slate-ns [ display ] >action ;
namespace slate> set-slate-ns
[ display ] >action
slate> "Automata" open-titled-window ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: init ( -- ) init-rule init-slate ; : init ( -- ) init-rule init-slate ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
VAR: loop-flag
DEFER: loop
: (loop) ( -- ) run-rule 3000 sleep loop ;
: loop ( -- ) loop-flag> [ (loop) ] [ ] if ;
: start-loop ( -- ) t >loop-flag [ loop ] in-thread ;
: stop-loop ( -- ) f >loop-flag ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TUPLE: automata-gadget ;
C: automata-gadget ( -- automata-gadget )
init
slate> over set-delegate
interesting random-item set-rule ;
: automata-window ( -- ) <automata-gadget> "Automata" open-titled-window ;
automata-gadget H{
{ T{ key-down f f "1" } [ slate-ns [ start-center ] bind ] }
{ T{ key-down f f "2" } [ slate-ns [ start-random ] bind ] }
{ T{ key-down f f "3" } [ slate-ns [ run-rule ] bind ] }
{ T{ key-down f f "5" }
[ slate-ns [ set-interesting start-center ] bind ] }
{ T{ key-down f f "9" } [ slate-ns [ start-loop ] bind ] }
{ T{ key-down f f "0" } [ slate-ns [ stop-loop ] bind ] }
} set-gestures
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
PROVIDE: contrib/automata ; PROVIDE: contrib/automata ;