' Declarations Const MAXBUFLEN = 3800 ' note: this limit imposed by use of graph control Dim Buffer(MAXBUFLEN) As Integer ' analog input data buffer Dim hEngine As Integer ' engine handle Dim hBoard As Integer ' board handle Dim fBoardInitialized As Integer ' valid if board installed and responding correctly Dim uMemArch As Integer ' type of DSP memory architecture Dim dwBufferBaseAddr As Long ' starting analog data buffer address Dim nCurBuf As Integer ' current analog I/O buffer Dim wBuflen As Integer ' buffer length Dim FsDesired,FsActual As Single ' desired and actual sampling frequency (Hz) Dim fRunning As Integer ' current board state in dscope example ' *** Form Load Procedure ******************* Sub Form_Load () Dim ret As Integer Dim dw As Long Dim BoardStr As String * 150 Dim wBoardClass As Integer Dim dwFsMode As Long Dim dwMemSize As Long Dim dwFsActual As Long Static ChanList(MAXCHAN) As Integer ' init some of the variables declared in general section hEngine = 0 hBoard = 0 fBoardInitialized = 0 wBuflen = 1024 nCurBuf = 0 VScale = 1 ' initial display vertical scale factor VOffset = 0 ' initial display vertical offset FsDesired = 20000! ' desired sampling frequency in Hz ' init local variables For i = 0 To (MAXCHAN - 1) ChanList(i) = i Next ret = DSInitToollib() ' initialize tool library needed by Hardware Selector DSShowEngMgrStatusWindow ' enable Engine Manager status window ' show Hardware Selector, let user make a board choice If DSShowHardwareSelectorDlg(0, BoardStr) = IDCANCEL Then GoTo Abort End If ' Open DSP engine hEngine = DSEngineOpen(ByVal DS_EO_HSM, ByVal 0&) ' try Hypersignal-Macro first If (hEngine = 0) Then hEngine = DSEngineOpen(ByVal DS_EO_HSA, ByVal 0&) ' try Hypersignal-Acoustic next If hEngine = 0 Then tmpstr = Str$(DSGetHWLibErrorStatus()) tmpstr = "DSEngineOpen error code=" + tmpstr MsgBox tmpstr, MB_OK, "DScope Test Prog" GoTo Abort End If End If ' Assign a board handle hBoard = DSAssignBoard(hEngine, ByVal BoardStr, 0, 0, 0) ' use defaults for bus type and I/O and Mem base addresses ' Initialize the board and check to see if it is responding fBoardInitialized = DSInitBoard(hBoard) If (fBoardInitialized = NUL) Then tmpstr = Str$(DSGetHWLibErrorStatus()) tmpstr = "DSInitBoard error code=" + tmpstr MsgBox tmpstr, MB_OK, "DScope Test Prog" GoTo Abort End If ' interrogate engine for board type values wBoardClass = DSGetBoardClass(hBoard) ' get memory architecture uMemArch = DSGetMemArch(hBoard) If (uMemArch = NUL) Then MsgBox "DSGetMemArch failed", MB_OK, "DScope Test Prog" GoTo Abort End If ' determine sampling rate ctrl. reg. value, and actual rate (closest rate possible to desired); ' CalcSampFreq returns ctrl. reg. value directly, uses ptr to return actual sampling frequency (in Hz) dwFsMode = DSCalcSampFreq(hBoard, FsDesired, 1, ChanList(0), FsActual) ' demo assumes 1 channel, initial value 20 kHz ' load executable DSP code file (usually a COFF file produced by DSP manufacturer's linker) ret = DSLoadFileProcessor(hBoard, ByVal 0&, &H1) If (ret = NUL) Then ' load default file for the board type (processor 0 only) MsgBox "DSLoadFile: problem loading file", MB_OK, "Dscope Test Prog" GoTo Abort End If ' get the memory size, (note that this currently has to be done after a call to LoadFile) dwMemSize = DSGetMemSize(hBoard, &H1) ' processor 0 only ' reset the DSP board (should already be in reset state; processor 0 only) ret = DSResetProcessor(hBoard, &H1) ' send down some important variables (needed if a default DSP Source Code is being used) ret = DSPutHVarMem(hBoard, DSP_BOARDCLASS, wBoardClass And &HFF) ' main type in low byte ret = DSPutHVarMem(hBoard, DSP_BOARDSUBCLASS, Shift(wBoardClass, -8)) ' subtype in high byte ret = DSPutHVarMem(hBoard, DSP_OPMODE, 2) ' Dig. Scope is mode 2 ret = DSPutHVarMem(hBoard, DSP_FILTTYPE1, 0) ' disable trace 1 real-time filter ret = DSPutHVarMem(hBoard, DSP_FILTTYPE2, 0) ' disable trace 2 real-time filter ret = DSPutHVarMem(hBoard, DSP_TRIGLEVEL, 0) ' free-run triggering ret = DSPutHVarMem(hBoard, DSP_TRIGCHANLIST, 0) ret = DSPutHVarMem(hBoard, DSP_BUFLEN, wBuflen) ' buffer size ret = DSPutHVarMem(hBoard, DSP_HOSTBUFNUM, 0) ret = DSPutHVarMem(hBoard, DSP_BUFNUM, 0) ret = DSPutHVarMem(hBoard, DSP_CHANLIST, 0) ' starting channel ret = DSPutHVarMem(hBoard, DSP_NUMCHAN, 1) ' number of channels ret = DSPutHVarMem(hBoard, DSP_GAINLIST, 0) ' gain list ret = DSPutHVarMem(hBoard, DSP_FSMODE, dwFsMode) ' sampling rate control register (mode value) dwFsActual = FsActual ret = DSPutHVarMem(hBoard, DSP_FSVALUE, dwFsActual) ' actual sampling rate (in Hz) ' get address of input time domain data dwBufferBaseAddr = DSGetHVarMem(hBoard, DSP_TIMDATAADDR) ' turn the board loose... (processor 0 only) ret = DSRunProcessor(hBoard, &H1) ' set the message blaster (MSGBLAST.VBX) to capture buffer ready messages from the DSP engine Buffer_Ready.hWndTarget = scope_window.hWnd Buffer_Ready.MsgList(0) = WM_DSPENGINE_BUFRDY ' register handle of graph window with engine, to receive "buffer ready" messages ret = DSRegisterEngineMsgWnd(hEngine, DS_REMW_SETDSPDATARDYMSG, scope_window.hWnd) ' register callback window for buffer ready messages ' tell the engine to wait for a buffer, and then start sending BUFRDY messages to registered window when analog data ready ret = DSWaitForBuffer(hBoard, 0, 0&, DS_WFB_POLLED) fRunning = True ' set internal board state flag ' set initial onscreen scrollbars and buttons TimeBase_Scroll.Value = wBuflen Offset_Scroll.Value = 50 ' offset bar is in % RunBoard.Value = True Exit Sub ' proceed with normal execution Abort: ' error condition / init. problem has occurred: abort Form_Unload (IDOK) End Sub
' *** Buffer Ready Event Processing *************** Sub Buffer_Ready_Message (MsgVal As Integer, wParam As Integer, lParam As Long, ReturnVal As Long) Dim uStatus As Integer Dim ret As Integer If (MsgVal = WM_DSPENGINE_BUFRDY) Then ' transfer below illustrates two common type of DSP memory architectures If (uMemArch = DS_GMA_VECTOR) Then ' vector data memory If (nCurBuf = 0) Then uStatus = DSGetMem(hBoard, DS_GM_VECTOR_DATA_X, dwBufferBaseAddr, DS_GM_SIZE16, Buffer(0), wBuflen) Else uStatus = DSGetMem(hBoard, DS_GM_VECTOR_DATA_Y, dwBufferBaseAddr, DS_GM_SIZE16, Buffer(0), wBuflen) End If Else ' linear data/prog memory, or modified harvard arch. with linear data memory uStatus = DSGetMem(hBoard, DS_GM_LINEAR_DATA_RT, dwBufferBaseAddr + nCurBuf * wBuflen, DS_GM_SIZE16, Buffer(0), wBuflen) End If If (uStatus = NUL) Then MsgBox "DSGetMem: problem with point transfer", MB_OK, "Dscope Test Prog" End If nCurBuf = nCurBuf Xor 1 ' switch buffers ret = DSPutHVarMem(hBoard, DSP_HOSTBUFNUM, nCurBuf) ' write the new buffer # ' instruct engine to wait for next buffer ret = DSWaitForBuffer(hBoard, nCurBuf, 0&, DS_WFB_POLLED) ' show 'em! (input data points) DisplayBufferData End If End Sub ' *** Waveform Data Display ******************* Sub DisplayBufferData () ' update the scope window with data currently in Buffer scope_window.NumSets = 1 scope_window.ThisSet = 1 scope_window.ThisPoint = 1 scope_window.NumPoints = wBuflen scope_window.AutoInc = 1 For i = 0 To wBuflen - 1 scope_window.GraphData = Buffer(i) * VScale + VOffset Next scope_window.DrawMode = 3 ' Blt to screen, to avoid flicker End Sub ' *** Form Unload Procedure ******************* Sub Form_Unload (Cancel As Integer) Dim ret As Integer ' free board, close engine if needed If (hBoard <> 0) And (fRunning = True) Then ret = DSCancelWaitBuffer(hBoard, nCurBuf) End If If (fBoardInitialized <> 0) Then ret = DSDisableBoard(hBoard) End If If (hBoard <> 0) Then ret = DSFreeBoard(hBoard) End If If (hEngine <> 0) Then ret = DSEngineClose(hEngine) End If End ' shut-down app End Sub