extra/ui/gadgets/labels/labels.factor

   1 ! Copyright (C) 2005, 2007 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays hashtables io kernel math namespaces
   4 opengl sequences io.streams.lines strings splitting
   5 ui.gadgets ui.gadgets.controls ui.gadgets.theme ui.render
   6 colors ;
   7 IN: ui.gadgets.labels
   8
   9 ! A label gadget draws a string.
  10 TUPLE: label text font color ;
  11
  12 : label-string ( label -- string )
  13     label-text dup string? [ "\n" join ] unless ; inline
  14
  15 : set-label-string ( string label -- )
  16     CHAR: \n pick memq? [
  17         >r string-lines r> set-label-text
  18     ] [
  19         set-label-text
  20     ] if ; inline
  21
  22 : label-theme ( gadget -- )
  23     black over set-label-color
  24     sans-serif-font swap set-label-font ;
  25
  26 : <label> ( string -- label )
  27     label construct-gadget
  28     [ set-label-string ] keep
  29     dup label-theme ;
  30
  31 M: label pref-dim*
  32     dup label-font open-font swap label-text text-dim ;
  33
  34 M: label draw-gadget*
  35     dup label-color gl-color
  36     dup label-font swap label-text origin get draw-text ;
  37
  38 M: label gadget-text* label-string % ;
  39
  40 : <label-control> ( model -- gadget )
  41     "" <label> [ set-label-string ] <control> ;
  42
  43 : text-theme ( gadget -- )
  44     black over set-label-color
  45     monospace-font swap set-label-font ;
  46
  47 : reverse-video-theme ( label -- )
  48     white over set-label-color
  49     black solid-interior ;