'function and sub for parallel port data access
'Use just like their QuickBasic Counterparts
'Out port%,Value ----- or X% = Inp(Port%)

Declare Function Inp Lib "InpOut32.DLL" Alias "Inp32" (ByVal portAdress As Integer) As Integer
Declare Sub out Lib "InpOut32.DLL" Alias "Out32" (ByVal portAdress As Integer, ByVal Value As Integer)

Option Explicit
'COMMON USED GLOBALS AND VARIABELS
Global Const MaxIOcard% = 3
Global Const MaxIOchip% = 7
Global Const MaxIOchannel% = 64
Global Const MaxDACchannel% = 32
Global Const MaxADchannel% = 16
Global Const MaxDAchannel% = 4
Global Const StartValue% = 0

Global IOconfig%(MaxIOchip%)
Global IOdata%(MaxIOchip%)
Global IO%(MaxIOchannel%)
Global DAC%(MaxDACchannel%)
Global AD%(MaxADchannel%)
Global DA%(MaxDAchannel%)

Global ADDAchipCode%(MaxIOcard%)
Global DACchipCode%(MaxIOcard%)
Global IOChipCode%(MaxIOchip%)

Global Statusport As Integer
Global Controlport As Integer
Global I2Cbusdelay As Integer

Function BINNOT% (Dec%)
    Dim Temp$, Complement$, i%
     Temp$ = DecToBin(Dec%)
     Complement$ = ""
     For i% = 1 To Len(Temp$)
	If Mid$(Temp$, i%, 1) = "1" Then
	    Complement$ = Complement$ + "0"
	Else
	    Complement$ = Complement$ + "1"
	End If
     Next
     BINNOT% = BinToDec(Complement$)
End Function

Function BinToDec% (BinNumber$)
    Dim Weight%
    Dim Dec%
    Dim i%
    Weight% = 1
    Dec% = 0                       'Reset decimal number

    If BinNumber$ <> "00000000" Then
	For i% = Len(BinNumber$) To 1 Step -1
	    If Mid$(BinNumber$, i%, 1) = "1" Then
		Dec% = Dec% + Weight%  'If bit=1 then add weigth factor
	    End If
	    Weight% = Weight% * 2  'Multiply weight factor by 2
	Next
	BinToDec% = Dec%        'Store result
    Else
	BinToDec% = 0
    End If
End Function

Sub ClearAllDA ()
    Dim ChannelNo%
    For ChannelNo% = 1 To MaxDAchannel%
	OutputDAchannel ChannelNo%, 0
    Next
End Sub

Sub ClearAllDAC ()
    Dim ChannelNo%
    For ChannelNo% = 1 To MaxDACchannel
	DAC%(ChannelNo%) = 0
    Next
    UpdateAllDAC
End Sub

Sub ClearAllIO ()
    Dim ChipNo%
    For ChipNo% = 0 To MaxIOchip%
	IOoutput ChipNo%, 0
    Next
End Sub

Sub ClearDACchannel (ChannelNo%)
    OutputDACchannel ChannelNo%, 0
End Sub

Sub ClearDACchip (ChipNo%)
    Dim Channel%, i%
    Channel% = ChipNo% * 8
    For i% = 1 To 8
	DAC%(Channel% + i%) = 0
    Next
    UpdateDACchip ChipNo%
End Sub

Sub ClearDAchannel (ChannelNo%)
    OutputDAchannel ChannelNo%, 0
End Sub

Sub ClearIOchannel (ChannelNo%)
    Dim Channel%
    Dim Datavar%, ChipNo%
    ChipNo% = (ChannelNo% - 1) \ 8
    Channel% = (ChannelNo% - 1) Mod 8
    Datavar% = IOdata%(ChipNo%) And BINNOT(SHL(1, Channel%))
    IOoutput ChipNo%, Datavar%
End Sub

Sub ClearIOchArray (ChannelNo%)
    Dim Channel%
    Dim Datavar%, ChipNo%
    ChipNo% = (ChannelNo% - 1) \ 8
    Channel% = (ChannelNo% - 1) Mod 8
    Datavar% = IOdata%(ChipNo%) And BINNOT(SHL(1, Channel%))
    UpdateIOdataArray ChipNo%, Datavar%
End Sub

Sub ClearIOChip (ChipNo%)
    IOoutput ChipNo%, 0
End Sub

Sub ClearIOdataArray (ChipNo%)
     Dim StartChannel%
     Dim Temp%
     Dim Datavar$
     Dim Channel%
    'Update IOdata array
    IOdata%(ChipNo) = IOdata%(ChipNo) And IOconfig%(ChipNo)

    'Update IO array
    StartChannel% = ChipNo% * 8 + 1
    Temp% = IOdata%(ChipNo%)
    Datavar$ = DecToBin(Temp%)
    For Channel% = 0 To 7
	If Mid$(Datavar$, 8 - Channel%, 1) = "1" Then
	    IO%(StartChannel% + Channel%) = 1
	Else
	    IO%(StartChannel% + Channel%) = 0
	End If
    Next
End Sub

' IO CONFIGURATION SUBROUTINES
Sub ConfigAllIOasInput ()
    Dim ChipNo%
    For ChipNo% = 0 To MaxIOchip%
	IOconfig%(ChipNo%) = 0
	ClearIOChip ChipNo%
	IOconfig%(ChipNo%) = 255
	ReadIOchip ChipNo%
    Next
End Sub

Sub ConfigAllIOasOutput ()
    Dim ChipNo%
    For ChipNo% = 0 To MaxIOchip%
	IOconfig%(ChipNo%) = 0
    Next
    ClearAllIO
End Sub

Sub ConfigIOChannelAsInput (ChannelNo%)
    Dim Channel%, ChipNo%
    ChipNo% = (ChannelNo% - 1) \ 8
    Channel% = (ChannelNo% - 1) Mod 8
    IOconfig%(ChipNo%) = IOconfig%(ChipNo%) And BINNOT(SHL(1, Channel%))
    ClearIOchannel ChannelNo%
    IOconfig%(ChipNo%) = IOconfig%(ChipNo%) Or SHL(1, Channel%)
    ReadIOchannel ChannelNo%
End Sub

Sub ConfigIOchannelAsOutput (ChannelNo%)
    Dim Channel%, ChipNo%
    ChipNo% = (ChannelNo% - 1) \ 8
    Channel% = (ChannelNo% - 1) Mod 8
    IOconfig%(ChipNo%) = IOconfig%(ChipNo%) And BINNOT(SHL(1, Channel%))
    ClearIOchannel ChannelNo%
End Sub

Sub ConfigIOchipAsInput (ChipNo%)
    IOconfig%(ChipNo%) = 0
    ClearIOChip ChipNo%
    IOconfig%(ChipNo%) = 255
    ReadIOchip ChipNo%
End Sub

Sub ConfigIOchipAsOutput (ChipNo%)
    IOconfig%(ChipNo%) = 0
    ClearIOChip ChipNo%
End Sub

Function DecTo7seg (Decnumber As Integer) As Integer
' Zet een Decimaal getal van 0..9 om in een 7-segment
' tegenwaarde voor sturing van een 7 segment display
' via I2C-bus
    
    Dim Temp As Integer
    Select Case Decnumber
	Case 0
	    Temp = 63
	Case 1
	    Temp = 6
	Case 2
	    Temp = 91
	Case 3
	    Temp = 79
	Case 4
	    Temp = 102
	Case 5
	    Temp = 109
	Case 6
	    Temp = 125
	Case 7
	    Temp = 7
	Case 8
	    Temp = 127
	Case 9
	    Temp = 111
   End Select
DecTo7seg = Temp
End Function

' RADIX CONVERSION SUBROUTINES
Function DecToBin$ (Decnumber%)
    'Conversion of decimal number (0...255) to 8 bit binary string.
    '--------------------------------------------------------------
    Dim Bin$
    Dim Faktor%, i%

    Bin$ = ""
    Faktor% = 128

    If Decnumber% <> 0 Then
	For i% = 1 To 8
	    If Faktor% > Decnumber% Then
		Bin$ = Bin$ + "0"
	    Else
		Bin$ = Bin$ + "1"
		Decnumber% = Decnumber% - Faktor%
	    End If
	    Faktor% = Faktor% \ 2
	Next
	DecToBin$ = Bin$
    Else
	DecToBin$ = "00000000"
    End If
End Function

Function DecToHex$ (Decnumber%)
    DecToHex = Hex$(Decnumber%)
End Function

Function HexToDec% (Hexnumber$)
    Dim StrLength%
    Dim decl%
    Dim dech%
    
    Dim StrLenght%
    StrLength% = 0
    decl% = 0
    dech% = 0
    Hexnumber$ = UCase$(Hexnumber$)
    StrLength% = Len(Hexnumber$)
    decl% = Asc(Mid$(Hexnumber$, StrLength%, 1))
    If decl% >= Asc("A") Then
	decl% = decl% - Asc("A") + 10
    Else
	decl% = decl% - Asc("0")
    End If
    If StrLength% = 2 Then
	dech% = Asc(Mid$(Hexnumber$, 1, 1))      'Convert most significant digit
	If dech% > Asc("A") Then               'Digit > 9 subtract offset A...F
	    dech% = dech% - Asc("A") + 10
	Else
	    dech% = dech% - Asc("0")
	End If
    End If
    HexToDec% = 16 * dech% + decl%
End Function

Sub I2CBusNotBusy ()
    Dim i%
    out Controlport%, 4
    For i% = 0 To I2Cbusdelay%
    Next
    
End Sub

Sub I2Cclockpulse ()
' Veroorzaak een look-alike Ack-puls op I2C-bus
    Dim i%
    out Controlport%, 12
    For i% = 0 To I2Cbusdelay%
    Next

    out Controlport%, 4
    For i% = 0 To I2Cbusdelay%
    Next

    out Controlport%, 12
    For i% = 0 To I2Cbusdelay%
    Next
End Sub

Sub I2CInit ()
    SelectI2CprinterPort 1
    I2Cbusdelay% = 1
    I2CBusNotBusy
    ConfigAllIOasInput
	ClearAllDAC
	ClearAllDA
	ReadAll
End Sub

Function I2CInput% ()
    Dim Serdata%
    Dim j%, i%
    Dim Inputdata%
    Serdata% = 0
    For j% = 1 To 8
	Serdata% = SHL(Serdata%, 1)
	out Controlport, 4
	For i% = 0 To I2Cbusdelay%
	Next

	Inputdata% = Inp(Statusport%) And 16
	If Inputdata% <> 0 Then
	    Serdata% = Serdata% Or 1
	End If

	out Controlport%, 12
	For i% = 0 To I2Cbusdelay%
	Next
    Next
    I2CInput% = Serdata%
End Function

Sub I2Cmasterclockpulse ()
    Dim i%
    out Controlport%, 14
    For i% = 0 To I2Cbusdelay%
    Next

    out Controlport%, 6
    For i% = 0 To I2Cbusdelay%
    Next

    out Controlport%, 14
    For i% = 0 To I2Cbusdelay%
    Next

    out Controlport%, 12
    For i% = 0 To I2Cbusdelay%
    Next
End Sub

Sub I2COutput (Serdata%)
    Dim Temp%
    Dim Serdat$
    Dim j%
    Dim DataOut%
    Dim i%
    Temp% = Serdata%
    Serdat$ = DecToBin(Temp%)

    For j% = 1 To 8

	If Mid$(Serdat$, j%, 1) = "1" Then
	    DataOut% = 12
	Else
	    DataOut% = 14
	End If
	out Controlport%, DataOut%
	For i% = 0 To I2Cbusdelay%
	Next

	DataOut% = Inp(Controlport%) And 7
	out Controlport%, DataOut%
	For i% = 0 To I2Cbusdelay%
	Next

	DataOut% = Inp(Controlport%) Or 8
	out Controlport%, DataOut%
	For i% = 0 To I2Cbusdelay%
	Next
    Next
End Sub

Sub I2Cstart ()
    Dim i%
    out Controlport%, 6
    For i% = 0 To I2Cbusdelay%
    Next

    out Controlport%, 14
    For i% = 0 To I2Cbusdelay%
    Next
End Sub

Sub I2CStop ()
    Dim i%
    out Controlport%, 14
    For i% = 0 To I2Cbusdelay%
    Next

    out Controlport%, 6
    For i% = 0 To I2Cbusdelay%
    Next

    out Controlport%, 4
    For i% = 0 To I2Cbusdelay%
    Next
End Sub

Sub init ()
' Initialiseerd de I2C Bus
    Dim i%
    out Controlport%, 4
    For i% = 0 To I2Cbusdelay%
    Next

End Sub

' OUTPUT SUBROUTINES
Sub IOoutput (ChipNo%, Datavar%)
    Dim Temp%
    Dim StartChannel%, Channel%
    Dim Datvar$
    Temp% = Datavar%
    Datavar% = BINNOT(Temp%) Or IOconfig%(ChipNo%)

    I2Cstart

    Temp% = IOChipCode%(ChipNo%)
    I2COutput Temp%

    I2Cclockpulse

    Temp% = Datavar%
    I2COutput Temp%

    I2Cclockpulse

    I2CStop

    IOdata%(ChipNo%) = (IOdata%(ChipNo%) And IOconfig%(ChipNo%)) Or BINNOT(Datavar%)


    StartChannel% = ChipNo% * 8 + 1
    Temp% = IOdata%(ChipNo%)
    Datvar$ = DecToBin(Temp%)
    For Channel% = 0 To 7
	If Mid$(Datvar$, 8 - Channel%, 1) = "1" Then
	    IO%(StartChannel% + Channel%) = 1
	Else
	    IO%(StartChannel% + Channel%) = 0
	End If
    Next
End Sub

Sub main ()
    Dim CardNo%
    Dim ChipNo%
    For CardNo% = 0 To MaxIOcard%
	DACchipCode%(CardNo%) = 64 + 2 * CardNo%
	ADDAchipCode%(CardNo%) = 144 + 2 * CardNo%
    Next

    For ChipNo% = 0 To MaxIOchip%
	IOChipCode%(ChipNo%) = 112 + 2 * ChipNo%
    Next

 I2CInit

End Sub

' 6 BIT DAC CONVERTER SUBROUTINES
Sub OutputDACchannel (ChannelNo%, Datavar%)
    Dim Serdata%
    If Datavar% > 63 Then
	 Datavar% = 63
      End If
    DAC%(ChannelNo%) = Datavar%

    I2Cstart

    Serdata% = DACchipCode%((ChannelNo% - 1) \ 8)
    I2COutput Serdata%

    I2Cclockpulse

    Serdata% = 240 Or ((ChannelNo% - 1) Mod 8)
    I2COutput Serdata%

    I2Cclockpulse

    I2COutput Datavar%

    I2Cclockpulse

    I2CStop
End Sub

' 8 BIT DA CONVERTER SUBROUTINES
Sub OutputDAchannel (ChannelNo%, Datavar%)
    Dim Temp%
    DA%(ChannelNo%) = Datavar
    I2Cstart

    Temp% = ADDAchipCode%(ChannelNo% - 1)
    I2COutput Temp%

    I2Cclockpulse

    I2COutput 64

    I2Cclockpulse

    I2COutput Datavar%

    I2Cclockpulse

    I2CStop
End Sub

'8 BIT AD CONVERTER SUBROUTINES
Sub ReadADchannel (ChannelNo%)
    Dim ChipCode%, Serdata%
    ChipCode% = ADDAchipCode%((ChannelNo% - 1) \ 4)

    I2Cstart

    I2COutput ChipCode%

    I2Cclockpulse

    Serdata% = 64 Or ((ChannelNo% - 1) Mod 4)
    I2COutput Serdata%

    I2Cclockpulse

    I2CStop

    I2Cstart

    Serdata% = ChipCode% Or 1
    I2COutput Serdata%

    I2Cclockpulse

    AD%(ChannelNo%) = I2CInput()

    I2Cmasterclockpulse

    AD%(ChannelNo%) = I2CInput()

    I2Cclockpulse

    I2CStop
End Sub

Sub ReadADchip (ChipNo%)
    Dim Channel%, Temp%, Serdata%, k%
    Channel% = ChipNo% * 4 + 1

    I2Cstart

    Temp% = ADDAchipCode%(ChipNo%)
    I2COutput Temp%

    I2Cclockpulse

    I2COutput 68

    I2Cclockpulse

    I2CStop

    I2Cstart

    Temp% = ADDAchipCode%(ChipNo%) Or 1
    I2COutput Temp%

    I2Cclockpulse

    Serdata% = I2CInput()

    For k% = 0 To 3
	I2Cmasterclockpulse
	Serdata% = I2CInput()
	AD%(Channel% + k%) = Serdata%
    Next

    I2Cclockpulse

    I2CStop
End Sub

'GENERAL SUBROUTINES
Sub ReadAll ()
    ReadAllIO
    ReadAllAD
End Sub

Sub ReadAllAD ()
    Dim CardNo%
    Dim ard
    For CardNo% = 0 To MaxIOcard%
	ReadADchip CardNo%
    Next
End Sub

Sub ReadAllIO ()
    Dim ChipNo%
    For ChipNo% = 0 To MaxIOchip%
	ReadIOchip ChipNo%
    Next
End Sub

Sub ReadCard (CardNo%)
    Dim ChipNo%
    ChipNo% = CardNo% * 2
    ReadIOchip ChipNo%
    ReadIOchip ChipNo% + 1
    ReadADchip CardNo%
End Sub

Sub ReadIOchannel (ChannelNo%)
    Dim ChipNo%
    ChipNo% = (ChannelNo% - 1) \ 8
    ReadIOchip ChipNo%
End Sub

' INPUT SUBROUTINES
Sub ReadIOchip (ChipNo%)
    Dim Datavar%, StartChannel%, Temp%, Datvar$, Channel%
    I2Cstart

    Datavar% = IOChipCode%(ChipNo%) Or 1
    I2COutput Datavar%

    I2Cclockpulse

    IOdata%(ChipNo%) = I2CInput()
    IOdata%(ChipNo%) = BINNOT(IOdata%(ChipNo%))
    I2Cclockpulse

    I2CStop

    StartChannel% = ChipNo% * 8 + 1
    Temp% = IOdata%(ChipNo%)
    Datvar$ = DecToBin(Temp%)
    For Channel% = 0 To 7
	If Mid$(Datvar$, 8 - Channel%, 1) = "1" Then
	    IO%(StartChannel% + Channel%) = 1
	Else
	    IO%(StartChannel% + Channel%) = 0
	End If
    Next
End Sub

Sub SelectI2CprinterPort (PrinterNo%)
    Select Case PrinterNo
	Case 0
	    Statusport% = 957
	    Controlport% = 958
	Case 1
	    Statusport% = 889
	    Controlport% = 890
	Case 2
	    Statusport% = 633
	    Controlport% = 634
	End Select
End Sub

Sub SetAllDA ()
    Dim ChannelNo%
    For ChannelNo% = 1 To MaxDAchannel%
	OutputDAchannel ChannelNo%, 255
    Next
End Sub

Sub SetAllDAC ()
    Dim ChannelNo%
    For ChannelNo% = 1 To MaxDACchannel
	DAC%(ChannelNo%) = 63
    Next
    UpdateAllDAC
End Sub

Sub SetAllIO ()
    Dim ChipNo%
    For ChipNo% = 0 To MaxIOchip%
       IOoutput ChipNo%, 255
    Next
End Sub

Sub SetDACchannel (ChannelNo%)
    OutputDACchannel ChannelNo%, 63
End Sub

Sub SetDACchip (ChipNo%)
    Dim Channel%, i%
    Channel% = ChipNo% * 8
    For i% = 1 To 8
	DAC%(Channel% + i%) = 63
    Next
    UpdateDACchip ChipNo%
End Sub

Sub SetDAchannel (ChannelNo%)
    OutputDAchannel ChannelNo%, 255
End Sub

Sub SetIOchannel (ChannelNo%)
    Dim ChipNo%, Channel%, Datavar%
    ChipNo% = (ChannelNo% - 1) \ 8
    Channel% = (ChannelNo% - 1) Mod 8
    Datavar% = SHL(1, Channel%) Or IOdata%(ChipNo%)
    IOoutput ChipNo%, Datavar%
End Sub

Sub SetIOchArray (ChannelNo%)
    Dim ChipNo%, Channel%, Datavar%
    ChipNo% = (ChannelNo% - 1) \ 8
    Channel% = (ChannelNo% - 1) Mod 8
    Datavar% = IOdata%(ChipNo%) Or SHL(1, Channel%)
    UpdateIOdataArray ChipNo%, Datavar%
End Sub

Sub SetIOchip (ChipNo%)
    IOoutput ChipNo%, 255
End Sub

Sub SetIOdataArray (ChipNo%)
     Dim Temp%, StartChannel%, Datvar$, Channel%
    ' Update IOdata array
    Temp% = IOconfig%(ChipNo%)
    IOdata%(ChipNo%) = IOdata%(ChipNo%) Or (BINNOT(Temp%))

    ' Updata IO array
    StartChannel% = ChipNo% * 8 + 1
    Temp% = IOdata%(ChipNo%)
    Datvar$ = DecToBin(Temp%)
    For Channel% = 0 To 7
	If Mid$(Datvar$, 8 - Channel%, 1) = "1" Then
	    IO%(StartChannel% + Channel%) = 1
	Else
	    IO%(StartChannel% + Channel%) = 0
	End If
    Next
End Sub

Function SHL% (Dec%, Positions%)
    Dim Temp$
    Temp$ = Right$(DecToBin(Dec%) + String$(Positions%, "0"), 8)
    SHL = BinToDec(Temp$)
End Function

Sub UpdateAll ()
    UpdateAllIO
    UpdateAllDAC
    UpdateAllDA
End Sub

Sub UpdateAllDA ()
    Dim ChannelNo%, Temp%
    For ChannelNo% = 1 To MaxDAchannel%
	Temp% = DA%(ChannelNo%)
	OutputDAchannel ChannelNo%, Temp%
    Next
End Sub

Sub UpdateAllDAC ()
    Dim CardNo%
    For CardNo% = 0 To MaxIOcard%
	UpdateDACchip CardNo%
    Next
End Sub

Sub UpdateAllIO ()
    Dim ChipNo%, Temp%
    For ChipNo% = 0 To MaxIOchip%
	Temp% = IOdata%(ChipNo%)
	IOoutput ChipNo%, Temp%
    Next
End Sub

Sub UpdateCard (CardNo%)
    Dim ChipNo%
    ChipNo% = CardNo% * 2
    UpdateIOchip ChipNo%
    UpdateIOchip ChipNo% + 1
    UpdateDACchip CardNo%
    UpdateDAchannel CardNo% + 1
End Sub

Sub UpdateDACchannel (ChannelNo%)
    Dim Temp%
    Temp% = DAC%(ChannelNo%)
    OutputDACchannel ChannelNo%, Temp%
End Sub

Sub UpdateDACchip (ChipNo%)
    Dim Serdata%, Channel%, k%, Temp%
    I2Cstart

    Serdata% = DACchipCode%(ChipNo%)
    I2COutput Serdata%

    I2Cclockpulse

    I2COutput 0

    I2Cclockpulse

    Channel% = ChipNo% * 8
    For k% = 1 To 8
	If DAC%(Channel% + k%) > 63 Then
	    DAC%(Channel% + k%) = 63
	End If
	Temp% = DAC%(Channel% + k%)
	I2COutput Temp%
	I2Cclockpulse
    Next

    I2CStop
End Sub

Sub UpdateDAchannel (ChannelNo%)
    Dim Temp%
    Temp% = DA%(ChannelNo%)
    OutputDAchannel ChannelNo%, Temp%
End Sub

Sub UpdateIOchip (ChipNo%)
    Dim Temp%
    Temp% = IOdata%(ChipNo%)
    IOoutput ChipNo%, Temp%
End Sub

' UPDATE IODATA & IO ARRAY SUBROUTINES
Sub UpdateIOdataArray (ChipNo%, Datavar%)
    Dim Temp%, StartChannel%, Datvar$, Channel%
    ' Update IOdata array
    IOdata%(ChipNo%) = IOdata%(ChipNo%) And IOconfig%(ChipNo%)
    Temp% = IOconfig%(ChipNo%)
    IOdata%(ChipNo%) = IOdata%(ChipNo%) Or (Datavar% And BINNOT(Temp%))

    'Update IO array
    StartChannel% = ChipNo% * 8 + 1
    Temp% = IOdata%(ChipNo%)
    Datvar$ = DecToBin(Temp%)
    For Channel% = 0 To 7
	If Mid$(Datvar$, 8 - Channel%, 1) = "1" Then
	    IO%(StartChannel% + Channel%) = 1
	Else
	    IO%(StartChannel% + Channel%) = 0
	End If
    Next
End Sub