From f32d7d30c9cd38544349697e475355e8a2e2a478 Mon Sep 17 00:00:00 2001
From: Jeffrey Armstrong <jeff@approximatrix.com>
Date: Thu, 21 May 2020 12:25:14 -0400
Subject: Binary files are now actually handled in the dumb terminal version.

---
 dumb_binary.f90 | 92 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 92 insertions(+)
 create mode 100644 dumb_binary.f90

(limited to 'dumb_binary.f90')

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
-- 
cgit v1.2.3