(***************************************************************************
 *  This sample will generate 3 different wave forms, sine, triangle and   *
 *  saw tooth.  The user has the choice of base address, DAC number and the*
 *  number of points per cycle.                                            *
 *                                                                         *
 *  The following setup of the board is expected:                          *
 *      -- Base address should be set to the address entered during       *
 *         program execution.                                              *
 ***************************************************************************)
program SAMPLE2;

uses CRT;

CONST PI = 3.1415927;

var counts      :word;                     (* number of points per cycle *)
    Address     :word;                     (* board base address         *)
    dacnum      :word;                     (* DAC used for output        *)
    progstruct  : array[0..20000] of word; (* buffer to hold points      *)
    menuchoice  :char;


function AskForBaseAddress(OldOne : String) : Word;
const
   Msg : string[4] = '0';
var
   NewOne, Success, Dummy, Error : Word;
   AddrInputPosX, AddrInputPosY : Word;
begin
   if (OldOne = 'OLD') then OldOne := Msg;
   WriteLn('Please enter the Base Address (0000-FFFF) for your card (in hex)');
   WriteLn('or press ENTER for ', OldOne, '.  ');
   Write('>');
   AddrInputPosX := WhereX; AddrInputPosY := WhereY;
   repeat
      GotoXY(AddrInputPosX, AddrInputPosY);
      ClrEol;
      Readln(Msg);
      Val('$' + Msg, NewOne, Error);
      if (error=0) then begin
         Success := 1;
         Dummy := NewOne;
      end else if (Msg = '') then begin
         GotoXY(AddrInputPosX, AddrInputPosY);
         WriteLn(OldOne);
         Msg := OldOne;
         Success := 1;
         Val('$' + Msg, Dummy, Error);
      end;
   until (Success = 1);
   AskForBaseAddress := Dummy;
end;  { end of AskForBaseAddress }




(***************************************************************************
 *  FUNCTION: setparams - local routine                                    *
 *  PURPOSE: Prompts the user for DAC number, base address and the number *
 *            of points per cycle.                                         *
 ***************************************************************************)
procedure setparms;

begin
   clrscr;
   Address := AskForBaseAddress('350');
   repeat
      GotoXY (1,7);
      ClrEol;
      Write('Enter the DAC number you wish to output to (0 through 15 only): ');
      ReadLn (dacnum);
   until (dacnum>=0) and (dacnum<=15);
   writeln;
   writeln;
   writeln;
   writeln('Enter the number of points you wish to calculate per cycle,');
   write('(20000 maximum, program will use modulus if needed): ');
   readln(counts);
   counts := counts mod 20001;
end; (* setparams *)

(***************************************************************************
 *  FUNCTION: sendtoport - local routine                                   *
 *  PURPOSE: Writes the point buffer to the DAC until a key is pressed.   *
 ***************************************************************************)
procedure sendtoport;

var i,temp           :word;
    ch               :char;

begin

   repeat
      for i := 1 to counts do
         portw[Address+(dacnum*2)] := progstruct[i];
   until (keypressed); (* Since "keypressed" is slow, the wave graphs will be distorted *)
   ch := readkey;
   portw[Address+(dacnum*2)] := 0;    (* set DAC to 0 output *)
end; (* sendtoport *)

(***************************************************************************
 *  FUNCTION: sinecurve - local routine                                    *
 *  PURPOSE: Calculate the points for creating a sine wave.               *
 ***************************************************************************)
procedure sinecurve;
var  i            : word;
     rads,sine    : real;

begin

   if counts = 0 then exit;           (* no point -- no curve *)

   clrscr;
   writeln('Calculating sine wave points.....');

   rads := 2.0 * PI / counts;         (* rad per count *)

   for i := 1 to counts do
      begin
      sine := (sin(rads * (i - 1)) + 1.0) * 32767;
      progstruct[i] := trunc(sine);
      end;
   clrscr;
   writeln('Generating sine wave, press any key to stop....');
   sendtoport;
end;  (* sinecurve *)

(***************************************************************************
 *  FUNCTION: trianglecurve - local routine                                *
 *  PURPOSE: Calculate the points for creating a triangle wave.           *
 ***************************************************************************)
procedure trianglecurve;
var   i           : word;
      slope,temp  : real;

begin

   if counts = 0 then exit;            (* no counts -- no curve *)

   clrscr;
   writeln('Calculating triangle wave points.....');

   slope := 65535.0 / counts * 2.0;
				       (* wave form slope       *)
   for i := 1 to counts div 2 do
      begin
      temp := slope * i;
      progstruct[i] := trunc(temp);
      temp := 65535 - temp;
      progstruct[i + counts div 2] := trunc(temp);
      end;
   clrscr;
   writeln('Generating triangle wave, press any key to stop....');
   sendtoport;
end; (* trianglecurve *)

(***************************************************************************
 *  FUNCTION: sawcurve - local routine                                     *
 *  PURPOSE: Calculate the points for creating a saw tooth wave.          *
 ***************************************************************************)
procedure sawcurve;

var  i            :word;
     slope,temp   :real;

begin

   if counts = 0 then exit;

   clrscr;
   writeln('Calculating saw tooth wave points.....');

   slope := 65535.0 / counts;       (* saw tooth slope *)
   for i := 1 to counts do
      begin
      temp := slope * i;
      progstruct[i] := trunc(temp);
      progstruct[i] := progstruct[i] mod 65536;
      end;
   clrscr;
   writeln('Generating saw tooth wave, press any key to stop....');
   sendtoport;
end; (* sawcurve *)

(***************************************************************************
 *  FUNCTION: menulist - local routine                                     *
 *  PURPOSE: Display the menu choise on the screen.                       *
 ***************************************************************************)
procedure menulist;

begin
   clrscr;
   writeln;writeln;writeln;
   writeln('Your menu selections are: ');
   writeln('1. Input Board Data  (do this first)');
   writeln('2. Sine curve');
   writeln('3. Triangle curve');
   writeln('4. Saw curve');
   writeln('5. End program, return to DOS');
   write('Input Choice: ');
   readln(menuchoice);
end; (*menulist *)

(***************************************************************************
 *  FUNCTION: main - local routine                                         *
 *  PURPOSE: Controls program execution.                                  *
 ***************************************************************************)
var
  Channel : word;
begin
   clrscr;
   writeln('                         SAMPLE2.PAS : D/A16-16                       ');
   writeln('                                                                         ');
   writeln('  This sample will generate 3 different wave forms, sine, triangle and   ');
   writeln('  saw tooth.  The user has the choice of base address, DAC number and the');
   writeln('  number of points per cycle.                                            ');
   writeln;
   writeln('  Board Configuration:                                                   ');
   writeln;
   writeln('  -- Base address should be set to the address which will be entered     ');
   writeln('     during program execution.                                           ');
   writeln('  -- The board should be set to bipolar mode   (required)');
   writeln('  -- All remaining jumper settings are irrelevant.                       ');
   writeln;
   writeln;
   writeln;
   writeln('Press ENTER to continue');
   readln;

    (* Set all sixteen buffers to 0 *)
    for Channel := 0 to 15 Do PortW[Address + Channel * 2] := $8000;

    (* Take card out of simultaneous update mode and update all channels *)
    Channel := Port[Address + 10];

   clrscr;
   repeat
      fillchar(progstruct,sizeof(progstruct),0); (* clear buffer               *)
      menulist;                                  (* display the menu           *)
      case menuchoice of                         (* execute the menu selection *)
         '1': setparms;               (* fetch the system params    *)
         '2': sinecurve;              (* generate a sine wave       *)
         '3': trianglecurve;          (* generate a triangle wave   *)
         '4': sawcurve;               (* generate a saw tooth wave  *)
         end;
   until (menuchoice = '5');
end.  (* main *)