add server, incredibly annoying hex hack
This commit is contained in:
		
							parent
							
								
									cb77591be1
								
							
						
					
					
						commit
						79859bbec7
					
				
										
											Binary file not shown.
										
									
								
							| 
						 | 
					@ -10,6 +10,7 @@ program main
 | 
				
			||||||
   type(vector3) :: npc_position
 | 
					   type(vector3) :: npc_position
 | 
				
			||||||
   type(vector3) :: player_position
 | 
					   type(vector3) :: player_position
 | 
				
			||||||
   real(c_float) :: npc_dir
 | 
					   real(c_float) :: npc_dir
 | 
				
			||||||
 | 
					   logical :: player_updated
 | 
				
			||||||
 | 
					
 | 
				
			||||||
   !
 | 
					   !
 | 
				
			||||||
   ! implement a login and logout screen
 | 
					   ! implement a login and logout screen
 | 
				
			||||||
| 
						 | 
					@ -31,6 +32,10 @@ program main
 | 
				
			||||||
 | 
					
 | 
				
			||||||
   call set_target_fps(60_c_int)
 | 
					   call set_target_fps(60_c_int)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					   !
 | 
				
			||||||
 | 
					   ! do login stuff here
 | 
				
			||||||
 | 
					   !
 | 
				
			||||||
 | 
					
 | 
				
			||||||
   !Main game loop
 | 
					   !Main game loop
 | 
				
			||||||
   do while (.not. window_should_close()) ! Detect window close button or ESC key
 | 
					   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%y = player_position%y
 | 
				
			||||||
      camera%target%z = player_position%z
 | 
					      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 begin_drawing()
 | 
				
			||||||
         call clear_background(RAYWHITE)
 | 
					         call clear_background(RAYWHITE)
 | 
				
			||||||
| 
						 | 
					@ -70,10 +77,7 @@ program main
 | 
				
			||||||
            ! Draw floor
 | 
					            ! Draw floor
 | 
				
			||||||
            call draw_grid(30_c_int, 1.0_c_float)
 | 
					            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(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)
 | 
					            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
 | 
					   end do
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					   !
 | 
				
			||||||
 | 
					   ! send logout call to server
 | 
				
			||||||
 | 
					   !
 | 
				
			||||||
 | 
					
 | 
				
			||||||
   call close_window() !Close window and OpenGL context
 | 
					   call close_window() !Close window and OpenGL context
 | 
				
			||||||
 | 
					
 | 
				
			||||||
contains
 | 
					contains
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -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
 | 
				
			||||||
| 
						 | 
					@ -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
 | 
				
			||||||
| 
						 | 
					@ -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" }
 | 
				
			||||||
| 
						 | 
					@ -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
 | 
				
			||||||
| 
						 | 
					@ -0,0 +1,2 @@
 | 
				
			||||||
 | 
					#!/bin/sh
 | 
				
			||||||
 | 
					listen1 'tcp!*!1234' ~/.local/bin/fortran-micro-httpd ../../common/html/index.html ../../common/sql/test.db3
 | 
				
			||||||
| 
						 | 
					@ -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.
 | 
					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....
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -58,7 +58,7 @@ contains
 | 
				
			||||||
      integer :: i, j, s_idx, e_idx, username_len, password_len
 | 
					      integer :: i, j, s_idx, e_idx, username_len, password_len
 | 
				
			||||||
      character(len=24) :: username
 | 
					      character(len=24) :: username
 | 
				
			||||||
      character(len=24) :: password
 | 
					      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) :: x_pos = 0.0_c_double
 | 
				
			||||||
      real(kind=c_double) :: y_pos = 0.0_c_double
 | 
					      real(kind=c_double) :: y_pos = 0.0_c_double
 | 
				
			||||||
      logical :: start = .false.
 | 
					      logical :: start = .false.
 | 
				
			||||||
| 
						 | 
					@ -108,16 +108,39 @@ contains
 | 
				
			||||||
 | 
					
 | 
				
			||||||
      get_appearance: do i = e_idx + 2, length
 | 
					      get_appearance: do i = e_idx + 2, length
 | 
				
			||||||
         if (request(i) .eq. '=') then
 | 
					         if (request(i) .eq. '=') then
 | 
				
			||||||
            s_idx = i + 1
 | 
					            s_idx = i + 4            
 | 
				
			||||||
         end if
 | 
					         end if
 | 
				
			||||||
      end do get_appearance
 | 
					      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_open(db, db_path(:Len_Trim(db_path)))
 | 
				
			||||||
      rc = db_add_user(db, username(:username_len), password(:password_len), &
 | 
					      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)
 | 
					      rc = db_close(db)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
   end subroutine add_user
 | 
					   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
 | 
					end program main
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -1,6 +1,6 @@
 | 
				
			||||||
author = "zongor"
 | 
					author = "zongor"
 | 
				
			||||||
copyright = "Copyright 2023, zongor"
 | 
					copyright = "Copyright 2023, zongor"
 | 
				
			||||||
license = "license"
 | 
					license = "MIT"
 | 
				
			||||||
maintainer = "admin@alfrescocavern.com"
 | 
					maintainer = "admin@alfrescocavern.com"
 | 
				
			||||||
name = "fortran-micro-httpd"
 | 
					name = "fortran-micro-httpd"
 | 
				
			||||||
version = "0.1.0"
 | 
					version = "0.1.0"
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -59,18 +59,22 @@ contains
 | 
				
			||||||
        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 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);")
 | 
					        // "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, 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.
 | 
					        !! 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
 | 
				
			||||||
        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) :: 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
 | 
				
			||||||
| 
						 | 
					@ -79,22 +83,26 @@ contains
 | 
				
			||||||
 | 
					
 | 
				
			||||||
        ! 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, 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_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()')
 | 
					        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()')
 | 
					        call db_error(rc, 'sqlite3_bind_int()')
 | 
				
			||||||
 | 
					
 | 
				
			||||||
        ! Insert bound value into database.
 | 
					        ! Insert bound value into database.
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue