zongor
/
mmo-project
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

add tcp client/server

This commit is contained in:
zongor 2023-10-08 11:54:21 -04:00
parent dad620f74e
commit b0c551bd07
9 changed files with 443 additions and 354 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

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

BIN
common/sql/test.db3
View File

Binary file not shown.

14
fortran/client/app/main.f90
View File

@ -27,7 +27,7 @@ program main
call getarg(2, password) 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) players = me%login(password)
camera%position = vector3(0.0_c_float, 10.0_c_float, 10.0_c_float) !Camera position 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 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) call me%sync_camera(camera)
if (player_updated) then if (player_updated) then
!players = me%move() players = me%move()
else else
!players = me%ping() players = me%ping()
end if end if
call begin_drawing() call begin_drawing()
@ -71,15 +71,15 @@ program main
call draw_grid(30_c_int, 1.0_c_float) 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) 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_mode_3d()
call end_drawing() call end_drawing()
end do end do
!players = me%logout() players = me%logout()
if (allocated(players)) then if (allocated(players)) then
deallocate(players) deallocate(players)
end if end if

1
fortran/client/fpm.toml
View File

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

196
fortran/client/src/player.f90
View File

@ -1,67 +1,69 @@
module player_mod module player_mod
use iso_fortran_env use iso_fortran_env
use iso_c_binding use iso_c_binding
use raylib use raylib
use mod_dill, only: ipaddr, ipaddr_remote, IPADDR_IPV4, mrecv, msend, tcp_connect, & use mod_dill, only: ipaddr, ipaddr_remote, IPADDR_IPV4, mrecv, msend, tcp_connect, &
suffix_attach suffix_attach
implicit none implicit none
type player type player
character(len=24):: username character(len=24):: username
type(vector3) :: position type(vector3) :: position
type(color) :: apperance type(color) :: apperance
contains contains
procedure, public :: login procedure, public :: login
procedure, public :: logout procedure, public :: logout
procedure, public :: ping procedure, public :: ping
procedure, public :: move procedure, public :: move
procedure, non_overridable, public :: sync_camera procedure, non_overridable, public :: sync_camera
end type player end type player
contains contains
type(player) function init_player(username, position, apperance, fifo_write, fifo_read) result(this) type(player) function init_player(username, position, apperance, fifo_write, fifo_read) result(this)
character(24) :: username character(24) :: username
type(vector3) :: position type(vector3) :: position
type(color) :: apperance type(color) :: apperance
integer :: fifo_write integer :: fifo_write
integer :: fifo_read integer :: fifo_read
this%username = username this%username = username
this%position = position this%position = position
this%apperance = apperance this%apperance = apperance
end function end function
function login(this, password) result(players) function login(this, password) result(players)
class(player) :: this class(player) :: this
character(24) :: password character(24) :: password
type(player), dimension(:), allocatable :: players type(player), dimension(:), allocatable :: players
players = send_packet(this, 1) print *, password
end function login
function logout(this) result(players) players = send_packet(this, 1)
class(player) :: this end function login
type(player), dimension(:), allocatable :: players
players = send_packet(this, 2) function logout(this) result(players)
end function logout class(player) :: this
type(player), dimension(:), allocatable :: players
function ping(this) result(players) players = send_packet(this, 2)
class(player) :: this end function logout
type(player), dimension(:), allocatable :: players
players = send_packet(this, 0) function ping(this) result(players)
end function ping class(player) :: this
type(player), dimension(:), allocatable :: players
function move(this) result(players) players = send_packet(this, 0)
class(player) :: this end function ping
type(player), dimension(:), allocatable :: players
players = send_packet(this, 3) function move(this) result(players)
end function move class(player) :: this
type(player), dimension(:), allocatable :: players
subroutine sync_camera(this, camera) players = send_packet(this, 3)
end function move
subroutine sync_camera(this, camera)
class(player), intent(inout) :: this class(player), intent(inout) :: this
type(camera3d), intent(inout) :: camera type(camera3d), intent(inout) :: camera
@ -71,47 +73,77 @@ contains
camera%target%x = this%position%x camera%target%x = this%position%x
camera%target%y = this%position%y camera%target%y = this%position%y
camera%target%z = this%position%z camera%target%z = this%position%z
end subroutine sync_camera end subroutine sync_camera
function send_packet(this, request_type) result(players) function send_packet(this, request_type) result(players)
class(player) :: this class(player) :: this
type(player), dimension(:), allocatable :: players type(player), dimension(:), allocatable :: players
integer :: request_type integer :: request_type
character(len=24) :: username character(len=24) :: username
integer :: apperance_r, apperance_g, apperance_b, i, count integer :: apperance_r, apperance_g, apperance_b, i, count
real(c_float) :: x_pos, y_pos real(c_float) :: x_pos, y_pos
integer(c_int) :: rc, connection integer(c_int) :: rc, connection
integer(c_size_t) :: message_size, msglen = 256 integer(c_size_t) :: message_size, msglen = 256
type(ipaddr) :: addr type(ipaddr) :: addr
character(c_char) :: message(256) = '' 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 = tcp_connect(addr, -1_c_int64_t)
connection = suffix_attach(connection, TCP_SUFFIX, 2_c_size_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.)
message_size = mrecv(connection, message, msglen, -1_c_int64_t) rc = msend(connection, f_c_string(f_message, .true.), &
read (message(:message_size), '(i3)') count transfer(Len_Trim(f_c_string(f_message, .true.)), 0_c_size_t), -1_c_int64_t)
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, & message_size = mrecv(connection, message, msglen, -1_c_int64_t)
apperance_r, apperance_g, apperance_b, x_pos, y_pos print *, 'recv message: ', message(:message_size)
read (message(:message_size), '(i3)') count
if (allocated(players)) then print *, count
players = [players, player(username, vector3( x_pos, 1.0_c_float, y_pos ), & do i = 0, count, 1
color(apperance_r, apperance_g, apperance_b, 255))] message_size = mrecv(connection, message, msglen, -1_c_int64_t)
else
players = [player(username, vector3( x_pos, 1.0_c_float, y_pos ), & read (message(:message_size), "(i3, i3, i3, f8.2, f8.2, a24)") &
color(apperance_r, apperance_g, apperance_b, 255))] apperance_r, apperance_g, apperance_b, x_pos, y_pos, username
end if
end do 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 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 end module player_mod

BIN
fortran/server/.test.sh.swp Normal file
View File

Binary file not shown.

89
fortran/server/app/main.f90
View File

@ -1,6 +1,10 @@
program main program main
use iso_fortran_env 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 use db
implicit none implicit none
@ -9,15 +13,15 @@ program main
character(len=24):: username character(len=24):: username
real(kind=c_double) :: x_pos real(kind=c_double) :: x_pos
real(kind=c_double) :: y_pos real(kind=c_double) :: y_pos
integer :: command, rc integer :: command
logical :: exist 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) call getarg(1, db_path)
@ -26,35 +30,50 @@ program main
stop 1 stop 1
end if end if
rc = db_open(db, db_path(:Len_Trim(db_path))) rc = db_open(db, db_path(:Len_Trim(db_path)))
! do while not logged out
server_loop: do
! read message from stdin rc = ipaddr_local(addr, '127.0.0.1'//c_null_char, 5555_c_int, IPADDR_IPV4)
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
call flush(12)
if (command .eq. 0) then ! get all logged in users and return their positions to client print *, 'Listening on socket:'
rc = db_count_logged_in_users(db) print *, ' IP address: ', address_string
rc = db_get_logged_in_users(db) print *, ' Port: ', ipaddr_port(addr)
else if (command .eq. 1) then print *, ' Opened DB : ', db_path(:Len_Trim(db_path))
rc = db_login_user(db, username)
rc = db_count_logged_in_users(db)
rc = db_get_logged_in_users(db)
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_get_logged_in_users(db)
else ! (2) if logout update logged_in to database
rc = db_logout_user(db, username)
rc = db_count_logged_in_users(db)
rc = db_get_logged_in_users(db)
exit server_loop
end if
end do server_loop
rc = db_close(db) socket = tcp_listen(addr, 0_c_int)
close(12)
! do while not logged out
server_loop: do
connection = tcp_accept(socket, addr_remote, -1_c_int64_t)
call ipaddr_str(addr, address_string)
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
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
end do server_loop
rc = db_close(db)
end program main end program main

492
fortran/server/src/db.f90
View File

@ -1,299 +1,333 @@
! db.f90 ! db.f90
module db module db
use iso_fortran_env use iso_fortran_env
use, intrinsic :: iso_c_binding use iso_c_binding
use :: sqlite3 use mod_dill, only: ipaddr, ipaddr_remote, IPADDR_IPV4, mrecv, msend, tcp_connect, &
implicit none suffix_attach
private use :: sqlite3
implicit none
private
integer, parameter, public :: DB_OK = SQLITE_OK integer, parameter, public :: DB_OK = SQLITE_OK
type, public :: db_type type, public :: db_type
type(c_ptr) :: ptr = c_null_ptr type(c_ptr) :: ptr = c_null_ptr
end type db_type end type db_type
public :: db_close public :: db_close
public :: db_open public :: db_open
public :: db_create_users public :: db_create_users
public :: db_get_logged_in_users public :: db_get_logged_in_users
public :: db_count_logged_in_users public :: db_count_logged_in_users
public :: db_add_user public :: db_add_user
public :: db_login_user public :: db_login_user
public :: db_logout_user public :: db_logout_user
public :: db_move_user public :: db_move_user
public :: db_delete_user public :: db_delete_user
private :: db_error private :: db_error
private :: db_exec private :: db_exec
contains contains
integer function db_open(db, path) result(rc)
integer function db_open(db, path) result(rc)
!! Opens database. !! Opens database.
type(db_type), intent(inout) :: db type(db_type), intent(inout) :: db
character(len=*), intent(in) :: path character(len=*), intent(in) :: path
rc = sqlite3_open(path, db%ptr) rc = sqlite3_open(path, db%ptr)
call db_error(rc, 'sqlite3_open()') call db_error(rc, 'sqlite3_open()')
end function db_open end function db_open
integer function db_exec(db, query) result(rc) integer function db_exec(db, query) result(rc)
!! Executes SQLite query. !! Executes SQLite query.
type(db_type), intent(inout) :: db type(db_type), intent(inout) :: db
character(len=*), intent(in) :: query character(len=*), intent(in) :: query
character(len=:), allocatable :: err_msg character(len=:), allocatable :: err_msg
rc = sqlite3_exec(db%ptr, query, c_null_ptr, c_null_ptr, err_msg) rc = sqlite3_exec(db%ptr, query, c_null_ptr, c_null_ptr, err_msg)
call db_error(rc, 'sqlite3_exec()', err_msg) call db_error(rc, 'sqlite3_exec()', err_msg)
end function db_exec end function db_exec
integer function db_close(db) result(rc) integer function db_close(db) result(rc)
!! Closes database. !! Closes database.
type(db_type), intent(inout) :: db type(db_type), intent(inout) :: db
rc = sqlite3_close(db%ptr) rc = sqlite3_close(db%ptr)
call db_error(rc, 'sqlite3_close()') call db_error(rc, 'sqlite3_close()')
end function db_close end function db_close
integer function db_create_users(db) result(rc) integer function db_create_users(db) result(rc)
!! Creates database tables. !! Creates database tables.
type(db_type), intent(inout) :: db type(db_type), intent(inout) :: db
! Create table "users". ! Create table "users".
rc = db_exec(db, "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 if (rc /= SQLITE_OK) return
end function db_create_users end function db_create_users
integer function db_add_user(db, username, password, apperance_r, apperance_g, apperance_b, & integer function db_add_user(db, username, password, apperance_r, apperance_g, apperance_b, &
x_pos, y_pos, logged_in, created) result(rc) x_pos, y_pos, logged_in, created) result(rc)
!! Adds student to database. !! Adds student to database.
type(db_type), intent(inout) :: db type(db_type), intent(inout) :: db
character(len=*), intent(in) :: username character(len=*), intent(in) :: username
character(len=*), intent(in) :: password character(len=*), intent(in) :: password
integer(kind=c_int), intent(in) :: apperance_r integer(kind=c_int), intent(in) :: apperance_r
integer(kind=c_int), intent(in) :: apperance_g integer(kind=c_int), intent(in) :: apperance_g
integer(kind=c_int), intent(in) :: apperance_b integer(kind=c_int), intent(in) :: apperance_b
real(kind=c_double), intent(in) :: x_pos real(kind=c_double), intent(in) :: x_pos
real(kind=c_double), intent(in) :: y_pos real(kind=c_double), intent(in) :: y_pos
integer(kind=c_int), intent(in) :: logged_in integer(kind=c_int), intent(in) :: logged_in
integer(kind=c_int), intent(in) :: created integer(kind=c_int), intent(in) :: created
type(c_ptr) :: stmt type(c_ptr) :: stmt
! Insert values through prepared statement. ! Insert values through prepared statement.
rc = sqlite3_prepare_v2(db%ptr, "INSERT INTO users(username, password, " & rc = sqlite3_prepare_v2(db%ptr, "INSERT INTO users(username, password, " &
//"apperance_r, apperance_g, apperance_b, x_pos, y_pos, logged_in, created) VALUES (?,?,?,?,?,?,?,?,?)", stmt) //"apperance_r, apperance_g, apperance_b, x_pos, y_pos, logged_in, created) VALUES (?,?,?,?,?,?,?,?,?)", stmt)
call db_error(rc, 'sqlite3_prepare_v2()') call db_error(rc, 'sqlite3_prepare_v2()')
rc = sqlite3_bind_text(stmt, 1, username) rc = sqlite3_bind_text(stmt, 1, username)
call db_error(rc, 'sqlite3_bind_text()') call db_error(rc, 'sqlite3_bind_text()')
rc = sqlite3_bind_text(stmt, 2, password) rc = sqlite3_bind_text(stmt, 2, password)
call db_error(rc, 'sqlite3_bind_text()') call db_error(rc, 'sqlite3_bind_text()')
rc = sqlite3_bind_int(stmt, 3, apperance_r) rc = sqlite3_bind_int(stmt, 3, apperance_r)
call db_error(rc, 'sqlite3_bind_int()') call db_error(rc, 'sqlite3_bind_int()')
rc = sqlite3_bind_int(stmt, 4, apperance_g) rc = sqlite3_bind_int(stmt, 4, apperance_g)
call db_error(rc, 'sqlite3_bind_int()') call db_error(rc, 'sqlite3_bind_int()')
rc = sqlite3_bind_int(stmt, 5, apperance_b) rc = sqlite3_bind_int(stmt, 5, apperance_b)
call db_error(rc, 'sqlite3_bind_int()') call db_error(rc, 'sqlite3_bind_int()')
rc = sqlite3_bind_double(stmt, 6, x_pos) rc = sqlite3_bind_double(stmt, 6, x_pos)
call db_error(rc, 'sqlite3_bind_double()') call db_error(rc, 'sqlite3_bind_double()')
rc = sqlite3_bind_double(stmt, 7, y_pos) rc = sqlite3_bind_double(stmt, 7, y_pos)
call db_error(rc, 'sqlite3_bind_double()') call db_error(rc, 'sqlite3_bind_double()')
rc = sqlite3_bind_int(stmt, 8, logged_in) rc = sqlite3_bind_int(stmt, 8, logged_in)
call db_error(rc, 'sqlite3_bind_int()') call db_error(rc, 'sqlite3_bind_int()')
rc = sqlite3_bind_int(stmt, 9, created) rc = sqlite3_bind_int(stmt, 9, created)
call db_error(rc, 'sqlite3_bind_int()') call db_error(rc, 'sqlite3_bind_int()')
! Insert bound value into database. ! Insert bound value into database.
rc = sqlite3_step(stmt) rc = sqlite3_step(stmt)
call db_error(rc, 'sqlite3_step()') call db_error(rc, 'sqlite3_step()')
! Clean-up prepared statement. ! Clean-up prepared statement.
rc = sqlite3_finalize(stmt) rc = sqlite3_finalize(stmt)
call db_error(rc, 'sqlite3_finalize()') call db_error(rc, 'sqlite3_finalize()')
end function db_add_user end function db_add_user
integer function db_delete_user(db, username) result(rc)
integer function db_delete_user(db, username) result(rc)
!! Adds student to database. !! Adds student to database.
type(db_type), intent(inout) :: db type(db_type), intent(inout) :: db
character(len=*), intent(in) :: username character(len=*), intent(in) :: username
type(c_ptr) :: stmt type(c_ptr) :: stmt
! Insert values through prepared statement. ! Insert values through prepared statement.
rc = sqlite3_prepare_v2(db%ptr, "DELETE FROM users WHERE users.username = ?;", stmt) rc = sqlite3_prepare_v2(db%ptr, "DELETE FROM users WHERE users.username = ?;", stmt)
call db_error(rc, 'sqlite3_prepare_v2()') call db_error(rc, 'sqlite3_prepare_v2()')
rc = sqlite3_bind_text(stmt, 1, username) rc = sqlite3_bind_text(stmt, 1, username)
call db_error(rc, 'sqlite3_bind_text()') call db_error(rc, 'sqlite3_bind_text()')
! Insert bound value into database. ! Insert bound value into database.
rc = sqlite3_step(stmt) rc = sqlite3_step(stmt)
call db_error(rc, 'sqlite3_step()') call db_error(rc, 'sqlite3_step()')
! Clean-up prepared statement. ! Clean-up prepared statement.
rc = sqlite3_finalize(stmt) rc = sqlite3_finalize(stmt)
call db_error(rc, 'sqlite3_finalize()') call db_error(rc, 'sqlite3_finalize()')
end function db_delete_user 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. !! Prints number of courses per student to standard output.
type(db_type), intent(inout) :: db type(db_type), intent(inout) :: db
integer(c_int), intent(inout) :: connection
type(c_ptr) :: stmt character(len=256) :: message
integer :: count 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) 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()') call db_error(rc, 'sqlite3_prepare_v2()')
step_loop: do step_loop: do
rc = sqlite3_step(stmt) rc = sqlite3_step(stmt)
select case (rc) select case (rc)
case (SQLITE_ROW) case (SQLITE_ROW)
count = sqlite3_column_int(stmt, 0) count = sqlite3_column_int(stmt, 0)
write(output_unit, "(i0)") count print *, 'logged in: ', count
case (SQLITE_DONE) write (message, "(i3)") count
exit step_loop 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 default case (SQLITE_DONE)
call db_error(rc, 'sqlite3_step()') exit step_loop
exit step_loop
end select
end do step_loop
rc = sqlite3_finalize(stmt) case default
call db_error(rc, 'sqlite3_finalize()') call db_error(rc, 'sqlite3_step()')
end function db_count_logged_in_users exit step_loop
end select
end do step_loop
integer function db_get_logged_in_users(db) result(rc) 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. !! Prints number of courses per student to standard output.
type(db_type), intent(inout) :: db type(db_type), intent(inout) :: db
integer(c_int), intent(inout) :: connection
type(c_ptr) :: stmt character(len=256) :: message
character(len=24) :: username type(c_ptr) :: stmt
integer :: apperance_r, apperance_g, apperance_b character(len=24) :: username
real :: x_pos, y_pos integer :: apperance_r, apperance_g, apperance_b
real(real64) :: x_pos, y_pos
rc = sqlite3_prepare_v2(db%ptr, & 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) "FROM users u WHERE u.logged_in = 1;", stmt)
call db_error(rc, 'sqlite3_prepare_v2()') call db_error(rc, 'sqlite3_prepare_v2()')
step_loop: do step_loop: do
rc = sqlite3_step(stmt) rc = sqlite3_step(stmt)
select case (rc) select case (rc)
case (SQLITE_ROW) case (SQLITE_ROW)
username = sqlite3_column_text(stmt, 0) username = sqlite3_column_text(stmt, 0)
apperance_r = sqlite3_column_int(stmt, 1) apperance_r = sqlite3_column_int(stmt, 1)
apperance_g = sqlite3_column_int(stmt, 2) apperance_g = sqlite3_column_int(stmt, 2)
apperance_b = sqlite3_column_int(stmt, 3) apperance_b = sqlite3_column_int(stmt, 3)
x_pos = sqlite3_column_double(stmt, 4) x_pos = sqlite3_column_double(stmt, 4)
y_pos = sqlite3_column_double(stmt, 5) 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
case (SQLITE_DONE) write (message, "(i3, i3, i3, f8.2, f8.2, a24)") &
exit step_loop apperance_r, apperance_g, apperance_b, x_pos, y_pos, username(:Len_Trim(username))
case default rc = msend(connection, f_c_string(message, .true.), &
call db_error(rc, 'sqlite3_step()') transfer(Len_Trim(f_c_string(message, .true.)), 0_c_size_t), -1_c_int64_t)
exit step_loop case (SQLITE_DONE)
end select exit step_loop
end do step_loop
rc = sqlite3_finalize(stmt) case default
call db_error(rc, 'sqlite3_finalize()') call db_error(rc, 'sqlite3_step()')
end function db_get_logged_in_users exit step_loop
end select
integer function db_login_user(db, username) result(rc) end do step_loop
type(db_type), intent(inout) :: db
character(len=24), intent(in) :: username
type(c_ptr) :: stmt
rc = sqlite3_prepare_v2(db%ptr, & rc = sqlite3_finalize(stmt)
"UPDATE users SET logged_in = 1 WHERE users.username = ?;", stmt) call db_error(rc, 'sqlite3_finalize()')
call db_error(rc, 'sqlite3_prepare_v2()') end function db_get_logged_in_users
rc = sqlite3_bind_text(stmt, 1, username) integer function db_login_user(db, username) result(rc)
call db_error(rc, 'sqlite3_bind_text()') type(db_type), intent(inout) :: db
character(len=24), intent(in) :: username
type(c_ptr) :: stmt
rc = sqlite3_step(stmt) rc = sqlite3_prepare_v2(db%ptr, &
call db_error(rc, 'sqlite3_step()') "UPDATE users SET logged_in = 1 WHERE users.username = ?;", stmt)
call db_error(rc, 'sqlite3_prepare_v2()')
rc = sqlite3_finalize(stmt) rc = sqlite3_bind_text(stmt, 1, username)
call db_error(rc, 'sqlite3_finalize()') call db_error(rc, 'sqlite3_bind_text()')
end function db_login_user
integer function db_logout_user(db, username) result(rc)
type(db_type), intent(inout) :: db
character(len=24), intent(in) :: username
type(c_ptr) :: stmt
rc = sqlite3_prepare_v2(db%ptr, & rc = sqlite3_step(stmt)
"UPDATE users SET logged_in = 0 WHERE users.username = ?;", stmt) call db_error(rc, 'sqlite3_step()')
call db_error(rc, 'sqlite3_prepare_v2()')
rc = sqlite3_bind_text(stmt, 1, username) rc = sqlite3_finalize(stmt)
call db_error(rc, 'sqlite3_bind_text()') call db_error(rc, 'sqlite3_finalize()')
end function db_login_user
rc = sqlite3_step(stmt) integer function db_logout_user(db, username) result(rc)
call db_error(rc, 'sqlite3_step()') type(db_type), intent(inout) :: db
character(len=24), intent(in) :: username
type(c_ptr) :: stmt
rc = sqlite3_finalize(stmt) rc = sqlite3_prepare_v2(db%ptr, &
call db_error(rc, 'sqlite3_finalize()') "UPDATE users SET logged_in = 0 WHERE users.username = ?;", stmt)
end function db_logout_user call db_error(rc, 'sqlite3_prepare_v2()')
integer function db_move_user(db, username, x_pos, y_pos) result(rc) rc = sqlite3_bind_text(stmt, 1, username)
type(db_type), intent(inout) :: db call db_error(rc, 'sqlite3_bind_text()')
character(len=24), intent(in) :: username
real(kind=c_double), intent(in) :: x_pos
real(kind=c_double), intent(in) :: y_pos
type(c_ptr) :: stmt
rc = sqlite3_prepare_v2(db%ptr, & rc = sqlite3_step(stmt)
"UPDATE users SET x_pos = ?, y_pos = ? WHERE users.username = ?;", stmt) call db_error(rc, 'sqlite3_step()')
call db_error(rc, 'sqlite3_prepare_v2()')
rc = sqlite3_bind_double(stmt, 1, x_pos) rc = sqlite3_finalize(stmt)
call db_error(rc, 'sqlite3_bind_double()') call db_error(rc, 'sqlite3_finalize()')
rc = sqlite3_bind_double(stmt, 2, y_pos) end function db_logout_user
call db_error(rc, 'sqlite3_bind_double()')
rc = sqlite3_bind_text(stmt, 3, username)
call db_error(rc, 'sqlite3_bind_text()')
rc = sqlite3_step(stmt) integer function db_move_user(db, username, x_pos, y_pos) result(rc)
call db_error(rc, 'sqlite3_step()') 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
type(c_ptr) :: stmt
rc = sqlite3_finalize(stmt) rc = sqlite3_prepare_v2(db%ptr, &
call db_error(rc, 'sqlite3_finalize()') "UPDATE users SET x_pos = ?, y_pos = ? WHERE users.username = ?;", stmt)
end function db_move_user call db_error(rc, 'sqlite3_prepare_v2()')
subroutine db_error(code, proc, err_msg) rc = sqlite3_bind_double(stmt, 1, x_pos)
call db_error(rc, 'sqlite3_bind_double()')
rc = sqlite3_bind_double(stmt, 2, y_pos)
call db_error(rc, 'sqlite3_bind_double()')
rc = sqlite3_bind_text(stmt, 3, username)
call db_error(rc, 'sqlite3_bind_text()')
rc = sqlite3_step(stmt)
call db_error(rc, 'sqlite3_step()')
rc = sqlite3_finalize(stmt)
call db_error(rc, 'sqlite3_finalize()')
end function db_move_user
subroutine db_error(code, proc, err_msg)
!! Prints error message. !! Prints error message.
integer, intent(in) :: code integer, intent(in) :: code
character(len=*), intent(in), optional :: proc character(len=*), intent(in), optional :: proc
character(len=*), intent(in), optional :: err_msg character(len=*), intent(in), optional :: err_msg
if (code == SQLITE_OK .or. code == SQLITE_DONE) return if (code == SQLITE_OK .or. code == SQLITE_DONE) return
if (present(proc) .and. present(err_msg)) then if (present(proc) .and. present(err_msg)) then
write(12, '(a, ": ", a, " (", i0, ")")') proc, err_msg, code print *, proc, err_msg, code
return return
end if end if
if (present(proc)) then if (present(proc)) then
write(12, '(a, ": ", i0)') proc, code print *, proc, code
return return
end if end if
write(12, '("unknown error: ", i0)') code print *, 'unknown error: ', code
end subroutine db_error 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 end module db

3
fortran/server/test.sh
View File

@ -1,2 +1,3 @@
#!/bin/sh #!/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