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

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

db4
Slava Pestov 2008-07-12 01:22:03 -05:00
parent 7ca3c2a878 7608afbf4c
commit 9bdd178789
43 changed files with 238 additions and 209 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/bit-arrays/bit-arrays.factor
View File

@ -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

25
extra/boids/boids.factor
View File

@ -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 ;

7
extra/boids/ui/ui.factor
View File

@ -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 ;

30
extra/bunny/bunny.factor
View File

@ -1,34 +1,25 @@
USING: alien alien.c-types arrays sequences math math.vectors
math.matrices math.parser io io.files kernel opengl opengl.gl
opengl.glu shuffle http.client vectors namespaces ui.gadgets
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 ;
USING: accessors arrays bunny.cel-shaded bunny.fixed-pipeline
bunny.model bunny.outlined destructors kernel math opengl.demo-support
opengl.gl sequences ui ui.gadgets ui.gestures ui.render words ;
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>
maybe-download read-model {
set-delegate
(>>model)
} bunny-gadget construct ;
0.0 0.0 0.375 bunny-gadget new-demo-gadget
maybe-download read-model >>model-triangles ;
: bunny-gadget-draw ( gadget -- draw )
{ draw-n>> draw-seq>> }
get-slots nth ;
[ draw-n>> ] [ draw-seq>> ] bi nth ;
: bunny-gadget-next-draw ( gadget -- )
dup { draw-seq>> draw-n>> }
get-slots
dup [ draw-seq>> ] [ draw-n>> ] bi
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
draw-bunny
[ geom>> ] [ bunny-gadget-draw ] bi draw-bunny
] if ;
M: bunny-gadget pref-dim* ( gadget -- dim )

18
extra/bunny/model/model.factor
View File

@ -1,9 +1,7 @@
USING: alien alien.c-types arrays sequences math math.vectors
math.matrices math.parser io io.files kernel opengl opengl.gl
opengl.glu io.encodings.ascii opengl.capabilities shuffle
http.client vectors splitting system combinators
float-arrays continuations destructors namespaces sequences.lib
accessors ;
USING: accessors alien.c-types arrays combinators destructors http.client
io io.encodings.ascii io.files kernel math math.matrices math.parser
math.vectors opengl opengl.capabilities opengl.gl sequences sequences.lib
splitting vectors words ;
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
3 GL_DOUBLE 0 roll glVertexPointer
nv>> "float" heap-size * buffer-offset
3 GL_FLOAT 0 roll glVertexPointer
] [
ni>>
GL_TRIANGLES swap GL_UNSIGNED_INT 0 buffer-offset glDrawElements

10
extra/bunny/outlined/outlined.factor
View File

@ -181,10 +181,9 @@ TUPLE: bunny-outlined
] [ drop ] if ;
: remake-framebuffer-if-needed ( draw -- )
dup [ gadget>> dim>> ] [ framebuffer-dim>> ] bi
over =
[ 2drop ] [
[ dup dispose-framebuffer dup ] dip {
dup [ gadget>> dim>> ] [ framebuffer-dim>> ] bi =
[ drop ] [
[ dispose-framebuffer ] [ dup ] [ gadget>> dim>> ] tri {
[
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 ( -- )

54
extra/math/geometry/rect/rect-docs.factor Normal file
View File

@ -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." } ;

42
extra/math/geometry/rect/rect.factor Normal file
View File

@ -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> ;

5
extra/math/physics/pos/pos.factor Normal file
View File

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

7
extra/math/physics/vel/vel.factor Normal file
View File

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

14
extra/opengl/demo-support/demo-support.factor
View File

@ -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 )
demo-gadget construct-gadget
: new-demo-gadget ( yaw pitch distance class -- 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 [

5
extra/spheres/spheres.factor
View File

@ -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>
{ set-delegate } spheres-gadget construct ;
20.0 10.0 20.0 spheres-gadget new-demo-gadget ;
M: spheres-gadget near-plane ( gadget -- z )
drop 1.0 ;

69
extra/springies/springies.factor
View File

@ -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 ;
: pos-y ( node -- y ) node-pos second ;
: vel-x ( node -- y ) node-vel first ;
: vel-y ( node -- y ) node-vel second ;
: set-node-vel ( vel node -- ) swap >>vel drop ;
: >>pos-x ( node x -- node ) over node-pos set-first ;
: >>pos-y ( node y -- node ) over node-pos set-second ;
: >>vel-x ( node x -- node ) over node-vel set-first ;
: >>vel-y ( node y -- node ) over node-vel set-second ;
: pos-x ( node -- x ) pos>> first ;
: pos-y ( node -- y ) pos>> second ;
: vel-x ( node -- y ) vel>> first ;
: 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
6 nrot 6 nrot 2array
5 nrot 5 nrot 2array
0 0 2array <node>
nodes> swap suffix >nodes ;
node new
swap >>elas
swap >>mass
-rot 2array >>vel
-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
-rot
5 nrot node-id
5 nrot node-id
<spring>
springs> swap suffix >springs ;
spring new
swap >>rest-length
swap >>damp
swap >>k
swap node-id >>node-b
swap node-id >>node-a
springs> swap suffix >springs
drop ;

6
extra/springies/ui/ui.factor
View File

@ -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 ;

2
extra/ui/cocoa/cocoa.factor
View File

@ -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 ;

2
extra/ui/cocoa/views/views.factor
View File

@ -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 -- )

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

@ -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 ;

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

@ -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

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

@ -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 ;

3
extra/ui/gadgets/editors/editors.factor
View File

@ -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

3
extra/ui/gadgets/frames/frames.factor
View File

@ -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

52
extra/ui/gadgets/gadgets-docs.factor
View File

@ -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." } ;

43
extra/ui/gadgets/gadgets.factor
View File

@ -1,51 +1,16 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! 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 ;
sequences quotations math.vectors combinators sorting vectors
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

2
extra/ui/gadgets/grid-lines/grid-lines.factor
View File

@ -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 ;

3
extra/ui/gadgets/grids/grids.factor
View File

@ -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

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

@ -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).

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

@ -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 ;

3
extra/ui/gadgets/menus/menus.factor
View File

@ -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 )

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

@ -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

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

@ -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

2
extra/ui/gadgets/paragraphs/paragraphs.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.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

2
extra/ui/gadgets/scrollers/scrollers-docs.factor
View File

@ -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

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

@ -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 ;

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

@ -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 ;

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

@ -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 ;

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

@ -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

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

@ -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

2
extra/ui/render/render-docs.factor
View File

@ -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

3
extra/ui/render/render.factor
View File

@ -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

2
extra/ui/ui-docs.factor
View File

@ -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

2
extra/ui/windows/windows.factor
View File

@ -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

2
extra/ui/x11/x11.factor
View File

@ -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

1
extra/windows/ole32/ole32.factor
View File

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