scroller fix, rename 2unseq ==> first2, 3unseq ==> first3, string>number works with...

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index e02c592c5254ce456a389937e5fa92ac9b01276a..9c63726b48c7493286fca6f694d9fc29c157aa7d 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -10,7 +10,6 @@
 - closing ui does not stop timers\r
 - adding/removing timers automatically for animated gadgets\r
 - theme abstraction in ui\r
-- menu dragging\r
 - find out why so many small bignums get consed\r
 - use incremental strategy for all pack layouts where possible\r
 - multiline editing in listener\r

diff --git a/doc/handbook.tex b/doc/handbook.tex
index 250b42439f21e2ad1181b8846decd27106f94c82..a8bf7729ff5e467330fab5e33f7fdb8eeb00806e 100644 (file)
--- a/doc/handbook.tex
+++ b/doc/handbook.tex
@@ -2678,8 +2678,8 @@ Note the naming convention here; the \verb|first| word actually gets the 0th ele
 \end{verbatim}
 \wordtable{
 \vocabulary{sequences}
-\ordinaryword{2unseq}{2unseq ( seq -- first second )}
-\ordinaryword{3unseq}{3unseq ( seq -- first second third )}
+\ordinaryword{first2}{first2 ( seq -- first second )}
+\ordinaryword{first3}{first3 ( seq -- first second third )}
 }
 Outputs the first two, or the first three elements of the sequence, respectively.
 

diff --git a/library/alien/compiler.factor b/library/alien/compiler.factor
index 9a033101613520f9527a52cf56c7538fed96c3f6..6be67f90a5ce00c0cb46bdb566b7532abf0238af 100644 (file)
--- a/library/alien/compiler.factor
+++ b/library/alien/compiler.factor
@@ -132,7 +132,7 @@ M: alien-node linearize-node* ( node -- )
 
 : unpair ( seq -- odds evens )
     2 swap group flip dup empty?
-    [ drop { } { } ] [ 2unseq ] ifte ;
+    [ drop { } { } ] [ first2 ] ifte ;
 
 : parse-arglist ( lst -- types stack effect )
     unpair [

diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor
index 0e02885e543132cdddfae591748e745a561b59a9..fa089c8af33db63696ab2f155cc7f9bfaa2e8f33 100644 (file)
--- a/library/bootstrap/primitives.factor
+++ b/library/bootstrap/primitives.factor
@@ -22,7 +22,7 @@ f crossref set
 vocabularies get [ "syntax" set [ reveal ] each ] bind
 
 : make-primitive ( { vocab word } n -- )
-    >r 2unseq create r> f define ;
+    >r first2 create r> f define ;
 
 {
     { "execute" "words"                     }
@@ -198,7 +198,7 @@ vocabularies get [ "syntax" set [ reveal ] each ] bind
 } dup length 3 swap [ + ] map-with [ make-primitive ] 2each
 
 : set-stack-effect ( { vocab word effect } -- )
-    3unseq >r lookup r> "stack-effect" set-word-prop ;
+    first3 >r lookup r> "stack-effect" set-word-prop ;
 
 {
     { "drop" "kernel" " x -- " }

diff --git a/library/collections/sequences.factor b/library/collections/sequences.factor
index 5097fde77e45021bbaae3fe3091a55f87d5b57c6..81bc1165d8e73f7c2b705395909b10b9f5cf430e 100644 (file)
--- a/library/collections/sequences.factor
+++ b/library/collections/sequences.factor
@@ -54,10 +54,10 @@ G: find ( seq quot -- i elt | quot: elt -- ? )
 
 : 2nth ( s s n -- x x ) tuck swap nth >r swap nth r> ; inline
 
-: 2unseq ( { x y } -- x y )
+: first2 ( { x y } -- x y )
     dup first swap second ; inline
 
-: 3unseq ( { x y z } -- x y z )
+: first3 ( { x y z } -- x y z )
     dup first over second rot third ; inline
 
 TUPLE: bounds-error index seq ;

diff --git a/library/compiler/intrinsics.factor b/library/compiler/intrinsics.factor
index 00d33f4d62a7aa13757f560740455f1c0b0b54fb..1330b3a2801dd655611b64934095fa82567d0877 100644 (file)
--- a/library/compiler/intrinsics.factor
+++ b/library/compiler/intrinsics.factor
@@ -144,7 +144,7 @@ sequences vectors words ;
 
 : values>vregs ( in -- in )
     value/vreg-list
-    dup [ 3unseq load-value ] each
+    dup [ first3 load-value ] each
     [ first <vreg> ] map ;
 
 : load-inputs ( node -- in )
@@ -152,7 +152,7 @@ sequences vectors words ;
     [ length swap node-out-d length - %dec-d , ] keep ;
 
 : binary-op-reg ( node op -- )
-    >r load-inputs 2unseq swap dup r> execute ,
+    >r load-inputs first2 swap dup r> execute ,
     0 0 %replace-d , ; inline
 
 : literal-immediate? ( value -- ? )

diff --git a/library/compiler/linearizer.factor b/library/compiler/linearizer.factor
index cf7ea9063f51f6eefd56eb8065551cceb6948a10..23ca7b2304328f2c0a77eca2935de674b2eb4698 100644 (file)
--- a/library/compiler/linearizer.factor
+++ b/library/compiler/linearizer.factor
@@ -66,7 +66,7 @@ M: #drop linearize-node* ( node -- )
     in-1  1 %dec-d , 0 %jump-t , ;
 
 M: #ifte linearize-node* ( node -- )
-    node-children 2unseq
+    node-children first2
     <label> dup ifte-head
     swap linearize-node ( false branch )
     %label , ( branch target of BRANCH-T )

diff --git a/library/compiler/x86/assembler.factor b/library/compiler/x86/assembler.factor
index a1c3a12da411316c4a1b197238b08e27cf130b77..6fd06f6ef6fab070c0cedf2045ce8bca0b92d998 100644 (file)
--- a/library/compiler/x86/assembler.factor
+++ b/library/compiler/x86/assembler.factor
@@ -88,7 +88,7 @@ M: indirect canonicalize dup car EBP = [ drop [ EBP 0 ] ] when ;
 ( Displaced indirect register operands -- eg, [ EAX 4 ]        )
 PREDICATE: cons displaced
     dup length 2 =
-    [ 2unseq integer? swap register? and ] [ drop f ] ifte ;
+    [ first2 integer? swap register? and ] [ drop f ] ifte ;
 
 M: displaced modifier second byte? BIN: 01 BIN: 10 ? ;
 M: displaced register car register ;

diff --git a/library/generic/slots.factor b/library/generic/slots.factor
index 350d65093e3c7b3ee59637b3225570078b18d60f..80ecf3850a8d2a378fa957e8f261dfc930fad644 100644 (file)
--- a/library/generic/slots.factor
+++ b/library/generic/slots.factor
@@ -30,17 +30,17 @@ sequences strings vectors words ;
     >r >r 2dup r> define-reader r> define-writer ;
 
 : ?create ( { name vocab }/f -- word )
-    dup [ 2unseq create ] when ;
+    dup [ first2 create ] when ;
 
 : intern-slots ( spec -- spec )
-    [ 3unseq swap ?create swap ?create 3vector ] map ;
+    [ first3 swap ?create swap ?create 3vector ] map ;
 
 : define-slots ( class spec -- )
     #! Define a collection of slot readers and writers for the
     #! given class. The spec is a list of lists of length 3 of
     #! the form [ slot reader writer ]. slot is an integer,
     #! reader and writer are either words, strings or f.
-    [ 3unseq define-slot ] each-with ;
+    [ first3 define-slot ] each-with ;
 
 : reader-word ( class name -- word )
     >r word-name "-" r> append3 "in" get 2vector ;

diff --git a/library/inference/branches.factor b/library/inference/branches.factor
index ca443c326dcdf726245a697a1f521217e2bbdb14..52394eb2edaa4e2b34f1d305563843104dd8e22e 100644 (file)
--- a/library/inference/branches.factor
+++ b/library/inference/branches.factor
@@ -11,7 +11,7 @@ namespaces parser prettyprint sequences strings vectors words ;
     [ [ required-inputs ] keep append ] map-with ;
 
 : unify-length ( seq seq -- seq )
-    2vector unify-lengths 2unseq ;
+    2vector unify-lengths first2 ;
 
 : unify-values ( seq -- value )
     #! If all values in list are equal, return the value.

diff --git a/library/inference/call-optimizers.factor b/library/inference/call-optimizers.factor
index 3d116a5d6f586614f2a2f819027c28a3fafa9257..6d981787f157e114000a26b7af69036ef4b0920f 100644 (file)
--- a/library/inference/call-optimizers.factor
+++ b/library/inference/call-optimizers.factor
@@ -38,7 +38,7 @@ sequences vectors words ;
     ] catch ;
 
 : flip-branches ( #ifte -- )
-    dup node-children 2unseq swap 2vector swap set-node-children ;
+    dup node-children first2 swap 2vector swap set-node-children ;
 
 \ not {
     { [ dup node-successor #ifte? ] [ node-successor dup flip-branches ] }
@@ -47,7 +47,7 @@ sequences vectors words ;
 : disjoint-eq? ( node -- ? )
     dup node-classes swap node-in-d
     [ swap hash ] map-with
-    2unseq 2dup and [ classes-intersect? not ] [ 2drop f ] ifte ;
+    first2 2dup and [ classes-intersect? not ] [ 2drop f ] ifte ;
 
 \ eq? {
     { [ dup disjoint-eq? ] [ [ f ] inline-literals ] }

diff --git a/library/inference/known-words.factor b/library/inference/known-words.factor
index 3d1c5d8a78f30248c62caf93f92b6b0e31bd6ce1..0d74a0b5379bf572069ab11ccc28aabd1285a918 100644 (file)
--- a/library/inference/known-words.factor
+++ b/library/inference/known-words.factor
@@ -26,7 +26,7 @@ memory parser sequences strings vectors words prettyprint ;
 \ cond [ [ object ] [ ] ] "infer-effect" set-word-prop
 
 \ cond [
-    pop-literal [ 2unseq cons ] map
+    pop-literal [ first2 cons ] map
     [ no-cond ] swap alist>quot infer-quot-value
 ] "infer" set-word-prop
 

diff --git a/library/inference/words.factor b/library/inference/words.factor
index daa1ff052c4873de8cb664cc0688b42d4eec46ed..9e5391880a7ed1284e321e8ffd4ced3efb8a7b82 100644 (file)
--- a/library/inference/words.factor
+++ b/library/inference/words.factor
@@ -16,7 +16,7 @@ hashtables parser prettyprint ;
     #! produces a number of values.
     swap #call [
         over [
-            2unseq swap consume-d produce-d
+            first2 swap consume-d produce-d
         ] hairy-node
     ] keep node, ;
 

diff --git a/library/math/math.factor b/library/math/math.factor
index 79f7ac0d163f261b5adf9f6fa5fcdfcabf42ed5a..8ab99a324fff0e5769d6d93a691c293a639cafaf 100644 (file)
--- a/library/math/math.factor
+++ b/library/math/math.factor
@@ -87,5 +87,4 @@ GENERIC: abs ( z -- |z| )
         dup 1 = [ drop 0 ] [ 2 /i log2 1 + ] ifte
     ] ifte ; foldable
 
-GENERIC: string>number ( str -- num ) foldable
 GENERIC: number>string ( str -- num ) foldable

diff --git a/library/math/parse-numbers.factor b/library/math/parse-numbers.factor
index a955370a95b6991978508e337d9c0d853cc07d9a..6a14eb9bfaabd9aeb3f7c7acb63487064d601355 100644 (file)
--- a/library/math/parse-numbers.factor
+++ b/library/math/parse-numbers.factor
@@ -29,14 +29,15 @@ M: object digit> not-a-number ;
     #! conversion fails.
     swap "-" ?head >r (base>) r> [ neg ] when ;
 
-M: string string>number 10 base> ;
-
-PREDICATE: string potential-ratio CHAR: / swap member? ;
-M: potential-ratio string>number ( str -- num )
+: string>ratio ( "a/b" -- a/b )
     "/" split1 >r 10 base> r> 10 base> / ;
 
-PREDICATE: string potential-float CHAR: . swap member? ;
-M: potential-float string>number ( str -- num ) string>float ;
+: string>number ( string -- n )
+    {
+        { [ CHAR: / over member? ] [ string>ratio ] }
+        { [ CHAR: . over member? ] [ string>float ] }
+        { [ t ] [ 10 base> ] }
+    } cond ;
 
 : bin> 2 base> ;
 : oct> 8 base> ;

diff --git a/library/sdl/sdl-utils.factor b/library/sdl/sdl-utils.factor
index 20d79be7de57356c951e15eed660136c177f8e6b..6ea4c32332e88e9d3adccf5cc4cb6d12aaec4600 100644 (file)
--- a/library/sdl/sdl-utils.factor
+++ b/library/sdl/sdl-utils.factor
@@ -21,7 +21,7 @@ SYMBOL: bpp
     [ >r init-screen r> call SDL_Quit ] with-scope ; inline
 
 : rgb ( [ r g b ] -- n )
-    3unseq
+    first3
     255
     swap >fixnum 8 shift bitor
     swap >fixnum 16 shift bitor

diff --git a/library/syntax/parse-syntax.factor b/library/syntax/parse-syntax.factor
index 2e9dff7438c77041fa9041767ec15abe4a5e8d07..b38714b3cafb609144bb8dc94abec258762456dc 100644 (file)
--- a/library/syntax/parse-syntax.factor
+++ b/library/syntax/parse-syntax.factor
@@ -46,7 +46,7 @@ words ;
 
 ! Conses (whose cdr might not be a list)
 : [[ f ; parsing
-: ]] 2unseq swons swons ; parsing
+: ]] first2 swons swons ; parsing
 
 ! Vectors
 : { f ; parsing

diff --git a/library/syntax/prettyprint.factor b/library/syntax/prettyprint.factor
index 4cc8ac91956738ce92dd2d14b578fc05fe3b1566..1bf739f9aaeadd6d54c090b7eaee0553e22684e9 100644 (file)
--- a/library/syntax/prettyprint.factor
+++ b/library/syntax/prettyprint.factor
@@ -361,4 +361,4 @@ M: wrapper pprint* ( wrapper -- )
     { POSTPONE: {{ POSTPONE: }} }
     { POSTPONE: [[ POSTPONE: ]] }
     { POSTPONE: [[ POSTPONE: ]] }
-} [ 2unseq define-close define-open ] each
+} [ first2 define-close define-open ] each

diff --git a/library/test/inference.factor b/library/test/inference.factor
index 7ac12ae91e39c4783582c482247e425b87221c81..a4529c237b099d57f99b0bd85b84c734d02c1d0a 100644 (file)
--- a/library/test/inference.factor
+++ b/library/test/inference.factor
@@ -2,7 +2,7 @@ IN: temporary
 USING: generic inference kernel lists math math-internals
 namespaces parser sequences test vectors ;
 
-: simple-effect 2unseq >r length r> length 2vector ;
+: simple-effect first2 >r length r> length 2vector ;
 
 [ { 0 2 } ] [ [ 2 "Hello" ] infer simple-effect ] unit-test
 [ { 1 2 } ] [ [ dup ] infer simple-effect ] unit-test

diff --git a/library/test/sequences.factor b/library/test/sequences.factor
index 80eb79c6069f41198d3c90d156d3f33b75d3039a..2fbdfbf5d01f8dbb0a70043de734ca99ac4291bc 100644 (file)
--- a/library/test/sequences.factor
+++ b/library/test/sequences.factor
@@ -12,7 +12,7 @@ test vectors ;
 [ { 3 4 } ] [ 0 2 2 4 1 10 <range> <slice> subseq >vector ] unit-test
 [ "cba" ] [ 3 "abcdef" head-slice reverse ] unit-test
 
-[ 1 2 3 ] [ 1 2 3 3vector 3unseq ] unit-test
+[ 1 2 3 ] [ 1 2 3 3vector first3 ] unit-test
 
 [ 5040 ] [ [ 1 2 3 4 5 6 7 ] 1 [ * ] reduce ] unit-test
 

diff --git a/library/ui/books.factor b/library/ui/books.factor
index eddf33b62b2772701ec6363baebe582444d3e357..da7963deece665ae3a982fd6cb90e3b359f350e2 100644 (file)
--- a/library/ui/books.factor
+++ b/library/ui/books.factor
@@ -46,7 +46,7 @@ TUPLE: book-browser book ;
         { "<"  [ find-book prev-page  ] }
         { ">"  [ find-book next-page  ] }
         { ">|" [ find-book last-page  ] }
-    ] [ 2unseq >r <label> r> <button> ] map
+    ] [ first2 >r <label> r> <button> ] map
     <shelf> [ add-gadgets ] keep ;
 
 C: book-browser ( book -- gadget )

diff --git a/library/ui/fonts.factor b/library/ui/fonts.factor
index 66f368efc9fc4441eae96b6144ccd0fa3105f576..4111759246b4993c0576da066e881ed4e621eed9 100644 (file)
--- a/library/ui/fonts.factor
+++ b/library/ui/fonts.factor
@@ -24,7 +24,7 @@ styles vectors ;
     [ resource-path % "/fonts/" % % ".ttf" % ] "" make ;
 
 : open-font ( [ font style ptsize ] -- alien )
-    3unseq >r ttf-name ttf-path r> TTF_OpenFont ;
+    first3 >r ttf-name ttf-path r> TTF_OpenFont ;
 
 SYMBOL: open-fonts
 

diff --git a/library/ui/paint.factor b/library/ui/paint.factor
index 4fe67e80ad6daad48f95053d2c754ef93688c9e5..52cbee47dcd9497a99a267bdbc5774ba9d93e449 100644 (file)
--- a/library/ui/paint.factor
+++ b/library/ui/paint.factor
@@ -7,7 +7,7 @@ namespaces sdl sequences strings styles vectors ;
 SYMBOL: clip
 
 : >sdl-rect ( rectangle -- sdlrect )
-    [ rect-loc 2unseq ] keep rect-dim 2unseq make-rect ;
+    [ rect-loc first2 ] keep rect-dim first2 make-rect ;
 
 : set-clip ( rect -- )
     #! The top/left corner of the clip rectangle is the location
@@ -69,7 +69,7 @@ TUPLE: solid ;
 
 : rect>screen ( shape -- x1 y1 x2 y2 )
     >r origin get dup r> rect-dim v+
-    >r 2unseq r> 2unseq >r 1 - r> 1 - ;
+    >r first2 r> first2 >r 1 - r> 1 - ;
 
 ! Solid pen
 M: solid draw-interior
@@ -129,10 +129,10 @@ M: gradient draw-interior ( gadget gradient -- )
 ! Bevel pen
 TUPLE: bevel width ;
 
-: x1/x2/y1 surface get pick pick >r 2unseq r> first swap ;
-: x1/x2/y2 surface get pick pick >r first r> 2unseq ;
-: x1/y1/y2 surface get pick pick >r 2unseq r> second ;
-: x2/y1/y2 surface get pick pick >r second r> 2unseq swapd ;
+: x1/x2/y1 surface get pick pick >r first2 r> first swap ;
+: x1/x2/y2 surface get pick pick >r first r> first2 ;
+: x1/y1/y2 surface get pick pick >r first2 r> second ;
+: x2/y1/y2 surface get pick pick >r second r> first2 swapd ;
 
 SYMBOL: bevel-1
 SYMBOL: bevel-2
@@ -173,7 +173,7 @@ M: gadget draw-gadget* ( gadget -- )
     <plain-gadget> dup << bevel f 2 >> boundary set-paint-prop ;
 
 : draw-line ( from to color -- )
-    >r >r >r surface get r> 2unseq r> 2unseq r> rgb lineColor ;
+    >r >r >r surface get r> first2 r> first2 r> rgb lineColor ;
 
 : draw-fanout ( from tos color -- )
     -rot [ >r 2dup r> rot draw-line ] each 2drop ;

diff --git a/library/ui/scrolling.factor b/library/ui/scrolling.factor
index 29c1c9d574caf98dc8db4401a9f399a32c3f6e07..d7316cc79a4295783c03376392a9ad27c9eeb9f6 100644 (file)
--- a/library/ui/scrolling.factor
+++ b/library/ui/scrolling.factor
@@ -26,14 +26,6 @@ C: viewport ( content -- viewport )
 
 M: viewport pref-dim gadget-child pref-dim ;
 
-M: viewport layout* ( viewport -- )
-    dup find-scroller scroller-origin vneg
-    swap gadget-child dup prefer
-    set-rect-loc ;
-
-M: viewport focusable-child* ( viewport -- gadget )
-    gadget-child ;
-
 : set-slider ( page max value slider -- )
     #! page/max/value are 3-vectors.
     [ [ slider-vector v. ] keep set-slider-value ] keep
@@ -46,10 +38,21 @@ M: viewport focusable-child* ( viewport -- gadget )
     r> r> set-slider ;
 
 : scroll ( scroller value -- )
-    2dup
-    over scroller-x update-slider
+    2dup over scroller-x update-slider
     over scroller-y update-slider ;
 
+: update-scroller ( scroller -- ) dup scroller-origin scroll ;
+
+: update-viewport ( viewport scroller -- )
+    scroller-origin vneg
+    swap gadget-child dup prefer set-rect-loc ;
+
+M: viewport layout* ( viewport -- )
+    dup find-scroller dup update-scroller update-viewport ;
+
+M: viewport focusable-child* ( viewport -- gadget )
+    gadget-child ;
+
 : add-viewport 2dup set-scroller-viewport add-center ;
 
 : add-x-slider 2dup set-scroller-x add-bottom ;

diff --git a/library/ui/sliders.factor b/library/ui/sliders.factor
index c31eca3798c2708fb20456579804fe8583c1b50c..3669ae2e78e5a46368b736e7914bdb3828a092ab 100644 (file)
--- a/library/ui/sliders.factor
+++ b/library/ui/sliders.factor
@@ -105,12 +105,12 @@ M: elevator pref-dim drop thumb-min ;
 : <up-button>
     <gadget> [ -1 swap slide-by-line ] <repeat-button> ;
 
-: add-up { 1 1 1 } over slider-vector v- 2unseq set-frame-child ;
+: add-up { 1 1 1 } over slider-vector v- first2 set-frame-child ;
 
 : <down-button>
     <gadget> [ 1 swap slide-by-line ] <repeat-button> ;
 
-: add-down { 1 1 1 } over slider-vector v+ 2unseq set-frame-child ;
+: add-down { 1 1 1 } over slider-vector v+ first2 set-frame-child ;
 
 : add-elevator 2dup set-slider-elevator add-center ;
 

diff --git a/library/ui/text.factor b/library/ui/text.factor
index d47c6188699856ba4f4d53b82045ae3ed87499d7..2b1908e7ac82d733b22a7fcc0fb80568ea274c22 100644 (file)
--- a/library/ui/text.factor
+++ b/library/ui/text.factor
@@ -27,8 +27,8 @@ sequences strings styles ;
         2drop
     ] [
         >r [ gadget-font ] keep r> swap
-        fg 3unseq make-color
+        fg first3 make-color
         TTF_RenderUNICODE_Blended
-        [ >r origin get 2unseq r> draw-surface ] keep
+        [ >r origin get first2 r> draw-surface ] keep
         SDL_FreeSurface
     ] ifte ;

diff --git a/library/ui/ui.factor b/library/ui/ui.factor
index 0dab64336c135d6e1605008d61ddf2dd8c2f63af..360ac9c82df3ef907c48956cb78005a7a8687774 100644 (file)
--- a/library/ui/ui.factor
+++ b/library/ui/ui.factor
@@ -47,7 +47,7 @@ IN: shells
     #! dimensions.
     ttf-init
     ?init-world
-    world get rect-dim 2unseq 0 SDL_RESIZABLE [
+    world get rect-dim first2 0 SDL_RESIZABLE [
         [
             ui-title dup SDL_WM_SetCaption
             start-world