(*************************************************************************** * 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. * * * * LAST MODIFICATION: 2/5/98 * * * ***************************************************************************) 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. * * * * INPUT: None. * * * * CALLS: None. * * * * OUTPUT: None. * * * ***************************************************************************) procedure setparms; var code:integer; ch : char; begin ClrScr; Address := AskForBaseAddress('350'); WriteLn; repeat GotoXY (1,7); ClrEol; Write('Enter the DAC number (0 or 1 only): '); ch:= ReadKey; WriteLn(ch); val(ch,dacnum,code); until (dacnum=0) or (dacnum=1); 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,temp :word; lowbyte,hibyte :byte; ch :char; begin (* each point is broken into the hi byte and low byte, and then written to the DAC into two seperate bytes. *) repeat for i := 1 to counts do begin temp := progstruct[i] mod 256; lowbyte := temp; temp := progstruct[i] div 256; hibyte := temp; port[Address+(dacnum*2)] := lowbyte; port[Address+(dacnum*2+1)] := hibyte; end; until (keypressed); ch := readkey; port[Address+(dacnum*2)] := 0; (* set DAC to 0 output *) port[Address+(dacnum*2+1)] := 0; 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 * 16); 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 * 16); temp := 4095 - temp; progstruct[i + counts div 2] := trunc(temp * 16); 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 4096; progstruct[i] := progstruct[i] * 16; 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. * * * ***************************************************************************) BEGIN ClrScr; WriteLn(' SAMPLE2.PAS : DA-02A'); 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; WriteLn('Board Configuration:'); WriteLn; WriteLn('-- Base address should be set to the address which will be entered during'); WriteLn(' program execution'); WriteLn('-- All remaining jumper settings are irrelevant'); 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': 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 *)