1 files changed, 76 insertions, 0 deletions
diff --git a/ag_binary.f90 b/ag_binary.f90
new file mode 100644
index 0000000..f96e212
--- /dev/null
+++ b/ag_binary.f90
@@ -0,0 +1,76 @@
+! 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 ag_binary
+use binary
+implicit none
+
+    type, extends(binary_handler) :: appgraphics_binary_handler
+    
+        contains
+        
+        procedure :: handle_binary => ag_handle_binary
+    
+    end type
+    
+contains
+
+    function ag_handle_binary(self, mimetype, url, iostatus) result(unit_number)
+    use appgraphics
+    implicit none
+    
+        class(appgraphics_binary_handler)::self
+        character(*), intent(in)::mimetype
+        character(*), intent(in)::url
+        integer, intent(out)::iostatus
+        integer::unit_number
+        
+        character(256)::filename
+        integer::i, istatus
+        
+        iostatus = binary_ignore
+        
+        if(dlgyesno(DIALOG_INFO, "Binary file encountered.  Would you like to save?")) then
+        
+            filename = ' '
+            i = index(url, '/', back=.true.)
+            if(i > 0) then
+                filename = url(i+1:len_trim(url))
+            end if
+            
+            if(dlgsavefile(filename)) then 
+                unit_number = 0
+            
+                open(newunit=unit_number, file=trim(filename), status='UNKNOWN', &
+                     access='STREAM', form='UNFORMATTED', iostat=istatus)
+                if(istatus /= 0) then
+                    iostatus = binary_error
+                else
+                    iostatus = binary_okay
+                end if
+            end if
+        
+        end if
+        
+    end function ag_handle_binary
+
+end module ag_binary