aboutsummaryrefslogtreecommitdiff
path: root/dumb_binary.f90
diff options
context:
space:
mode:
authorJeffrey Armstrong <jeff@approximatrix.com>2020-05-21 12:25:14 -0400
committerJeffrey Armstrong <jeff@approximatrix.com>2020-05-21 12:25:14 -0400
commitf32d7d30c9cd38544349697e475355e8a2e2a478 (patch)
tree20538809141ec6dfb6954ae7d892680d13c138fe /dumb_binary.f90
parentf46daf7de9884e32c8141ef761940f8f0a6e0249 (diff)
downloadLR-87-f32d7d30c9cd38544349697e475355e8a2e2a478.tar.gz
LR-87-f32d7d30c9cd38544349697e475355e8a2e2a478.zip
Binary files are now actually handled in the dumb terminal version.
Diffstat (limited to 'dumb_binary.f90')
-rw-r--r--dumb_binary.f9092
1 files changed, 92 insertions, 0 deletions
diff --git a/dumb_binary.f90 b/dumb_binary.f90
new file mode 100644
index 0000000..f12bb66
--- /dev/null
+++ b/dumb_binary.f90
@@ -0,0 +1,92 @@
+! Copyright (c) 2020 Jeffrey Armstrong <jeff@rainbow-100.com>
+!
+! Permission is hereby granted, free of charge, to any person obtaining a copy
+! of this software and associated documentation files (the "Software"), to deal
+! in the Software without restriction, including without limitation the rights
+! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+! copies of the Software, and to permit persons to whom the Software is
+! furnished to do so, subject to the following conditions:
+!
+! The above copyright notice and this permission notice shall be included in
+! all copies or substantial portions of the Software.
+!
+! The Software shall be used for Good, not Evil.
+!
+! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+! SOFTWARE.
+
+module dumb_binary
+use binary
+implicit none
+
+ type, extends(binary_handler) :: dumb_binary_handler
+
+ contains
+
+ procedure :: handle_binary => dumb_handle_binary
+
+ end type
+
+contains
+
+ function dumb_handle_binary(self, mimetype, url, iostatus) result(unit_number)
+
+ class(dumb_binary_handler)::self
+ character(*), intent(in)::mimetype
+ character(*), intent(in)::url
+ integer, intent(out)::iostatus
+ integer::unit_number
+
+ character::asksave
+ character(256)::filename
+ character(256)::guessed_filename
+ integer::i, istatus
+
+ iostatus = binary_ignore
+
+ write(*,'(1X, A44)', advance='no') "*** Binary file encountered, Save? (Y/N) => "
+
+ read(*, '(A1)') asksave
+
+ if(asksave == 'y' .or. asksave == 'Y') then
+
+ filename = ' '
+ i = index(url, '/', back=.true.)
+ if(i > 0) then
+
+ guessed_filename = url(i+1:len_trim(url))
+
+ else
+
+ guessed_filename = "file.bin"
+
+ end if
+
+ write(*, *) "*** Enter filename to save ["//trim(guessed_filename)//"]"
+ write(*, '(1X, A3)', advance='no') "=> "
+ read(*, '(a)', iostat=istatus) filename
+
+ if(len_trim(filename) == 0 .or. istatus /= 0) then
+ filename = guessed_filename
+ end if
+
+ unit_number = 0
+
+ open(newunit=unit_number, file=trim(filename), status='UNKNOWN', &
+ access='STREAM', form='FORMATTED', iostat=istatus)
+ if(istatus /= 0) then
+ iostatus = binary_error
+ else
+ iostatus = binary_okay
+ end if
+
+ end if
+
+ end function dumb_handle_binary
+
+end module dumb_binary