extra/automata/ui/ui.factor

   1
   2 USING: kernel namespaces math quotations arrays hashtables sequences threads
   3        opengl
   4        opengl.gl
   5        colors
   6        ui
   7        ui.gestures
   8        ui.gadgets
   9        ui.gadgets.slate
  10        ui.gadgets.labels
  11        ui.gadgets.buttons
  12        ui.gadgets.frames
  13        ui.gadgets.packs
  14        ui.gadgets.grids
  15        ui.gadgets.theme
  16        ui.gadgets.handler
  17        accessors
  18        vars fry
  19        rewrite-closures automata math.geometry.rect newfx ;
  20
  21 IN: automata.ui
  22
  23 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  24
  25 : draw-point ( y x value -- ) 1 = [ swap glVertex2i ] [ 2drop ] if ;
  26
  27 : draw-line ( y line -- ) 0 swap [ [ 2dup ] dip draw-point 1+ ] each 2drop ;
  28
  29 : (draw-bitmap) ( bitmap -- ) 0 swap [ [ dup ] dip draw-line 1+ ] each drop ;
  30
  31 : draw-bitmap ( bitmap -- ) GL_POINTS glBegin (draw-bitmap) glEnd ;
  32
  33 : display ( -- ) black gl-color bitmap> draw-bitmap ;
  34
  35 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  36
  37 VAR: slate
  38
  39 ! Call a 'model' quotation with the current 'view'.
  40
  41 : with-view ( quot -- )
  42   slate> rect-dim first >width
  43   slate> rect-dim second >height
  44   call
  45   slate> relayout-1 ;
  46
  47 ! Create a quotation that is appropriate for buttons and gesture handler.
  48
  49 : view-action ( quot -- quot ) '[ drop _ with-view ] closed-quot ;
  50
  51 : view-button ( label quot -- button ) [ <label> ] dip view-action <bevel-button> ;
  52
  53 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  54
  55 ! Helper word to make things less verbose
  56
  57 : random-rule ( -- ) set-interesting start-center ;
  58
  59 DEFER: automata-window
  60
  61 : automata-window* ( -- )
  62   init-rule
  63   set-interesting
  64
  65   <frame>
  66
  67     <shelf>
  68
  69       "1 - Center"      [ start-center    ] view-button add-gadget
  70       "2 - Random"      [ start-random    ] view-button add-gadget
  71       "3 - Continue"    [ run-rule        ] view-button add-gadget
  72       "5 - Random Rule" [ random-rule     ] view-button add-gadget
  73       "n - New"         [ automata-window ] view-button add-gadget
  74
  75     @top grid-add
  76
  77     C[ display ] <slate>
  78       { 400 400 } >>pdim
  79     dup >slate
  80
  81     @center grid-add
  82
  83   <handler>
  84
  85   H{ }
  86     T{ key-down f f "1" } [ start-center    ] view-action is
  87     T{ key-down f f "2" } [ start-random    ] view-action is
  88     T{ key-down f f "3" } [ run-rule        ] view-action is
  89     T{ key-down f f "5" } [ random-rule     ] view-action is
  90     T{ key-down f f "n" } [ automata-window ] view-action is
  91
  92   >>table
  93
  94   "Automata" open-window ;
  95
  96 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  97
  98 : automata-window ( -- ) [ [ automata-window* ] with-scope ] with-ui ;
  99
 100 MAIN: automata-window