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
|
module m_screen
implicit none
integer::max_x, max_y
integer::winid
integer::cell_size
integer::xoffset, yoffset
integer::scorex, scorey
integer::nextx, nexty
contains
subroutine init()
use bgi
use m_constants
use iso_c_binding, only: C_NULL_CHAR
implicit none
winid = initwindow(SCREEN_W, SCREEN_H, "Fetris!")
call setbkcolor(BLACK)
cell_size = (SCREEN_H-20)/ROWS
xoffset = 10
yoffset = 10
call setcolor(WHITE)
call line(xoffset-2, yoffset-2, xoffset-2, yoffset + (SCREEN_H-20) + 2)
call line(xoffset-2, yoffset + (SCREEN_H-20) + 2, &
xoffset + cell_size*COLUMNS + 2, yoffset + (SCREEN_H-20) + 2)
call line(xoffset + cell_size*COLUMNS + 2, yoffset + (SCREEN_H-20) + 2, &
xoffset + cell_size*COLUMNS + 2, yoffset-2)
scorex = xoffset + cell_size*COLUMNS + 40
scorey = yoffset
call settextstyle(9, HORIZ_DIR, 2)
nextx = scorex
nexty = scorey+60
call setcolor(WHITE)
call outtextxy(nextx, nexty, " Next:"//C_NULL_CHAR)
end subroutine init
subroutine shutdown()
use bgi
implicit none
call closegraph(winid)
end subroutine shutdown
subroutine draw_one_cell_at(x, y, v)
use bgi
use m_constants
implicit none
integer, intent(in)::x, y, v
if(v .EQ. 0) then
call setfillstyle(SOLID_FILL, BLACK)
call setcolor(BLACK)
else
call setfillstyle(SOLID_FILL, v)
call setcolor(v)
end if
call bar(x, y, x+cell_size, y+cell_size)
end subroutine draw_one_cell_at
subroutine draw_one_cell(r, c, v)
use bgi
use m_constants
implicit none
integer, intent(in)::r, c, v
integer::x,y
x = xoffset + (c - 1)*cell_size
y = yoffset + (ROWS - r + 1)*cell_size
call draw_one_cell_at(x, y, v)
end subroutine draw_one_cell
subroutine draw_board(g)
use m_game
use bgi
implicit none
type(game)::g
integer::r, c
do r = 1, ROWS
do c = 1, COLUMNS
call draw_one_cell(r, c, g%board(r, c))
end do
end do
end subroutine draw_board
subroutine draw_next(g)
use m_game
use bgi
implicit none
type(game)::g
integer::x, y, i, j
x = nextx
do i=0,3
y = nexty+40
do j=0,3
call draw_one_cell_at(x, y, g%waiting%blocks(i,j))
y = y + cell_size
end do
x = x + cell_size
end do
end subroutine draw_next
subroutine draw_score(g)
use m_game
use bgi
use iso_c_binding, only: C_NULL_CHAR
implicit none
type(game)::g
character(120)::scoretext
write(scoretext, *) "Score:", g%score
call setcolor(BLACK)
call setfillstyle(SOLID_FILL, BLACK)
call bar(scorex, scorey, SCREEN_W, 40)
call setcolor(WHITE)
call outtextxy(scorex, scorey, trim(scoretext)//C_NULL_CHAR)
end subroutine draw_score
subroutine show_loss(score)
use bgi
use m_constants
implicit none
integer, intent(in)::score
character(120)::scoretext
integer::ignored
call setfillstyle(SOLID_FILL, LIGHTRED)
call bar(SCREEN_W/2 - 100, SCREEN_H/3, SCREEN_W/2 + 100, SCREEN_H/3+120)
call setbkcolor(LIGHTRED)
call setcolor(BLACK)
write(scoretext, *) "Score:", score
call outtextxy(SCREEN_W/2 - 80, SCREEN_H/3+20, " GAME OVER"//C_NULL_CHAR)
call outtextxy(SCREEN_W/2 - 80, SCREEN_H/3+60, trim(scoretext)//C_NULL_CHAR)
call outtextxy(SCREEN_W/2 - 80, SCREEN_H/3+80, " Press any key to exit"//C_NULL_CHAR)
ignored = getch()
end subroutine show_loss
end module m_screen
|
