unit i2cport;

interface

uses
 sysutils;

CONST
 MaxIOcard     = 3;
 MaxIOchip     = 7;
 MaxIOchannel  = 64;
 MaxDACchannel = 32;
 MaxADchannel  = 16;
 MaxDAchannel  = 4;

VAR

        printerPort : Integer;

 StatusPort    : Integer;
 ControlPort   : Integer;
 I2CbusDelay   : Integer;

 IOconfig      : ARRAY[0..MaxIOchip] OF Integer;
 IOdata        : ARRAY[0..MaxIOchip] OF Integer;
 IO            : ARRAY[1..MaxIOchannel] OF Integer;
 DAC           : ARRAY[1..MaxDACchannel] OF Integer;
 AD            : ARRAY[1..MaxADchannel] OF Integer;
 DA            : ARRAY[1..MaxDAchannel] OF Integer;
        ADDAchipCode  : ARRAY[0..MaxIOcard] OF Integer;
        DACchipCode   : ARRAY[0..MaxIOcard] OF Integer;
        IOChipCode    : ARRAY[0..MaxIOchip] OF Integer;



procedure i2cinit;
procedure SelectI2CprinterPort;
procedure i2cbusnotbusy;
procedure ConfigAllIOasInput;
procedure ClearAllIO;
procedure ReadAll;
procedure ReadAllIO;
procedure IOoutput(chipno,datavar:integer);
procedure i2cstart;
procedure i2cstop;
procedure i2coutput(serdata:integer);
procedure i2cclockpulse;
procedure ReadIOchip(chipno:integer);
function  i2cinput:integer;
procedure ConfigIOchipAsOutput(ChipNo:integer);
procedure ClearIOchip(chipno:integer);
procedure SetIOchip(chipno:integer);
procedure clearIOchannel(channelno:integer);
procedure setIOchannel(channelno:integer);
function right(str: string; len : integer):string;
function leftVB(str: string; len : integer):string;
function mid(str: string; start:integer;len:integer):string;
function DecimaltoBinary(decNum:integer):string;
function BNOT(binstr:string):string;
function DecimaltoBinaryNOT(decNum:integer):string;
function BinarytoDecimal(binstr:string):integer;
function BINNOT(decnum:integer):integer;
function VBstrings(num:integer;c:string): string;
function VBSHL(dec,positions:integer):integer;
procedure k8000getready;
procedure outPP(PortAddress:smallint;Value:smallint);
function inPP(PortAddress:smallint):smallint;

procedure testrunninglights;

{$IFDEF LINUX}
{external library calls using libprtio.so.1
get the library from
http://users.netonecom.net/~bbcat/Kylix.shtml
}
function openParPort(portN : PChar) : Integer; cdecl; external 'libprtio.so.1';
{$EXTERNALSYM openParPort}
procedurecloseParPort(prtPort : Integer); cdecl; external 'libprtio.so.1';
{$EXTERNALSYMcloseParPort}
procedure wrControlPort(prtPort : Integer; c : Byte); cdecl; external 'libprtio.so.1';
{$EXTERNALSYMwrControlPort}
functionrdStatusPort(prtPort : Integer) : Byte; cdecl; external 'libprtio.so.1';
{$EXTERNALSYMrdStatusPort}
functionrdControlPort(prtPort : Integer) : Byte; cdecl; external 'libprtio.so.1';
{$EXTERNALSYMrdControlPort}
function OpenPort : Boolean;
procedure ClosePort;
procedure writeControl(c : Byte);
function readStatus : Byte;
function readControl : Byte;
{$ENDIF}



implementation


{$IFDEFLINUX}
procedureoutPP(PortAddress:smallint;Value:smallint);
var
 ByteValue:Byte;
begin
     ByteValue:=Byte(Value);
     writeControl(Bytevalue);
end;

function inPP(PortAddress:smallint):smallint;
var
   ByteValue:byte;
begin

if PortAddress = 890 then
 Bytevalue := readControl
else
Bytevalue := readStatus;
inPP:=smallint(ByteValue) and $00FF;
end;



procedure ClosePort;
begin
 if (printerPort <> 0) and (printerPort <> -1) then closeParPort(printerPort);
end;

functionOpenPort : Boolean;
var
 i : Integer;
begin
if (printerPort <> 0) and (printerPort <> -1) then closeParPort(printerPort);
 //change the string to suit your configuration
 i := openParPort(PChar('/dev/parport0'));
 if i = -1 then Result := False
 else begin
      printerPort := i;
      Result := True;
      end;
end;

procedurewriteControl(c : Byte);
begin
 if (printerPort <> 0) and (printerPort <> -1) then
    wrControlPort(printerPort,c)
end;

functionreadStatus : Byte;
begin
 if (printerPort <> 0) and (printerPort <> -1) then
    Result := rdStatusPort(printerPort)
 else Result := 0;
end;

functionreadControl:Byte;
begin
if (printerPort <> 0) and (printerPort <> -1) then
    Result := rdControlPort(printerPort)
 else Result := 0;
end;
{$ENDIF}


{$IFDEFWIN32}
{Code copied from Jan Axelson web-site
http://www.lvr.com/jansfaq.htm}
procedure outPP(PortAddress:smallint;Value:smallint);
var
   ByteValue:Byte;
begin
     ByteValue:=Byte(Value);
     asm
        push dx
        mov dx,PortAddress
        mov al, ByteValue
        out dx,al
        pop dx
     end;
end;

function inPP(PortAddress:smallint):smallint;
var
   ByteValue:byte;
begin
   asm
        push dx
        mov dx, PortAddress
        in al,dx
        mov ByteValue,al
        pop dx
    end;
    inPP:=smallint(ByteValue) and $00FF;
end;
{$ENDIF}


{K8000 VB code ported to Pascal
 http://www.velleman.be/kits/k8000.htm
 http://www.velleman.be/company/download.asp
}

procedure k8000getready;
var
cardno : integer;
chipno : integer;

begin


for cardno := 0 to MaxIOcard do
begin
    DACchipcode[cardno] := 64 + 2*cardno;
    ADDAchipCode[CardNo] := 144 + 2 * CardNo;
end;


    For ChipNo := 0 To MaxIOchip do
    begin
        IOChipCode[ChipNo] := 112 + 2 * ChipNo;
    end;

I2CInit;



end;


procedure i2cinit;
begin

  SelectI2CprinterPort;
  I2Cbusdelay := 1;

  I2CBusNotBusy;
  ConfigAllIOasInput ;
  ReadAll;

end;


procedure SelectI2CprinterPort;
begin
    Statusport := 889;
    Controlport  := 890;
end;


procedure i2cbusnotbusy;
var
i : integer;

begin
    outPP(Controlport, 4);


    For i := 0 To I2Cbusdelay do
    begin
     // replace this with a timer maybe
    end;
end;

procedure ConfigAllIOasInput;
var
chipno : integer;
begin
    For ChipNo := 0 To MaxIOchip do
     begin
        IOconfig[ChipNo] := 0;
     end;
    ClearAllIO;
end;

procedure ClearAllIO;
var
 chipno : integer;
begin
    For ChipNo := 0 To MaxIOchip do
    begin
        IOoutput(ChipNo, 0);
    end;
end;


procedure IOoutput(chipno,datavar:integer);
var
temp,startchannel,channel: integer;
datvar : string;
begin

temp := datavar;
datavar := Binnot(temp) Or IOconfig[ChipNo]; //look into this

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 := DecimalToBinary(Temp);
for channel := 0 to 7 do
 begin
   if mid(datvar,8-channel,1) = '1' then
    IO[startchannel + channel] := 1
    else
    IO[startchannel + channel] := 0;

 end;
end;


procedure ReadAll;
begin
    ReadAllIO;
end;

procedure ReadAllIO;
var
chipno : integer;
begin
for chipno := 0 to maxIOchip do
 begin
    ReadIOchip(ChipNo);
 end;
end;


procedure ReadIOchip(chipno:integer);
var
datavar,startchannel,temp,channel:integer;
datvar:string;
begin
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 := decimaltobinary(temp);

  for channel := 0 to 7 do
 begin
   if mid(datvar,8-channel,1) = '1' then
    IO[startchannel + channel] := 1
    else
    IO[startchannel + channel] := 0;

 end;
end;


procedure i2cstart;
var
i : integer;
begin
outPP(Controlport,6);
for i := 0 to i2cbusdelay do
begin
end;
end;

procedure i2cstop;
var
i : integer;
begin
outPP(controlport,14);
for i := 0 to i2cbusdelay do
begin
end;

outPP(controlport,6);
for i := 0 to i2cbusdelay do
begin
end;

outPP(controlport,4);
for i := 0 to i2cbusdelay do
begin
end;


end;

procedure i2coutput(serdata:integer);
var
temp,j,dataout,i : integer;
serdat : string;
begin
temp := serdata;
serdat := decimaltobinary(temp);

for j := 1 to 8 do
 begin
     If Mid(Serdat, j, 1) = '1' Then
            DataOut := 12
        Else
            DataOut := 14;

     outPP(Controlport, DataOut);

     For i := 0 To I2Cbusdelay do
     begin
     end;

     dataout := inPP(Controlport) and 7;



     outPP(controlport,dataout);

     For i := 0 To I2Cbusdelay do
     begin
     end;

     dataout := inPP(Controlport) or 8;

     outPP(controlport,dataout);

     For i := 0 To I2Cbusdelay do
     begin
     end;


 end;


end;


procedure i2cclockpulse;
var
i : integer;
begin
  outPP(controlport,12);

   For i := 0 To I2Cbusdelay do
     begin
     end;

  outPP(controlport,4);

   For i := 0 To I2Cbusdelay do
     begin
     end;

     outPP(controlport,12);

   For i := 0 To I2Cbusdelay do
     begin
     end;

end;


function i2cinput:integer;
var
serdata,j,i,inputdata : integer;
begin
serdata := 0;

 for j := 1 to 8 do
 begin
   serdata := VBSHL(serdata,1);
   outPP(controlport,4);

   for i := 0 to i2cbusdelay do
   begin
   end;

   inputdata := inPP(statusport) and 16;

   if inputdata <> 0 then
    serdata := serdata or 1;

   outPP(controlport,12);
   for i := 0 to i2cbusdelay do
   begin
   end;


 end;

i2cinput := serdata;

end;

procedure ConfigIOchipAsOutput(ChipNo:integer);
begin
IOconfig[chipno] := 0;
clearIOchip(chipno);

end;

procedure ClearIOchip(chipno:integer);
begin
  IOoutput(chipno,0);
end;


procedure SetIOchip(chipno:integer);
begin
IOoutput(chipno,255);
end;


procedure clearIOchannel(channelno:integer);
var
channel,datavar,chipno : integer;
begin
chipno := (channelno - 1) div 8;
channel := (channelno - 1) mod 8;
datavar := IOdata[chipno] and binnot(VBSHL(1,channel));
IOoutput(chipno,datavar);
end;


procedure setIOchannel(channelno:integer);
var
chipno,channel,datavar:integer;
begin
chipno := (channelno - 1) div 8;
channel := (channelno - 1) mod 8;
datavar := VBSHL(1,channel) or IOdata[chipno];
IOoutput(chipno,datavar);
end;




function right(str: string; len : integer):string;
var
s : array[0..255] of Char;
l,m : integer;
temp : string;
begin
l := length(str);
StrPCopy(s, str);

for m := (l - len) to l do
 begin
     temp := temp + s[m];
 end;

right := temp;

end;

function leftVB(str: string; len : integer):string;
var
s : array[0..255] of Char;
m : integer;
temp : string;
begin
StrPCopy(s, str);
for m := 0 to len-1 do
 begin
     temp := temp + s[m];
 end;
leftVB := temp;
end;

function mid(str: string; start:integer;len:integer):string;
var
s : array[0..255] of Char;
m : integer;
temp : string;
begin

StrPCopy(s, str);
for m := start-1 to start+len-2 do
 begin
     temp := temp + s[m];
 end;
mid := temp;
end;

function DecimaltoBinary(decNum:integer):string;
var
binstr : string;
i : integer;
factor : array[1..8] of integer;
begin
factor[1] := 128; factor[2] := 64; factor[3] := 32;   factor[4] := 16;
factor[5] := 8; factor[6] := 4;factor[7]  := 2;   factor[8] := 1;

binstr := '';

for i := 1 to 8 do
 begin
   if factor[i] > decNum then
     binstr := binstr + '0'
     else
      begin
      binstr := binstr + '1';
      decNum := decNum - factor[i];
      end;
 end;
DecimaltoBinary := binstr;
end;

function BNOT(binstr:string):string;
var
i : integer;
temp : string;
begin
temp := '';

for i := 1 to length(binstr) do
 begin
   if mid(binstr,i,1) = '0' then
   temp := temp + '1'
   else
   temp := temp + '0';
 end;

BNOT := temp;

end;



function DecimaltoBinaryNOT(decNum:integer):string;
var
temp : string;
begin
temp := decimalToBinary(decNum);
temp := BNOT(temp);
DecimaltoBinaryNOT := temp;
end;

function BinarytoDecimal(binstr:string):integer;
var
weight,i,sum : integer;
begin
sum := 0;
weight := 1;

for i := 8 downto 1 do
 begin
     if mid(binstr,i,1) = '1' then
      sum := sum + weight;
      weight := weight*2;
 end;
BinarytoDecimal := sum;

end;

function BINNOT(decnum:integer):integer;
var
temp : string;
begin
temp := decimaltobinaryNOT(decnum);
BINNOT := BinarytoDecimal(temp);
end;


function VBSHL(dec,positions:integer):integer;
var
temp : string;
begin
 temp := '';
 temp := right( (decimaltobinary(dec) + VBstrings(positions,'0')) ,8);
 VBSHL := binarytodecimal(temp);
end;



function VBstrings(num:integer;c:string): string;
begin
VBstrings := stringofchar('0',num);
end;


procedure testrunninglights;
var
i,j,pausefactor,pause,pause2,p : integer;
begin


{$IFDEF LINUX}
openport;
{$ENDIF}

k8000getready;


ConfigIOchipAsOutput(0);
ConfigIOchipAsOutput(1);

pausefactor := 10000;
i := 1;
j:= 0;
repeat
 if i = 1 then p := 16 else p := i - 1;

  clearIOchannel(p);
  setIOchannel(i);

   if pausefactor <> 0 then
    begin
    for pause := 0 to pausefactor do
     begin
         for pause2 := 0 to 10000 do
         begin
         end;
     end;
     end;

    if i = 16 then i := 1 else i := i + 1;

    j := j+1;

  until j >= 32;

{$IFDEF LINUX}
closeport;
{$ENDIF}


end;






end.