From a2eb8a04310fca093ad5b44df09a536c82f20e03 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Fri, 18 Jul 2008 17:14:23 -0500
Subject: [PATCH] golden-section: revisit a few items
---
extra/golden-section/golden-section.factor | 68 +++++++++++-----------
1 file changed, 34 insertions(+), 34 deletions(-)
diff --git a/extra/golden-section/golden-section.factor b/extra/golden-section/golden-section.factor
index 354d4d9116..8ae8bccc25 100644
--- a/extra/golden-section/golden-section.factor
+++ b/extra/golden-section/golden-section.factor
@@ -1,64 +1,64 @@
+
USING: kernel namespaces math math.constants math.functions arrays sequences
- opengl opengl.gl opengl.glu ui ui.render ui.gadgets ui.gadgets.theme
- ui.gadgets.slate colors ;
+ opengl opengl.gl opengl.glu ui ui.render ui.gadgets ui.gadgets.theme
+ ui.gadgets.slate colors accessors combinators.cleave ;
+
IN: golden-section
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! To run:
-! "golden-section" run
+: disk ( radius center -- )
+ glPushMatrix
+ gl-translate
+ dup 0 glScalef
+ gluNewQuadric [ 0 1 20 20 gluDisk ] [ gluDeleteQuadric ] bi
+ glPopMatrix ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-: disk ( quadric radius center -- )
- glPushMatrix
- gl-translate
- dup 0 glScalef
- 0 1 10 10 gluDisk
- glPopMatrix ;
+! omega(i) = 2*pi*i*(phi-1)
+
+! x(i) = 0.5*i*cos(omega(i))
+! y(i) = 0.5*i*sin(omega(i))
+
+! radius(i) = 10*sin((pi*i)/720)
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: omega ( i -- omega ) phi 1- * 2 * pi * ;
-: x ( i -- x ) dup omega cos * 0.5 * ;
+: x ( i -- x ) [ omega cos ] [ 0.5 * ] bi * ;
+: y ( i -- y ) [ omega sin ] [ 0.5 * ] bi * ;
-: y ( i -- y ) dup omega sin * 0.5 * ;
-
-: center ( i -- point ) dup x swap y 2array ;
+: center ( i -- point ) { x y } 1arr ;
: radius ( i -- radius ) pi * 720 / sin 10 * ;
: color ( i -- color ) 360.0 / dup 0.25 1 4array ;
-: rim ( quadric i -- )
- black gl-color dup radius 1.5 * swap center disk ;
+: rim ( i -- ) [ drop black gl-color ] [ radius 1.5 * ] [ center ] tri disk ;
+: inner ( i -- ) [ color gl-color ] [ radius ] [ center ] tri disk ;
-: inner ( quadric i -- )
- dup color gl-color dup radius swap center disk ;
+: dot ( i -- ) [ rim ] [ inner ] bi ;
-: dot ( quadric i -- ) 2dup rim inner ;
-
-: golden-section ( quadric -- ) 720 [ dot ] with each ;
+: golden-section ( -- ) 720 [ dot ] each ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-: with-quadric ( quot -- )
- gluNewQuadric [ swap call ] keep gluDeleteQuadric ; inline
-
: display ( -- )
- GL_PROJECTION glMatrixMode
- glLoadIdentity
- -400 400 -400 400 -1 1 glOrtho
- GL_MODELVIEW glMatrixMode
- glLoadIdentity
- [ golden-section ] with-quadric ;
+ GL_PROJECTION glMatrixMode
+ glLoadIdentity
+ -400 400 -400 400 -1 1 glOrtho
+ GL_MODELVIEW glMatrixMode
+ glLoadIdentity
+ golden-section ;
: golden-section-window ( -- )
[
- [ display ] <slate>
- { 600 600 } over set-slate-pdim
- "Golden Section" open-window
- ] with-ui ;
+ [ display ] <slate>
+ { 600 600 } >>pdim
+ "Golden Section" open-window
+ ]
+ with-ui ;
MAIN: golden-section-window