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
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
module m_game
use m_constants
use m_piece
implicit none
type game
! NOTE: Row 1 is the bottom
integer, dimension(ROWS, COLUMNS)::board
integer::score
type(piece)::waiting
type(piece)::falling
logical::piece_stuck
end type game
contains
function new_game()
implicit none
type(game)::new_game
new_game%board = 0
new_game%score = 0
new_game%piece_stuck = .FALSE.
end function new_game
recursive subroutine check_rows(g)
implicit none
type(game), intent(inout)::g
integer::i, j
do i = 1, ROWS
if(all(g%board(i,:) .NE. 0)) then
g%score = g%score + ROW_VALUE
do j = i, ROWS-1
g%board(j,:) = g%board(j+1,:)
end do
g%board(ROWS, :) = 0
call check_rows(g)
exit
end if
end do
end subroutine check_rows
subroutine pop_piece(g)
use m_constants
implicit none
type(game), intent(inout)::g
integer::i, j
do i = g%falling%r, g%falling%r+3
do j = g%falling%c, g%falling%c+3
if(i .GT. 0 .AND. i .LE. ROWS .AND. j .GT. 0 .AND. j .LE. COLUMNS) then
if(g%falling%blocks(i-g%falling%r, j-g%falling%c) .NE. 0) then
g%board(i, j) = 0
end if
end if
end do
end do
end subroutine pop_piece
subroutine push_piece(g)
use m_constants
implicit none
type(game), intent(inout)::g
integer::i, j, p_i, p_j
do i = g%falling%r, g%falling%r+3
do j = g%falling%c, g%falling%c+3
if(i .GT. 0 .AND. i .LE. ROWS .AND. j .GT. 0 .AND. j .LE. COLUMNS) then
p_i = i - g%falling%r
p_j = j - g%falling%c
if(g%falling%blocks(p_i, p_j) .NE. 0) then
g%board(i, j) = g%falling%blocks(p_i, p_j)
end if
end if
end do
end do
end subroutine push_piece
pure function check_piece(g, p, r, c)
use m_piece
implicit none
logical::check_piece
type(game), intent(in)::g
type(piece), intent(in)::p
integer, intent(in)::r, c
integer::i, j, p_i, p_j
check_piece = .TRUE.
do p_i = 0, 3
do p_j = 0, 3
if(p%blocks(p_i, p_j) .NE. 0) then
i = r + p_i
j = c + p_j
if(j .LT. 1 .OR. j .GT. COLUMNS .OR. i .LT. 1) then
check_piece = .FALSE.
else if(i .LE. ROWS) then
if(g%board(i, j) .NE. 0) then
check_piece = .FALSE.
exit
end if
end if
end if
end do
end do
end function check_piece
subroutine rotate_piece(g)
use m_piece
implicit none
type(game), intent(inout)::g
type(piece)::holding
holding = g%falling
call pop_piece(g)
holding%blocks = transpose(holding%blocks)
holding%blocks = holding%blocks(:, 3:0:-1)
if(check_piece(g, holding, holding%r, holding%c)) then
g%falling%blocks = holding%blocks
end if
call push_piece(g)
end subroutine rotate_piece
subroutine move_piece(g, specified_dir)
use m_constants
implicit none
type(game), intent(inout)::g
integer, intent(in), optional::specified_dir
integer::direction
integer::temp_c, temp_r
direction = DOWN
if(present(specified_dir)) then
direction = specified_dir
end if
temp_c = g%falling%c
temp_r = g%falling%r
select case (direction)
case (DOWN)
temp_r = temp_r - 1
case (LEFT)
temp_c = temp_c - 1
case (RIGHT)
temp_c = temp_c + 1
end select
call pop_piece(g)
if(.NOT. check_piece(g, g%falling, temp_r, temp_c)) then
temp_c = g%falling%c
temp_r = g%falling%r
end if
! Did a move occur?
if(temp_c .EQ. g%falling%c .AND. temp_r .EQ. g%falling%r .AND. .NOT. present(specified_dir)) then
g%piece_stuck = .TRUE.
else
g%falling%c = temp_c
g%falling%r = temp_r
end if
! Place piece back on screen
call push_piece(g)
end subroutine move_piece
end module m_game
|
