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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2008-08-05 00:47:36 -05:00
parent f798cdcde4 085a9b9ff4
commit d486e1a341
10 changed files with 116 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
extra/cfdg/cfdg.factor
View File

@ -4,7 +4,8 @@ USING: kernel alien.c-types combinators namespaces arrays
math math.functions math.vectors math.trig math math.functions math.vectors math.trig
opengl.gl opengl.glu opengl ui ui.gadgets.slate opengl.gl opengl.glu opengl ui ui.gadgets.slate
vars colors self self.slots vars colors self self.slots
random-weighted colors.hsv cfdg.gl accessors ; random-weighted colors.hsv cfdg.gl accessors
ui.gadgets.handler ui.gestures assocs ui.gadgets ;
IN: cfdg IN: cfdg
@ -130,7 +131,7 @@ VAR: threshold
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: recursive ( quot -- ) iterate? swap when ; : recursive ( quot -- ) iterate? swap when ; inline
: multi ( seq -- ) random-weighted* call ; : multi ( seq -- ) random-weighted* call ;
@ -155,6 +156,28 @@ VAR: start-shape
: set-initial-color ( -- ) T{ hsva f 0 0 0 1 } clone >self ; : set-initial-color ( -- ) T{ hsva f 0 0 0 1 } clone >self ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SYMBOL: dlist
! : build-model-dlist ( -- )
! 1 glGenLists dlist set
! dlist get GL_COMPILE_AND_EXECUTE glNewList
! start-shape> call
! glEndList ;
: build-model-dlist ( -- )
1 glGenLists dlist set
dlist get GL_COMPILE_AND_EXECUTE glNewList
set-initial-color
self> set-color
start-shape> call
glEndList ;
: display ( -- ) : display ( -- )
GL_PROJECTION glMatrixMode GL_PROJECTION glMatrixMode
@ -172,15 +195,43 @@ VAR: start-shape
init-modelview-matrix-stack init-modelview-matrix-stack
init-color-stack init-color-stack
set-initial-color dlist get not
[ build-model-dlist ]
[ dlist get glCallList ]
if ;
self> set-color ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
start-shape> call ; : delete-dlist ( -- ) dlist get [ dlist get 1 glDeleteLists dlist off ] when ;
: cfdg-window* ( -- ) : cfdg-window* ( -- )
[ display ] closed-quot <slate> C[ display ] <slate>
{ 500 500 } over set-slate-pdim { 500 500 } >>pdim
C[ delete-dlist ] >>ungraft
dup "CFDG" open-window ; dup "CFDG" open-window ;
: cfdg-window ( -- ) [ cfdg-window* ] with-ui ; : cfdg-window ( -- ) [ cfdg-window* ] with-ui ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SYMBOL: the-slate
: rebuild ( -- ) delete-dlist the-slate get relayout-1 ;
: <cfdg-gadget> ( -- slate )
C[ display ] <slate>
dup the-slate set
{ 500 500 } >>pdim
C[ dlist get [ dlist get 1 glDeleteLists ] when ] >>ungraft
<handler>
H{ } clone
T{ key-down f f "ENTER" } C[ drop rebuild ] swap pick set-at
T{ button-down } C[ drop rebuild ] swap pick set-at
>>table ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
USE: fry
: cfdg-window. ( quot -- )
'[ [ @ <cfdg-gadget> "CFDG" open-window ] with-scope ] with-ui ;

13
extra/cfdg/models/aqua-star/aqua-star.factor
View File

@ -25,11 +25,12 @@ iterate? [
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: run ( -- ) : init ( -- )
[ -1 b ] >background [ -1 b ] >background
{ -60 140 -120 140 } viewport set { -60 140 -120 140 } >viewport
0.1 threshold set 0.1 >threshold
[ anemone-begin ] start-shape set [ anemone-begin ] >start-shape ;
cfdg-window ;
: run ( -- ) [ init ] cfdg-window. ;
MAIN: run MAIN: run

13
extra/cfdg/models/chiaroscuro/chiaroscuro.factor
View File

@ -29,11 +29,12 @@ DEFER: white
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: run ( -- ) : init ( -- )
[ -0.5 b ] >background [ -0.5 b ] >background
{ -3 6 -2 6 } viewport set { -3 6 -2 6 } >viewport
0.01 threshold set 0.01 >threshold
[ chiaroscuro ] start-shape set [ chiaroscuro ] >start-shape ;
cfdg-window ;
: run ( -- ) [ init ] cfdg-window. ;
MAIN: run MAIN: run

13
extra/cfdg/models/flower6/flower6.factor
View File

@ -18,12 +18,13 @@ iterate? [
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: run ( -- ) : init ( -- )
[ ] >background [ ] >background
{ -1 2 -1 2 } viewport set { -1 2 -1 2 } >viewport
0.01 threshold set 0.01 >threshold
[ flower6 ] start-shape set [ flower6 ] >start-shape ;
cfdg-window ;
: run ( -- ) [ init ] cfdg-window. ;
MAIN: run MAIN: run

13
extra/cfdg/models/game1-turn6/game1-turn6.factor
View File

@ -37,11 +37,12 @@ DEFER: start
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: run ( -- ) : init ( -- )
[ 66 hue 0.4 sat 0.5 b ] >background [ 66 hue 0.4 sat 0.5 b ] >background
{ -5 10 -5 10 } viewport set { -5 10 -5 10 } >viewport
0.001 >threshold 0.001 >threshold
[ start ] >start-shape [ start ] >start-shape ;
cfdg-window ;
: run ( -- ) [ init ] cfdg-window. ;
MAIN: run MAIN: run

13
extra/cfdg/models/lesson/lesson.factor
View File

@ -96,12 +96,13 @@ iterate? [
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: run ( -- ) : init ( -- )
[ ] >background [ ] >background
{ -5 25 -15 25 } viewport set { -5 25 -15 25 } >viewport
0.03 threshold set 0.03 >threshold
[ toc ] start-shape set [ toc ] >start-shape ;
cfdg-window ;
: run ( -- ) [ init ] cfdg-window. ;
MAIN: run MAIN: run

7
extra/cfdg/models/rules08/rules08.factor
View File

@ -51,12 +51,13 @@ DEFER: line
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: run ( -- ) : init ( -- )
[ -1 b ] >background [ -1 b ] >background
{ -20 40 -20 40 } viewport set { -20 40 -20 40 } viewport set
[ centre ] >start-shape [ centre ] >start-shape
0.0001 >threshold 0.0001 >threshold ;
cfdg-window ;
: run ( -- ) [ init ] cfdg-window. ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

16
extra/cfdg/models/sierpinski/sierpinski.factor
View File

@ -26,14 +26,12 @@ iterate? [
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: run ( -- ) : init ( -- )
[ ] >background [ ] >background
{ -4 8 -4 8 } viewport set { -4 8 -4 8 } >viewport
0.01 >threshold 0.01 >threshold
[ top ] >start-shape [ top ] >start-shape ;
cfdg-window ;
MAIN: run
: run ( -- ) [ init ] cfdg-window. ;
MAIN: run

13
extra/cfdg/models/snowflake/snowflake.factor
View File

@ -25,12 +25,13 @@ spike
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: run ( -- ) : init ( -- )
[ ] >background [ ] >background
{ -40 80 -40 80 } viewport set { -40 80 -40 80 } >viewport
0.1 threshold set 0.1 >threshold
[ snowflake ] start-shape set [ snowflake ] >start-shape ;
cfdg-window ;
: run ( -- ) [ init ] cfdg-window. ;
MAIN: run MAIN: run

7
extra/cfdg/models/spirales/spirales.factor
View File

@ -29,12 +29,13 @@ DEFER: line
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: run ( -- ) : init ( -- )
[ -1 b ] >background [ -1 b ] >background
{ -20 40 -20 40 } viewport set { -20 40 -20 40 } viewport set
[ line ] >start-shape [ line ] >start-shape
0.03 >threshold 0.03 >threshold ;
cfdg-window ;
: run ( -- ) [ init ] cfdg-window. ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!