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

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

   type player
      character(len=:), allocatable :: 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) result(this)
      character(24) :: username
      type(vector3) :: position
      type(color) :: apperance

      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=:), allocatable :: username
      character(len=:), allocatable :: local_username
      integer :: apperance_r, apperance_g, apperance_b, i, count
      real(real64) :: x_pos, y_pos

      integer(c_size_t) :: message_size, msglen = 1024
      character(c_char) :: message(1024) = ''
      character(len=256) :: f_message

      type(json_value), pointer :: root, user, recv_users
      type(json_core) :: json
      character(len=:), allocatable :: str
      character(len=1024) :: jsn_string
      character(len=10) :: istr
      logical :: found

      integer(c_int) :: rc, connection
      type(ipaddr) :: addr
      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)

      call json%initialize(path_mode=2)
      call json%create_object(root, '')
      call json%create_object(user, 'user')

      local_username = this%username(:Len_Trim(this%username))

      call json%add(user, 'username', local_username)
      call json%add(user, 'x_pos', this%position%x)
      call json%add(user, 'y_pos', this%position%z)
      call json%add(user, 'command', request_type)

      call json%add(root, user)
      call json%serialize(root, str)

      call json%print(root)
      
      connection = suffix_attach(connection, TCP_SUFFIX, 2_c_size_t)

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

      connection = suffix_detach(connection, -1_c_size_t)

      connection = suffix_attach(connection, TCP_SUFFIX, 2_c_size_t)

      message_size = mrecv(connection, message, msglen, -1_c_int64_t)

      print *, 'message=', message

      call c_f_string(message, jsn_string)

      call json%deserialize(recv_users, jsn_string(:Len_Trim(jsn_string)))

      call json%info(recv_users, '/users', n_children=count)

      if (allocated(players)) then
         deallocate (players)
      end if

      if (count > 0) then
      do i = 0, count - 1
         write (istr, fmt='(I10)') i
         istr = adjustl(istr)
         call json%get(recv_users, "/users/"//istr//"/apperance_r", apperance_r, found)
         if (.not. found) stop 1
         call json%get(recv_users, "/users/"//istr//"/apperance_g", apperance_g, found)
         if (.not. found) stop 1
         call json%get(recv_users, "/users/"//istr//"/apperance_b", apperance_b, found)
         if (.not. found) stop 1
         call json%get(recv_users, "/users/"//istr//"/x_pos", x_pos, found)
         if (.not. found) stop 1
         call json%get(recv_users, "/users/"//istr//"/y_pos", y_pos, found)
         if (.not. found) stop 1
         call json%get(recv_users, "/users/"//istr//"/username", username, found)
         if (.not. found) stop 1

         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 if

      nullify (recv_users)
      call json%destroy()
      
      rc = tcp_close(connection, -1_c_int64_t)
   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

   subroutine c_f_string(c_string, f_string)
      character(kind=c_char), dimension(:), intent(in) :: c_string
      character(len=*), intent(out) :: f_string
      integer :: i
      i = 1
      do while (c_string(i) /= c_null_char .and. i <= len(f_string) - 1)
         f_string(i:i) = c_string(i)
         i = i + 1
      end do
      if (i < len(f_string)) f_string(i:) = ' '
   end subroutine c_f_string

end module player_mod