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 USING: kernel namespaces math math.constants math.functions arrays sequences
arrays sequences opengl opengl.gl opengl.glu ui ui.render opengl opengl.gl opengl.glu ui ui.render ui.gadgets ui.gadgets.theme
ui.gadgets ui.gadgets.theme ui.gadgets.slate colors ; ui.gadgets.slate colors ;
IN: golden-section IN: golden-section
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! To run: ! To run:
! ! "golden-section" run
! "demos.golden-section" run
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: disk ( quadric radius center -- ) : disk ( quadric radius center -- )
glPushMatrix glPushMatrix
gl-translate gl-translate
dup 0 glScalef dup 0 glScalef
0 1 10 10 gluDisk 0 1 10 10 gluDisk
glPopMatrix ; glPopMatrix ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: phi ( -- phi ) 5 sqrt 1 + 2 / 1 - ; : omega ( i -- omega ) phi 1- * 2 * pi * ;
: omega ( i -- omega ) phi * 2 * pi * ;
: x ( i -- x ) dup omega cos * 0.5 * ; : x ( i -- x ) dup omega cos * 0.5 * ;
@ -35,10 +32,10 @@ glPopMatrix ;
: color ( i -- color ) 360.0 / dup 0.25 1 4array ; : color ( i -- color ) 360.0 / dup 0.25 1 4array ;
: rim ( quadric i -- ) : 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 -- ) : 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 ; : dot ( quadric i -- ) 2dup rim inner ;
@ -47,21 +44,21 @@ dup color gl-color dup radius swap center disk ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: with-quadric ( quot -- ) : with-quadric ( quot -- )
gluNewQuadric [ swap call ] keep gluDeleteQuadric ; inline gluNewQuadric [ swap call ] keep gluDeleteQuadric ; inline
: display ( -- ) : display ( -- )
GL_PROJECTION glMatrixMode GL_PROJECTION glMatrixMode
glLoadIdentity glLoadIdentity
-400 400 -400 400 -1 1 glOrtho -400 400 -400 400 -1 1 glOrtho
GL_MODELVIEW glMatrixMode GL_MODELVIEW glMatrixMode
glLoadIdentity glLoadIdentity
[ golden-section ] with-quadric ; [ golden-section ] with-quadric ;
: golden-section-window ( -- ) : golden-section-window ( -- )
[ [
[ display ] <slate> [ display ] <slate>
{ 600 600 } over set-slate-dim { 600 600 } over set-slate-dim
"Golden Section" open-window "Golden Section" open-window
] with-ui ; ] 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. ! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.syntax kernel math math.functions math.parser math.ranges memoize USING: alien.syntax kernel math math.constants math.functions math.parser
project-euler.common sequences ; math.ranges memoize project-euler.common sequences ;
IN: project-euler.025 IN: project-euler.025
! http://projecteuler.net/index.php?section=problems&id=25 ! http://projecteuler.net/index.php?section=problems&id=25
@ -67,9 +67,6 @@ PRIVATE>
<PRIVATE <PRIVATE
: phi ( -- phi )
5 sqrt 1+ 2 / ;
: digit-fib* ( n -- term ) : digit-fib* ( n -- term )
1- 5 log10 2 / + phi log10 / ceiling >integer ; 1- 5 log10 2 / + phi log10 / ceiling >integer ;