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

Fix uses of new math constants

db4
Aaron Schaefer 2008-01-24 18:18:12 -05:00
parent 6d5c1bf1d2
commit 6df78419b9
2 changed files with 27 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,28 +1,25 @@
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 ;
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 ;
IN: golden-section
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! To run:
!
! "demos.golden-section" run
! "golden-section" run
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: disk ( quadric radius center -- )
glPushMatrix
gl-translate
dup 0 glScalef
0 1 10 10 gluDisk
glPopMatrix ;
glPushMatrix
gl-translate
dup 0 glScalef
0 1 10 10 gluDisk
glPopMatrix ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: phi ( -- phi ) 5 sqrt 1 + 2 / 1 - ;
: omega ( i -- omega ) phi * 2 * pi * ;
: omega ( i -- omega ) phi 1- * 2 * pi * ;
: x ( i -- x ) dup omega cos * 0.5 * ;
@ -35,10 +32,10 @@ glPopMatrix ;
: color ( i -- color ) 360.0 / dup 0.25 1 4array ;
: rim ( quadric i -- )
black gl-color dup radius 1.5 * swap center disk ;
black gl-color dup radius 1.5 * swap center disk ;
: inner ( quadric i -- )
dup color gl-color dup radius swap center disk ;
dup color gl-color dup radius swap center disk ;
: dot ( quadric i -- ) 2dup rim inner ;
@ -47,21 +44,21 @@ dup color gl-color dup radius swap center disk ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: with-quadric ( quot -- )
gluNewQuadric [ swap call ] keep gluDeleteQuadric ; inline
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 ] with-quadric ;
: golden-section-window ( -- )
[
[ display ] <slate>
{ 600 600 } over set-slate-dim
"Golden Section" open-window
] with-ui ;
[
[ display ] <slate>
{ 600 600 } over set-slate-dim
"Golden Section" open-window
] with-ui ;
MAIN: golden-section-window
MAIN: golden-section-window

7
extra/project-euler/025/025.factor
View File

@ -1,7 +1,7 @@
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax kernel math math.functions math.parser math.ranges memoize
project-euler.common sequences ;
USING: alien.syntax kernel math math.constants math.functions math.parser
math.ranges memoize project-euler.common sequences ;
IN: project-euler.025
! http://projecteuler.net/index.php?section=problems&id=25
@ -67,9 +67,6 @@ PRIVATE>
<PRIVATE
: phi ( -- phi )
5 sqrt 1+ 2 / ;
: digit-fib* ( n -- term )
1- 5 log10 2 / + phi log10 / ceiling >integer ;