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 fonts kernel ui.gadgets ui.gadgets.borders
   4 ui.gadgets.corners ui.gadgets.frames ui.gadgets.grids
   5 ui.gadgets.labels ui.pens.image ui.render ;
   6 IN: ui.gadgets.labeled
   7
   8 TUPLE: labeled-gadget < frame content ;
   9
  10 <PRIVATE
  11
  12 : <labeled-title> ( gadget -- label )
  13     >label
  14     [ panel-background-color font-with-background ] change-font
  15     { 0 2 } <border>
  16     "title-middle" corner-image
  17     <image-pen> t >>fill? >>interior ;
  18
  19 : /-FOO-\ ( title labeled -- labeled )
  20     "title-left" corner-icon @top-left grid-add
  21     swap <labeled-title> @top grid-add
  22     "title-right" corner-icon @top-right grid-add ;
  23
  24 M: labeled-gadget focusable-child* content>> ;
  25
  26 PRIVATE>
  27
  28 : <labeled-gadget> ( gadget title -- newgadget )
  29     labeled-gadget "labeled-block" [
  30         pick >>content
  31         /-FOO-\
  32         |-----|
  33         \-----/
  34     ] make-corners ;