-
Notifications
You must be signed in to change notification settings - Fork 0
/
maze.scm
163 lines (147 loc) · 5.73 KB
/
maze.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
;; -*- coding: utf-8 -*-
;;
;; maze.scm
;; 2019-6-19 v1.22
;;
;; <内容>
;; Gauche-gl を使用した、迷路を自動生成して表示するサンプルです。
;; スタート(水色)からゴール(赤色)までのルートも探索して表示します。
;; 生成される迷路の上下左右はつながっています。
;; スペースキーを押すと、次の迷路を表示します。
;; ESCキーを押すと終了します。
;;
;; 参考「古くて新しい自動迷路生成アルゴリズム」
;; http://d.hatena.ne.jp/yaneurao/20130125
;;
(add-load-path "lib" :relative)
(use gl)
(use gl.glut)
(use gauche.uvector)
(use math.const)
(use glmintool)
(use gltextscrn)
(use glmazekit)
(define *title* "maze") ; ウィンドウのタイトル
(define *width* 480) ; ウィンドウ上の画面幅(px)
(define *height* 480) ; ウィンドウ上の画面高さ(px)
(define *mw* 30) ; 迷路の幅 (=水平方向のブロック数)
(define *mh* 30) ; 迷路の高さ(=垂直方向のブロック数)
(define *sx* 1) ; スタートのX座標
(define *sy* 1) ; スタートのY座標
(define *gx* (quotient (+ *mw* 1) 2)) ; ゴールのX座標
(define *gy* (quotient (+ *mh* 1) 2)) ; ゴールのY座標
(define *wd/2* 400) ; 画面幅/2
(define *ht/2* 400) ; 画面高さ/2
(define *wsize* 20) ; 壁の長さ
(define *wwide* 3) ; 壁の幅
(define *backcolor* #f32(0.0 0.0 0.3 1.0)) ; 背景色
(define *wallcolor* #f32(1.0 1.0 1.0 1.0)) ; 壁の色
(define *startcolor* #f32(0.0 0.7 1.0 1.0)) ; スタートの色
(define *goalcolor* #f32(1.0 0.0 0.0 1.0)) ; ゴールの色
(define *routecolor* #f32(1.0 1.0 0.0 1.0)) ; 探索ルートの色
;; ウィンドウ情報クラスのインスタンス生成
(define *win* (make <wininfo>))
(win-init *win* *width* *height* (* *wd/2* 2) (* *ht/2* 2))
;; 迷路クラスのインスタンス生成
(define *maze* (make <maze>))
;; 迷路の表示
(define (disp-maze mz)
(define mw (~ mz 'width)) ; 迷路の幅
(define mh (~ mz 'height)) ; 迷路の高さ
(define mdata (~ mz 'data)) ; 迷路データ
(define (pt x y) (+ (* y mw) x)) ; 配列番号への変換
(define ws (win-h *win* *wsize*)) ; ウィンドウ上の壁の長さ(px)
(define ww (win-h *win* *wwide*)) ; ウィンドウ上の壁の幅(px)
(define ox (/. (- *width* (* ws mw)) 2)) ; ウィンドウ上の迷路の左上点のX座標(px)
(define oy (/. (- *height* (* ws mh)) 2)) ; ウィンドウ上の迷路の左上点のY座標(px)
;; ブロックの数だけループする
(let loop ((x1 0) (y1 0))
(let ((bx1 (+ ox (* x1 ws))) ; ウィンドウ上の1ブロックの左上点のX座標(px)
(by1 (+ oy (* y1 ws))) ; ウィンドウ上の1ブロックの左上点のY座標(px)
(d1 (~ mdata (pt x1 y1)))) ; 1ブロックの迷路データ
;; 壁の表示
(gl-color *wallcolor*)
(if (logtest d1 1) (draw-win-rect bx1 (+ by1 (/. ww -2)) ws ww *width* *height*))
(if (logtest d1 2) (draw-win-rect (+ bx1 ws (/. ww -2)) by1 ww ws *width* *height*))
(if (logtest d1 4) (draw-win-rect bx1 (+ by1 ws (/. ww -2)) ws ww *width* *height*))
(if (logtest d1 8) (draw-win-rect (+ bx1 (/. ww -2)) by1 ww ws *width* *height*))
;; 1ブロックの背景の表示
(gl-color (cond ((logtest d1 128) *goalcolor*)
((logtest d1 64) *startcolor*)
((logtest d1 32) *routecolor*)
(else *backcolor*)))
(draw-win-rect bx1 by1 ws ws *width* *height* 'left -0.99999)
)
(cond
((< x1 (- mw 1)) (loop (+ x1 1) y1))
((< y1 (- mh 1)) (loop 0 (+ y1 1))))
))
;; 初期化
(define (init)
(gl-clear-color 0.0 0.0 0.0 0.0)
(gl-enable GL_DEPTH_TEST)
;; 迷路の初期化
(maze-init *maze* *mw* *mh*)
;; 迷路の生成
(maze-generate *maze* disp)
;; 画面表示
(disp)
;; 迷路の探索
(maze-set-start *maze* *sx* *sy*)
(maze-set-goal *maze* *gx* *gy*)
(maze-search *maze*)
;; 画面表示
(disp))
;; 画面表示
(define (disp)
(gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
;; 迷路の表示
(disp-maze *maze*)
;(gl-flush)
(glut-swap-buffers))
;; 画面のリサイズ
(define (reshape w h)
(set! *width* w)
(set! *height* (min w h))
(win-update-size *win* *width* *height*)
;; 縦横比を変えずにリサイズ
(gl-viewport 0 (quotient (- h *height*) 2) *width* *height*))
;; キー入力
(define (keyboard key x y)
(cond
;; ESCキーで終了
((= key (char->integer #\escape)) (exit 0))
;; スペースキーで次を表示
((= key (char->integer #\space))
;; 迷路の初期化
(maze-init *maze* *mw* *mh*)
;; 迷路の生成
(maze-generate *maze* disp)
;; 画面表示
(disp)
;; 迷路の探索
(maze-set-start *maze* *sx* *sy*)
(maze-set-goal *maze* *gx* *gy*)
(maze-search *maze*)
;; 画面表示
(disp))
;; [g]キーでGC実行(デバッグ用)
((or (= key (char->integer #\g)) (= key (char->integer #\G)))
(gc) (print (gc-stat)))
))
;; メイン処理
(define (main args)
(glut-init '())
(glut-init-display-mode (logior GLUT_DOUBLE GLUT_RGB GLUT_DEPTH))
(glut-init-window-size *width* *height*)
(glut-init-window-position 100 100)
(glut-create-window *title*)
(init)
(glut-display-func disp)
(glut-reshape-func reshape)
(glut-keyboard-func keyboard)
(glut-show-window)
;; コールバック内エラー対策
(guard (ex (else (report-error ex) (exit 1)))
(glut-main-loop))
0)