basis/ui/gadgets/labels/labels.factor

   1 ! Copyright (C) 2005, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays hashtables io kernel math namespaces
   4 make opengl sequences strings splitting ui.gadgets
   5 ui.gadgets.tracks fonts ui.render
   6 ui.text colors models ;
   7 IN: ui.gadgets.labels
   8
   9 ! A label gadget draws a string.
  10 TUPLE: label < gadget text font ;
  11
  12 : label-string ( label -- string )
  13     text>> dup string? [ "\n" join ] unless ; inline
  14
  15 : set-label-string ( string label -- )
  16     [ CHAR: \n over memq? [ string-lines ] when ] dip (>>text) ; inline
  17
  18 : label-theme ( gadget -- gadget )
  19     sans-serif-font >>font ; inline
  20
  21 : new-label ( string class -- label )
  22     new-gadget
  23     [ set-label-string ] keep
  24     label-theme ; inline
  25
  26 : <label> ( string -- label )
  27     label new-label ;
  28
  29 M: label pref-dim*
  30     [ font>> ] [ text>> ] bi text-dim ;
  31
  32 M: label draw-gadget*
  33     [ font>> ] [ text>> ] bi origin get draw-text ;
  34
  35 M: label gadget-text* label-string % ;
  36
  37 TUPLE: label-control < label ;
  38
  39 M: label-control model-changed
  40     swap value>> over set-label-string relayout ;
  41
  42 : <label-control> ( model -- gadget )
  43     "" label-control new-label
  44         swap >>model ;
  45
  46 : text-theme ( gadget -- gadget )
  47     monospace-font >>font ;
  48
  49 : reverse-video-theme ( label -- label )
  50     sans-serif-font reverse-video-font >>font ;
  51
  52 GENERIC: >label ( obj -- gadget )
  53 M: string >label <label> ;
  54 M: array >label <label> ;
  55 M: object >label ;
  56 M: f >label drop <gadget> ;
  57
  58 : label-on-left ( gadget label -- button )
  59     { 1 0 } <track>
  60         swap >label f track-add
  61         swap 1 track-add ;
  62
  63 : label-on-right ( label gadget -- button )
  64     { 1 0 } <track>
  65         swap f track-add
  66         swap >label 1 track-add ;