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

control gadget refactoring

release
Slava Pestov 2007-11-13 18:51:10 -05:00
parent 5262801398
commit 9bb0c40dc8
35 changed files with 98 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
extra/color-picker/color-picker.factor Normal file → Executable file
View File

@ -1,7 +1,7 @@
! Copyright (C) 2006, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.functions math.parser models sequences
ui ui.gadgets ui.gadgets.controls ui.gadgets.frames
ui ui.gadgets ui.gadgets.frames
ui.gadgets.labels ui.gadgets.packs ui.gadgets.sliders ui.render
;
IN: color-picker
@ -11,9 +11,14 @@ IN: color-picker
: <color-slider> ( model -- gadget )
<x-slider> 1 over set-slider-line ;
TUPLE: color-preview ;
: <color-preview> ( model -- gadget )
<gadget> { 100 100 } over set-rect-dim
[ set-gadget-interior ] <control> ;
<gadget> color-preview construct-control
{ 100 100 } over set-rect-dim ;
M: color-preview model-changed
dup control-value over set-gadget-interior relayout-1 ;
: <color-model> ( model -- model )
[ [ 256 /f ] map 1 add <solid> ] <filter> ;

2
extra/slides/slides.factor Normal file → Executable file
View File

@ -1,6 +1,6 @@
USING: arrays hashtables help.markup help.stylesheet io
io.styles kernel math models namespaces sequences ui ui.gadgets
ui.gadgets.books ui.gadgets.controls ui.gadgets.panes
ui.gadgets.books ui.gadgets.panes
ui.gestures ui.render ;
IN: slides

2
extra/ui/gadgets/books/books-docs.factor Normal file → Executable file
View File

@ -1,4 +1,4 @@
USING: ui.gadgets.books ui.gadgets.controls help.markup
USING: ui.gadgets.books help.markup
help.syntax ui.gadgets models ;
HELP: book

2
extra/ui/gadgets/books/books.factor Normal file → Executable file
View File

@ -1,6 +1,6 @@
! Copyright (C) 2006, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences models ui.gadgets ui.gadgets.controls ;
USING: kernel sequences models ui.gadgets ;
IN: ui.gadgets.books
TUPLE: book ;

24
extra/ui/gadgets/buttons/buttons.factor Normal file → Executable file
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays ui.commands ui.gadgets ui.gadgets.borders
ui.gadgets.controls ui.gadgets.labels ui.gadgets.theme
ui.gadgets.labels ui.gadgets.theme
ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures
ui.render kernel math models namespaces sequences strings
quotations assocs combinators classes colors tuples opengl
@ -131,13 +131,18 @@ M: checkmark-paint draw-interior
{ 5 5 } over set-pack-gap
1/2 swap set-pack-align ;
TUPLE: checkbox ;
: <checkbox> ( model label -- checkbox )
<checkmark>
label-on-right
over [ toggle-model drop ] curry <button>
[ set-button-selected? ] <control>
checkbox construct-control
dup checkbox-theme ;
M: checkbox model-changed
dup control-value over set-button-selected? relayout-1 ;
TUPLE: radio-paint color ;
C: <radio-paint> radio-paint
@ -165,9 +170,18 @@ M: radio-paint draw-boundary
dup radio-knob-theme
{ 16 16 } over set-gadget-dim ;
: <radio-control> ( model value gadget quot -- control )
>r dupd [ set-control-value ] curry* r> call
[ >r = r> set-button-selected? ] curry* <control> ; inline
TUPLE: radio-control value ;
: <radio-control> ( value model gadget quot -- control )
>r pick [ swap set-control-value ] curry r> call
radio-control construct-control
tuck set-radio-control-value ; inline
M: radio-control model-changed
dup control-value
over radio-control-value =
over set-button-selected?
relayout-1 ;
: <radio-controls> ( model assoc quot -- gadget )
swapd [ >r -rot r> call gadget, ] 2curry assoc-each ; inline

1
extra/ui/gadgets/controls/authors.txt
View File

@ -1 +0,0 @@
Slava Pestov

51
extra/ui/gadgets/controls/controls-docs.factor
View File

@ -1,51 +0,0 @@
USING: ui.gadgets help.markup help.syntax models kernel classes
tuples ;
IN: ui.gadgets.controls
HELP: control
{ $class-description "A control is a " { $link gadget } " linked to a " { $link model } " stored in the " { $link control-model } " slot. Changes to the model are reflected in the appearance and behavior of the control, and the control may in turn change the value of the model in response to user input."
$nl
"Controls are created by calling " { $link <control> } " and " { $link construct-control } "."
$nl
"Objects may delegate to " { $link control } " instances, in which case the " { $link control-self } " slot must be set to the frontmost object in the delegation chain. This ensures that the correct object receives notification of model changes." } ;
HELP: <control>
{ $values { "model" model } { "gadget" gadget } { "quot" "a quotation with stack effect " { $snippet "( value control -- )" } } }
{ $description "Creates a new control linked to the given model. The gadget parameter becomes the control's delegate. The quotation is called when the model value changes," }
{ $examples
"The following example creates a gadget whose fill color is determined by the value of a model:"
{ $code
"USING: ui.gadgets ui.gadgets.panes models ;"
": set-fill-color >r <solid> r> set-gadget-interior ;"
"{ 1.0 0.0 0.5 1.0 } <model>"
"<gadget> [ set-fill-color ] <control>"
"{ 100 100 } over set-rect-dim"
"gadget."
}
"The " { $vocab-link "color-picker" } " module extends this example into an elaborate color choose."
} ;
{ <control> construct-control control-value set-control-value } related-words
HELP: control-value
{ $values { "control" control } { "value" object } }
{ $description "Outputs the value of the control's model." } ;
HELP: set-control-value
{ $values { "value" object } { "control" control } }
{ $description "Sets the value of the control's model." } ;
ARTICLE: "ui-control-impl" "Implementing controls"
"A control is a gadget which is linked to an underlying " { $link model } "."
{ $subsection control }
"There are two ways to implement a new control. First, an existing gadget can be wrapped in a control:"
{ $subsection <control> }
"Second, a new tuple class can be defined, whose instances delegate to controls:"
{ $subsection construct-control }
"Some utility words useful in control implementations:"
{ $subsection control-model }
{ $subsection control-value }
{ $subsection set-control-value }
{ $see-also "models" } ;
ABOUT: "ui-control-impl"

37
extra/ui/gadgets/controls/controls.factor
View File

@ -1,37 +0,0 @@
! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel models ui.gadgets ;
IN: ui.gadgets.controls
TUPLE: control self model quot ;
: (construct-control)
construct dup dup set-control-self ; inline
: <control> ( model gadget quot -- gadget )
{
set-control-model set-gadget-delegate set-control-quot
} control (construct-control) ;
: control-value ( control -- value )
control-model model-value ;
: set-control-value ( value control -- )
control-model set-model ;
M: control graft*
control-self dup dup control-model add-connection
model-changed ;
M: control ungraft*
control-self dup control-model remove-connection ;
M: control model-changed
control-self
[ control-value ] keep
[ dup control-quot call ] keep
relayout ;
: construct-control ( model underlying class -- tuple )
>r [ 2drop ] <control> { set-gadget-delegate } r>
(construct-control) ; inline

1
extra/ui/gadgets/controls/summary.txt
View File

@ -1 +0,0 @@
Controls display a view of an underlying model

3
extra/ui/gadgets/editors/editors-docs.factor Normal file → Executable file
View File

@ -1,6 +1,5 @@
USING: documents help.markup help.syntax ui.gadgets
ui.gadgets.scrollers ui.gadgets.controls
models strings ui.commands ;
ui.gadgets.scrollers models strings ui.commands ;
IN: ui.gadgets.editors
HELP: editor

2
extra/ui/gadgets/editors/editors.factor Normal file → Executable file
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays documents ui.clipboards ui.commands ui.gadgets
ui.gadgets.borders ui.gadgets.buttons ui.gadgets.labels
ui.gadgets.scrollers ui.gadgets.theme ui.gadgets.controls
ui.gadgets.scrollers ui.gadgets.theme
ui.render ui.gestures io kernel math models namespaces opengl
opengl.gl sequences strings io.styles math.vectors sorting
colors combinators ;

28
extra/ui/gadgets/gadgets.factor Normal file → Executable file
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays hashtables kernel models math namespaces sequences
timers quotations math.vectors combinators sorting vectors
dlists ;
dlists models ;
IN: ui.gadgets
TUPLE: rect loc dim ;
@ -43,12 +43,15 @@ M: array rect-dim drop { 0 0 } ;
TUPLE: gadget
pref-dim parent children orientation state focus
visible? root? clipped? grafted?
interior boundary ;
interior boundary
model ;
M: gadget equal? 2drop f ;
M: gadget hashcode* drop gadget hashcode* ;
M: gadget model-changed drop ;
: gadget-child ( gadget -- child ) gadget-children first ;
: nth-gadget ( n gadget -- child ) gadget-children nth ;
@ -63,7 +66,24 @@ M: gadget hashcode* drop gadget hashcode* ;
} gadget construct ;
: construct-gadget ( class -- tuple )
>r <gadget> { set-delegate } r> construct ; inline
>r <gadget> r> construct-delegate ; inline
: construct-control ( model gadget class -- control )
>r tuck set-gadget-model r> construct-delegate ; inline
: activate-control ( gadget -- )
dup gadget-model dup [ dupd add-connection ] when
model-changed ;
: deactivate-control ( gadget -- )
dup gadget-model dup [ dupd remove-connection ] when
drop ;
: control-value ( control -- value )
gadget-model model-value ;
: set-control-value ( value control -- )
gadget-model set-model ;
: relative-loc ( fromgadget togadget -- loc )
2dup eq? [
@ -228,6 +248,7 @@ M: gadget graft* drop ;
: graft ( gadget -- )
t over set-gadget-grafted?
dup graft*
dup activate-control
[ graft ] each-child ;
GENERIC: ungraft* ( gadget -- )
@ -237,6 +258,7 @@ M: gadget ungraft* drop ;
: ungraft ( gadget -- )
dup gadget-grafted? [
dup [ ungraft ] each-child
dup deactivate-control
dup ungraft*
f over set-gadget-grafted?
] when drop ;

2
extra/ui/gadgets/labelled/labelled-docs.factor Normal file → Executable file
View File

@ -1,5 +1,5 @@
USING: ui.gadgets help.markup help.syntax strings models
ui.gadgets.panes ui.gadgets.controls ;
ui.gadgets.panes ;
IN: ui.gadgets.labelled
HELP: labelled-gadget

3
extra/ui/gadgets/labels/labels-docs.factor Normal file → Executable file
View File

@ -1,5 +1,4 @@
USING: ui.gadgets.controls help.markup
help.syntax strings ui.gadgets models ;
USING: help.markup help.syntax strings ui.gadgets models ;
IN: ui.gadgets.labels
HELP: label

10
extra/ui/gadgets/labels/labels.factor Normal file → Executable file
View File

@ -2,8 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays hashtables io kernel math namespaces
opengl sequences io.streams.lines strings splitting
ui.gadgets ui.gadgets.controls ui.gadgets.tracks
ui.gadgets.theme ui.render colors ;
ui.gadgets ui.gadgets.tracks ui.gadgets.theme ui.render colors ;
IN: ui.gadgets.labels
! A label gadget draws a string.
@ -37,8 +36,13 @@ M: label draw-gadget*
M: label gadget-text* label-string % ;
TUPLE: label-control ;
M: label-control model-changed
dup control-value over set-label-text relayout ;
: <label-control> ( model -- gadget )
"" <label> [ set-label-string ] <control> ;
"" <label> label-control construct-control ;
: text-theme ( gadget -- )
black over set-label-color

5
extra/ui/gadgets/lists/lists-docs.factor Normal file → Executable file
View File

@ -1,6 +1,5 @@
USING: ui.commands help.markup help.syntax
ui.gadgets ui.gadgets.presentations ui.gadgets.controls
ui.operations kernel models classes ;
USING: ui.commands help.markup help.syntax ui.gadgets
ui.gadgets.presentations ui.operations kernel models classes ;
IN: ui.gadgets.lists
HELP: +secondary+

2
extra/ui/gadgets/lists/lists.factor Normal file → Executable file
View File

@ -1,7 +1,7 @@
! Copyright (C) 2006, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: ui.commands ui.gestures ui.render ui.gadgets
ui.gadgets.controls ui.gadgets.labels ui.gadgets.scrollers
ui.gadgets.labels ui.gadgets.scrollers
kernel sequences models opengl math namespaces
ui.gadgets.presentations ui.gadgets.viewports ui.gadgets.packs
math.vectors tuples ;

4
extra/ui/gadgets/panes/panes-docs.factor Normal file → Executable file
View File

@ -1,5 +1,5 @@
USING: ui.gadgets.controls ui.gadgets models
help.markup help.syntax io kernel quotations ;
USING: ui.gadgets models help.markup help.syntax io kernel
quotations ;
IN: ui.gadgets.panes
HELP: pane

10
extra/ui/gadgets/panes/panes.factor Normal file → Executable file
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays ui.gadgets ui.gadgets.borders ui.gadgets.buttons
ui.gadgets.labels ui.gadgets.controls ui.gadgets.scrollers
ui.gadgets.labels ui.gadgets.scrollers
ui.gadgets.paragraphs ui.gadgets.incremental ui.gadgets.packs
ui.gadgets.theme ui.clipboards ui.gestures ui.traverse ui.render
hashtables io kernel namespaces sequences io.styles strings
@ -137,8 +137,14 @@ M: duplex-stream write-gadget
: <scrolling-pane> ( -- pane )
<pane> t over set-pane-scrolls? ;
TUPLE: pane-control quot ;
M: pane-control model-changed
dup control-value swap dup pane-control-quot with-pane ;
: <pane-control> ( model quot -- pane )
[ with-pane ] curry <pane> swap <control> ;
>r <pane> pane-control construct-control r>
over set-pane-control-quot ;
: do-pane-stream ( pane-stream quot -- )
>r pane-stream-pane r> keep scroll-pane ; inline

2
extra/ui/gadgets/scrollers/scrollers-tests.factor Normal file → Executable file
View File

@ -1,5 +1,5 @@
IN: temporary
USING: ui.gadgets ui.gadgets.scrollers ui.gadgets.controls
USING: ui.gadgets ui.gadgets.scrollers
namespaces tools.test kernel models ui.gadgets.viewports math
math.vectors arrays sequences ;

2
extra/ui/gadgets/scrollers/scrollers.factor Normal file → Executable file
View File

@ -1,6 +1,6 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays ui.gadgets ui.gadgets.controls
USING: arrays ui.gadgets
ui.gadgets.viewports ui.gadgets.frames ui.gadgets.grids
ui.gadgets.theme ui.gadgets.sliders ui.gestures kernel math
namespaces sequences models combinators math.vectors ;

3
extra/ui/gadgets/sliders/sliders-docs.factor Normal file → Executable file
View File

@ -1,5 +1,4 @@
USING: ui.gadgets.controls help.markup help.syntax ui.gadgets
models ;
USING: help.markup help.syntax ui.gadgets models ;
IN: ui.gadgets.sliders
HELP: elevator

2
extra/ui/gadgets/sliders/sliders.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays ui.gestures ui.gadgets ui.gadgets.buttons
ui.gadgets.controls ui.gadgets.frames ui.gadgets.grids
ui.gadgets.frames ui.gadgets.grids
ui.gadgets.theme ui.render kernel math namespaces sequences
vectors models math.vectors math.functions quotations colors ;
IN: ui.gadgets.sliders

2
extra/ui/gadgets/slots/slots.factor Normal file → Executable file
View File

@ -3,7 +3,7 @@
USING: namespaces ui.gadgets ui.gestures ui.commands kernel
ui.gadgets.scrollers parser prettyprint ui.gadgets.buttons
sequences arrays ui.gadgets.borders ui.gadgets.tracks
ui.gadgets.editors ui.gadgets.controls io math
ui.gadgets.editors io math
definitions math.vectors assocs refs ;
IN: ui.gadgets.slots

2
extra/ui/gadgets/viewports/viewports-docs.factor Normal file → Executable file
View File

@ -1,4 +1,4 @@
USING: ui.gadgets.viewports ui.gadgets.controls help.markup
USING: ui.gadgets.viewports help.markup
help.syntax ui.gadgets models ;
HELP: viewport

2
extra/ui/gadgets/viewports/viewports.factor Normal file → Executable file
View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: ui.gadgets.viewports
USING: arrays ui.gadgets ui.gadgets.borders ui.gadgets.controls
USING: arrays ui.gadgets ui.gadgets.borders
kernel math namespaces sequences models math.vectors ;
: viewport-gap { 3 3 } ; inline

4
extra/ui/tools/deploy/deploy.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: ui.gadgets colors kernel ui.render namespaces
ui.gadgets.controls models sequences ui.gadgets.buttons
models sequences ui.gadgets.buttons
ui.gadgets.packs ui.gadgets.labels tools.deploy.config
namespaces ui.gadgets.editors ui.gadgets.borders ui.gestures
ui.commands assocs ui.gadgets.tracks ui ui.tools.listener
@ -52,7 +52,7 @@ TUPLE: deploy-gadget vocab settings ;
reflection-settings
advanced-settings
] make-pile dup deploy-settings-theme
namespace <mapping> swap [ 2drop ] <control>
namespace <mapping> over set-gadget-model
] bind ;
: find-deploy-gadget

2
extra/ui/tools/interactor/interactor.factor Normal file → Executable file
View File

@ -4,7 +4,7 @@ USING: arrays assocs combinators continuations documents
ui.tools.workspace hashtables io io.styles kernel math
math.vectors models namespaces parser prettyprint quotations
sequences strings threads listener tuples ui.commands
ui.gadgets ui.gadgets.controls ui.gadgets.editors
ui.gadgets ui.gadgets.editors
ui.gadgets.presentations ui.gadgets.worlds ui.gestures ;
IN: ui.tools.interactor

4
extra/ui/tools/listener/listener-tests.factor Normal file → Executable file
View File

@ -1,7 +1,7 @@
USING: continuations documents ui.tools.interactor
ui.tools.listener hashtables kernel namespaces parser sequences
timers tools.test ui.commands ui.gadgets.controls
ui.gadgets.editors ui.gadgets.panes vocabs words ;
timers tools.test ui.commands ui.gadgets.editors
ui.gadgets.panes vocabs words ;
IN: temporary
timers [ init-timers ] unless

2
extra/ui/tools/search/search-tests.factor Normal file → Executable file
View File

@ -1,6 +1,6 @@
USING: assocs ui.tools.search help.topics io.files io.styles
kernel namespaces sequences source-files threads timers
tools.test ui.gadgets ui.gadgets.controls ui.gestures vocabs
tools.test ui.gadgets ui.gestures vocabs
vocabs.loader words ;
IN: temporary

2
extra/ui/tools/search/search.factor Normal file → Executable file
View File

@ -4,7 +4,7 @@ USING: assocs ui.tools.interactor ui.tools.listener
ui.tools.workspace help help.topics io.files io.styles kernel
models namespaces prettyprint quotations sequences sorting
source-files strings tools.completion tools.crossref tuples
ui.commands ui.gadgets ui.gadgets.controls ui.gadgets.editors
ui.commands ui.gadgets ui.gadgets.editors
ui.gadgets.lists ui.gadgets.scrollers ui.gadgets.tracks
ui.gestures ui.operations vocabs words vocabs.loader
tools.browser ;

4
extra/ui/tools/tools-tests.factor Normal file → Executable file
View File

@ -1,13 +1,13 @@
USING: ui.tools ui.tools.interactor ui.tools.listener
ui.tools.search ui.tools.workspace kernel models namespaces
sequences timers tools.test ui.gadgets ui.gadgets.buttons
ui.gadgets.controls ui.gadgets.labelled ui.gadgets.presentations
ui.gadgets.labelled ui.gadgets.presentations
ui.gadgets.scrollers vocabs ;
IN: temporary
[
[ f ] [
0 <model> <gadget> [ 2drop ] <control> gadget set
0 <model> <gadget> [ set-gadget-model ] keep gadget set
<workspace-tabs> gadget-children empty?
] unit-test
] with-scope

2
extra/ui/tools/tools.factor Normal file → Executable file
View File

@ -5,7 +5,7 @@ ui.tools.operations ui.tools.browser ui.tools.inspector
ui.tools.listener ui.tools.profiler ui.tools.walker
ui.tools.operations inspector io kernel math models namespaces
prettyprint quotations sequences ui ui.commands ui.gadgets
ui.gadgets.books ui.gadgets.buttons ui.gadgets.controls
ui.gadgets.books ui.gadgets.buttons
ui.gadgets.labelled ui.gadgets.scrollers ui.gadgets.tracks
ui.gadgets.worlds ui.gadgets.presentations ui.gestures words
vocabs.loader tools.test ui.gadgets.buttons

2
extra/ui/tools/traceback/traceback.factor Normal file → Executable file
View File

@ -1,7 +1,7 @@
! Copyright (C) 2006, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: continuations kernel models namespaces prettyprint ui
ui.commands ui.gadgets ui.gadgets.controls ui.gadgets.labelled
ui.commands ui.gadgets ui.gadgets.labelled
ui.gadgets.tracks ui.gestures ;
IN: ui.tools.traceback

2
extra/ui/tools/workspace/workspace.factor Normal file → Executable file
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: classes continuations help help.topics kernel models
sequences ui ui.backend ui.tools.debugger ui.gadgets
ui.gadgets.books ui.gadgets.buttons ui.gadgets.controls
ui.gadgets.books ui.gadgets.buttons
ui.gadgets.labelled ui.gadgets.panes ui.gadgets.scrollers
ui.gadgets.tracks ui.gadgets.worlds ui.gadgets.presentations
ui.gadgets.status-bar ui.commands ui.gestures assocs arrays