unit mmc_h;

interface

uses
	Windows, Messages, SysUtils, Classes;

type
  TWINAPI = procedure(isr:word);
  PWINAPI = ^TWINAPI;

const
  MAX_CARD	= 16;

  WR0	      =	$00; // command register
  WR1       =	$02;
  WR2       =	$04;
  WR3       =	$06;
  WR4       =	$08;
  WR5       =	$0a;
  WR6       =	$0c;
  WR7       =	$0e;
  RR0       =	$00;
  RR1       =	$02;
  RR2       =	$04;
  RR3       =	$06;
  RR4       =	$08;
  RR5       =	$0a;
  RR6       =	$0c;
  RR7       =	$0e;
  RD        =	$10;	// card id address (for MC8041P)
  BP1P      = $04;
  BP1M      = $06;
  BP2P      = $08;
  BP2M      = $0a;
  BP3P      = $0c;
  BP3M      = $0e;

  mGridVal: array[0..5,0..15] of string =
          		 (('-','BPSC1','BPSC0','ZONE2','ZONE1','ZONE0','CNEXT','I-DRV','U-ERR','Z-ERR','Y-ERR','X-ERR','U-DRV','Z-DRV','Y-DRV','X-DRV'),
		   ('EMG','ALARM','LMT-','LMT+','IN3','IN2','IN1','IN0','ADSND','ACNST','AASND','DSND','CNST','ASND','CMP-','CMP+'),
		   ('-','-','-','-','-','-','-','-','-','-','EMG','ALARM','HLMT-','HLMT+','SLMT-','SLMT+'),
		   ('-','-','-','-','-','-','-','-','D-END','C-STA','C-END','P>=C+','P<C+','P<C-','P>=C-','PULSE'),
		   ('Y-ALM','Y-INP','Y-EX-','Y-EX+','Y-IN3','Y-IN2','Y-IN1','Y-IN0','X-ALM','X-INP','X-EX-','X-EX+','X-IN3','X-IN2','X-IN1','X-IN0'),
		   ('U-ALM','U-INP','U-EX-','U-EX+','U-IN3','U-IN2','U-IN1','U-IN0','Z-ALM','Z-INP','Z-EX-','Z-EX+','Z-IN3','Z-IN2','Z-IN1','Z-IN0'));

function OpenCard_N(no: Integer; isr: PWINAPI; base_addr, size, irq: Integer): LongWord; cdecl; external 'mc8041p.dll';
function CloseCard_N(no: Integer): Boolean; cdecl; external 'mc8041p.dll';
function CloseCard_all: Boolean; cdecl; external 'mc8041p.dll';
function InW_N(no: Integer; iocc: Word): Word; cdecl; external 'mc8041p.dll';
procedure OutW_N(no: Integer; iocc: Word; data: Integer); cdecl; external 'mc8041p.dll';
function _hookIRQ(no: Integer; isr: Pointer): Integer; cdecl; external 'mc8041p.dll';
function ValidString: PChar; cdecl; external 'mc8041p.dll';
function GetAxes: Integer; cdecl; external 'mc8041p.dll';

function GetIndexValue(no: Integer): Integer;
procedure readRR(no, axis: Integer);
procedure wreg1_N(no, axis, wdata: Integer);
procedure wreg2_N(no, axis, wdata: Integer);
procedure wreg3_N(no, axis, wdata: Integer);
procedure command_N(no, axis, cmd: Integer);
procedure range_N(no, axis: Integer; wdata: Longint);
procedure acac_N(no, axis, wdata: Integer);
procedure acc_N(no, axis, wdata: Integer);
procedure dec_N(no, axis, wdata: Integer);
procedure startv_N(no, axis, wdata: Integer);
procedure speed_N(no, axis, wdata: Integer);
procedure pulse_N(no, axis: Integer; wdata: Longint);
procedure decp_N(no, axis: Integer; wdata: Longint);
procedure center_N(no, axis: Integer; wdata: Longint);
procedure lp_N(no, axis: Integer; wdata: Longint);
procedure ep_N(no, axis: Integer; wdata: Longint);
procedure compp_N(no, axis: Integer; wdata: Longint);
procedure compm_N(no, axis: Integer; wdata: Longint);
procedure accofst_N(no, axis: Integer; wdata: Longint);
function readlp_N(no, axis: Integer): Longint;
function readep_N(no, axis: Integer): Longint;
procedure wait_N(no, axis: Integer);
procedure next_wait_N(no: Integer);
procedure bp_wait_N(no: Integer);
function init: Integer;
procedure close;
function inwN(no: Integer; iocc: Word): Word;
procedure outwN(no: Integer; iocc, data: Word);

implementation

var
  m_rr: array[0..3, 0..7] of Word;
  m_no: Integer;
  int_flg, BoardOk, FIndex: array[0..MAX_CARD-1] of Integer;

function GetIndexValue(no: Integer): Integer;
begin
  Result := FIndex[no];
end;

procedure readRR(no, axis: Integer);
const
  addr: array [0..7] of Integer = (RR0, RR1, RR2, RR3, RR4, RR5, RR6, RR7);

var
  t, I: Integer;
begin
  t := ($01 shl axis) and $0f;
  OutW_N(no, WR0, (t shl 8) + $0f);
  for I := 0 to 7 do
    m_rr[axis][I] := InW_N(no, addr[i]);
end;

procedure wreg1_N(no, axis, wdata: Integer);
begin
  axis := axis and $0f;
  OutW_N(no, WR0, (axis shl 8) + $0f);
  OutW_N(no, WR1, wdata);
end;

procedure wreg2_N(no, axis, wdata: Integer);
begin
  axis := axis and $0f;
  OutW_N(no, WR0, (axis shl 8) + $0f);
  OutW_N(no, WR2, wdata);
end;

procedure wreg3_N(no, axis, wdata: Integer);
begin
  axis := axis and $0f;
  OutW_N(no, WR0, (axis shl 8) + $0f);
  OutW_N(no, WR3, wdata);
end;

procedure command_N(no, axis, cmd: Integer);
begin
  axis := axis and $0f;
  OutW_N(no, WR0, (axis shl 8) + cmd);
end;

procedure range_N(no, axis: Integer; wdata: Longint);
begin
  axis := axis and $0f;
  if wdata < 1 then wdata := 1;
  if (wdata - 8000000) > 0 then wdata := 8000000;

	OutW_N(no, WR7, (wdata shr 16) and $0ffff);
	OutW_N(no, WR6, wdata and $0ffff);
	OutW_N(no, WR0, (axis shl 8) + $00);
end;

procedure acac_N(no, axis, wdata: Integer);
begin
  axis := axis and $0f;
  if wdata > 65535 then wdata := 65535;
  if wdata < 1 then wdata := 1;
  if (wdata - 8000000) > 0 then wdata := 8000000;

	OutW_N(no, WR6, wdata);
	OutW_N(no, WR0, (axis shl 8) + $01);
end;

procedure acc_N(no, axis, wdata: Integer);
begin
  axis := axis and $0f;
  if wdata > 8000 then wdata := 8000;
  if wdata < 1 then wdata := 1;
  if (wdata - 8000000) > 0 then wdata := 8000000;

	OutW_N(no, WR6, wdata);
	OutW_N(no, WR0, (axis shl 8) + $02);
end;

procedure dec_N(no, axis, wdata: Integer);
begin
  axis := axis and $0f;
  if wdata > 8000 then wdata := 8000;
  if wdata < 1 then wdata := 1;
  if (wdata - 8000000) > 0 then wdata := 8000000;

	OutW_N(no, WR6, wdata);
	OutW_N(no, WR0, (axis shl 8) + $03);
end;

procedure startv_N(no, axis, wdata: Integer);
begin
  axis := axis and $0f;
  if wdata > 8000 then wdata := 8000;
  if wdata < 1 then wdata := 1;
  if (wdata - 8000000) > 0 then wdata := 8000000;

	OutW_N(no, WR6, wdata);
	OutW_N(no, WR0, (axis shl 8) + $04);
end;

procedure speed_N(no, axis, wdata: Integer);
begin
  axis := axis and $0f;
  if wdata > 8000 then wdata := 8000;
  if wdata < 1 then wdata := 1;
  if (wdata - 8000000) > 0 then wdata := 8000000;

	OutW_N(no, WR6, wdata);
	OutW_N(no, WR0, (axis shl 8) + $05);
end;

procedure pulse_N(no, axis: Integer; wdata: Longint);
begin
  axis := axis and $0f;
  if wdata < -8388608 then wdata := -8388608;
  if wdata > 268435455 then wdata := 268435455;

	OutW_N(no, WR7, (wdata shr 16) and $0ffff);
	OutW_N(no, WR6, wdata and $0ffff);
	OutW_N(no, WR0, (axis shl 8) + $06);
end;

procedure decp_N(no, axis: Integer; wdata: Longint);
begin
  axis := axis and $0f;

	OutW_N(no, WR7, (wdata shr 16) and $0ffff);
	OutW_N(no, WR6, wdata and $0ffff);
	OutW_N(no, WR0, (axis shl 8) + $07);
end;

procedure center_N(no, axis: Integer; wdata: Longint);
begin
  axis := axis and $0f;
  if wdata < -8388608 then wdata := -8388608;
  if wdata > 8388607 then wdata := 8388607;

	OutW_N(no, WR7, (wdata shr 16) and $0ffff);
	OutW_N(no, WR6, wdata and $0ffff);
	OutW_N(no, WR0, (axis shl 8) + $08);
end;

procedure lp_N(no, axis: Integer; wdata: Longint);
begin
  axis := axis and $0f;

	OutW_N(no, WR7, (wdata shr 16) and $0ffff);
	OutW_N(no, WR6, wdata and $0ffff);
	OutW_N(no, WR0, (axis shl 8) + $09);
end;

procedure ep_N(no, axis: Integer; wdata: Longint);
begin
  axis := axis and $0f;

	OutW_N(no, WR7, (wdata shr 16) and $0ffff);
	OutW_N(no, WR6, wdata and $0ffff);
	OutW_N(no, WR0, (axis shl 8) + $0a);
end;

procedure compp_N(no, axis: Integer; wdata: Longint);
begin
  axis := axis and $0f;

	OutW_N(no, WR7, (wdata shr 16) and $0ffff);
	OutW_N(no, WR6, wdata and $0ffff);
	OutW_N(no, WR0, (axis shl 8) + $0b);
end;

procedure compm_N(no, axis: Integer; wdata: Longint);
begin
  axis := axis and $0f;

	OutW_N(no, WR7, (wdata shr 16) and $0ffff);
	OutW_N(no, WR6, wdata and $0ffff);
	OutW_N(no, WR0, (axis shl 8) + $0c);
end;

procedure accofst_N(no, axis: Integer; wdata: Longint);
begin
  axis := axis and $0f;

	OutW_N(no, WR7, (wdata shr 16) and $0ffff);
	OutW_N(no, WR6, wdata and $0ffff);
	OutW_N(no, WR0, (axis shl 8) + $0d);
end;

function readlp_N(no, axis: Integer): Longint;
var
  d6, d7: Longint;
begin
  axis := axis and $0f;
	OutW_N(no, WR0, (axis shl 8) + $10);

  d6 := InW_N(no, RR6);
  d7 := InW_N(no, RR7);

  Result := d6 + (d7 shl 16);
end;

function readep_N(no, axis: Integer): Longint;
var
  d6, d7: Longint;
begin
  axis := axis and $0f;
	OutW_N(no, WR0, (axis shl 8) + $11);

  d6 := InW_N(no, RR6);
  d7 := InW_N(no, RR7);

  Result := d6 + (d7 shl 16);
end;

procedure wait_N(no, axis: Integer);
begin
  axis := axis and $0f;

  repeat
  ;
  until (InW_N(no, RR0) and axis = 0);
end;

procedure next_wait_N(no: Integer);
begin
  repeat
  ;
  until (InW_N(no, RR0) and $0200 <> 0);
end;

procedure bp_wait_N(no: Integer);
begin
  repeat
  ;
  until (InW_N(no, RR0) and $6000 <> $6000);
end;

procedure isr_sub(no: Integer);
begin
	int_flg[no] := 1;
	command_N(no, $1, $0f);
	InW_N(no, RR3);
	command_N(no, $1, $0f);
	OutW_N(no, WR3, $0100);
end;

procedure isr(no: Integer);
begin
  isr_sub(no);
end;

procedure isr0;
begin
  isr_sub(0);
end;

procedure isr1;
begin
  isr_sub(1);
end;

procedure isr2;
begin
  isr_sub(2);
end;

procedure isr3;
begin
  isr_sub(3);
end;

procedure isr4;
begin
  isr_sub(4);
end;

procedure isr5;
begin
  isr_sub(5);
end;

procedure isr6;
begin
  isr_sub(6);
end;

procedure isr7;
begin
  isr_sub(7);
end;

procedure isr8;
begin
  isr_sub(8);
end;

procedure isr9;
begin
  isr_sub(9);
end;
procedure isr10;
begin
  isr_sub(10);
end;
procedure isr11;
begin
  isr_sub(11);
end;
procedure isr12;
begin
  isr_sub(12);
end;
procedure isr13;
begin
  isr_sub(13);
end;
procedure isr14;
begin
  isr_sub(14);
end;

procedure isr15;
begin
  isr_sub(15);
end;

function init: Integer;
var
  ists: THandle;
  no, cnt: Integer;
  pFunc: PWINAPI;
begin
  pFunc := @ISR1;
  close;
	m_no := 0;

  for no := 0 to (MAX_CARD-1) do begin
    int_flg[no] := 0;
    ists := 0;
    case no of
      0 : ists := OpenCard_N(no, @ISR0, 0, 0, 0);
      1 : ists := OpenCard_N(no, @ISR1, 0, 0, 0);
      2 : ists := OpenCard_N(no, @ISR2, 0, 0, 0);
      3 : ists := OpenCard_N(no, @ISR3, 0, 0, 0);
      4 : ists := OpenCard_N(no, @ISR4, 0, 0, 0);
      5 : ists := OpenCard_N(no, @ISR5, 0, 0, 0);
      6 : ists := OpenCard_N(no, @ISR6, 0, 0, 0);
      7 : ists := OpenCard_N(no, @ISR7, 0, 0, 0);
      8 : ists := OpenCard_N(no, @ISR8, 0, 0, 0);
      9 : ists := OpenCard_N(no, @ISR9, 0, 0, 0);
      10: ists := OpenCard_N(no, @ISR10, 0, 0, 0);
      11: ists := OpenCard_N(no, @ISR11, 0, 0, 0);
      12: ists := OpenCard_N(no, @ISR12, 0, 0, 0);
      13: ists := OpenCard_N(no, @ISR13, 0, 0, 0);
      14: ists := OpenCard_N(no, @ISR14, 0, 0, 0);
      15: ists := OpenCard_N(no, @ISR15, 0, 0, 0);
    end;

    if ists = 0 then
      BoardOk[no] := 0
    else begin
      BoardOk[no] := 1;
      Findex[m_no] := no;
      Inc(m_no);
      OutW_N(no, WR0, $8000);

      for cnt := 0 to 9999 do ;
      wreg1_N(no, $f, $0000);
      wreg2_N(no, $f, $0000);
      wreg3_N(no, $f, $0000);

      accofst_N(no, $f, 0);
      range_N(no, $f, 800000);
      acac_N(no, $f, 1010);
      acc_N(no, $f, 400);
      dec_N(no, $f, 400);
      startv_N(no, $f, 100);
      speed_N(no, $f, 4000);
      pulse_N(no, $f, 32000);
      lp_N(no, $f, 0);
      ep_N(no, $f, 0);
    end;
  end;

	Result := m_no;
end;

procedure close;
begin
  CloseCard_all;
end;

function inwN(no: Integer; iocc: Word): Word;
begin
  Result := InW_N(no, iocc);
end;

procedure outwN(no: Integer; iocc, data: Word);
begin
  OutW_N(no, iocc, data);
end;

end.
