add tcp client/server

.gitignore

@@ -3,6 +3,8 @@ a.out
 
 *.mod
 *.log
+*.~undo-tree~
+*.*~
 
 build/
 fortran/client/client

fortran/client/app/main.f90

@@ -27,7 +27,7 @@ program main
    call getarg(2, password)
 
    me = player(username, vector3( 0.0_c_float, 1.0_c_float, 2.0_c_float ), PURPLE)
-   !players = me%login(password)
+   players = me%login(password)
 
    camera%position = vector3(0.0_c_float, 10.0_c_float, 10.0_c_float) !Camera position
    camera%target = vector3(0.0_c_float, 0.0_c_float, 0.0_c_float) !Camera looking at point
@@ -58,9 +58,9 @@ program main
       call me%sync_camera(camera)
 
       if (player_updated) then
-         !players = me%move()
+         players = me%move()
       else
-         !players = me%ping()
+         players = me%ping()
       end if
 
       call begin_drawing()
@@ -71,15 +71,15 @@ 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)            
+               call draw_cube(players(i)%position, 0.5_c_float, 0.5_c_float, 0.5_c_float, players(i)%apperance)
-            !end do
+            end do
          call end_mode_3d()
       call end_drawing()
 
    end do
 
-   !players = me%logout()
+   players = me%logout()
    if (allocated(players)) then
       deallocate(players)
    end if

fortran/client/fpm.toml

@@ -16,3 +16,4 @@ library = false
 implicit-typing = false
 implicit-external = false
 source-form = "free"
+[dependencies]

fortran/client/src/player.f90

@@ -37,6 +37,8 @@ contains
       character(24) :: password
       type(player), dimension(:), allocatable :: players
 
+      print *, password
+
       players = send_packet(this, 1)
    end function login
 
@@ -85,33 +87,63 @@ contains
       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
+      character(len=256) :: f_message
+      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)
+      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(message, "(i3, 1x, a24, 1x, f8.2, 1x, f8.2)")  request_type, &
+      write (f_message, "(f8.2, f8.2, i3, a24)") &
-            this%username, this%position%x, this%position%y
+           this%position%x, this%position%y, request_type, this%username
 
-        rc = msend(connection, message(Len_Trim(message)), transfer(Len_Trim(message), 0_c_size_t), -1_c_int64_t)
+      print *, f_c_string(f_message, .true.)
+
+      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)
 
       message_size = mrecv(connection, message, msglen, -1_c_int64_t)
+      print *, 'recv message: ', message(:message_size)
       read (message(:message_size), '(i3)') count
-        do i=0, count, 1
+
+      print *, 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, & 
+         read (message(:message_size), "(i3, i3, i3, f8.2, f8.2, a24)") &
-                apperance_r, apperance_g, apperance_b, x_pos, y_pos
+            apperance_r, apperance_g, apperance_b, x_pos, y_pos, username
 
          if (allocated(players)) then
-                players = [players, player(username, vector3( x_pos, 1.0_c_float, y_pos ), &
+            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 ), &
+            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
 
+   ! 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
+
 end module player_mod

fortran/server/app/main.f90

@@ -1,6 +1,10 @@
 program main
    use iso_fortran_env
-   use, intrinsic :: iso_c_binding
+   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 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 db
    implicit none
 
@@ -9,15 +13,15 @@ program main
    character(len=24):: username
    real(kind=c_double) :: x_pos
    real(kind=c_double) :: y_pos
-   integer :: command, rc
+   integer :: command
    logical :: exist
 
-   inquire (file="debug.log", exist=exist)
+   integer(c_int) :: connection, rc, socket
-   if (exist) then
+   integer(c_size_t) :: message_size, msglen = 256
-      open (12, file="debug.log", status="old", position="append", action="write")
+   character(c_char) :: message(256) = ''
-   else
+   type(ipaddr) :: addr, addr_remote
-      open (12, file="debug.log", status="new", action="write")
+   character(kind=c_char, len=IPADDR_MAXSTRLEN) :: address_string = ''
-   end if
+   character(len=*), parameter :: TCP_SUFFIX = c_carriage_return//c_new_line//c_null_char
 
    call getarg(1, db_path)
 
@@ -27,34 +31,49 @@ program main
    end if
 
    rc = db_open(db, db_path(:Len_Trim(db_path)))
+
+   rc = ipaddr_local(addr, '127.0.0.1'//c_null_char, 5555_c_int, IPADDR_IPV4)
+   call ipaddr_str(addr, address_string)
+
+   print *, 'Listening on socket:'
+   print *, '  IP address: ', address_string
+   print *, '  Port: ', ipaddr_port(addr)
+   print *, '  Opened DB : ', db_path(:Len_Trim(db_path))
+
+   socket = tcp_listen(addr, 0_c_int)
+
    ! do while not logged out
    server_loop: do
 
-    ! read message from stdin
+      connection = tcp_accept(socket, addr_remote, -1_c_int64_t)
-    read(input_unit,  "(i3, 1x, a24, 1x, f8.2, 1x, f8.2)") command, username, x_pos, y_pos
+      call ipaddr_str(addr, address_string)
-    write(12, "(i3, 1x, a24, 1x, f8.2, 1x, f8.2)") command, username, x_pos, y_pos
+      print *, 'New connection from '//trim(address_string)
-    call flush(12)
+      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
 
       if (command .eq. 0) then     ! get all logged in users and return their positions to client
-      rc = db_count_logged_in_users(db)
+         rc = db_count_logged_in_users(db, connection)
-      rc = db_get_logged_in_users(db)
+         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)
+         rc = db_count_logged_in_users(db, connection)
-      rc = db_get_logged_in_users(db)
+         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)
+         rc = db_count_logged_in_users(db, connection)
-      rc = db_get_logged_in_users(db)
+         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)
+         rc = db_count_logged_in_users(db, connection)
-      rc = db_get_logged_in_users(db)
+         rc = db_get_logged_in_users(db, connection)
          exit server_loop
       end if
    end do server_loop
 
    rc = db_close(db)
-  close(12)
 
 end program main

fortran/server/src/db.f90

@@ -1,7 +1,9 @@
 ! db.f90
 module db
    use iso_fortran_env
-    use, intrinsic :: iso_c_binding
+   use iso_c_binding
+   use mod_dill, only: ipaddr, ipaddr_remote, IPADDR_IPV4, mrecv, msend, tcp_connect, &
+                       suffix_attach
    use :: sqlite3
    implicit none
    private
@@ -27,7 +29,6 @@ module db
    private :: db_exec
 contains
 
-
    integer function db_open(db, path) result(rc)
         !! Opens database.
       type(db_type), intent(inout) :: db
@@ -61,11 +62,11 @@ contains
 
       ! Create table "users".
       rc = db_exec(db, "CREATE TABLE users " &
-        // "(id INTEGER PRIMARY KEY ASC, " &
+                   //"(id INTEGER PRIMARY KEY ASC, " &
-        // "username TEXT, password TEXT, " &
+                   //"username TEXT, password TEXT, " &
-        // "apperance_r INTEGER, apperance_g INTEGER, apperance_b INTEGER, " &
+                   //"apperance_r INTEGER, apperance_g INTEGER, apperance_b INTEGER, " &
-        // "x_pos REAL, y_pos REAL, logged_in INTEGER, " &
+                   //"x_pos REAL, y_pos REAL, logged_in INTEGER, " &
-        // "created INTEGER);")
+                   //"created INTEGER);")
       if (rc /= SQLITE_OK) return
    end function db_create_users
 
@@ -118,7 +119,6 @@ contains
       call db_error(rc, 'sqlite3_finalize()')
    end function db_add_user
 
-
    integer function db_delete_user(db, username) result(rc)
         !! Adds student to database.
       type(db_type), intent(inout) :: db
@@ -141,10 +141,12 @@ contains
       call db_error(rc, 'sqlite3_finalize()')
    end function db_delete_user
 
-    integer function db_count_logged_in_users(db) result(rc)
+   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
 
@@ -157,7 +159,11 @@ contains
          select case (rc)
          case (SQLITE_ROW)
             count = sqlite3_column_int(stmt, 0)
-                    write(output_unit, "(i0)") count
+            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
@@ -172,17 +178,19 @@ contains
       call db_error(rc, 'sqlite3_finalize()')
    end function db_count_logged_in_users
 
-    integer function db_get_logged_in_users(db) result(rc)
+   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
       type(c_ptr)      :: stmt
       character(len=24) :: username
       integer :: apperance_r, apperance_g, apperance_b
-        real :: x_pos, y_pos
+      real(real64) :: x_pos, y_pos
 
       rc = sqlite3_prepare_v2(db%ptr, &
-                "SELECT username, apperance_r, apperance_g, apperance_b, x_pos, y_pos " // &
+                              "SELECT username, apperance_r, apperance_g, apperance_b, x_pos, y_pos "// &
                               "FROM users u WHERE u.logged_in = 1;", stmt)
       call db_error(rc, 'sqlite3_prepare_v2()')
 
@@ -197,9 +205,12 @@ contains
             apperance_b = sqlite3_column_int(stmt, 3)
             x_pos = sqlite3_column_double(stmt, 4)
             y_pos = sqlite3_column_double(stmt, 5)
-                    write(output_unit, "(a24, 1x, i3, 1x, i3, 1x, i3, 1x, f8.2, 1x, f8.2)") username(:Len_Trim(username)), & 
-                        apperance_r, apperance_g, apperance_b, x_pos, y_pos
 
+            write (message, "(i3, i3, i3, f8.2, f8.2, a24)") &
+               apperance_r, apperance_g, apperance_b, x_pos, y_pos, username(:Len_Trim(username))
+
+            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
 
@@ -285,15 +296,38 @@ contains
       if (code == SQLITE_OK .or. code == SQLITE_DONE) return
 
       if (present(proc) .and. present(err_msg)) then
-            write(12, '(a, ": ", a, " (", i0, ")")') proc, err_msg, code
+         print *, proc, err_msg, code
          return
       end if
 
       if (present(proc)) then
-            write(12, '(a, ": ", i0)') proc, code
+         print *, proc, code
          return
       end if
 
-        write(12, '("unknown error: ", i0)') code
+      print *, 'unknown error: ', code
    end subroutine db_error
+
+   ! 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
 end module db

fortran/server/test.sh

@@ -1,2 +1,3 @@
 #!/bin/sh
-listen1 'tcp!*!35565' ~/.local/bin/fortran-mmo-server ../../common/sql/test.db3
+#listen1 'tcp!*!35565'
+~/.local/bin/fortran-mmo-server ../../common/sql/test.db3