unmaintained/ui/gadgets/corners/corners.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel namespaces sequences ui.gadgets.frames
   4 ui.gadgets.grids ui.gadgets.icons ui.gadgets.theme ;
   5 IN: ui.gadgets.corners
   6
   7 CONSTANT: @center { 1 1 }
   8 CONSTANT: @left { 0 1 }
   9 CONSTANT: @right { 2 1 }
  10 CONSTANT: @top { 1 0 }
  11 CONSTANT: @bottom { 1 2 }
  12
  13 CONSTANT: @top-left { 0 0 }
  14 CONSTANT: @top-right { 2 0 }
  15 CONSTANT: @bottom-left { 0 2 }
  16 CONSTANT: @bottom-right { 2 2 }
  17
  18 SYMBOL: name
  19
  20 : corner-image ( name -- image )
  21     [ name get "-" ] dip 3append theme-image ;
  22
  23 : corner-icon ( name -- icon )
  24     corner-image <icon> ;
  25
  26 : /-----\ ( corner -- corner )
  27     "top-left" corner-icon @top-left grid-add
  28     "top-middle" corner-icon @top grid-add
  29     "top-right" corner-icon @top-right grid-add ;
  30
  31 : |-----| ( gadget corner -- corner )
  32     "left-edge" corner-icon @left grid-add
  33     swap @center grid-add
  34     "right-edge" corner-icon @right grid-add ;
  35
  36 : \-----/ ( corner -- corner )
  37     "bottom-left" corner-icon @bottom-left grid-add
  38     "bottom-middle" corner-icon @bottom grid-add
  39     "bottom-right" corner-icon @bottom-right grid-add ;
  40
  41 : make-corners ( class name quot -- corners )
  42     [ [ [ 3 3 ] dip new-frame { 1 1 } >>filled-cell ] dip name ] dip
  43     with-variable ; inline