From 17623b0805ec074d8fb4aa026f97d8f4abfd0da1 Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Thu, 21 May 2020 13:16:56 -0400 Subject: Added binary handler for windows gui. Fixed opening and writing of binary files so it works on windows too. Removed all tabs from link lines for simpler processing. --- ag_binary.f90 | 76 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 76 insertions(+) create mode 100644 ag_binary.f90 (limited to 'ag_binary.f90') 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 +! +! 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 -- cgit v1.2.3