fixed client so that the user can update themselves!

fortran/client/app/main.f90

@@ -3,6 +3,7 @@ program main
    use iso_c_binding
    use raylib
    use player_mod
+   use json_module
    implicit none
 
    integer(c_int) :: screen_width = 800
@@ -11,10 +12,11 @@ program main
    type(camera3d), target :: camera
    type(player) :: me
    type(player), dimension(:), allocatable :: players
-   character(len=24):: username
+   character(len=24) :: username
-   character(len=24):: password
+   character(len=24) :: password
    integer :: i, status
    logical :: player_updated, exist
+   real(c_double) :: time
 
    inquire (file="debug.log", exist=exist)
    if (exist) then
@@ -26,7 +28,7 @@ program main
    call getarg(1, username)
    call getarg(2, password)
 
-   me = player(username, vector3( 0.0_c_float, 1.0_c_float, 2.0_c_float ), PURPLE)
+   me = player(username, vector3(0.0_c_float, 1.0_c_float, 2.0_c_float), PURPLE)
    players = me%login(password)
 
    camera%position = vector3(0.0_c_float, 10.0_c_float, 10.0_c_float) !Camera position
@@ -57,11 +59,14 @@ program main
 
       call me%sync_camera(camera)
 
+      time = get_time()
+      if (modulo(time, 1.0) .ge. 0.98_c_double) then
          if (player_updated) then
             players = me%move()
          else
             players = me%ping()
          end if
+      end if
 
       call begin_drawing()
       call clear_background(RAYWHITE)
@@ -71,7 +76,7 @@ program main
       call draw_grid(30_c_int, 1.0_c_float)
 
       call draw_cube(me%position, 0.5_c_float, 0.5_c_float, 0.5_c_float, me%apperance)
-            do i=1,size(players)
+      do i = 1, size(players)
          call draw_cube(players(i)%position, 0.5_c_float, 0.5_c_float, 0.5_c_float, players(i)%apperance)
       end do
       call end_mode_3d()
@@ -81,9 +86,9 @@ program main
 
    players = me%logout()
    if (allocated(players)) then
-      deallocate(players)
+      deallocate (players)
    end if
    call close_window() !Close window and OpenGL context
-   close(12)
+   close (12)
 
 end program main

fortran/client/src/player.f90

@@ -4,11 +4,11 @@ module player_mod
    use raylib
    use json_module
    use mod_dill, only: ipaddr, ipaddr_remote, IPADDR_IPV4, mrecv, msend, tcp_connect, &
-                       suffix_attach
+                       suffix_attach, tcp_close, suffix_detach
    implicit none
 
    type player
-      character(len=24):: username
+      character(len=:), allocatable :: username
       type(vector3) :: position
       type(color) :: apperance
    contains
@@ -21,12 +21,10 @@ module player_mod
 
 contains
 
-   type(player) function init_player(username, position, apperance, fifo_write, fifo_read) result(this)
+   type(player) function init_player(username, position, apperance) result(this)
       character(24) :: username
       type(vector3) :: position
       type(color) :: apperance
-      integer :: fifo_write
-      integer :: fifo_read
 
       this%username = username
       this%position = position
@@ -80,69 +78,83 @@ contains
       class(player) :: this
       type(player), dimension(:), allocatable :: players
       integer :: request_type
-      character(len=24) :: username
+      character(len=:), allocatable :: username
+      character(len=:), allocatable :: local_username
       integer :: apperance_r, apperance_g, apperance_b, i, count
-      real(c_float) :: x_pos, y_pos
+      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
-      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%initialize(path_mode=2)
       call json%create_object(root, '')
       call json%create_object(user, 'user')
 
-      call json%add(user, 'username', this%username)
+      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, '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(f_c_string(str, .true.)), 0_c_size_t), -1_c_int64_t)
+                 transfer(Len_Trim(str) + 1, 0_c_size_t), -1_c_int64_t)
 
-      call json%destroy()
+      connection = suffix_detach(connection, -1_c_size_t)
+
+      connection = suffix_attach(connection, TCP_SUFFIX, 2_c_size_t)
 
-      call json%initialize()
       message_size = mrecv(connection, message, msglen, -1_c_int64_t)
-      print *, 'recv message: ', message
+
+      print *, '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)
+      call json%deserialize(recv_users, jsn_string(:Len_Trim(jsn_string)))
 
-      print *, count
+      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 (i_str, fmt='(I10)') i
+         write (istr, fmt='(I10)') i
-         i_str = adjustl(i_str)
+         istr = adjustl(istr)
-         call json%get("/users/"//istr//"/apperance_r", apperance_r, found)
+         call json%get(recv_users, "/users/"//istr//"/apperance_r", apperance_r, found)
          if (.not. found) stop 1
-         call json%get("/users/"//istr//"/apperance_g", apperance_g, found)
+         call json%get(recv_users, "/users/"//istr//"/apperance_g", apperance_g, found)
          if (.not. found) stop 1
-         call json%get("/users/"//istr//"/apperance_b", apperance_b, found)
+         call json%get(recv_users, "/users/"//istr//"/apperance_b", apperance_b, found)
          if (.not. found) stop 1
-         call json%get("/users/"//istr//"/x_pos", x_pos, found)
+         call json%get(recv_users, "/users/"//istr//"/x_pos", x_pos, found)
          if (.not. found) stop 1
-         call json%get("/users/"//istr//"/y_pos", y_pos, found)
+         call json%get(recv_users, "/users/"//istr//"/y_pos", y_pos, found)
          if (.not. found) stop 1
-         call json%get("/users/"//istr//"/username", username, found)
+         call json%get(recv_users, "/users/"//istr//"/username", username, found)
          if (.not. found) stop 1
 
          if (allocated(players)) then
@@ -153,8 +165,12 @@ contains
                               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`

fortran/client/src/raylib.f90

@@ -407,28 +407,28 @@ module raylib
       subroutine disable_cursor() bind(c, name="DisableCursor")
       end subroutine disable_cursor
 
-    function is_key_pressed(key) result (res) bind(c, name="IsKeyPressed") 
+      function is_key_pressed(key) result(res) bind(c, name="IsKeyPressed")
          import :: c_int
          import :: c_bool
          logical(c_bool) :: res
          integer(c_int), intent(in), value :: key
       end function is_key_pressed
 
-    function is_key_down(key) result (res) bind(c, name="IsKeyDown")  
+      function is_key_down(key) result(res) bind(c, name="IsKeyDown")
          import :: c_int
          import :: c_bool
          logical(c_bool) :: res
          integer(c_int), intent(in), value :: key
       end function is_key_down
 
-    function is_key_released(key) result (res) bind(c, name="IsKeyReleased")
+      function is_key_released(key) result(res) bind(c, name="IsKeyReleased")
          import :: c_int
          import :: c_bool
          logical(c_bool) :: res
          integer(c_int), intent(in), value :: key
       end function is_key_released
 
-   function is_key_up(key) result (res) bind(c, name="IsKeyUp")      
+      function is_key_up(key) result(res) bind(c, name="IsKeyUp")
          import :: c_int
          import :: c_bool
          logical(c_bool) :: res
@@ -483,5 +483,10 @@ module raylib
          type(vector2), intent(in), value :: size
          type(color), intent(in), value  :: col
       end subroutine draw_plane
+
+      function get_time() result(res) bind(c, name="GetTime")
+         import :: c_double
+         real(c_double) :: res
+      end function get_time
    end interface
 end module

fortran/server/app/main.f90

@@ -54,7 +54,9 @@ program main
       call ipaddr_str(addr, address_string)
       print *, 'New connection from '//trim(address_string)
       connection = suffix_attach(connection, TCP_SUFFIX, 2_c_size_t)
+      print *, 'connected'
       message_size = mrecv(connection, message, msglen, -1_c_int64_t)
+      print *, message_size
 
       call c_f_string(message, jsn_string)
 
@@ -73,20 +75,20 @@ program main
       call json%destroy()
 
       if (command .eq. 0) then     ! get all logged in users and return their positions to client
-         rc = db_get_logged_in_users(db, connection)
       else if (command .eq. 1) then
          rc = db_login_user(db, username)
-         rc = db_get_logged_in_users(db, connection)
       else if (command .eq. 3) then ! update new pos to database
          rc = db_move_user(db, username, x_pos, y_pos)
-         rc = db_get_logged_in_users(db, connection)
       else ! (2)  if logout update logged_in to database
          rc = db_logout_user(db, username)
-         rc = db_get_logged_in_users(db, connection)
          exit server_loop
       end if
+
+      rc = db_get_logged_in_users(db, connection)
+      rc = tcp_close(connection, -1_c_int64_t)
    end do server_loop
 
+   rc = tcp_close(connection, -1_c_int64_t)
    rc = db_close(db)
 
 contains

fortran/server/src/db.f90

@@ -3,8 +3,7 @@ module db
    use iso_fortran_env
    use iso_c_binding
    use json_module
-   use mod_dill, only: ipaddr, ipaddr_remote, IPADDR_IPV4, mrecv, msend, tcp_connect, &
+   use mod_dill, only: msend, suffix_attach, suffix_detach
-                       suffix_attach
    use :: sqlite3
    implicit none
    private
@@ -145,6 +144,7 @@ contains
         !! Prints number of courses per student to standard output.
       type(db_type), intent(inout) :: db
       integer(c_int), intent(inout) :: connection
+      character(len=*), parameter :: TCP_SUFFIX = c_carriage_return // c_new_line // c_null_char
 
       character(len=:), allocatable :: str
       type(json_value), pointer :: root, users, user
@@ -198,8 +198,12 @@ contains
       call json%add(root, users)
       call json%serialize(root, str)
 
+      print *, 'sending users'
+      call json%print(root)
+
       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()
 
       rc = sqlite3_finalize(stmt)
@@ -215,7 +219,7 @@ contains
                               "UPDATE users SET logged_in = 1 WHERE users.username = ?;", stmt)
       call db_error(rc, 'sqlite3_prepare_v2()')
 
-      rc = sqlite3_bind_text(stmt, 1, username)
+      rc = sqlite3_bind_text(stmt, 1, username(:Len_Trim(username)))
       call db_error(rc, 'sqlite3_bind_text()')
 
       rc = sqlite3_step(stmt)