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

use 1&& in a few places, clean up some more ui code

db4
Doug Coleman 2009-10-04 17:50:34 -05:00
parent a273cbb68e
commit 474e02020c
11 changed files with 65 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/ui/backend/x11/x11.factor
View File

@ -107,9 +107,9 @@ CONSTANT: key-codes
: valid-input? ( string gesture -- ? )
over empty? [ 2drop f ] [
mods>> { f { S+ } } member? [
[ [ 127 = not ] [ CHAR: \s >= ] bi and ] all?
[ { [ 127 = not ] [ CHAR: \s >= ] } 1&& ] all?
] [
[ [ 127 = not ] [ CHAR: \s >= ] [ alpha? not ] tri and and ] all?
[ { [ 127 = not ] [ CHAR: \s >= ] [ alpha? not ] } 1&& ] all?
] if
] if ;

26
basis/ui/gadgets/buttons/buttons.factor
View File

@ -1,12 +1,13 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays kernel math models namespaces sequences
strings quotations assocs combinators classes colors colors.constants
classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets
ui.gadgets.borders ui.gadgets.labels ui.gadgets.tracks
ui.gadgets.packs ui.gadgets.worlds ui.gestures ui.pens ui.pens.solid
ui.pens.image ui.pens.tile math.rectangles locals fry
combinators.smart ;
USING: accessors arrays assocs classes classes.tuple colors
colors.constants combinators combinators.short-circuit
combinators.smart fry kernel locals math math.rectangles
math.vectors models namespaces opengl opengl.gl quotations
sequences strings ui.commands ui.gadgets ui.gadgets.borders
ui.gadgets.labels ui.gadgets.packs ui.gadgets.tracks
ui.gadgets.worlds ui.gestures ui.pens ui.pens.image
ui.pens.solid ui.pens.tile ;
FROM: models => change-model ;
IN: ui.gadgets.buttons
@ -30,7 +31,7 @@ PRIVATE>
: button-update ( button -- )
dup
[ mouse-clicked? ] [ button-rollover? ] bi and
{ [ mouse-clicked? ] [ button-rollover? ] } 1&&
buttons-down? and
>>pressed?
relayout-1 ;
@ -42,8 +43,9 @@ PRIVATE>
dup "" swap show-status button-update ;
: button-clicked ( button -- )
dup button-update
dup button-rollover?
[ ]
[ button-update ]
[ button-rollover? ] tri
[ dup quot>> call( button -- ) ] [ drop ] if ;
button H{
@ -67,7 +69,9 @@ C: <button-pen> button-pen
: button-pen ( button pen -- button pen )
over find-button {
{ [ dup [ pressed?>> ] [ selected?>> ] bi and ] [ drop pressed-selected>> ] }
{ [ dup { [ pressed?>> ] [ selected?>> ] } 1&& ]
[ drop pressed-selected>>
] }
{ [ dup pressed?>> ] [ drop pressed>> ] }
{ [ dup selected?>> ] [ drop selected>> ] }
{ [ dup button-rollover? ] [ drop rollover>> ] }

5
basis/ui/gadgets/frames/frames.factor
View File

@ -26,7 +26,8 @@ M: glue pref-dim* drop { 0 0 } ;
length 1 + * [-] ; inline
: -center) ( pref-dim gap filled-cell dims -- )
[ nip available-space ] 2keep [ remove-nth sum [-] ] 2keep set-nth ; inline
[ nip available-space ]
[ [ remove-nth sum [-] ] [ set-nth ] 2bi ] 2bi ; inline
: (fill-center) ( frame grid-layout quot1 quot2 -- ) (fill- -center) ; inline
@ -35,7 +36,7 @@ M: glue pref-dim* drop { 0 0 } ;
[ [ second ] [ row-heights>> ] (fill-center) ] 2bi ;
: <frame-layout> ( frame -- grid-layout )
dup <grid-layout> [ fill-center ] keep ;
dup <grid-layout> [ fill-center ] [ ] bi ;
PRIVATE>

10
basis/ui/gadgets/gadgets.factor
View File

@ -85,7 +85,7 @@ M: gadget contains-point? ( loc gadget -- ? )
: pick-up ( point gadget -- child/f )
2dup [ dup point>rect ] dip children-on
[ contains-point? ] with find-last nip
[ [ loc>> v- ] keep pick-up ] [ nip ] ?if ;
[ [ loc>> v- ] [ pick-up ] bi ] [ nip ] ?if ;
: max-dim ( dims -- dim ) { 0 0 } [ vmax ] reduce ;
@ -115,7 +115,7 @@ M: gadget gadget-text-separator
gadget-text-separator '[ _ % ] [ gadget-text* ] interleave ;
M: gadget gadget-text*
[ children>> ] keep gadget-seq-text ;
[ children>> ] [ gadget-seq-text ] bi ;
M: array gadget-text*
[ gadget-text* ] each ;
@ -183,7 +183,7 @@ GENERIC: pref-dim* ( gadget -- dim )
: pref-dim ( gadget -- dim )
dup pref-dim>> [ ] [
[ pref-dim* ] keep dup layout-state>>
[ pref-dim* ] [ dup layout-state>> ] bi
[ drop ] [ dupd (>>pref-dim) ] if
] ?if ;
@ -267,7 +267,7 @@ M: gadget ungraft* drop ;
: notify ( gadget -- )
dup graft-state>>
[ first { f f } { t t } ? >>graft-state ] keep
[ first { f f } { t t } ? >>graft-state ] [ ] bi
{
{ { f t } [ dup activate-control graft* ] }
{ { t f } [ dup deactivate-control ungraft* ] }
@ -388,7 +388,7 @@ M: gadget request-focus-on parent>> request-focus-on ;
M: f request-focus-on 2drop ;
: request-focus ( gadget -- )
[ focusable-child ] keep request-focus-on ;
[ focusable-child ] [ request-focus-on ] bi ;
: focus-path ( gadget -- seq )
[ focus>> ] follow ;

9
basis/ui/gadgets/grids/grids.factor
View File

@ -27,7 +27,9 @@ PRIVATE>
: grid-child ( grid pair -- gadget ) grid@ nth ;
: grid-add ( grid child pair -- grid )
[ nip grid-child unparent ] [ drop add-gadget ] [ swapd grid@ set-nth ] 3tri ;
[ nip grid-child unparent ]
[ drop add-gadget ]
[ swapd grid@ set-nth ] 3tri ;
: grid-remove ( grid pair -- grid ) [ <gadget> ] dip grid-add ;
@ -114,8 +116,7 @@ M: grid layout* [ grid>> ] [ <grid-layout> ] bi grid-layout ;
M: grid children-on ( rect gadget -- seq )
dup children>> empty? [ 2drop f ] [
[ { 0 1 } ] dip grid>>
[ 0 <column> fast-children-on ] keep
<slice> concat
[ 0 <column> fast-children-on ] [ <slice> concat ] bi
] if ;
M: grid gadget-text*
@ -123,4 +124,4 @@ M: grid gadget-text*
[ [ gadget-text ] map ] map format-table
[ CHAR: \n , ] [ % ] interleave ;
PRIVATE>
PRIVATE>

2
basis/ui/gadgets/line-support/line-support.factor
View File

@ -79,7 +79,7 @@ PRIVATE>
[ second ] [ [ line-height ] [ min-rows>> ] [ max-rows>> ] tri ] bi* clamp ;
M: line-gadget pref-viewport-dim
[ pref-dim ] keep
[ pref-dim ] [ ] bi
[ line-gadget-width ]
[ line-gadget-height ]
2bi 2array ;

2
basis/ui/gadgets/tables/tables.factor
View File

@ -307,7 +307,7 @@ PRIVATE>
'[ _ row-value eq? ] with find drop ;
: (update-selected-indices) ( table -- set )
[ selection>> value>> dup [ array? not ] [ ] bi and [ 1array ] when ] keep
[ selection>> value>> dup { [ array? not ] [ ] } 1&& [ 1array ] when ] keep
'[ _ find-row-index ] map sift unique f assoc-like ;
: initial-selected-indices ( table -- set )

3
basis/ui/gadgets/tracks/tracks.factor
View File

@ -61,6 +61,7 @@ PRIVATE>
pick sizes>> push add-gadget ;
M: track remove-gadget
[ [ children>> index ] keep sizes>> delete-nth ] [ call-next-method ] 2bi ;
[ [ children>> index ] [ sizes>> ] bi delete-nth ]
[ call-next-method ] 2bi ;
: clear-track ( track -- ) [ sizes>> delete-all ] [ clear-gadget ] bi ;

7
basis/ui/operations/operations.factor
View File

@ -1,8 +1,7 @@
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays definitions kernel ui.commands
ui.gestures sequences strings math words generic namespaces
hashtables quotations assocs fry linked-assocs ;
USING: accessors arrays assocs combinators.short-circuit fry
kernel linked-assocs namespaces sequences ui.commands words ;
IN: ui.operations
SYMBOL: +keyboard+
@ -18,7 +17,7 @@ TUPLE: operation predicate command translator listener? ;
swap >>predicate ;
PREDICATE: listener-operation < operation
[ command>> listener-command? ] [ listener?>> ] bi or ;
{ [ command>> listener-command? ] [ listener?>> ] } 1|| ;
M: operation command-name
command>> command-name ;

26
basis/ui/tools/browser/browser.factor
View File

@ -1,14 +1,14 @@
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: debugger classes help help.topics help.crossref help.home
kernel models compiler.units assocs words vocabs accessors fry arrays
combinators.short-circuit namespaces sequences help.apropos
combinators ui ui.commands ui.gadgets ui.gadgets.panes
ui.gadgets.scrollers ui.gadgets.tracks ui.gestures ui.gadgets.buttons
ui.gadgets.packs ui.gadgets.editors ui.gadgets.labels
ui.gadgets.status-bar ui.gadgets.glass ui.gadgets.borders
ui.gadgets.viewports ui.tools.common ui.tools.browser.popups
ui.tools.browser.history ;
USING: accessors arrays assocs classes combinators
combinators.short-circuit compiler.units debugger fry help
help.apropos help.crossref help.home help.topics kernel models
sequences ui ui.commands ui.gadgets ui.gadgets.borders
ui.gadgets.buttons ui.gadgets.editors ui.gadgets.glass
ui.gadgets.labels ui.gadgets.panes ui.gadgets.scrollers
ui.gadgets.status-bar ui.gadgets.tracks ui.gadgets.viewports
ui.gestures ui.tools.browser.history ui.tools.browser.popups
ui.tools.common vocabs ;
IN: ui.tools.browser
TUPLE: browser-gadget < tool history scroller search-field popup ;
@ -95,8 +95,10 @@ M: browser-gadget focusable-child* search-field>> ;
"help.home" (browser-window) ;
: error-help-window ( error -- )
[ error-help ]
[ dup tuple? [ class ] [ drop "errors" ] if ] bi or (browser-window) ;
{
[ error-help ]
[ dup tuple? [ class ] [ drop "errors" ] if ]
} 1|| (browser-window) ;
\ browser-window H{ { +nullary+ t } } define-command
@ -162,4 +164,4 @@ browser-gadget "scrolling"
{ T{ key-down f f "PAGE_DOWN" } com-page-down }
} define-command-map
MAIN: browser-window
MAIN: browser-window

26
basis/ui/tools/profiler/profiler.factor
View File

@ -1,14 +1,15 @@
! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel quotations accessors fry assocs present math.order
math.vectors arrays locals models.search models.sort models sequences
vocabs tools.profiler words prettyprint combinators.smart
definitions.icons see ui ui.commands ui.gadgets ui.gadgets.panes
ui.gadgets.scrollers ui.gadgets.tracks ui.gestures ui.gadgets.buttons
ui.gadgets.tables ui.gadgets.search-tables ui.gadgets.labeled
ui.gadgets.packs ui.gadgets.labels ui.gadgets.tabbed
ui.gadgets.status-bar ui.gadgets.borders ui.tools.browser
ui.tools.common ui.baseline-alignment ui.operations ui.images ;
USING: accessors arrays assocs combinators.short-circuit
combinators.smart definitions.icons fry kernel locals
math.order models models.search models.sort present see
sequences tools.profiler ui.baseline-alignment ui.commands
ui.gadgets ui.gadgets.borders ui.gadgets.buttons
ui.gadgets.labeled ui.gadgets.labels ui.gadgets.packs
ui.gadgets.search-tables ui.gadgets.status-bar
ui.gadgets.tabbed ui.gadgets.tables ui.gadgets.tracks
ui.gestures ui.images ui.operations ui.tools.browser
ui.tools.common vocabs words ;
FROM: models.arrow => <arrow> ;
FROM: models.arrow.smart => <smart-arrow> ;
FROM: models.product => <product> ;
@ -105,9 +106,10 @@ M: method-renderer column-titles drop { "" "Method" "Count" } ;
: method-matches? ( method generic class -- ? )
[ first ] 2dip
[ drop dup [ subwords memq? ] [ 2drop t ] if ]
[ nip dup [ swap "method-class" word-prop = ] [ 2drop t ] if ]
3bi and ;
{
[ drop dup [ subwords memq? ] [ 2drop t ] if ]
[ nip dup [ swap "method-class" word-prop = ] [ 2drop t ] if ]
} 3&& ;
: <methods-model> ( profiler -- model )
[