basis/ui/gadgets/labeled/labeled.factor

   1 ! Copyright (C) 2006, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel sequences colors fonts ui.gadgets
   4 ui.gadgets.frames ui.gadgets.grids ui.gadgets.icons ui.gadgets.labels
   5 ui.gadgets.borders ui.pens.image ;
   6 IN: ui.gadgets.labeled
   7
   8 TUPLE: labeled-gadget < frame content ;
   9
  10 <PRIVATE
  11
  12 CONSTANT: @center { 1 1 }
  13 CONSTANT: @left { 0 1 }
  14 CONSTANT: @right { 2 1 }
  15 CONSTANT: @top { 1 0 }
  16 CONSTANT: @bottom { 1 2 }
  17
  18 CONSTANT: @top-left { 0 0 }
  19 CONSTANT: @top-right { 2 0 }
  20 CONSTANT: @bottom-left { 0 2 }
  21 CONSTANT: @bottom-right { 2 2 }
  22
  23 : labeled-image ( name -- image )
  24     "labeled-block-" prepend theme-image ;
  25
  26 : labeled-icon ( name -- icon )
  27     labeled-image <icon> ;
  28
  29 CONSTANT: labeled-title-background
  30     T{ rgba f
  31         0.7843137254901961
  32         0.7686274509803922
  33         0.7176470588235294
  34         1.0
  35     }
  36
  37 : <labeled-title> ( gadget -- label )
  38     >label
  39     [ labeled-title-background font-with-background ] change-font
  40     { 0 2 } <border>
  41     "title-middle" labeled-image
  42     <image-pen> t >>fill? >>interior ;
  43
  44 : /-FOO-\ ( title labeled -- labeled )
  45     "title-left" labeled-icon @top-left grid-add
  46     swap <labeled-title> @top grid-add
  47     "title-right" labeled-icon @top-right grid-add ;
  48
  49 : |-----| ( gadget labeled -- labeled )
  50     "left-edge" labeled-icon @left grid-add
  51     swap [ >>content ] [ @center grid-add ] bi
  52     "right-edge" labeled-icon @right grid-add ;
  53
  54 : \-----/ ( labeled -- labeled )
  55     "bottom-left" labeled-icon @bottom-left grid-add
  56     "bottom-middle" labeled-icon @bottom grid-add
  57     "bottom-right" labeled-icon @bottom-right grid-add ;
  58
  59 M: labeled-gadget focusable-child* content>> ;
  60
  61 PRIVATE>
  62
  63 : <labeled-gadget> ( gadget title -- newgadget )
  64     3 3 labeled-gadget new-frame
  65         { 1 1 } >>filled-cell
  66         /-FOO-\
  67         |-----|
  68         \-----/ ;