Initial code commit for Fetris.

1 files changed, 128 insertions, 0 deletions

diff --git a/screen.f90 b/screen.f90
new file mode 100644
index 0000000..d16f778
--- /dev/null
+++ b/screen.f90
@@ -0,0 +1,128 @@
+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
+        
+    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, WHITE)
+            call setcolor(WHITE)
+        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
\ No newline at end of file