extra/ui/gadgets/slate/slate.factor

   1
   2 USING: kernel namespaces opengl ui.render ui.gadgets accessors ;
   3
   4 IN: ui.gadgets.slate
   5
   6 TUPLE: slate < gadget action pdim graft ungraft ;
   7
   8 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   9
  10 : init-slate ( slate -- slate )
  11   init-gadget
  12   [ ]         >>action
  13   { 200 200 } >>pdim
  14   [ ]         >>graft
  15   [ ]         >>ungraft ;
  16
  17 : <slate> ( action -- slate )
  18   slate new
  19     init-slate
  20     swap >>action ;
  21
  22 M: slate pref-dim* ( slate -- dim ) pdim>> ;
  23
  24 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  25
  26 USING: combinators arrays sequences math math.geometry
  27        opengl.gl ui.gadgets.worlds ;
  28
  29 : screen-y* ( gadget -- loc )
  30   {
  31     [ find-world height ]
  32     [ screen-loc second ]
  33     [ height ]
  34   }
  35   cleave
  36   + - ;
  37
  38 : screen-loc* ( gadget -- loc )
  39   {
  40     [ screen-loc first ]
  41     [ screen-y* ]
  42   }
  43   cleave
  44   2array ;
  45
  46 : setup-viewport ( gadget -- gadget )
  47   dup
  48   {
  49     [ screen-loc* ]
  50     [ dim>>       ]
  51   }
  52   cleave
  53   gl-viewport ;
  54
  55 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  56
  57 : default-coordinate-system ( gadget -- gadget )
  58   dup
  59   {
  60     [ drop 0 ]
  61     [ width 1 - ]
  62     [ height 1 - ]
  63     [ drop 0 ]
  64   }
  65   cleave
  66   -1 1
  67   glOrtho ;
  68
  69 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  70
  71 M: slate graft*   ( slate -- ) graft>>   call ;
  72 M: slate ungraft* ( slate -- ) ungraft>> call ;
  73
  74 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  75
  76 GENERIC: establish-coordinate-system ( gadget -- gadget )
  77
  78 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  79
  80 M: slate establish-coordinate-system ( slate -- slate )
  81    default-coordinate-system ;
  82
  83 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  84
  85 GENERIC: draw-slate ( slate -- slate )
  86
  87 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  88
  89 M: slate draw-slate ( slate -- slate ) dup action>> call ;
  90
  91 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  92
  93 M: slate draw-gadget* ( slate -- )
  94
  95    GL_PROJECTION glMatrixMode glPushMatrix glLoadIdentity
  96
  97    establish-coordinate-system
  98
  99    GL_MODELVIEW glMatrixMode glPushMatrix glLoadIdentity
 100
 101    setup-viewport
 102
 103    draw-slate
 104
 105    GL_PROJECTION glMatrixMode glPopMatrix glLoadIdentity
 106    GL_MODELVIEW  glMatrixMode glPopMatrix glLoadIdentity
 107
 108    dup
 109    find-world
 110    ! The world coordinate system is a little wacky:
 111    dup { [ drop 0 ] [ width ] [ height ] [ drop 0 ] } cleave -1 1 glOrtho
 112    setup-viewport
 113    drop
 114    drop ;
 115
 116 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!