extra/ui/gadgets/slate/slate.factor

   1 ! Copyright (C) 2009 Eduardo Cavazos
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 USING: accessors arrays combinators kernel math opengl opengl.gl
   5 sequences ui.gadgets ui.gadgets.worlds ui.render ;
   6
   7 IN: ui.gadgets.slate
   8
   9 TUPLE: slate < gadget action pdim graft ungraft ;
  10
  11 : init-slate ( slate -- slate )
  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 : width ( rect -- w ) dim>> first ;
  25
  26 : height ( rect -- h ) dim>> second ;
  27
  28 : screen-y* ( gadget -- loc )
  29     [ find-world height ] [ screen-loc second ] [ height ] tri + - ;
  30
  31 : screen-loc* ( gadget -- loc )
  32     [ screen-loc first ] [ screen-y* ] bi 2array ;
  33
  34 : setup-viewport ( gadget -- gadget )
  35     dup { [ screen-loc* ] [ dim>> ] } cleave gl-viewport ;
  36
  37 : default-coordinate-system ( gadget -- gadget )
  38     dup {
  39         [ drop 0 ] [ width 1 - ] [ height 1 - ] [ drop 0 ]
  40     } cleave -1 1 glOrtho ;
  41
  42 M: slate graft* graft>> call( -- ) ;
  43
  44 M: slate ungraft* ungraft>> call( -- ) ;
  45
  46 GENERIC: establish-coordinate-system ( gadget -- gadget )
  47
  48 M: slate establish-coordinate-system default-coordinate-system ;
  49
  50 GENERIC: draw-slate ( slate -- slate )
  51
  52 M: slate draw-slate dup action>> call( slate -- slate ) ;
  53
  54 M: slate draw-gadget* ( slate -- )
  55
  56    GL_PROJECTION glMatrixMode glPushMatrix glLoadIdentity
  57
  58    establish-coordinate-system
  59
  60    GL_MODELVIEW glMatrixMode glPushMatrix glLoadIdentity
  61
  62    setup-viewport
  63
  64    draw-slate
  65
  66    GL_PROJECTION glMatrixMode glPopMatrix glLoadIdentity
  67    GL_MODELVIEW  glMatrixMode glPopMatrix glLoadIdentity
  68
  69    dup
  70    find-world
  71    ! The world coordinate system is a little wacky:
  72    dup { [ drop 0 ] [ width ] [ height ] [ drop 0 ] } cleave -1 1 glOrtho
  73    setup-viewport
  74    drop
  75    drop ;