'kopiel trash bin '020229 'FUNCTION SetBetaSample2(a AS SINGLE, b AS SINGLE, BYVAL freq AS LONG) AS LONG ' LOCAL sini AS SINGLE 'fails if registered ' LOCAL i AS EXT 'only ext precision floats are registered ' LOCAL normval AS EXT ' LOCAL scaletofreq AS EXT ' LOCAL tog AS LONG ' DIM Sample(%CD_SR * 2 - 1) AS STATIC INTEGER '%CD_SR * 2 / 2 *2 for stereo /2 for 500ms ' DIM Sample1(%CD_SR * 2 - 1) AS STATIC INTEGER ' ScaleToFreq = (freq * Pi / %CD_SR) 'Pi2/2 = Pi because beta transform doubles freq [generates ERR: D phase between samples] ''* 2/ 2 *2 for 500ms '/2 for stereo!! ' normval = (a^a * b^b/(a + b)^(a + b)) ' IF tog THEN 'tog structure so we can keep on playing while were computing a new sample in the other array (aka double buffering) ' tog = %false ' FOR i = 0 TO UBOUND(Sample) ' sini = SIN(i * ScaleToFreq) ' Sample(i) = SGN(sini) * &H7000 ' Sample(i) = Sample(i) * ((ABS(sini) ^ a * (1 - ABS(sini)) ^b)/normval )'( GetBetaValue(ABS(sini), a, b, normval) ) ' NEXT ' pBetaSample2 = VARPTR(Sample(0)) ' ELSE ' tog = %true ' FOR i = 0 TO UBOUND(Sample1) ' sini = SIN(i * ScaleToFreq) ' Sample1(i) = SGN(sini) * &H7000 ' Sample1(i) = Sample1(i) * ((ABS(sini) ^ a * (1 - ABS(sini)) ^b)/normval )'( GetBetaValue(ABS(sini), a, b, normval) ) ' NEXT ' pBetaSample2 = VARPTR(Sample1(0)) ' END IF 'FUNCTION CreateSliderWindow(id AS LONG) AS LONG ' static hDlg AS LONG ' static hDC AS LONG ' static hPen AS LONG ' static trect AS rect ' static a AS SINGLE, b AS SINGLE, f AS LONG ' LOCAL tekst AS ASCIIZ * 10 ' LOCAL rechthoek AS fourlongs ' IF id = 0 THEN ' DIALOG NEW %HWND_DESKTOP, "param window",1,1,160,230 TO hDlg1 ' ' MSGBOX STR$(hdlg1) ' hDlg = hDlg1 ' ELSEIF id = 1 THEN ' ' MSGBOX "1" ' DIALOG NEW %HWND_DESKTOP, "param window2",1,240,160,230 TO hDlg2 ' ' MSGBOX STR$(hdlg2) ' hDlg = hDlg2 ' END IF ' ' ' DIALOG SHOW MODELESS hDlg, CALL CBSliderwindow ' 'init drawing stuff ' hDC = GetDC(hDlg) ' GetClientRect hDlg, RechtHoek', Rechthoek ' PatBlt hDC,0,0,Rechthoek.b, Rechthoek.h, %WHITENESS' Rechthoek.x, RechtHoek.y, Rechthoek.b, Rechthoek.h, %WHITENESS ' ' MSGBOX "white" ' hPen = CreatePen (%PS_SOLID,1, RGB(&HAA, &H44,&H66) ) ' SelectObject hDc, hPen ' 'draw freq slider ' MoveTo hDC, 10, 10 ' LineTo hDC, 20,10 ' LineTo hDC, 20,310 ' LineTo hDC, 10, 310 ' LineTo hDC, 10, 10 ' DeleteObject hPen ' 'draw a slider ' hPen = CreatePen (%PS_SOLID, 1, RGB(&HAA, &HAA, &H44)) ' SelectObject hDC, hPen ' MoveTo hDC, 100, 10 ' LineTo hDC, 110, 10 ' LineTo hDC, 110, 210 ' LineTo hDC, 100, 210 ' LineTo hDC, 100, 10 ' 'draw b slider ' MoveTo hDC, 150, 10 ' LineTo hDC, 160, 10 ' LineTo hDC, 160, 210 ' LineTo hDC, 150, 210 ' LineTo hDC, 150, 10 ' DeleteObject hPen ' 'draw freq valueline ' hPen = CreatePen (%PS_SOLID,1, RGB(&HAA,&H44,&H66))',0,0) ) ' SelectObject hDC, hPen ' MoveTo hDC, 10, 310 - SQR(8 * 400) 'formula for placement of freq ' LineTo hDC, 20, 310 - SQR(8 * 400) ' DeleteObject hPen ' 'draw a valueline ' hPen = CreatePen (%PS_SOLID, 1, RGB(&HAA, &HAA, &H44)) ' SelectObject hDC, hPen ' MoveTo hDC, 100, 210 - 50 * SQR( 1) ' LineTo hDC, 110, 210 - 50 * SQR( 1) ' 'draw b valueline ' MoveTo hDC, 150, 210 - 50 * SQR(1.2) ' LineTo hDC, 160, 210 - 50 * SQR(1.2) ' 'write freq label ' SetTextColor hDC, RGB(&HAA, &H44, &H66) ' SetRect trect, 1, 320, 210, 338 ' tekst = "freq:" ' DrawText hDC, tekst, -1, tRect, %DT_LEFT ' 'write a label ' SetTextColor hDC, RGB(&HAA, &HAA, &H44) '&H000000FF ' red ' tekst="a:" ' SetRect trect, 100, 220, 210, 338 ' DrawText hDC, tekst, -1, tRect, %DT_LEFT ' 'write b label ' tekst = "b:" ' SetRect trect, 150,220,210,338 ' DrawText hDC, tekst, -1, tRect, %DT_LEFT ' 'write freq value ' SetRect trect, 1, 340, 210, 358 ' SetTextColor hDC, RGB(&HAA, &H44, &H66) ' tekst =TRIM$(STR$( INT(((310 -400)^2)/8) ) + " Hz" + STRING$(8,"_")) ' DrawText hDC, tekst, -1, tRect, %DT_LEFT ' 'write a value ' SetTextColor hDC, RGB(&HAA, &HAA, &H44) '&H000000FF ' red ' SetRect trect, 100, 240, 210, 358 ' tekst ="1" 'TRIM$( STR$( ((210 - 50 * SQR(2 * 1 ))*1000)/1000 ) ) '+ " Hz" '+ STRING$(8,"_")) ' DrawText hDC, tekst, -1, tRect, %DT_LEFT ' 'write b value ' SetRect trect, 150, 240, 210, 358 ' tekst ="1.2" 'TRIM$( STR$( ((210 - 50 * SQR(2 * 1 ))*1000)/1000 ) ) '+ " Hz" '+ STRING$(8,"_")) ' DrawText hDC, tekst, -1, tRect, %DT_LEFT ' ' 'cleanup ' DeleteObject hPen ' ReleaseDC hDlg, hDC ' ' 'END FUNCTION CALLBACK FUNCTION CBSLiderwindow 'NOT (yet) a general purpouse slider LOCAL hDC AS LONG LOCAL hPen AS LONG LOCAL lpPaint AS PaintStruct LOCAL trect AS rect LOCAL id AS LONG LOCAL tekst AS ASCIIZ * 10 STATIC init AS LONG STATIC mouseX() AS LONG, mouseY() AS LONG STATIC freqY() AS LONG, freqVal() AS LONG STATIC aY() AS LONG, aVal() AS SINGLE STATIC bY() AS LONG, bVal() AS SINGLE IF ISFALSE init THEN DIM mouseX(0 TO 7) 'max 8 - take to much place to have more DIM mouseY(0 TO 7) DIM freqY(0 TO 7) DIM freqval(0 TO 7) DIM aY(0 TO 7) DIM aval(0 TO 7) DIM bY(0 TO 7) DIM bval(0 TO 7) FOR id = 0 TO 7 FreqVal(id) = 400 FreqY(id) = 310 - SQR(8 * FreqVal(id)) aVal(id) = 1 aY(id) = 210 - 50 * SQR(aVal(id)) bVAl(id) = 1.2 bY(id) = 210 - 50 * SQR(bVal(id)) NEXT init = %true END IF SELECT CASE CBHNDL CASE hDlg1 id = 0 CASE hDlg2 id = 1 CASE ELSE MSGBOX "ERR: unexpected window handle",,"gmt_k.CBSliderwindow" END SELECT hDc = GetDC(CBHNDL) SELECT CASE CBMSG CASE %WM_CREATE 'we don't get this guess pb intercepts it?? MSGBOX "msg WM_CREATE received",,"CBMain" CASE %WM_COMMAND SELECT CASE CBCTL END SELECT CASE %WM_CLOSE CASE %WM_PAINT ' getClientRect hDC, tRect ' RedrawWindow CBHNDL,tRect,0,%RDW_UPDATENOW 'CAUSES FATAL CRASH CASE %WM_MOUSEMOVE ' this is included here only to demonstrate the coding... mouseX(id) = LOWRD(CBLPARAM) mouseY(id) = HIWRD(CBLPARAM) CASE %WM_LBUTTONUP IF (mouseX(id) > 10) AND (MouseX(id) <= 20) AND (MouseY(id) > 10) AND (MouseY(id)<310) THEN hPen = CreatePen (%PS_SOLID,1,RGB(&HFF,&HFF,&HFF)) SelectObject hDc, hPen MoveTo hDC, 11,freqY(id) LineTo hDC, 19, freqY(id) DeleteObject hPen hPen = CreatePen (%PS_SOLID,1,RGB(&HAA,&H44,&H66)) SelectObject hDC, hPen freqY(id) = mouseY(id) MoveTo hDC, 11, freqY(id) LineTo hDC, 19, freqY(id) DeleteObject hPen ' SetBetaSample 1, 1.2, ((310 - freqY)^2)/8 SetTextColor hDC, RGB(&HAA, &H44, &H66) '&H000000FF ' red SetRect trect, 1, 340, 210, 358 freqVal(id) = ( (310 - freqY(id)) ^ 2 ) / 8 tekst =TRIM$(STR$(INT(freqVal(id) ), 6) + " Hz" + STRING$(8,"_") ) DrawText hDC, tekst, -1, tRect, %DT_LEFT ELSEIF (MouseY(id) >10) AND (MouseY(id) < 210) THEN IF (MouseX(id) >= 100) AND (MouseX(id) <= 110) THEN hPen = CreatePen (%PS_SOLID,1,RGB(&HFF,&HFF,&HFF)) SelectObject hDC, hPen MoveTo hDC, 101, aY(id) LineTo hDC, 109, aY(id) DeleteObject hPen hPen = CreatePen (%PS_SOLID,1,RGB(&HAA,&HAA,&H66)) SelectObject hDC, hPen aY(id) = mouseY(id) MoveTo hDC, 101, aY(id) LineTo hDC, 109, aY(id) DeleteObject hPen SetTextColor hDC, RGB(&HAA, &HAA, &H66) '&H000000FF ' red SetRect trect, 100, 240, 210, 358 aVal(id) = ( ( (210 - aY(id)) / 50 ) ^ 2 ) tekst =TRIM$( STR$( INT(aVal(id)*1000)/1000 ) ) '+ " Hz" '+ STRING$(8,"_")) DrawText hDC, tekst, -1, tRect, %DT_LEFT ELSEIF (MouseX(id) >= 150) AND (MouseX(id) <= 160) THEN hPen = CreatePen (%PS_SOLID,1,RGB(&HFF,&HFF,&HFF)) SelectObject hDC, hPen MoveTo hDC, 151, bY(id) LineTo hDC, 159, bY(id) DeleteObject hPen hPen = CreatePen (%PS_SOLID,1,RGB(&HAA,&HAA,&H66)) SelectObject hDC, hPen bY(id) = mouseY(id) MoveTo hDC, 151, bY(id) LineTo hDC, 159, bY(id) DeleteObject hPen SetTextColor hDC, RGB(&HAA, &HAA, &H66) '&H000000FF ' red SetRect trect, 150, 240, 210, 358 bVal(id) = ( ( (210 - bY(id)) / 50 ) ^ 2 ) tekst =TRIM$( STR$( INT(bVal(id)*1000)/1000 ) ) '+ " Hz" '+ STRING$(8,"_")) DrawText hDC, tekst, -1, tRect, %DT_LEFT END IF END IF IF CBHNDL = hDlg1 THEN SetBetaSample aVal(id), bVal(id), freqVal(id) ELSEIF CBHNDL = hDlg2 THEN SetBetaSample2 aVal(id), bVal(id), freqVal(id) END IF CASE %WM_SETFOCUS OR %WM_WINDOWPOSCHANGED getClientRect CBHNDL, tRect RedrawWindow CBHNDL,tRect,0,%RDW_UPDATENOW ' CASE %WM_MOUSEMOVE ' this is included here only to demonstrate the coding... ' CONTROL SET TEXT hDlgMain,500, STR$(LOWRD(CBLPARAM)) + "," + STR$(HIWRD(CBLPARAM)) ' SendMessage hStatus, %WM_SETTEXT, 0, VARPTR(zText) END SELECT END FUNCTION