From 7795d6e35e067e54f14ff34a9cf5a2a96c0becb7 Mon Sep 17 00:00:00 2001
From: Jeffrey Armstrong <jeffrey.armstrong@approximatrix.com>
Date: Fri, 6 Jun 2014 10:16:16 -0400
Subject: Initial code commit for Fetris.

---
 game.f90 | 195 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 195 insertions(+)
 create mode 100644 game.f90

(limited to 'game.f90')

diff --git a/game.f90 b/game.f90
new file mode 100644
index 0000000..11727af
--- /dev/null
+++ b/game.f90
@@ -0,0 +1,195 @@
+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)::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
\ No newline at end of file
-- 
cgit v1.2.3