automata.ui: new automata-window*
							parent
							
								
									2374b4293d
								
							
						
					
					
						commit
						5decac30d2
					
				| 
						 | 
				
			
			@ -14,13 +14,25 @@ USING: kernel namespaces math quotations arrays hashtables sequences threads
 | 
			
		|||
       ui.gadgets.packs
 | 
			
		||||
       ui.gadgets.grids
 | 
			
		||||
       ui.gadgets.theme
 | 
			
		||||
       accessors
 | 
			
		||||
       qualified
 | 
			
		||||
       namespaces.lib assocs.lib vars
 | 
			
		||||
       rewrite-closures automata math.geometry.rect ;
 | 
			
		||||
       rewrite-closures automata math.geometry.rect newfx ;
 | 
			
		||||
 | 
			
		||||
IN: automata.ui
 | 
			
		||||
 | 
			
		||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 | 
			
		||||
 | 
			
		||||
QUALIFIED: ui.gadgets
 | 
			
		||||
QUALIFIED: ui.gadgets.grids
 | 
			
		||||
 | 
			
		||||
: add-gadget ( parent child -- parent ) over ui.gadgets:add-gadget ;
 | 
			
		||||
 | 
			
		||||
: grid-add ( grid child i j -- grid )
 | 
			
		||||
  >r >r dupd swap r> r> ui.gadgets.grids:grid-add ;
 | 
			
		||||
 | 
			
		||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 | 
			
		||||
 | 
			
		||||
: draw-point ( y x value -- ) 1 = [ swap glVertex2i ] [ 2drop ] if ;
 | 
			
		||||
 | 
			
		||||
: draw-line ( y line -- ) 0 swap [ >r 2dup r> draw-point 1+ ] each 2drop ;
 | 
			
		||||
| 
						 | 
				
			
			@ -57,29 +69,40 @@ slate> relayout-1 ;
 | 
			
		|||
 | 
			
		||||
DEFER: automata-window
 | 
			
		||||
 | 
			
		||||
: automata-window* ( -- ) init-rule set-interesting <frame>
 | 
			
		||||
: automata-window* ( -- )
 | 
			
		||||
  init-rule
 | 
			
		||||
  set-interesting
 | 
			
		||||
 | 
			
		||||
{
 | 
			
		||||
[ "1 - Center"      [ start-center    ] view-button ]
 | 
			
		||||
[ "2 - Random"      [ start-random    ] view-button ]
 | 
			
		||||
[ "3 - Continue"    [ run-rule        ] view-button ]
 | 
			
		||||
[ "5 - Random Rule" [ random-rule     ] view-button ]
 | 
			
		||||
[ "n - New"         [ automata-window ] view-button ]
 | 
			
		||||
} make*
 | 
			
		||||
[ [ gadget, ] curry ] map concat ! Hack
 | 
			
		||||
make-shelf over @top grid-add
 | 
			
		||||
  <frame>
 | 
			
		||||
 | 
			
		||||
[ display ] closed-quot <slate> { 400 400 } over set-slate-dim dup >slate
 | 
			
		||||
over @center grid-add
 | 
			
		||||
    <shelf>
 | 
			
		||||
 | 
			
		||||
{
 | 
			
		||||
{ T{ key-down f f "1" } [ [ start-center    ] view-action ] }
 | 
			
		||||
{ T{ key-down f f "2" } [ [ start-random    ] view-action ] }
 | 
			
		||||
{ T{ key-down f f "3" } [ [ run-rule        ] view-action ] }
 | 
			
		||||
{ T{ key-down f f "5" } [ [ random-rule     ] view-action ] }
 | 
			
		||||
{ T{ key-down f f "n" } [ [ automata-window ] view-action ] }
 | 
			
		||||
} [ make* ] map >hashtable <handler> tuck set-gadget-delegate
 | 
			
		||||
"Automata" open-window ;
 | 
			
		||||
      "1 - Center"      [ start-center    ] view-button add-gadget
 | 
			
		||||
      "2 - Random"      [ start-random    ] view-button add-gadget
 | 
			
		||||
      "3 - Continue"    [ run-rule        ] view-button add-gadget
 | 
			
		||||
      "5 - Random Rule" [ random-rule     ] view-button add-gadget
 | 
			
		||||
      "n - New"         [ automata-window ] view-button add-gadget
 | 
			
		||||
 | 
			
		||||
    @top grid-add
 | 
			
		||||
 | 
			
		||||
    C[ display ] <slate>
 | 
			
		||||
      { 400 400 } >>dim
 | 
			
		||||
    dup >slate
 | 
			
		||||
 | 
			
		||||
    @center grid-add
 | 
			
		||||
 | 
			
		||||
  H{ }
 | 
			
		||||
    T{ key-down f f "1" } [ start-center    ] view-action is
 | 
			
		||||
    T{ key-down f f "2" } [ start-random    ] view-action is
 | 
			
		||||
    T{ key-down f f "3" } [ run-rule        ] view-action is
 | 
			
		||||
    T{ key-down f f "5" } [ random-rule     ] view-action is
 | 
			
		||||
    T{ key-down f f "n" } [ automata-window ] view-action is
 | 
			
		||||
 | 
			
		||||
  <handler>
 | 
			
		||||
 | 
			
		||||
    tuck set-gadget-delegate
 | 
			
		||||
 | 
			
		||||
  "Automata" open-window ;
 | 
			
		||||
 | 
			
		||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue