basis/ui/gadgets/frames/frames.factor

   1 ! Copyright (C) 2005, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays generic kernel math namespaces sequences
   4 words splitting grouping math.vectors ui.gadgets.grids
   5 ui.gadgets math.geometry.rect ;
   6 IN: ui.gadgets.frames
   7
   8 TUPLE: glue < gadget ;
   9
  10 M: glue pref-dim* drop { 0 0 } ;
  11
  12 : <glue> ( -- glue ) glue new-gadget ;
  13
  14 : <frame-grid> ( -- grid ) 9 [ <glue> ] replicate 3 group ;
  15
  16 : @center ( -- i j ) 1 1 ; inline
  17 : @left ( -- i j ) 0 1 ; inline
  18 : @right ( -- i j ) 2 1 ; inline
  19 : @top ( -- i j ) 1 0 ; inline
  20 : @bottom ( -- i j ) 1 2 ; inline
  21
  22 : @top-left ( -- i j ) 0 0 ; inline
  23 : @top-right ( -- i j ) 2 0 ; inline
  24 : @bottom-left ( -- i j ) 0 2 ; inline
  25 : @bottom-right ( -- i j ) 2 2 ; inline
  26
  27 TUPLE: frame < grid ;
  28
  29 : new-frame ( class -- frame )
  30     <frame-grid> swap new-grid ; inline
  31
  32 : <frame> ( -- frame )
  33     frame new-frame ;
  34
  35 : (fill-center) ( dim vec -- )
  36     [ [ first ] [ third ] bi v+ [v-] ] keep set-second ;
  37
  38 : fill-center ( dim horiz vert -- )
  39     [ over ] dip [ (fill-center) ] 2bi@ ;
  40
  41 M: frame layout*
  42     dup compute-grid
  43     [ [ dim>> ] 2dip fill-center ] [ grid-layout ] 3bi ;