diff --git a/extra/boids/boids.factor b/extra/boids/boids.factor index ab624a606b..8c045ee270 100644 --- a/extra/boids/boids.factor +++ b/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 ; diff --git a/extra/boids/ui/ui.factor b/extra/boids/ui/ui.factor index 064eda841b..38dd9b4f78 100755 --- a/extra/boids/ui/ui.factor +++ b/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>> ; - -: 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 ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/golden-section/golden-section.factor b/extra/golden-section/golden-section.factor index 8ae8bccc25..a83dc988fd 100644 --- a/extra/golden-section/golden-section.factor +++ b/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 ; -: 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 ; diff --git a/extra/processing/shapes/shapes.factor b/extra/processing/shapes/shapes.factor new file mode 100644 index 0000000000..16530c5414 --- /dev/null +++ b/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 -- ) + + { 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 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 ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +