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

golden-section: Use processing.shapes

db4
Eduardo Cavazos 2008-07-28 00:49:34 -05:00
parent 1c091ed24b
commit d6ad62ebf0
1 changed files with 9 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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 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 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) ! omega(i) = 2*pi*i*(phi-1)
! x(i) = 0.5*i*cos(omega(i)) ! x(i) = 0.5*i*cos(omega(i))
@ -34,12 +27,13 @@ IN: golden-section
: radius ( i -- radius ) pi * 720 / sin 10 * ; : 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 ; : golden-section ( -- ) 720 [ dot ] each ;