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 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 type(json_value), pointer :: root, user type(json_file) :: json character(len=:), allocatable :: str character(len=255) :: jsn_string character(len=10) :: i_str logical :: found 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) call json%initialize() call json%create_object(root, '') call json%create_object(user, 'user') call json%add(user, 'username', this%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) rc = msend(connection, f_c_string(str, .true.), & transfer(Len_Trim(f_c_string(str, .true.)), 0_c_size_t), -1_c_int64_t) call json%destroy() call json%initialize() message_size = mrecv(connection, message, msglen, -1_c_int64_t) print *, 'recv message: ', message call c_f_string(message, jsn_string) call json%deserialize(jsn_string(:Len_Trim(jsn_string))) call json%info('/users', n_children=count) print *, count do i = 0, count - 1 write (i_str, fmt='(I10)') i i_str = adjustl(i_str) call json%get("/users/"//istr//"/apperance_r", apperance_r, found) if (.not. found) stop 1 call json%get("/users/"//istr//"/apperance_g", apperance_g, found) if (.not. found) stop 1 call json%get("/users/"//istr//"/apperance_b", apperance_b, found) if (.not. found) stop 1 call json%get("/users/"//istr//"/x_pos", x_pos, found) if (.not. found) stop 1 call json%get("/users/"//istr//"/y_pos", y_pos, found) if (.not. found) stop 1 call json%get("/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 call json%destroy() 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