module MXAPI
	implicit none

	interface
		integer*2 function Init_MatrixAPI() BIND(C,name='init_matrixapi')
		end function Init_MatrixAPI
	end interface

	interface
		integer*2 function Release_MatrixAPI() BIND(C,name='release_matrixapi')
		end function Release_MatrixAPI
	end interface

	interface
		integer*4 function GetVersionAPI() BIND(C,name='getversionapi')
		end function GetVersionAPI
	end interface

	interface
		integer*4 function GetVersionDRV_USB() BIND(C,name='getversiondrv_usb')
		end function GetVersionDRV_USB
	end interface

	interface
		integer*2 function Dongle_Count(Port) BIND(C,name='dongle_count')
		integer*2, value :: Port
		end function Dongle_Count
	end interface

	interface
		integer*2 function Dongle_MemSize(DngNr, PortNr) BIND(C,name='dongle_memsize')
		integer*2, value :: DngNr
		integer*2, value :: PortNr
		end function Dongle_MemSize
	end interface

	interface
		integer*4 function Dongle_Model(DngNr, PortNr) BIND(C,name='dongle_model')
		integer*2, value :: DngNr
		integer*2, value :: PortNr
		end function Dongle_Model
	end interface

	interface
		integer*4 function Dongle_Version(DngNr, PortNr) BIND(C,name='dongle_version')
		integer*2, value :: DngNr
		integer*2, value :: PortNr
		end function Dongle_Version
	end interface

	interface
		integer*2 function Dongle_ReadData(UserCode, fldData, Count, DngNr, PortNr) BIND(C,name='dongle_readdata')
		integer*4,   value :: UserCode
		integer*4, dimension(*) :: fldData
		integer*2, value :: Count
		integer*2, value :: DngNr
		integer*2, value :: PortNr
		end function Dongle_ReadData
	end interface

	interface
		integer*2 function Dongle_ReadDataEx(UserCode, fldData, Fpos, Count, DngNr, PortNr) BIND(C,name='dongle_readdataex')
		integer*4,   value :: UserCode
		integer*4, dimension(*) :: fldData
		integer*2, value :: Fpos
		integer*2, value :: Count
		integer*2, value :: DngNr
		integer*2, value :: PortNr
		end function Dongle_ReadDataEx
	end interface

	interface
		integer*2 function Dongle_WriteData(UserCode, fldData, Count, DngNr, PortNr) BIND(C,name='dongle_writedata')
		integer*4,   value :: UserCode
		integer*4, dimension(*) :: fldData
		integer*2, value :: Count
		integer*2, value :: DngNr
		integer*2, value :: PortNr
		end function Dongle_WriteData
	end interface

	interface
		integer*2 function Dongle_WriteDataEx(UserCode, fldData, Fpos, Count, DngNr, PortNr) BIND(C,name='dongle_writedataex')
		integer*4,   value :: UserCode
		integer*4, dimension(*) :: fldData
		integer*2, value :: Fpos
		integer*2, value :: Count
		integer*2, value :: DngNr
		integer*2, value :: PortNr
		end function Dongle_WriteDataEx
	end interface

	interface
		integer*4 function Dongle_ReadSerNr(UserCode, DngNr, PortNr) BIND(C,name='dongle_readsernr')
		integer*4, value :: UserCode
		integer*2, value :: DngNr
		integer*2, value :: PortNr
		end function Dongle_ReadSerNr
	end interface

	interface
		integer*2 function Dongle_WriteKey(UserCode, KeyData, DngNr, PortNr) BIND(C,name='dongle_writekey')
		integer*4,   value :: UserCode
		integer*4, dimension(4) :: KeyData
		integer*2, value :: DngNr
		integer*2, value :: PortNr
		end function Dongle_WriteKey
	end interface

	interface
		integer*2 function Dongle_GetKeyFlag(UserCode, DngNr, PortNr) BIND(C,name='dongle_getkeyflag')
		integer*4,   value :: UserCode
		integer*2, value :: DngNr
		integer*2, value :: PortNr
		end function Dongle_GetKeyFlag
	end interface

	interface
		integer*2 function Dongle_EncryptData(UserCode, DataBlock, DngNr, PortNr) BIND(C,name='dongle_encryptdata')
		integer*4,   value :: UserCode
		integer*4, dimension(2) :: DataBlock
		integer*2, value :: DngNr
		integer*2, value :: PortNr
		end function Dongle_EncryptData
	end interface

	interface
		integer*2 function Dongle_DecryptData(UserCode, DataBlock, DngNr, PortNr) BIND(C,name='dongle_decryptdata')
		integer*4,   value :: UserCode
		integer*4, dimension(2) :: DataBlock
		integer*2, value :: DngNr
		integer*2, value :: PortNr
		end function Dongle_DecryptData
	end interface

	interface
		integer*2 function Dongle_SetDriverFlag(UserCode, Mode, DngNr, PortNr) BIND(C,name='dongle_setdriverflag')
		integer*4, value :: UserCode
		integer*2, value :: Mode
		integer*2, value :: DngNr
		integer*2, value :: PortNr
		end function Dongle_SetDriverFlag
	end interface

	interface
		integer*2 function Dongle_GetDriverFlag(UserCode, DngNr, PortNr) BIND(C,name='dongle_getdriverflag')
		integer*4, value :: UserCode
		integer*2, value :: DngNr
		integer*2, value :: PortNr
		end function Dongle_GetDriverFlag
	end interface

	interface
		integer*2 function SetConfig_MatrixNet( nAccess, nFile ) BIND(C, name='setconfig_matrixnet')
		use iso_c_binding
		integer*2, value :: nAccess
		character(kind=c_char), dimension(*) :: nFile
		end function SetConfig_MatrixNet
	end interface

	interface
		integer*4 function GetConfig_MatrixNet( Category ) BIND(C, name='getconfig_matrixnet')
		integer*2, value :: Category
		end function GetConfig_MatrixNet
	end interface

	interface
		integer*2 function LogIn_MatrixNet(UserCode, AppSlot, DngNr) BIND(C,name='login_matrixnet')
		integer*4, value :: UserCode
		integer*2, value :: AppSlot
		integer*2, value :: DngNr
		end function LogIn_MatrixNet
	end interface

	interface
		integer*2 function LogOut_MatrixNet(UserCode, AppSlot, DngNr) BIND(C,name='logout_matrixnet')
		integer*4, value :: UserCode
		integer*2, value :: AppSlot
		integer*2, value :: DngNr
		end function LogOut_MatrixNet
	end interface

contains

integer*2 function hiWord( version)
	integer*4 :: version

	hiWord=int(rshift(version, 16))
	
end function hiword

integer*2 function loWord( version)
	integer*4 :: version

	loWord=int(and(version, X'ffffffff'))

end function loword


subroutine MxApp_Encrypt( myData_, Key_ )
	integer*4,dimension(0:1) :: myData_
	integer*4, dimension(0:3) :: Key_

	! Fortran does not support unsigned integer
	! So we use 8byte integers for calcuation
	integer*8,dimension(0:1) :: myData
	integer*8,dimension(0:3) :: Key

	integer*8 delta, sum;
	integer*8 :: three = 3
	integer*2 cnt;

	integer*8 :: mask = X'ffffffff'
	integer*2 :: i

	myData(0) = int(myData_(0))
	myData(1) = int(myData_(1))

	Key(0) = int(Key_(0))
	Key(1) = int(Key_(1))
	Key(2) = int(Key_(2))
	Key(3) = int(Key_(3))

	sum = 0;
	delta = X'9e3779b9'

	do i=1, 32

	myData(0) = myData(0)+ieor( ieor(lshift(myData(1),4), rshift(myData(1),5)) + myData(1), sum + Key( and(sum, three)))
	myData(0) = and(myData(0), mask)

	sum = sum + delta

	myData(1) = myData(1) + ieor( ieor(lshift(myData(0),4), rshift(myData(0),5)) + myData(0), sum + Key( and(rshift(sum,11),three)))
	myData(1) = and(myData(1), mask)

	! 8byte integers are converted back to 4byte integer
	myData_(0)=int(myData(0))
	myData_(1)=int(myData(1))

	end do

end subroutine MxApp_Encrypt


subroutine MxApp_Decrypt( myData_, Key_ )
	integer*4,dimension(0:1) :: myData_
	integer*4, dimension(0:3) :: Key_

	! Fortran does not support unsigned integer
	! So we use 8byte integers for calcuation
	integer*8,dimension(0:1) :: myData
	integer*8,dimension(0:3) :: Key

	integer*8 delta, sum;

	integer*8 :: three = 3
	integer*2 cnt;

	integer*8 :: mask = X'ffffffff'
	integer*2 :: i

	myData(0) = int(myData_(0))
	myData(1) = int(myData_(1))

	Key(0) = int(Key_(0))
	Key(1) = int(Key_(1))
	Key(2) = int(Key_(2))
	Key(3) = int(Key_(3))

	sum = X'C6EF3720';
	delta = X'9e3779b9'

	do i=1, 32

	myData(1) = myData(1)-ieor( ieor(lshift(myData(0),4), rshift(myData(0),5)) + myData(0), sum + Key( and(rshift(sum,11),three)))
	myData(1) = and(myData(1), mask)

	sum = sum - delta

	myData(0) = myData(0)-ieor( ieor(lshift(myData(1),4), rshift(myData(1),5)) + myData(1), sum + Key( and(sum, three)))
	  myData(0) = and(myData(0), mask)

	! 8byte integers are converted back to 4byte integer
	myData_(0)=int(myData(0))
	myData_(1)=int(myData(1))

	end do

end subroutine MxApp_Decrypt

end module MXAPI


program main
	use MXAPI
	use iso_c_binding

	implicit none

	integer*2 :: r									! return value
	integer*4 :: r32
    integer*4,parameter :: UserCode=1234
	integer*4,allocatable,dimension(:) :: fldData
	integer*2 :: count
    integer*2,parameter :: port=85
	integer*2,parameter :: dngnr=1
	integer*2 :: i

	character(1) :: ch
	integer*4,dimension(0:1) :: plainData
	integer*4,dimension(0:3) :: encKey


	r=Init_MatrixAPI()

	r32=GetVersionAPI()
	print *,"API Version -> Major Version:", hiWord(r32), "Minor Version:", loWord(r32)

	r = Dongle_Count(port)

	print *, "Dongle Count=", r

	if( r <= 0 ) then
		print *, "No Dongle Connected"
		r = Release_MatrixAPI()
		stop
	end if

	!============================================
	!  Acquire Dongle Info
	!============================================

	r32 = Dongle_Model(DngNr, Port)
	print *,"Dongle Model", r32

	r32=Dongle_Version(DngNr, Port)
	print *,"Dongle Version -> Major Version:", hiWord(r32), "Minor Version:", loWord(r32)

	r = Dongle_MemSize(DngNr, Port)
	print *, "MemSize:", r

	! Calculate the Field Count
	count = r/4

	print *, "Field Count:", count


	r32 = Dongle_ReadSerNr(UserCode, DngNr, Port)
	print *, "Dongle Serial Number:", r32

	!============================================
	!  Field Read / Write test
	!============================================

	! allocate fldData big enough to hold all the field data values
	allocate( fldData(count) )


	r = Dongle_ReadData(UserCode, fldData, Count, DngNr, Port)


	if( r>0 ) then
		do i=1, r
			print *, i, fldData(i)
		end do
	end if

	do i=1 ,r
		fldData(i) = 100+i
	end do

	! write 3 fields only
	r = Dongle_WriteData(UserCode, fldData, int(3, 2), DngNr, Port )

	print *, "Dongle_WriteData Result=", r

	deallocate( fldData )

	!============================================
	!  Encrypt / Decrypt test
	!============================================

	! Encrypt Data
	plainData(0)=123666444
	plainData(1)=42343242

	r=Dongle_EncryptData(UserCode, plainData, DngNr, Port)
	print *, plainData

	r=Dongle_DecryptData(UserCode, plainData, DngNr, Port)
	print *, plainData

	! If the dongle has the same XTEA key as the followings, 
 	! Dongle_EncryptData / MxApp_Encrypt,  Dongle_DecryptData / MxApp_Decrypt
	! must output the same results

	encKey(0) = 123456789
	encKey(1) = 234567891
	encKey(2) = 3456789
	encKey(3) = 456789012

	call MxApp_Encrypt(plainData, encKey)
	print *, plainData

	call MxApp_Decrypt(plainData, encKey)
	print *, plainData


	!============================================
	!  Remote API test
	!============================================

	! enable Remote API 
	r=SetConfig_MatrixNet(int(1,2),"c:\matrix\abc.xxxx"//c_null_char)
	print *,r

	print *, "Remote Refresh Time:", GetConfig_MatrixNet(int(1,2))

	r = LogIn_MatrixNet( UserCode, int(1,2), DngNr)
	print *, "LogIn_MatrixNet:", r

	write (*,"(a)",advance="no") "press any key and return to continue:"
	read *, ch

	r = LogOut_MatrixNet( UserCode, int(1,2), DngNr)
	print *, "LogOut_MatrixNet:", r

	!Disable Remote API
	r=SetConfig_MatrixNet(int(0,2),""//c_null_char)


	r = Release_MatrixAPI()

end program main