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 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=*), parameter :: TCP_SUFFIX = c_carriage_return // c_new_line // c_null_char rc = ipaddr_remote(addr, '127.0.0.1' // c_null_char, 35565_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(message, "(i3, 1x, a24, 1x, f8.2, 1x, f8.2)") request_type, & this%username, this%position%x, this%position%y rc = msend(connection, message(Len_Trim(message)), transfer(Len_Trim(message), 0_c_size_t), -1_c_int64_t) message_size = mrecv(connection, message, msglen, -1_c_int64_t) read (message(:message_size), '(i3)') count do i=0, count, 1 message_size = mrecv(connection, message, msglen, -1_c_int64_t) read(message, "(a, i3, i3, i3, f8.2, f8.2)") username, & apperance_r, apperance_g, apperance_b, x_pos, y_pos 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 end module player_mod