#INCLUDE "c:\b\pb\gmt\kristof\audexp\AE.bi" DECLARE FUNCTION InitAudioExperiments AS LONG 'declare task subs DECLARE SUB AMaster 'master task DECLARE SUB P1 DECLARE SUB P2 DECLARE SUB P3 DECLARE SUB RecordWaves 'recorder task DECLARE SUB RecordGrains DECLARE SUB PlayWaves 'player Task DECLARE SUB RecWaveHandler 'other subs &functions DECLARE SUB IncrFc 'puts next file number in AE.FC DECLARE SUB GetFN() 'puts a filename in AE.filenam(fc) DECLARE SUB ToLog(a$) 'write string to log file DECLARE SUB Str_Mod(f1 AS LONG, f2 AS LONG) 'stretch to average length and modulate on each other, file numbera as argument DECLARE SUB Free(BYREF t AS LONG) 'frees the track and sets t to -1 DECLARE FUNCTION VarSpeed(f AS LONG, fakt AS SINGLE)AS INTEGER 'varispeed playbacktask, filenr and stretching faktor, does not change file, does immediate playback 'DECLARE FUNCTION GranusynthEx (GSD AS GrainSynthDataType) AS LONG '(BYREF GranAr() AS INTEGER,BYREF Overlap() AS SINGLE, BYVAL duration AS DWORD) AS LONG DECLARE FUNCTION AEStart() AS LONG DECLARE SUB GetGrainFileName(BYREF fn AS ASCIIZ * 15) 'globals GLOBAL AE AS AudExpType GLOBAL AE_NoiseFloor AS LONG GLOBAL Rt AS SINGLE GLOBAL Str AS SINGLE GLOBAL GrL AS LONG GLOBAL ToPlay AS ASCIIZ * 15 'contains names of files to be played FUNCTION InitAudioExperiments AS LONG ' AE_PrepareWaveFunctions WavHdr() TOO EARLY!!! 'doesitwork IF ISFALSE Audio.hwi THEN MSGBOX "please select wave input device first" FUNCTION =%false EXIT FUNCTION END IF IF ISFALSE Audio.hwo THEN MSGBOX "please select wave output device first" FUNCTION = %false EXIT FUNCTION END IF ButnSW(1).cptr = CODEPTR(AEStart) AE_NoiseFloor = %AENoiseFloor Rt = 80 Str = 3 GrL = 40 * %CD_SR/1000 Task(%AEMaster).naam = "Master" Task(%AEMaster).freq = 3 Task(%AEMaster).switch = %false'%true Task(%AEMaster).cptr = CODEPTR(AMaster) Task(%part1).naam = "P1" Task(%part1).freq = 3 Task(%part1).switch = %false Task(%part1).pan = 0 'functions as 'initialised' here Task(%part1).cptr = CODEPTR(P1) Task(%part2).naam = "P2" Task(%part2).freq = 0.191 Task(%part2).switch = %false Task(%part2).pan = 0 Task(%part2).cptr = CODEPTR(P2) Task(%part3).naam = "P3" Task(%part3).freq = .073 Task(%part3).switch = %false Task(%part3).pan = 0 Task(%part3).cptr = CODEPTR(P3) Task(%part4).naam = "P4" Task(%part4).freq = .4 Task(%part4).switch = %false Task(%part4).pan = 0 Task(%part4).cptr = CODEPTR(P4) Task(%RecTask).naam = "RecordIt" 'cont recording, writes useful data in separate track, send to RWH Task(%RecTask).freq = 10 'seems to be satisfying; was20 'not recomputed internally, should stay fixed Task(%RecTask).switch =%false Task(%RecTask).cptr =CODEPTR(RecordWaves) Task(%RWH).naam = "RecHand" 'finish and store info on tracknr passed in Task(%RWH).channel by RecordWaves Task(%RWH).freq = 5 Task(%RWH).switch = %false Task(%RWH).channel = 17 '= tracknr; nothing to save right now so we take an invalid one (recogd by sub) Task(%RWH).cptr = CODEPTR(RecWaveHandler) Task(%PlayTask).naam = "PlayIt" 'plays wave in global ToPlay &resets it Task(%PlayTask).freq = 1 Task(%PlayTask).switch = %false Task(%PlayTask).cptr = CODEPTR(PlayWaves) Task(%Monitor).naam = "Monit" 'keep track of slider controlled global vars Task(%Monitor).freq = 1 Task(%Monitor).switch = %false Task(%Monitor).cptr=CODEPTR(AE_Monitor) StartWaveOutStream %AudioStreamCallBack FUNCTION = %true END FUNCTION FUNCTION AEStart AS LONG ' MSGBOX "start AE" AE_PrepareWaveFunctions WavHdr() StartStopToggle 'GMT function StartTask %AEMaster StartTask %RecTask StartTask %PlayTask StartTask %Monitor END FUNCTION SUB AE_Monitor 'monitor sliders n stuff and set according variables STATIC tasknr AS LONG STATIC Slnr() AS LONG STATIC nrSlr AS LONG STATIC TaskParamLabels() AS ASCIIZ * 8 LOCAL i AS LONG IF ISFALSE(tasknr) THEN tasknr = %Monitor nrSlr = 3 'nr of sliders - 1 DIM Slnr(0 TO nrSlr) DIM TaskParamLabels(0 TO NrSlr) 'slider 0 is for the noisefloor ' 1 grainlength ' 2 gransynth density (* 10, as sliders are integers) ' 3 stretch fakt (*10 TaskParamLabels(0) = "NzFl" TaskParamLabels(1) = "gLen TaskParamLabels(2) = "gRep" TaskParamLabels(3)="gStr" ' MakeTaskParameterDialog %Demo_ScaleUP,2,Slider(),0,UDctrl(),TaskParamLabels() MakeTaskParameterDialog BYVAL tasknr,nrSlr + 1,Slider(),0,UDctrl(),TaskParamLabels() FOR i = 0 TO nrSlr Slnr(i) = TaskEX(tasknr).SliderNumbers(i) NEXT Slider(slnr(0)).minval = 200 Slider(slnr(0)).maxval = 2500 Slider(slnr(0)).stap = 20 Slider(slnr(0)).value = AE_NoiseFloor Slider(slnr(1)).minval = 5 Slider(slnr(1)).maxval = 200 Slider(slnr(1)).stap = 2 Slider(slnr(1)).value = GrL *1000/%CD_SR Slider(slnr(2)).minval = 5 Slider(slnr(2)).maxval = 200 Slider(slnr(2)).stap = 2 Slider(slnr(2)).value=Rt Slider(slnr(3)).minval = 1 Slider(slnr(3)).maxval = 100 Slider(slnr(3)).stap = 1 Slider(slnr(3)).value = Str * 10 FOR i = 0 TO nrSlr SendMessage Slider(slnr(i)).h, %TBM_SETRANGE,%True, MakeLong(Slider(slnr(i)).minval, Slider(slnr(i)).maxval) SendMessage Slider(slnr(i)).h, %TBM_SETPAGESIZE,0,Slider(Slnr(i)).stap SendMessage Slider(Slnr(i)).h, %TBM_SETPOS,%True, Slider(Slnr(i)).value NEXT END IF AE_NoiseFloor = Slider(slnr(0)).value GrL = Slider(slnr(1)).value * %CD_SR / 1000 Rt = Slider(slnr(2)).value 'SQR(Slider(slnr(2)).value ) /40 '/ 10 Str = Slider(slnr(3)).value / 10 END SUB SUB AMaster STATIC fn() AS ASCIIZ *15 'filename LOCAL track AS LONG LOCAL GrainLength AS DWORD LOCAL NrGrains AS DWORD LOCAL Arr() AS INTEGER LOCAL duur AS DWORD LOCAL i AS DWORD LOCAL dummy AS LONG ' MSGBOX "Master: " + STR$(task(%AEMaster).patch) ' ToLog "Master" SELECT CASE task(%AEMaster).patch 'patch holds counter for events in composition CASE %false INCR task(%AEMaster).patch StartTask %Part1 EXIT SUB CASE 1 IF BIT (AE.flag, 6) THEN ' ToLog "M: start P2" INCR task(%AEMaster).patch StartTask %Part2 StartTask %Part3 EXIT SUB END IF CASE 2 IF ISFALSE BIT (AE.flag, 6) THEN '!!! bit toggle I - 0 > hier 0 = verander ! ' ToLog "M: start P3" INCR task(%AEMaster).patch BIT RESET AE.flag, 6 StopTask %Part2 StopTask %Part1 StartTask %Part4 EXIT SUB END IF END SELECT IF BIT(AE.flag, 3) THEN 'new sample recorded BIT RESET AE.flag, 3 SELECT CASE task(%AEMAster).patch CASE 1 ' MSGBOX "msg to p1 from master" BIT SET AE.flag, 5 CASE 2 BIT SET AE.flag, 5 'bit set AE.flag, 7 'task(%part2).freq = task(%part2).freq / 2 CASE ELSE END SELECT END IF EXIT SUB END SUB SUB P1 'we split the piece in several submaster parts STATIC Grain AS GrainType 'those are static for the case we would use teh grainsynths as threads STATIC GSD AS GrainSynthDataType 'so the data aren't removed when the sub is at its end LOCAL track AS LONG STATIC Arr()AS INTEGER 'these must be static STATIC overl() AS SINGLE 'as the pointers are passed to other functions STATIC ub() AS DWORD 'otherwise the variables are released to soon STATIC lb()AS DWORD 'and accessing their pointers then causes crashes STATIC cFiles AS DWORD IF ISFALSE task(%Part1).switch AND %TASK_BUSY THEN MSGBOX "P1 not busy, exit now" EXIT SUB END IF IF Toplay <>"" THEN EXIT SUB IF task(%part1).pan < 1THEN 'serves as initialised toggle here.. BIT SET task(%part1).pan, 0 DIM Arr(0 TO 1) 'dummy dimensioning to make redim possible DIM overl(0 TO 3) 'fill in dimensions and values that don't change here overl(0) = 3:overl(1) = 1: overl(2) = .5:overl(3) = .5 DIM lb(0 TO 2):DIM ub(0 TO 2) Grain.length = 820 '20 ms GSD.lLb = UBOUND(lb) +1 :GSD.lUb = UBOUND(Ub) + 1 :GSD.lOverl = UBOUND(overl) + 1 END IF 'when using threads, we will have to check also if thread is finished/busy... IF BIT (AE.flag, 5) THEN BIT RESET AE.flag, 5 SELECT CASE AE.duur(AE.FC-1) CASE < 20 EXIT SUB CASE < 1500 'tussen 20 en 1500 ms track = ReadWaveData(AE.filenam(AE.FC-1)) IF track < 0 THEN BIT SET AE.flag, 5: EXIT SUB 'retry Grain.length = 820 Grain.nr = CalcNrOfGrains(track, Grain.length) REDIM Arr(0 TO (Grain.nr * Grain.length) - 1) Grain.pArr = VARPTR(Arr(0)) 'to where the data are ! AE_GranulateTrack track, 2, Grain Free track lb(0) = 0:lb(1) = UBOUND(Arr, 1)-2:lb(2) = 0 ub(0) = 1:ub(1) = UBOUND(Arr,1) :ub(2) = UBOUND(arr, 1) GSD.pGrain = VARPTR(Grain) GSD.pLb = VARPTR(lb(0)) :GSD.pUb = VARPTR(ub(0)) :GSD.pOverl = VARPTR(overl(0)) GSD.duration = AE.duur(AE.FC-1) * 2 track = GranuSynthStoch(GSD) IF track < 0 THEN BIT SET AE.flag, 5: EXIT SUB 'retry INCR cFiles ToPlay = "P1"+STR$(cfiles)+".wav" WriteAudioTrack ToPlay, WavHdr(track) Free track EXIT SUB CASE ELSE EXIT SUB END SELECT ELSE SELECT CASE cFiles CASE >5 BIT SET AE.flag, 6 IF task(%part1).patch<5 THEN INCR task(%part1).patch '= 1 task(%part1).freq = task(%part1).freq * 1.8 ToPlay = "P1"+STR$(INT(1+RND*5))+".wav" EXIT SUB END IF task(%part1).patch = %false task(%part1).freq = .5'0.4 '2 CASE >0 ToPlay = "P1"+STR$(INT(((cfiles)*RND) + 1 ))+".wav" 'not always played - nevermind, checking prbbly takes mor time END SELECT 'END IF END IF END SUB SUB P2 STATIC Grain AS GrainType STATIC GSD AS GrainSynthDataType STATIC count AS LONG STATIC cfiles AS LONG STATIC Arr() AS INTEGER LOCAL track AS LONG STATIC overl() AS SINGLE STATIC lb() AS DWORD STATIC ub() AS DWORD STATIC pGSD AS GrainSynthDataType PTR INCR cfiles IF task(%part2).pan < 1 THEN BIT SET task(%part2).pan, 0 DIM Arr(0 TO 1) 'init to make redim possible Grain.length = 820 'fill in static data here DIM overl(0 TO 0) overl(0) = .5':overl(1) = 1: overl(2) = .5:overl(3) = .5 DIM lb(0 TO 2):DIM ub(0 TO 2) END IF IF cfiles > 6 THEN 'files 1 - 6 al opgenomen... cfiles = 1 END IF INCR count IF count > 12 THEN ERASE Arr, overl, ub, lb 'no we can't use this anymore !! don't restart task (?) BIT RESET AE.flag, 6 'indeed , reset, the toggeling of of this bit toggles master to new event! EXIT SUB END IF task(%part2).patch = cfiles track = ReadWaveData("P1"+STR$(cfiles)+".wav") IF track < 0 THEN DECR cFiles:DECR count: EXIT SUB 'retry Grain.nr = CalcNrOfGrains(track, Grain.Length) REDIM Arr(0 TO (Grain.Nr * Grain.Length) - 1) Grain.pArr = VARPTR(arr(0)) AE_GranulateTrack track, 2, Grain GSD.pGrain = VARPTR(Grain) Free track lb(0) = 0:lb(1) = UBOUND(Arr, 1)-2:lb(2) = 0 ub(0) = 1:ub(1) = UBOUND(Arr,1) :ub(2) = UBOUND(arr, 1) GSD.pOverl = VARPTR(overl(0)): GSD.lOverl = UBOUND(overl) + 1 GSD.pLb = VARPTR(lb(0)) : GSD.lLb = UBOUND(lb) + 1 GSD.pUb = VARPTR(ub(0)) : GSD.lUb = UBOUND(ub) + 1 GSD.duration = AE.duur(AE.FC-1) * 1.5 'pGSD = VARPTR(GSD) track = GranuSynthStoch (GSD) ' GranuSynthStoch pGSD IF track < 0 THEN DECR cFiles:DECR count: EXIT SUB 'retry ToPlay = "P1"+STR$(cFiles)+".wav" WriteAudioTrack ToPlay, WavHdr(track) 'kan dit crashes veroorzaken? > als ToPlay begint voor writetrack? Free track END SUB SUB P3 STATIC Grain AS GrainType STATIC GSD AS GrainSynthDataType STATIC track AS LONG STATIC arr() AS INTEGER STATIC overl() AS SINGLE STATIC cfiles AS LONG IF Task(%part3).pan < 1 THEN BIT SET Task(%part3).pan, 0 DIM Arr(0 TO 1) 'dummy init DIM overl(0 TO 3) overl(0) = .1:overl(1) = .1:overl(2) = .11:overl(3) = .12 END IF IF (AE.duur(AE.FC-1) < 50) OR (AE.duur(AE.FC-1) >2000) THEN EXIT SUB track = ReadWaveData(AE.filenam(AE.FC-1)) IF track < 0 THEN EXIT SUB Grain.length = 410 '10ms Grain.Nr = CalcNrOfGrains(track, Grain.Length) REDIM Arr(0 TO (Grain.NR * Grain.Length) - 1) Grain.pArr= VARPTR(Arr(0)) AE_GranulateTrack track, 2, Grain Free track GSD.pGrain = VARPTR(Grain) GSD.pOverl = VARPTR(overl(0)) : GSD.lOverl = UBOUND(overl) + 1 GSD.duration = 3000 track = GranuSynthEx (GSD) IF track < 0 THEN EXIT SUB INCR cfiles ToPlay = "P3" + STR$(cFiles)+".wav" WriteAudioTrack Toplay, WavHdr(track) Free track END SUB SUB P4 STATIC cnt AS DWORD LOCAL track AS LONG LOCAL file AS DWORD INCR cnt SELECT CASE cnt CASE < 6 Task(%part4).freq = 1 ToPlay = "P1"+STR$(6 - cnt)+".wav" track = ReadWaveData(Toplay) IF track < 0 THEN DECR cnt: EXIT SUB 'try again NormalizeWave WavHdr(track), 20 WriteAudioTrack ToPlay,WavHdr(track) Free track CASE < 32 Task(%part4).freq = 3 file = 1 + RND * 5 ToPlay = "P1"+STR$(file)+".wav" CASE < 38 '32 - 37 Task(%part4).freq = .6 ToPlay = "P1"+STR$(38-cnt)+".wav" track = ReadWaveData(Toplay) IF track < 0 THEN DECR cnt: EXIT SUB 'try again ResizeAudioTrack track, TrackDuration(track) * 1.2 WaveAddReverb WavHdr(track),200,0.7 WriteAudioTrack ToPlay,WavHdr(track) Free track CASE < 40 file = 1 + RND * 5 ToPlay = "P1"+STR$(file)+".wav" CASE < 46 Task(%part4).freq = 1 ToPlay = "P1"+STR$(46 - cnt)+".wav" track = ReadWaveData(Toplay) IF track < 0 THEN DECR cnt: EXIT SUB 'try again NormalizeWave WavHdr(track), 30 WriteAudioTrack ToPlay,WavHdr(track) Free track CASE < 48 file = 1 + RND * 5 ToPlay = "P1"+STR$(file)+".wav" CASE < 54 '48 - 53 Task(%part4).freq = .52 ToPlay = "P1"+STR$(54-cnt)+".wav" track = ReadWaveData(Toplay) IF track < 0 THEN DECR cnt: EXIT SUB 'try again ResizeAudioTrack track, TrackDuration(track) * 1.2 WaveAddReverb WavHdr(track),100,0.7 WriteAudioTrack ToPlay, WavHdr(track) Free track CASE < 60 Task(%part4).freq = 3 file = 1 + RND * 5 ToPlay = "P1"+STR$(file)+".wav" CASE < 66 Task(%part4).freq = .47 ToPlay = "P1"+STR$(66-cnt)+".wav" track = ReadWaveData(Toplay) IF track < 0 THEN DECR cnt: EXIT SUB 'try again ResizeAudioTrack track, TrackDuration(track) * 1.2 WaveAddReverb WavHdr(track),100,0.7 WriteAudioTrack ToPlay,WavHdr(track) Free track CASE < 72 task(%part4).freq = 3 file = 1 + RND * 5 ToPlay = "P1"+STR$(file)+".wav" CASE < 78 Task(%part4).freq = 1 ToPlay = "P1"+STR$(78 - cnt)+".wav" track = ReadWaveData(Toplay) IF track < 0 THEN DECR cnt: EXIT SUB 'try again NormalizeWave WavHdr(track), 40 WriteAudioTrack ToPlay,WavHdr(track) Free track CASE 78 Task(%part4).freq = 4 CASE 120 TO 126 Task(%part4).freq = .41 ToPlay = "P1"+STR$(127-cnt)+".wav" track = ReadWaveData(Toplay) IF track < 0 THEN DECR cnt: EXIT SUB 'try again ResizeAudioTrack track, TrackDuration(track) * 1.2 WaveAddReverb WavHdr(track),100,0.7 WriteAudioTrack ToPlay,WavHdr(track) Free track CASE 127 Task(%part4).freq = 5 CASE ELSE file = 1 + RND * 5 ToPlay = "P1"+STR$(file)+".wav" END SELECT END SUB SUB RecordWaves 'debugged and ok, buth watch out with assigning and freeing tracks that could allready be in use!!! 'look for a sound, preceeded and followed by silence, put it in a track, pass the number to RWH STATIC TrackRead AS LONG 'van recordbuffer STATIC TrackWrite AS LONG 'naar bijhoud buffer STATIC initialised AS INTEGER STATIC TLastRead AS DWORD 'tijd v/ einde laatst lezing v e stuk v d buffer in ms STATIC pGenRead AS INTEGER PTR ' pointer to information read from buffer that is being recorded STATIC pGenWrite AS INTEGER PTR 'pointer to place in trackwrite where new information will be stored STATIC SampCall AS WORD 'samples per call of this task '!! make constants for this ?? STATIC MsPCall AS DWORD 'milli seconds per call STATIC cSilent AS DWORD 'counter of silent samples LOCAL SamCount AS WORD 'samplecounter LOCAL TotVol AS INTEGER 'max vol i/e stuk sample LOCAL Lp AS LONG LOCAL dummy AS INTEGER ToLog "RW" IF ISFALSE initialised THEN initialised = %true Audio.ToDisk = %false SamPCall = %CD_SR/task(%RecTask).freq 'AudioFormat.nSamplesPerSec/task(%RecTask).freq MsPCall = 1000/Task(%RecTask).freq EXIT SUB END IF IF BIT (AE.flag, 0) THEN 'start recording BIT RESET AE.flag, 0 TrackRead = RecordAudioSample(10000) ' 10", was: (AE.Duur(AE.fc)) TrackWrite = GetFreeAudioTrack IF (TrackWrite < 0) OR (TrackRead<0) THEN 'no free track BIT SET AE.flag, 0 Free TrackRead Free TrackWrite EXIT SUB END IF WavHdr(TrackWrite).dwflags = %false '? SizeAudioTrack TrackWrite, MsPCall pGenRead = WavHdr(TrackRead).lpData pGenWrite = WavHdr(TrackWrite).lpData tLastRead = timeGetTime task(%RecTask).patch =%false '0 = recoring started, no storing yet 1=silence, no storing yet, 2 = storing EXIT SUB END IF IF ISFALSE TrackStatus.Recording(TrackRead) THEN 'this should prevent reading further then the defined buffer boundary, without further checking Free TrackRead Free TrackWrite BIT SET AE.flag, 0 'this makes it a ever continuing task, without master interference!! EXIT SUB END IF IF TLastRead + MspCall >= timeGetTime THEN 'happens often, wait until more data recorded ! EXIT SUB END IF 'de SamPCall samples na pNext kunnen nu veilig gelezen worden TotVol = %false SamCount = %false DO WHILE SamCount < SamPCall @pGenWrite = @pGenRead IF @pGenRead > TotVol THEN TotVol = @pGenRead END IF INCR pGenWrite :INCR pGenWrite 'twice > only left channel copied, other channel free > for speed 'no relevant difference between signals on different channels INCR pGenRead :INCR pGenRead INCR SamCount LOOP WHILE SamCount < SamPCall tLastRead = timeGetTime SELECT CASE TAsk(%RecTask).Patch 'houd bij of we aan het opnemen zijn/ aan het wachten op stilte of signaal CASE 0 'wachten op stilte voor signaal ' SetDlgItemText hCockpit, %GMT_TEXT0_ID + 10, "Waiting for silence" pGenWrite = WavHdr(TrackWrite).lpData 'begin wordt volgende keer gewoon weer overschreven IF TotVol 1 THEN cSilent = %false TAsk(%RecTask).Patch = 1 EXIT SUB END IF ELSE cSilent = %false END IF EXIT SUB CASE 1 'silence, waiting for signal ' SetDlgItemText hCockpit, %GMT_TEXT0_ID + 10, "Waiting for signal" IF TotVol > AE_NoiseFloor THEN Task(%RecTask).Patch = 2 ' Lp = WavHdr(TrackWrite).lpData '< !!!!!!!! resizeaudiotrack can change pointer!!!!! ResizeAudioTrack TrackWrite, WaveDuration(WavHdr(TrackWrite)) + MsPCall pGenWrite = pGenWrite + WavHdr(TrackWrite).lpData - Lp ELSE pGenWrite = WavHdr(TrackWrite).lpData 'begin wordt volgende keer gewoon weer overschreven END IF EXIT SUB CASE 2 'current noise is being stored, stop on silence IF TotVol 1 THEN cSilent=%false WaveInStop Audio.hWi Free TrackRead IF WavHdr(TrackWrite).dwBufferlength < ((SamPCall *4) * 8) THEN SetDlgItemText gh.Cockpit, %GMT_TEXT0_ID + 10, "Recording failed, sound too short" Free TrackWrite BIT SET AE.flag, 0 EXIT SUB 'too short to save, probably just a click END IF IF ISFALSE task(%RWH).switch AND %TASK_BUSY THEN task(%RWH).channel = TrackWrite StartTask %RWH ELSE MSGBOX "ERROR can't start RecWaveHandler" END IF BIT SET AE.flag, 0 ' this makes it a ever continuing task, without master interference!! EXIT SUB END IF ELSE cSilent = %false END IF 'not saved yet, new bufferlength '!!!!!!!! resizeaudiotrack can change pointer (15 THEN MSGBOX "will stop RWH" StopTask %RWH EXIT SUB END IF IF ISFALSE TimFirstRec THEN TimfirstRec = timeGetTime END IF AE.TimRec(AE.FC) = (timeGetTime - TimFirstRec)/1000 'secondes TrimWave WavHdr(Task(%RWH).channel),AE_NoiseFloor AE.duur(AE.FC) = WaveDuration(WavHdr(Task(%RWH).channel))'1000 * WavHdr(trackwrite).dwBufferLength / %BytesPSec 'Audioformat.nAvgBytesPerSec ResizeAudioTrack Task(%RWH).channel,AE.duur(AE.FC) GetFN 'put new filname in place SaveAudioTrack AE.filenam(AE.fc),Task(%RWH).channel ' >naar AESampleProc SetDlgItemText gh.Cockpit, %GMT_TEXT0_ID + 10,STR$(AE.FC + 1) + " Recorded" IncrFc 'increase file counter >naar AESampleProc BIT SET AE.flag, 3 '>naar AESampleProc task(%RWH).channel = 17'NOT %false StopTask %RWH END SUB 'SUB SortGranArr (BYREF Arr() AS INTEGER) ' LOCAL i AS DWORD:LOCAL j AS DWORD ' DIM Vel (LBOUND(Arr,1) TO UBOUND(Arr,1)) AS LOCAL DWORD ' FOR i = LBOUND(Arr,1) TO UBOUND(Arr,1) ' FOR j=LBOUND(Arr, 2) TO UBOUND(Arr, 2) ' Vel(i) = Vel(i) + ABS(Arr(i,j)) ' NEXT ' NEXT '' ' 'END SUB SUB GetGrainFileName (BYREF fn AS ASCIIZ * 15) STATIC count AS DWORD fn = "grain" + STR$(count) +".wav" INCR count END SUB 'FUNCTION GranusynthEx (GSD AS GrainSynthDataType) AS LONG'(BYREF GranAr() AS INTEGER, BYREF OverlapFactor() AS SINGLE,BYVAL duration AS DWORD) AS LONG 'based on Granusynth2 'but here overlap() is an array, so the overlap factor changes over time, following linear curves 'between the values in the array 'we don't limit overlapfactor boundaries here. ' overlapfactor < 0.5 - creates electronic artefacts... might be wanted ' overlapfactor: 0.5 - classic used for timestretching ' 1 - no overlapping, grains in succession ' 2 - leaves holes. 'unlike granusynth2, this function 'uses up' the whole array ' duration: duration of the wavesound you want to generate (in ms) ' This function generates two identical 180° out of phase channels (left= -right) ' and returns the tracknumber. ' LOCAL track AS LONG ' LOCAL Div AS SINGLE 'divisor if we mix grains ' LOCAL pTrack AS INTEGER PTR ' LOCAL pGrainStart AS INTEGER PTR ' LOCAL MaxpTrack AS DWORD ' LOCAL GrainId AS SINGLE ' LOCAL SamCount AS DWORD ' LOCAL stap AS DWORD ' LOCAL Pos AS LONG 'position (in bytes!) in wavebuffer that is written (working in samples required unecessary divisions ' LOCAL MaxPos AS LONG 'maximum of pos ' LOCAL dum AS SINGLE ' LOCAL i AS DWORD 'counter ' ' 'make sure overlap(x) > 0 ' FOR i = 0 TO Gsd.lOverl 'LBOUND(OverlapFactor) TO UBOUND(OverlapFactor) ' IF Gsd.@pOverl[i] <= 0 THEN ' GSD.@pOverl[i] = .1 ' END IF ' NEXT ' ' track = GetFreeAudioTrack ' IF track < %False THEN ' FUNCTION = -1 ' EXIT FUNCTION ' END IF ' ' SizeAudioTrack track, GSD.duration ' pTrack = WavHdr(track).lpData ' pGrainStart = WavHdr(track).lpData ' MaxpTrack = WavHdr(track).lpData + WavHdr(track).dwBufferlength - (4* GSD.@pGrain.Length) ' MaxPos = MaxpTrack - pTrack 'WavHdr(track).dwBufferlength ' pos = %false ' ' DO ' SamCount = INT(GrainId) * GSD.@pGrain.length ' DO ' @pTrack = @pTrack + div * GSD.@pGrain.@pArr[SamCount]'GranAr(GrainCount,SamCount) ' INCR pTrack ' @pTrack = @pTrack - div * GSD.@pGrain.@pArr[SamCount] 'GranAr(GrainCount,SamCount) ' INCR pTrack ' INCR SamCount ' LOOP WHILE SamCount < INT(GrainId + 1)* GSD.@pGrain.length 'WHILE SamCount < GrainLength ' dum = (GSD.lOverl - 1) * Pos/MaxPos ' IF FIX(dum) < (GSD.lOverl - 1) THEN ' dum = (1-FRAC(dum)) * GSD.@pOverl[FIX(dum)] + FRAC(dum) * GSD.@pOverl[CEIL(dum)] ' div = dum ' stap = GSD.@pGrain.Length * dum ' ELSE ' stap = GSD.@pGrain.Length* GSD.@pOverl[GSD.lOverl - 1] ' Div = GSD.@pOverl[GSD.lOverl - 1] ' END IF ' IF div >1 THEN div = 1 ' SHIFT LEFT Stap, 2 ' pGrainStart = pGrainStart + Stap ' pos = pGrainStart - WavHdr(track).lpData ' pTrack = pGrainStart ' GrainId = (GSD.@pGrain.nr - 1) * Pos/MaxPos ' LOOP UNTIL pTrack > MaxpTrack ' FUNCTION = track 'END FUNCTION SUB free( BYREF t AS LONG ) IF (t < 0) OR (t >15) THEN EXIT SUB END IF WavHdr(t).dwFlags = %false SizeAudioTrack t, %false t = -1 END SUB SUB Str_Mod(f1 AS LONG, f2 AS LONG) ' the files AE.filenam(f1 en f2) worden gestretched tot ze evenlang zijn, 'info van l kannaal van f2 komt op r kannaal van track(f1) 'crossmodulatie op het resultaat, dit wordt onmiddelijk afgespeeld LOCAL track1 AS LONG LOCAL track2 AS LONG LOCAL track1b AS LONG LOCAL track2b AS LONG LOCAL pData1 AS INTEGER PTR LOCAL pData2 AS INTEGER PTR LOCAL SamPCall AS DWORD 'recomputed every call LOCAL SamCount AS DWORD LOCAL av AS DWORD 'average duration (ms) of the two tracks track1 = ReadWaveData (AE.filenam(f1)) 'GetFreeAudioTrack IF track1 < 0 THEN EXIT SUB 'if out of tracks, exit sub track2 = ReadWaveData (AE.filenam(f2)) 'getFreeAudioTrack IF track2 < 0 THEN Free Track1 EXIT SUB END IF track1b = GetFreeAudioTrack IF track1b < 0 THEN Free track1 Free track2 EXIT SUB END IF Av=WaveDuration(WavHdr(track1))+ Waveduration(WavHdr(track2)) SHIFT RIGHT Av, 1 'divide by two ResizeAudioTrack track1b, Av VariSpeed WavHdr(track1), WavHdr(track1b) Free track1 track2b = GetFreeAudioTrack 'no need to check, as a track has just been released... ResizeAudioTrack track2b, Av VariSpeed WavHdr(track2), WavHdr(track2b) Free track2 'we suppose that the right channels are not filled in (standard up till now in AE) pData1 = WavHdr(track1b).lpData pData2 = WavHdr(track2b).lpData INCR pData1 'start at right channel SamPCall = WavHdr(track1b).dwBufferLength 'was Av / 4 toen aV nog voor de bufferlength stond) SHIFT RIGHT SamPCall, 2 '/4 SamCount = %false DO WHILE SamCount < SamPCall @pData1=@pData2 INCR pData1:INCR pData1 INCR pData2:INCR pData2 INCR SamCount LOOP WHILE SamCount < SamPCall 'track1b now prepared for crossmodulation, L chan = original, R chan = from track2b Free track2b CrossModulate WavHdr(track1b) PlayAudioTrack track1b, %MODULATE_VOLUME Free track1b '!? ... WORKS!! END SUB SUB ToLog(a$) STATIC f AS LONG STATIC init AS LONG IF ISFALSE init THEN init = %true ToLog "Restart" f = FREEFILE OPEN "AElog.txt" FOR APPEND AS f END IF WRITE# f, timeGetTime , a$ END SUB SUB PlayWaves STATIC tasknr AS INTEGER LOCAL i AS WORD LOCAL track AS LONG LOCAL retval AS LONG IF ISFALSE tasknr THEN tasknr = %PlayTask END IF ToLog "PW" IF ToPlay = "" THEN EXIT SUB ToLog "PW wil do..." track = ReadWaveData(ToPlay) SELECT CASE track CASE < 0 MSGBOX "PW no free tracks" Task(%PlayTask).freq = 1 EXIT SUB CASE < 5 Task(%PlayTask).freq = 8'Task(%PlayTask).freq + .5 CASE < 10 Task(%PlayTask).freq = 4 CASE < 15 Task(%PlayTask).freq = 1 CASE ELSE MSGBOX "PW all tracks occupied Task(%PlayTask).freq = 1 EXIT SUB END SELECT PlayAudioTrack track, %Modulate_volume ToPlay = "" END SUB FUNCTION VarSpeed (f AS LONG,fakt AS SINGLE)AS INTEGER 'filenr in AE type, stretching faktor 'stretch the contents of wavefile AE.filenum(f) with faktor fakt and play the result 'uses gmt's varispeed, but takes also care of the playback... 'later extend this, so that you can have a stretch speed envelope in an array LOCAL src AS LONG LOCAL dest AS LONG IF f> AE.FC THEN FUNCTION = -2 'fatal error '?? -1 > you can try when new files are rec'd EXIT FUNCTION END IF src=ReadWaveData(AE.filenam(f)) 'counter increased after sample is saved dest = GetFreeAudioTrack IF dest < 0 THEN WavHdr(src).dwFlags = %false ResizeAudioTrack src, %false FUNCTION = dest '= -1 for tem failure, -2 for fatal err. EXIT FUNCTION END IF ReSizeAudioTrack dest, INT(WaveDuration(WavHdr(src)) * fakt) VariSpeed WavHdr(src), WavHdr(dest) WavHdr(src).dwFlags = %false ResizeAudioTrack src, %false PlayAudioTrack dest,%Modulate_Volume FUNCTION = %false 'succeeded END FUNCTION SUB IncrFc 'increases file counter INCR AE.FC IF AE.FC > %MaxFiles THEN AE.FC = 0 END IF END SUB SUB GetFn 'fills in new filename were AE.counter is now, new recorded files STATIC counter AS DWORD 'CALLED BEFORE IncrFc INCR counter AE.filenam(AE.fc) ="AE"+STR$(counter)+".wav" AE.gfilenam(AE.fc) = "gAE"+STR$(counter)+".wav" END SUB 'EOF