--- /dev/null
+Eduardo Cavazos
--- /dev/null
+
+USING: kernel alien.c-types combinators namespaces make arrays
+ sequences sequences.lib namespaces.lib splitting
+ math math.functions math.vectors math.trig
+ opengl.gl opengl.glu opengl ui ui.gadgets.slate
+ vars colors self self.slots
+ random-weighted colors.hsv cfdg.gl accessors
+ ui.gadgets.handler ui.gestures assocs ui.gadgets macros
+ qualified specialized-arrays.double ;
+
+QUALIFIED: syntax
+
+IN: cfdg
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+SELF-SLOTS: hsva
+
+: clear-color ( color -- ) gl-clear-color GL_COLOR_BUFFER_BIT glClear ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! if (adjustment < 0)
+! base + base * adjustment
+
+! if (adjustment > 0)
+! base + (1 - base) * adjustment
+
+: adjust ( val num -- val ) dup 0 > [ 1 pick - * + ] [ dupd * + ] if ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: hue ( num -- ) hue-> + 360 mod ->hue ;
+
+: saturation ( num -- ) saturation-> swap adjust ->saturation ;
+: brightness ( num -- ) value-> swap adjust ->value ;
+: alpha ( num -- ) alpha-> swap adjust ->alpha ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: h ( num -- ) hue ;
+: sat ( num -- ) saturation ;
+: b ( num -- ) brightness ;
+: a ( num -- ) alpha ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+VAR: color-stack
+
+: init-color-stack ( -- ) V{ } clone >color-stack ;
+
+: push-color ( -- ) self> color-stack> push self> clone >self ;
+
+: pop-color ( -- ) color-stack> pop dup >self gl-color ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! : double-nth* ( c-array indices -- seq ) swap [ double-nth ] curry map ;
+
+: double-nth* ( c-array indices -- seq )
+ swap byte-array>double-array [ nth ] curry map ;
+
+: check-size ( modelview -- num ) { 0 1 4 5 } double-nth* [ abs ] map biggest ;
+
+VAR: threshold
+
+: iterate? ( -- ? ) get-modelview-matrix check-size threshold> > ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! cos 2a sin 2a 0 0
+! sin 2a -cos 2a 0 0
+! 0 0 1 0
+! 0 0 0 1
+
+! column major order
+
+: gl-flip ( angle -- ) deg>rad dup dup dup
+ [ 2 * cos , 2 * sin , 0 , 0 ,
+ 2 * sin , 2 * cos neg , 0 , 0 ,
+ 0 , 0 , 1 , 0 ,
+ 0 , 0 , 0 , 1 , ]
+ double-array{ } make underlying>> glMultMatrixd ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: circle ( -- )
+ self> gl-color
+ gluNewQuadric dup 0 0.5 20 10 gluDisk gluDeleteQuadric ;
+
+: triangle ( -- )
+ self> gl-color
+ GL_POLYGON glBegin
+ 0 0.577 glVertex2d
+ 0.5 -0.289 glVertex2d
+ -0.5 -0.289 glVertex2d
+ glEnd ;
+
+: square ( -- )
+ self> gl-color
+ GL_POLYGON glBegin
+ -0.5 0.5 glVertex2d
+ 0.5 0.5 glVertex2d
+ 0.5 -0.5 glVertex2d
+ -0.5 -0.5 glVertex2d
+ glEnd ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: size ( scale -- ) dup 1 glScaled ;
+
+: size* ( scale-x scale-y -- ) 1 glScaled ;
+
+: rotate ( angle -- ) 0 0 1 glRotated ;
+
+: x ( x -- ) 0 0 glTranslated ;
+
+: y ( y -- ) 0 swap 0 glTranslated ;
+
+: flip ( angle -- ) gl-flip ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: s ( scale -- ) size ;
+: s* ( scale-x scale-y -- ) size* ;
+: r ( angle -- ) rotate ;
+: f ( angle -- ) flip ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: do ( quot -- )
+ push-modelview-matrix
+ push-color
+ call
+ pop-modelview-matrix
+ pop-color ; inline
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: recursive ( quot -- ) iterate? swap when ; inline
+
+: multi ( seq -- ) random-weighted* call ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: [rules] ( seq -- quot )
+ [ unclip swap [ [ do ] curry ] map concat 2array ] map
+ [ call-random-weighted ] swap prefix
+ [ when ] swap prefix
+ [ iterate? ] swap append ;
+
+MACRO: rules ( seq -- quot ) [rules] ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: [rule] ( seq -- quot )
+ [ [ do ] swap prefix ] map concat
+ [ when ] swap prefix
+ [ iterate? ] prepend ;
+
+MACRO: rule ( seq -- quot ) [rule] ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+VAR: background
+
+: set-initial-background ( -- ) T{ hsva f 0 0 1 1 } clone >self ;
+
+: set-background ( -- )
+ set-initial-background
+ background> call
+ self> clear-color ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+USING: rewrite-closures ;
+
+VAR: viewport ! { left width bottom height }
+
+VAR: start-shape
+
+: 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> gl-color
+
+ start-shape> call
+
+ glEndList ;
+
+: display ( -- )
+
+ GL_PROJECTION glMatrixMode
+ glLoadIdentity
+ viewport> first dup viewport> second +
+ viewport> third dup viewport> fourth + gluOrtho2D
+
+ GL_MODELVIEW glMatrixMode
+ glLoadIdentity
+
+ set-background
+
+ GL_COLOR_BUFFER_BIT glClear
+
+ init-modelview-matrix-stack
+ init-color-stack
+
+ dlist get not
+ [ build-model-dlist ]
+ [ dlist get glCallList ]
+ if ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: delete-dlist ( -- ) dlist get [ dlist get 1 glDeleteLists dlist off ] when ;
+
+: cfdg-window* ( -- slate )
+ C[ display ] <slate>
+ { 500 500 } >>pdim
+ C[ delete-dlist ] >>ungraft
+ dup "CFDG" open-window ;
+
+: cfdg-window ( -- slate ) [ 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 ;
\ No newline at end of file
--- /dev/null
+Eduardo Cavazos
--- /dev/null
+
+USING: kernel alien.c-types namespaces sequences opengl.gl ;
+
+IN: cfdg.gl
+
+: get-modelview-matrix ( -- alien )
+ GL_MODELVIEW_MATRIX 16 "GLdouble" <c-array> tuck glGetDoublev ;
+
+SYMBOL: modelview-matrix-stack
+
+: init-modelview-matrix-stack ( -- ) V{ } clone modelview-matrix-stack set ;
+
+: push-modelview-matrix ( -- )
+ get-modelview-matrix modelview-matrix-stack get push ;
+
+: pop-modelview-matrix ( -- ) modelview-matrix-stack get pop glLoadMatrixd ;
\ No newline at end of file
--- /dev/null
+
+USING: kernel namespaces math random opengl.gl opengl.glu ui ui.gadgets.slate
+ random-weighted cfdg ;
+
+IN: cfdg.models.aqua-star
+
+: tentacle ( -- )
+iterate? [
+ { { 1 [ circle
+ [ .23 y .99 s .002 b tentacle ] do ] }
+ { 1 [ circle
+ [ .17 y 2 r .99 s .002 b tentacle ] do ] }
+ { 1 [ circle
+ [ .12 y -2 r .99 s .001 b tentacle ] do ] } }
+ call-random-weighted
+] when ;
+
+: anemone ( -- )
+iterate? [
+ tentacle
+ [ 10 x -11 r .995 s -.002 b anemone ] do
+] when ;
+
+: anemone-begin ( -- ) [ 196 hue 0.8324 sat 1 b anemone ] do ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: init ( -- )
+ [ -1 b ] >background
+ { -60 140 -120 140 } >viewport
+ 0.1 >threshold
+ [ anemone-begin ] >start-shape ;
+
+: run ( -- ) [ init ] cfdg-window. ;
+
+MAIN: run
--- /dev/null
+Eduardo Cavazos
--- /dev/null
+Eduardo Cavazos
--- /dev/null
+
+USING: kernel namespaces sequences math
+ opengl.gl opengl.glu ui ui.gadgets.slate
+ random-weighted cfdg ;
+
+IN: cfdg.models.chiaroscuro
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+DEFER: white
+
+: black ( -- )
+ {
+ { 60 [ 0.6 s circle ] [ 0.1 x 5 r 0.99 s -0.01 b -0.01 a black ] }
+ { 1 [ white black ] }
+ }
+ rules ;
+
+: white ( -- )
+ {
+ { 60 [ 0.6 s circle ] [ 0.1 x -5 r 0.99 s 0.01 b -0.01 a white ] }
+ { 1 [ black white ] }
+ }
+ rules ;
+
+: chiaroscuro ( -- ) { [ 0.5 b black ] } rule ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: init ( -- )
+ [ -0.5 b ] >background
+ { -3 6 -2 6 } >viewport
+ 0.03 >threshold
+ [ chiaroscuro ] >start-shape ;
+
+: run ( -- ) [ init ] cfdg-window. ;
+
+MAIN: run
--- /dev/null
+Eduardo Cavazos
--- /dev/null
+USING: tools.deploy.config ;
+V{
+ { deploy-ui? t }
+ { deploy-io 1 }
+ { deploy-reflection 2 }
+ { deploy-compiler? t }
+ { deploy-math? t }
+ { deploy-word-props? f }
+ { deploy-c-types? f }
+ { "stop-after-last-window?" t }
+ { "bundle-name" "cfdg.models.flower6.app" }
+}
--- /dev/null
+
+USING: kernel namespaces sequences math
+ opengl.gl opengl.glu ui ui.gadgets.slate
+ random-weighted cfdg ;
+
+IN: cfdg.models.flower6
+
+: petal6 ( -- )
+iterate? [
+ [ 1 0.001 s* square ] do
+ [ -0.5 x 0.01 s -1 b circle ] do
+ [ 0.5 x 120.21 r 0.996 s 0.5 x 0.005 b petal6 ] do
+] when ;
+
+: flower6 ( -- )
+12 [ [ [ 30 r ] times petal6 ] do ] each
+12 [ [ [ 30 r ] times 90 flip petal6 ] do ] each ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: init ( -- )
+ [ ] >background
+ { -1 2 -1 2 } >viewport
+ 0.01 >threshold
+ [ flower6 ] >start-shape ;
+
+: run ( -- ) [ init ] cfdg-window. ;
+
+MAIN: run
+
--- /dev/null
+Eduardo Cavazos
--- /dev/null
+
+USING: kernel namespaces math opengl.gl opengl.glu ui ui.gadgets.slate
+ random-weighted cfdg ;
+
+IN: cfdg.models.game1-turn6
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: f-triangles ( -- )
+ {
+ [ 0.1 x 0.1 y -0.33 alpha 20 hue 0.7 sat 0.80 b triangle ]
+ [ 10 hue 0.9 sat 0.33 b triangle ]
+ [ 0.9 s 10 hue 0.5 sat 1.00 b triangle ]
+ [ 0.8 s 5 r f-triangles ]
+ }
+ rule ;
+
+: f-squares ( -- )
+ {
+ [ 0.1 x 0.1 y -0.33 alpha 250 hue 0.70 sat 0.80 b square ]
+ [ 220 hue 0.90 sat 0.33 b square ]
+ [ 0.9 s 220 hue 0.25 sat 1.00 b square ]
+ [ 0.8 s 5 r f-squares ]
+ }
+ rule ;
+
+DEFER: start
+
+: spiral ( -- )
+ {
+ { 1 [ f-squares ]
+ [ 0.5 x 0.5 y 45 r f-triangles ]
+ [ 1 y 25 r 0.9 s spiral ] }
+
+ { 0.022 [ 90 flip 50 hue start ] }
+ }
+ rules ;
+
+: start ( -- )
+ [ spiral ] do
+ [ 120 r spiral ] do
+ [ 240 r spiral ] do ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: init ( -- )
+ [ 66 hue 0.4 sat 0.5 b ] >background
+ { -5 10 -5 10 } >viewport
+ 0.001 >threshold
+ [ start ] >start-shape ;
+
+: run ( -- ) [ init ] cfdg-window. ;
+
+MAIN: run
\ No newline at end of file
--- /dev/null
+Eduardo Cavazos
--- /dev/null
+
+USING: kernel namespaces math opengl.gl opengl.glu ui ui.gadgets.slate
+ random-weighted cfdg ;
+
+IN: cfdg.models.lesson
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: shapes ( -- )
+[ square ] do
+[ 0.3 b circle ] do
+[ 0.5 b triangle ] do
+[ 0.7 b 60 r triangle ] do ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: chapter-1 ( -- )
+[ 2 x 5 y 3 size square ] do
+[ 6 x 5 y 3 size circle ] do
+[ 4 x 2 y 3 size triangle ] do
+[ 1 y 3 size shapes ] do ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: foursquare ( -- )
+[ 0 x 0 y 5 3 size* square ] do
+[ 0 x 5 y 2 4 size* square ] do
+[ 5 x 5 y 3 size square ] do
+[ 5 x 0 y 2 size square ] do ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: chapter-2 ( -- )
+[ square ] do
+[ 3 x 7 y square ] do
+[ 5 x 7 y 30 r square ] do
+[ 3 x 5 y 0.75 size square ] do
+[ 5 x 5 y 0.5 b square ] do
+[ 7 x 6 y 45 r 0.7 size 0.7 b square ] do
+[ 5 x 1 y 10 r 0.2 size foursquare ] do ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: spiral ( -- )
+iterate? [
+ [ 0.5 size circle ] do
+ [ 0.2 y -3 r 0.995 size spiral ] do
+] when ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: chapter-3 ( -- ) [ 0 x 3 y spiral ] do ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+DEFER: tree
+
+: branch-left ( -- )
+{ { 1 [ 20 r tree ] }
+ { 1 [ 30 r tree ] }
+ { 1 [ 40 r tree ] }
+ { 1 [ ] } } random-weighted* do ;
+
+: branch-right ( -- )
+{ { 1 [ -20 r tree ] }
+ { 1 [ -30 r tree ] }
+ { 1 [ -40 r tree ] }
+ { 1 [ ] } } random-weighted* do ;
+
+: branch ( -- ) branch-left branch-right ;
+
+: tree ( -- )
+iterate? [
+ {
+ { 20 [ [ 0.25 size circle ] do
+ [ 0.1 y 0.97 size tree ] do ] }
+ { 1.5 [ branch ] }
+ } random-weighted* do
+] when ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: chapter-4 ( -- )
+[ 1 x 0 y tree ] do
+[ 6 x 0 y tree ] do
+[ 1 x 4 y tree ] do
+[ 6 x 4 y tree ] do ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: toc ( -- )
+[ 0 x 0 y chapter-1 ] do
+[ 10 x 0 y chapter-2 ] do
+[ 0 x -10 y chapter-3 ] do
+[ 10 x -10 y chapter-4 ] do ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: init ( -- )
+ [ ] >background
+ { -5 25 -15 25 } >viewport
+ 0.03 >threshold
+ [ toc ] >start-shape ;
+
+: run ( -- ) [ init ] cfdg-window. ;
+
+MAIN: run
+
--- /dev/null
+
+USING: namespaces sequences math random-weighted cfdg ;
+
+IN: cfdg.models.rules08
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: insct ( -- )
+ [ 1.5 5.5 size* -1 brightness triangle ] do
+ 10
+ [ [ [ 1 0.9 size* -0.15 y 0.05 brightness ] times 1 5 size* triangle ] do ]
+ each ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+DEFER: line
+
+: ligne ( -- )
+ {
+ { 1 [ 4.5 y 1.15 0.8 size* -0.3 b line ] }
+ { 0.5 [ ] }
+ }
+ rules ;
+
+: line ( -- ) { [ insct ligne ] } rule ;
+
+: sole ( -- )
+ {
+ { 1 [ 1 brightness 0.5 saturation ligne ] [ 140 r 1 hue sole ] }
+ { 0.01 [ ] }
+ }
+ rules ;
+
+: centre ( -- ) { [ 1 b 5 s circle ] [ sole ] } rule ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: init ( -- )
+ [ -1 b ] >background
+ { -20 40 -20 40 } viewport set
+ [ centre ] >start-shape
+ 0.0001 >threshold ;
+
+: run ( -- ) [ init ] cfdg-window. ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+MAIN: run
\ No newline at end of file
--- /dev/null
+Eduardo Cavazos
--- /dev/null
+
+USING: kernel namespaces math opengl.gl opengl.glu ui ui.gadgets.slate
+ random-weighted cfdg ;
+
+IN: cfdg.models.sierpinski
+
+: shape ( -- ) circle ;
+
+! : sierpinski ( -- )
+! iterate? [
+! shape
+! [ 0.6 s 5 r 0.2 b -1.5 y 0 x sierpinski ] do
+! [ 0.6 s 5 r -0.2 b 0.75 y -1.2990375 x sierpinski ] do
+! [ 0.6 s 5 r 0.75 y 1.2990375 x sierpinski ] do
+! ] when ;
+
+: sierpinski ( -- )
+iterate? [
+ shape
+ [ -1.5 y 0 x 0.6 s 5 r 0.2 b sierpinski ] do
+ [ 0.75 y -1.2990375 x 0.6 s 5 r -0.2 b sierpinski ] do
+ [ 0.75 y 1.2990375 x 0.6 s 5 r sierpinski ] do
+] when ;
+
+: top ( -- ) [ -13.5 r 0.5 b sierpinski ] do ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: init ( -- )
+ [ ] >background
+ { -4 8 -4 8 } >viewport
+ 0.01 >threshold
+ [ top ] >start-shape ;
+
+: run ( -- ) [ init ] cfdg-window. ;
+
+MAIN: run
\ No newline at end of file
--- /dev/null
+Eduardo Cavazos
--- /dev/null
+
+USING: kernel namespaces math opengl.gl opengl.glu ui ui.gadgets.slate
+ random-weighted cfdg ;
+
+IN: cfdg.models.snowflake
+
+: spike ( -- )
+iterate? [
+ { { 1 [ square
+ [ 0.95 y 0.97 s spike ] do ] }
+ { 0.03 [ square
+ [ 60 r spike ] do
+ [ -60 r spike ] do
+ [ 0.95 y 0.97 s spike ] do ] } }
+ call-random-weighted
+] when ;
+
+: snowflake ( -- )
+spike
+[ 60 r spike ] do
+[ 120 r spike ] do
+[ 180 r spike ] do
+[ 240 r spike ] do
+[ 300 r spike ] do ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: init ( -- )
+ [ ] >background
+ { -40 80 -40 80 } >viewport
+ 0.1 >threshold
+ [ snowflake ] >start-shape ;
+
+: run ( -- ) [ init ] cfdg-window. ;
+
+MAIN: run
+
--- /dev/null
+
+USING: namespaces sequences math random-weighted cfdg ;
+
+IN: cfdg.models.spirales
+
+DEFER: line
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: block ( -- ) { [ circle ] [ 0.3 s 60 flip line ] } rule ;
+
+: a1 ( -- ) { [ 0.95 s 2 x 12 r 0.5 b 10 hue 1.5 sat a1 ] [ block ] } rule ;
+
+: line ( -- ) -0.3 a { [ 0 r a1 ] [ 120 r a1 ] [ 240 r a1 ] } rule ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: init ( -- )
+ [ -1 b ] >background
+ { -20 40 -20 40 } >viewport
+ [ line ] >start-shape
+ 0.04 >threshold ;
+
+: run ( -- ) [ init ] cfdg-window. ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+MAIN: run
\ No newline at end of file
--- /dev/null
+Implementation of: http://contextfreeart.org
+++ /dev/null
-Eduardo Cavazos
+++ /dev/null
-
-USING: kernel alien.c-types combinators namespaces make arrays
- sequences sequences.lib namespaces.lib splitting
- math math.functions math.vectors math.trig
- opengl.gl opengl.glu opengl ui ui.gadgets.slate
- vars colors self self.slots
- random-weighted colors.hsv cfdg.gl accessors
- ui.gadgets.handler ui.gestures assocs ui.gadgets macros
- qualified speicalized-arrays.double ;
-QUALIFIED: syntax
-IN: cfdg
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-SELF-SLOTS: hsva
-
-: clear-color ( color -- ) gl-clear-color GL_COLOR_BUFFER_BIT glClear ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! if (adjustment < 0)
-! base + base * adjustment
-
-! if (adjustment > 0)
-! base + (1 - base) * adjustment
-
-: adjust ( val num -- val ) dup 0 > [ 1 pick - * + ] [ dupd * + ] if ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: hue ( num -- ) hue-> + 360 mod ->hue ;
-
-: saturation ( num -- ) saturation-> swap adjust ->saturation ;
-: brightness ( num -- ) value-> swap adjust ->value ;
-: alpha ( num -- ) alpha-> swap adjust ->alpha ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: h ( num -- ) hue ;
-: sat ( num -- ) saturation ;
-: b ( num -- ) brightness ;
-: a ( num -- ) alpha ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-VAR: color-stack
-
-: init-color-stack ( -- ) V{ } clone >color-stack ;
-
-: push-color ( -- ) self> color-stack> push self> clone >self ;
-
-: pop-color ( -- ) color-stack> pop dup >self gl-color ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: double-nth* ( c-array indices -- seq ) swap [ double-nth ] curry map ;
-
-: check-size ( modelview -- num ) { 0 1 4 5 } double-nth* [ abs ] map biggest ;
-
-VAR: threshold
-
-: iterate? ( -- ? ) get-modelview-matrix check-size threshold> > ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! cos 2a sin 2a 0 0
-! sin 2a -cos 2a 0 0
-! 0 0 1 0
-! 0 0 0 1
-
-! column major order
-
-: gl-flip ( angle -- ) deg>rad dup dup dup
- [ 2 * cos , 2 * sin , 0 , 0 ,
- 2 * sin , 2 * cos neg , 0 , 0 ,
- 0 , 0 , 1 , 0 ,
- 0 , 0 , 0 , 1 , ]
- double-array{ } make underlying>> glMultMatrixd ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: circle ( -- )
- self> gl-color
- gluNewQuadric dup 0 0.5 20 10 gluDisk gluDeleteQuadric ;
-
-: triangle ( -- )
- self> gl-color
- GL_POLYGON glBegin
- 0 0.577 glVertex2d
- 0.5 -0.289 glVertex2d
- -0.5 -0.289 glVertex2d
- glEnd ;
-
-: square ( -- )
- self> gl-color
- GL_POLYGON glBegin
- -0.5 0.5 glVertex2d
- 0.5 0.5 glVertex2d
- 0.5 -0.5 glVertex2d
- -0.5 -0.5 glVertex2d
- glEnd ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: size ( scale -- ) dup 1 glScaled ;
-
-: size* ( scale-x scale-y -- ) 1 glScaled ;
-
-: rotate ( angle -- ) 0 0 1 glRotated ;
-
-: x ( x -- ) 0 0 glTranslated ;
-
-: y ( y -- ) 0 swap 0 glTranslated ;
-
-: flip ( angle -- ) gl-flip ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: s ( scale -- ) size ;
-: s* ( scale-x scale-y -- ) size* ;
-: r ( angle -- ) rotate ;
-: f ( angle -- ) flip ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: do ( quot -- )
- push-modelview-matrix
- push-color
- call
- pop-modelview-matrix
- pop-color ; inline
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: recursive ( quot -- ) iterate? swap when ; inline
-
-: multi ( seq -- ) random-weighted* call ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: [rules] ( seq -- quot )
- [ unclip swap [ [ do ] curry ] map concat 2array ] map
- [ call-random-weighted ] swap prefix
- [ when ] swap prefix
- [ iterate? ] swap append ;
-
-MACRO: rules ( seq -- quot ) [rules] ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: [rule] ( seq -- quot )
- [ [ do ] swap prefix ] map concat
- [ when ] swap prefix
- [ iterate? ] prepend ;
-
-MACRO: rule ( seq -- quot ) [rule] ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-VAR: background
-
-: set-initial-background ( -- ) T{ hsva f 0 0 1 1 } clone >self ;
-
-: set-background ( -- )
- set-initial-background
- background> call
- self> clear-color ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-USING: rewrite-closures ;
-
-VAR: viewport ! { left width bottom height }
-
-VAR: start-shape
-
-: 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> gl-color
-
- start-shape> call
-
- glEndList ;
-
-: display ( -- )
-
- GL_PROJECTION glMatrixMode
- glLoadIdentity
- viewport> first dup viewport> second +
- viewport> third dup viewport> fourth + gluOrtho2D
-
- GL_MODELVIEW glMatrixMode
- glLoadIdentity
-
- set-background
-
- GL_COLOR_BUFFER_BIT glClear
-
- init-modelview-matrix-stack
- init-color-stack
-
- dlist get not
- [ build-model-dlist ]
- [ dlist get glCallList ]
- if ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: delete-dlist ( -- ) dlist get [ dlist get 1 glDeleteLists dlist off ] when ;
-
-: cfdg-window* ( -- slate )
- C[ display ] <slate>
- { 500 500 } >>pdim
- C[ delete-dlist ] >>ungraft
- dup "CFDG" open-window ;
-
-: cfdg-window ( -- slate ) [ 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 ;
\ No newline at end of file
+++ /dev/null
-Eduardo Cavazos
+++ /dev/null
-
-USING: kernel alien.c-types namespaces sequences opengl.gl ;
-
-IN: cfdg.gl
-
-: get-modelview-matrix ( -- alien )
- GL_MODELVIEW_MATRIX 16 "GLdouble" <c-array> tuck glGetDoublev ;
-
-SYMBOL: modelview-matrix-stack
-
-: init-modelview-matrix-stack ( -- ) V{ } clone modelview-matrix-stack set ;
-
-: push-modelview-matrix ( -- )
- get-modelview-matrix modelview-matrix-stack get push ;
-
-: pop-modelview-matrix ( -- ) modelview-matrix-stack get pop glLoadMatrixd ;
\ No newline at end of file
+++ /dev/null
-
-USING: kernel namespaces math random opengl.gl opengl.glu ui ui.gadgets.slate
- random-weighted cfdg ;
-
-IN: cfdg.models.aqua-star
-
-: tentacle ( -- )
-iterate? [
- { { 1 [ circle
- [ .23 y .99 s .002 b tentacle ] do ] }
- { 1 [ circle
- [ .17 y 2 r .99 s .002 b tentacle ] do ] }
- { 1 [ circle
- [ .12 y -2 r .99 s .001 b tentacle ] do ] } }
- call-random-weighted
-] when ;
-
-: anemone ( -- )
-iterate? [
- tentacle
- [ 10 x -11 r .995 s -.002 b anemone ] do
-] when ;
-
-: anemone-begin ( -- ) [ 196 hue 0.8324 sat 1 b anemone ] do ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: init ( -- )
- [ -1 b ] >background
- { -60 140 -120 140 } >viewport
- 0.1 >threshold
- [ anemone-begin ] >start-shape ;
-
-: run ( -- ) [ init ] cfdg-window. ;
-
-MAIN: run
+++ /dev/null
-Eduardo Cavazos
+++ /dev/null
-Eduardo Cavazos
+++ /dev/null
-
-USING: kernel namespaces sequences math
- opengl.gl opengl.glu ui ui.gadgets.slate
- random-weighted cfdg ;
-
-IN: cfdg.models.chiaroscuro
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-DEFER: white
-
-: black ( -- )
- {
- { 60 [ 0.6 s circle ] [ 0.1 x 5 r 0.99 s -0.01 b -0.01 a black ] }
- { 1 [ white black ] }
- }
- rules ;
-
-: white ( -- )
- {
- { 60 [ 0.6 s circle ] [ 0.1 x -5 r 0.99 s 0.01 b -0.01 a white ] }
- { 1 [ black white ] }
- }
- rules ;
-
-: chiaroscuro ( -- ) { [ 0.5 b black ] } rule ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: init ( -- )
- [ -0.5 b ] >background
- { -3 6 -2 6 } >viewport
- 0.03 >threshold
- [ chiaroscuro ] >start-shape ;
-
-: run ( -- ) [ init ] cfdg-window. ;
-
-MAIN: run
+++ /dev/null
-Eduardo Cavazos
+++ /dev/null
-USING: tools.deploy.config ;
-V{
- { deploy-ui? t }
- { deploy-io 1 }
- { deploy-reflection 2 }
- { deploy-compiler? t }
- { deploy-math? t }
- { deploy-word-props? f }
- { deploy-c-types? f }
- { "stop-after-last-window?" t }
- { "bundle-name" "cfdg.models.flower6.app" }
-}
+++ /dev/null
-
-USING: kernel namespaces sequences math
- opengl.gl opengl.glu ui ui.gadgets.slate
- random-weighted cfdg ;
-
-IN: cfdg.models.flower6
-
-: petal6 ( -- )
-iterate? [
- [ 1 0.001 s* square ] do
- [ -0.5 x 0.01 s -1 b circle ] do
- [ 0.5 x 120.21 r 0.996 s 0.5 x 0.005 b petal6 ] do
-] when ;
-
-: flower6 ( -- )
-12 [ [ [ 30 r ] times petal6 ] do ] each
-12 [ [ [ 30 r ] times 90 flip petal6 ] do ] each ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: init ( -- )
- [ ] >background
- { -1 2 -1 2 } >viewport
- 0.01 >threshold
- [ flower6 ] >start-shape ;
-
-: run ( -- ) [ init ] cfdg-window. ;
-
-MAIN: run
-
+++ /dev/null
-Eduardo Cavazos
+++ /dev/null
-
-USING: kernel namespaces math opengl.gl opengl.glu ui ui.gadgets.slate
- random-weighted cfdg ;
-
-IN: cfdg.models.game1-turn6
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: f-triangles ( -- )
- {
- [ 0.1 x 0.1 y -0.33 alpha 20 hue 0.7 sat 0.80 b triangle ]
- [ 10 hue 0.9 sat 0.33 b triangle ]
- [ 0.9 s 10 hue 0.5 sat 1.00 b triangle ]
- [ 0.8 s 5 r f-triangles ]
- }
- rule ;
-
-: f-squares ( -- )
- {
- [ 0.1 x 0.1 y -0.33 alpha 250 hue 0.70 sat 0.80 b square ]
- [ 220 hue 0.90 sat 0.33 b square ]
- [ 0.9 s 220 hue 0.25 sat 1.00 b square ]
- [ 0.8 s 5 r f-squares ]
- }
- rule ;
-
-DEFER: start
-
-: spiral ( -- )
- {
- { 1 [ f-squares ]
- [ 0.5 x 0.5 y 45 r f-triangles ]
- [ 1 y 25 r 0.9 s spiral ] }
-
- { 0.022 [ 90 flip 50 hue start ] }
- }
- rules ;
-
-: start ( -- )
- [ spiral ] do
- [ 120 r spiral ] do
- [ 240 r spiral ] do ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: init ( -- )
- [ 66 hue 0.4 sat 0.5 b ] >background
- { -5 10 -5 10 } >viewport
- 0.001 >threshold
- [ start ] >start-shape ;
-
-: run ( -- ) [ init ] cfdg-window. ;
-
-MAIN: run
\ No newline at end of file
+++ /dev/null
-Eduardo Cavazos
+++ /dev/null
-
-USING: kernel namespaces math opengl.gl opengl.glu ui ui.gadgets.slate
- random-weighted cfdg ;
-
-IN: cfdg.models.lesson
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: shapes ( -- )
-[ square ] do
-[ 0.3 b circle ] do
-[ 0.5 b triangle ] do
-[ 0.7 b 60 r triangle ] do ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: chapter-1 ( -- )
-[ 2 x 5 y 3 size square ] do
-[ 6 x 5 y 3 size circle ] do
-[ 4 x 2 y 3 size triangle ] do
-[ 1 y 3 size shapes ] do ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: foursquare ( -- )
-[ 0 x 0 y 5 3 size* square ] do
-[ 0 x 5 y 2 4 size* square ] do
-[ 5 x 5 y 3 size square ] do
-[ 5 x 0 y 2 size square ] do ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: chapter-2 ( -- )
-[ square ] do
-[ 3 x 7 y square ] do
-[ 5 x 7 y 30 r square ] do
-[ 3 x 5 y 0.75 size square ] do
-[ 5 x 5 y 0.5 b square ] do
-[ 7 x 6 y 45 r 0.7 size 0.7 b square ] do
-[ 5 x 1 y 10 r 0.2 size foursquare ] do ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: spiral ( -- )
-iterate? [
- [ 0.5 size circle ] do
- [ 0.2 y -3 r 0.995 size spiral ] do
-] when ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: chapter-3 ( -- ) [ 0 x 3 y spiral ] do ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-DEFER: tree
-
-: branch-left ( -- )
-{ { 1 [ 20 r tree ] }
- { 1 [ 30 r tree ] }
- { 1 [ 40 r tree ] }
- { 1 [ ] } } random-weighted* do ;
-
-: branch-right ( -- )
-{ { 1 [ -20 r tree ] }
- { 1 [ -30 r tree ] }
- { 1 [ -40 r tree ] }
- { 1 [ ] } } random-weighted* do ;
-
-: branch ( -- ) branch-left branch-right ;
-
-: tree ( -- )
-iterate? [
- {
- { 20 [ [ 0.25 size circle ] do
- [ 0.1 y 0.97 size tree ] do ] }
- { 1.5 [ branch ] }
- } random-weighted* do
-] when ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: chapter-4 ( -- )
-[ 1 x 0 y tree ] do
-[ 6 x 0 y tree ] do
-[ 1 x 4 y tree ] do
-[ 6 x 4 y tree ] do ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: toc ( -- )
-[ 0 x 0 y chapter-1 ] do
-[ 10 x 0 y chapter-2 ] do
-[ 0 x -10 y chapter-3 ] do
-[ 10 x -10 y chapter-4 ] do ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: init ( -- )
- [ ] >background
- { -5 25 -15 25 } >viewport
- 0.03 >threshold
- [ toc ] >start-shape ;
-
-: run ( -- ) [ init ] cfdg-window. ;
-
-MAIN: run
-
+++ /dev/null
-
-USING: namespaces sequences math random-weighted cfdg ;
-
-IN: cfdg.models.rules08
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: insct ( -- )
- [ 1.5 5.5 size* -1 brightness triangle ] do
- 10
- [ [ [ 1 0.9 size* -0.15 y 0.05 brightness ] times 1 5 size* triangle ] do ]
- each ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-DEFER: line
-
-: ligne ( -- )
- {
- { 1 [ 4.5 y 1.15 0.8 size* -0.3 b line ] }
- { 0.5 [ ] }
- }
- rules ;
-
-: line ( -- ) { [ insct ligne ] } rule ;
-
-: sole ( -- )
- {
- { 1 [ 1 brightness 0.5 saturation ligne ] [ 140 r 1 hue sole ] }
- { 0.01 [ ] }
- }
- rules ;
-
-: centre ( -- ) { [ 1 b 5 s circle ] [ sole ] } rule ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: init ( -- )
- [ -1 b ] >background
- { -20 40 -20 40 } viewport set
- [ centre ] >start-shape
- 0.0001 >threshold ;
-
-: run ( -- ) [ init ] cfdg-window. ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-MAIN: run
\ No newline at end of file
+++ /dev/null
-Eduardo Cavazos
+++ /dev/null
-
-USING: kernel namespaces math opengl.gl opengl.glu ui ui.gadgets.slate
- random-weighted cfdg ;
-
-IN: cfdg.models.sierpinski
-
-: shape ( -- ) circle ;
-
-! : sierpinski ( -- )
-! iterate? [
-! shape
-! [ 0.6 s 5 r 0.2 b -1.5 y 0 x sierpinski ] do
-! [ 0.6 s 5 r -0.2 b 0.75 y -1.2990375 x sierpinski ] do
-! [ 0.6 s 5 r 0.75 y 1.2990375 x sierpinski ] do
-! ] when ;
-
-: sierpinski ( -- )
-iterate? [
- shape
- [ -1.5 y 0 x 0.6 s 5 r 0.2 b sierpinski ] do
- [ 0.75 y -1.2990375 x 0.6 s 5 r -0.2 b sierpinski ] do
- [ 0.75 y 1.2990375 x 0.6 s 5 r sierpinski ] do
-] when ;
-
-: top ( -- ) [ -13.5 r 0.5 b sierpinski ] do ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: init ( -- )
- [ ] >background
- { -4 8 -4 8 } >viewport
- 0.01 >threshold
- [ top ] >start-shape ;
-
-: run ( -- ) [ init ] cfdg-window. ;
-
-MAIN: run
\ No newline at end of file
+++ /dev/null
-Eduardo Cavazos
+++ /dev/null
-
-USING: kernel namespaces math opengl.gl opengl.glu ui ui.gadgets.slate
- random-weighted cfdg ;
-
-IN: cfdg.models.snowflake
-
-: spike ( -- )
-iterate? [
- { { 1 [ square
- [ 0.95 y 0.97 s spike ] do ] }
- { 0.03 [ square
- [ 60 r spike ] do
- [ -60 r spike ] do
- [ 0.95 y 0.97 s spike ] do ] } }
- call-random-weighted
-] when ;
-
-: snowflake ( -- )
-spike
-[ 60 r spike ] do
-[ 120 r spike ] do
-[ 180 r spike ] do
-[ 240 r spike ] do
-[ 300 r spike ] do ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: init ( -- )
- [ ] >background
- { -40 80 -40 80 } >viewport
- 0.1 >threshold
- [ snowflake ] >start-shape ;
-
-: run ( -- ) [ init ] cfdg-window. ;
-
-MAIN: run
-
+++ /dev/null
-
-USING: namespaces sequences math random-weighted cfdg ;
-
-IN: cfdg.models.spirales
-
-DEFER: line
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: block ( -- ) { [ circle ] [ 0.3 s 60 flip line ] } rule ;
-
-: a1 ( -- ) { [ 0.95 s 2 x 12 r 0.5 b 10 hue 1.5 sat a1 ] [ block ] } rule ;
-
-: line ( -- ) -0.3 a { [ 0 r a1 ] [ 120 r a1 ] [ 240 r a1 ] } rule ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: init ( -- )
- [ -1 b ] >background
- { -20 40 -20 40 } >viewport
- [ line ] >start-shape
- 0.04 >threshold ;
-
-: run ( -- ) [ init ] cfdg-window. ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-MAIN: run
\ No newline at end of file
+++ /dev/null
-Implementation of: http://contextfreeart.org
projects / factor.git / commitdiff