// =====================================================
//
//   miniLA_win - I/O routine (USB)
//
//   (c) miniLA Team
//
// =====================================================
//
// This is free software; you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation; either version 2, or (at your option)
// any later version.
//
// This software is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
// GNU General Public License for more details.
//
// You should have received a copy of the GNU General Public License
// along with this package; see the file COPYING.  If not, write to
// the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
// Boston, MA 02111-1307, USA.


unit dlgIO_USB;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, Spin, ExtCtrls;

type
  TfrmIO_USB = class(TForm)
    btnCancel: TBitBtn;
    btnOK: TBitBtn;
    rgUSBDev: TGroupBox;
    rbUSBAuto: TRadioButton;
    rbUSBMan: TRadioButton;
    cbUSBDev: TComboBox;
    procedure rbUSBManClick(Sender: TObject);
    procedure rbUSBAutoClick(Sender: TObject);
    procedure cbUSBDevDropDown(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    AutoDetect	: boolean;
    dev_description : string;
  public
    { Public declarations }
    function	ReadReg(Addr: Integer; Immediate: Boolean): Longint;
    procedure 	WriteReg(Addr: Integer; Val: Byte; Immediate: Boolean);
    procedure	Init;
    procedure	Close;
  end;


var
  frmIO_USB: TfrmIO_USB;


//******************************************************************************
//******************************************************************************
//******************************************************************************

implementation

uses dlgMain, D2XXUnit, uINIFile;

{$R *.DFM}

type
  TLast_Access = (none, read, write);
  Names = Array[1..20] of string;
  Names_Ptr = ^Names;
  DataBuff = Array[0..63] of byte;
  Data_Ptr = ^DataBuff;

var
  PortAIsOpen : boolean;
  OutIndex : integer;
  last_access : TLast_Access;

const
  default_description = 'miniLA USB Interface A';


//=================================================================
procedure SendBytes(NumberOfBytes : integer);
//=================================================================
var i : integer;
begin
   i := Write_USB_Device_Buffer( NumberOfBytes);
   OutIndex := OutIndex - i;
end;


//=================================================================
procedure AddToBuffer(I:integer);
//=================================================================
begin
   FT_Out_Buffer[OutIndex]:= I AND $FF;
   inc(OutIndex);
end;



//=================================================================
function GetData: integer;
//=================================================================
var
    res : FT_Result;
    j : integer;
begin
    j := 0;
    // assume at least 1 byte
    repeat
        sleep(1);
        res := Get_USB_Device_QueueStatus;
        if FT_Q_Bytes > 0 then
        begin
            j := Read_USB_Device_Buffer(FT_Q_Bytes);
        end else
        begin
            sleep(0); // delay for XP systems that lock up
        end;
    until (j > 0) or (res <> FT_OK);

    result := res;
end;



//=================================================================
function OpenPort(PortName : string) : boolean;
//=================================================================
Var
    res : FT_Result;
    NoOfDevs,i,J : integer;
    Name : String;
    DualName : string;
    done : boolean;
begin
    PortAIsOpen := False;
    result := False;
    Name := '';
    Dualname := PortName;
    res := GetFTDeviceCount;

    if res <> Ft_OK then exit;

    NoOfDevs := FT_Device_Count;
    j := 0;
    if NoOfDevs > 0 then
    begin
        repeat
            repeat
                res := GetFTDeviceDescription(J);
                if (res <> Ft_OK) then  J := J + 1;
            until (res = Ft_OK) OR (J=NoOfDevs);

            if res <> Ft_OK then exit;

            done := false;
            i := 1;
            Name := '';

            repeat
                if ORD(FT_Device_String_Buffer[i]) <> 0 then
                begin
                    Name := Name + FT_Device_String_Buffer[i];
                end else
                begin
                    done := true;
                end;
                i := i + 1;
            until done;

            J := J + 1;
        until (J = NoOfDevs) or (name = DualName);
    end;

    if (name = DualName) then
    begin
        res := Open_USB_Device_By_Device_Description(name);

        if res <> Ft_OK then exit;

        result := true;
        res := Get_USB_Device_QueueStatus;

        if res <> Ft_OK then exit;

        PortAIsOpen := true;
    end else
    begin
        result := false;
    end;
end;

//=================================================================
// This should satisfy outstanding commands.
//
// We will use $AA and $AB as commands which
// are invalid so that the MPSSE block should echo these
// back to us preceded with an $FA
//=================================================================
function Sync_To_MPSSE : boolean;
var
    res : FT_Result;
    i,j : integer;
    Done : boolean;
begin
    result := false;
    res := Get_USB_Device_QueueStatus;

    if res <> FT_OK then exit;
    if (FT_Q_Bytes > 0) then
    begin
        res := Read_USB_Device_Buffer(FT_Q_Bytes);
    end;

    repeat
        OutIndex := 0;
        AddToBuffer($AA); // bad command
        SendBytes(OutIndex);
        res := Get_USB_Device_QueueStatus;

        if FT_Q_Bytes = 0 then sleep(0);

    until (FT_Q_Bytes > 0) or (res <> FT_OK); // or timeout

    if res <> FT_OK then exit;

    i := Read_USB_Device_Buffer(FT_Q_Bytes);
    j := 0;

    Done := False;

    repeat
        if (FT_In_Buffer[j] = $FA) then
        begin
            if (j < (i-2)) then
            begin
                if (FT_In_Buffer[j+1] = $AA) then Done := true;
            end;
        end;
        j := j + 1;
    until (j=i) or Done;

    OutIndex := 0;
    AddToBuffer($AB); // bad command
    SendBytes(OutIndex);

    repeat
        res := Get_USB_Device_QueueStatus;
    until (FT_Q_Bytes > 0) or (res <> FT_OK); // or timeout

    if res <> FT_OK then exit;

    i := Read_USB_Device_Buffer(FT_Q_Bytes);
    j := 0;
    Done := False;

    repeat
        if (FT_In_Buffer[j] = $FA) then
        begin
            if (j <= (i-2)) then
            begin
                if (FT_In_Buffer[j+1] = $AB) then Done := true;
            end;
        end;
        j := j + 1;
    until (j=i) or Done;

    if Done then result := true;
end;

//=================================================================
function InitDev : boolean;
//=================================================================
var
    res : FT_Result;
begin
    res := Set_USB_Device_LatencyTimer(16);
    res := Set_USB_Device_BitMode($00,$00); 		// reset controller
    res := Set_USB_Device_BitMode($00,$08); 		// enable Host Bus Emulation
    result := Sync_To_MPSSE;
end;




//=================================================================
procedure TfrmIO_USB.Init;
//=================================================================
var
   Dname : string;
   passed : boolean;
   ftresult : FT_Result;
begin
    if AutoDetect then
        DName := default_description
    else
        DName := dev_description;

    if (Dname <> '') then
    begin
        passed := OpenPort(Dname);
        if passed then
        begin
	        // Device opened
	        passed := InitDev;
	        if  passed then
	        begin
	        end else
	        begin
	            raise Exception.Create('USB initialisation failed.');
	            close;
	        end;
        end else
	    begin
	        raise Exception.Create('USB device opening failed.');
	    end;
    end else
    begin						// note: maybe redundant check
        raise Exception.Create('No USB device selected.');
    end;
end;

//=================================================================
procedure TfrmIO_USB.Close;
//=================================================================
var res : FT_Result;
begin
   if PortAIsOpen then
     res := Close_USB_Device;
   PortAIsOpen := False;
end;


//=================================================================
function TfrmIO_USB.ReadReg(Addr: Integer; Immediate: Boolean): longint;
//=================================================================
//var res	: byte;
begin
    if last_access <> read then
    begin
        AddToBuffer($91); 		// read extended
        AddToBuffer($1);			// Address high
    end else
        AddToBuffer($90);			// read short

    AddToBuffer(Addr);	 		// Address low
    if immediate then
    begin
        AddToBuffer($87); 		// Send Immediate
        SendBytes(OutIndex);		// send off the command
        result := GetData;
    end else
        result := 0;
   last_access := read;
end;


//=================================================================
procedure TfrmIO_USB.WriteReg(Addr: Integer; Val: Byte; Immediate: Boolean);
//=================================================================
begin
    if last_access <> write then
    begin
        AddToBuffer($93);			// write extended
        AddToBuffer($0); 			// Address high
    end else
        AddToBuffer($92); 		// write short

    AddToBuffer(Addr);	 		// Address low
    AddToBuffer(Val); 			// Data
    if (immediate) then
        SendBytes(OutIndex); 		// send off the command
   last_access := write;
end;

//=================================================================
procedure TfrmIO_USB.FormCreate(Sender: TObject);
//=================================================================
begin
   AutoDetect := INIFile.ReadBool('HW', 'USB_AUTODETECT', true);
   dev_description := INIFile.ReadString('HW', 'USB_DESCRIPTION', default_description);
end;


//=================================================================
procedure TfrmIO_USB.FormDestroy(Sender: TObject);
//=================================================================
begin
   INIFile.WriteBool('HW', 'USB_AUTODETECT', AutoDetect);
   INIFile.WriteString('HW', 'USB_DESCRIPTION', dev_description)
end;


//=================================================================
procedure TfrmIO_USB.FormActivate(Sender: TObject);
//=================================================================
begin
   rbUSBAuto.Checked := AutoDetect;
   rbUSBMan.Checked := not AutoDetect;
   cbUSBDev.Text := dev_description;
end;

//=================================================================
procedure TfrmIO_USB.rbUSBAutoClick(Sender: TObject);
//=================================================================
begin
   cbUSBDev.Enabled := false;
end;


//=================================================================
procedure TfrmIO_USB.rbUSBManClick(Sender: TObject);
//=================================================================
begin
   cbUSBDev.Enabled := true;
end;

//=================================================================
// Fill combo box with connected devices
//=================================================================
procedure TfrmIO_USB.cbUSBDevDropDown(Sender: TObject);
var
   res : FT_Result;
   NoOfDevs,DevIdx,i : integer;
   Name : String;
begin
   frmIO_USB.cbUSBDev.Clear;

   res := GetFTDeviceCount;
   if res <> Ft_OK then exit;

   NoOfDevs := FT_Device_Count;
   DevIdx := 0;
   while (NoOfDevs > 0) and (DevIdx <> NoOfDevs) do
    begin
      res := GetFTDeviceDescription(DevIdx);
      if res = Ft_OK then
	begin
	  Name := StrPas(@FT_Device_String_Buffer);
	  i := Length(Name);
	  if (i > 2) and (copy(Name, i-1, 2) = ' A') then
	     cbUSBDev.Items.Add(Name);
	end;
      inc(DevIdx);
    end;
end;


//=================================================================
procedure TfrmIO_USB.btnOKClick(Sender: TObject);
//=================================================================
var
    Baudrate : Integer;
    ftresult : FT_Result;
begin
   AutoDetect := rbUSBAuto.Checked;
   dev_description := cbUSBDev.Text;

   if (dev_description = '') and not AutoDetect then
    begin
      MessageDlg('Invalid device description', mtError,[mbOK],0);
      exit;
    end;

   ModalResult := mrOK;
end;

end.
