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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2008-07-28 06:31:40 -05:00
parent d817efe1dd 4f10ed4aaf
commit 462588e10f
4 changed files with 137 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/boids/boids.factor
View File

@ -220,7 +220,7 @@ cond ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: init-boids ( -- ) 50 random-boids >boids ;
: init-boids ( -- ) 100 random-boids >boids ;
: init-world-size ( -- ) { 100 100 } >world-size ;

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

@ -1,6 +1,7 @@
USING: combinators.short-circuit kernel namespaces
math
math.trig
math.functions
math.vectors
math.parser
@ -21,7 +22,8 @@ USING: combinators.short-circuit kernel namespaces
ui.gestures
assocs.lib vars rewrite-closures boids accessors
math.geometry.rect
newfx ;
newfx
processing.shapes ;
IN: boids.ui
@ -29,17 +31,21 @@ IN: boids.ui
! draw-boid
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: point-a ( boid -- a ) pos>> ;
: point-b ( boid -- b ) [ pos>> ] [ vel>> normalize* 20 v*n ] bi v+ ;
: boid-points ( boid -- point-a point-b ) [ point-a ] [ point-b ] bi ;
: draw-boid ( boid -- ) boid-points gl-line ;
: draw-boid ( boid -- )
glPushMatrix
dup pos>> gl-translate-2d
vel>> first2 rect> arg rad>deg 0 0 1 glRotated
{ { 0 5 } { 0 -5 } { 20 0 } } triangle
fill-mode
glPopMatrix ;
: draw-boids ( -- ) boids> [ draw-boid ] each ;
: display ( -- ) black gl-color draw-boids ;
: boid-color ( -- color ) { 1.0 0 0 0.3 } ;
: display ( -- )
boid-color >fill-color
draw-boids ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

24
extra/golden-section/golden-section.factor
View File

@ -1,21 +1,14 @@
USING: kernel namespaces math math.constants math.functions arrays sequences
USING: kernel namespaces math math.constants math.functions math.order
arrays sequences
opengl opengl.gl opengl.glu ui ui.render ui.gadgets ui.gadgets.theme
ui.gadgets.slate colors accessors combinators.cleave ;
ui.gadgets.slate colors accessors combinators.cleave
processing.shapes ;
IN: golden-section
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: disk ( radius center -- )
glPushMatrix
gl-translate
dup 0 glScalef
gluNewQuadric [ 0 1 20 20 gluDisk ] [ gluDeleteQuadric ] bi
glPopMatrix ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! omega(i) = 2*pi*i*(phi-1)
! x(i) = 0.5*i*cos(omega(i))
@ -34,12 +27,13 @@ IN: golden-section
: radius ( i -- radius ) pi * 720 / sin 10 * ;
: color ( i -- color ) 360.0 / dup 0.25 1 4array ;
: color ( i -- i ) dup 360.0 / dup 0.25 1 4array >fill-color ;
: rim ( i -- ) [ drop black gl-color ] [ radius 1.5 * ] [ center ] tri disk ;
: inner ( i -- ) [ color gl-color ] [ radius ] [ center ] tri disk ;
: line-width ( i -- i ) dup radius 0.5 * 1 max glLineWidth ;
: dot ( i -- ) [ rim ] [ inner ] bi ;
: draw ( i -- ) [ center ] [ radius 1.5 * 2 * ] bi circle ;
: dot ( i -- ) color line-width draw ;
: golden-section ( -- ) 720 [ dot ] each ;

112
extra/processing/shapes/shapes.factor Normal file
View File

@ -0,0 +1,112 @@
USING: kernel namespaces arrays sequences grouping
alien.c-types
math math.vectors math.geometry.rect
opengl.gl opengl.glu opengl generalizations vars
combinators.cleave ;
IN: processing.shapes
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
VAR: fill-color
VAR: stroke-color
{ 0 0 0 1 } stroke-color set-global
{ 1 1 1 1 } fill-color set-global
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: fill-mode ( -- )
GL_FRONT_AND_BACK GL_FILL glPolygonMode
fill-color> gl-color ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: stroke-mode ( -- )
GL_FRONT_AND_BACK GL_LINE glPolygonMode
stroke-color> gl-color ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: gl-vertex-2d ( vertex -- ) first2 glVertex2d ;
: gl-vertices-2d ( vertices -- ) [ gl-vertex-2d ] each ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: point* ( x y -- ) stroke-mode GL_POINTS [ glVertex2d ] do-state ;
: point ( point -- ) stroke-mode GL_POINTS [ gl-vertex-2d ] do-state ;
: points ( points -- ) stroke-mode GL_POINTS [ gl-vertices-2d ] do-state ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: line** ( x y x y -- )
stroke-mode GL_LINES [ glVertex2d glVertex2d ] do-state ;
: line* ( a b -- ) stroke-mode GL_LINES [ [ gl-vertex-2d ] bi@ ] do-state ;
: lines ( seq -- ) stroke-mode GL_LINES [ gl-vertices-2d ] do-state ;
: line ( seq -- ) lines ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: triangles ( seq -- )
[ fill-mode GL_TRIANGLES [ gl-vertices-2d ] do-state ]
[ stroke-mode GL_TRIANGLES [ gl-vertices-2d ] do-state ] bi ;
: triangle ( seq -- ) triangles ;
: triangle* ( a b c -- ) 3array triangles ;
: triangle** ( x y x y x y -- ) 6 narray 2 group triangles ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: polygon ( seq -- )
[ fill-mode GL_POLYGON [ gl-vertices-2d ] do-state ]
[ stroke-mode GL_POLYGON [ gl-vertices-2d ] do-state ] bi ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: rectangle ( loc dim -- )
<rect>
{ top-left top-right bottom-right bottom-left }
1arr
polygon ;
: rectangle* ( x y width height -- ) [ 2array ] 2bi@ rectangle ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: gl-translate-2d ( pos -- ) first2 0 glTranslated ;
: gl-scale-2d ( xy -- ) first2 1 glScaled ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: gl-ellipse ( center dim -- )
glPushMatrix
[ gl-translate-2d ] [ gl-scale-2d ] bi*
gluNewQuadric
dup 0 0.5 20 1 gluDisk
gluDeleteQuadric
glPopMatrix ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: gl-get-line-width ( -- width )
GL_LINE_WIDTH 0 <double> tuck glGetDoublev *double ;
: ellipse ( center dim -- )
GL_FRONT_AND_BACK GL_FILL glPolygonMode
[ stroke-color> gl-color gl-ellipse ]
[ fill-color> gl-color gl-get-line-width 2 * dup 2array v- gl-ellipse ] 2bi ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: circle ( center size -- ) dup 2array ellipse ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!