extra/maze/maze.factor

   1 ! From http://www.ffconsultancy.com/ocaml/maze/index.html
   2 USING: accessors arrays kernel math math.order math.vectors
   3 namespaces opengl.demo-support opengl.gl random sequences ui
   4 ui.gadgets ui.gadgets.canvas ui.gestures 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 : visit ( cell -- ) f swap first2 visited get ?nth ?set-nth ;
  14
  15 : choices ( cell -- seq )
  16     { { -1 0 } { 1 0 } { 0 -1 } { 0 1 } }
  17     [ v+ ] with map
  18     [ unvisited? ] filter ;
  19
  20 : random-neighbour ( cell -- newcell ) choices random ;
  21
  22 : vertex ( pair -- )
  23     first2 [ 0.5 + line-width * ] bi@ glVertex2d ;
  24
  25 : (draw-maze) ( cell -- )
  26     dup vertex
  27     glEnd
  28     GL_POINTS [ dup vertex ] do-state
  29     GL_LINE_STRIP glBegin
  30     dup vertex
  31     dup visit
  32     dup random-neighbour [
  33         (draw-maze) (draw-maze)
  34     ] [
  35         drop
  36         glEnd
  37         GL_LINE_STRIP glBegin
  38     ] if* ;
  39
  40 : draw-maze ( n -- )
  41     line-width 2 - glLineWidth
  42     line-width 2 - glPointSize
  43     1.0 1.0 1.0 1.0 glColor4d
  44     dup '[ _ t <array> ] replicate visited set
  45     GL_LINE_STRIP [
  46         { 0 0 } dup vertex (draw-maze)
  47     ] do-state ;
  48
  49 TUPLE: maze < canvas ;
  50
  51 : <maze> ( -- gadget ) maze new-canvas ;
  52
  53 : n ( gadget -- n ) dim>> first2 min line-width /i ;
  54
  55 M: maze layout* delete-canvas-dlist ;
  56
  57 M: maze draw-gadget* [ n draw-maze ] draw-canvas ;
  58
  59 M: maze pref-dim* drop { 400 400 } ;
  60
  61 M: maze handle-gesture
  62     over T{ button-down { # 1 } } =
  63     [ nip relayout f ] [ call-next-method ] if ;
  64
  65 MAIN-WINDOW: maze-window { { title "Maze" } }
  66     <maze> >>gadgets ;