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

UI cleanups

db4
Slava Pestov 2008-07-11 00:46:15 -05:00
parent a119bea53a
commit e8d0cbbd6a
3 changed files with 24 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
extra/ui/gadgets/borders/borders.factor
View File

@ -6,11 +6,15 @@ IN: ui.gadgets.borders
TUPLE: border < gadget size fill ; TUPLE: border < gadget size fill ;
: <border> ( child gap -- border ) : new-border ( child class -- border )
border new-gadget new-gadget
swap dup 2array >>size { 0 0 } >>size
{ 0 0 } >>fill { 0 0 } >>fill
[ add-gadget ] keep ; [ add-gadget ] keep ; inline
: <border> ( child gap -- border )
swap border new-border
swap dup 2array >>size ;
M: border pref-dim* M: border pref-dim*
[ border-size 2 v*n ] keep [ border-size 2 v*n ] keep

20
extra/ui/gadgets/buttons/buttons.factor
View File

@ -4,12 +4,12 @@ USING: accessors arrays kernel math models namespaces sequences
strings quotations assocs combinators classes colors strings quotations assocs combinators classes colors
classes.tuple opengl math.vectors classes.tuple opengl math.vectors
ui.commands ui.gadgets ui.gadgets.borders ui.commands ui.gadgets ui.gadgets.borders
ui.gadgets.labels ui.gadgets.theme ui.gadgets.wrappers ui.gadgets.labels ui.gadgets.theme
ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures
ui.render ; ui.render ;
IN: ui.gadgets.buttons IN: ui.gadgets.buttons
TUPLE: button < wrapper pressed? selected? quot ; TUPLE: button < border pressed? selected? quot ;
: buttons-down? ( -- ? ) : buttons-down? ( -- ? )
hand-buttons get-global empty? not ; hand-buttons get-global empty? not ;
@ -41,11 +41,9 @@ button H{
} set-gestures } set-gestures
: new-button ( label quot class -- button ) : new-button ( label quot class -- button )
new-gadget [ swap >label ] dip new-border swap >>quot ; inline
swap >>quot
[ >r >label r> add-gadget ] keep ; inline
: <button> ( gadget quot -- button ) : <button> ( label quot -- button )
button new-button ; button new-button ;
TUPLE: button-paint plain rollover pressed selected ; TUPLE: button-paint plain rollover pressed selected ;
@ -84,13 +82,11 @@ M: button-paint draw-boundary
: bevel-button-theme ( gadget -- gadget ) : bevel-button-theme ( gadget -- gadget )
<bevel-button-paint> >>interior <bevel-button-paint> >>interior
{ 5 5 } >>size
faint-boundary ; inline faint-boundary ; inline
: >bevel-label ( label -- gadget )
>label 5 <border> ;
: <bevel-button> ( label quot -- button ) : <bevel-button> ( label quot -- button )
>r >bevel-label r> <button> bevel-button-theme ; <button> bevel-button-theme ;
TUPLE: repeat-button < button ; TUPLE: repeat-button < button ;
@ -101,7 +97,7 @@ repeat-button H{
: <repeat-button> ( label quot -- button ) : <repeat-button> ( label quot -- button )
#! Button that calls the quotation every 100ms as long as #! Button that calls the quotation every 100ms as long as
#! the mouse is held down. #! the mouse is held down.
>r >bevel-label r> repeat-button new-button bevel-button-theme ; repeat-button new-button bevel-button-theme ;
TUPLE: checkmark-paint color ; TUPLE: checkmark-paint color ;
@ -209,7 +205,7 @@ M: radio-control model-changed
dup radio-buttons-theme ; dup radio-buttons-theme ;
: <toggle-button> ( value model label -- gadget ) : <toggle-button> ( value model label -- gadget )
>bevel-label <radio-control> bevel-button-theme ; <radio-control> bevel-button-theme ;
: <toggle-buttons> ( model assoc -- gadget ) : <toggle-buttons> ( model assoc -- gadget )
[ [ <toggle-button> ] <radio-controls> ] make-shelf ; [ [ <toggle-button> ] <radio-controls> ] make-shelf ;

18
extra/ui/gadgets/editors/editors.factor
View File

@ -9,7 +9,6 @@ ui.gadgets.theme ui.gadgets.wrappers ui.render ui.gestures ;
IN: ui.gadgets.editors IN: ui.gadgets.editors
TUPLE: editor < gadget TUPLE: editor < gadget
self
font color caret-color selection-color font color caret-color selection-color
caret mark caret mark
focused? ; focused? ;
@ -30,8 +29,7 @@ focused? ;
new-gadget new-gadget
<document> >>model <document> >>model
init-editor-locs init-editor-locs
editor-theme editor-theme ; inline
dup dup set-editor-self ; inline
: <editor> ( -- editor ) : <editor> ( -- editor )
editor new-editor ; editor new-editor ;
@ -209,19 +207,19 @@ M: editor pref-dim*
dup editor-font* swap control-value text-dim ; dup editor-font* swap control-value text-dim ;
: contents-changed ( model editor -- ) : contents-changed ( model editor -- )
editor-self swap swap
over editor-caret [ over validate-loc ] (change-model) over caret>> [ over validate-loc ] (change-model)
over editor-mark [ over validate-loc ] (change-model) over mark>> [ over validate-loc ] (change-model)
drop relayout ; drop relayout ;
: caret/mark-changed ( model editor -- ) : caret/mark-changed ( model editor -- )
nip editor-self dup relayout-1 scroll>caret ; nip [ relayout-1 ] [ scroll>caret ] bi ;
M: editor model-changed M: editor model-changed
{ {
{ [ 2dup gadget-model eq? ] [ contents-changed ] } { [ 2dup model>> eq? ] [ contents-changed ] }
{ [ 2dup editor-caret eq? ] [ caret/mark-changed ] } { [ 2dup caret>> eq? ] [ caret/mark-changed ] }
{ [ 2dup editor-mark eq? ] [ caret/mark-changed ] } { [ 2dup mark>> eq? ] [ caret/mark-changed ] }
} cond ; } cond ;
M: editor gadget-selection? M: editor gadget-selection?