module m_screen implicit none integer::max_x, max_y integer::winid integer::cell_size integer::xoffset, yoffset integer::scorex, scorey contains subroutine init() use bgi use m_constants 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) end subroutine init subroutine shutdown() use bgi implicit none call closegraph(winid) end subroutine shutdown 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 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 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_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