basis/ui/gadgets/grid-lines/grid-lines.factor

   1 ! Copyright (C) 2006, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel accessors math namespaces opengl opengl.gl
   4 sequences math.vectors ui.gadgets ui.gadgets.grids ui.render
   5 math.geometry.rect fry ;
   6 IN: ui.gadgets.grid-lines
   7
   8 TUPLE: grid-lines color ;
   9
  10 C: <grid-lines> grid-lines
  11
  12 SYMBOL: grid-dim
  13
  14 : half-gap ( -- gap ) grid get gap>> [ 2/ ] map ; inline
  15
  16 : grid-line-from/to ( orientation point -- from to )
  17     half-gap v- swap
  18     [ [ half-gap ] 2dip set-axis ]
  19     [ [ grid-dim get ] 2dip set-axis ] 2bi ;
  20
  21 : draw-grid-lines ( gaps orientation -- )
  22     [ grid get swap grid-positions grid get dim>> suffix ] dip
  23     [ '[ _ v- ] map ] keep
  24     '[ _ swap grid-line-from/to gl-line ] each ;
  25
  26 M: grid-lines draw-boundary
  27     color>> gl-color [
  28         [ grid set ]
  29         [ dim>> half-gap v- grid-dim set ]
  30         [ compute-grid ] tri
  31         [ { 1 0 } draw-grid-lines ]
  32         [ { 0 1 } draw-grid-lines ]
  33         bi*
  34     ] with-scope ;