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 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%y) 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 (username .ne. this%username) then 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 else if (request_type .eq. 1) then print *, 'login, setting pos' this%position%x = x_pos this%position%y = y_pos print *, x_pos, y_pos print *, 'login, setting apperance' this%apperance%r = apperance_r this%apperance%g = apperance_g this%apperance%b = apperance_b print *, apperance_r, apperance_g, apperance_b end if 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