Paste: Brian’s (Factored) Functional Brain
Author: | pruned |
Mode: | factor |
Date: | Sat, 17 Oct 2009 10:53:51 |
Plain Text |
: mmap '[ _ map ] map ; inline
: 2mmap '[ _ 2map ] 2map ; inline
: aggregate
dup dup <reversed> [ unclip drop f suffix ] bi@ <reversed>
[ 2array ] 2map [ swap prefix ] 2map [ sift ] map ;
: neighbours
[ aggregate ] map flip [ aggregate ] map [ concat ] mmap ;
SYMBOLS: on off dying ;
: step-cell
[ on = ] filter length swap
{
{ on [ drop dying ] }
{ dying [ drop off ] }
{ off [ 2 = [ on ] [ off ] if ] }
} case ;
: random-world
first2 zero-matrix
[ drop { on off dying } random ] mmap ;
: step-world dup neighbours [ step-cell ] 2mmap ;
Author: | jon |
Mode: | factor |
Date: | Sat, 17 Oct 2009 10:57:08 |
Plain Text |
USING: sequences kernel arrays random locals math math.ranges
fry ui.gadgets colors.constants ui.pens opengl ;
IN: brian
TUPLE: cell ;
TUPLE: on-cell < cell ;
TUPLE: dying-cell < cell ;
TUPLE: off-cell < cell ;
C: <on-cell> on-cell
C: <dying-cell> dying-cell
C: <off-cell> off-cell
GENERIC: step-cell
GENERIC: color
M: on-cell step-cell 2drop <dying-cell> ;
M: dying-cell step-cell 2drop <off-cell> ;
M: off-cell step-cell swap 2 = [ drop <on-cell> ] when ;
M: on-cell color drop COLOR: red ;
M: dying-cell color drop COLOR: blue ;
M: off-cell color drop COLOR: black ;
: <matrix> 2dup <array> [ drop <array> ] with with map ;
: <world> f <matrix> ;
: on|off { T{ on-cell } T{ off-cell } } random clone ;
: <random-world> <world> [ [ drop on|off ] map ] map ;
: inc-matrix [ nth nth ] 3keep nth [ swap 1 + swap ] dip set-nth ;
: inc-possible?
[ length [ < ] curry bi@ ] 3keep
drop [ 0 >= ] bi@ and and and ;
: inc-if-possible
3dup inc-possible? [ inc-matrix ] [ 3drop ] if ;
:: increment-around-index
-1 1 [a,b] dup
[ [ x y swapd [ + ] 2bi@ matrix inc-if-possible ] with each ] curry each ;
:: increment-on
cell on-cell? [ x y matrix increment-around-index ] when ;
: on-count
dup length 0 <matrix> tuck '[ [ _ increment-on ] curry each-index ] each-index ;
: (step-cell) nth nth swap step-cell ;
: step-world
dup on-count '[ [ _ (step-cell) ] curry map-index ] map-index ;
M: cell draw-interior
nip color gl-color { 0 0 } { 10 10 } gl-fill-rect ;
Author: | jon |
Mode: | factor |
Date: | Sat, 17 Oct 2009 12:31:23 |
Plain Text |
USING: sequences kernel arrays random locals math math.ranges
fry ui.gadgets colors.constants ui.pens opengl accessors ui
threads ;
IN: brian
TUPLE: cell ;
TUPLE: on-cell < cell ;
TUPLE: dying-cell < cell ;
TUPLE: off-cell < cell ;
C: <on-cell> on-cell
C: <dying-cell> dying-cell
C: <off-cell> off-cell
GENERIC: step-cell
GENERIC: color
M: on-cell step-cell 2drop <dying-cell> ;
M: dying-cell step-cell 2drop <off-cell> ;
M: off-cell step-cell swap 2 = [ drop <on-cell> ] when ;
M: on-cell color drop COLOR: red ;
M: dying-cell color drop COLOR: blue ;
M: off-cell color drop COLOR: black ;
: <matrix> 2dup <array> [ drop <array> ] with with map ;
: <world> f <matrix> ;
: on|off { T{ on-cell } T{ off-cell } } random clone ;
: <random-world> <world> [ [ drop on|off ] map ] map ;
: inc-matrix nth [ 1 + ] change-nth ;
: inc-possible?
[ length [ < ] curry bi@ ] 3keep
drop [ 0 >= ] bi@ and and and ;
: inc-if-possible 3dup inc-possible? [ inc-matrix ] [ 3drop ] if ;
:: increment-around-index
-1 1 [a,b] dup
[ [ x y swapd [ + ] 2bi@ matrix inc-if-possible ] with each ] curry each ;
:: increment-on cell on-cell? [ x y matrix increment-around-index ] when ;
: live-neighbours-count
dup length 0 <matrix> tuck
'[ [ _ increment-on ] curry each-index ] each-index ;
: (step-cell) nth nth swap step-cell ;
: step-world
dup live-neighbours-count '[ [ _ (step-cell) ] curry map-index ] map-index ;
: draw-cell [ color gl-color ] 2dip 2array [ 10 * ] map { 10 10 } gl-fill-rect ;
TUPLE: brian cells gadget ;
M: brian draw-interior nip cells>> [ [ draw-cell ] curry each-index ] each-index ;
: brian-gadget
<gadget>
over cells>> length dup 2array [ 10 * ] map >>pref-dim
swap >>interior ;
: finished?
cells>> [ [ on-cell? ] any? ] map [ ] any? ;
: step-brian dup cells>> step-world >>cells dup gadget>> relayout-1 ;
: (new-brian)
<random-world> f brian boa dup brian-gadget [ "brian" open-window ] keep >>gadget
[ dup finished? ] [ step-brian yield ] while drop ;
: new-brian [ (new-brian) ] curry with-ui ;
: example 100 new-brian ;
Author: | Jon |
Mode: | factor |
Date: | Sat, 17 Oct 2009 17:38:06 |
Plain Text |
USING: accessors arrays colors.constants combinators fry kernel
locals math math.matrices opengl random sequences ui.pens ui.gadgets
ui calendar alarms io ;
IN: brian2
<PRIVATE
: mmap '[ _ map ] map ; inline
: 2mmap '[ _ 2map ] 2map ; inline
: meach-index '[ _ curry each-index ] each-index ; inline
SYMBOLS: on off dying ;
: random-world
first2 zero-matrix
[ drop { on off } random ] mmap ;
: aggregate
dup dup <reversed> [ unclip drop f suffix ] bi@ <reversed>
[ 2array ] 2map [ swap prefix ] 2map [ sift ] map ;
: neighbours
[ aggregate ] map flip [ aggregate ] map [ concat ] mmap flip ;
: step-cell
[ on = ] filter length swap
{
{ on [ drop dying ] }
{ dying [ drop off ] }
{ off [ 2 = [ on ] [ off ] if ] }
} case ;
: step-world dup neighbours [ step-cell ] 2mmap ;
: color
{
{ on [ COLOR: red ] }
{ off [ COLOR: black ] }
{ dying [ COLOR: blue ] }
} case ;
: cell-loc
[ 2array ] dip [ * ] 2map ;
:: draw-cell
cell color gl-color
j i cell-dim [ cell-loc ] keep gl-fill-rect ;
: (draw)
[ draw-cell ] curry meach-index ;
:: draw
[let* | world-dim [ world [ first length ] [ length ] bi 2array ]
cell-dim [ gadget-dim world-dim [ / ] 2map ]
| world cell-dim (draw) ] ;
TUPLE: world-pen world ;
M: world-pen draw-interior
[ pref-dim>> ] [ world>> ] bi* draw ;
: <world-gadget>
world-pen boa <gadget> swap >>interior { 800 800 } >>pref-dim ;
: open-brian-window
<world-gadget> dup [ "Brian's Brain" open-window ] curry with-ui ;
: step-window
dup interior>> dup world>> step-world >>world >>interior dup relayout-1 ;
PRIVATE>
:: animate
dim random-world open-brian-window [ step-window ] curry
now frequency milliseconds add-alarm ;
: example { 80 80 } 100 animate ;
New Annotation