101 lines
		
	
	
		
			2.6 KiB
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			101 lines
		
	
	
		
			2.6 KiB
		
	
	
	
		
			Factor
		
	
	
 | 
						|
USING: kernel namespaces math quotations arrays hashtables sequences threads
 | 
						|
       opengl
 | 
						|
       opengl.gl
 | 
						|
       colors
 | 
						|
       ui
 | 
						|
       ui.gestures
 | 
						|
       ui.gadgets
 | 
						|
       ui.gadgets.slate
 | 
						|
       ui.gadgets.labels
 | 
						|
       ui.gadgets.buttons
 | 
						|
       ui.gadgets.frames
 | 
						|
       ui.gadgets.packs
 | 
						|
       ui.gadgets.grids
 | 
						|
       ui.gadgets.theme
 | 
						|
       ui.gadgets.handler
 | 
						|
       accessors
 | 
						|
       vars fry
 | 
						|
       rewrite-closures automata math.geometry.rect newfx ;
 | 
						|
 | 
						|
IN: automata.ui
 | 
						|
 | 
						|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 | 
						|
 | 
						|
: draw-point ( y x value -- ) 1 = [ swap glVertex2i ] [ 2drop ] if ;
 | 
						|
 | 
						|
: draw-line ( y line -- ) 0 swap [ [ 2dup ] dip draw-point 1+ ] each 2drop ;
 | 
						|
 | 
						|
: (draw-bitmap) ( bitmap -- ) 0 swap [ [ dup ] dip draw-line 1+ ] each drop ;
 | 
						|
 | 
						|
: draw-bitmap ( bitmap -- ) GL_POINTS glBegin (draw-bitmap) glEnd ;
 | 
						|
 | 
						|
: display ( -- ) black gl-color bitmap> draw-bitmap ;
 | 
						|
 | 
						|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 | 
						|
 | 
						|
VAR: slate
 | 
						|
 | 
						|
! Call a 'model' quotation with the current 'view'.
 | 
						|
 | 
						|
: with-view ( quot -- )
 | 
						|
  slate> rect-dim first >width
 | 
						|
  slate> rect-dim second >height
 | 
						|
  call
 | 
						|
  slate> relayout-1 ;
 | 
						|
 | 
						|
! Create a quotation that is appropriate for buttons and gesture handler.
 | 
						|
 | 
						|
: view-action ( quot -- quot ) '[ drop _ with-view ] closed-quot ;
 | 
						|
 | 
						|
: view-button ( label quot -- button ) [ <label> ] dip view-action <bevel-button> ;
 | 
						|
 | 
						|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 | 
						|
 | 
						|
! Helper word to make things less verbose
 | 
						|
 | 
						|
: random-rule ( -- ) set-interesting start-center ;
 | 
						|
 | 
						|
DEFER: automata-window
 | 
						|
 | 
						|
: automata-window* ( -- )
 | 
						|
  init-rule
 | 
						|
  set-interesting
 | 
						|
 | 
						|
  <frame>
 | 
						|
 | 
						|
    <shelf>
 | 
						|
 | 
						|
      "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 } >>pdim
 | 
						|
    dup >slate
 | 
						|
 | 
						|
    @center grid-add
 | 
						|
 | 
						|
  <handler>
 | 
						|
 | 
						|
  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
 | 
						|
 | 
						|
  >>table
 | 
						|
 | 
						|
  "Automata" open-window ;
 | 
						|
 | 
						|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 | 
						|
 | 
						|
: automata-window ( -- ) [ [ automata-window* ] with-scope ] with-ui ;
 | 
						|
 | 
						|
MAIN: automata-window
 |