help.html: only input.focus().
[factor.git] / 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-neighbor ( 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-neighbor [
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 ;