Tuesday, February 27, 2007

Random maze generator

I couldn't resist and ported another one of Jon Harrop's demos to Factor. This time it is the Random Maze Generator.

The code:
! From http://www.ffconsultancy.com/ocaml/maze/index.html
USING: sequences namespaces math opengl arrays gadgets
gadgets-theme kernel ;
IN: maze

: line-width 8 ;

SYMBOL: visited

: unvisited? ( cell -- ? ) first2 visited get ?nth ?nth ;

: ?set-nth ( elt i seq -- )
2dup bounds-check? [ set-nth ] [ 3drop ] if ;

: visit ( cell -- ) f swap first2 visited get ?nth ?set-nth ;

: choices ( cell -- seq )
{ { -1 0 } { 1 0 } { 0 -1 } { 0 1 } }
[ v+ ] map-with
[ unvisited? ] subset ;

: random-neighbour ( cell -- newcell ) choices random ;

: vertex ( pair -- )
first2 [ 0.5 + line-width * ] 2apply glVertex2d ;

: (draw-maze) ( cell -- )
dup vertex
glEnd
GL_POINTS [ dup vertex ] do-state
GL_LINE_STRIP glBegin
dup vertex
dup visit
dup random-neighbour dup [
(draw-maze) (draw-maze)
] [
2drop
glEnd
GL_LINE_STRIP glBegin
] if ;

: draw-maze ( n -- )
line-width 2 - glLineWidth
line-width 2 - glPointSize
1.0 1.0 1.0 1.0 glColor4d
dup [ drop t <array> ] map-with visited set
GL_LINE_STRIP glBegin
{ 0 0 } dup vertex (draw-maze)
glEnd ;

TUPLE: maze dlist ;

C: maze ( -- gadget )
dup delegate>gadget
black <solid> over set-gadget-interior ;

: n ( gadget -- n ) rect-dim first2 min line-width /i ;

: delete-maze-dlist ( maze -- )
dup maze-dlist [ delete-dlist ] when*
f swap set-maze-dlist ;

: cache-maze-dlist ( maze -- dlist )
dup maze-dlist [ ] [
dup GL_COMPILE [ n draw-maze ] make-dlist
dup rot set-maze-dlist
] ?if ;

M: maze layout* delete-maze-dlist ;

M: maze ungraft* delete-maze-dlist ;

M: maze draw-gadget*
origin get [ cache-maze-dlist glCallList ] with-translation ;

M: maze pref-dim* drop { 400 400 } ;

: maze-window <maze> "Maze" open-window ;

PROVIDE: demos/maze ;

MAIN: demos/maze maze-window ;

2 comments:

Anonymous said...

I'm enjoying these examples despite not understanding them. There is a certain poetry in the arcane concatentation of nips, dups, and swaps.

A detailed annotated version of one of tese more complex examples would be very helpful!

Jon Harrop said...

Awesome demo, dude!