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
|
program fetris
use m_game
use m_screen
use m_piece
use m_constants
use bgi
implicit none
type(game)::g
type(piece)::new_p
logical::playing, loser
logical::redraw
integer::last_score
integer(kind=8)::count_rate, count_now
real(kind=8)::current_time, last_update
call init_random()
call init()
g = new_game()
g%falling = new_piece()
g%piece_stuck = .FALSE.
call system_clock(count_rate=count_rate)
playing = .TRUE.
loser = .FALSE.
last_update = 0
last_score = -1
call draw_score(g)
do while(playing)
call system_clock(count=count_now)
current_time = real(count_now, 8)/real(count_rate,8)
redraw = .FALSE.
if(current_time - last_update .GT. UPDATE_SECONDS) then
last_update = current_time
call move_piece(g)
redraw = .TRUE.
end if
if(g%piece_stuck) then
last_score = g%score
call check_rows(g)
new_p = new_piece()
if(.NOT. check_piece(g, new_p, new_p%r, new_p%c)) then
loser = .TRUE.
playing = .FALSE.
call clear_keys()
exit
else
g%falling = new_p
g%piece_stuck = .FALSE.
call clear_keys()
end if
end if
if(kbhit() .NE. 0) then
select case (getch())
case (KEY_LEFT)
call move_piece(g, LEFT)
redraw = .TRUE.
case (KEY_RIGHT)
call move_piece(g, RIGHT)
redraw = .TRUE.
case (KEY_DOWN)
call move_piece(g, DOWN)
redraw = .TRUE.
case (KEY_UP)
call rotate_piece(g)
redraw = .TRUE.
case (ichar('q'), ichar('Q'))
playing = .FALSE.
end select
end if
if(redraw) then
call draw_board(g)
if(g%score .NE. last_score) then
call draw_score(g)
last_score = g%score
end if
end if
end do
if(loser) then
call clear_keys()
call show_loss(g%score)
end if
call shutdown()
contains
subroutine init_random()
implicit none
INTEGER :: i, n, clock
INTEGER, DIMENSION(:), ALLOCATABLE :: seed
CALL RANDOM_SEED(size = n)
ALLOCATE(seed(n))
CALL SYSTEM_CLOCK(COUNT=clock)
seed = clock + 37 * (/ (i - 1, i = 1, n) /)
CALL RANDOM_SEED(PUT = seed)
DEALLOCATE(seed)
end subroutine init_random
subroutine clear_keys()
use bgi
implicit none
integer::ignored
do while(kbhit() .NE. 0)
ignored = getch()
end do
end subroutine clear_keys
end program fetris
|
