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.pens ui.gadgets ui.gadgets.grids
   5 ui.gadgets.grids.private ui.render math.rectangles
   6 fry locals arrays assocs ;
   7 IN: ui.gadgets.grid-lines
   8
   9 TUPLE: grid-lines color ;
  10
  11 C: <grid-lines> grid-lines
  12
  13 <PRIVATE
  14
  15 :: (compute-grid-lines) ( grid n ns orientation -- seq )
  16     grid gap>> :> gap
  17     ns n suffix gap orientation v. '[ _ - orientation n*v ] map
  18     dup grid dim>> gap v- orientation reverse [ v* ] keep '[ _ _ v+ v+ ] map
  19     [ [ gap [ 2/ ] map v+ ] map ] bi@ zip ;
  20
  21 : compute-grid-lines ( grid -- lines )
  22     dup <grid-layout>
  23     [ accumulate-cell-xs horizontal (compute-grid-lines) ]
  24     [ accumulate-cell-ys vertical (compute-grid-lines) ]
  25     2bi append ;
  26
  27 PRIVATE>
  28
  29 M: grid-lines draw-boundary
  30     color>> gl-color compute-grid-lines [ first2 gl-line ] each ;