' *********************************************** ' * Debug code for GMT * ' * * ' * This module is only included if the * ' * compilation of the metaconstant %Debug is * ' * defined in the main GMT module. * ' * none of this code is required to run GMT * ' *********************************************** GLOBAL gList() AS STRING * 80 ' replaces dos screen layout for listwindow. moved to debug 01.04.2000 GLOBAL hListWnd AS LONG ' Win32api handle for the general use display window. moved to debug 01.04.2000 DECLARE SUB MakeListWindow () ' callback message handler for listing and selection window DECLARE FUNCTION LstProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG)AS LONG DECLARE SUB InitDebug () DECLARE SUB DebugTask () DECLARE SUB SxTask () DECLARE SUB SxInTask () DECLARE SUB GetProteusDump () SUB InitDebug () LOCAL i AS DWORD ' globals for text messaging in user window: ' used in module gmt_debug as well as in the procedure wPrint DIM gList(24) AS GLOBAL STRING * 80 FOR i = 0 TO UBOUND(gList) gList(i) = STRING$(80,32) ' fill with spaces. NEXT i ' insert the initialisation code here... IF App.DebugTaskNr > -1 THEN Task(App.DebugTaskNr).cPtr = CODEPTR(DebugTask) Task(App.DebugTaskNr).freq = 16 Task(App.DebugTaskNr).naam = "debug" END IF Task(20).cPtr = CODEPTR(SXtask) Task(20).freq = 0.2 Task(20).naam = "SXsend" Task(21).cPtr = CODEPTR(SXinTask) Task(21).freq = 50 Task(21).naam = "SX-IN" Task(22).naam = "ProtDump" Task(22).freq = 1 Task(22).cPtr = CODEPTR(GetProteusDump) END SUB SUB DebugTask IF (Task(App.DebugTaskNr).swit AND %TASK_BUSY) = %d1 THEN wPrint %False, glist() EXIT SUB END IF IF ISFALSE Task(App.DebugTaskNr).tog THEN Task(App.DebugTaskNr).tog = %True 'IF ISFALSE hListWnd THEN ' MakeListWindow if you want to create a non proportional blue window. 'END IF wprint %true, glist() EXIT SUB END IF ' your debug code... ' example: STATIC ArCheck AS LONG #IF %DEF(%Bom) IF ISFALSE ArCheck THEN CALL CheckDataArrays ArCheck = %True END IF #ENDIF wprint 1, glist() ' prints the contents of glist END SUB SUB SXtask STATIC COUNT AS BYTE ' written to test sysex receive in the midi module. ' This needs 2 PC's, or a loop cable midi-in to midi-out. SysEx hMidiO(0), CHR$(&HF0,COUNT,49 + (RND(1)*30),50,51,52,53,54,55,56,57,58,59,&HF7) INCR COUNT COUNT = COUNT AND &H7F END SUB SUB SXinTask LOCAL i AS LONG LOCAL tmp AS STRING LOCAL tmp1 AS STRING LOCAL retval AS LONG LOCAL b AS BYTE STATIC COUNT AS DWORD STATIC f AS DWORD STATIC tog AS BYTE IF ISFALSE tog THEN IF ISFALSE hMidiI(0) THEN EXIT SUB f = FREEFILE OPEN "SX-tst.bin" FOR APPEND AS #f PRINT #f, "Sys-ex dump produced by SXinTask in module debug" & " " & DATE$ & " " & TIME$ tog = %True END IF tmp1 = GetSysEx (0, %Oldest OR %Remove) IF tmp1 <> "" THEN INCR COUNT SetDlgItemText gh.Cockpit, %GMT_TEXT0_ID + 10, STR$(COUNT) PRINT #f, tmp1 FOR i = 1 TO LEN(tmp1) tmp = tmp & " " & HEX$(ASC((MID$(tmp1,i,1)))) NEXT i glist(0) = "Debug sysex procedure" glist(1 + (COUNT MOD (UBOUND(glist)-1))) = tmp PRINT #f, tmp wPrint %True, glist() END IF END SUB SUB GetProteusDump () STATIC COUNT AS BYTE LOCAL ID AS BYTE IF ISFALSE Task(21).swit THEN starttask 21 ID = %False ' SysEx hMidiO(0), CHR$(&HF0,&H18,4,id,0,&H7F,&H7F,&HF7) ' request all user presets SysEx hMidiO(0), CHR$(&HF0,&H18,4,ID,8,&HF7) ' master settings INCR COUNT COUNT = COUNT AND &H7F Stoptask 22 END SUB SUB MakeListWindow () EXPORT LOCAL msg AS tagMSG LOCAL wc AS WndClassEx LOCAL szClassName AS ASCIIZ * 10 LOCAL dwExStyle AS DWORD szClassName = "LISTING" wc.cbSize = SIZEOF(wc) wc.style = %CS_HREDRAW OR %CS_VREDRAW wc.lpfnWndProc = CODEPTR(LstProc) wc.cbClsExtra = 0 wc.cbWndExtra = 0 wc.hInstance = gh.Inst wc.hIcon = App.hIcon wc.hCursor = LoadCursor( %NULL, BYVAL %IDC_ARROW ) wc.hbrBackground = GetStockObject(%WHITE_BRUSH) wc.lpszMenuName = %NULL wc.lpszClassName = VARPTR( szClassName ) wc.hIconSm = App.hIcon RegisterClassEx wc dwExStyle = %WS_EX_APPWINDOW ' Now, create a window using the registered class gh.List= CreateWindowEx(BYVAL dwExStyle,_ szClassName, _ ' window class name " user feedback window ", _ ' window caption %WS_OVERLAPPEDWINDOW, _ ' window style 1, _ ' initial x position 1, _ ' initial y position 200, _ ' initial x size 130, _ ' initial y size %NULL, _ '%HWND_DESKTOP, _ ' parent window handle %NULL, _ ' window menu handle gh.Inst, _ ' program instance handle BYVAL %NULL) ' creation parameters ' Display the window on the screen ShowWindow gh.List, %SW_SHOW UpdateWindow gh.List ' wPrint %True, glist() - print to a dialog list END SUB FUNCTION LstProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _ BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG ' callback function with message loop for list window LOCAL hDC AS LONG LOCAL LpPaint AS PaintStruct LOCAL tRect AS Rect LOCAL i AS LONG FUNCTION = 0 SELECT CASE wMsg ' CASE %WM_CREATE ' SendMessage hWnd, %WM_PAINT, 0, 0 ' EXIT FUNCTION CASE %WM_SIZE InvalidateRect hWnd, BYVAL %False, BYVAL %True CASE %WM_PAINT hDC = BeginPaint(hWnd, lpPaint) SetTextColor hDC, &H0000FFFF 'yellow ' &H0003F010 ' GREEN SetBkColor hDC,&H00FF0000 'Blue '&H000000FF ' RED GetClientRect hWnd, tRect FOR i = 0 TO UBOUND(glist) IF TRIM$(gList(i)) = "" THEN TextOut hDC, 1, 1 + (i* 16), STRING$(80," "),80 ' 16 is minimum heigth for the font set in our resource. ELSE TextOut hDC, 1, 1 + (i* 16), glist(i)+ CHR$(0), LEN(glist(i)) END IF NEXT i EndPaint hWnd, LpPaint EXIT FUNCTION END SELECT ' other msg's handled by the default handler: FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam) END FUNCTION '[EOF]