' ***************************************** ' * g_glib.bas : source code for * ' * g_glib.dll * ' * dll procedures for * ' * Godfried-Willem Raes compositions. * ' * Version 11.00 * ' ***************************************** ' 31.08.2008: changed for PB 9.00 compiler. Variable name point changed to ppoint. ' 01.06.2009: rechecked for GMT V10.0 ' 07.06.2009: compile check for NiDAQmx ' 07.07.2009: DrawRadarTriangle can be used to display the doppler radar under NiDAQmx. ' 30.03.2011: PBWin 10 compiler upgrade #COMPILER PBWIN 10 ' Compile with PBWIN 10.00 #COMPILE DLL "g_glib.dll" #OPTION VERSION5 ' compile for 98, not Windows2000 and/or NT5 #REGISTER ALL #DIM ALL #INCLUDE ONCE "..\winapi\g_win.inc" 'Win32api.inc" #INCLUDE ONCE "g_kons.bi" ' integer and string constants #INCLUDE ONCE "g_type.bi" ' our own structures, user defined types #INCLUDE ONCE "g_indep.bi" '#INCLUDE once "g_net.bi" ' not required in here. '#INCLUDE once "g_lib.bi" ' loads the library DLL, by including its public declarations. %g_glib_inc = %True #INCLUDE ONCE "g_glib.bi" ' declarations. 'the following creates a dependency from g_lib, but then, it's not likely that any function here will ' be used in an application that doesn't use g_lib.. DECLARE FUNCTION GetAX3SensorPointer LIB "g_lib.dll" (BYVAL nr AS LONG, BYVAL listentasknr AS LONG) AS DWORD DECLARE FUNCTION GetPir2SensorPointer LIB "g_lib.dll" (BYVAL nr AS LONG, BYVAL listentasknr AS LONG) AS DWORD ' string constants: $consult = "consult the composer to get the proper software version" $visit = "Visit: " & $WEBSITE $g_email = "e-mail to: " & $email $needrobots = "This piece also requires the authors musical automats" $needii = "this piece can only be performed using the authors invisible instrument" $needradar = "this piece can only be performed using the authors radar installation" $setup_error = "-Setup error" & CHR$(0) GLOBAL hInst AS LONG ' instance handle of this dll FUNCTION LIBMAIN(BYVAL h AS LONG, _ BYVAL fwdReason AS LONG, _ BYVAL lpvReserved AS LONG) EXPORT AS LONG FUNCTION = %True SELECT CASE fwdReason CASE %DLL_PROCESS_ATTACH hInst = h CASE %DLL_PROCESS_DETACH, %DLL_THREAD_ATTACH , %DLL_THREAD_DETACH ' niks CASE ELSE FUNCTION = %False END SELECT END FUNCTION SUB MissingCode (piece AS STRING) EXPORT LOCAL m AS ASCIIZ * 1023 LOCAL szTitelBox AS ASCIIZ * 50 SELECT CASE UCASE$(piece) ' CASE "WSBSERVER" ' szTitelBox = "- Server" ' m = "NT server code not in library" + CHR$(13) ' m = m + $consult + CHR$(13) ' m = m + $needrobots + $CRLF ' m = m + "as well as a separate Wintel PC running GMT for each automat" +$CRLF ' m = m + $visit & "tromp/index.html for more information" + $CRLF ' m = m + $g_email + CHR$(13,0) ' MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST ' CASE "SLAGWERK" ' szTitelBox = " ' m = "Robot control code not in library" + CHR$(13) ' m = m + $consult + CHR$(13) ' m = m + $needrobots + $CRLF ' m = m + " - - - - " + $CRLF ' m = m + $g_email + CHR$(13,0) ' m = m + $visit & "tromp/index.html for more information" + $CRLF ' MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "ZERHACKER" szTitelBox = "" m = " code not in library" + CHR$(13) m = m + $consult + CHR$(13) m = m + $g_email + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "FIDELC" szTitelBox = "" m = " code not in library" + CHR$(13) m = m + $consult + CHR$(13) m = m + $g_email + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "TECHNOFAUSTUS" szTitelBox = "" m = " code not in library" + CHR$(13) m = m + $consult + CHR$(13) m = m + "Specific hardware is required to perform this opera as well" + CHR$(13) m = m + $needii & CHR$(13) m = m + $g_email + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "LICKSTICK" szTitelBox = "" m = " code not in library" + CHR$(13) m = m + $consult + CHR$(13) m = m + $g_email + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "WOODSTOCK" szTitelbox = "" m = " code not in library" + CHR$(13) m = m + $consult + CHR$(13) m = m + $g_email + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "CELLOPI" szTitelBox = "" m = " code not in library" + CHR$(13) m = m + $consult + CHR$(13) m = m + $g_email + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "BAKLAVA" szTitelBox = "" m = " code not in library" + CHR$(13) m = m + $consult + CHR$(13) m = m + $g_email + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "TOVERFLUIT" szTitelBox = "" m = " code not in library" + CHR$(13) m = m + $consult + CHR$(13) m = m + "This piece can only be performed on the authors barrelorgans," + CHR$(13) m = m + "his player piano and an automated tuba..." + CHR$(13) m = m + $g_email + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "COHIBA" szTitelBox = "" m = " code not in library" + CHR$(13) m = m + $consult + CHR$(13) m = m + "as well as the score for the flutist!" + CHR$(13) m = m + $g_email + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "OBOTEK" szTitelBox = "" m = " code not in library" + CHR$(13) m = m + $consult + CHR$(13) m = m + $g_email + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "WOODSTOCKJAZZ" szTitelBox = "" m = " code not in library" + CHR$(13) m = m + $consult + CHR$(13) m = m + $g_email + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "BOXING" szTitelBox = "" m = " code not in library" + CHR$(13) m = m + "consult the composer to get the score for this stringquintet" + CHR$(13) m = m + $g_email + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "CDF747" szTitelBox = "" m = " code not in library" + CHR$(13) m = m+ "consult the composer to get the finished tape for this piece" + CHR$(13) m = m+ $g_email + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "SINCS" szTitelBox = "" m = " code not in library" + CHR$(13) m = m + "consult the composer to get the finished tape for this piece" + CHR$(13) m = m + $g_email + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "SHIFTS" szTitelBox = "" m = " code not found in GMT library" + CHR$(13) m = m + "consult the composer to get the CD-recording of this piece" + CHR$(13) m = m + "or, to get the complete score material for performances " + CHR$(13) m = m + "or, the software modules for real time electronic performances." + CHR$(13) m = m + $g_email + CHR$(13) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "GORGONIO" szTitelBox = "" m = " code not in library" + CHR$(13) m = m + "This composition can only be played on the authors barrelorgans" + CHR$(13) m = m + " and " + CHR$(13) m = m + "in combination with his Vorsetzer on the piano..." + CHR$(13) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "JUMPY" szTitelbox = "" m = " code not in library" + CHR$(13) m = m + "This composition can only be played on the authors playerpiano" + CHR$(13) m = m + "A CD recording is available on the Logos public domain label [LPD004]" + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "HYDROCEPHALLUS" m = " code not in library" + CHR$(13) m = m + "consult the composer to get the score for this piece" + CHR$(13) m = m + $g_email + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "BOM", "SONGBOOK" szTitelBox = " & " m = " & code not in library" + CHR$(13) m = m + $needii + CHR$(13) m = m + $g_email + CHR$(13) m = m + "http://www.logosfoundation.org/index.html" + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "II" szTitelBox = "" m = "M.I.M. code not in library" + CHR$(13) m = m & $needii & CHR$(13) m = m + "as acquired by the Brussels Instruments Museum " + CHR$(13) m = m + "http://logosfoundation.org/ii/gesture-instrument.html" + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "FALL95" szTitelBox = "" m = " code not in library" + CHR$(13) m = m + "This piece can only be performed on the authors player piano, in " + CHR$(13) m = m + "combination with a small instrumental ensemble conducted by the " + CHR$(13) m = m + "authors 'PolyMetronome' connected to the printer port. " + CHR$(13) m = m + "A CD recording of this piece is available, published together with the" + CHR$(13) m = m + "book 'Nieuwe Muziek in Vlaanderen' by Mark Delaere a.o." + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "SPRING94" szTitelBox = "" m = " code not in library" + CHR$(13) m = m + "A CD recording of this piece is available, published by XI, nr 117" + CHR$(13) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "PANATELLA" szTitelBox = "" m = " code not in library" + CHR$(13) m = m + $consult + CHR$(13) m = m + "as well as the score for the flutist!" + CHR$(13) m = m + $g_email + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "GESTROBO" szTitelBox = "" m = "Gestrobo code not in library" + CHR$(13) m = m & $needii & CHR$(13) m = m + "in combination with the M&M robot orchestra." + CHR$(13) m = m + "http://logosfoundation.org/ii/gesture-instrument.html" + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "QUADRADA" szTitelBox = "" m = "Quadrada code not in library" + CHR$(13) m = m & $needradar & CHR$(13) m = m + "in combination with the M&M robot orchestra." + CHR$(13) m = m + "http://logosfoundation.org/ii/quadrada.html" + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "SQE", "STO", "SQE_STO" szTitelBox = " and " m = "code not in library" + CHR$(13) m = m & $needradar & CHR$(13) m = m + "needs the M&M robot orchestra." + CHR$(13) ' m = m + "http://logosfoundation.org/ii/quadrada.html" + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST CASE "NAMUDA" szTitelBox = "" m = "Namuda code not in library" + CHR$(13) m = m & $needii & CHR$(13) m = m + "in combination with the M&M robot orchestra." + CHR$(13) m = m + "http://logosfoundation.org/ii/Namuda_123.pdf" + CHR$(13,0) MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST END SELECT END SUB SUB WrongSynth (p AS STRING) EXPORT ' this is no longer needed, since we now use a listbox presenting only appropriate ' synth choices for each piece... LOCAL szTitelbox AS ASCIIZ * 50 LOCAL m AS ASCIIZ * 1023 SELECT CASE p CASE "BAKLAVA" szTitelBox = "" m = " can only be performed by selecting a" + CHR$(13) m = m + "Proteus 2 or Proteus 2XR synthesizer (EMU)" + CHR$(13) m = m + "for rehearsals, or the robot orchestra for performance" + CHR$(13) m = m + "as well as a Roland Pitch to Midi convertor" + CHR$(13,0) CASE "TECHNOFAUSTUS" szTitelBox = "" m = " requires all of the composers robots:" + CHR$(13) m = m + "Klung, Rotomoton, Piperola, Troms, Vox Humanola, Trump," + CHR$(13) m = m + "player piano, Harma, Springers, Vibi, AutoSax, Dripper," + CHR$(13) m = m + "Bourdonola, Invisible Instrument, CQT-device..." + CHR$(13,0) CASE "LICKSTICK" szTitelBox = "" m = " can only be performed by selecting a" + CHR$(13) m = m + "Proteus 2/3 or Proteus 2XR/3XR synthesizer (EMU)" + CHR$(13) m = m + "as well as a Roland Pitch to Midi convertor" + CHR$(13,0) CASE "WOODSTOCK" szTitelBox = "" m = " can only be performed by selecting a" + CHR$(13) m = m + "Proteus 2/3 or Proteus 2XR/3XR synthesizer (EMU)" + CHR$(13) m = m + "as well as a Roland Pitch to Midi convertor" + CHR$(13,0) CASE "CELLOPI" szTitelBox = "" m = " can only be performed by selecting a" + CHR$(13) m = m + "Proteus 2 or Proteus 2XR synthesizer (EMU)" + CHR$(13) m = m + "as well as a Roland Pitch to Midi convertor" + CHR$(13,0) CASE "TOVERFLUIT" szTitelBox = "" m = " can only be performed using" + CHR$(13) m = m + "the authors barrelorgans, Vox Humanola, Piperola" + CHR$(13) m = m + "his player piano and an automated tuba..." + CHR$(13,0) CASE "COHIBA" szTitelBox = "" m = " can only be performed by selecting a" + CHR$(13) m = m + "Proteus 2 or Proteus 2XR synthesizer (EMU)" + CHR$(13) m = m + "as well as a Roland Pitch to Midi convertor" + CHR$(13,0) CASE "OBOTEK" szTitelBox = "" m = " can only be performed by selecting a" + CHR$(13) m = m + "Proteus 2 or Proteus 2XR synthesizer (EMU)" + CHR$(13) m = m + "as well as a Roland Pitch to Midi convertor" + CHR$(13,0) CASE "BOXING" szTitelBox = "" m = " can only be demonstated using an" + CHR$(13) m = m + "EMU Proteus 2 or Proteus 2XR synthesizer" + CHR$(13,0) CASE "CDF747" szTitelBox = "" m = " can only be performed by" + CHR$(13) m = m+ "an EMU Procussion Synthesizer module" + CHR$(13,0) CASE "SINCS" szTitelBox = "" m = " requires following midi devices:" + CHR$(13) m = m + "Cloudrider" + CHR$(13,0) CASE "SHIFTS" szTitelBox = "" m = " requires one of the following midi synthesizers:" + CHR$(13) m = m + "EMU : Proteus2, Proteus2XR, Proteus3, Proteus3XR" + CHR$(13) m = m + "EMU : Proteus2000, Proformance " + CHR$(13) m = m + "Raes-Trimpin player piano, Q&R playola" + CHR$(13) m = m + "Yamaha FB01, General Midi" + CHR$(13,0) CASE "GORGONIO" szTitelBox = "" m = " wrong midi device selected:" + CHR$(13) m = m + "This composition can only be played on the authors barrelorgans" + CHR$(13) m = m + " and " + CHR$(13) m = m + "in combination with his Vorsetzer on the piano..." + CHR$(13,0) CASE "JUMPY" szTitelbox = "" m = " requires you to select one of following midi devices:" + CHR$(13) m = m + "RAES-TRIMPIN playerpiano, Q&R playola " + CHR$(13,0) CASE "HYDROCEPHALLUS" szTitelbox = "" m = " requires as EMU Proteus2" + CHR$(13) m = m + "or EMU Proteus3 synthesizer" & CHR$(13,0) CASE "BOM", "SONGBOOK" szTitelBox = " & " m = " & require the EMU Proteus3" + CHR$(13) m = m + "or EMU Proteus3XR synthesizer as well as a Digitec " + CHR$(13) m = m + "TSR24 with PPI20 expansion board installed " + CHR$(13) m = m + "A roland pitch to midi convertor is needed as well" + CHR$(13,0) CASE "FALL95" szTitelBox = "" m = " requires you to select following devices:" + CHR$(13) m = m + "Polymetronome connected to a digital I/O port" + CHR$(13) m = m + "Proteus 2 or Proteus 2XR synthesizer for the demonstration only" + CHR$(13,0) CASE "PANATELLA" szTitelBox = "" m = " can only be performed by selecting a" + CHR$(13) m = m + "synthesizer in the menu. The configuration file" + CHR$(13) m = m + "\cohiba\panatella.dat should contain the data for the patches" + CHR$(13) m = m + "to be used for this piece." + CHR$(13) m = m + "Also a Roland Pitch to Midi convertor is required." + CHR$(13,0) END SELECT IF LEFT$(m,1) <> CHR$(0) THEN MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST END IF END SUB FUNCTION CheckConditions (App AS Applicationtype, hMidiI() AS DWORD ,hMidiO() AS DWORD) EXPORT AS LONG LOCAL szTitelbox AS ASCIIZ * 20 LOCAL m AS ASCIIZ * 200 LOCAL cnt AS LONG LOCAL i AS LONG FUNCTION = %True SELECT CASE App.id CASE %ID_EARY, %ID_PARADISO, %ID_TECHNOFAUSTUS, %ID_LITHOS, %ID_PROLOGOS, %ID_TEKNE, %ID_FAUSTTANGO, %ID_GNOS, %ID_FLEXES, %ID_WANDER, %ID_FAUST_DESCENT, %ID_FAUST_AUXARBRES IF ISFALSE hMidiO(0) THEN MSGBOX "5 Midi out ports required",,FUNCNAME$ FUNCTION = %False EXIT FUNCTION END IF szTitelbox = " setup error" m = "" IF ISFALSE hMidiI(0) THEN m = "You need a midi input device !" + $CRLF cnt = %False FOR i = 0 TO UBOUND(hMidiO) IF hMidiO(i) THEN INCR cnt NEXT i IF ISFALSE cnt THEN FUNCTION = %False: EXIT FUNCTION IF cnt < 5 THEN m = m & "You need to select 5 midi output ports !" + $CRLF IF m <> "" THEN MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST END IF 'FUNCTION = %False ' voorlopig geremd, voor ontwikkelingsdoeleinden... EXIT FUNCTION CASE %ID_II_ROBOTS IF ISFALSE hMidiO(0) THEN MSGBOX "Midi out port required",,FUNCNAME$ FUNCTION = %False EXIT FUNCTION END IF szTitelbox = " setup error" m = "" IF ISFALSE hMidiI(0) THEN m = "You need a midi input device !" + $CRLF cnt = %False FOR i = 0 TO UBOUND(hMidiO) IF hMidiO(i) THEN INCR cnt NEXT i IF cnt < 4 THEN m = m & "You need to select 4 midi output ports !" + $CRLF IF m <> "" THEN MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST END IF 'FUNCTION = %False ' voorlopig geremd, voor ontwikkelingsdoeleinden... EXIT FUNCTION CASE %ID_SPRING94 IF hMidiO(0) THEN FUNCTION = %True CASE %ID_QUADRADAR IF ISFALSE hMidiO(0) THEN MSGBOX "Midi out port required",,FUNCNAME$ FUNCTION = %False EXIT FUNCTION END IF cnt = %False FOR i = 0 TO UBOUND(hMidiO) IF hMidiO(i) THEN INCR cnt NEXT i szTitelbox = " setup error" m = "" IF cnt < 4 THEN m = m & "You need to select 4 midi output ports !" + $CRLF IF m <> "" THEN MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST END IF 'FUNCTION = %False ' voorlopig geremd, voor ontwikkelingsdoeleinden... EXIT FUNCTION FUNCTION = %True ' voorlopig, for development of code. CASE %ID_SQE_STO, %ID_SQE, %ID_STO szTitelbox = " setup error" cnt = %False FOR i = 0 TO UBOUND(hMidiO) IF hMidiO(i) THEN INCR cnt NEXT i IF cnt < 4 THEN m = m & "You need to select 4 midi output ports !" + $CRLF IF m <> "" THEN MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST END IF FUNCTION = %True CASE %ID_WOODSTOCKJAZZ szTitelbox = " setup error" cnt = %False FOR i = 0 TO UBOUND(hMidiO) IF hMidiO(i) THEN INCR cnt NEXT i IF cnt < 2 THEN m = m & "You need to select 2 midi output ports !" + $CRLF IF m <> "" THEN MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST END IF FUNCTION = %True CASE %ID_NAMUDA, %ID_DOPPLER szTitelbox = " setup error" cnt = %False FOR i = 0 TO UBOUND(hMidiO) IF hMidiO(i) THEN INCR cnt NEXT i IF cnt < 4 THEN m = m & "You need to select 4 midi output ports !" + $CRLF IF m <> "" THEN MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST END IF FUNCTION = %True CASE ELSE '... END SELECT END FUNCTION SUB ErrorMidiIn () EXPORT LOCAL m AS ASCIIZ * 32 m = "NO MIDI INPUT DEVICE SELECTED" + CHR$(13) MessageBox hInst,m, $setup_error,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST END SUB SUB ErrorMidiOut () EXPORT LOCAL m AS ASCIIZ * 32 m = "NO MIDI OUTPUT DEVICE SELECTED" + CHR$(13) MessageBox hInst,m, $setup_error,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST END SUB SUB ErrorWaveIn () EXPORT LOCAL m AS ASCIIZ * 32 m = "NO WAVE INPUT DEVICE SELECTED" + CHR$(13) MessageBox hInst,m, $setup_error,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST END SUB SUB ErrorWaveOut () EXPORT LOCAL m AS ASCIIZ * 32 m = "NO WAVE OUTPUT DEVICE SELECTED" + CHR$(13) MessageBox hInst,m, $setup_error,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST END SUB ' removed 11.06.2009 'SUB ErrorBom (BYVAL fout AS DWORD) EXPORT '' LOCAL m AS ASCIIZ * 255 ' LOCAL szTitelbox AS ASCIIZ * 30 ' SELECT CASE fout ' CASE 1 ' szTitelBox = "DAQ-Error" + CHR$(13) ' m = "No DAQ device selected or no DAQ device found" + CHR$(13)_ ' + "You can run neither ,, nor " + CHR$(13)_ ' + "without properly functioning data acquisition hardware." + CHR$(13)_ ' + "[Error generated by Prepare_DAQ_hardware in module g_h]" + CHR$(13) ' MessageBox hInst,m, szTitelbox,%MB_OK OR %MB_ICONSTOP OR %MB_TASKMODAL OR %MB_TOPMOST ' END SELECT 'END SUB FUNCTION CheckInstalled (composition$, App AS applicationtype) EXPORT AS LONG LOCAL test AS DWORD LOCAL mypath AS STRING mypath = TRIM$(App.audiofilepath) ' TRIM$(GetGmtDir) ' in module g_indep, but we can also use CURDIR$ 'mypath = mypath & "\" ' to be changed: ' App.audiofiles should contain the complete path to the place of the files FUNCTION = %False test = %False ' this function checks the conditions for specific applications/compositions. SELECT CASE UCASE$(TRIM$(composition$)) CASE "SPRING94" mypath = mypath & "gw_enseko\spring94\spring94.ini" IF ExistFile (mypath) THEN FUNCTION = %True : EXIT FUNCTION CASE "CELLOPI" 'mypath = mypath & "gw_soloko\cellopi\cel" IF ExistFile ($CELLOPIINI) THEN FUNCTION = %TRue 'INCR test CASE "COHIBA" 'mypath = mypath & "gw_soloko\cohiba\cohiba" IF ExistFile ($COHIBAINI) THEN FUNCTION = %True 'INCR test CASE "LICKSTICK" 'mypath = mypath & "gw_soloko\lickstick\ls" IF ExistFile ($LICKSTICKINI) THEN FUNCTION = %True 'INCR test CASE "WOODSTOCK" , "WOODSTOCKJAZZ" 'mypath = mypath & "gw_soloko\woodstock\ws" IF ExistFile ($WOODSTOCKINI) THEN FUNCTION = %True 'INCR test CASE "OBOTEK" 'mypath = mypath & "gw_soloko\obotek\OboTek" IF ExistFile ($OBOTEKINI) THEN FUNCTION = %True 'INCR test CASE "PANATELLA" 'mypath = mypath & "gw_soloko\cohiba\cohiba" IF ExistFile ($PANATELLAINI) THEN FUNCTION = %True 'INCR test CASE "BAKLAVA" ' changed 03.10.2006: existence of files is checked in g_file: ReadWaveFileListFromFile 'mypath = mypath & "gw_soloko\baklava\bkl_" IF ExistFile ($BAKLAVAINI) THEN FUNCTION = %True 'INCR test END SELECT END FUNCTION SUB DrawRadarTriangle (BYVAL h AS LONG, a() AS SINGLE) EXPORT ' procedure to use with Holosound sonar devices, setup in a tetrahedron configuration. ' redesigned 18.07.2002 ' also used for fast doppler mode sonar., called from g_n-h.dll LOCAL ppoint AS POINTL LOCAL hDC AS DWORD LOCAL Ti AS RadarTriangleType LOCAL WndRect AS FOURLONGS LOCAL vsize AS LONG LOCAL ssize AS LONG STATIC tog AS LONG STATIC Tr AS RadarTriangleType STATIC Wr AS FOURLONGS STATIC pt() AS pointl ' for outer triangle STATIC hpb AS LONG ' blue pen STATIC hpg AS LONG ' green pen STATIC hp0 AS LONG ' black pen LOCAL hpold AS LONG 'returnvalue of selectobject - reselect when finished DIM pti(3) AS LOCAL pointl ' for inner triangle IF ISFALSE tog THEN IF ISFALSE h THEN EXIT SUB DIM pt(2) AS STATIC pointl hpb = CreatePen (%PS_SOLID, 1, RGB(0,0,255)) ' blue hp0 = CreatePen (%PS_SOLID, 1, RGB(0,0,0)) ' black hpg = CreatePen (%PS_SOLID, 1, RGB(0,255,0)) ' green tog = %True END IF GetClientRect h, WndRect ' WndRect.x , WndRect.y always 0,0 ! hDC = GetDC(h) IF WndRect <> Wr THEN ' triangle will always fit in window... IF WndRect.h -10 < WndRect.b * 0.866 THEN Tr.z = (WndRect.h * 1.155) - 10 ELSEIF WndRect.b - 10 > (WndRect.h * 1.155) -10 THEN Tr.z = (WndRect.h * 1.155) - 10 ELSE Tr.z = (WndRect.b) - 10 END IF Tr.h = (Tr.z * 0.866) Tr.Tx = WndRect.b / 2 Tr.Ty = (WndRect.h - Tr.h)/ 2 ' half margin Tr.Lx = (WndRect.b - Tr.z) /2 Tr.Ly = Tr.Ty + Tr.h Tr.Rx = ((WndRect.b - Tr.z) / 2 ) + Tr.z Tr.Ry = Tr.Ly Tr.Cx = (Tr.Lx + Tr.Rx + Tr.Tx) / 3 ' coordinates center. Tr.Cy = (Tr.Ly + Tr.Ry + Tr.Ty) / 3 Wr = WndRect ' koordinaten van de buitendriehoek: pt(0).x = Tr.Lx pt(0).y = Tr.Ly pt(1).x = Tr.Rx pt(1).y = Tr.Ry pt(2).x = Tr.Tx Pt(2).y = Tr.Ty PatBlt hDC,WndRect.x,WndRect.y,WndRect.b, WndRect.h, %WHITENESS ' wipe existing drawing END IF ' redraw outer triangle in the window... hpold = SelectObject(hDC, hp0) '0 ' black pen ' SetDCPenColor hDC,&H00000000& - refuses this: not found in dll returned... DPtoLP hDC, pt(0), 3 POLYGON hDC, pt(0), 3 ' fills the triangle and erases its internal surface. IF a(0) + a(1) + a(2) > 0 THEN ' calculate coordinates for inner movingtriangle: Ti.Tx = Tr.Cx Ti.Ty = Tr.Ty + (Tr.Cy - (Tr.Cy * a(2))) IF Ti.Ty > Tr.Cy THEN Ti.Ty = Tr.Cy Ti.Lx = Tr.Lx + (Tr.z * (1-a(0)) / 2 ) IF Ti.Lx > Tr.Cx THEN Ti.Lx = Tr.Cx Ti.Ly = Tr.Ly - (Tr.h * (1-a(0))/ 3 ) IF Ti.Ly < Tr.Cy THEN Ti.Ly = Tr.Cy Ti.Rx = Tr.Rx - (Tr.z * (1-a(1)) / 2 ) IF Ti.Rx < Tr.Cx THEN Ti.Rx = Tr.Cx Ti.Ry = Tr.Ry - (Tr.h * (1-a(1))/3) IF Ti.Ry < Tr.Cy THEN Ti.Ry = Tr.Cy ' find point of gravity of this new triangle: Ti.Cx = (Ti.Tx + Ti.Lx + Ti.Rx) /3 Ti.Cy = (Ti.Ty + Ti.Ly + Ti.Ry) /3 ' draw height-lines in outer triangle: ' from top to base: MoveToEx hDC, Tr.Tx,Tr.Ty, ppoint ' startpunt top LineTo hDC, Ti.Tx, Ti.Ty ' from left corner: MoveToEx hDC, Tr.Lx, Tr.Ly, ppoint LineTo hDC, Ti.Lx, Ti.Ly ' from right corner: MoveToEx hDC, Tr.Rx, Tr.Ry, ppoint LineTo hDC, Ti.Rx, Ti.Ry 'DRAW CONNECTING INNER TRIANGLE: pti(0).x = Ti.Lx : pti(0).y = Ti.Ly pti(1).x = Ti.Rx : pti(1).y = Ti.Ry pti(2).x = Ti.Tx : Pti(2).y = Ti.Ty pti(3).x = Ti.Lx : pti(3).y = Ti.Ly ' to close the triangle DPtoLP hDC, pti(0), 4 'PolyGon hDC, pt(0), 3 ' closes triangle, but erases surface. POLYLINE hDC, pt(0), 3 'SetDCPenColor hDC, &H00FF0000 - refused. SelectObject hDC, hpb ' blue pen ' draw center circle... ssize = (a(0) + a(1) + a(2)) * (Tr.cy / 12) 'Ellipse hDC, Ti.Cx-5, Ti.Cy-5, Ti.Cx+5,Ti.Cy+5 ELLIPSE hDC, Ti.Cx-ssize, Ti.Cy-ssize, Ti.Cx+ssize,Ti.Cy+ssize ' draw connection lines: MoveToEx hDc, Ti.Lx, Ti.Ly, ppoint LineTo hDc, Ti.Cx, Ti.Cy LineTo hDc, Ti.Rx, Ti.Ry MoveToEx hDC, Ti.Tx, Ti.Ty, ppoint LineTo hDC, Ti.Cx,Ti.Cy END IF IF a(3) + a(4) + a(5) > 0 THEN ' and now the same for the velocity channels: ' SetDCPenColor hDC, &H00000000 SelectObject hDC, hp0 ' calculate coordinates for inner movingtriangle - velocity channels: Ti.Tx = Tr.Cx Ti.Ty = Tr.Ty + (Tr.Cy - (Tr.Cy * a(5))) IF Ti.Ty > Tr.Cy THEN Ti.Ty = Tr.Cy Ti.Lx = Tr.Lx + (Tr.z * (1-a(3)) / 2 ) IF Ti.Lx > Tr.Cx THEN Ti.Lx = Tr.Cx Ti.Ly = Tr.Ly - (Tr.h * (1-a(3))/ 3 ) IF Ti.Ly < Tr.Cy THEN Ti.Ly = Tr.Cy Ti.Rx = Tr.Rx - (Tr.z * (1-a(4)) / 2 ) IF Ti.Rx < Tr.Cx THEN Ti.Rx = Tr.Cx Ti.Ry = Tr.Ry - (Tr.h * (1-a(4))/3) IF Ti.Ry < Tr.Cy THEN Ti.Ry = Tr.Cy ' find point of gravity of this new triangle: Ti.Cx = (Ti.Tx + Ti.Lx + Ti.Rx) /3 Ti.Cy = (Ti.Ty + Ti.Ly + Ti.Ry) /3 ' draw height-lines in outer triangle: ' from top to base: MoveToEx hDC, Tr.Tx,Tr.Ty, ppoint ' startpunt top LineTo hDC, Ti.Tx, Ti.Ty ' from left corner: MoveToEx hDC, Tr.Lx, Tr.Ly, ppoint LineTo hDC, Ti.Lx, Ti.Ly ' from right corner: MoveToEx hDC, Tr.Rx, Tr.Ry, ppoint LineTo hDC, Ti.Rx, Ti.Ry 'DRAW CONNECTING INNER TRIANGLE: pti(0).x = Ti.Lx : pti(0).y = Ti.Ly pti(1).x = Ti.Rx : pti(1).y = Ti.Ry pti(2).x = Ti.Tx : Pti(2).y = Ti.Ty pti(3).x = Ti.Lx : pti(3).y = Ti.Ly DPtoLP hDC, pti(0), 4 'PolyGon hDC, pt(0), 3 POLYLINE hDC, pti(0), 4 'SetDCPenColor hDC, &H0000FF00 SelectObject hDC, hpg ' green ' draw center circle... vsize = (a(3) + a(4) + a(5))* (Tr.cy / 12) ELLIPSE hDC, Ti.Cx-vsize, Ti.Cy-vsize, Ti.Cx+vsize,Ti.Cy+vsize ' draw connection lines: MoveToEx hDc, Ti.Lx, Ti.Ly, ppoint LineTo hDc, Ti.Cx, Ti.Cy LineTo hDc, Ti.Rx, Ti.Ry MoveToEx hDC, Ti.Tx, Ti.Ty, ppoint LineTo hDC, Ti.Cx,Ti.Cy END IF SelectObject hDc, hpold ' DeleteObject hp0 ' DeleteObject hpb ' Deleteobject hpg ReleaseDC h, hDC END SUB SUB Draw_SonarTetrahedron (BYVAL h AS LONG, sr AS sonartype) EXPORT ' procedure to use with Sonar devices, setup in a tetrahedron configuration. ' redesigned 02.11.2003 ' requires the sonar type! LOCAL ppoint AS POINTL LOCAL hDC AS DWORD LOCAL Ti AS RadarTriangleType LOCAL WndRect AS FOURLONGS LOCAL vsize AS LONG LOCAL ssize AS LONG STATIC tog AS LONG STATIC Tr AS RadarTriangleType STATIC Wr AS FOURLONGS STATIC pt() AS pointl ' for outer triangle STATIC hpb AS LONG ' blue pen STATIC hpg AS LONG ' green pen STATIC hp0 AS LONG ' black pen LOCAL hpold AS LONG 'returnvalue of selectobject - reselect when finished DIM pti(3) AS LOCAL pointl ' for inner triangle IF ISFALSE tog THEN IF ISFALSE h THEN EXIT SUB DIM pt(2) AS STATIC pointl hpb = CreatePen (%PS_SOLID, 1, RGB(0,0,255)) ' blue hp0 = CreatePen (%PS_SOLID, 1, RGB(0,0,0)) ' black hpg = CreatePen (%PS_SOLID, 1, RGB(0,255,0)) ' green tog = %True END IF GetClientRect h, WndRect ' WndRect.x , WndRect.y always 0,0 ! hDC = GetDC(h) IF WndRect <> Wr THEN ' triangle will always fit in window... IF WndRect.h -10 < WndRect.b * 0.866 THEN Tr.z = (WndRect.h * 1.155) - 10 ELSEIF WndRect.b - 10 > (WndRect.h * 1.155) -10 THEN Tr.z = (WndRect.h * 1.155) - 10 ELSE Tr.z = (WndRect.b) - 10 END IF Tr.h = (Tr.z * 0.866) Tr.Tx = WndRect.b / 2 Tr.Ty = (WndRect.h - Tr.h)/ 2 ' half margin Tr.Lx = (WndRect.b - Tr.z) /2 Tr.Ly = Tr.Ty + Tr.h Tr.Rx = ((WndRect.b - Tr.z) / 2 ) + Tr.z Tr.Ry = Tr.Ly Tr.Cx = (Tr.Lx + Tr.Rx + Tr.Tx) / 3 ' coordinates center. Tr.Cy = (Tr.Ly + Tr.Ry + Tr.Ty) / 3 Wr = WndRect ' koordinaten van de buitendriehoek: pt(0).x = Tr.Lx pt(0).y = Tr.Ly pt(1).x = Tr.Rx pt(1).y = Tr.Ry pt(2).x = Tr.Tx Pt(2).y = Tr.Ty PatBlt hDC,WndRect.x,WndRect.y,WndRect.b, WndRect.h, %WHITENESS ' wipe existing drawing END IF ' redraw outer triangle in the window... hpold = SelectObject(hDC, hp0) '0 ' black pen DPtoLP hDC, pt(0), 3 POLYGON hDC, pt(0), 3 ' fills the triangle and erases its internal surface. IF sr.s > sr.noise THEN ' calculate coordinates for inner movingtriangle: Ti.Tx = Tr.Cx Ti.Ty = Tr.Ty + (Tr.Cy - (Tr.Cy * (sr.sz/%d12))) IF Ti.Ty > Tr.Cy THEN Ti.Ty = Tr.Cy Ti.Lx = Tr.Lx + (Tr.z * (1-(sr.sx/%d12)) / 2 ) IF Ti.Lx > Tr.Cx THEN Ti.Lx = Tr.Cx Ti.Ly = Tr.Ly - (Tr.h * (1-(sr.sx/%d12))/ 3 ) IF Ti.Ly < Tr.Cy THEN Ti.Ly = Tr.Cy Ti.Rx = Tr.Rx - (Tr.z * (1-(sr.sy/%d12)) / 2 ) IF Ti.Rx < Tr.Cx THEN Ti.Rx = Tr.Cx Ti.Ry = Tr.Ry - (Tr.h * (1-(sr.sy/%d12))/3) IF Ti.Ry < Tr.Cy THEN Ti.Ry = Tr.Cy ' find point of gravity of this new triangle: Ti.Cx = (Ti.Tx + Ti.Lx + Ti.Rx) /3 Ti.Cy = (Ti.Ty + Ti.Ly + Ti.Ry) /3 ' draw height-lines in outer triangle: ' from top to base: MoveToEx hDC, Tr.Tx,Tr.Ty, ppoint ' startpunt top LineTo hDC, Ti.Tx, Ti.Ty ' from left corner: MoveToEx hDC, Tr.Lx, Tr.Ly, ppoint LineTo hDC, Ti.Lx, Ti.Ly ' from right corner: MoveToEx hDC, Tr.Rx, Tr.Ry, ppoint LineTo hDC, Ti.Rx, Ti.Ry 'DRAW CONNECTING INNER TRIANGLE: pti(0).x = Ti.Lx : pti(0).y = Ti.Ly pti(1).x = Ti.Rx : pti(1).y = Ti.Ry pti(2).x = Ti.Tx : Pti(2).y = Ti.Ty pti(3).x = Ti.Lx : pti(3).y = Ti.Ly ' to close the triangle DPtoLP hDC, pti(0), 4 'PolyGon hDC, pt(0), 3 ' closes triangle, but erases surface. POLYLINE hDC, pt(0), 3 SelectObject hDC, hpb ' blue pen ' draw center circle... ssize = (sr.s * Tr.cy) / %d14 '(a(0) + a(1) + a(2)) * (Tr.cy / 12) ELLIPSE hDC, Ti.Cx-ssize, Ti.Cy-ssize, Ti.Cx+ssize,Ti.Cy+ssize ' draw connection lines: MoveToEx hDc, Ti.Lx, Ti.Ly, ppoint LineTo hDc, Ti.Cx, Ti.Cy LineTo hDc, Ti.Rx, Ti.Ry MoveToEx hDC, Ti.Tx, Ti.Ty, ppoint LineTo hDC, Ti.Cx,Ti.Cy END IF IF sr.xyzf > sr.noise THEN ' and now the same for the velocity channels: SelectObject hDC, hp0 ' calculate coordinates for inner movingtriangle - velocity channels: Ti.Tx = Tr.Cx Ti.Ty = Tr.Ty + (Tr.Cy - (Tr.Cy * (sr.zf/%d12))) ' z IF Ti.Ty > Tr.Cy THEN Ti.Ty = Tr.Cy Ti.Lx = Tr.Lx + (Tr.z * (1-(sr.xf/%d12)) / 2 ) ' x IF Ti.Lx > Tr.Cx THEN Ti.Lx = Tr.Cx Ti.Ly = Tr.Ly - (Tr.h * (1-(sr.xf/%d12))/ 3 ) ' x IF Ti.Ly < Tr.Cy THEN Ti.Ly = Tr.Cy Ti.Rx = Tr.Rx - (Tr.z * (1-(sr.yf/%d12)) / 2 ) ' y IF Ti.Rx < Tr.Cx THEN Ti.Rx = Tr.Cx Ti.Ry = Tr.Ry - (Tr.h * (1-(sr.yf/%d12))/3) ' y IF Ti.Ry < Tr.Cy THEN Ti.Ry = Tr.Cy ' find point of gravity of this new triangle: Ti.Cx = (Ti.Tx + Ti.Lx + Ti.Rx) /3 Ti.Cy = (Ti.Ty + Ti.Ly + Ti.Ry) /3 ' draw height-lines in outer triangle: ' from top to base: MoveToEx hDC, Tr.Tx,Tr.Ty, ppoint ' startpunt top LineTo hDC, Ti.Tx, Ti.Ty ' from left corner: MoveToEx hDC, Tr.Lx, Tr.Ly, ppoint LineTo hDC, Ti.Lx, Ti.Ly ' from right corner: MoveToEx hDC, Tr.Rx, Tr.Ry, ppoint LineTo hDC, Ti.Rx, Ti.Ry 'DRAW CONNECTING INNER TRIANGLE: pti(0).x = Ti.Lx : pti(0).y = Ti.Ly pti(1).x = Ti.Rx : pti(1).y = Ti.Ry pti(2).x = Ti.Tx : Pti(2).y = Ti.Ty pti(3).x = Ti.Lx : pti(3).y = Ti.Ly DPtoLP hDC, pti(0), 4 POLYLINE hDC, pti(0), 4 SelectObject hDC, hpg ' green ' draw center circle... vsize = (sr.xyzf * Tr.cy) / %d14 ELLIPSE hDC, Ti.Cx-vsize, Ti.Cy-vsize, Ti.Cx+vsize,Ti.Cy+vsize ' draw connection lines: MoveToEx hDc, Ti.Lx, Ti.Ly, ppoint LineTo hDc, Ti.Cx, Ti.Cy LineTo hDc, Ti.Rx, Ti.Ry MoveToEx hDC, Ti.Tx, Ti.Ty, ppoint LineTo hDC, Ti.Cx,Ti.Cy END IF SelectObject hDc, hpold ' DeleteObject hp0 ' DeleteObject hpb ' Deleteobject hpg ReleaseDC h, hDC END SUB SUB Draw_QuadRadar (BYVAL h AS LONG, BYVAL pr AS DWORD) EXPORT ' this proc. is not used! ' in g_h.dll we call only Draw_Quadradar_Square. ' procedure to use with radar interfaces setup in a square. ' pr holds the value of the pointer to the radartype. ' 21.02.2003 debugged. Now o.k. LOCAL ppoint AS POINTL LOCAL hDC AS DWORD LOCAL WndRect AS FOURLONGS LOCAL side AS LONG STATIC tog AS LONG STATIC hpb AS LONG ' blue pen STATIC hpg AS LONG ' green pen STATIC hp0 AS LONG ' black pen STATIC hpr AS LONG ' red pen LOCAL hpold AS LONG ' returnvalue of selectobject - reselect when finished ' LOCAL Lx AS SINGLE ' LOCAL Ly AS SINGLE IF ISFALSE tog THEN IF ISFALSE h THEN EXIT SUB DIM pt(2) AS STATIC pointl DIM r(3) AS STATIC RadarType AT pr hpb = CreatePen (%PS_SOLID, 1, RGB(0,0,255)) ' blue hp0 = CreatePen (%PS_SOLID, 1, RGB(0,0,0)) ' black hpg = CreatePen (%PS_SOLID, 1, RGB(0,255,0)) ' green hpr = CreatePen (%PS_SOLID, 1, RGB(255,0,0)) ' red ' DIM Cx(0 TO 2) AS STATIC Complex ' DIM Po(0 TO 2) AS STATIC Polar tog = %True END IF GetClientRect h, WndRect ' WndRect.x , WndRect.y always 0,0 ! hDC = GetDC(h) ' make sure the coordinates are always square! side = MIN(WndRect.h, WndRect.b) ' tevens de hoogte, want we hebben een vierkant PatBlt hDC,%False,%False,side,side, %WHITENESS ' wipe existing drawing ' first we draw a circle fitting in the window: ELLIPSE hDC, %False,%False, side,side ' then we draw the diagonal lines: MoveToEx hDC, %False, %False, ppoint ' startpunt links boven - axis transducers 0 and 2 LineTo hDC, side, side MoveToEx hDC, %False,side, ppoint ' startpunt links onder - axis transducers 1 and 3 LineTo hDC, side, %False ' eerste koppel transducers (0-2): hpold = SelectObject(hDC, hpg) ' green pen ' het middelpunt van dit lijnstuk is: ' we slaan dit op in pt(0): pt(0).x = side * r(0).l pt(0).y = pt(0).x ' for debug: ELLIPSE hDC, pt(0).x -r(0).s, pt(0).y-r(0).s ,pt(0).x + r(0).s, pt(0).y + r(0).s ' tweede koppel transducers: ' het punt van het centrum van de beweging zou zich nu op het middelpunt van dit lijnstuk moeten bevinden... ' het middelpunt van dit lijnstuk is: pt(1).x = side * r(1).l pt(1).y = side - pt(1).x ' for debug: SelectObject hDC, hpr ' red pen ELLIPSE hDC, pt(1).x -r(1).s, pt(1).y-r(1).s ,pt(1).x + r(1).s, pt(1).y + r(1).s ' wanneer we nu het midden van het lijnstuk pt(0)-pt(1) berekenen, hebben we de richting van de ' gedetekteerde beweging in kaart gebracht: ' pt(2).x = (pt(0).x + pt(1).x) / 2 ' pt(2).y = (pt(0).y + pt(1).y) / 2 ' Voor de bepaling van de positie is dit fout, we moeten immers de vektoren optellen. ' Het gezochte punt moet in het verlengde liggen van de lijn vanuit het centrum naar dit punt, ' en wel op de dubbele afstand van dit centrum. ' afstand van het centrum voor x = pt(2).x - (side/2) ' negatief is in de linkerkant van het scherm ' dus korrigeren we: ' pt(2).x = pt(2).x + pt(2).x - (side/2) ' pt(2).y = pt(2).y + pt(2).y - (side/2) ' dit kan nu met minder rekenwerk ook in 1 keer: side = side /2 pt(2).x = pt(0).x + pt(1).x - side pt(2).y = pt(0).y + pt(1).y - side ' We tekenen deze lijn: SelectObject hDC, hpb ' blue pen MoveToEx hDC, side , side , ppoint LineTo hDC, pt(2).x, pt(2).y ' we tekenen op de plaats van beweging een elips (maat en aspekt zijn een funktie van de amplitude) ELLIPSE hDC, pt(2).x -r(0).s, pt(2).y - r(1).s, pt(2).x + r(0).s, pt(2).y + r(1).s ' the magnitude of the new vector should always be: ' Po(2).mag = SQR((((r(0).lx + r(0).ly)/ 2)^2) + (((r(1).lx + r(1).ly)/ 2)^2)) ' the sign should be added: ' Po(2).ang = ArcCos (((r(0).lx + r(0).ly)/2) /Po(2).mag) ' P2C Po(2), Cx(2) ' nu hebben we de koordinaten vanuit het centrum size/2, size/2 in Cx(2).real en Cx(2).imag ' dus moeten we nu rescalen en de y koordinaat verschuiven ' pt(2).x = Cx(2).real * side ' pt(2).y = side - (Cx(2).imag * side) ' test for math: ' Ellipse hDC, r(0).pc.real, r(0).pc.imag, r(0).pc.real, r(0).pc.imag SelectObject hDc, hpold ' DeleteObject hp0 ' DeleteObject hpb ' Deleteobject hpg ReleaseDC h, hDC END SUB SUB Draw_QuadRadar_Square (BYVAL h AS LONG, BYVAL pr AS DWORD) EXPORT ' procedure to use with radar interfaces setup in a square. ' pr holds the value of the pointer to the radartype. ' 19.02.2003 ' 21.02.2003 debugged. Now o.k. ' 03.03.2003 new version ' 09.03.2003 some bugs killed. ' 30.03.2003 updated with new type structure. ' 01.04.2003 updated LOCAL ppoint AS POINTL LOCAL hDC AS DWORD LOCAL WndRect AS FOURLONGS LOCAL side AS LONG STATIC tog AS LONG STATIC hpb AS LONG ' blue pen STATIC hpg AS LONG ' green pen STATIC hp0 AS LONG ' black pen STATIC hpr AS LONG ' red pen LOCAL hpold AS LONG ' returnvalue of selectobject - reselect when finished LOCAL x AS LONG LOCAL y AS LONG LOCAL sx AS LONG LOCAL sy AS LONG IF ISFALSE tog THEN IF ISFALSE h THEN EXIT SUB DIM pt(3) AS STATIC pointl DIM r(3) AS STATIC RadarType AT pr hpb = CreatePen (%PS_SOLID, 1, RGB(0,0,255)) ' blue hp0 = CreatePen (%PS_SOLID, 1, RGB(0,0,0)) ' black hpg = CreatePen (%PS_SOLID, 1, RGB(0,255,0)) ' green hpr = CreatePen (%PS_SOLID, 1, RGB(255,0,0)) ' red tog = %True END IF GetClientRect h, WndRect ' WndRect.x , WndRect.y always 0,0 ! hDC = GetDC(h) ' make sure the coordinates are always square! side = MIN(WndRect.h, WndRect.b) ' tevens de hoogte, want we hebben een vierkant PatBlt hDC,%False,%False,side,side, %WHITENESS ' wipe existing drawing SelectObject hDC, hpg ' green pen ' draw a circle fitting in the window: ELLIPSE hDC, %False,%False, side,side selectobject hDC, hp0 ' draw the coordinate system in black: ' x-axis - transducers 0 and 2: MoveToEx hDC, %False, side / 2, ppoint LineTo hDC, side, side/2 ' y-axis - transducers 1 and 3: MoveToEx hDC, side/2,%False,ppoint LineTo hDC, side/2, side SelectObject hDC, hpg ' green pen ' then we draw the diagonal lines: MoveToEx hDC, %False, %False, ppoint ' startpunt links boven - LineTo hDC, side, side MoveToEx hDC, %False,side, ppoint ' startpunt links onder - LineTo hDC, side, %False ' coordinates positie volgens transducer 0: [ links boven op scherm ] Pt(0).x = (side/2) + (side/2 * r(0).pc.real) Pt(0).y = (side/2) - (side/2 * r(0).pc.imag) ' coordinates positie volgens transducer 1: [ onderaan op scherm] Pt(1).x = (side/2) + (side/2 * r(1).pc.real) Pt(1).y = (side/2) - (side/2 * r(1).pc.imag) ' coordinates positie volgens transducer 2: [ rechts onder op scherm] Pt(2).x = (side/2) + (side/2 * r(2).pc.real) Pt(2).y = (side/2) - (side/2 * r(2).pc.imag) ' coordinates positie volgens transducer 3: [ rechts boven op scherm] Pt(3).x = (side/2) + (side/2 * r(3).pc.real) Pt(3).y = (side/2) - (side/2 * r(3).pc.imag) x = (Pt(0).x + Pt(1).x + Pt(2).x + Pt(3).x) / 4 y = (Pt(0).y + Pt(1).y + Pt(2).y + Pt(3).y) / 4 SelectObject hDC, hpr ' red pen ' draw polygon: - size of this polygon is proportional to unsecurity of place determination. DPtoLP hDC, pt(0), 4 POLYGON hDC, pt(0), 4 ' fills the polygon and erases its internal surface. SelectObject hDC, hpb ' blue pen ' draw central elipse: sx = (r(0).s + r(2).s) / 4 '2 - should become a function of r().sfakt sy = (r(1).s + r(3).s) / 4 '2 ELLIPSE hDC, x - sy, y - sx, x + sy, y + sx SelectObject hDc, hpold ReleaseDC h, hDC END SUB SUB Axe3_Mon() EXPORT 'task for graphical monitoring of Axe3 params 'recommended task freq: 48 (updates values for one axe sensor, one direction at each call STATIC mx() AS SINGLE STATIC mn() AS SINGLE STATIC init AS DWORD STATIC hwAx3 AS DWORD STATIC swp AS DWORD STATIC pAxe3 AS Axe_Type PTR STATIC oldlx AS SINGLE, oldly AS SINGLE, oldrx AS SINGLE, oldry AS SINGLE 'for tempo's LOCAL i AS LONG LOCAL b$ IF ISFALSE init THEN DIM mx(15) DIM mn(15) pAxe3 = GetAX3Sensorpointer (0,-1) DIALOG NEW 0, "Ax3Mon", 200,50,146,278, %WS_CAPTION OR %WS_POPUP TO hwAx3 '@ 20080904: was ,%WS_EX_TOOLWINDOW TO hwAx3 - no idea why.. CONTROL ADD GRAPHIC, hwAx3, 100,"", 2, 2, 70, 100 CONTROL ADD GRAPHIC, hwAx3, 200,"", 74, 2, 70, 100 CONTROL ADD GRAPHIC, hwAx3, 300,"", 2, 104, 70, 100 CONTROL ADD GRAPHIC, hwAx3, 400,"", 74, 104, 70, 100 CONTROL ADD GRAPHIC, hwAx3, 500, "", 2, 206, 142, 70 'for tempo's DIALOG SHOW MODELESS hwAx3 init = 1 END IF mx(0) = MAX(mx(0), @pAxe3.avglx) mx(1) = MAX(mx(1), @pAxe3.acclx) mx(2) = MAX(mx(2), @pAxe3.dalx) mx(3) = MAX(mx(3), @pAxe3.tiltlx) mn(0) = MIN(mn(0), @pAxe3.avglx) mn(1) = MIN(mn(1), @pAxe3.acclx) mn(2) = MIN(mn(2), @pAxe3.dalx) mn(3) = MIN(mn(3), @pAxe3.tiltlx) mx(4) = MAX(mx(4), @pAxe3.avgly) mx(5) = MAX(mx(5), @pAxe3.accly) mx(6) = MAX(mx(6), @pAxe3.daly) mx(7) = MAX(mx(7), @pAxe3.tiltly) mn(4) = MIN(mn(4), @pAxe3.avgly) mn(5) = MIN(mn(5), @pAxe3.accly) mn(6) = MIN(mn(6), @pAxe3.daly) mn(7) = MIN(mn(7), @pAxe3.tiltly) mx(8) = MAX(mx(8), @pAxe3.avgrx) mx(9) = MAX(mx(9), @pAxe3.accrx) mx(10) = MAX(mx(10), @pAxe3.darx) mx(11) = MAX(mx(11), @pAxe3.tiltrx) mn(8) = MIN(mn(8), @pAxe3.avgrx) mn(9) = MIN(mn(9), @pAxe3.accrx) mn(10) = MIN(mn(10), @pAxe3.darx) mn(11) = MIN(mn(11), @pAxe3.tiltrx) mx(12) = MAX(mx(12), @pAxe3.avgry) mx(13) = MAX(mx(13), @pAxe3.accry) mx(14) = MAX(mx(14), @pAxe3.dary) mx(15) = MAX(mx(15), @pAxe3.tiltry) mn(12) = MIN(mn(12), @pAxe3.avgry) mn(13) = MIN(mn(13), @pAxe3.accry) mn(14) = MIN(mn(14), @pAxe3.dary) mn(15) = MIN(mn(15), @pAxe3.tiltry) INCR swp swp = swp MOD 4 GRAPHIC ATTACH hwAx3, 100 + 100 * swp, REDRAW GRAPHIC SCALE (-100,1300) - (1100, -100) 'so the bargraphs are in the region 0->1 GRAPHIC CLEAR %WHITE GRAPHIC WIDTH 1 GRAPHIC STYLE 0 'empty bars GRAPHIC BOX (0, 0)- (1000/7, 1000), 10, 10, &HCCCCCC, 0 GRAPHIC BOX (2000/7, 0)- (3000/7, 1000), 10, 0, &HCCCCCC, 0 GRAPHIC BOX (4000/7, 0)- (5000/7, 1000), 10, 0, &HCCCCCC, 0 GRAPHIC BOX (6000/7, 0)- (7000/7, 1000), 10, 0, &HCCCCCC, 0 GRAPHIC FONT "Lucida Console", 8, 0 GRAPHIC COLOR RGB(200,200,0), %WHITE GRAPHIC SET POS (0, 1090) GRAPHIC PRINT "Tilt" GRAPHIC COLOR RGB(0,200,0), %WHITE GRAPHIC SET POS (2000/7, 1090) GRAPHIC PRINT "Avg" GRAPHIC COLOR RGB(200,0,200), %WHITE GRAPHIC SET POS (4000/7, 1090) GRAPHIC PRINT "acc" GRAPHIC COLOR RGB(0,0,200), %WHITE GRAPHIC SET POS (6000/7, 1090) GRAPHIC PRINT "da" 'paint valuers GRAPHIC COLOR %BLACK, %WHITE GRAPHIC SET POS (-50,1200) SELECT CASE swp CASE 0 'lx GRAPHIC PRINT "left x" GRAPHIC BOX (0, 500) - (1000/7, MAX(0, MIN(1000, 500 + 500 * @pAxe3.tiltlx))), 20, 0, RGB(200,200,0) GRAPHIC BOX (2000/7, 0) - (3000/7, MAX(0, MIN(1000, @pAxe3.avglx / 1.2))), 20, 0, RGB(0,200,0) GRAPHIC BOX (4000/7, 500) - (5000/7, MAX(0, MIN(1000, 500 + 100 * @pAxe3.acclx))), 20, 0, RGB(200,0,200) GRAPHIC BOX (6000/7, 500) - (7000/7, MAX(0, MIN(1000, 500 + 250 * @pAxe3.dalx))), 20, 0, RGB(0,0,200) CASE 1 GRAPHIC PRINT "left y" GRAPHIC BOX (0, 500) - (1000/7, MAX(0, MIN(1000, 500 + 500 * @pAxe3.tiltly))), 20, 0, RGB(200,200,0) GRAPHIC BOX (2000/7, 0) - (3000/7, MAX(0, MIN(1000, @pAxe3.avgly / 1.2))), 20, 0, RGB(0,200,0) GRAPHIC BOX (4000/7, 500) - (5000/7, MAX(0, MIN(1000, 500 + 100 * @pAxe3.accly))), 20, 0, RGB(200,0,200) GRAPHIC BOX (6000/7, 500) - (7000/7, MAX(0, MIN(1000, 500 + 250 * @pAxe3.daly))), 20, 0, RGB(0,0,200) CASE 2 GRAPHIC PRINT "right x" GRAPHIC BOX (0, 500) - (1000/7, MAX(0, MIN(1000, 500 + 500 * @pAxe3.tiltrx))), 20, 0, RGB(200,200,0) GRAPHIC BOX (2000/7, 0) - (3000/7, MAX(0, MIN(1000, @pAxe3.avgrx / 1.2))), 20, 0, RGB(0,200,0) GRAPHIC BOX (4000/7, 500) - (5000/7, MAX(0, MIN(1000, 500 + 100 * @pAxe3.accrx))), 20, 0, RGB(200,0,200) GRAPHIC BOX (6000/7, 500) - (7000/7, MAX(0, MIN(1000, 500 + 250 * @pAxe3.darx))), 20, 0, RGB(0,0,200) CASE 3 GRAPHIC PRINT "right y" GRAPHIC BOX (0, 500) - (1000/7, MAX(0, MIN(1000, 500 + 500 * @pAxe3.tiltry))), 20, 0, RGB(200,200,0) GRAPHIC BOX (2000/7, 0) - (3000/7, MAX(0, MIN(1000, @pAxe3.avgry / 1.2))), 20, 0, RGB(0,200,0) GRAPHIC BOX (4000/7, 500) - (5000/7, MAX(0, MIN(1000, 500 + 100 * @pAxe3.accry))), 20, 0, RGB(200,0,200) GRAPHIC BOX (6000/7, 500) - (7000/7, MAX(0, MIN(1000, 500 + 250 * @pAxe3.dary))), 20, 0, RGB(0,0,200) END SELECT 'put demarcations GRAPHIC LINE (0,500)-(1000/7,500), 0 GRAPHIC LINE (4000/7,500)-(5000/7,500),0 GRAPHIC LINE (6000/7,500)-(7000/7,500),0 GRAPHIC REDRAW IF swp = 3 THEN 'mm values GRAPHIC ATTACH hwAx3, 500, REDRAW GRAPHIC SCALE (-200, 1300)-(1100, -100) GRAPHIC CLEAR %WHITE GRAPHIC WIDTH 1 GRAPHIC STYLE 0 GRAPHIC SET POS (-100, 1300) GRAPHIC COLOR %BLACK, %WHITE GRAPHIC PRINT "MM values" GRAPHIC COLOR RGB(200, 100, 0), %WHITE GRAPHIC SET POS (-200, 1000) GRAPHIC PRINT "lx" +STR$( INT( 10 * IIF(@pAxe3.mmlx > 0, @pAxe3.mmlx, oldlx))/10) GRAPHIC BOX (0,1000)-(1000, 9000/11), 10, 0, &HCCCCCC, 0 GRAPHIC BOX (0,1000)-(IIF(@pAxe3.mmlx > 0, @pAxe3.mmlx, oldlx) * 2, 9000/11), 20, 0, RGB (200, 100, 0) GRAPHIC COLOR RGB (200, 100, 0), %WHITE GRAPHIC SET POS (-200, 8000/11) GRAPHIC PRINT "ly" +STR$( INT( 10 * IIF(@pAxe3.mmly > 0, @pAxe3.mmly, oldly))/10) GRAPHIC BOX (0,8000/11)-(1000, 6000/11), 10, 0, &HCCCCCC, 0 GRAPHIC BOX (0,8000/11)-(IIF(@pAxe3.mmly > 0, @pAxe3.mmly, oldly) * 2, 6000/11), 20, 0,RGB (200, 100, 0) GRAPHIC COLOR RGB (200, 100, 0), %WHITE GRAPHIC SET POS (-200, 5000/11) GRAPHIC PRINT "rx" +STR$( INT( 10 * IIF(@pAxe3.mmrx > 0, @pAxe3.mmrx, oldrx))/10) GRAPHIC BOX (0,5000/11)-(1000, 3000/11), 10, 0, &HCCCCCC, 0 GRAPHIC BOX (0,5000/11)-(IIF(@pAxe3.mmrx > 0, @pAxe3.mmrx, oldrx) * 2, 3000/11), 20, 0,RGB (200, 100, 0) GRAPHIC COLOR RGB (200, 100, 0), %WHITE GRAPHIC SET POS (-200, 2000/11) GRAPHIC PRINT "ry" +STR$( INT( 10 * IIF(@pAxe3.mmry > 0, @pAxe3.mmry, oldry))/10) GRAPHIC BOX (0,2000/11)-(1000, 0), 10, 0, &HCCCCCC, 0 GRAPHIC BOX (0,2000/11)-(IIF(@pAxe3.mmry > 0, @pAxe3.mmry, oldry) * 2, 0), 20, 0, RGB (200, 100, 0) IF @pAxe3.mmlx > 0 THEN oldlx = @pAxe3.mmlx IF @pAxe3.mmly > 0 THEN oldly = @pAxe3.mmly IF @pAxe3.mmrx > 0 THEN oldrx = @pAxe3.mmrx IF @pAxe3.mmry > 0 THEN oldry = @pAxe3.mmry ' logfile "lx:" + GRAPHIC REDRAW END IF FOR i = 0 TO 7 b$ = b$ + STR$(mx(i)) 'FORMAT$(mx(i), "####.####/ / ;-####.####/ ") NEXT ' CONTROL SET TEXT gh.cockpit, %GMT_MSG1, b$ ' logfile "lmax: " + b$ ' b$ = "" ' FOR i = 8 TO 15 ' b$ = b$ + STR$(mx(i)) 'FORMAT$(mx(i), "####.####/ / ;-####.####/ ") ' NEXT ' CONTROL SET TEXT gh.cockpit, %GMT_MSG2, b$ ' logfile "rmax: " + b$ ' b$ = "" ' FOR i = 0 TO 7 ' b$ = b$ + STR$(mn(i)) 'FORMAT$(mn(i), "####.####/ / ;-####.####/ ") ' NEXT ' ' CONTROL SET TEXT gh.cockpit, %GMT_MSG1, b$ ' logfile "lmin: " + b$ ' b$ = "" ' FOR i = 8 TO 15 ' b$ = b$ + STR$(mn(i)) 'FORMAT$(mn(i), "####.####/ / ;-####.####/ ") ' NEXT ' ' CONTROL SET TEXT gh.cockpit, %GMT_MSG2, b$ ' logfile "rmin: " + b$ ' remarks made during debugging stage.. '------------------------------------ 'RESULTS ' lmax: 1544. 5.09 3.01 0. 1353. 5.09 3.29 0. ' rmax: 1439. 5.49 3.73 1.57 1222. 5.47 3.66 0. ' lmin: 0. -0.01 -2.47 -1.13 0. -1.98 -4.5 -0.81 ' rmin: 0. -1.72 -3.96 -1.56 0. -1.99 -4.14 -1.02 ' lmax: 1436. 5.0977 2.8555 0. 1236. 5.082 3.4883 0. ' rmax: 1288. 5.4883 4.25 1.5708 1204. 5.4844 3.5742 0. ' lmin: 0. 0. -2.3594 -1.0966 0. -1.9805 -3.8164 -1.1533 ' rmin: 0. 0. -2.1445 -1.563 0. -1.9805 -4.2578 -1.0218 ' lmax: 1391 5.097656 3.011719 0 1356 5.070312 3.273438 0 ' rmax: 1632 5.496094 3.808594 1.570796 1261 5.441406 3.878906 1.482379 ' lmin: 0-.8984375-3.851562-1.000243 0-1.988281-4.859375-.8377545 ' rmin: 0-.3164062-3.832031-1.562999 0-1.984375-3.796875-1.562999 ' 'overzicht min/max ' 'avg##: vrij veel variatie tss verschillende metingen ' avglx [0 -> 1544] ' avgly [0 -> 1356] ' avgrx [0 -> 1632] ' avgry [0 -> 1261] ' 'acc#: maxima varieren bij verschillende metingen heel erg weinig, minima meer ' accLX [-.90 -> 5.09] 'bij twee metingen was het minimum 0! ' accLY [-1.98 -> 5.09] ' accRX [-1.72 -> 5.49] ' accRY [-1.99 -> 5.48] ' 'da##: er zin variaties tss versch metingen, maar die zin niet zo groot ' daLX [-3.85 -> 3.01] ' daLY [-4.86 -> 3.48] ' daRX [-3.96 -> 4.25] ' daRY [-4.26 -> 3.87] ' 'tilt## beperkte veranderingen, behalve max van RY, die twee keer 0 was en 1 keer 1.48 ' tiltLx [-1.13 -> 0] ' tiltLy [-1.16 -> 0] ' tiltRx [-1.13 -> 1.57] ' tiltRy [-1.56 -> 1.48] 'maximum was voor twee metingen 0! 'na aanpassing van de firmware: ' lmax: 1187 4.336134 4.155462 1.570796 772 3.670833 3.9375 1.570796 ' rmax: 959 3.008 3.2 1.570796 681 2.650206 2.757202 .7690783 ' lmin: 0 -1.869748 -3.189076 -.7544306 0 -2.133333 -2.75 -.5429531 ' rmin: 0 -1.956 -3.008 -1.08435 0 -2.106996 -2.588477 -.2579966 ' lmax: 1106 4.340336 4.184874 1.570796 758 3.6625 3.408333 1.570796 ' rmax: 1025 3.008 3.596 1.570796 742 2.63786 2.769547 1.242218 ' lmin: 0 -1.163866 -2.823529 -.7777536 0 -2.129167 -2.866666 -.5724186 ' rmin: 0 -2.048 -2.996 -1.199892 0 -2.061728 -2.880658 -1.570796 END SUB SUB Pir2_mon () EXPORT STATIC hwPir2 AS DWORD STATIC init AS DWORD STATIC swp AS DWORD STATIC havgl() AS DWORD STATIC havgc() AS DWORD STATIC havgr() AS DWORD STATIC mxav AS DWORD STATIC hdist() AS DWORD STATIC hang() AS DWORD STATIC mxdist AS DWORD STATIC tt AS DWORD STATIC mxang AS DWORD STATIC pPir2 AS Pir_type PTR LOCAL xx AS SINGLE, yy AS SINGLE LOCAL i AS LONG '20071207 'test results: 'when we separate the 3 sensors with a piece of cardboard, the bit trains and avg's become useable 'within the first couple of meters, distance moves between 0.06 and 0.07/0.08 (meaning at every distance between 1 and a couple of meters we get 0.06 as wel as 0.07) 'for longer distances, the distance value becomes meaningfull but very noisy IF ISFALSE init THEN pPIR2 = GetPIR2Sensorpointer (0, -1) DIALOG NEW 0, "Pir2Mon", 200,104,279,154, %WS_CAPTION,%WS_EX_TOOLWINDOW TO hwPir2 CONTROL ADD GRAPHIC, hwPir2, 100,"", 2, 2, 70, 70 'angle + distance CONTROL ADD GRAPHIC, hwPir2, 200,"", 74, 2, 40, 70 'avgx CONTROL ADD GRAPHIC, hwPir2, 300,"", 116, 2, 40, 70 'dx CONTROL ADD GRAPHIC, hwPir2, 400,"", 158, 2, 40, 70 'fx CONTROL ADD GRAPHIC, hwPir2, 1000, "", 200, 2, 77, 70 'voor de bittreintjes CONTROL ADD GRAPHIC, hwPir2, 500, "", 2, 74, 70, 70 'angle histogram CONTROL ADD GRAPHIC, hwPir2, 600, "", 74,74, 40, 70 'avgs histo CONTROL ADD GRAPHIC, hwPir2, 700, "", 116,74, 40, 70 'avgs histo CONTROL ADD GRAPHIC, hwPir2, 800, "", 158,74, 40, 70 'avgs histo DIALOG SHOW MODELESS hwPir2 DIM havgl(500): DIM havgc(500): DIM havgr(500) DIM hdist(1000): DIM hang(100 * Pi2) mxav = 1: mxang = 1: mxdist = 1 init = 1 tt = timegettime + 30000 END IF IF (tt <> 0) AND (tt < timegettime) THEN 'na inregeltijd: histogram reset warning "resetting histograms" RESET havgl(), havgc(), havgr(), hang() tt = 0 END IF INCR swp swp = swp MOD 4 IF @pPir2.avgl > UBOUND(havgl) THEN Warning FUNCNAME$ + ": avgl higher then expected" ELSE INCR havgl(@pPir2.avgl) mxav = MAX(mxav, havgl(@pPir2.avgl)) END IF IF @pPir2.avgc > UBOUND(havgc) THEN Warning FUNCNAME$ + ": avgc higher then expected" ELSE INCR havgc(@pPir2.avgc) mxav = MAX(mxav, havgc(@pPir2.avgc)) END IF IF @pPir2.avgr > UBOUND(havgr) THEN Warning FUNCNAME$ + ": avgr higher then expected" ELSE INCR havgr(@pPir2.avgr) mxav = MAX(mxav, havgr(@pPir2.avgr)) END IF IF @pPir2.distance <= 1 THEN INCR hdist(INT(@pPir2.distance * 1000)) mxdist = MAX(mxdist, hdist(INT(@pPir2.distance * 1000))) ELSE Warning FUNCNAME$ + ": distance higher then expected" END IF IF @pPir2.angle < Pi2 THEN ' logfile "mxang - ang" + STR$(mxang) + STR$(@pPir2.angle) + STR$(hang(INT(@pPir2.angle * 100)) ) INCR hang(INT((Pi + @pPir2.angle) * 100)) mxang = MAX(mxang, hang(INT((Pi + @pPir2.angle) * 100))) ELSE Warning FUNCNAME$ + ": angle higher then expected:" + STR$(@pPir2.angle) END IF GRAPHIC ATTACH hwPir2, 100 + 100 * swp, REDRAW GRAPHIC SCALE (-100,1300) - (1100, -100) 'so the bargraphs are in the region 0->1 GRAPHIC CLEAR %WHITE GRAPHIC WIDTH 1 GRAPHIC STYLE 0 GRAPHIC COLOR %BLACK, %WHITE GRAPHIC FONT "Lucida Console", 8, 0 GRAPHIC SET POS (0, 1190) SELECT CASE swp CASE 0 'draw distance and angle GRAPHIC PRINT "angle * distancee" GRAPHIC ELLIPSE (0,1000)-(1000,0), &HCCCCCC, 0 GRAPHIC WIDTH 1 GRAPHIC COLOR %WHITE xx = 500 + 500 * COS(@pPir2.angle) : yy = 500 + 500 * SIN(@pPir2.angle) GRAPHIC LINE (500,500) - (xx, yy) GRAPHIC WIDTH 3 GRAPHIC COLOR RGB(200,0,0) 'log scaling xx = 500 + 500 * COS(@pPir2.angle) * SQR(@pPir2.distance): yy = 500 + 500 * SIN(@pPir2.angle) * SQR(@pPir2.distance) GRAPHIC LINE (500,500) - (xx, yy) GRAPHIC COLOR %RED, %WHITE GRAPHIC SET POS (0, 0) GRAPHIC PRINT "d:" + FORMAT$(@pPir2.distance, "0.00") GRAPHIC REDRAW 'histogram GRAPHIC ATTACH hwPir2, 500, REDRAW GRAPHIC SCALE (-100,1300)-(1100,-100) GRAPHIC CLEAR %WHITE GRAPHIC WIDTH 1 GRAPHIC SET POS (0,1190) GRAPHIC COLOR %BLACK, %WHITE GRAPHIC FONT "Lucida Console", 8, 0 GRAPHIC PRINT "angle histo" + STR$(mxang) GRAPHIC ELLIPSE (0,1000) - (1000, 0) GRAPHIC ELLIPSE (0,1000)-(1000,0), &HCCCCCC, 0 GRAPHIC COLOR RGB(200,0,0) FOR i = LBOUND(hang) TO UBOUND(hang) xx = 500 + 500 * hang(i)/mxang * COS(i/100 - Pi): yy = 500 + 500 * hang(i)/mxang * SIN(i/100- Pi) GRAPHIC LINE (500,500)-(xx,yy) NEXT CASE 1 'avgx 'empty bars GRAPHIC PRINT "avg" GRAPHIC BOX (0, 0)- (1000/5, 1000), 10, 10, &HCCCCCC, 0 GRAPHIC BOX (2000/5, 0)- (3000/5, 1000), 10, 0, &HCCCCCC, 0 GRAPHIC BOX (4000/5, 0)- (5000/5, 1000), 10, 0, &HCCCCCC, 0 GRAPHIC BOX (0, 0) - (1000/5, @pPir2.avgl * 2), 20, 0, RGB(200,200,0) GRAPHIC BOX (2000/5, 0) - (3000/5, @pPir2.avgc * 2), 20, 0, RGB(0,200,0) GRAPHIC BOX (4000/5, 0) - (5000/5, @pPir2.avgr * 2), 20, 0, RGB(200,0,200) GRAPHIC REDRAW 'histogram of average GRAPHIC SET POS (0, 1190) GRAPHIC PRINT "avgl histo" GRAPHIC ATTACH hwPir2, 600, REDRAW GRAPHIC SCALE (-100, 1300)-(550, -100) GRAPHIC CLEAR %WHITE GRAPHIC WIDTH 2 GRAPHIC STYLE 0 GRAPHIC COLOR %BLACK, %WHITE FOR i = LBOUND(havgl) TO UBOUND(havgl) GRAPHIC LINE (i, 0)-(i,1000 * havgl(i)/mxav), RGB(200,200,0) NEXT GRAPHIC REDRAW 'bit trains 'although we scale it to the nr of pixels it is wide, there stay gaps between the lines and they are not 100% evenly distributed GRAPHIC ATTACH hwPir2, 1000, REDRAW GRAPHIC SCALE(-10, 1300)-(66, -100) GRAPHIC CLEAR %WHITE GRAPHIC WIDTH 1 GRAPHIC STYLE 0 GRAPHIC COLOR &H0AAAAAA, %WHITE GRAPHIC LINE (0,0)-(64, 0) GRAPHIC LINE (0,300)-(64, 300) GRAPHIC LINE (0,600)-(64, 600) GRAPHIC COLOR %BLACK, %WHITE FOR i = 0 TO 63 IF BIT(@pPir2.lefttrain, i) THEN GRAPHIC LINE (i, 0) - (i, 200), RGB(200 * i/64, 200 * i/64, 0) IF BIT(@pPir2.CENTERTrain, i) THEN GRAPHIC LINE (i, 400) - (i, 600), RGB(0, 200*i/64,0) IF BIT(@pPir2.RIGHTtrain, i) THEN GRAPHIC LINE (i, 800) - (i, 1000), RGB(200*i/64, 0, 200*i/64) ' 'aliasing test: ' graphic line (i, 50)-(i, 55), rgb(i*4, 0, 0) NEXT CASE 2 'dx GRAPHIC PRINT "dur" GRAPHIC BOX (0, 0)- (1000/5, 1000), 10, 10, &HCCCCCC, 0 GRAPHIC BOX (2000/5, 0)- (3000/5, 1000), 10, 0, &HCCCCCC, 0 GRAPHIC BOX (4000/5, 0)- (5000/5, 1000), 10, 0, &HCCCCCC, 0 GRAPHIC BOX (0, 0) - (1000/5, @pPir2.dleft /1.023), 20, 0, RGB(200,200,0) GRAPHIC BOX (2000/5, 0) - (3000/5, @pPir2.dcenter /1.023), 20, 0, RGB(0,200,0) GRAPHIC BOX (4000/5, 0) - (5000/5, @pPir2.dright/1.023 * 2), 20, 0, RGB(200,0,200) GRAPHIC REDRAW 'histogram of average GRAPHIC SET POS (0, 1190) GRAPHIC PRINT "avgc histo" GRAPHIC ATTACH hwPir2, 700, REDRAW GRAPHIC SCALE (-100, 1300)-(550, -100) GRAPHIC CLEAR %WHITE GRAPHIC WIDTH 2 GRAPHIC STYLE 0 GRAPHIC COLOR %BLACK, %WHITE FOR i = LBOUND(havgc) TO UBOUND(havgc) GRAPHIC LINE (i, 0)-(i,1000 * havgc(i)/mxav), RGB(0,200,0) NEXT CASE 3 'fx - scale?? GRAPHIC PRINT "freq" GRAPHIC BOX (0, 0)- (1000/5, 1000), 10, 10, &HCCCCCC, 0 GRAPHIC BOX (2000/5, 0)- (3000/5, 1000), 10, 0, &HCCCCCC, 0 GRAPHIC BOX (4000/5, 0)- (5000/5, 1000), 10, 0, &HCCCCCC, 0 GRAPHIC BOX (0, 0) - (1000/5, @pPir2.fleft * 20), 20, 0, RGB(200,200,0) GRAPHIC BOX (2000/5, 0) - (3000/5, @pPir2.fcenter * 20), 20, 0, RGB(0,200,0) GRAPHIC BOX (4000/5, 0) - (5000/5, @pPir2.fright * 20), 20, 0, RGB(200,0,200) GRAPHIC REDRAW 'histogram of average GRAPHIC SET POS (0, 1190) GRAPHIC PRINT "avgr histo" GRAPHIC ATTACH hwPir2, 800, REDRAW GRAPHIC SCALE (-100, 1300)-(550, -100) GRAPHIC CLEAR %WHITE GRAPHIC WIDTH 2 GRAPHIC STYLE 0 GRAPHIC COLOR %BLACK, %WHITE FOR i = LBOUND(havgr) TO UBOUND(havgr) GRAPHIC LINE (i, 0)-(i,1000 * havgr(i)/mxav), RGB(200,0,200) NEXT END SELECT GRAPHIC REDRAW END SUB '[EOF]