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

extra/boids/boids.factor

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

extra/boids/ui/ui.factor

@@ -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>> ;
+: draw-boid ( boid -- )
-
+  glPushMatrix
-: point-b ( boid -- b ) [ pos>> ] [ vel>> normalize* 20 v*n ] bi v+ ;
+    dup pos>> gl-translate-2d
-
+        vel>> first2 rect> arg rad>deg 0 0 1 glRotated
-: boid-points ( boid -- point-a point-b ) [ point-a ] [ point-b ] bi ;
+    { { 0 5 } { 0 -5 } { 20 0 } } triangle
-
+    fill-mode
-: draw-boid ( boid -- ) boid-points gl-line ;
+  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 ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

extra/golden-section/golden-section.factor

@@ -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 ;
+: line-width ( i -- i ) dup radius 0.5 * 1 max glLineWidth ;
-: inner ( i -- ) [      color gl-color ] [ radius       ] [ center ] tri disk ;
 
-: 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 ;
 

extra/processing/shapes/shapes.factor

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