diff --git a/.gitignore b/.gitignore index 9fa917e..a260995 100644 --- a/.gitignore +++ b/.gitignore @@ -7,4 +7,3 @@ a.out *.*~ build/ -fortran/client/client diff --git a/common/sql/test.db3 b/common/sql/test.db3 index 5d766a5..8272975 100644 Binary files a/common/sql/test.db3 and b/common/sql/test.db3 differ diff --git a/fortran/client/fpm.toml b/fortran/client/fpm.toml index 508f25a..8f289a3 100644 --- a/fortran/client/fpm.toml +++ b/fortran/client/fpm.toml @@ -16,4 +16,5 @@ library = false implicit-typing = false implicit-external = false source-form = "free" -[dependencies] \ No newline at end of file +[dependencies] +json-fortran = { git = "https://github.com/jacobwilliams/json-fortran.git" } \ No newline at end of file diff --git a/fortran/client/src/player.f90 b/fortran/client/src/player.f90 index d479e2f..0853b45 100644 --- a/fortran/client/src/player.f90 +++ b/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)") & - this%position%x, this%position%y, request_type, this%username + call json%initialize() + 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.), & - transfer(Len_Trim(f_c_string(f_message, .true.)), 0_c_size_t), -1_c_int64_t) + 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(:message_size) - read (message(:message_size), '(i3)') count + 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 - message_size = mrecv(connection, message, msglen, -1_c_int64_t) - - read (message(:message_size), "(i3, i3, i3, f8.2, f8.2, a24)") & - apperance_r, apperance_g, apperance_b, x_pos, y_pos, username + 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), & @@ -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 diff --git a/fortran/server/.test.sh.swp b/fortran/server/.test.sh.swp deleted file mode 100644 index f528278..0000000 Binary files a/fortran/server/.test.sh.swp and /dev/null differ diff --git a/fortran/server/app/main.f90 b/fortran/server/app/main.f90 index 27cf5e1..d5d0912 100644 --- a/fortran/server/app/main.f90 +++ b/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, & - c_size_t, c_carriage_return, c_new_line + use iso_c_binding 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 - real(kind=c_double) :: x_pos - real(kind=c_double) :: y_pos + character(len=:), allocatable :: username + real(real64) :: x_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 - print *, 'username=', username, ' x_pos=', x_pos, ' y_pos=', y_pos, ' command=', command + call c_f_string(message, jsn_string) + + 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 diff --git a/fortran/server/fpm.toml b/fortran/server/fpm.toml index 0fbb4e6..2e6da77 100644 --- a/fortran/server/fpm.toml +++ b/fortran/server/fpm.toml @@ -17,4 +17,5 @@ implicit-typing = false implicit-external = false source-form = "free" [dependencies] -fortran-sqlite3 = { git = "https://github.com/interkosmos/fortran-sqlite3.git" } \ No newline at end of file +fortran-sqlite3 = { git = "https://github.com/interkosmos/fortran-sqlite3.git" } +json-fortran = { git = "https://github.com/jacobwilliams/json-fortran.git" } \ No newline at end of file diff --git a/fortran/server/src/db.f90 b/fortran/server/src/db.f90 index 206f29b..d6ade0e 100644 --- a/fortran/server/src/db.f90 +++ b/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)") & - apperance_r, apperance_g, apperance_b, x_pos, y_pos, username(:Len_Trim(username)) + call json%create_object(user, 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 - real(kind=c_double), intent(in) :: x_pos - real(kind=c_double), intent(in) :: y_pos + character(len=:), allocatable, intent(in) :: username + real(c_double), intent(in) :: x_pos + real(c_double), intent(in) :: y_pos type(c_ptr) :: stmt rc = sqlite3_prepare_v2(db%ptr, & diff --git a/fortran/server/test/json_test.sh b/fortran/server/test/json_test.sh new file mode 100755 index 0000000..e4e8fa5 --- /dev/null +++ b/fortran/server/test/json_test.sh @@ -0,0 +1,2 @@ +#!/bin/sh +cat player.json | nc localhost 5555 diff --git a/fortran/server/test/player.json b/fortran/server/test/player.json new file mode 100644 index 0000000..d2dfff1 Binary files /dev/null and b/fortran/server/test/player.json differ diff --git a/fortran/server/test/server_test.f90 b/fortran/server/test/server_test.f90 deleted file mode 100644 index 68dc289..0000000 --- a/fortran/server/test/server_test.f90 +++ /dev/null @@ -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 \ No newline at end of file