Commits

Barry Schwartz committed 216b5ae

opentype_longdatetime Fortran module.

Comments (0)

Files changed (3)

fortran/font/Makefile.am

      fi
 
 lib_LTLIBRARIES = libib-not-yet-named.la
-libib_not_yet_named_la_SOURCES = opentype_bytes.F90					\
-	  opentype_data_types.F90 opentype_fixed.F90 opentype_longs.F90	\
-	  opentype_shorts.F90 opentype_tags.F90 opentype_uint24.F90
+libib_not_yet_named_la_SOURCES = opentype_bytes.F90						\
+     opentype_data_types.F90 opentype_fixed.F90							\
+     opentype_longdatetime.F90 opentype_longs.F90 opentype_shorts.F90	\
+     opentype_tags.F90 opentype_uint24.F90
 
 pkgconfigdir = "${libdir}/pkgconfig"
 nodist_pkgconfig_DATA = package-not-yet-named.pc
 
 if HAVE_MODFILES
 
-MODFILES = opentype_bytes opentype_data_types opentype_fixed		\
-	  opentype_longs opentype_shorts opentype_tags opentype_uint24
+MODFILES = opentype_bytes opentype_data_types opentype_fixed	\
+    opentype_longdatetime opentype_longs opentype_shorts		\
+    opentype_tags opentype_uint24
 
 pkginclude_HEADERS = $(foreach f, $(MODFILES), $(call modfile,${f}))
 
 	@$(force_rebuild)
 $(call modfile,opentype_fixed): opentype_fixed.lo
 	@$(force_rebuild)
+$(call modfile,opentype_longdatetime): opentype_longdatetime.lo
+	@$(force_rebuild)
 $(call modfile,opentype_longs): opentype_longs.lo
 	@$(force_rebuild)
 $(call modfile,opentype_shorts): opentype_shorts.lo
 $(call modfile,opentype_uint24): opentype_uint24.lo
 	@$(force_rebuild)
 
-opentype_data_types.lo $(call modfile,opentype_data_types): $(call		\
-	  modfile,opentype_bytes) $(call modfile,opentype_fixed) $(call		\
-	  modfile,opentype_longs) $(call modfile,opentype_shorts) $(call	\
-	  modfile,opentype_tags) $(call modfile,opentype_uint24)
+opentype_data_types.lo $(call modfile,opentype_data_types): $(call	\
+    modfile,opentype_bytes) $(call modfile,opentype_fixed) $(call	\
+    modfile,opentype_longdatetime) $(call modfile,opentype_longs)	\
+    $(call modfile,opentype_shorts) $(call modfile,opentype_tags)	\
+    $(call modfile,opentype_uint24)
 
 else
 

fortran/font/configure.ac

 
 # Checks for libraries.
 
+dnl dnl --- FIXME: Provide an alternative to TIME8() for non-GNU compilers.
+dnl dnl
+dnl dnl AC_MSG_CHECKING([for TIME8 Fortran intrinsic (GNU extension)])
+dnl AC_ARG_VAR([FC_TIME8],[the TIME8 Fortran function (a GNU extension; default is to use the intrinsic if present)])
+dnl AC_CACHE_CHECK([for TIME8 Fortran intrinsic (GNU extension)],
+dnl mypackage_cv_fc_time8_intrinsic,
+dnl [if test x"${FC_TIME8}" != x; then
+dnl     mypackage_cv_fc_time8_intrinsic="${FC_TIME8}"
+dnl else
+dnl   AC_LANG_PUSH(Fortran)
+dnl   i=0
+dnl   while test \( -f tmpdir_$i \) -o \( -d tmpdir_$i \) ; do
+dnl     i=`expr $i + 1`
+dnl   done
+dnl   mkdir tmpdir_$i
+dnl   cd tmpdir_$i
+dnl   AC_RUN_IFELSE([
+dnl   !234567
+dnl         program conftest_program
+dnl         intrinsic time8
+dnl         open(10, file='bitbucket.dat', action='readwrite')
+dnl         write(10,'(i50)') time8()
+dnl         close(10)
+dnl         end program conftest_program
+dnl     ],
+dnl     [
+dnl         mypackage_cv_fc_time8_intrinsic=time8
+dnl     ],
+dnl     [
+dnl         AC_MSG_ERROR([cannot build without TIME8])
+dnl     ])
+dnl   cd ..
+dnl   rm -fr tmpdir_$i
+dnl   AC_LANG_POP(Fortran)
+dnl fi
+dnl ])
+dnl FC_TIME8="${mypackage_cv_fc_time8_intrinsic}"
+
 
 # Checks for header files.
 

fortran/font/opentype_longdatetime.F90

+! Copyright (C) 2012 by Barry Schwartz
+!
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+!
+! Redistributions of source code must retain the above copyright notice, this
+! list of conditions and the following disclaimer.
+!
+! Redistributions in binary form must reproduce the above copyright notice,
+! this list of conditions and the following disclaimer in the documentation
+! and/or other materials provided with the distribution.
+
+! The name of the author may not be used to endorse or promote products
+! derived from this software without specific prior written permission.
+
+! THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
+! WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
+! EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+!--------------------------------------------------------------------------
+
+! OpenType LONGDATETIME data type. See
+! http://www.microsoft.com/typography/otspec/otff.htm
+
+!--------------------------------------------------------------------------
+
+module opentype_longdatetime
+  use iso_fortran_env
+  implicit none
+
+  ! 1 January 1904 00:00:00 UT, to within leap seconds, expressed in
+  ! seconds relative to the Unix epoch.
+  integer(int64), parameter :: ot_epoch = -2082844800_int64
+
+  type :: ot_longdatetime
+     integer(int8), dimension(8) :: val
+  end type ot_longdatetime
+
+  interface ot_longdatetime
+     module procedure ot_longdatetime_of_int
+  end interface ot_longdatetime
+
+  interface int
+     module procedure int_of_ot_longdatetime
+  end interface int
+
+contains
+
+  elemental function ot_longdatetime_of_int(i_time) result(b)
+    integer(int64), intent(in) :: i_time
+    type(ot_longdatetime) :: b
+
+    integer(int64) :: i
+
+    ! Convert from Unix time to OpenType time.
+    i = i_time - ot_epoch
+
+    b%val = [int(iand(shiftr(i,56),255_int64), kind=int8), &
+         int(iand(shiftr(i,48),255_int64), kind=int8), &
+         int(iand(shiftr(i,40),255_int64), kind=int8), &
+         int(iand(shiftr(i,32),255_int64), kind=int8), &
+         int(iand(shiftr(i,24),255_int64), kind=int8), &
+         int(iand(shiftr(i,16),255_int64), kind=int8), &
+         int(iand(shiftr(i,8),255_int64), kind=int8), &
+         int(iand(i,255_int64), kind=int8)]
+  end function ot_longdatetime_of_int
+
+  elemental function int_of_ot_longdatetime(b) result(i_time)
+    integer(int64) :: i_time
+    type(ot_longdatetime), intent(in) :: b
+
+    integer(int64) :: i
+
+    i = ior(shiftl(int(b%val(1), kind=int64), 56), &
+         ior(shiftl(iand(int(b%val(2), kind=int64), 255_int64), 48), &
+         ior(shiftl(iand(int(b%val(3), kind=int64), 255_int64), 40), &
+         ior(shiftl(iand(int(b%val(4), kind=int64), 255_int64), 32), &
+         ior(shiftl(iand(int(b%val(5), kind=int64), 255_int64), 24), &
+         ior(shiftl(iand(int(b%val(6), kind=int64), 255_int64), 16), &
+         ior(shiftl(iand(int(b%val(7), kind=int64), 255_int64), 8), &
+         iand(int(b%val(8), kind=int64), 255_int64))))))))
+
+    ! Convert from OpenType time to Unix time.
+    i_time = i + ot_epoch
+
+  end function int_of_ot_longdatetime
+
+end module opentype_longdatetime
+
+!--------------------------------------------------------------------------
+
+#ifdef TEST_OPENTYPE_LONGDATETIME
+
+program test_opentype_longdatetime
+  use opentype_longdatetime
+
+  integer :: unit
+  type(ot_longdatetime) :: c
+
+  open(newunit=unit, file='a.out.COPY', action='readwrite', status='unknown', access='stream')
+
+  write(unit, pos=10) ot_longdatetime(9223372036854775807_int64)
+  read(unit, pos=10) c
+  print *, 9223372036854775807_int64, ' => ', int(c)
+
+  write(unit, pos=10) ot_longdatetime([0,0,0,0,0,0,0,0])
+  read(unit, pos=10) c
+  print *, [0,0,0,0,0,0,0,0], ' => ', int(c)
+
+  close(unit)
+
+end program test_opentype_longdatetime
+
+#endif
+
+!--------------------------------------------------------------------------