mmo-project/fortran/client/src/player.f90

module player_mod
   use iso_fortran_env
   use iso_c_binding
   use raylib
   use mod_dill, only: ipaddr, ipaddr_remote, IPADDR_IPV4, mrecv, msend, tcp_connect, &
                       suffix_attach
   implicit none

   type player
      character(len=24):: username
      type(vector3) :: position
      type(color) :: apperance
   contains
      procedure, public :: login
      procedure, public :: logout
      procedure, public :: ping
      procedure, public :: move
      procedure, non_overridable, public :: sync_camera
   end type player

contains

   type(player) function init_player(username, position, apperance, fifo_write, fifo_read) result(this)
      character(24) :: username
      type(vector3) :: position
      type(color) :: apperance
      integer :: fifo_write
      integer :: fifo_read

      this%username = username
      this%position = position
      this%apperance = apperance
   end function

   function login(this, password) result(players)
      class(player) :: this
      character(24) :: password
      type(player), dimension(:), allocatable :: players

      print *, password

      players = send_packet(this, 1)
   end function login

   function logout(this) result(players)
      class(player) :: this
      type(player), dimension(:), allocatable :: players

      players = send_packet(this, 2)
   end function logout

   function ping(this) result(players)
      class(player) :: this
      type(player), dimension(:), allocatable :: players

      players = send_packet(this, 0)
   end function ping

   function move(this) result(players)
      class(player) :: this
      type(player), dimension(:), allocatable :: players

      players = send_packet(this, 3)
   end function move

   subroutine sync_camera(this, camera)
      class(player), intent(inout) :: this
      type(camera3d), intent(inout) :: camera

      camera%position%x = this%position%x
      camera%position%y = this%position%y + 10.0_c_float
      camera%position%z = this%position%z + 10.0_c_float
      camera%target%x = this%position%x
      camera%target%y = this%position%y
      camera%target%z = this%position%z
   end subroutine sync_camera

   function send_packet(this, request_type) result(players)
      class(player) :: this
      type(player), dimension(:), allocatable :: players
      integer :: request_type
      character(len=24) :: username
      integer :: apperance_r, apperance_g, apperance_b, i, count
      real(c_float) :: x_pos, y_pos

      integer(c_int) :: rc, connection
      integer(c_size_t) :: message_size, msglen = 256
      type(ipaddr) :: addr
      character(c_char) :: message(256) = ''
      character(len=256) :: f_message
      character(len=*), parameter :: TCP_SUFFIX = c_carriage_return//c_new_line//c_null_char

      rc = ipaddr_remote(addr, '127.0.0.1'//c_null_char, 5555_c_int, IPADDR_IPV4, -1_c_int64_t)
      connection = tcp_connect(addr, -1_c_int64_t)
      connection = suffix_attach(connection, TCP_SUFFIX, 2_c_size_t)

      write (f_message, "(f8.2, f8.2, i3, a24)") &
           this%position%x, this%position%y, request_type, this%username

      print *, f_c_string(f_message, .true.)

      rc = msend(connection, f_c_string(f_message, .true.), &
                 transfer(Len_Trim(f_c_string(f_message, .true.)), 0_c_size_t), -1_c_int64_t)

      message_size = mrecv(connection, message, msglen, -1_c_int64_t)
      print *, 'recv message: ', message(:message_size)
      read (message(:message_size), '(i3)') count

      print *, count
      do i = 0, count, 1
         message_size = mrecv(connection, message, msglen, -1_c_int64_t)

         read (message(:message_size), "(i3, i3, i3, f8.2, f8.2, a24)") &
            apperance_r, apperance_g, apperance_b, x_pos, y_pos, username

         if (allocated(players)) then
            players = [players, player(username, vector3(x_pos, 1.0_c_float, y_pos), &
                                       color(apperance_r, apperance_g, apperance_b, 255))]
         else
            players = [player(username, vector3(x_pos, 1.0_c_float, y_pos), &
                              color(apperance_r, apperance_g, apperance_b, 255))]
         end if
      end do
   end function send_packet

   ! from ivanpribec `https://fortran-lang.discourse.group/t/best-practices-for-passing-c-strings/104/12`
   function f_c_string(string, trim)
      use, intrinsic :: iso_c_binding, only: c_char, c_null_char
      implicit none
      character(len=*), intent(in) :: string
      logical, intent(in), optional :: trim

      character(kind=c_char, len=:), allocatable :: f_c_string
      logical :: trim_

      trim_ = .true.
      if (present(trim)) trim_ = trim

      block
         intrinsic trim
         if (trim_) then
            f_c_string = trim(string)//c_null_char
         else
            f_c_string = string//c_null_char
         end if
      end block
   end function

end module player_mod