basis/ui/pens/tile/tile.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel accessors math.vectors ui.images opengl fry
   4 combinators ui.pens ;
   5 IN: ui.pens.tile
   6
   7 ! Tile pen
   8 TUPLE: tile-pen left center right background foreground ;
   9
  10 : <tile-pen> ( left center right background foreground -- pen )
  11     tile-pen boa ;
  12
  13 : >tile-pen< ( pen -- left center right )
  14     [ left>> ] [ center>> ] [ right>> ] tri ; inline
  15
  16 M: tile-pen pen-pref-dim
  17     swap [
  18         >tile-pen< [ image-dim ] tri@
  19         [ vmax vmax ] [ v+ v+ ] 3bi
  20     ] dip orientation>> set-axis ;
  21
  22 : compute-tile-xs ( gadget pen -- x1 x2 x3 )
  23     [ 2drop { 0 0 } ]
  24     [ nip left>> image-dim ]
  25     [ [ dim>> ] [ right>> image-dim ] bi* v- ]
  26     2tri ;
  27
  28 : compute-tile-widths ( gadget pen -- w1 w2 w3 )
  29     [ nip left>> image-dim ]
  30     [ [ dim>> ] [ [ left>> ] [ right>> ] bi [ image-dim ] bi@ ] bi* v+ v- ]
  31     [ nip right>> image-dim ]
  32     2tri ;
  33
  34 : render-tile ( tile x width gadget -- )
  35     [ orientation>> '[ _ v* ] dip ] keep
  36    '[
  37        _ _ [ dim>> swap ] [ orientation>> ] bi set-axis
  38        swap draw-scaled-image
  39    ] with-translation ;
  40
  41 M: tile-pen draw-interior
  42     {
  43         [ nip >tile-pen< ]
  44         [ compute-tile-xs ]
  45         [ compute-tile-widths ]
  46         [ drop ]
  47     } 2cleave
  48     [ render-tile ] curry tri-curry@ tri-curry* tri* ;
  49
  50 M: tile-pen pen-background nip background>> ;
  51
  52 M: tile-pen pen-foreground nip foreground>> ;