steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

field fix

cvs
Slava Pestov 2005-02-12 00:11:31 +00:00
parent 36b97dd4ee
commit 96edb600fe
2 changed files with 22 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
examples/gadget-test.factor
View File

@ -75,8 +75,8 @@ USE: words
"Filled?" <checkbox> dup "filled" set "shelf" get add-gadget
"shelf" get "pile" get add-gadget
"Welcome to Factor " version cat2 <label> "pile" get add-gadget
"Welcome to Factor " version cat2 <label> <field> "pile" get add-gadget
"Welcome to Factor " version cat2 <label> <field> "pile" get add-gadget
"Welcome to Factor " version cat2 <field> "pile" get add-gadget
"Welcome to Factor " version cat2 <field> "pile" get add-gadget
"pile" get bevel-border dup "dialog" set dup
moving-actions

36
library/ui/fields.factor
View File

@ -5,29 +5,33 @@ USING: generic kernel lists math namespaces sdl line-editor ;
TUPLE: field active? delegate ;
: field-border ( gadget -- border )
bevel-border dup f bevel-up? set-paint-property ;
C: field ( delegate -- field )
[ >r field-border r> set-field-delegate ] keep
{{
[[ [ gain-focus ] [ dup blue foreground set-paint-property redraw ] ]]
[[ [ lose-focus ] [ dup black foreground set-paint-property redraw ] ]]
[[ [ button-down 1 ] [ my-hand request-focus ] ]]
[[ [ "RETURN" ] [ drop "foo!" USE: stdio print ] ]]
}} over set-gadget-gestures ;
TUPLE: editor line delegate ;
C: editor ( -- )
0 0 0 0 <rectangle> <gadget> over set-editor-delegate
[ <line-editor> set-editor-line ] keep ;
: editor-text ( editor -- text )
editor-line [ line-text get ] bind ;
: set-editor-text ( text editor -- )
editor-line [ line-text set ] bind ;
C: editor ( text -- )
0 0 0 0 <rectangle> <gadget> over set-editor-delegate
[ <line-editor> swap set-editor-line ] keep
[ set-editor-text ] keep ;
M: editor layout* ( label -- )
[ editor-text dup shape-w swap shape-h ] keep resize-gadget ;
M: editor draw-shape ( label -- )
dup [ editor-text draw-shape ] with-translation ;
: field-border ( gadget -- border )
bevel-border dup f bevel-up? set-paint-property ;
C: field ( text -- field )
[ >r <editor> field-border r> set-field-delegate ] keep
{{
[[ [ gain-focus ] [ dup blue foreground set-paint-property redraw ] ]]
[[ [ lose-focus ] [ dup black foreground set-paint-property redraw ] ]]
[[ [ button-down 1 ] [ my-hand request-focus ] ]]
[[ [ "RETURN" ] [ drop "foo!" USE: stdio print ] ]]
}} over set-gadget-gestures ;