extra/ui/gadgets/slate/slate.factor

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