maze/maze.f90 at master · joewing/maze · GitHub

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
! Maze Generator in Fortran.
! Joe Wingbermuehle
! 2010-09-28

program maze

   implicit none
   integer :: width, height
   parameter (width = 39)
   parameter (height = 23)
   integer :: mz(width, height)

   mz(:,:) = 1
   call generate_maze(width, height, mz)
   call show_maze(width, height, mz)

end program maze

! Display the maze.
subroutine show_maze(width, height, mz)

   implicit none
   integer, intent(in) :: width, height
   integer, intent(in) :: mz(width, height)
   integer :: x, y

   do y = 1, height
      do x = 1, width
         if (mz(x, y) .eq. 0) then
            write (*,'(AA)',advance='no') '  '
         else
            write (*,'(AA)',advance='no') '[]'
         end if
      end do
      print *, ''
   end do

end subroutine show_maze

! Generate the maze.
subroutine generate_maze(width, height, mz)

   implicit none
   integer, intent(in)     :: width, height
   integer, intent(inout)  :: mz(width, height)
   integer                 :: x, y
   integer                 :: seed(8)

   call itime(seed)
   call random_seed(put = seed)
   mz(2, 2) = 0
   do y = 2, height, 2
      do x = 2, width, 2
         call carve_maze(width, height, mz, x, y)
      end do
   end do
   mz(2, 1) = 0
   mz(width - 1, height) = 0

end subroutine generate_maze

! Carve the maze at the specified coordinates.
subroutine carve_maze(width, height, mz, x, y)

   implicit none
   integer, intent(in)     :: width, height
   integer, intent(inout)  :: mz(width, height)
   integer, intent(in)     :: x, y
   real     :: rand
   integer  :: dir, cnt
   integer  :: dx, dy, localx, localy
   integer  :: x1, y1, x2, y2

   call random_number(rand)
   cnt = 0
   dir = rand * 4
   localx = x
   localy = y
   do
      dx = 0
      dy = 0
      select case (dir)
         case (0)
            dx = 1
         case (1)
            dy = 1
         case (2)
            dx = -1
         case default
            dy = -1
      end select
      x1 = localx + dx
      y1 = localy + dy
      x2 = x1 + dx
      y2 = y1 + dy
      if (     x2 .gt. 1 .and. x2 .lt. width    &
         .and. y2 .gt. 1 .and. y2 .lt. height   &
         .and. mz(x1, y1) .eq. 1 .and. mz(x2, y2) .eq. 1) then
         mz(x1, y1) = 0
         mz(x2, y2) = 0
         localx = x2
         localy = y2
         call random_number(rand)
         dir = rand * 4
         cnt = 0
      else
         cnt = cnt + 1
         if (cnt .gt. 3) then
            exit
         end if
         dir = mod(dir + 1, 4)
      end if
   end do

end subroutine carve_maze