unit f8254u;

interface

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

type
  Tf8254Form = class(TForm)
    ISAPanel: TGroupBox;
    HexLabel: TLabel;
    BaseEdit: TEdit;
    StartButton: TButton;
    ExitButton: TButton;
    FeatureGroup: TRadioGroup;
    FreqInPanel: TPanel;
    FreqOutPanel: TPanel;
    EventCountPanel: TPanel;
    PulseWidthPanel: TPanel;
    FreqInLabel: TLabel;
    FreqInEdit: TEdit;
    PulseLabel: TLabel;
    PulseEdit: TEdit;
    FreqOutLabel: TLabel;
    FreqOutEdit: TEdit;
    EventTestButton: TButton;
    SinceLastButton: TButton;
    EventCountLabel: TLabel;
    EventCountEdit: TEdit;
    SinceFirstButton: TButton;
    Instructions: TMemo;
    RealLabel: TLabel;
    RealEdit: TEdit;
    FreqInTimer: TTimer;
    PulseWidthTimer: TTimer;
    procedure FeatureGroupClick(Sender: TObject);
    procedure ExitButtonClick(Sender: TObject);
    procedure StartButtonClick(Sender: TObject);
    procedure SinceFirstButtonClick(Sender: TObject);
    procedure SinceLastButtonClick(Sender: TObject);
    procedure EventTestButtonClick(Sender: TObject);
    procedure FreqInTimerTimer(Sender: TObject);
    procedure PulseWidthTimerTimer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
   INITIALIZE = 1;                // initialize the counter
   START      = 2;                // start counting
   SINCESTART = 4;                // how many since starting
   SINCELAST  = 8;                // how many since last check
   STOP       = 16;               // stop counting
   RESET      = 32;               // reset counter to 65535

var
  f8254Form: Tf8254Form;
  BaseAddress: Word;

implementation

{$R *.DFM}
uses
  ACCES32;

procedure CtrMode(Base: word; cntr, mode:byte);
var
   ctrl: byte;
begin
   ctrl := (cntr shl 6) or $30 or (mode shl 1);
   OutPortB(Base + 3, ctrl);
end;

procedure CtrLoad(Base: word; c, val:word);
begin
   OutPortB(Base + c, lo(val));
   OutPortB(Base + c, hi(val));
end;

// NOTE: CtrRead isn't actually used in this sample, but it is here for reference
function CtrRead(Base: word; c : byte) : word;
begin
   OutPortB(Base + 3, c shl 6);
   CtrRead := InPortB(Base + c) + (InPortb(Base + c) shl 8);
end;

function ReadStatus(Base: Word): Word;
begin
   OutPortB(Base + 3, $E4);     // 1110 0100 ReadBack for ctr1
   Result := InPortB(Base + 1); // ctr1 output
   Result := Result SHR 7;
end;

procedure InitCounter(Base: Word);
begin
   Ctrmode(Base, 0, 0);         // 0011 0000 ctr0 LSB/MSB mode 0
   Ctrload(Base, 0, $FFFF);     // load 65535 into ctr0
end;

function ReadCounter0(Base: Word): Word;
var
   LSB, MSB: Word;
begin
   OutPortB(Base + 3, $D2);     // 1101 0010 RB ctr0 latch
   LSB := InPortB(Base);        // LSB of ctr0
   MSB := InPortB(Base);        // MSB of ctr0

   Result := (MSB SHL 8) + LSB; // values at ctr1 = 0
end;

function ReadCounter1(Base: Word): LongWord;
var
   LSB, MSB: Word;
begin
   OutPortB(Base + 3, $D4);     // 1101 0100 Read Back counts ctr1
   LSB := InPortB(Base + 1);    // ctr1 counts LSB
   MSB := InPortB(Base + 1);    // ctr1 counts MSB

   Result := (MSB SHL 8) + LSB;
end;

function ReadCounter2(Base: Word): LongWord;
var
   LSB, MSB: Word;
begin
   OutPortB(Base + 3, $D8);     // 1101 1000 Read Back counts ctr2
   LSB := InPortB(Base + 2);    // ctr1 counts LSB
   MSB := InPortB(Base + 2);    // ctr1 counts MSB

   Result := (MSB SHL 8) + LSB;
end;

procedure Tf8254Form.FeatureGroupClick(Sender: TObject);
begin
   StartButton.Enabled := True;
   FreqInTimer.Enabled := False;
   PulseWidthTimer.Enabled := False;
   case FeatureGroup.ItemIndex of
      0: begin
         StartButton.Caption := 'Start Input';
         FreqInPanel.Visible := true;
         FreqOutPanel.Visible := false;
         EventCountPanel.Visible := false;
         PulseWidthPanel.Visible := false;
         Instructions.SelStart := 161;
         Instructions.SelLength := 1000;
         Instructions.SelText := 'Frequency Measurement requires CTR0 Gate controlled by CTR1 Output and a 1MHz clock input to CTR1. Bring the the frequency you want to measure into Counter 0 input.';
         Instructions.Lines.Add('Click the "Start Measure" button to demonstrate the frequency measuring feature. The measured frequency will be displayed in the text box.');
         end;
      1: begin
         StartButton.Caption := 'Start Output';
         FreqInPanel.Visible := false;
         FreqOutPanel.Visible := true;
         EventCountPanel.Visible := false;
         PulseWidthPanel.Visible := false;
         Instructions.SelStart := 161;
         Instructions.SelLength := 1000;
         Instructions.SelText := 'Frequency Generation requires a 1MHz input to CTR1, and CTR1 Output connected to CTR2 Clock, as well as both CTR1 & CTR2 Gates enabled. The frequency will be generated from Counter 2 output.';
         Instructions.Lines.Add('To demonstrate the frequency output feature, enter the desired output frequency in the text box (between 1Hz and 250000Hz), then click the "Start Output" button.');
         Instructions.Lines.Add('The actual output frequency will be also be displayed.');
         end;
      2: begin
         StartButton.Caption := 'Start Counts';
         FreqInPanel.Visible := false;
         FreqOutPanel.Visible := false;
         EventCountPanel.Visible := true;
         PulseWidthPanel.Visible := false;
         Instructions.SelStart := 161;
         Instructions.SelLength := 1000;
         Instructions.SelText := 'Event Counting requires CTR0 Gate enabled, or connected to CTR1. Bring your pulse train in on Counter 0 input.';
         Instructions.Lines.Add('Click the "Start Counting" button to demonstrate the event counting feature. Use the "Since First" and "Since Last" buttons to display the event counts since starting the demo, and since the last reading, respectively.');
         Instructions.Lines.Add('Use the "Stop & Reset" button to stop the demo, and reset the count.');
         end;
      3: begin
         StartButton.Caption := 'Start Measure';
         FreqInPanel.Visible := false;
         FreqOutPanel.Visible := false;
         EventCountPanel.Visible := false;
         PulseWidthPanel.Visible := true;
         Instructions.SelStart := 161;
         Instructions.SelLength := 1000;
         Instructions.SelText := 'Pulse Width Measurement requires a 1MHz input to CTR1. Bring the the signal you want to measure into Gate 1.';
         Instructions.Lines.Add('Click the "Start Measure" button to demonstrate the pulse width measuring feature. The measured pulse width will be displayed in the text box.');
         end;
   end;
end;

procedure Tf8254Form.FreqInTimerTimer(Sender: TObject);
var
   secondcount: Word;
   timeout: LongWord;
begin
   timeout := 65535;

   Ctrmode(BaseAddress, 1, 3);        // 0111 0110 ctr1 mode3, LSB/MSB
   Ctrload(BaseAddress, 1, $FFFE);    // load LSB and MSB values into
                                      // ctr1 to make slow input to gate 0

   while (ReadStatus(BaseAddress) = 1) and (timeout <> 0) do
      dec(timeout);                   // out ctr1 = 1

   timeout := 65535;
   Ctrmode(BaseAddress, 0, 2);        // 0011 0100 ctr0 mode 2 L/M
   Ctrload(BaseAddress, 0, $FFFF);    // load 65535 into ctr 0

   while (ReadStatus(BaseAddress) = 0) and (timeout <> 0) do
      dec(timeout);                   // ctr1 still 0
   timeout := 65535;

   while (ReadStatus(BaseAddress) = 1) and (timeout <> 0) do
      dec(timeout);                   // ctr1 = 1
   secondcount := ReadCounter0(BaseAddress);   // read value of counter
   FreqInEdit.Text := IntToStr(round((65535 - secondcount)/0.032767));   // convert from counts to f
end;

function FreqOutTest(Base: Word; frequency: LongWord): Real;
var
   countsA, countsB: LongWord;
   temp, x: LongWord;
   trash: Double;
begin
   x := 2;
   Result := 0;
   if ((frequency > 250000) or (frequency < 1)) then
      exit;                           // return if freq is too low/high

   trash := frequency;                // convert to float for division
   trash := 1000000/trash;            // calculate the number of counts
   temp := round(trash);              // round to the nearest count

   repeat                             // try to divide the counts
      countsA := x;                   // evenly between the two counters
      inc(x);
   until not(((temp mod countsA) <> 0)
          and (countsA < temp)
          and (countsA < 65535));     // exit if counts too high

   if ((countsA >= temp) and (temp < 131070)) then
   begin                              // gone through all vals
      countsA := 2;                   // counter can only hold 65535
      countsB := temp div 2;
   end
   else begin
      if (temp >= 131070) then begin  // counts too high to fit in counter
         countsA := 20;               // divide to make fit
         countsB := temp div 20;
      end
      else
         countsB := temp div countsA; // if found divisor use it
   end;
   Ctrmode(Base, 2, 3);               // 1011 1110 ctr2 mode3
   Ctrload(Base, 2, countsA);

   Ctrmode(Base, 1, 2);               // 0111 0100 ctr1 mode2
   Ctrload(Base, 1, countsB);
   Result := 1000000 / (countsA * countsB);
end;

function EventCountTest(Base: Word; feature: Integer): Word;
const
   previousmeasure: Word = 0;
var
   currentmeasure, returnvalue: Word;
   flag: Boolean;
begin
   flag := False;
   returnvalue := 0;
   currentmeasure := 0;
   if (INITIALIZE and feature) <> 0 then             // 1
      InitCounter(Base);                 // init counter0 to count in mode 0

   if (START and feature) <> 0 then                  // 2
      Ctrmode(Base, 1, 1);                // 0111 0010 ctr1 LSB/MSB mode 1
                                          // to hold gate of ctr0 high

   if (SINCESTART and feature) <> 0 then begin       // 4
      if not(flag) then begin             // counts down from 65535
         currentmeasure := 65535 - ReadCounter0(Base);
         flag := True;                    // flag read counter
      end;
      returnvalue := currentmeasure;      // set value to return
   end;

   if (SINCELAST and feature) <> 0 then begin        // 8
      if not(flag) then begin             // calculate counts
	 currentmeasure := 65535 - ReadCounter0(Base);
	 flag := True;
      end;                                // calculate since last
      returnvalue := currentmeasure - previousmeasure;
   end;

   if (STOP and feature) <> 0 then                   // 16
      Ctrmode(Base, 1, 0);                // 0111 0000 ctr1 mode0 out=0

   if (RESET and feature) <> 0 then begin            // 32
      InitCounter(Base);                 // init counter to 65535
      previousmeasure := 0;               // no previous counts
   end;

   if (flag) then begin                   // set previous measure if counter read
      previousmeasure := currentmeasure;
      Result := returnvalue;              // if counter read return value
   end
   else
      Result := 0;                        // return 0 if counter not read
end;

procedure Tf8254Form.SinceFirstButtonClick(Sender: TObject);
begin
   EventCountEdit.Text := IntToStr(EventCountTest(BaseAddress, SINCESTART));
end;

procedure Tf8254Form.SinceLastButtonClick(Sender: TObject);
begin
   EventCountEdit.Text := IntToStr(EventCountTest(BaseAddress, SINCELAST));
end;

procedure Tf8254Form.EventTestButtonClick(Sender: TObject);
begin
   EventCountTest(BaseAddress, STOP + RESET);
   FeatureGroup.Enabled := True;
end;

procedure Tf8254Form.PulseWidthTimerTimer(Sender: TObject);
const
   TIMEOUTVAL = 150000;
var
   temp, secondcount, previouscount: LongWord;
   timeout: LongWord;
   one, two: LongWord;
begin
   Ctrmode(BaseAddress, 2, 2);           // ctr2 mode2
   Ctrload(BaseAddress, 2, $FFFF);       // write 65535 to counter 2
   Ctrmode(BaseAddress, 1, 2);           // ctr1 mode2
   Ctrload(BaseAddress, 1, $FFFF);       // write 65535 to counter 1

   temp := ReadCounter1(BaseAddress); // read the counter
   timeout := 0;

   //the following two repeat-until loops ensure a high transition has happened
   //(a high on gate input reloads the counter)
   repeat
      previouscount := temp;
      temp := ReadCounter1(BaseAddress);
      inc(timeout);
   until ((temp = previouscount) or (timeout >= TIMEOUTVAL));
   one := ReadCounter2(BaseAddress);
   if (timeout < TIMEOUTVAL) then timeout := 0;

   repeat
      secondcount := ReadCounter1(BaseAddress);
      inc(timeout);
   until ((temp <> secondcount) or (timeout >= TIMEOUTVAL));
   if (timeout < TIMEOUTVAL) then timeout := 0;

// wait until the counts stop (low on the gate again)
   repeat
      previouscount := secondcount;
      secondcount := ReadCounter1(BaseAddress);
      inc(timeout);
   until ((secondcount = previouscount) or (timeout >= TIMEOUTVAL));

   two := ReadCounter2(BaseAddress);
   if (timeout < TIMEOUTVAL) then
      PulseEdit.Text := IntToStr((one-two)*65536+(65535 - secondcount))  // return the counts for the pulse
   else
      PulseEdit.Text := '0';
end;

procedure Tf8254Form.StartButtonClick(Sender: TObject);
var
   frequency: LongWord;
begin
   BaseAddress := StrToInt('$' + BaseEdit.Text);
   case FeatureGroup.ItemIndex of
      0: begin
            if FreqInTimer.Enabled = False then begin
               FreqInTimer.Tag := BaseAddress;
               StartButton.Caption := 'Stop Measure';
               FreqInTimer.Enabled := True;
            end
            else begin
               StartButton.Caption := 'Start Measure';
               FreqInTimer.Enabled := False;
            end;
         end;
      1: begin
         frequency := StrToInt(FreqOutEdit.Text);
         RealEdit.Text := FloatToStr(FreqOutTest(BaseAddress, frequency));
         end;
      2: EventCountTest(BaseAddress, INITIALIZE + START);
      3: if PulseWidthTimer.Enabled = False then begin
            PulseWidthTimer.Tag := BaseAddress;
            StartButton.Caption := 'Stop Measure';
            PulseWidthTimer.Enabled := True;
         end
         else begin
            StartButton.Caption := 'Start Measure';
            PulseWidthTimer.Enabled := False;
         end;
   end;
end;

procedure Tf8254Form.ExitButtonClick(Sender: TObject);
begin
   Close;
end;

procedure Tf8254Form.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   EventCountTest(BaseAddress, STOP + RESET);
   FreqInTimer.Enabled := False;
   PulseWidthTimer.Enabled := False;
end;

procedure Tf8254Form.FormCreate(Sender: TObject);
begin
   if (InPortB($61) = $AA55) then begin
      Application.MessageBox('ACCESNT.SYS not detected. Please copy ACCESNT.SYS into [NT]/system32/drivers and re-run this sample.', 'Warning', IDOK);
   end;
end;

end.