extra/springies/ui/ui.factor

   1
   2 USING: kernel namespaces threads sequences math math.vectors
   3        opengl.gl opengl colors ui ui.gadgets ui.gadgets.slate
   4        fry rewrite-closures vars springies accessors math.geometry.rect ;
   5
   6 IN: springies.ui
   7
   8 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   9
  10 : draw-node ( node -- ) pos>> { -5 -5 } v+ [ { 10 10 } gl-rect ] with-translation ;
  11
  12 : draw-spring ( spring -- )
  13   [ node-a>> pos>> ] [ node-b>> pos>> ] bi gl-line ;
  14
  15 : draw-nodes ( -- ) nodes> [ draw-node ] each ;
  16
  17 : draw-springs ( -- ) springs> [ draw-spring ] each ;
  18
  19 : set-projection ( -- )
  20   GL_PROJECTION glMatrixMode
  21   glLoadIdentity
  22   0 world-width 1- 0 world-height 1- -1 1 glOrtho
  23   GL_MODELVIEW glMatrixMode
  24   glLoadIdentity ;
  25
  26 ! : display ( -- ) set-projection black gl-color draw-nodes draw-springs ;
  27
  28 : display ( -- ) set-projection black gl-color draw-nodes draw-springs ;
  29
  30 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  31
  32 VAR: slate
  33
  34 VAR: loop
  35
  36 : update-world-size ( -- ) slate> rect-dim >world-size ;
  37
  38 : refresh-slate ( -- ) slate> relayout-1 ;
  39
  40 DEFER: maybe-loop
  41
  42 : run ( -- )
  43   update-world-size
  44   iterate-system
  45   refresh-slate
  46   yield
  47   maybe-loop ;
  48
  49 : maybe-loop ( -- ) loop> [ run ] when ;
  50
  51 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  52
  53 : springies-window* ( -- )
  54
  55   C[ display ] <slate>
  56     { 800 600 } >>pdim
  57     C[ { 500 500 } >world-size loop on [ run ] in-thread ] >>graft
  58     C[ loop off ] >>ungraft
  59   [ >slate ] [ "Springies" open-window ] bi ;
  60
  61 : springies-window ( -- ) [ [ springies-window* ] with-scope ] with-ui ;
  62
  63 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  64
  65 : go* ( quot -- ) '[ [ springies-window* 1000 sleep @ ] with-scope ] with-ui ;