add json module

.gitignore

@@ -7,4 +7,3 @@ a.out
 *.*~
 
 build/
-fortran/client/client

fortran/client/fpm.toml

@@ -17,3 +17,4 @@ implicit-typing = false
 implicit-external = false
 source-form = "free"
 [dependencies]
+json-fortran = { git = "https://github.com/jacobwilliams/json-fortran.git" }

fortran/client/src/player.f90

@@ -2,6 +2,7 @@ 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
@@ -90,28 +91,59 @@ contains
       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)
 
-      write (f_message, "(f8.2, f8.2, i3, a24)") &
+      call json%initialize()
-           this%position%x, this%position%y, request_type, this%username
+      call json%create_object(root, '')
+      call json%create_object(user, 'user')
 
-      print *, f_c_string(f_message, .true.)
+      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)
 
-      rc = msend(connection, f_c_string(f_message, .true.), &
+      call json%add(root, user)
-                 transfer(Len_Trim(f_c_string(f_message, .true.)), 0_c_size_t), -1_c_int64_t)
+      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(:message_size)
+      print *, 'recv message: ', message
-      read (message(:message_size), '(i3)') count
+
+      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
+      do i = 0, count - 1
-         message_size = mrecv(connection, message, msglen, -1_c_int64_t)
+         write (i_str, fmt='(I10)') i
-
+         i_str = adjustl(i_str)
-         read (message(:message_size), "(i3, i3, i3, f8.2, f8.2, a24)") &
+         call json%get("/users/"//istr//"/apperance_r", apperance_r, found)
-            apperance_r, apperance_g, apperance_b, x_pos, y_pos, username
+         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), &
@@ -121,6 +153,8 @@ contains
                               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`
@@ -146,4 +180,16 @@ contains
       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

fortran/server/app/main.f90

@@ -1,28 +1,33 @@
 program main
    use iso_fortran_env
-   use iso_c_binding, only: c_char, c_double, c_int, c_int64_t, c_null_char, &
+   use iso_c_binding
-                            c_size_t, c_carriage_return, c_new_line
    use mod_dill, only: ipaddr, ipaddr_local, ipaddr_port, ipaddr_str, &
                        IPADDR_MAXSTRLEN, IPADDR_IPV4, tcp_accept, tcp_close, &
                        tcp_listen, mrecv, msend, suffix_attach, suffix_detach
+   use json_module
    use db
    implicit none
 
    type(db_type) :: db
    character(len=128):: db_path
-   character(len=24):: username
+   character(len=:), allocatable :: username
-   real(kind=c_double) :: x_pos
+   real(real64) :: x_pos
-   real(kind=c_double) :: y_pos
+   real(real64) :: y_pos
    integer :: command
-   logical :: exist
+   logical :: exist, found
 
    integer(c_int) :: connection, rc, socket
    integer(c_size_t) :: message_size, msglen = 256
-   character(c_char) :: message(256) = ''
+   character(c_char) :: message(255) = ''
    type(ipaddr) :: addr, addr_remote
    character(kind=c_char, len=IPADDR_MAXSTRLEN) :: address_string = ''
    character(len=*), parameter :: TCP_SUFFIX = c_carriage_return//c_new_line//c_null_char
 
+   type(json_value), pointer :: root
+   type(json_file) :: json
+   character(len=:), allocatable :: str
+   character(len=255) :: jsn_string
+
    call getarg(1, db_path)
 
    inquire (file=db_path(:Len_Trim(db_path)), exist=exist)
@@ -50,25 +55,33 @@ program main
       print *, 'New connection from '//trim(address_string)
       connection = suffix_attach(connection, TCP_SUFFIX, 2_c_size_t)
       message_size = mrecv(connection, message, msglen, -1_c_int64_t)
-      print *, message_size, message
 
-      read (message, "(f8.2, f8.2, i3, a24)") x_pos, y_pos, command, username
+      call c_f_string(message, jsn_string)
-      print *, 'username=', username, ' x_pos=', x_pos, ' y_pos=', y_pos, ' command=', command
+
+      call json%initialize()
+      call json%deserialize(jsn_string(:Len_Trim(jsn_string)))
+      call json%print()
+
+      call json%get('user.username', username, found)
+      if (.not. found) print *, 'cant find username!'
+      call json%get('user.x_pos', x_pos, found)
+      if (.not. found) print *, 'cant find x_pos!'
+      call json%get('user.y_pos', y_pos, found)
+      if (.not. found) print *, 'cant find y_pos!'
+      call json%get('user.command', command, found)
+      if (.not. found) print *, 'cant find command!'
+      call json%destroy()
 
       if (command .eq. 0) then     ! get all logged in users and return their positions to client
-         rc = db_count_logged_in_users(db, connection)
          rc = db_get_logged_in_users(db, connection)
       else if (command .eq. 1) then
          rc = db_login_user(db, username)
-         rc = db_count_logged_in_users(db, connection)
          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_count_logged_in_users(db, connection)
          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_count_logged_in_users(db, connection)
          rc = db_get_logged_in_users(db, connection)
          exit server_loop
       end if
@@ -76,4 +89,17 @@ program main
 
    rc = db_close(db)
 
+contains
+   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 program main

fortran/server/fpm.toml

@@ -18,3 +18,4 @@ implicit-external = false
 source-form = "free"
 [dependencies]
 fortran-sqlite3 = { git = "https://github.com/interkosmos/fortran-sqlite3.git" }
+json-fortran = { git = "https://github.com/jacobwilliams/json-fortran.git" }

fortran/server/src/db.f90

@@ -2,6 +2,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, &
                        suffix_attach
    use :: sqlite3
@@ -18,7 +19,6 @@ module db
    public :: db_open
    public :: db_create_users
    public :: db_get_logged_in_users
-   public :: db_count_logged_in_users
    public :: db_add_user
    public :: db_login_user
    public :: db_logout_user
@@ -141,51 +141,17 @@ contains
       call db_error(rc, 'sqlite3_finalize()')
    end function db_delete_user
 
-   integer function db_count_logged_in_users(db, connection) result(rc)
-        !! Prints number of courses per student to standard output.
-      type(db_type), intent(inout) :: db
-      integer(c_int), intent(inout) :: connection
-
-      character(len=256) :: message
-      type(c_ptr)      :: stmt
-      integer :: count
-
-      rc = sqlite3_prepare_v2(db%ptr, "SELECT count(logged_in) FROM users u WHERE u.logged_in = 1;", stmt)
-      call db_error(rc, 'sqlite3_prepare_v2()')
-
-      step_loop: do
-         rc = sqlite3_step(stmt)
-
-         select case (rc)
-         case (SQLITE_ROW)
-            count = sqlite3_column_int(stmt, 0)
-            print *, 'logged in: ', count
-
-            write (message, "(i3)") count
-            rc = msend(connection, f_c_string(message, .true.), &
-                 transfer(Len_Trim(f_c_string(message, .true.)), 0_c_size_t), -1_c_int64_t)
-
-         case (SQLITE_DONE)
-            exit step_loop
-
-         case default
-            call db_error(rc, 'sqlite3_step()')
-            exit step_loop
-         end select
-      end do step_loop
-
-      rc = sqlite3_finalize(stmt)
-      call db_error(rc, 'sqlite3_finalize()')
-   end function db_count_logged_in_users
-
    integer function db_get_logged_in_users(db, connection) result(rc)
         !! Prints number of courses per student to standard output.
       type(db_type), intent(inout) :: db
       integer(c_int), intent(inout) :: connection
 
-      character(len=256) :: message
+      character(len=:), allocatable :: str
+      type(json_value), pointer :: root, users, user
+      type(json_core) :: json
+
       type(c_ptr)      :: stmt
-      character(len=24) :: username
+      character(len=:), allocatable :: username
       integer :: apperance_r, apperance_g, apperance_b
       real(real64) :: x_pos, y_pos
 
@@ -194,6 +160,10 @@ contains
                               "FROM users u WHERE u.logged_in = 1;", stmt)
       call db_error(rc, 'sqlite3_prepare_v2()')
 
+      call json%initialize()
+      call json%create_object(root, '')
+      call json%create_array(users, 'users')
+
       step_loop: do
          rc = sqlite3_step(stmt)
 
@@ -206,11 +176,16 @@ contains
             x_pos = sqlite3_column_double(stmt, 4)
             y_pos = sqlite3_column_double(stmt, 5)
 
-            write (message, "(i3, i3, i3, f8.2, f8.2, a24)") &
+            call json%create_object(user, username)
-               apperance_r, apperance_g, apperance_b, x_pos, y_pos, username(:Len_Trim(username))
+            call json%add(user, 'apperance_r', apperance_r)
+            call json%add(user, 'apperance_g', apperance_g)
+            call json%add(user, 'apperance_b', apperance_b)
+            call json%add(user, 'x_pos', x_pos)
+            call json%add(user, 'y_pos', y_pos)
+            call json%add(user, 'username', username)
+            call json%add(users, user)
+            nullify(user) !cleanup
 
-            rc = msend(connection, f_c_string(message, .true.), &
-                 transfer(Len_Trim(f_c_string(message, .true.)), 0_c_size_t), -1_c_int64_t)
          case (SQLITE_DONE)
             exit step_loop
 
@@ -220,13 +195,20 @@ contains
          end select
       end do step_loop
 
+      call json%add(root, users)
+      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()
+
       rc = sqlite3_finalize(stmt)
       call db_error(rc, 'sqlite3_finalize()')
    end function db_get_logged_in_users
 
    integer function db_login_user(db, username) result(rc)
       type(db_type), intent(inout) :: db
-      character(len=24), intent(in) :: username
+      character(len=:), allocatable, intent(in) :: username
       type(c_ptr)      :: stmt
 
       rc = sqlite3_prepare_v2(db%ptr, &
@@ -264,9 +246,9 @@ contains
 
    integer function db_move_user(db, username, x_pos, y_pos) result(rc)
       type(db_type), intent(inout) :: db
-      character(len=24), intent(in) :: username
+      character(len=:), allocatable, intent(in) :: username
-      real(kind=c_double), intent(in) :: x_pos
+      real(c_double), intent(in) :: x_pos
-      real(kind=c_double), intent(in) :: y_pos
+      real(c_double), intent(in) :: y_pos
       type(c_ptr)      :: stmt
 
       rc = sqlite3_prepare_v2(db%ptr, &

fortran/server/test/json_test.sh

@@ -0,0 +1,2 @@
+#!/bin/sh
+cat player.json | nc localhost 5555

fortran/server/test/server_test.f90

@@ -1,7 +0,0 @@
-program main
-   use iso_fortran_env
-   implicit none
-
-   write(output_unit, "(i3, 1x, a24, 1x, f8.2, 1x, f8.2)") 0, 'chakr', 0.0, 0.0
-
-end program main