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

db4
Slava Pestov 2008-08-06 17:51:45 -05:00
commit 90287744dc
13 changed files with 48 additions and 31 deletions

View File

@ -1 +1 @@
demos

View File

@ -5,7 +5,7 @@ USING: kernel alien.c-types combinators namespaces arrays
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 ; ui.gadgets.handler ui.gestures assocs ui.gadgets macros ;
IN: cfdg IN: cfdg
@ -137,6 +137,25 @@ VAR: threshold
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: [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 VAR: background
: set-initial-background ( -- ) T{ hsva f 0 0 1 1 } clone >self ; : set-initial-background ( -- ) T{ hsva f 0 0 1 1 } clone >self ;

View File

@ -5,34 +5,32 @@ USING: kernel namespaces sequences math
IN: cfdg.models.chiaroscuro IN: cfdg.models.chiaroscuro
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
DEFER: white DEFER: white
: black ( -- ) iterate? [ : black ( -- )
{ { 60 [ [ 0.6 s circle ] do {
[ 0.1 x 5 r 0.99 s -0.01 b -0.01 a black ] do ] } { 60 [ 0.6 s circle ] [ 0.1 x 5 r 0.99 s -0.01 b -0.01 a black ] }
{ 1 [ white black ] } } { 1 [ white black ] }
call-random-weighted }
] when ; rules ;
: white ( -- ) iterate? [ : white ( -- )
{ { 60 [ {
[ 0.6 s circle ] do { 60 [ 0.6 s circle ] [ 0.1 x -5 r 0.99 s 0.01 b -0.01 a white ] }
[ 0.1 x -5 r 0.99 s 0.01 b -0.01 a white ] do { 1 [ black white ] }
] } }
{ 1 [ rules ;
black white
] } }
call-random-weighted
] when ;
: chiaroscuro ( -- ) [ 0.5 b black ] do ; : chiaroscuro ( -- ) { [ 0.5 b black ] } rule ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: init ( -- ) : init ( -- )
[ -0.5 b ] >background [ -0.5 b ] >background
{ -3 6 -2 6 } >viewport { -3 6 -2 6 } >viewport
0.01 >threshold 0.03 >threshold
[ chiaroscuro ] >start-shape ; [ chiaroscuro ] >start-shape ;
: run ( -- ) [ init ] cfdg-window. ; : run ( -- ) [ init ] cfdg-window. ;

View File

@ -10,7 +10,7 @@ IN: demos
: demo-vocabs ( -- seq ) "demos" tagged [ second ] map concat [ name>> ] map ; : demo-vocabs ( -- seq ) "demos" tagged [ second ] map concat [ name>> ] map ;
: <run-vocab-button> ( vocab-name -- button ) : <run-vocab-button> ( vocab-name -- button )
dup '[ drop [ , run ] call-listener ] <bevel-button> ; dup '[ drop [ , run ] call-listener ] <bevel-button> { 0 0 } >>align ;
: <demo-runner> ( -- gadget ) : <demo-runner> ( -- gadget )
<pile> 1 >>fill demo-vocabs [ <run-vocab-button> add-gadget ] each ; <pile> 1 >>fill demo-vocabs [ <run-vocab-button> add-gadget ] each ;

View File

@ -1,3 +1,2 @@
demos
web web
network network

View File

@ -1 +1 @@
demos

View File

@ -41,7 +41,7 @@ VAR: model
: display ( -- ) : display ( -- )
black gl-clear black set-clear-color GL_COLOR_BUFFER_BIT glClear
GL_FLAT glShadeModel GL_FLAT glShadeModel
@ -57,7 +57,9 @@ camera> do-look-at
GL_FRONT_AND_BACK GL_LINE glPolygonMode GL_FRONT_AND_BACK GL_LINE glPolygonMode
white gl-color white color>raw glColor4d
! white set-color
GL_LINES glBegin { 0 0 0 } gl-vertex { 0 0 1 } gl-vertex glEnd GL_LINES glBegin { 0 0 0 } gl-vertex { 0 0 1 } gl-vertex glEnd

View File

@ -1 +1 @@
demos example

View File

@ -1 +1 @@
demos

View File

@ -1 +1 @@
demos

View File

@ -1 +1 @@
demos

View File

@ -1 +1 @@
demos

View File

@ -1,2 +1 @@
demos
web web