extra/maze/maze.factor

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