Merge branch 'master' of git://repo.or.cz/factor/jcg

extra/bit-arrays/bit-arrays.factor

@@ -76,7 +76,7 @@ M: bit-array byte-length length 7 + -3 shift ;
     n zero? [ 0 <bit-array> ] [
         [let | out [ n log2 1+ <bit-array> ] i! [ 0 ] n'! [ n ] |
             [ n' zero? not ] [
-                n' out underlying>> i 255 bitand set-alien-unsigned-1
+                n' out underlying>> i set-alien-unsigned-1
                 n' -8 shift n'!
                 i 1+ i!
             ] [ ] while

extra/boids/boids.factor

@@ -6,14 +6,17 @@ USING: combinators.short-circuit kernel namespaces
        math.order
        math.vectors
        math.trig
+       math.physics.pos
+       math.physics.vel
        combinators arrays sequences random vars
-       combinators.lib ;
+       combinators.lib
+       accessors ;
 
 IN: boids
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-TUPLE: boid pos vel ;
+TUPLE: boid < vel ;
 
 C: <boid> boid
 
@@ -70,7 +73,7 @@ VAR: separation-radius
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: distance ( boid boid -- n ) [ boid-pos ] [ boid-pos ] bi* v- norm ;
+: distance ( boid boid -- n ) [ pos>> ] [ pos>> ] bi* v- norm ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -81,10 +84,10 @@ VAR: separation-radius
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: relative-position ( self other -- v ) swap [ boid-pos ] bi@ v- ;
+: relative-position ( self other -- v ) swap [ pos>> ] bi@ v- ;
 
 : relative-angle ( self other -- angle )
-over boid-vel -rot relative-position angle-between ;
+over vel>> -rot relative-position angle-between ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -92,9 +95,9 @@ over boid-vel -rot relative-position angle-between ;
 
 : vaverage ( seq-of-vectors -- seq ) [ vsum ] [ length ] bi v/n ;
 
-: average-position ( boids -- pos ) [ boid-pos ] map vaverage ;
+: average-position ( boids -- pos ) [ pos>> ] map vaverage ;
 
-: average-velocity ( boids -- vel ) [ boid-vel ] map vaverage ;
+: average-velocity ( boids -- vel ) [ vel>> ] map vaverage ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -123,7 +126,7 @@ over boid-vel -rot relative-position angle-between ;
   dup cohesion-neighborhood
   dup empty?
   [ 2drop { 0 0 } ]
-  [ average-position swap boid-pos v- normalize* cohesion-weight> v*n ]
+  [ average-position swap pos>> v- normalize* cohesion-weight> v*n ]
   if ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -143,7 +146,7 @@ over boid-vel -rot relative-position angle-between ;
   dup separation-neighborhood
   dup empty?
   [ 2drop { 0 0 } ]
-  [ average-position swap boid-pos swap v- normalize* separation-weight> v*n ]
+  [ average-position swap pos>> swap v- normalize* separation-weight> v*n ]
   if ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -206,10 +209,10 @@ cond ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: new-pos ( boid -- pos ) [ boid-pos ] [ boid-vel time-slice> v*n ] bi v+ ;
+: new-pos ( boid -- pos ) [ pos>> ] [ vel>> time-slice> v*n ] bi v+ ;
 
 : new-vel ( boid -- vel )
-  [ boid-vel ] [ acceleration time-slice> v*n ] bi v+ normalize* ;
+  [ vel>> ] [ acceleration time-slice> v*n ] bi v+ normalize* ;
 
 : wrap-pos ( pos -- pos ) { [ wrap-x ] [ wrap-y ] } parallel-call ;
 

extra/boids/ui/ui.factor

@@ -19,7 +19,8 @@ USING: combinators.short-circuit kernel namespaces
        ui.gadgets.packs
        ui.gadgets.grids
        ui.gestures
-       assocs.lib vars rewrite-closures boids ;
+       assocs.lib vars rewrite-closures boids accessors
+       math.geometry.rect ;
 
 IN: boids.ui
 
@@ -27,9 +28,9 @@ IN: boids.ui
 ! draw-boid
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: point-a ( boid -- a ) boid-pos ;
+: point-a ( boid -- a ) pos>> ;
 
-: point-b ( boid -- b ) [ boid-pos ] [ boid-vel normalize* 20 v*n ] bi v+ ;
+: point-b ( boid -- b ) [ pos>> ] [ vel>> normalize* 20 v*n ] bi v+ ;
 
 : boid-points ( boid -- point-a point-b ) [ point-a ] [ point-b ] bi ;
 

extra/bunny/bunny.factor

@@ -1,34 +1,25 @@
-USING: alien alien.c-types arrays sequences math math.vectors
+USING: accessors arrays bunny.cel-shaded bunny.fixed-pipeline
-math.matrices math.parser io io.files kernel opengl opengl.gl
+bunny.model bunny.outlined destructors kernel math opengl.demo-support
-opengl.glu shuffle http.client vectors namespaces ui.gadgets
+opengl.gl sequences ui ui.gadgets ui.gestures ui.render words ;
-ui.gadgets.canvas ui.render ui splitting combinators
-system combinators.lib float-arrays continuations
-opengl.demo-support multiline ui.gestures bunny.fixed-pipeline
-bunny.cel-shaded bunny.outlined bunny.model accessors destructors ;
 IN: bunny
 
-TUPLE: bunny-gadget model geom draw-seq draw-n ;
+TUPLE: bunny-gadget < demo-gadget model-triangles geom draw-seq draw-n ;
 
 : <bunny-gadget> ( -- bunny-gadget )
-    0.0 0.0 0.375 <demo-gadget>
+    0.0 0.0 0.375 bunny-gadget new-demo-gadget
-    maybe-download read-model {
+    maybe-download read-model >>model-triangles ;
-        set-delegate
-        (>>model)
-    } bunny-gadget construct ;
 
 : bunny-gadget-draw ( gadget -- draw )
-    { draw-n>> draw-seq>> }
+    [ draw-n>> ] [ draw-seq>> ] bi nth ;
-    get-slots nth ;
 
 : bunny-gadget-next-draw ( gadget -- )
-    dup { draw-seq>> draw-n>> }
+    dup [ draw-seq>> ] [ draw-n>> ] bi
-    get-slots
     1+ swap length mod
     >>draw-n relayout-1 ;
 
 M: bunny-gadget graft* ( gadget -- )
     GL_DEPTH_TEST glEnable
-    dup model>> <bunny-geom> >>geom
+    dup model-triangles>> <bunny-geom> >>geom
     dup
     [ <bunny-fixed-pipeline> ]
     [ <bunny-cel-shaded> ]
@@ -48,8 +39,7 @@ M: bunny-gadget draw-gadget* ( gadget -- )
         dup demo-gadget-set-matrices
         GL_MODELVIEW glMatrixMode
         0.02 -0.105 0.0 glTranslatef
-        { geom>> bunny-gadget-draw } get-slots
+        [ geom>> ] [ bunny-gadget-draw ] bi draw-bunny
-        draw-bunny
     ] if ;
 
 M: bunny-gadget pref-dim* ( gadget -- dim )

extra/bunny/model/model.factor

@@ -1,9 +1,7 @@
-USING: alien alien.c-types arrays sequences math math.vectors
+USING: accessors alien.c-types arrays combinators destructors http.client
-math.matrices math.parser io io.files kernel opengl opengl.gl
+io io.encodings.ascii io.files kernel math math.matrices math.parser
-opengl.glu io.encodings.ascii opengl.capabilities shuffle
+math.vectors opengl opengl.capabilities opengl.gl sequences sequences.lib
-http.client vectors splitting system combinators
+splitting vectors words ;
-float-arrays continuations destructors namespaces sequences.lib
-accessors ;
 IN: bunny.model
 
 : numbers ( str -- seq )
@@ -66,7 +64,7 @@ TUPLE: bunny-buffers array element-array nv ni ;
     {
         [
             [ first concat ] [ second concat ] bi
-            append >c-double-array
+            append >c-float-array
             GL_ARRAY_BUFFER swap GL_STATIC_DRAW <gl-buffer>
         ]
         [
@@ -86,10 +84,10 @@ M: bunny-dlist bunny-geom
 M: bunny-buffers bunny-geom
     dup { array>> element-array>> } get-slots [
         { GL_VERTEX_ARRAY GL_NORMAL_ARRAY } [
-            GL_DOUBLE 0 0 buffer-offset glNormalPointer
+            GL_FLOAT 0 0 buffer-offset glNormalPointer
             [
-                nv>> "double" heap-size * buffer-offset
+                nv>> "float" heap-size * buffer-offset
-                3 GL_DOUBLE 0 roll glVertexPointer
+                3 GL_FLOAT 0 roll glVertexPointer
             ] [
                 ni>>
                 GL_TRIANGLES swap GL_UNSIGNED_INT 0 buffer-offset glDrawElements

extra/bunny/outlined/outlined.factor

@@ -181,10 +181,9 @@ TUPLE: bunny-outlined
     ] [ drop ] if ;
 
 : remake-framebuffer-if-needed ( draw -- )
-    dup [ gadget>> dim>> ] [ framebuffer-dim>> ] bi
+    dup [ gadget>> dim>> ] [ framebuffer-dim>> ] bi =
-    over =
+    [ drop ] [
-    [ 2drop ] [
+        [ dispose-framebuffer ] [ dup ] [ gadget>> dim>> ] tri {
-        [ dup dispose-framebuffer dup ] dip {
             [
                 GL_RGBA16F_ARB GL_RGBA (framebuffer-texture)
                 [ >>color-texture drop ] keep
@@ -196,7 +195,8 @@ TUPLE: bunny-outlined
                 [ >>depth-texture drop ] keep
             ]
         } 2cleave
-        (make-framebuffer) >>framebuffer drop
+        [ (make-framebuffer) >>framebuffer ] [ >>framebuffer-dim ] bi
+        drop
     ] if ;
 
 : clear-framebuffer ( -- )

extra/math/geometry/rect/rect-docs.factor

@@ -0,0 +1,54 @@
+USING: help.markup help.syntax ;
+
+IN: math.geometry.rect
+
+HELP: rect
+{ $class-description "A rectangle with the following slots:"
+    { $list
+        { { $link rect-loc } " - the top-left corner of the rectangle as an x/y pair" }
+        { { $link rect-dim } " - the dimensions of the rectangle as a width/height pair" }
+    }
+    "Rectangles are constructed by calling " { $link <rect> } " and " { $link <extent-rect> } "."
+} ;
+
+HELP: <rect> ( loc dim -- rect )
+{ $values { "loc" "a pair of integers" } { "dim" "a pair of integers" } { "rect" "a new " { $link rect } } }
+{ $description "Creates a new rectangle with the specified top-left location and dimensions." } ;
+
+{ <zero-rect> <rect> <extent-rect> } related-words
+
+HELP: set-rect-dim ( dim rect -- )
+{ $values { "dim" "a pair of integers" } { "rect" rect } }
+{ $description "Modifies the dimensions of a rectangle." }
+{ $side-effects "rect" } ;
+
+HELP: rect-bounds
+{ $values { "rect" rect } { "loc" "a pair of integers" } { "dim" "a pair of integers" } }
+{ $description "Outputs the location and dimensions of a rectangle." } ;
+
+{ rect-bounds rect-extent } related-words
+
+HELP: <extent-rect> ( loc ext -- rect )
+{ $values { "loc" "a pair of integers" } { "ext" "a pair of integers" } { "rect" "a new " { $link rect } } }
+{ $description "Creates a new rectangle with the specified top-left and bottom-right corner locations." } ;
+
+HELP: rect-extent
+{ $values { "rect" rect } { "loc" "a pair of integers" } { "ext" "a pair of integers" } }
+{ $description "Outputs the location of the top-left and bottom-right corners of a rectangle." } ;
+
+HELP: offset-rect
+{ $values { "rect" rect } { "loc" "a pair of integers" } { "newrect" "a new " { $link rect } } }
+{ $description "Creates a new rectangle with the same dimensions, and top-left corner translated by " { $snippet "loc" } "." } ;
+
+HELP: rect-intersect
+{ $values { "rect1" rect } { "rect2" rect } { "newrect" "a new " { $link rect } } }
+{ $description "Computes the intersection of two rectangles." } ;
+
+HELP: intersects?
+{ $values { "rect/point" "a " { $link rect } " or a pair of integers" } { "rect" rect } { "?" "a boolean" } }
+{ $description "Tests if two rectangles (or a point and a rectangle, respectively) have a non-empty intersection." } ;
+
+HELP: <zero-rect>
+{ $values { "rect" "a new " { $link rect } } }
+{ $description "Creates a rectangle located at the origin with zero dimensions." } ;
+

extra/math/geometry/rect/rect.factor

@@ -0,0 +1,42 @@
+
+USING: kernel arrays math.vectors ;
+
+IN: math.geometry.rect
+
+TUPLE: rect { loc initial: { 0 0 } } { dim initial: { 0 0 } } ;
+
+: <zero-rect> ( -- rect ) rect new ;
+
+C: <rect> rect
+
+M: array rect-loc ;
+
+M: array rect-dim drop { 0 0 } ;
+
+: rect-bounds ( rect -- loc dim ) dup rect-loc swap rect-dim ;
+
+: rect-extent ( rect -- loc ext ) rect-bounds over v+ ;
+
+: 2rect-extent ( rect rect -- loc1 loc2 ext1 ext2 )
+    [ rect-extent ] bi@ swapd ;
+
+: <extent-rect> ( loc ext -- rect ) over [v-] <rect> ;
+
+: offset-rect ( rect loc -- newrect )
+    over rect-loc v+ swap rect-dim <rect> ;
+
+: (rect-intersect) ( rect rect -- array array )
+    2rect-extent vmin >r vmax r> ;
+
+: rect-intersect ( rect1 rect2 -- newrect )
+    (rect-intersect) <extent-rect> ;
+
+: intersects? ( rect/point rect -- ? )
+    (rect-intersect) [v-] { 0 0 } = ;
+
+: (rect-union) ( rect rect -- array array )
+    2rect-extent vmax >r vmin r> ;
+
+: rect-union ( rect1 rect2 -- newrect )
+    (rect-union) <extent-rect> ;
+

extra/math/physics/pos/pos.factor

@@ -0,0 +1,5 @@
+
+IN: math.physics.pos
+
+TUPLE: pos pos ;
+

extra/math/physics/vel/vel.factor

@@ -0,0 +1,7 @@
+
+USING: math.physics.pos ;
+
+IN: math.physics.vel
+
+TUPLE: vel < pos vel ;
+

extra/opengl/demo-support/demo-support.factor

@@ -9,10 +9,10 @@ IN: opengl.demo-support
 
 SYMBOL: last-drag-loc
 
-TUPLE: demo-gadget yaw pitch distance ;
+TUPLE: demo-gadget < gadget yaw pitch distance ;
 
-: <demo-gadget> ( yaw pitch distance -- gadget )
+: new-demo-gadget ( yaw pitch distance class -- gadget )
-    demo-gadget construct-gadget
+    new-gadget
         swap >>distance
         swap >>pitch
         swap >>yaw ;
@@ -31,19 +31,19 @@ M: demo-gadget distance-step ( gadget -- dz )
 : fov-ratio ( gadget -- fov ) dim>> dup first2 min v/n ;
 
 : yaw-demo-gadget ( yaw gadget -- )
-    [ [ demo-gadget-yaw + ] keep set-demo-gadget-yaw ] keep relayout-1 ;
+    [ + ] with change-yaw relayout-1 ;
 
 : pitch-demo-gadget ( pitch gadget -- )
-    [ [ demo-gadget-pitch + ] keep set-demo-gadget-pitch ] keep relayout-1 ;
+    [ + ] with change-pitch relayout-1 ;
 
 : zoom-demo-gadget ( distance gadget -- )
-    [ [ demo-gadget-distance + ] keep set-demo-gadget-distance ] keep relayout-1 ;
+    [ + ] with change-distance relayout-1 ;
 
 M: demo-gadget pref-dim* ( gadget -- dim )
     drop { 640 480 } ;
 
 : -+ ( x -- -x x )
-    dup neg swap ;
+    [ neg ] keep ;
 
 : demo-gadget-frustum ( gadget -- -x x -y y near far )
     [ near-plane ] [ far-plane ] [ fov-ratio ] tri [

extra/spheres/spheres.factor

@@ -99,14 +99,13 @@ main()
 }
 ;
 
-TUPLE: spheres-gadget
+TUPLE: spheres-gadget < demo-gadget
     plane-program solid-sphere-program texture-sphere-program
     reflection-framebuffer reflection-depthbuffer
     reflection-texture ;
 
 : <spheres-gadget> ( -- gadget )
-    20.0 10.0 20.0 <demo-gadget>
+    20.0 10.0 20.0 spheres-gadget new-demo-gadget ;
-    { set-delegate } spheres-gadget construct ;
 
 M: spheres-gadget near-plane ( gadget -- z )
     drop 1.0 ;

extra/springies/springies.factor

@@ -1,6 +1,6 @@
 
 USING: kernel combinators sequences arrays math math.vectors
-       generalizations vars ;
+       generalizations vars accessors math.physics.vel ;
 
 IN: springies
 
@@ -28,23 +28,27 @@ VAR: gravity
 ! node
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-TUPLE: node mass elas pos vel force ;
+! TUPLE: node mass elas pos vel force ;
+
+TUPLE: node < vel mass elas force ;
 
 C: <node> node
 
-: >>pos ( node pos -- node ) over set-node-pos ;
+! : >>pos ( node pos -- node ) over set-node-pos ;
 
-: >>vel ( node vel -- node ) over set-node-vel ;
+! : >>vel ( node vel -- node ) over set-node-vel ;
 
-: pos-x ( node -- x ) node-pos first ;
+: set-node-vel ( vel node -- ) swap >>vel drop ;
-: pos-y ( node -- y ) node-pos second ;
-: vel-x ( node -- y ) node-vel first ;
-: vel-y ( node -- y ) node-vel second ;
 
-: >>pos-x ( node x -- node ) over node-pos set-first ;
+: pos-x ( node -- x ) pos>> first ;
-: >>pos-y ( node y -- node ) over node-pos set-second ;
+: pos-y ( node -- y ) pos>> second ;
-: >>vel-x ( node x -- node ) over node-vel set-first ;
+: vel-x ( node -- y ) vel>> first ;
-: >>vel-y ( node y -- node ) over node-vel set-second ;
+: vel-y ( node -- y ) vel>> second ;
+
+: >>pos-x ( node x -- node ) over pos>> set-first ;
+: >>pos-y ( node y -- node ) over pos>> set-second ;
+: >>vel-x ( node x -- node ) over vel>> set-first ;
+: >>vel-y ( node y -- node ) over vel>> set-second ;
 
 : apply-force ( node vec -- ) over node-force v+ swap set-node-force ;
 
@@ -61,7 +65,7 @@ TUPLE: spring rest-length k damp node-a node-b ;
 C: <spring> spring
 
 : end-points ( spring -- b-pos a-pos )
-  [ spring-node-b node-pos ] [ spring-node-a node-pos ] bi ;
+  [ spring-node-b pos>> ] [ spring-node-a pos>> ] bi ;
 
 : spring-length ( spring -- length ) end-points v- norm ;
 
@@ -112,10 +116,10 @@ C: <spring> spring
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : relative-velocity-a ( spring -- vel )
-  [ spring-node-a node-vel ] [ spring-node-b node-vel ] bi v- ;
+  [ spring-node-a vel>> ] [ spring-node-b vel>> ] bi v- ;
 
 : unit-vec-b->a ( spring -- vec )
-  [ spring-node-a node-pos ] [ spring-node-b node-pos ] bi v- ;
+  [ spring-node-a pos>> ] [ spring-node-b pos>> ] bi v- ;
 
 : relative-velocity-along-spring-a ( spring -- vel )
   [ relative-velocity-a ] [ unit-vec-b->a ] bi vector-projection ;
@@ -126,10 +130,10 @@ C: <spring> spring
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : relative-velocity-b ( spring -- vel )
-  [ spring-node-b node-vel ] [ spring-node-a node-vel ] bi v- ;
+  [ spring-node-b vel>> ] [ spring-node-a vel>> ] bi v- ;
 
 : unit-vec-a->b ( spring -- vec )
-  [ spring-node-b node-pos ] [ spring-node-a node-pos ] bi v- ;
+  [ spring-node-b pos>> ] [ spring-node-a pos>> ] bi v- ;
 
 : relative-velocity-along-spring-b ( spring -- vel )
   [ relative-velocity-b ] [ unit-vec-a->b ] bi vector-projection ;
@@ -210,9 +214,9 @@ C: <spring> spring
 : calc-acceleration ( node -- vec ) [ node-force ] [ node-mass ] bi v/n ;
 
 : new-vel ( node -- vel )
-  [ node-vel ] [ calc-acceleration time-slice> v*n ] bi v+ ;
+  [ vel>> ] [ calc-acceleration time-slice> v*n ] bi v+ ;
 
-: new-pos ( node -- pos ) [ node-pos ] [ node-vel time-slice> v*n ] bi v+ ;
+: new-pos ( node -- pos ) [ pos>> ] [ vel>> time-slice> v*n ] bi v+ ;
 
 : iterate-node ( node -- )
   dup new-pos >>pos
@@ -231,16 +235,21 @@ C: <spring> spring
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : mass ( id x y x-vel y-vel mass elas -- )
-  7 nrot drop
+  node new
-  6 nrot 6 nrot 2array
+    swap >>elas
-  5 nrot 5 nrot 2array
+    swap >>mass
-  0 0 2array <node>
+    -rot 2array >>vel
-  nodes> swap suffix >nodes ;
+    -rot 2array >>pos
+    0 0  2array >>force
+  nodes> swap suffix >nodes
+  drop ;
 
 : spng ( id id-a id-b k damp rest-length -- )
-  6 nrot drop
+   spring new
-  -rot
+     swap >>rest-length
-  5 nrot node-id
+     swap >>damp
-  5 nrot node-id
+     swap >>k
-  <spring>
+     swap node-id >>node-b
-  springs> swap suffix >springs ;
+     swap node-id >>node-a
+   springs> swap suffix >springs
+   drop ;

extra/springies/ui/ui.factor

@@ -1,16 +1,16 @@
 
 USING: kernel namespaces threads sequences math math.vectors
        opengl.gl opengl colors ui ui.gadgets ui.gadgets.slate
-       fry rewrite-closures vars springies ;
+       fry rewrite-closures vars springies accessors math.geometry.rect ;
 
 IN: springies.ui
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: draw-node ( node -- ) node-pos { -5 -5 } v+ dup { 10 10 } v+ gl-rect ;
+: draw-node ( node -- ) pos>> { -5 -5 } v+ dup { 10 10 } v+ gl-rect ;
 
 : draw-spring ( spring -- )
-  [ spring-node-a node-pos ] [ spring-node-b node-pos ] bi gl-line ;
+  [ spring-node-a pos>> ] [ spring-node-b pos>> ] bi gl-line ;
 
 : draw-nodes ( -- ) nodes> [ draw-node ] each ;
 

extra/ui/cocoa/cocoa.factor

@@ -5,7 +5,7 @@ command-line kernel memory namespaces cocoa.messages
 cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types
 cocoa.windows cocoa.classes cocoa.application sequences system
 ui ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
-ui.cocoa.views core-foundation threads ;
+ui.cocoa.views core-foundation threads math.geometry.rect ;
 IN: ui.cocoa
 
 TUPLE: handle view window ;

extra/ui/cocoa/views/views.factor

@@ -4,7 +4,7 @@ USING: accessors alien alien.c-types arrays assocs cocoa kernel
 math cocoa.messages cocoa.subclassing cocoa.classes cocoa.views
 cocoa.application cocoa.pasteboard cocoa.types cocoa.windows
 sequences ui ui.gadgets ui.gadgets.worlds ui.gestures
-core-foundation threads combinators ;
+core-foundation threads combinators math.geometry.rect ;
 IN: ui.cocoa.views
 
 : send-mouse-moved ( view event -- )

extra/ui/gadgets/books/books.factor

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

extra/ui/gadgets/borders/borders.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays ui.gadgets kernel math
-namespaces vectors sequences math.vectors ;
+namespaces vectors sequences math.vectors math.geometry.rect ;
 IN: ui.gadgets.borders
 
 TUPLE: border < gadget

extra/ui/gadgets/buttons/buttons.factor

@@ -6,7 +6,7 @@ classes.tuple opengl math.vectors
 ui.commands ui.gadgets ui.gadgets.borders
 ui.gadgets.labels ui.gadgets.theme
 ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures
-ui.render ;
+ui.render math.geometry.rect ;
 IN: ui.gadgets.buttons
 
 TUPLE: button < border pressed? selected? quot ;

extra/ui/gadgets/editors/editors.factor

@@ -5,7 +5,8 @@ namespaces opengl opengl.gl sequences strings io.styles
 math.vectors sorting colors combinators assocs math.order
 ui.clipboards ui.commands ui.gadgets ui.gadgets.borders
 ui.gadgets.buttons ui.gadgets.labels ui.gadgets.scrollers
-ui.gadgets.theme ui.gadgets.wrappers ui.render ui.gestures ;
+ui.gadgets.theme ui.gadgets.wrappers ui.render ui.gestures
+math.geometry.rect ;
 IN: ui.gadgets.editors
 
 TUPLE: editor < gadget

extra/ui/gadgets/frames/frames.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2005, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays generic kernel math namespaces sequences words
-splitting grouping math.vectors ui.gadgets.grids ui.gadgets ;
+splitting grouping math.vectors ui.gadgets.grids ui.gadgets
+math.geometry.rect ;
 IN: ui.gadgets.frames
 
 ! A frame arranges gadgets in a 3x3 grid, where the center

extra/ui/gadgets/gadgets-docs.factor

@@ -1,53 +1,7 @@
 USING: help.markup help.syntax opengl kernel strings
-classes.tuple classes quotations models ;
+       classes.tuple classes quotations models math.geometry.rect ;
 IN: ui.gadgets
 
-HELP: rect
-{ $class-description "A rectangle with the following slots:"
-    { $list
-        { { $link rect-loc } " - the top-left corner of the rectangle as an x/y pair" }
-        { { $link rect-dim } " - the dimensions of the rectangle as a width/height pair" }
-    }
-    "Rectangles are constructed by calling " { $link <rect> } " and " { $link <extent-rect> } "."
-} ;
-
-HELP: <rect> ( loc dim -- rect )
-{ $values { "loc" "a pair of integers" } { "dim" "a pair of integers" } { "rect" "a new " { $link rect } } }
-{ $description "Creates a new rectangle with the specified top-left location and dimensions." } ;
-
-{ <zero-rect> <rect> <extent-rect> } related-words
-
-HELP: set-rect-dim ( dim rect -- )
-{ $values { "dim" "a pair of integers" } { "rect" rect } }
-{ $description "Modifies the dimensions of a rectangle. To resize a gadget, use " { $link set-gadget-dim } " or " { $link set-layout-dim } " instead." }
-{ $side-effects "rect" } ;
-
-HELP: rect-bounds
-{ $values { "rect" rect } { "loc" "a pair of integers" } { "dim" "a pair of integers" } }
-{ $description "Outputs the location and dimensions of a rectangle." } ;
-
-{ rect-bounds rect-extent } related-words
-
-HELP: <extent-rect> ( loc ext -- rect )
-{ $values { "loc" "a pair of integers" } { "ext" "a pair of integers" } { "rect" "a new " { $link rect } } }
-{ $description "Creates a new rectangle with the specified top-left and bottom-right corner locations." } ;
-
-HELP: rect-extent
-{ $values { "rect" rect } { "loc" "a pair of integers" } { "ext" "a pair of integers" } }
-{ $description "Outputs the location of the top-left and bottom-right corners of a rectangle." } ;
-
-HELP: offset-rect
-{ $values { "rect" rect } { "loc" "a pair of integers" } { "newrect" "a new " { $link rect } } }
-{ $description "Creates a new rectangle with the same dimensions, and top-left corner translated by " { $snippet "loc" } "." } ;
-
-HELP: rect-intersect
-{ $values { "rect1" rect } { "rect2" rect } { "newrect" "a new " { $link rect } } }
-{ $description "Computes the intersection of two rectangles." } ;
-
-HELP: intersects?
-{ $values { "rect/point" "a " { $link rect } " or a pair of integers" } { "rect" rect } { "?" "a boolean" } }
-{ $description "Tests if two rectangles (or a point and a rectangle, respectively) have a non-empty intersection." } ;
-
 HELP: gadget-child
 { $values { "gadget" gadget } { "child" gadget } }
 { $description "Outputs the first child of the gadget. Typically this word is used with gadgets which are known to have an only child." } ;
@@ -57,10 +11,6 @@ HELP: nth-gadget
 { $description "Outputs the " { $snippet "n" } "th child of the gadget." }
 { $errors "Throws an error if " { $snippet "n" } " is negative or greater than or equal to the number of children." } ;
 
-HELP: <zero-rect>
-{ $values { "rect" "a new " { $link rect } } }
-{ $description "Creates a rectangle located at the origin with zero dimensions." } ;
-
 HELP: <gadget>
 { $values { "gadget" "a new " { $link gadget } } }
 { $description "Creates a new gadget." } ;

extra/ui/gadgets/gadgets.factor

@@ -2,50 +2,15 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays hashtables kernel models math namespaces
        sequences quotations math.vectors combinators sorting vectors
-dlists dequeues models threads concurrency.flags math.order ;
+       dlists dequeues models threads concurrency.flags
+       math.order math.geometry.rect ;
+
 IN: ui.gadgets
 
 SYMBOL: ui-notify-flag
 
 : notify-ui-thread ( -- ) ui-notify-flag get-global raise-flag ;
 
-TUPLE: rect { loc initial: { 0 0 } } { dim initial: { 0 0 } } ;
-
-: <zero-rect> ( -- rect ) rect new ;
-
-C: <rect> rect
-
-M: array rect-loc ;
-
-M: array rect-dim drop { 0 0 } ;
-
-: rect-bounds ( rect -- loc dim ) dup rect-loc swap rect-dim ;
-
-: rect-extent ( rect -- loc ext ) rect-bounds over v+ ;
-
-: 2rect-extent ( rect rect -- loc1 loc2 ext1 ext2 )
-    [ rect-extent ] bi@ swapd ;
-
-: <extent-rect> ( loc ext -- rect ) over [v-] <rect> ;
-
-: offset-rect ( rect loc -- newrect )
-    over rect-loc v+ swap rect-dim <rect> ;
-
-: (rect-intersect) ( rect rect -- array array )
-    2rect-extent vmin >r vmax r> ;
-
-: rect-intersect ( rect1 rect2 -- newrect )
-    (rect-intersect) <extent-rect> ;
-
-: intersects? ( rect/point rect -- ? )
-    (rect-intersect) [v-] { 0 0 } = ;
-
-: (rect-union) ( rect rect -- array array )
-    2rect-extent vmax >r vmin r> ;
-
-: rect-union ( rect1 rect2 -- newrect )
-    (rect-union) <extent-rect> ;
-
 TUPLE: gadget < rect
 pref-dim parent children orientation focus
 visible? root? clipped? layout-state graft-state graft-node

extra/ui/gadgets/grid-lines/grid-lines.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math namespaces opengl opengl.gl sequences
-math.vectors ui.gadgets ui.gadgets.grids ui.render ;
+math.vectors ui.gadgets ui.gadgets.grids ui.render math.geometry.rect ;
 IN: ui.gadgets.grid-lines
 
 TUPLE: grid-lines color ;

extra/ui/gadgets/grids/grids.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel math namespaces sequences words io
-io.streams.string math.vectors ui.gadgets columns accessors ;
+io.streams.string math.vectors ui.gadgets columns accessors
+math.geometry.rect ;
 IN: ui.gadgets.grids
 
 TUPLE: grid < gadget

extra/ui/gadgets/incremental/incremental.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io kernel math namespaces math.vectors ui.gadgets
-ui.gadgets.packs accessors ;
+ui.gadgets.packs accessors math.geometry.rect ;
 IN: ui.gadgets.incremental
 
 ! Incremental layout allows adding lines to panes to be O(1).

extra/ui/gadgets/lists/lists.factor

@@ -4,7 +4,7 @@ USING: accessors ui.commands ui.gestures ui.render ui.gadgets
 ui.gadgets.labels ui.gadgets.scrollers
 kernel sequences models opengl math math.order namespaces
 ui.gadgets.presentations ui.gadgets.viewports ui.gadgets.packs
-math.vectors classes.tuple ;
+math.vectors classes.tuple math.geometry.rect ;
 IN: ui.gadgets.lists
 
 TUPLE: list < pack index presenter color hook ;

extra/ui/gadgets/menus/menus.factor

@@ -3,7 +3,8 @@
 USING: arrays ui.commands ui.gadgets ui.gadgets.buttons
 ui.gadgets.worlds ui.gestures generic hashtables kernel math
 models namespaces opengl sequences math.vectors
-ui.gadgets.theme ui.gadgets.packs ui.gadgets.borders colors ;
+ui.gadgets.theme ui.gadgets.packs ui.gadgets.borders colors
+math.geometry.rect ;
 IN: ui.gadgets.menus
 
 : menu-loc ( world menu -- loc )

extra/ui/gadgets/packs/packs.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: sequences ui.gadgets kernel math math.functions
-math.vectors namespaces math.order accessors ;
+math.vectors namespaces math.order accessors math.geometry.rect ;
 IN: ui.gadgets.packs
 
 TUPLE: pack < gadget

extra/ui/gadgets/panes/panes.factor

@@ -9,7 +9,7 @@ quotations math opengl combinators math.vectors
 sorting splitting io.streams.nested assocs
 ui.gadgets.presentations ui.gadgets.slots ui.gadgets.grids
 ui.gadgets.grid-lines classes.tuple models continuations
-destructors accessors ;
+destructors accessors math.geometry.rect ;
 IN: ui.gadgets.panes
 
 TUPLE: pane < pack

extra/ui/gadgets/paragraphs/paragraphs.factor

@@ -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.labels ui.render kernel math
-namespaces sequences math.order ;
+namespaces sequences math.order math.geometry.rect ;
 IN: ui.gadgets.paragraphs
 
 ! A word break gadget

extra/ui/gadgets/scrollers/scrollers-docs.factor

@@ -1,5 +1,5 @@
 USING: ui.gadgets help.markup help.syntax ui.gadgets.viewports
-ui.gadgets.sliders ;
+ui.gadgets.sliders math.geometry.rect ;
 IN: ui.gadgets.scrollers
 
 HELP: scroller

extra/ui/gadgets/scrollers/scrollers.factor

@@ -4,7 +4,7 @@ USING: accessors 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 models.range models.compose
-combinators math.vectors classes.tuple ;
+combinators math.vectors classes.tuple math.geometry.rect ;
 IN: ui.gadgets.scrollers
 
 TUPLE: scroller < frame viewport x y follows ;

extra/ui/gadgets/sliders/sliders.factor

@@ -4,7 +4,7 @@ USING: accessors arrays ui.gestures ui.gadgets ui.gadgets.buttons
 ui.gadgets.frames ui.gadgets.grids math.order
 ui.gadgets.theme ui.render kernel math namespaces sequences
 vectors models models.range math.vectors math.functions
-quotations colors ;
+quotations colors math.geometry.rect ;
 IN: ui.gadgets.sliders
 
 TUPLE: elevator < gadget direction ;

extra/ui/gadgets/tracks/tracks.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors io kernel math namespaces
-sequences words math.vectors ui.gadgets ui.gadgets.packs ;
+sequences words math.vectors ui.gadgets ui.gadgets.packs math.geometry.rect ;
 IN: ui.gadgets.tracks
 
 TUPLE: track < pack sizes ;

extra/ui/gadgets/viewports/viewports.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: ui.gadgets.viewports
 USING: accessors arrays ui.gadgets ui.gadgets.borders
-kernel math namespaces sequences models math.vectors ;
+kernel math namespaces sequences models math.vectors math.geometry.rect ;
 
 : viewport-gap { 3 3 } ; inline
 

extra/ui/gadgets/worlds/worlds.factor

@@ -3,7 +3,7 @@
 USING: accessors arrays assocs continuations kernel math models
 namespaces opengl sequences io combinators math.vectors
 ui.gadgets ui.gestures ui.render ui.backend ui.gadgets.tracks
-debugger ;
+debugger math.geometry.rect ;
 IN: ui.gadgets.worlds
 
 TUPLE: world < track

extra/ui/render/render-docs.factor

@@ -1,5 +1,5 @@
 USING: ui.gadgets ui.gestures help.markup help.syntax
-kernel classes strings opengl.gl models ;
+kernel classes strings opengl.gl models math.geometry.rect ;
 IN: ui.render
 
 HELP: gadget

extra/ui/render/render.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien arrays hashtables io kernel math namespaces opengl
 opengl.gl opengl.glu sequences strings io.styles vectors
-combinators math.vectors ui.gadgets colors math.order ;
+combinators math.vectors ui.gadgets colors
+math.order math.geometry.rect ;
 IN: ui.render
 
 SYMBOL: clip

extra/ui/ui-docs.factor

@@ -1,6 +1,6 @@
 USING: help.markup help.syntax strings quotations debugger
 io.styles namespaces ui.backend ui.gadgets ui.gadgets.worlds
-ui.gadgets.tracks ui.gadgets.packs ui.gadgets.grids ;
+ui.gadgets.tracks ui.gadgets.packs ui.gadgets.grids math.geometry.rect ;
 IN: ui
 
 HELP: windows

extra/ui/windows/windows.factor

@@ -8,7 +8,7 @@ sequences strings vectors words windows.kernel32 windows.gdi32
 windows.user32 windows.opengl32 windows.messages windows.types
 windows.nt windows threads libc combinators continuations
 command-line shuffle opengl ui.render unicode.case ascii
-math.bitfields locals symbols accessors ;
+math.bitfields locals symbols accessors math.geometry.rect ;
 IN: ui.windows
 
 SINGLETON: windows-ui-backend

extra/ui/x11/x11.factor

@@ -6,7 +6,7 @@ assocs kernel math namespaces opengl sequences strings x11.xlib
 x11.events x11.xim x11.glx x11.clipboard x11.constants
 x11.windows io.encodings.string io.encodings.ascii
 io.encodings.utf8 combinators debugger command-line qualified
-math.vectors classes.tuple opengl.gl threads ;
+math.vectors classes.tuple opengl.gl threads math.geometry.rect ;
 QUALIFIED: system
 IN: ui.x11
 

extra/windows/ole32/ole32.factor

@@ -10,6 +10,7 @@ TYPEDEF: void* LPUNKNOWN
 TYPEDEF: wchar_t* LPOLESTR
 TYPEDEF: wchar_t* LPCOLESTR
 
+TYPEDEF: REFGUID LPGUID
 TYPEDEF: REFGUID REFIID
 TYPEDEF: REFGUID REFCLSID