Advertisement
Oppaceted

Untitled

Feb 26th, 2023
324
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.  
  2. program x0
  3.     implicit none
  4.     !определение переменных и функций
  5.     character, allocatable :: table(:,:)
  6.     integer :: n,win,a,b,player
  7.     logical :: process
  8.     integer :: player_win
  9.     !тело программы
  10.     !
  11.     !проверка корректности введённых значений размера поля и количества клеток, необхожимых для выигрыша
  12.     do while(.true.)
  13.         write (*,'(a$)') 'Enter the size of the field:'
  14.         read (*,*) n
  15.         if ( (n >= 20) .or. (n <= 0) ) then
  16.             write (*,'(a)') 'Too big or incorrect value, try again.'
  17.             cycle
  18.         else
  19.             exit
  20.         end if
  21.     end do
  22.     do while(.true.)
  23.         write (*,'(a$)') 'Enter the number of cells required to win:'
  24.         read (*,*) win
  25.         if ( (win > n) .or. (win <= 0) ) then
  26.             write (*,'(a)') 'Too big or incorrect value, try again.'
  27.             cycle
  28.         else
  29.             exit
  30.         end if
  31.     end do
  32.     allocate(table(n,n))
  33.     table(:,:) = '-'
  34.     player = 1
  35.     process = .true.
  36.     !
  37.     do while(process)
  38.         !
  39.         !проверка выигрыша и заполненности таблицы - 1,2 - выигрыш
  40.         !соответствующих игроков, 3 - заполненность - 0 - игра продолжается
  41.         if (player_win(n,win,table)==1) then
  42.             write (*,'(a)') 'Congrats! Player 1 won!'
  43.             exit
  44.         elseif (player_win(n,win,table)==2) then
  45.             write (*,'(a)') 'Congrats! Player 2 won!'
  46.             exit
  47.         elseif (player_win(n,win,table)==3) then
  48.             write (*,'(a)') 'No one won!'
  49.             exit
  50.         else
  51.             do while (.true.)
  52.                 write (*,'(a,1x,i1,1x,a)') 'Player',player,'walks'
  53.                 write (*,'(a$)') 'Enter a row: '
  54.                 read (*,'(i5$)') a
  55.                 write (*,'(a$)') 'Enter a column: '
  56.                 read (*,'(i5$)') b
  57.                 if ( (.not.((a<=n).and.(1<=a))) .or. (.not.((b<=n).and.(1<=b))) ) then
  58.                     write (*,'(a)') 'Enter the correct value!'
  59.                     cycle
  60.                 else if  ( (table(a,b) == '0') .or. (table(a,b) == 'x') ) then
  61.                     write (*,'(a)') 'Enter the correct value!'
  62.                     cycle
  63.                 else
  64.                     exit
  65.                 end if
  66.             end do
  67.             if (player == 1) then
  68.                 table(a,b) = 'x'
  69.                 player = 2
  70.             else
  71.                 table(a,b) = '0'
  72.                 player = 1
  73.             end if
  74.             call draw(n,table)
  75.         end if
  76.     end do
  77.     deallocate(table)
  78. end program x0
  79. !
  80. !процедура отрисовки поля
  81. subroutine draw(draw_size,draw_table)
  82.     integer :: draw_size, dr_1, dr_2
  83.     character :: draw_table(draw_size,draw_size)
  84.     !
  85.     do dr_1 =1,draw_size
  86.         if (dr_1 /= draw_size) then
  87.             write (*,'(1x,i2$)') dr_1
  88.         else
  89.             write (*,'(1x,i2)') dr_1
  90.         end if
  91.     end do
  92.     do dr_1 =1,draw_size
  93.         do dr_2 =1,(draw_size-1)
  94.             write (*,'(2x,a$)') draw_table(dr_1,dr_2)
  95.         end do
  96.         write (*,'(2x,a,1x,i2)') draw_table(dr_1,draw_size), dr_1
  97.     end do
  98. end subroutine
  99. !
  100. !функция выигрыша (состоит из других функций и процедур)
  101. integer function player_win(pw_size, pw_win, pw_table)
  102.     integer :: pw_1, pw_2, pw_size, pw_win, cut_win
  103.     character :: pw_table(pw_size,pw_size), pw_win_table(pw_win,pw_win)
  104.     logical :: full
  105.     !
  106.     !
  107.     player_win = 0
  108.     if (full(pw_size, pw_table)) then
  109.         player_win = 3
  110.     end if
  111.     do pw_1 = 1, (pw_size-pw_win+1)
  112.         do pw_2 = 1, (pw_size-pw_win+1)
  113.             call equate(pw_size,pw_win,pw_table,pw_win_table,pw_1,pw_2)
  114.             if (cut_win(pw_win, pw_win_table) /= 0) then
  115.                 player_win = cut_win(pw_win, pw_win_table)
  116.                 return
  117.             end if
  118.         end do
  119.     end do
  120. end function
  121. !
  122. !функция проверки заполненности поля
  123. logical function full(f_size,f_table)
  124.     integer :: f_size, f_1, f_2
  125.     character :: f_table(f_size,f_size)
  126.     !
  127.     full = .true.
  128.     do f_1 =1,f_size
  129.         do f_2 =1, f_size
  130.             if ( f_table(f_1,f_2) == '-' ) then
  131.                 full = .false.
  132.                 return
  133.             end if
  134.         end do
  135.     end do
  136. end function
  137. !
  138. !способ проверки выигрыша - так как поле и размер клеток, нужных для выигрыша не совпадает
  139. !мы создаём процедуру, режущую исходное поле на поля размером количество клеток для выигрыша
  140. !на количество клеток для выигрыша
  141. subroutine equate(eq_size, eq_win, eq_table, eq_win_table, eq_pw_1, eq_pw_2)
  142.     integer :: eq_size, eq_win, eq_pw_1, eq_pw_2, eq_1, eq_2
  143.     character :: eq_table(eq_size, eq_size), eq_win_table(eq_win, eq_win)
  144.     !
  145.     do eq_1 =1, eq_win
  146.         do eq_2 =1, eq_win
  147.             eq_win_table(eq_1,eq_2) = eq_table( (eq_pw_1+eq_1-1),(eq_pw_2+eq_2-1) )
  148.         end do
  149.     end do
  150. end subroutine
  151. !
  152. !функция выигрыша в обрезанной таблице
  153. integer function cut_win(cw_win, cw_table)
  154.     integer :: cw_win, cw_1, for_if
  155.     character :: cw_table(cw_win,cw_win)
  156.     !
  157.     cut_win = 0
  158.     for_if = 0
  159.     do cw_1 = 1,cw_win
  160.         if (cw_table(cw_1,cw_1) == 'x' .and. (for_if == 2) ) then
  161.             for_if = 0
  162.             exit
  163.         elseif (cw_table(cw_1,cw_1) == 'x' .and. (for_if /= 2) ) then
  164.             for_if = 1
  165.         elseif (cw_table(cw_1,cw_1) == '0' .and. (for_if == 1) ) then
  166.             for_if = 0
  167.             exit
  168.         elseif (cw_table(cw_1,cw_1) == '0' .and. (for_if /= 1) ) then
  169.             for_if = 2
  170.         else
  171.             for_if = 0
  172.             exit
  173.         end if
  174.     end do
  175.     if ( (cw_1==cw_win) .and. (for_if /= 0) ) then
  176.         cut_win = for_if
  177.         return
  178.     end if
  179. end function
  180.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement