diff --git a/basis/random/random.factor b/basis/random/random.factor index 5c93606ab5..be2d5955cd 100755 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -51,6 +51,9 @@ PRIVATE> [ length random-integer ] keep nth ] if-empty ; +: randomize ( seq -- seq' ) + dup length 1 (a,b] [ dup random pick exchange ] each ; + : delete-random ( seq -- elt ) [ length random-integer ] keep [ nth ] 2keep delete-nth ; diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor index 79a47380b6..efdd54bcc7 100644 --- a/basis/ui/gadgets/panes/panes.factor +++ b/basis/ui/gadgets/panes/panes.factor @@ -358,25 +358,25 @@ M: f sloppy-pick-up* [ 3drop { } ] if ; -: move-caret ( pane -- pane ) - dup hand-rel over sloppy-pick-up >>caret +: move-caret ( pane loc -- pane ) + over screen-loc v- over sloppy-pick-up >>caret dup relayout-1 ; : begin-selection ( pane -- ) f >>selecting? - move-caret + hand-loc get move-caret f >>mark drop ; : extend-selection ( pane -- ) hand-moved? [ dup selecting?>> [ - move-caret + hand-loc get move-caret ] [ dup hand-clicked get child? [ t >>selecting? dup hand-clicked set-global - move-caret + hand-click-loc get move-caret caret>mark ] when ] if @@ -394,7 +394,7 @@ M: f sloppy-pick-up* : select-to-caret ( pane -- ) t >>selecting? dup mark>> [ caret>mark ] unless - move-caret + hand-loc get move-caret dup request-focus com-copy-selection ; diff --git a/extra/automata/ui/ui.factor b/extra/automata/ui/ui.factor index 9210097cab..def71e7e67 100644 --- a/extra/automata/ui/ui.factor +++ b/extra/automata/ui/ui.factor @@ -15,7 +15,7 @@ USING: kernel namespaces math quotations arrays hashtables sequences threads ui.gadgets.theme ui.gadgets.handler accessors - namespaces.lib assocs.lib vars + vars fry rewrite-closures automata math.geometry.rect newfx ; IN: automata.ui @@ -24,9 +24,9 @@ IN: automata.ui : draw-point ( y x value -- ) 1 = [ swap glVertex2i ] [ 2drop ] if ; -: draw-line ( y line -- ) 0 swap [ >r 2dup r> draw-point 1+ ] each 2drop ; +: draw-line ( y line -- ) 0 swap [ [ 2dup ] dip draw-point 1+ ] each 2drop ; -: (draw-bitmap) ( bitmap -- ) 0 swap [ >r dup r> draw-line 1+ ] each drop ; +: (draw-bitmap) ( bitmap -- ) 0 swap [ [ dup ] dip draw-line 1+ ] each drop ; : draw-bitmap ( bitmap -- ) GL_POINTS glBegin (draw-bitmap) glEnd ; @@ -46,9 +46,9 @@ VAR: slate ! Create a quotation that is appropriate for buttons and gesture handler. -: view-action ( quot -- quot ) [ drop [ ] with-view ] make* closed-quot ; +: view-action ( quot -- quot ) '[ drop _ with-view ] closed-quot ; -: view-button ( label quot -- ) >r