contrib/action-field.factor

   1
   2 USING: kernel models namespaces math sequences arrays hashtables gadgets
   3        gadgets-text gadgets-buttons ;
   4 IN: action-field
   5
   6 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   7
   8 TUPLE: action-field quot ;
   9
  10 C: action-field ( quot -- action-field )
  11 tuck set-action-field-quot f <model> [ add-connection ] 2keep
  12 <field> over set-gadget-delegate ;
  13
  14 M: action-field model-changed ( action-field -- ) dup action-field-quot call ;
  15
  16 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  17
  18 : variable-field ( var -- action-field )
  19 unit [ editor-text ] swap append [ set ] append <action-field> ;
  20
  21 : number-field ( var -- action-field )
  22 unit [ editor-text string>number ] swap append [ set ] append <action-field> ;
  23
  24 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  25 ! [bind] [unbind] and [bound?] should probably be in a separate
  26 ! file. But right now boids and automata are the only programs which
  27 ! use this, and I don't want to add a new contrib file just for
  28 ! this. For now they'll live here. Maybe bind-button and
  29 ! bind-action-field should go into a gadgets-utils file eventually.
  30 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  31
  32 : [bind] ( ns quot -- quot ) \ bind 3array >quotation ;
  33
  34 : [unbind] ( quot -- quot ) second ;
  35
  36 : [bound?] ( quot -- ? )
  37 dup length 3 = [ dup first hashtable? swap third \ bind = and ] [ f ] if ;
  38
  39 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  40
  41 : bind-button ( ns button -- ) tuck button-quot [bind] swap set-button-quot ;
  42
  43 : bind-action-field ( ns action-field -- )
  44 tuck action-field-quot [bind] swap set-action-field-quot ;
  45
  46 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  47
  48 PROVIDE: contrib/action-field ;