add server, incredibly annoying hex hack

fortran/client/main.f90

@@ -10,6 +10,7 @@ program main
    type(vector3) :: npc_position
    type(vector3) :: player_position
    real(c_float) :: npc_dir
+   logical :: player_updated
 
    !
    ! implement a login and logout screen
@@ -31,6 +32,10 @@ program main
 
    call set_target_fps(60_c_int)
 
+   !
+   ! do login stuff here
+   !
+
    !Main game loop
    do while (.not. window_should_close()) ! Detect window close button or ESC key
 
@@ -51,17 +56,19 @@ program main
       camera%target%y = player_position%y
       camera%target%z = player_position%z
 
-      if (npc_position%x < -10) then
-         npc_dir = 0.1_c_float
-      else if (npc_position%x > 10) then
-         npc_dir = -0.1_c_float
-      end if
-      npc_position%x = npc_position%x + npc_dir
 
-      !
+      ! if player updated
-      ! implement a user input for texting
+      ! send new player postition to server
-      ! https://www.raylib.com/examples/text/loader.html?name=text_input_box
+      ! else
-      !
+      ! send ping to server
+      ! read response
+      ! for each user in logged in
+      ! if (npc_position%x < -10) then
+      !    npc_dir = 0.1_c_float
+      ! else if (npc_position%x > 10) then
+      !    npc_dir = -0.1_c_float
+      ! end if
+      ! npc_position%x = npc_position%x + npc_dir
 
       call begin_drawing()
          call clear_background(RAYWHITE)
@@ -70,10 +77,7 @@ program main
             ! Draw floor
             call draw_grid(30_c_int, 1.0_c_float)
 
-            ! Draw user & others text over them
+            ! Draw other users
-            ! https://www.raylib.com/examples/text/loader.html?name=text_draw_3d
-
-            !Draw npc cube
             call draw_cube(npc_position, 0.5_c_float, 0.5_c_float, 0.5_c_float, GRAY)
             call draw_cube_wires(npc_position, 0.5_c_float, 0.5_c_float, 0.5_c_float, DARKGRAY)
 
@@ -85,6 +89,10 @@ program main
 
    end do
 
+   !
+   ! send logout call to server
+   !
+
    call close_window() !Close window and OpenGL context
 
 contains

fortran/server/README.md

@@ -0,0 +1,24 @@
+# server
+
+- request
+
+  - int :: request_type
+    - ping
+    - login
+    - logout
+    - move
+  - str(24) :: username
+  - int :: timestamp
+  - str(?) :: data
+  - int :: data_length
+  - double :: x_pos
+  - double :: y_pos
+
+- response
+  - int :: response_type
+    - int :: number_of_records
+    - array :: records
+      - str(24) :: username
+      - str(24) :: color
+      - double :: x_pos
+      - double :: y_pos

fortran/server/app/main.f90

@@ -0,0 +1,37 @@
+program main
+   use, intrinsic :: iso_c_binding
+   use iso_fortran_env
+   use :: sqlite3
+   use db
+   implicit none
+
+
+   character, dimension(:), allocatable  :: form_data
+   character(len=128):: db_path
+   integer :: err, i, length
+   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
+
+  ! do while not logged out
+
+    ! read message from stdin
+
+    ! if ping then get all logged in users and return their positions to client
+
+    ! if move update new pos to database
+
+    ! if logout update logged_in to database
+
+  ! end do
+
+  ! send logout all to clients
+
+contains
+
+end program main

fortran/server/fpm.toml

@@ -0,0 +1,19 @@
+name = "fortran-mmo-server"
+version = "0.1.0"
+license = "MIT"
+author = "zongor"
+maintainer = "admin@alfrescocavern.com"
+copyright = "Copyright 2023, zongor"
+[build]
+auto-executables = true
+auto-tests = true
+auto-examples = true
+module-naming = false
+[install]
+library = false
+[fortran]
+implicit-typing = false
+implicit-external = false
+source-form = "free"
+[dependencies]
+fortran-sqlite3 = { git = "https://github.com/interkosmos/fortran-sqlite3.git" }

fortran/server/src/db.f90

@@ -0,0 +1,196 @@
+! db.f90
+module db
+    !! Database abstraction layer.
+    use, intrinsic :: iso_c_binding
+    use :: sqlite3
+    implicit none
+    private
+
+    integer, parameter, public :: DB_OK = SQLITE_OK
+
+    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_add_user
+    public :: db_delete_user
+
+    private :: db_error
+    private :: db_exec
+contains
+
+
+    integer function db_open(db, path) result(rc)
+        !! Opens database.
+        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
+
+    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
+
+        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)
+        !! Closes database.
+        type(db_type), intent(inout) :: db
+
+        rc = sqlite3_close(db%ptr)
+        call db_error(rc, 'sqlite3_close()')
+    end function db_close
+
+    integer function db_create_users(db) result(rc)
+        !! Creates database tables.
+        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
+
+    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
+
+        ! 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()')
+
+        ! 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
+
+
+    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
+
+        ! 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()')
+
+        ! 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
+
+    integer function db_get_logged_in_users(db) result(rc)
+        !! Prints number of courses per student to standard output.
+        type(db_type), intent(inout) :: db
+
+        type(c_ptr)      :: stmt
+        character(len=24) :: username
+        real(kind=c_double) :: x_pos, y_pos
+
+        rc = sqlite3_prepare_v2(db%ptr, &
+                "SELECT username, 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)
+
+            select case (rc)
+                case (SQLITE_ROW)
+                    username  = sqlite3_column_text(stmt, 0)
+                    x_pos  =    sqlite3_column_double(stmt, 1)
+                    y_pos  =    sqlite3_column_double(stmt, 1)
+                    write(12, *) username, x_pos, y_pos
+
+                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_get_logged_in_users
+    
+    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
+
+        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)) then
+            write(12, '(a, ": ", i0)') proc, code
+            return
+        end if
+
+        write(12, '("unknown error: ", i0)') code
+    end subroutine db_error
+end module db

fortran/server/test.sh

@@ -0,0 +1,2 @@
+#!/bin/sh
+listen1 'tcp!*!1234' ~/.local/bin/fortran-micro-httpd ../../common/html/index.html ../../common/sql/test.db3

fortran/www/README.md

@@ -164,7 +164,7 @@ The request/response headers are pretty easily replicated.
 
 Probably the best feature in the HTTP protocol is actually the `Content-Length` header, since it allows you to exactly allocate the amount of memory needed to store the body of the request.
 
-There isnt a whole lot left to implement. Just getting the path to the html file and the database file from the args. 
+There isnt a whole lot left to implement. Just getting the path to the html file and the database file from the args.
 
 We read the index.html from the file and serve it to the front end on a `GET` request.
 
@@ -172,3 +172,4 @@ On a `POST` request it will parse the body and insert the user data into the dat
 
 This is probably the longest I have had to take for the smallest amount of actual features for anything I have created yet.
 
+Also the hex to integer just doesnt work at all so I had to implement one myself....

fortran/www/app/main.f90

@@ -58,7 +58,7 @@ contains
       integer :: i, j, s_idx, e_idx, username_len, password_len
       character(len=24) :: username
       character(len=24) :: password
-      character(len=8)  :: appearance
+      integer :: appearance_r, appearance_g, appearance_b
       real(kind=c_double) :: x_pos = 0.0_c_double
       real(kind=c_double) :: y_pos = 0.0_c_double
       logical :: start = .false.
@@ -108,16 +108,39 @@ contains
 
       get_appearance: do i = e_idx + 2, length
          if (request(i) .eq. '=') then
-            s_idx = i + 1
+            s_idx = i + 4            
          end if
       end do get_appearance
-      appearance = transfer(request(s_idx:length), appearance)
+
+      appearance_r = hex2int(request(s_idx), request(s_idx+1))
+      appearance_g = hex2int(request(s_idx+2), request(s_idx+3))
+      appearance_b = hex2int(request(s_idx+4), request(s_idx+5))
 
       rc = db_open(db, db_path(:Len_Trim(db_path)))
       rc = db_add_user(db, username(:username_len), password(:password_len), &
-         appearance(:Len_Trim(appearance)), x_pos, y_pos, 0, time())
+         appearance_r, appearance_g, appearance_b, x_pos, y_pos, 0, time())
       rc = db_close(db)
 
    end subroutine add_user
 
+   integer function hex2int(h1, h2) result(val)
+        character, intent(in) :: h1
+        character, intent(in) :: h2
+        integer :: a, b
+
+        if (ichar(h1) .le. ichar('9')) then 
+         a = ichar(h1) - ichar('0')
+        else
+         a = iand(ichar(h1), 7) + 9
+        end if
+
+        if (ichar(h2) .le. ichar('9')) then 
+         b = ichar(h2) - ichar('0')
+        else
+         b = iand(ichar(h2), 7) + 9
+        end if
+
+        val = shiftl(a, 4) + b
+   end function hex2int
+
 end program main

fortran/www/fpm.toml

@@ -1,6 +1,6 @@
 author = "zongor"
 copyright = "Copyright 2023, zongor"
-license = "license"
+license = "MIT"
 maintainer = "admin@alfrescocavern.com"
 name = "fortran-micro-httpd"
 version = "0.1.0"

fortran/www/src/db.f90

@@ -59,18 +59,22 @@ contains
         rc = db_exec(db, "CREATE TABLE users " &
         // "(id INTEGER PRIMARY KEY ASC, " &
         // "username TEXT, password TEXT, " &
-        // "apperance TEXT, x_pos REAL, " &
+        // "apperance_r INTEGER, apperance_g INTEGER, apperance_b INTEGER, " &
-        // "y_pos REAL, logged_in 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, 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
-        character(len=*), intent(in)    :: apperance
+        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
@@ -79,22 +83,26 @@ contains
 
         ! Insert values through prepared statement.
         rc = sqlite3_prepare_v2(db%ptr, "INSERT INTO users(username, password, " &
-        //"apperance, 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()')
 
         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_text(stmt, 3, apperance)
+        rc = sqlite3_bind_int(stmt, 3, apperance_r)
-        call db_error(rc, 'sqlite3_bind_text()')
-        rc = sqlite3_bind_double(stmt, 4, x_pos)
-        call db_error(rc, 'sqlite3_bind_double()')
-        rc = sqlite3_bind_double(stmt, 5, y_pos)
-        call db_error(rc, 'sqlite3_bind_double()')
-        rc = sqlite3_bind_int(stmt, 6, logged_in)
         call db_error(rc, 'sqlite3_bind_int()')
-        rc = sqlite3_bind_int(stmt, 7, created)
+        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.