aboutsummaryrefslogtreecommitdiff
path: root/player
diff options
context:
space:
mode:
authorJeffrey Armstrong <jeff@approximatrix.com>2021-03-25 16:50:32 -0400
committerJeffrey Armstrong <jeff@approximatrix.com>2021-03-25 16:50:32 -0400
commit2a79043e4b33118437b3ade35a792b9e0d1323be (patch)
treeea2e50b8a624543b59ab8a0da7b3a630dd9143f0 /player
parent1545914afff13e37bfcfee1b04828942e430a819 (diff)
downloadlevitating-2a79043e4b33118437b3ade35a792b9e0d1323be.tar.gz
levitating-2a79043e4b33118437b3ade35a792b9e0d1323be.zip
Started on server components. Implemented thin, only-necessary sqlite wrapping in Fortran.
Diffstat (limited to 'player')
-rw-r--r--player/levitating-player-windows.prj8
-rw-r--r--player/levitating-player.prj8
-rw-r--r--player/utilities.F90222
3 files changed, 8 insertions, 230 deletions
diff --git a/player/levitating-player-windows.prj b/player/levitating-player-windows.prj
index 0566b8a..5b0e5e0 100644
--- a/player/levitating-player-windows.prj
+++ b/player/levitating-player-windows.prj
@@ -16,6 +16,9 @@
"filename":"..\\common\\request.f90",
"enabled":"1"
},{
+ "filename":".\\common\\utilities.F90",
+ "enabled":"1"
+ },{
"filename":"..\\common\\wsa.f90",
"enabled":"1"
}]
@@ -39,9 +42,6 @@
},{
"filename":".\\tasks.f90",
"enabled":"1"
- },{
- "filename":".\\utilities.F90",
- "enabled":"1"
}]
},
"Name":"levitating-player-windows (levitating-player.exe)",
@@ -99,4 +99,4 @@
"Link LAPACK":0
}
}
-} \ No newline at end of file
+}
diff --git a/player/levitating-player.prj b/player/levitating-player.prj
index aaed51c..bda2479 100644
--- a/player/levitating-player.prj
+++ b/player/levitating-player.prj
@@ -16,6 +16,9 @@
"filename":"..\\common\\request.f90",
"enabled":"1"
},{
+ "filename":".\\common\\utilities.F90",
+ "enabled":"1"
+ },{
"filename":"..\\common\\wsa.f90",
"enabled":"1"
}]
@@ -39,9 +42,6 @@
},{
"filename":".\\tasks.f90",
"enabled":"1"
- },{
- "filename":".\\utilities.F90",
- "enabled":"1"
}]
},
"Name":"levitating-player (target.exe)",
@@ -99,4 +99,4 @@
"Link LAPACK":0
}
}
-} \ No newline at end of file
+}
diff --git a/player/utilities.F90 b/player/utilities.F90
deleted file mode 100644
index 2e19031..0000000
--- a/player/utilities.F90
+++ /dev/null
@@ -1,222 +0,0 @@
-module utilities
-
-#ifdef WINDOWS
- character, parameter::dir_sep = '\'
-#else
- character, parameter::dir_sep = '/'
-#endif
-
-contains
-
- function is_absolute_path(path)
- implicit none
-
- logical::is_absolute_path
- character(len=*), intent(in)::path
-
- is_absolute_path = .false.
- if(path(1:1) == dir_sep) then
- is_absolute_path = .true.
- else
-#ifdef WINDOWS
- if(path(2:2) == ":") then
- is_absolute_path = .true.
- end if
-#endif
- end if
-
- end function is_absolute_path
-
- subroutine combine_paths(first, second, res)
- implicit none
-
- character(len=*), intent(in)::first, second
- character(len=*), intent(out)::res
-
- integer::i
-
- i = len_trim(first)
-
- if(first(i:i) == dir_sep) then
- res = trim(first)//trim(second)
- else
- res = trim(first)//dir_sep//trim(second)
- end if
-
- end subroutine combine_paths
-
- subroutine write_date_and_time(unit_number, values)
- implicit none
-
- integer, intent(in)::unit_number
- integer, intent(in), dimension(8)::values
-
- write(unit_number, '(I4, A1, I2, A1, I2, 1X, I2, A1, I2, A1, I2)') &
- values(1), "-", &
- values(2), "-", &
- values(3), &
- values(5), ":", &
- values(6), ":", &
- values(7)
-
- end subroutine write_date_and_time
-
- function remove_directory(absolute_dir, and_files)
- implicit none
-
- character(*), intent(in)::absolute_dir
- logical, intent(in), optional::and_files
- logical::remove_directory
-
- character(len=8)::cmd, flags
- integer::retval
-
-#ifdef WINDOWS
- flags = " "
- cmd = "rmdir"
-#else
- flags = "-r"
- cmd = "rm"
-#endif
-
- if(present(and_files)) then
- if(and_files) then
-#ifdef WINDOWS
- flags = "/S /Q"
-#else
- flags = "-rf"
-#endif
- end if
- end if
-
- call execute_command_line(trim(cmd)//" "//trim(flags)//" "//trim(absolute_dir), &
- wait=.true., exitstat=retval)
-
- remove_directory = (retval == 0)
-
- end function remove_directory
-
- function read_into_buffer(unit_number, buffer)
- implicit none
-
- integer, intent(in)::unit_number
- character, dimension(*), intent(out)::buffer
- integer::read_into_buffer
-
- integer::i, ierr
-
- ierr = 0
- i = 0
- do while(ierr == 0 .and. i < len(buffer))
- i = i + 1
- read(unit_number, iostat=ierr) buffer(i)
- end do
-
- if(ierr /= 0) then
- i = i - 1
- end if
-
- read_into_buffer = i
-
- end function read_into_buffer
-
- function generate_temporary_filename() result(fullpath)
- use iso_c_binding
- implicit none
-
- character(len=:), pointer::fullpath
- type(c_ptr)::tmp_name
- character(kind=c_char), dimension(:), pointer::cfullpath
- integer(kind=c_size_t)::clength
- integer::i
-
- interface
- function c_strlen(p) bind(c, name='strlen')
- use iso_c_binding
- type(c_ptr), value::p
- integer(kind=c_size_t)::strlen
- end function c_strlen
-
- function c_malloc(x) bind(c, name='malloc')
- use iso_c_binding
- type(c_ptr)::c_malloc
- integer(kind=c_size_t), value::x
- end function c_malloc
-
- subroutine c_free(p) bind(c, name='free')
- use iso_c_binding
- type(c_ptr), value::p
- end subroutine c_free
-
- end interface
-
-#ifdef WINDOWS
- interface
- function GetTempPath(n, b) bind(c, name='GetTempPathA')
- use iso_c_binding
- integer(kind=c_int32_t)::GetTempPath
- integer(kind=c_int32_t), value::n
- type(c_ptr), value::b
- end function GetTempPath
-
- function GetTempFileName(pn, prefix, unique, b) bind(c, name='GetTempFileNameA')
- use iso_c_binding
- integer(kind=c_int)::GetTempFileName
- integer(kind=c_int), value::unique
- type(c_ptr), value::pn, prefix, b
- end function GetTempFileName
- end interface
-
- type(c_ptr)::tmp_path
- integer::res
-
- tmp_path = c_malloc(int(1024, kind=c_size_t))
- res = GetTempPath(1023, tmp_path)
-
- tmp_name = c_malloc(int(1024, kind=c_size_t))
- res = GetTempFileName(tmp_path, c_null_ptr, 0, tmp_name)
-
- call c_free(tmp_path)
-#else
- interface
- function tmpnam(p) bind(c, name='tmpnam')
- use iso_c_binding
- type(c_ptr), value::p
- type(c_ptr)::tmpnam
- end function tmpnam
- end interface
-
- type(c_ptr)::ignored
-
- tmp_name = c_malloc(int(1024, kind=c_size_t))
-
- ignored = tmpnam(tmp_name)
-#endif
-
- ! Convert the C Ptr to a Fortran object
- clength = c_strlen(tmp_name)
- call c_f_pointer(tmp_name, cfullpath, (/ clength /))
- allocate(character(len=clength)::fullpath)
- do i = 1, clength
- fullpath(i:i) = cfullpath(i)
- end do
-
- cfullpath => null()
- call c_free(tmp_name)
-
- end function generate_temporary_filename
-
- subroutine delete_file(filename)
- implicit none
-
- character(*), intent(in)::filename
-
-#ifdef GNU
- call unlink(filename)
-#else
- ! Not implemented...
-#endif
-
- end subroutine delete_file
-
-end module utilities \ No newline at end of file