(***************************************************************************
 *                    Pascal SAMPLE #2: SAMPLE2.PAS                        *
 *                                                                         *
 *  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 the the address entered during       *
 *         program execution.                                              *
 *                                                                         *
 ***************************************************************************)


program sample2;

uses crt;

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

   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.                                         *
 *                                                                         *
 *     INPUT: None.                                                        *
 *                                                                         *
 *     CALLS: None.                                                        *
 *                                                                         *
 *    OUTPUT: None.                                                        *
 *                                                                         *
 ***************************************************************************)

procedure setparms;
var
   ch   : char;
   code : integer;

begin
   ClrScr;
   Address := AskForBaseAddress('300');
   repeat
      GotoXY (1,7);
      ClrEol;
      Write('Enter the DAC number (0 to 3 only): ');
      ch := ReadKey;
      WriteLn(ch);
      val(ch,dacnum,code);
   until (dacnum>=0) and (dacnum<=3);
   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.   *
 *                                                                         *
 *     INPUT: None.                                                        *
 *                                                                         *
 *     CALLS: None.                                                        *
 *                                                                         *
 *    OUTPUT: None.                                                        *
 *                                                                         *
 ***************************************************************************)


procedure sendtoport;
var
   i   :word;
   ch  :char;

begin

   repeat
      for i := 1 to counts do
         begin
            PortW[Address+4+(2*dacnum)] := progstruct[i];
         end;
   until (keypressed);
   ch := readkey;
   PortW[Address+4+(2*dacnum)] := 0;   (* Set DAC to 0 output *)
end; (* sendtoport *)

(***************************************************************************
 *                                                                         *
 *  FUNCTION: sinecurve - local routine                                    *
 *                                                                         *
 *   PURPOSE: Calculate the points for creating a sine wave.               *
 *                                                                         *
 *     INPUT: None.                                                        *
 *                                                                         *
 *     CALLS: None.                                                        *
 *                                                                         *
 *    OUTPUT: None.                                                        *
 *                                                                         *
 ***************************************************************************)


procedure sinecurve;
var
   i          : word;
   rads, sine : real;

begin

   if counts = 0 then exit;           (* no counts -- 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) * 2047;
         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.           *
 *                                                                         *
 *     INPUT: None.                                                        *
 *                                                                         *
 *     CALLS: None.                                                        *
 *                                                                         *
 *    OUTPUT: None.                                                        *
 *                                                                         *
 ***************************************************************************)


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 := 4095.0 / counts * 2.0;    (* wave form slope *)
   for I := 1 to counts div 2 do
      begin
         temp := slope * i;
         progstruct[i] := trunc(temp);
         temp := 4095 - 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.          *
 *                                                                         *
 *     INPUT: None.                                                        *
 *                                                                         *
 *     CALLS: None.                                                        *
 *                                                                         *
 *    OUTPUT: None.                                                        *
 *                                                                         *
 ***************************************************************************)


procedure sawcurve;
var
   i           : word;
   slope, temp : real;

begin

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

   ClrScr;
   WriteLn('Calculating saw tooth wave points.....');
   slope := 4095.0 / counts;         (* saw tooth slope *)
   for I := 1 to counts do
      begin
         temp := slope * i;
         progstruct[i] := trunc(temp);
         progstruct[i] := progstruct[i] mod 4096;
      end;
   ClrScr;
   WriteLn('Generating saw tooth wave, press any key to stop....');
   sendtoport;
end; (* saw curve *)

(***************************************************************************
 *                                                                         *
 *  FUNCTION: menulist - local routine                                     *
 *                                                                         *
 *   PURPOSE: Display the menu choise on the screen.                       *
 *                                                                         *
 *     INPUT: None.                                                        *
 *                                                                         *
 *     CALLS: None.                                                        *
 *                                                                         *
 *    OUTPUT: None.                                                        *
 *                                                                         *
 ***************************************************************************)


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: ');
   menuchoice := ReadKey;
end; (* menulist *)

(***************************************************************************
 *                                                                         *
 *  FUNCTION: main - local routine                                         *
 *                                                                         *
 *   PURPOSE: Controls program execution.                                  *
 *                                                                         *
 *     INPUT: None.                                                        *
 *                                                                         *
 *     CALLS: None.                                                        *
 *                                                                         *
 *    OUTPUT: None.                                                        *
 *                                                                         *
 ***************************************************************************)
begin
   ClrScr;
   WriteLn('                    Pascal SAMPLE #2: SAMPLE2.PAS                        ');
   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;
   WriteLn;
   WriteLn;
   WriteLn('Press ENTER to continue');
   ReadLn;
   ClrScr;
   repeat
      fillchar(progstruct,sizeof(progstruct),0); (* clear buffer               *)
      menulist;                                  (* display the menu           *)
      case menuchoice of                         (* execute the menu selection *)
         '1': begin
                 setparms;            (* fetch the system params    *)
                 Port[Address+4] := 0;       (* Set DAC to 0 output *)
                 Port[Address+6] := 0;       (* Set DAC to 0 output *)
                 Port[Address+8] := 0;       (* Set DAC to 0 output *)
                 Port[Address+$0A] := 0;     (* Set DAC to 0 output *)
              end;
         '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 *)