unmaintained/ui/gadgets/poppers/poppers.factor

   1 ! Copyright (C) 2009 Sam Anklesaria
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays accessors combinators kernel math
   4 models models.combinators namespaces sequences
   5 ui.gadgets ui.gadgets.controls ui.gadgets.layout
   6 ui.gadgets.tracks ui.gestures ui.gadgets.line-support ;
   7 EXCLUDE: ui.gadgets.editors => model-field ;
   8 IN: ui.gadgets.poppers
   9
  10 TUPLE: popped < model-field { fatal? initial: t } ;
  11 TUPLE: popped-editor < multiline-editor ;
  12 : <popped> ( text -- gadget ) <basic> init-field popped-editor popped (new-field) swap >>model* ;
  13
  14 : set-expansion ( popped size -- ) over dup parent>> [ children>> index ] [ sizes>> ] bi set-nth relayout ;
  15 : new-popped ( popped -- ) insertion-point "" <popped>
  16     [ rot 1 + f (track-add-at) ] keep [ relayout ] [ request-focus ] bi ;
  17 : focus-prev ( popped -- ) dup parent>> children>> length 1 =
  18     [ drop ] [
  19         insertion-point [ 1 - dup -1 = [ drop 1 ] when ] [ children>> ] bi* nth
  20         [ request-focus ] [ editor>> end-of-document ] bi
  21     ] if ;
  22 : initial-popped ( popper -- ) "" <popped> [ f track-add drop ] keep request-focus ;
  23
  24 TUPLE: popper < track { unfocus-hook initial: [ drop ] } ;
  25 ! list of strings is model (make shown objects implement sequence protocol)
  26 : <popper> ( model -- popper ) vertical popper new-track swap >>model ;
  27
  28 M: popped handle-gesture swap {
  29     { gain-focus [ 1 set-expansion f ] }
  30     { lose-focus [ dup parent>>
  31         [ [ unfocus-hook>> call( a -- ) ] curry [ f set-expansion ] bi ]
  32         [ drop ] if* f
  33     ] }
  34     { T{ key-up f f "RET" } [ dup editor>> delete-previous-character new-popped f ] }
  35     { T{ key-up f f "BACKSPACE" } [ dup editor>> editor-string "" =
  36         [ dup fatal?>> [ [ focus-prev ] [ unparent ] bi ] [ t >>fatal? drop ] if ]
  37         [ f >>fatal? drop ] if f
  38     ] }
  39     [ swap call-next-method ]
  40 } case ;
  41
  42 M: popper handle-gesture swap T{ button-down f f 1 } =
  43     [ hand-click# get 2 = [ initial-popped ] [ drop ] if ] [ drop ] if f ;
  44
  45 M: popper model-changed
  46     [ children>> [ unparent ] each ]
  47     [ [ value>> [ <popped> ] map ] dip [ f track-add ] reduce request-focus ] bi ;
  48
  49 M: popped pref-dim* editor>> [ pref-dim* first ] [ line-height ] bi 2array ;
  50 M: popper focusable-child* children>> [ t ] [ first ] if-empty ;