(***************************************************************************
 *                    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.                                            *
 *                                                                         *
 *                                                                         *
 *  LAST MODIFICATION: 2/5/98                                         SMG  *
 *                                                                         *
 ***************************************************************************)
Program Sample2;

Uses
    Crt;

Const
    DefaultBase = '$340';
    pi = 3.1415927;

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

(****************************************************************************
 *                                                                          *
 *  FUNCTION: Deci                                                          *
 *                                                                          *
 *   PURPOSE: Convert a decimal string into a hex word.                     *
 *                                                                          *
 *   INPUT: A decimal string.                                               *
 *                                                                          *
 *   CALLS: None.                                                           *
 *                                                                          *
 *   OUTPUT: Hexidecimal word.                                              *
 *                                                                          *
 ****************************************************************************)
Function Deci(DS : String) : Word;
var
   BS : String;
   Er : Integer;
   DI : Word;
begin
   BS := '$' + DS;
   Val(BS, DI, Er);
   Deci := DI;
end;

(****************************************************************************
 *                                                                          *
 *  FUNCTION: Hex                                                           *
 *                                                                          *
 *   PURPOSE: Convert a hex word into a hex string.                         *
 *                                                                          *
 *   INPUT: Hex word.                                                       *
 *                                                                          *
 *   CALLS: None.                                                           *
 *                                                                          *
 *   OUTPUT: Hex string.                                                    *
 *                                                                          *
 ****************************************************************************)
Function Hex(BB : Word) : String;
var
   AA, CC   : Byte;
   DD       : String;
   HexTable : String;
begin
   HexTable := '0123456789ABCDEF';
   DD := '000';
   DD[3] := HexTable[(BB AND $00F) + 1];
   DD[2] := HexTable[((BB AND $0F0) SHR 4) + 1];
   DD[1] := HexTable[((BB AND $F00) SHR 8) + 1];
   Hex := DD;
end;

(****************************************************************************
 *                                                                          *
 *  FUNCTION: AskForBaseAddress                                             *
 *                                                                          *
 *   PURPOSE: Prompt user for card base address.                            *
 *                                                                          *
 *   INPUT: None.                                                           *
 *                                                                          *
 *   CALLS: Deci                                                            *
 *          Hex                                                             *
 *                                                                          *
 *   OUTPUT: None.                                                          *
 *                                                                          *
 ****************************************************************************)
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: Intro                                                         *
 *                                                                          *
 *   PURPOSE: Display introductory information and prompt for base address. *
 *                                                                          *
 *     INPUT: None.                                                         *
 *                                                                          *
 *     CALLS: AskForBaseAddress                                             *
 *                                                                          *
 *    OUTPUT: None.                                                         *
 *                                                                          *
 ****************************************************************************)
Procedure Intro;
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;
Writeln('Press ENTER to set base address');
Readln;

 ClrScr;
 Base := AskForBaseAddress( DefaultBase );
 ClrScr;
end; (* of Intro *)


(***************************************************************************
 *                                                                         *
 *  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;

begin
ClrScr;
Writeln;
Write('Enter the DAC number you wish to output to (0 through 15): ');
Readln(dacnum);
dacnum := dacnum mod 16;
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,temp           : Word;
    ch               : Char;

begin
    repeat
        for i := 1 to counts do
            PortW[base+(dacnum*2)] := progstruct[i];
    until (keypressed);
    ch := Readkey;
    PortW[base+(dacnum*2)] := 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 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) * 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;

    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 4095;
        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.                       *
 *                                                                         *
 *     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: ');
    Readln(menuchoice);
end; (*menulist *)

(***************************************************************************
 *                                                                         *
 *  FUNCTION: main - local routine                                         *
 *                                                                         *
 *   PURPOSE: Controls program execution.                                  *
 *                                                                         *
 *     INPUT: None.                                                        *
 *                                                                         *
 *     CALLS: None.                                                        *
 *                                                                         *
 *    OUTPUT: None.                                                        *
 *                                                                         *
 ***************************************************************************)
Var
    Channel : Word;
Begin
    Intro;

    (* Set all sixteen buffers to 0 *)
    for Channel := 0 to 16 do
        PortW[base + Channel * 2] := 0;

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

    (* Release zero latch *)
    Channel := Port[base + 15];

    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');

    Writeln('DA12-16 sample #2 complete.');
end.  (* main *)