extra/maze/maze.factor

   1 ! From http://www.ffconsultancy.com/ocaml/maze/index.html
   2 USING: sequences namespaces math math.vectors opengl opengl.gl
   3 arrays kernel random ui ui.gadgets ui.gadgets.canvas ui.render
   4 math.order math.geometry.rect ;
   5 IN: maze
   6
   7 : line-width 8 ;
   8
   9 SYMBOL: visited
  10
  11 : unvisited? ( cell -- ? ) first2 visited get ?nth ?nth ;
  12
  13 : ?set-nth ( elt i seq -- )
  14     2dup bounds-check? [ set-nth ] [ 3drop ] if ;
  15
  16 : visit ( cell -- ) f swap first2 visited get ?nth ?set-nth ;
  17
  18 : choices ( cell -- seq )
  19     { { -1 0 } { 1 0 } { 0 -1 } { 0 1 } }
  20     [ v+ ] with map
  21     [ unvisited? ] filter ;
  22
  23 : random-neighbour ( cell -- newcell ) choices random ;
  24
  25 : vertex ( pair -- )
  26     first2 [ 0.5 + line-width * ] bi@ glVertex2d ;
  27
  28 : (draw-maze) ( cell -- )
  29     dup vertex
  30     glEnd
  31     GL_POINTS glBegin dup vertex glEnd
  32     GL_LINE_STRIP glBegin
  33     dup vertex
  34     dup visit
  35     dup random-neighbour dup [
  36         (draw-maze) (draw-maze)
  37     ] [
  38         2drop
  39         glEnd
  40         GL_LINE_STRIP glBegin
  41     ] if ;
  42
  43 : draw-maze ( n -- )
  44     line-width 2 - glLineWidth
  45     line-width 2 - glPointSize
  46     1.0 1.0 1.0 1.0 glColor4d
  47     dup [ drop t <array> ] with map visited set
  48     GL_LINE_STRIP glBegin
  49     { 0 0 } dup vertex (draw-maze)
  50     glEnd ;
  51
  52 TUPLE: maze < canvas ;
  53
  54 : <maze> ( -- gadget ) maze new-canvas ;
  55
  56 : n ( gadget -- n ) rect-dim first2 min line-width /i ;
  57
  58 M: maze layout* delete-canvas-dlist ;
  59
  60 M: maze draw-gadget* [ n draw-maze ] draw-canvas ;
  61
  62 M: maze pref-dim* drop { 400 400 } ;
  63
  64 : maze-window ( -- )
  65     [ <maze> "Maze" open-window ] with-ui ;
  66
  67 MAIN: maze-window