add tcp client/server
This commit is contained in:
parent
dad620f74e
commit
b0c551bd07
|
|
@ -3,6 +3,8 @@ a.out
|
|||
|
||||
*.mod
|
||||
*.log
|
||||
*.~undo-tree~
|
||||
*.*~
|
||||
|
||||
build/
|
||||
fortran/client/client
|
||||
|
|
|
|||
Binary file not shown.
|
|
@ -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)
|
||||
! call draw_cube(players(i)%position, 0.5_c_float, 0.5_c_float, 0.5_c_float, players(i)%apperance)
|
||||
!end do
|
||||
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()
|
||||
call end_drawing()
|
||||
|
||||
end do
|
||||
|
||||
!players = me%logout()
|
||||
players = me%logout()
|
||||
if (allocated(players)) then
|
||||
deallocate(players)
|
||||
end if
|
||||
|
|
|
|||
|
|
@ -16,3 +16,4 @@ library = false
|
|||
implicit-typing = false
|
||||
implicit-external = false
|
||||
source-form = "free"
|
||||
[dependencies]
|
||||
|
|
@ -1,67 +1,69 @@
|
|||
module player_mod
|
||||
use iso_fortran_env
|
||||
use iso_c_binding
|
||||
use raylib
|
||||
use mod_dill, only: ipaddr, ipaddr_remote, IPADDR_IPV4, mrecv, msend, tcp_connect, &
|
||||
suffix_attach
|
||||
implicit none
|
||||
use iso_fortran_env
|
||||
use iso_c_binding
|
||||
use raylib
|
||||
use mod_dill, only: ipaddr, ipaddr_remote, IPADDR_IPV4, mrecv, msend, tcp_connect, &
|
||||
suffix_attach
|
||||
implicit none
|
||||
|
||||
type player
|
||||
character(len=24):: username
|
||||
type(vector3) :: position
|
||||
type(color) :: apperance
|
||||
contains
|
||||
procedure, public :: login
|
||||
procedure, public :: logout
|
||||
procedure, public :: ping
|
||||
procedure, public :: move
|
||||
procedure, non_overridable, public :: sync_camera
|
||||
end type player
|
||||
type player
|
||||
character(len=24):: username
|
||||
type(vector3) :: position
|
||||
type(color) :: apperance
|
||||
contains
|
||||
procedure, public :: login
|
||||
procedure, public :: logout
|
||||
procedure, public :: ping
|
||||
procedure, public :: move
|
||||
procedure, non_overridable, public :: sync_camera
|
||||
end type player
|
||||
|
||||
contains
|
||||
|
||||
type(player) function init_player(username, position, apperance, fifo_write, fifo_read) result(this)
|
||||
character(24) :: username
|
||||
type(vector3) :: position
|
||||
type(color) :: apperance
|
||||
integer :: fifo_write
|
||||
integer :: fifo_read
|
||||
type(player) function init_player(username, position, apperance, fifo_write, fifo_read) result(this)
|
||||
character(24) :: username
|
||||
type(vector3) :: position
|
||||
type(color) :: apperance
|
||||
integer :: fifo_write
|
||||
integer :: fifo_read
|
||||
|
||||
this%username = username
|
||||
this%position = position
|
||||
this%apperance = apperance
|
||||
end function
|
||||
this%username = username
|
||||
this%position = position
|
||||
this%apperance = apperance
|
||||
end function
|
||||
|
||||
function login(this, password) result(players)
|
||||
class(player) :: this
|
||||
character(24) :: password
|
||||
type(player), dimension(:), allocatable :: players
|
||||
function login(this, password) result(players)
|
||||
class(player) :: this
|
||||
character(24) :: password
|
||||
type(player), dimension(:), allocatable :: players
|
||||
|
||||
players = send_packet(this, 1)
|
||||
end function login
|
||||
print *, password
|
||||
|
||||
function logout(this) result(players)
|
||||
class(player) :: this
|
||||
type(player), dimension(:), allocatable :: players
|
||||
players = send_packet(this, 1)
|
||||
end function login
|
||||
|
||||
players = send_packet(this, 2)
|
||||
end function logout
|
||||
function logout(this) result(players)
|
||||
class(player) :: this
|
||||
type(player), dimension(:), allocatable :: players
|
||||
|
||||
function ping(this) result(players)
|
||||
class(player) :: this
|
||||
type(player), dimension(:), allocatable :: players
|
||||
players = send_packet(this, 2)
|
||||
end function logout
|
||||
|
||||
players = send_packet(this, 0)
|
||||
end function ping
|
||||
function ping(this) result(players)
|
||||
class(player) :: this
|
||||
type(player), dimension(:), allocatable :: players
|
||||
|
||||
function move(this) result(players)
|
||||
class(player) :: this
|
||||
type(player), dimension(:), allocatable :: players
|
||||
players = send_packet(this, 0)
|
||||
end function ping
|
||||
|
||||
players = send_packet(this, 3)
|
||||
end function move
|
||||
function move(this) result(players)
|
||||
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
|
||||
type(camera3d), intent(inout) :: camera
|
||||
|
||||
|
|
@ -71,47 +73,77 @@ contains
|
|||
camera%target%x = this%position%x
|
||||
camera%target%y = this%position%y
|
||||
camera%target%z = this%position%z
|
||||
end subroutine sync_camera
|
||||
end subroutine sync_camera
|
||||
|
||||
function send_packet(this, request_type) result(players)
|
||||
class(player) :: this
|
||||
type(player), dimension(:), allocatable :: players
|
||||
integer :: request_type
|
||||
character(len=24) :: username
|
||||
integer :: apperance_r, apperance_g, apperance_b, i, count
|
||||
real(c_float) :: x_pos, y_pos
|
||||
function send_packet(this, request_type) result(players)
|
||||
class(player) :: this
|
||||
type(player), dimension(:), allocatable :: players
|
||||
integer :: request_type
|
||||
character(len=24) :: username
|
||||
integer :: apperance_r, apperance_g, apperance_b, i, count
|
||||
real(c_float) :: x_pos, y_pos
|
||||
|
||||
integer(c_int) :: rc, connection
|
||||
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
|
||||
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
|
||||
|
||||
rc = ipaddr_remote(addr, '127.0.0.1' // c_null_char, 35565_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)
|
||||
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, &
|
||||
this%username, this%position%x, this%position%y
|
||||
write (f_message, "(f8.2, f8.2, i3, a24)") &
|
||||
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)
|
||||
read (message(:message_size), '(i3)') count
|
||||
do i=0, count, 1
|
||||
message_size = mrecv(connection, message, msglen, -1_c_int64_t)
|
||||
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)
|
||||
|
||||
read(message, "(a, i3, i3, i3, f8.2, f8.2)") username, &
|
||||
apperance_r, apperance_g, apperance_b, x_pos, y_pos
|
||||
message_size = mrecv(connection, message, msglen, -1_c_int64_t)
|
||||
print *, 'recv message: ', message(:message_size)
|
||||
read (message(:message_size), '(i3)') count
|
||||
|
||||
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
|
||||
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
|
||||
|
||||
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
|
||||
|
||||
! 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
|
||||
|
|
|
|||
Binary file not shown.
|
|
@ -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)
|
||||
if (exist) then
|
||||
open (12, file="debug.log", status="old", position="append", action="write")
|
||||
else
|
||||
open (12, file="debug.log", status="new", action="write")
|
||||
end if
|
||||
integer(c_int) :: connection, rc, socket
|
||||
integer(c_size_t) :: message_size, msglen = 256
|
||||
character(c_char) :: message(256) = ''
|
||||
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
|
||||
|
||||
call getarg(1, db_path)
|
||||
|
||||
|
|
@ -26,35 +30,50 @@ program main
|
|||
stop 1
|
||||
end if
|
||||
|
||||
rc = db_open(db, db_path(:Len_Trim(db_path)))
|
||||
! do while not logged out
|
||||
server_loop: do
|
||||
rc = db_open(db, db_path(:Len_Trim(db_path)))
|
||||
|
||||
! read message from stdin
|
||||
read(input_unit, "(i3, 1x, a24, 1x, f8.2, 1x, f8.2)") command, username, x_pos, y_pos
|
||||
write(12, "(i3, 1x, a24, 1x, f8.2, 1x, f8.2)") command, username, x_pos, y_pos
|
||||
call flush(12)
|
||||
rc = ipaddr_local(addr, '127.0.0.1'//c_null_char, 5555_c_int, IPADDR_IPV4)
|
||||
call ipaddr_str(addr, address_string)
|
||||
|
||||
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_get_logged_in_users(db)
|
||||
else if (command .eq. 1) then
|
||||
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
|
||||
print *, 'Listening on socket:'
|
||||
print *, ' IP address: ', address_string
|
||||
print *, ' Port: ', ipaddr_port(addr)
|
||||
print *, ' Opened DB : ', db_path(:Len_Trim(db_path))
|
||||
|
||||
rc = db_close(db)
|
||||
close(12)
|
||||
socket = tcp_listen(addr, 0_c_int)
|
||||
|
||||
! 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
|
||||
|
|
|
|||
|
|
@ -1,299 +1,333 @@
|
|||
! db.f90
|
||||
module db
|
||||
use iso_fortran_env
|
||||
use, intrinsic :: iso_c_binding
|
||||
use :: sqlite3
|
||||
implicit none
|
||||
private
|
||||
use iso_fortran_env
|
||||
use iso_c_binding
|
||||
use mod_dill, only: ipaddr, ipaddr_remote, IPADDR_IPV4, mrecv, msend, tcp_connect, &
|
||||
suffix_attach
|
||||
use :: sqlite3
|
||||
implicit none
|
||||
private
|
||||
|
||||
integer, parameter, public :: DB_OK = SQLITE_OK
|
||||
integer, parameter, public :: DB_OK = SQLITE_OK
|
||||
|
||||
type, public :: db_type
|
||||
type(c_ptr) :: ptr = c_null_ptr
|
||||
end type db_type
|
||||
type, public :: db_type
|
||||
type(c_ptr) :: ptr = c_null_ptr
|
||||
end type db_type
|
||||
|
||||
public :: db_close
|
||||
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
|
||||
public :: db_move_user
|
||||
public :: db_delete_user
|
||||
public :: db_close
|
||||
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
|
||||
public :: db_move_user
|
||||
public :: db_delete_user
|
||||
|
||||
private :: db_error
|
||||
private :: db_exec
|
||||
private :: db_error
|
||||
private :: db_exec
|
||||
contains
|
||||
|
||||
|
||||
integer function db_open(db, path) result(rc)
|
||||
integer function db_open(db, path) result(rc)
|
||||
!! Opens database.
|
||||
type(db_type), intent(inout) :: db
|
||||
character(len=*), intent(in) :: path
|
||||
type(db_type), intent(inout) :: db
|
||||
character(len=*), intent(in) :: path
|
||||
|
||||
rc = sqlite3_open(path, db%ptr)
|
||||
call db_error(rc, 'sqlite3_open()')
|
||||
end function db_open
|
||||
rc = sqlite3_open(path, db%ptr)
|
||||
call db_error(rc, 'sqlite3_open()')
|
||||
end function db_open
|
||||
|
||||
integer function db_exec(db, query) result(rc)
|
||||
integer function db_exec(db, query) result(rc)
|
||||
!! Executes SQLite query.
|
||||
type(db_type), intent(inout) :: db
|
||||
character(len=*), intent(in) :: query
|
||||
character(len=:), allocatable :: err_msg
|
||||
type(db_type), intent(inout) :: db
|
||||
character(len=*), intent(in) :: query
|
||||
character(len=:), allocatable :: err_msg
|
||||
|
||||
rc = sqlite3_exec(db%ptr, query, c_null_ptr, c_null_ptr, err_msg)
|
||||
call db_error(rc, 'sqlite3_exec()', err_msg)
|
||||
end function db_exec
|
||||
rc = sqlite3_exec(db%ptr, query, c_null_ptr, c_null_ptr, err_msg)
|
||||
call db_error(rc, 'sqlite3_exec()', err_msg)
|
||||
end function db_exec
|
||||
|
||||
integer function db_close(db) result(rc)
|
||||
integer function db_close(db) result(rc)
|
||||
!! Closes database.
|
||||
type(db_type), intent(inout) :: db
|
||||
type(db_type), intent(inout) :: db
|
||||
|
||||
rc = sqlite3_close(db%ptr)
|
||||
call db_error(rc, 'sqlite3_close()')
|
||||
end function db_close
|
||||
rc = sqlite3_close(db%ptr)
|
||||
call db_error(rc, 'sqlite3_close()')
|
||||
end function db_close
|
||||
|
||||
integer function db_create_users(db) result(rc)
|
||||
integer function db_create_users(db) result(rc)
|
||||
!! Creates database tables.
|
||||
type(db_type), intent(inout) :: db
|
||||
type(db_type), intent(inout) :: db
|
||||
|
||||
! Create table "users".
|
||||
rc = db_exec(db, "CREATE TABLE users " &
|
||||
// "(id INTEGER PRIMARY KEY ASC, " &
|
||||
// "username TEXT, password TEXT, " &
|
||||
// "apperance_r INTEGER, apperance_g INTEGER, apperance_b INTEGER, " &
|
||||
// "x_pos REAL, y_pos REAL, logged_in INTEGER, " &
|
||||
// "created INTEGER);")
|
||||
if (rc /= SQLITE_OK) return
|
||||
end function db_create_users
|
||||
! Create table "users".
|
||||
rc = db_exec(db, "CREATE TABLE users " &
|
||||
//"(id INTEGER PRIMARY KEY ASC, " &
|
||||
//"username TEXT, password TEXT, " &
|
||||
//"apperance_r INTEGER, apperance_g INTEGER, apperance_b INTEGER, " &
|
||||
//"x_pos REAL, y_pos REAL, logged_in INTEGER, " &
|
||||
//"created INTEGER);")
|
||||
if (rc /= SQLITE_OK) return
|
||||
end function db_create_users
|
||||
|
||||
integer function db_add_user(db, username, password, apperance_r, apperance_g, apperance_b, &
|
||||
x_pos, y_pos, logged_in, created) result(rc)
|
||||
integer function db_add_user(db, username, password, apperance_r, apperance_g, apperance_b, &
|
||||
x_pos, y_pos, logged_in, created) result(rc)
|
||||
|
||||
!! Adds student to database.
|
||||
type(db_type), intent(inout) :: db
|
||||
character(len=*), intent(in) :: username
|
||||
character(len=*), intent(in) :: password
|
||||
integer(kind=c_int), intent(in) :: apperance_r
|
||||
integer(kind=c_int), intent(in) :: apperance_g
|
||||
integer(kind=c_int), intent(in) :: apperance_b
|
||||
real(kind=c_double), intent(in) :: x_pos
|
||||
real(kind=c_double), intent(in) :: y_pos
|
||||
integer(kind=c_int), intent(in) :: logged_in
|
||||
integer(kind=c_int), intent(in) :: created
|
||||
type(c_ptr) :: stmt
|
||||
type(db_type), intent(inout) :: db
|
||||
character(len=*), intent(in) :: username
|
||||
character(len=*), intent(in) :: password
|
||||
integer(kind=c_int), intent(in) :: apperance_r
|
||||
integer(kind=c_int), intent(in) :: apperance_g
|
||||
integer(kind=c_int), intent(in) :: apperance_b
|
||||
real(kind=c_double), intent(in) :: x_pos
|
||||
real(kind=c_double), intent(in) :: y_pos
|
||||
integer(kind=c_int), intent(in) :: logged_in
|
||||
integer(kind=c_int), intent(in) :: created
|
||||
type(c_ptr) :: stmt
|
||||
|
||||
! Insert values through prepared statement.
|
||||
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)
|
||||
call db_error(rc, 'sqlite3_prepare_v2()')
|
||||
! Insert values through prepared statement.
|
||||
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)
|
||||
call db_error(rc, 'sqlite3_prepare_v2()')
|
||||
|
||||
rc = sqlite3_bind_text(stmt, 1, username)
|
||||
call db_error(rc, 'sqlite3_bind_text()')
|
||||
rc = sqlite3_bind_text(stmt, 2, password)
|
||||
call db_error(rc, 'sqlite3_bind_text()')
|
||||
rc = sqlite3_bind_int(stmt, 3, apperance_r)
|
||||
call db_error(rc, 'sqlite3_bind_int()')
|
||||
rc = sqlite3_bind_int(stmt, 4, apperance_g)
|
||||
call db_error(rc, 'sqlite3_bind_int()')
|
||||
rc = sqlite3_bind_int(stmt, 5, apperance_b)
|
||||
call db_error(rc, 'sqlite3_bind_int()')
|
||||
rc = sqlite3_bind_double(stmt, 6, x_pos)
|
||||
call db_error(rc, 'sqlite3_bind_double()')
|
||||
rc = sqlite3_bind_double(stmt, 7, y_pos)
|
||||
call db_error(rc, 'sqlite3_bind_double()')
|
||||
rc = sqlite3_bind_int(stmt, 8, logged_in)
|
||||
call db_error(rc, 'sqlite3_bind_int()')
|
||||
rc = sqlite3_bind_int(stmt, 9, created)
|
||||
call db_error(rc, 'sqlite3_bind_int()')
|
||||
rc = sqlite3_bind_text(stmt, 1, username)
|
||||
call db_error(rc, 'sqlite3_bind_text()')
|
||||
rc = sqlite3_bind_text(stmt, 2, password)
|
||||
call db_error(rc, 'sqlite3_bind_text()')
|
||||
rc = sqlite3_bind_int(stmt, 3, apperance_r)
|
||||
call db_error(rc, 'sqlite3_bind_int()')
|
||||
rc = sqlite3_bind_int(stmt, 4, apperance_g)
|
||||
call db_error(rc, 'sqlite3_bind_int()')
|
||||
rc = sqlite3_bind_int(stmt, 5, apperance_b)
|
||||
call db_error(rc, 'sqlite3_bind_int()')
|
||||
rc = sqlite3_bind_double(stmt, 6, x_pos)
|
||||
call db_error(rc, 'sqlite3_bind_double()')
|
||||
rc = sqlite3_bind_double(stmt, 7, y_pos)
|
||||
call db_error(rc, 'sqlite3_bind_double()')
|
||||
rc = sqlite3_bind_int(stmt, 8, logged_in)
|
||||
call db_error(rc, 'sqlite3_bind_int()')
|
||||
rc = sqlite3_bind_int(stmt, 9, created)
|
||||
call db_error(rc, 'sqlite3_bind_int()')
|
||||
|
||||
! Insert bound value into database.
|
||||
rc = sqlite3_step(stmt)
|
||||
call db_error(rc, 'sqlite3_step()')
|
||||
! Insert bound value into database.
|
||||
rc = sqlite3_step(stmt)
|
||||
call db_error(rc, 'sqlite3_step()')
|
||||
|
||||
! Clean-up prepared statement.
|
||||
rc = sqlite3_finalize(stmt)
|
||||
call db_error(rc, 'sqlite3_finalize()')
|
||||
end function db_add_user
|
||||
! Clean-up prepared statement.
|
||||
rc = sqlite3_finalize(stmt)
|
||||
call db_error(rc, 'sqlite3_finalize()')
|
||||
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.
|
||||
type(db_type), intent(inout) :: db
|
||||
character(len=*), intent(in) :: username
|
||||
type(c_ptr) :: stmt
|
||||
type(db_type), intent(inout) :: db
|
||||
character(len=*), intent(in) :: username
|
||||
type(c_ptr) :: stmt
|
||||
|
||||
! Insert values through prepared statement.
|
||||
rc = sqlite3_prepare_v2(db%ptr, "DELETE FROM users WHERE users.username = ?;", stmt)
|
||||
call db_error(rc, 'sqlite3_prepare_v2()')
|
||||
! Insert values through prepared statement.
|
||||
rc = sqlite3_prepare_v2(db%ptr, "DELETE FROM users WHERE users.username = ?;", stmt)
|
||||
call db_error(rc, 'sqlite3_prepare_v2()')
|
||||
|
||||
rc = sqlite3_bind_text(stmt, 1, username)
|
||||
call db_error(rc, 'sqlite3_bind_text()')
|
||||
rc = sqlite3_bind_text(stmt, 1, username)
|
||||
call db_error(rc, 'sqlite3_bind_text()')
|
||||
|
||||
! Insert bound value into database.
|
||||
rc = sqlite3_step(stmt)
|
||||
call db_error(rc, 'sqlite3_step()')
|
||||
! Insert bound value into database.
|
||||
rc = sqlite3_step(stmt)
|
||||
call db_error(rc, 'sqlite3_step()')
|
||||
|
||||
! Clean-up prepared statement.
|
||||
rc = sqlite3_finalize(stmt)
|
||||
call db_error(rc, 'sqlite3_finalize()')
|
||||
end function db_delete_user
|
||||
! Clean-up prepared statement.
|
||||
rc = sqlite3_finalize(stmt)
|
||||
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
|
||||
type(db_type), intent(inout) :: db
|
||||
integer(c_int), intent(inout) :: connection
|
||||
|
||||
type(c_ptr) :: stmt
|
||||
integer :: count
|
||||
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()')
|
||||
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)
|
||||
step_loop: do
|
||||
rc = sqlite3_step(stmt)
|
||||
|
||||
select case (rc)
|
||||
case (SQLITE_ROW)
|
||||
count = sqlite3_column_int(stmt, 0)
|
||||
write(output_unit, "(i0)") count
|
||||
select case (rc)
|
||||
case (SQLITE_ROW)
|
||||
count = sqlite3_column_int(stmt, 0)
|
||||
print *, 'logged in: ', count
|
||||
|
||||
case (SQLITE_DONE)
|
||||
exit step_loop
|
||||
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 default
|
||||
call db_error(rc, 'sqlite3_step()')
|
||||
exit step_loop
|
||||
end select
|
||||
end do step_loop
|
||||
case (SQLITE_DONE)
|
||||
exit step_loop
|
||||
|
||||
rc = sqlite3_finalize(stmt)
|
||||
call db_error(rc, 'sqlite3_finalize()')
|
||||
end function db_count_logged_in_users
|
||||
case default
|
||||
call db_error(rc, 'sqlite3_step()')
|
||||
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.
|
||||
type(db_type), intent(inout) :: db
|
||||
type(db_type), intent(inout) :: db
|
||||
integer(c_int), intent(inout) :: connection
|
||||
|
||||
type(c_ptr) :: stmt
|
||||
character(len=24) :: username
|
||||
integer :: apperance_r, apperance_g, apperance_b
|
||||
real :: x_pos, y_pos
|
||||
character(len=256) :: message
|
||||
type(c_ptr) :: stmt
|
||||
character(len=24) :: username
|
||||
integer :: apperance_r, apperance_g, apperance_b
|
||||
real(real64) :: x_pos, y_pos
|
||||
|
||||
rc = sqlite3_prepare_v2(db%ptr, &
|
||||
"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()')
|
||||
rc = sqlite3_prepare_v2(db%ptr, &
|
||||
"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()')
|
||||
|
||||
step_loop: do
|
||||
rc = sqlite3_step(stmt)
|
||||
step_loop: do
|
||||
rc = sqlite3_step(stmt)
|
||||
|
||||
select case (rc)
|
||||
case (SQLITE_ROW)
|
||||
username = sqlite3_column_text(stmt, 0)
|
||||
apperance_r = sqlite3_column_int(stmt, 1)
|
||||
apperance_g = sqlite3_column_int(stmt, 2)
|
||||
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
|
||||
select case (rc)
|
||||
case (SQLITE_ROW)
|
||||
username = sqlite3_column_text(stmt, 0)
|
||||
apperance_r = sqlite3_column_int(stmt, 1)
|
||||
apperance_g = sqlite3_column_int(stmt, 2)
|
||||
apperance_b = sqlite3_column_int(stmt, 3)
|
||||
x_pos = sqlite3_column_double(stmt, 4)
|
||||
y_pos = sqlite3_column_double(stmt, 5)
|
||||
|
||||
case (SQLITE_DONE)
|
||||
exit step_loop
|
||||
write (message, "(i3, i3, i3, f8.2, f8.2, a24)") &
|
||||
apperance_r, apperance_g, apperance_b, x_pos, y_pos, username(:Len_Trim(username))
|
||||
|
||||
case default
|
||||
call db_error(rc, 'sqlite3_step()')
|
||||
exit step_loop
|
||||
end select
|
||||
end do 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 (SQLITE_DONE)
|
||||
exit step_loop
|
||||
|
||||
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
|
||||
type(c_ptr) :: stmt
|
||||
case default
|
||||
call db_error(rc, 'sqlite3_step()')
|
||||
exit step_loop
|
||||
end select
|
||||
end do step_loop
|
||||
|
||||
rc = sqlite3_prepare_v2(db%ptr, &
|
||||
"UPDATE users SET logged_in = 1 WHERE users.username = ?;", stmt)
|
||||
call db_error(rc, 'sqlite3_prepare_v2()')
|
||||
rc = sqlite3_finalize(stmt)
|
||||
call db_error(rc, 'sqlite3_finalize()')
|
||||
end function db_get_logged_in_users
|
||||
|
||||
rc = sqlite3_bind_text(stmt, 1, username)
|
||||
call db_error(rc, 'sqlite3_bind_text()')
|
||||
integer function db_login_user(db, username) result(rc)
|
||||
type(db_type), intent(inout) :: db
|
||||
character(len=24), intent(in) :: username
|
||||
type(c_ptr) :: stmt
|
||||
|
||||
rc = sqlite3_step(stmt)
|
||||
call db_error(rc, 'sqlite3_step()')
|
||||
rc = sqlite3_prepare_v2(db%ptr, &
|
||||
"UPDATE users SET logged_in = 1 WHERE users.username = ?;", stmt)
|
||||
call db_error(rc, 'sqlite3_prepare_v2()')
|
||||
|
||||
rc = sqlite3_finalize(stmt)
|
||||
call db_error(rc, 'sqlite3_finalize()')
|
||||
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_bind_text(stmt, 1, username)
|
||||
call db_error(rc, 'sqlite3_bind_text()')
|
||||
|
||||
rc = sqlite3_prepare_v2(db%ptr, &
|
||||
"UPDATE users SET logged_in = 0 WHERE users.username = ?;", stmt)
|
||||
call db_error(rc, 'sqlite3_prepare_v2()')
|
||||
rc = sqlite3_step(stmt)
|
||||
call db_error(rc, 'sqlite3_step()')
|
||||
|
||||
rc = sqlite3_bind_text(stmt, 1, username)
|
||||
call db_error(rc, 'sqlite3_bind_text()')
|
||||
rc = sqlite3_finalize(stmt)
|
||||
call db_error(rc, 'sqlite3_finalize()')
|
||||
end function db_login_user
|
||||
|
||||
rc = sqlite3_step(stmt)
|
||||
call db_error(rc, 'sqlite3_step()')
|
||||
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_finalize(stmt)
|
||||
call db_error(rc, 'sqlite3_finalize()')
|
||||
end function db_logout_user
|
||||
rc = sqlite3_prepare_v2(db%ptr, &
|
||||
"UPDATE users SET logged_in = 0 WHERE users.username = ?;", stmt)
|
||||
call db_error(rc, 'sqlite3_prepare_v2()')
|
||||
|
||||
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
|
||||
type(c_ptr) :: stmt
|
||||
rc = sqlite3_bind_text(stmt, 1, username)
|
||||
call db_error(rc, 'sqlite3_bind_text()')
|
||||
|
||||
rc = sqlite3_prepare_v2(db%ptr, &
|
||||
"UPDATE users SET x_pos = ?, y_pos = ? WHERE users.username = ?;", stmt)
|
||||
call db_error(rc, 'sqlite3_prepare_v2()')
|
||||
rc = sqlite3_step(stmt)
|
||||
call db_error(rc, 'sqlite3_step()')
|
||||
|
||||
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_finalize(stmt)
|
||||
call db_error(rc, 'sqlite3_finalize()')
|
||||
end function db_logout_user
|
||||
|
||||
rc = sqlite3_step(stmt)
|
||||
call db_error(rc, 'sqlite3_step()')
|
||||
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
|
||||
type(c_ptr) :: stmt
|
||||
|
||||
rc = sqlite3_finalize(stmt)
|
||||
call db_error(rc, 'sqlite3_finalize()')
|
||||
end function db_move_user
|
||||
rc = sqlite3_prepare_v2(db%ptr, &
|
||||
"UPDATE users SET x_pos = ?, y_pos = ? WHERE users.username = ?;", stmt)
|
||||
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.
|
||||
integer, intent(in) :: code
|
||||
character(len=*), intent(in), optional :: proc
|
||||
character(len=*), intent(in), optional :: err_msg
|
||||
integer, intent(in) :: code
|
||||
character(len=*), intent(in), optional :: proc
|
||||
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
|
||||
write(12, '(a, ": ", a, " (", i0, ")")') proc, err_msg, code
|
||||
return
|
||||
end if
|
||||
if (present(proc) .and. present(err_msg)) then
|
||||
print *, proc, err_msg, code
|
||||
return
|
||||
end if
|
||||
|
||||
if (present(proc)) then
|
||||
write(12, '(a, ": ", i0)') proc, code
|
||||
return
|
||||
end if
|
||||
if (present(proc)) then
|
||||
print *, proc, code
|
||||
return
|
||||
end if
|
||||
|
||||
write(12, '("unknown error: ", i0)') code
|
||||
end subroutine db_error
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue