' ************************************************ ' * < TECHNOFAUSTUS > * ' * ACT 2: LITHOS * ' * a chamber opera * ' * for robot orchestra and dancers/actors * ' * by * ' * Godfried-Willem Raes * ' ************************************************ 'INTERACTION: Gesture interaction added 2016. ' 20.11.1999 start work on Act 1 - development versions saved ' as faust0..., faust1... in ' subdirectory /faust/... ' 02.10.2000 attempts to port it to NT... ' 04.02.2001 further worksession started... ' 20.02.2001 Faust text integrated. ' 04.08.2001 start rescoring for automatons. ' 20.05.2002 Recoded for robot orchestra ' This piece needs the MidiMan 4x4 midi interface. ' The first selected midi port should be connected to: ' ThunderWood ' Belly ' Vibi ' Rotomoton ' Troms ' Klung ' The second selected midi port to: ' Bourdonola ' Piperola ' The third selected midi port to: ' Vox Humanola ' AutoSax ' Springers ' The fourth selected midi port to: ' Player Piano ' Harma ' 22.05.2002 rehearsal session ' 23.05.2002 rehearsals and code refinement. ' 27.05.2002 premiere try out act 1 ' 01.06.2002 springers added. Some silly bugs removed. ' 15.06.2002 ini-file port assignments added. ' 22.06.2002 Restructuring of code in different modules. ' 17.07.2002 Rechecked on robots. ' 09.10.2002 Drip mechanism for homunculus' coming to life constructed. ' 13.10.2002 Dripper tested o.k. after solving timing problems with putty ' 15.10.2002 Dripper test procedure added. (for theatre setup) ' 16.10.2002 Try out with Emilie De Vlam ' 28.11.2002 Enschede performance ' 16.12.2002 start up problems... ' 16.09.2003 reconsidered for Den Haag - This section does not use sonar nor radar. ' 08.01.2005: adapted to new pic in bourdonola. ' 16.01.2005: testrun - o.k. we may consider adding Llor, Ake, Puff ' 14.03.2005: new dripper implemented. ' 29.08.2005: recheck ' 04.12.2005: adapted to new Harma. Perc_stop task removed. Was not conform to the new MM hardware. ' testrun. gwr. ' 06.05.2006: testrun for japanese visitors ' 13.09.2006: quick run through for M&M hardware changes ' 21.01.2007: checked against changes in harmlibs. Testrun o.k. ' to do: add elegant ending procedure. ' 11.06.2009: sonar_radar flags checked. ' 19.04.2012: rechecked for inclusion in the No/Si production ' extra dripper note changed to 12 instead of 15, to conform with the wiring. ' Note: must be switched off at the end in the cockpit!!! ' The duration for this act is read from the faust.ini file. Normally set to 900 (15 minutes) ' For the performance on 19.04 we changed it to 600 (yielding 10 minutes) ' 14.10.2016: Reconsidered for the 'Nat' production ' to be added: Whisper or Tinti on gesture input. ' 15.10.2016: Whisper added. Tinti added. ' Autosax task changed to Asa, but not in the metatask. ' HybroLo doubling Bourdonola now. ' running out of tasks that can run simultaneous now... ' the limit seems to be 16 now. ' Problem with midi-in ports if they are not used. On prog. close we hang. DECLARE FUNCTION Init_Lithos () AS DWORD DECLARE SUB Lithos_DripPulse () ' dripper & troms. DECLARE SUB Monolith0 () ' vox humanola DECLARE SUB Monolith1 () ' klung DECLARE SUB Monolith2 () ' piano & harma DECLARE SUB Monolith3 () ' piperola- bourdonola DECLARE SUB Monolith4 () ' vibi & piano DECLARE SUB Lithos_Meta () DECLARE SUB Lithos_HiddenHarm () ' silent DECLARE SUB Lithos_SolvHarm () ' silent DECLARE SUB Lithos_Transposer () ' belly DECLARE SUB ButnSW_Lithos_StartStop () DECLARE SUB Lithos_Whisper () ' uses doppler ii DECLARE SUB Lithos_Whisper_Stop () DECLARE SUB Lithos_Tinti () ' uses doppler ii DECLARE SUB LithosCommand () DECLARE SUB LithoSax () DECLARE SUB Lithos_Score_Time () DECLARE SUB Lithos_Percus () FUNCTION Init_Lithos () AS DWORD LOCAL i AS DWORD LOCAL n AS LONG LOCAL m AS ASCIIZ * 30 App.Komposduur = Read_Duration_From_File ($faustini, "Lithos") ' new function in g_file.dll 15.10.2003 logfile "Lithos duration as read from inifile = " & STR$(App.Komposduur) 'App.komposduur = 900 ' = 15 minutes App.tempo = 20 ' should become interactive on drips. 'Adapt buttons to this application: ' SWITCHES: (these can toggle) ' ButnSW(0).tag = "Thru" ' Win32Api-Call - Midi- Thru toggle switch ButnSW(1).tag0 = "Start" ' start/stop toggle SetDlgItemText gh.Cockpit, %GMT_BUTNSW_ID + 1, "Start" ButnSW(1).flag = %False ' reset ButnSW(1).cptr = CODEPTR(ButnSW_Lithos_StartStop) ' blank existing tasks: FOR i = 16 TO 48 RemoveCockpitTask i Task(i).har.vel = NUL$(128) NEXT i ' Lithos taskinitialisation: Task(%Lithos_Drip).naam = "DripPuls" Task(%Lithos_Drip).cPtr = CODEPTR(Lithos_DripPulse) Task(%Lithos_Drip).duur = App.komposduur Task(%Lithos_Drip).tempo = App.tempo Task(%Lithos_Drip).flags = %HARM_TASK Task(%Lithos_Drip).freq = 1 Task(%Litho_HideHarm).naam = "HideHarm" ' does not play anything... Task(%Litho_HideHarm).cPtr = CODEPTR(Lithos_HiddenHarm) Task(%Litho_HideHarm).duur = App.komposduur Task(%Litho_HideHarm).tempo = App.tempo Task(%Litho_HideHarm).flags = %False Task(%Litho_HideHarm).freq = 12 '100 Task(%Lithos_SolveHarm).naam = "SolvHarm" ' does not play anything Task(%Lithos_SolveHarm).cPtr = CODEPTR(Lithos_SolvHarm) Task(%Lithos_SolveHarm).duur = App.komposduur Task(%Lithos_SolveHarm).tempo = App.tempo Task(%Lithos_SolveHarm).flags = %False Task(%Lithos_SolveHarm).freq = 1 '2 '1 '8 Task(%Lithos_tc).naam = "Transpo" ' uses Belly Task(%Lithos_tc).cPtr = CODEPTR(Lithos_Transposer) Task(%Lithos_tc).duur = App.komposduur Task(%Lithos_tc).freq = 12! / App.komposduur Task(%Lithos_tc).tempo = Task(%Lithos_tc).freq * 60! Task(%Lithos_tc).flags = %False Task(%litho_scoretime).naam = "ScorTim" ' does not play anything. Task(%litho_scoretime).cptr = CODEPTR(Lithos_Score_Time) Task(%litho_scoretime).duur = App.Komposduur Task(%litho_scoretime).freq = 0.66 ' was 7 - this freq stays constant. Task(%litho_scoretime).flags = %False Task(%Litho0).naam = "Lit0-hum" ' linear - vox humanola Task(%Litho0).cPtr = CODEPTR(Monolith0) Task(%Litho0).duur = App.komposduur Task(%Litho0).tempo = App.tempo Task(%Litho0).flags = %Harm_Task Task(%Litho0).rit.minduur = 0.1 '0.05 Task(%Litho0).rit.maxduur = 3 Task(%Litho0).freq = 0.4 '20 Task(%Litho1).naam = "Lit1-klu" ' klung Task(%Litho1).cPtr = CODEPTR(Monolith1) Task(%Litho1).duur = App.komposduur Task(%Litho1).tempo = App.tempo Task(%Litho1).flags = %Harm_Task Task(%Litho1).rit.minduur = 0.1 '0.05 Task(%Litho1).rit.maxduur = 3 Task(%Litho1).freq = 0.9 '19 Task(%Litho2).naam = "Li2piaha" ' piano & harma Task(%Litho2).cPtr = CODEPTR(Monolith2) Task(%Litho2).duur = App.komposduur Task(%Litho2).tempo = App.tempo Task(%Litho2).flags = %Harm_Task Task(%Litho2).rit.minduur = 0.06 ' 0.05 Task(%Litho2).rit.maxduur = 3 Task(%Litho2).freq = 0.78 '18 Task(%Litho3).naam = "Li3pipbo" ' piperola-bourdonola Task(%Litho3).cPtr = CODEPTR(Monolith3) Task(%Litho3).duur = App.komposduur Task(%Litho3).tempo = App.tempo Task(%Litho3).flags = %Harm_Task Task(%Litho3).rit.minduur = 0.08 '0.03 Task(%Litho3).rit.maxduur = 3 Task(%Litho3).freq = 0.26 '17 Task(%Litho4).naam = "Li4vipia" ' vibi-piano Task(%Litho4).cPtr = CODEPTR(Monolith4) Task(%Litho4).duur = App.komposduur Task(%Litho4).tempo = App.tempo Task(%Litho4).flags = %Harm_Task Task(%Litho4).rit.minduur = 0.07 '0.02 Task(%Litho4).rit.maxduur = 3 Task(%Litho4).freq = 0.37 '16 Task(%litho_meta).naam = "MetaPuls" Task(%litho_meta).cPtr = CODEPTR(Lithos_Meta) Task(%litho_meta).duur = App.Komposduur Task(%litho_meta).tempo = App.tempo Task(%litho_meta).freq = App.tempo / 60 ' 0.3 Task(%litho_command).naam = "Control" Task(%litho_command).cPtr = CODEPTR(Lithos_Control) Task(%litho_command).freq = 4 Task(%lithoSax).naam = "FauSaX" ' now uses Task(%lithoSax).cptr = CODEPTR(LithoSax) Task(%lithoSax).freq = 6 Task(%lithoSax).flags = %False '%MIDI_TASK OR %Harm_Task TaskEX(%lithosax).stopcptr = CODEPTR(Lithosax_Stop) Task(%LithoPerc).naam = "Perkus" Task(%LithoPerc).cptr = CODEPTR(Lithos_Percus) Task(%LithoPerc).freq = App.Tempo / 10 Task(%LithoPerc).flags = %False Task(%Lithos_Whisper).naam = "Whisper" ' added 15.10.2016 Task(%Lithos_Whisper).cptr = CODEPTR(Lithos_Whisper) Task(%Lithos_Whisper).freq = 129 Task(%Lithos_Whisper).flags = %PERTIM_Task TaskEX(%Lithos_Whisper).stopCptr = CODEPTR(Lithos_Whisper_Stop) Task(%Lithos_Tinti).cptr = CODEPTR(Lithos_Tinti) ' added 15.10.2016 Task(%Lithos_Tinti).naam = "Tinti" Task(%Lithos_Tinti).freq = 40 Task(%Lithos_Tinti).flags = %False TaskEX(%Lithos_Tinti).stopCptr = CODEPTR(MM_Tinti_Off) ' FaustPatches "lithos" 16.10/2016 - no longer required. m = "" ' Start_Doppler_DAQ ' required? IF ISFALSE Task(%Gesture_Analyser).tog THEN starttask %Gesture_Analyser SendMessage gh.Cockpit, %WM_SETTEXT,0, VARPTR(m) SetDlgItemText gh.Cockpit, %GMT_TITLE, "" SetDlgItemText gh.Cockpit, %GMT_AUTHOR, $gwr SetDlgItemText gh.Cockpit, %GMT_MSG1, "The birth of the homunculus" SetDlgItemText gh.Cockpit, %GMT_MSG2, "Faust's laboratory" FUNCTION = %True END FUNCTION SUB ButnSW_Lithos_StartStop () LOCAL ButtonNr AS LONG LOCAL i AS DWORD LOCAL j AS DWORD LOCAL cptr AS DWORD ButtonNr = App.butnSWparam - %GMT_BUTNSW_ID IF ButnSW(Buttonnr).flag THEN App.MTstart = %True App.tstart = timeGetTime ' start the chronometerfunction SetDlgItemText gh.Cockpit, %GMT_BUTNSW_ID + ButtonNr, "STOP" IF hMidiI(0) THEN ClearMiBuf 0 ' start with a blank midi input buffer ' BlockSysExReception hMidiI(0) 'SxThread ' dll proc END IF Promil %True Runtime %True ' StartTask App.GlobalHarmonyTaskNr StartTask %Litho_HideHarm StartTask %Lithos_Drip ' following case may be unneeded now (27.06.2009) ' SELECT CASE Sonar_Radar ' CASE 0'%False ' 'Sonar_DAQ %DAQ_DOUBLEBUFFER ' 16.04.2003 - maybe not required here. ' cptr = GetProcAddress(gh.gnh, "SONAR_DAQ") ' CALL DWORD cptr USING Sonar_DAQ(%DAQ_DOUBLEBUFFER) ' CASE 1'%TRue ' 'Radar_DAQ %DAQ_DOUBLEBUFFER ' cptr = GetProcAddress(gh.gnh, "RADAR_DAQ") ' CALL DWORD cptr USING Radar_DAQ(%DAQ_DOUBLEBUFFER) ' END SELECT StartTask %Litho0 StartTask %Litho1 StartTask %Litho2 StartTask %Litho3 StartTask %Litho4 StartTask %litho_command StartTask %Lithos_tc StartTask %Lithos_SolveHarm StartTask %litho_meta StartTask %litho_scoretime ELSE ' App.MTstart = %False - with this we loose our syntax in Lithos! SetDlgItemText gh.Cockpit, %GMT_BUTNSW_ID + ButtonNr, "Ended" Promil %False FOR i = 16 TO 63 IF Task(i).swit THEN stoptask i NEXT i ' not required (27.06.2009) ' SELECT CASE Sonar_Radar ' CASE 0'%False ' cptr = GetProcAddress(gh.gnh, "SONAR_DAQ") ' CALL DWORD cptr USING Sonar_DAQ(%false) ' 'Sonar_DAQ %False ' CASE 1'%True ' cptr = GetProcAddress(gh.gnh, "RADAR_DAQ") ' CALL DWORD cptr USING Radar_DAQ(%false) ' 'Radar_DAQ %False ' END SELECT MM_AllOff %MM_Notes OR %MM_Lights ' added 21.01.2006 END IF App.butnSWparam = %False END SUB SUB Lithos_DripPulse () ' changed to troms 04.08.2001 ' dripper code added 10-13.10.2002 ' changed to new hardware 21.10.2002 ' to be done: add code for display countdown. (use Nidaq dio port) ' or, 27.06.2009: for new hardware midi controlled display... ' or, using the displays on heli and/or so ' This tasks' harmstring contributes to the global harmony task. STATIC Ritmeteller AS INTEGER LOCAL tiks! LOCAL param AS SINGLE LOCAL v AS BYTE STATIC note AS BYTE STATIC slnr AS LONG IF ISFALSE Task(%Lithos_Drip).tog THEN DIM TaskParamLabels(0) AS STATIC ASCIIZ*8 TaskParamLabels(0)="drip" ' for steering drip-size IF Task(%Lithos_Drip).hParam = %Null THEN MakeTaskParameterDialog %Lithos_Drip,1, Slider(),0,UdCtrl(), TaskParamLabels() END IF slnr = TaskEX(%Lithos_Drip).SliderNumbers(0) Slider(Slnr).value = 125 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value 'Dripper_Start 'MM_Dripper_On MM_Springers_On mPlay Springers.Channel, 36, 110 ' was noot 120, voor de oude mapping van Springers. Task(%Lithos_Drip).tog = %True END IF param = Tprop!(%litho_scoretime) ' linear 0-1 IF ISFALSE Task(%Lithos_Drip).Rit.pattern(Ritmeteller) THEN Ritmeteller = %False Task(%Lithos_Drip).Rit.pattern(0)= 1 + (param * 99!) ' ON Task(%Lithos_Drip).Rit.pattern(1)= -(101 - Task(%Lithos_Drip).Rit.pattern(0)) ' OFF Task(%Lithos_Drip).Rit.pattern(2)= %False mPlay dripper.channel, 12, Slider(slnr).value ' 12 since 2012 END IF tiks! = RitmSigma!(Task(%Lithos_Drip).Rit) IF tiks! < 1 THEN EXIT SUB ' crashes without this limit ? Task(%Lithos_Drip).freq = (tiks! * Task(%Lithos_Drip).tempo ) / (60 * ABS(Task(%Lithos_Drip).Rit.pattern(Ritmeteller))) IF Task(%Lithos_Drip).Rit.pattern(Ritmeteller) > 0 THEN note = 47 - (param * 24) v = 10 + (param * 110) AddNote2Har Task(%Lithos_Drip).Har, note, v mPlay Troms.channel, note, v ELSEIF Task(%Lithos_Drip).Rit.pattern(Ritmeteller) < 0 THEN Task(%Lithos_Drip).Har.vel = NUL$(128) END IF INCR Ritmeteller END SUB SUB Lithos_Transposer () LOCAL oct AS DWORD IF ISFALSE Task(%Lithos_tc).tog THEN App.globton = %False Task(%Lithos_tc).tog = %True ' changed in procs. 15.09.2006 'ModeMess Belly.channel, &H44, %True ' set to intelligent listen task (pitch mapping) 'ModeMess Belly.channel, 4, 20 ' default instelling, cent-afwijking 'Belly.ctrl(&H44) = %True 'Belly.ctrl(4) = 20 Task(%Lithos_tc).tog = %True EXIT SUB END IF ' will set the global App.Globton App.globton = (App.globton + 5) MOD 12 ' in kwarten ' play this on belly if possible: FOR oct = 60 TO 108 STEP 12 ' Play Belly.Channel, oct + (App.globton MOD 12), 64 '100 ' since 15.09.2006: PlayBelly (oct + (App.Globton MOD 12), 64, 20) NEXT oct END SUB SUB Monolith0 () ' vox humanola and autosax ' for easier transportation of the production, vox humanola can be replaced with LOCAL param AS SINGLE LOCAL cnr AS INTEGER LOCAL aantal_tellen AS WORD LOCAL i AS DWORD STATIC Ritmeteller AS INTEGER STATIC oldcnr AS INTEGER STATIC holdflag AS DWORD STATIC tiks_per_tijd AS WORD STATIC fROOT AS SINGLE ' var.name changed, since ROOT became a keyword in PB. STATIC oldnoot AS INTEGER STATIC tiks! IF ISFALSE Task(%Litho0).tog THEN fROOT = 5! ' was: 3! tiks_per_tijd = 30 Ritmeteller = %False Task(%Litho0).tempo = App.tempo ' could become interactive with drips. Task(%Litho0).freq = 100 'App.tempo / 60 Task(%Litho0).tog = %True MM_Humanola_On ' motor ON Controller Humanola.channel, 7, %MM_Humanola_Motor Humanola.ctrl(7) = %MM_Humanola_Motor EXIT SUB END IF param = Tprop!(%litho_scoretime) ' linear 0-1 IF param < 0 THEN EXIT SUB IF ISFALSE Task(%Litho0).Rit.pattern(Ritmeteller) THEN Ritmeteller = %False aantal_tellen = 3 + INT(param * fROOT) BIT RESET aantal_tellen, 0 ' should always be even FOR i = 0 TO Aantal_tellen - 2 IF ISFALSE BIT(i,0) THEN Task(%Litho0).rit.pattern(i) = 1 + ((tiks_per_tijd -1) * param) ' alsmaar meer legato ELSE Task(%Litho0).rit.pattern(i) = -((tiks_per_tijd + 1) - (Task(%Litho0).rit.pattern(i-1))) END IF NEXT i Task(%Litho0).rit.pattern(i)= -((tiks_per_tijd * fROOT) - (tiks_per_tijd * (1+(Aantal_tellen\2) ))) ' rest is rust... Task(%Litho0).rit.pattern(i+1)= %False tiks! = RitmSigma!(Task(%Litho0).Rit) END IF ' het tempo voor een gehele maat is frq = task(tasknr%).tempo / 60 ' zo'n gehele maat beslaat een aantal eenheden gegeven in tiks! Task(%Litho0).freq = (tiks! * Task(%Litho0).tempo ) / (60 * ABS(Task(%Litho0).Rit.pattern(Ritmeteller))) IF Task(%Litho0).Rit.pattern(Ritmeteller) > 0 THEN ' this plays the basic harmony SELECT CASE Ritmeteller CASE %False cnr = GetStrongest(Task(%Litho_HideHarm).Har,3) IF cnr = -1 THEN cnr = oldcnr CASE 2 cnr = GetStrongest(Task(%Litho_HideHarm).Har, 2) IF cnr = -1 THEN cnr = oldcnr CASE 4 cnr = GetStrongest(Task(%Litho_HideHarm).Har,1) ' check this: will it not return a single note? IF cnr = -1 THEN cnr = oldcnr CASE 6 cnr = GetStrongest%(Task(%Lithos_SolveHarm).Har,1) IF cnr = -1 THEN cnr = %False END SELECT IF cnr <> oldcnr THEN Task(%Litho0).har.vel = NUL$(128) AddCnr2Har Task(%Litho0).har, cnr, 55,66, 127 ' vox humanola limits are 36-91 PlayHar Task(%Litho0).Har, Humanola.channel oldcnr = cnr holdflag = %false ELSE holdflag = %true END IF ELSEIF Task(%Litho0).Rit.pattern(Ritmeteller) < 0 THEN IF holdflag = %false THEN Task(%Litho0).Har.vel = NUL$(128) FOR i = 55 TO 66 NoteOff Humanola.channel, i 'Task(%Litho0).channel, i NEXT i oldcnr = %False END IF END IF INCR Ritmeteller END SUB SUB LithoSax () ' 19.04.2012: MM_Autosax_Off %MM_Notes added. ' 15.10.2016: We may better change this to play on ASA instead of autosax... ' doesn't do anything anymore... ' seems we run out of tasks... ' If it plays, it's quite nice now... STATIC saxnote, lites, oldsaxnote AS INTEGER LOCAL param AS SINGLE STATIC cnt AS DWORD IF ISFALSE Task(%lithoSax).tog THEN cnt = %False MM_Asa_On Controller Asa.channel, 7, 120 Controller Asa.channel, 1, 6 Task(%lithoSax).tog = %True END IF param = Tprop!(%litho_scoretime) ' linear 0-1 SELECT CASE param CASE < 0.25 Task(%lithoSax).freq = App.Tempo / 60 CASE < 0.5 Task(%lithoSax).freq = App.Tempo * 2 / 60 CASE < 0.75 Task(%lithoSax).freq = App.Tempo * 4 / 60 CASE < 0.9 Task(%lithoSax).freq = App.Tempo * 6 / 60 CASE ELSE Task(%lithoSax).freq = App.Tempo * 9 / 60 END SELECT SELECT CASE cnt MOD 7 CASE %False saxnote = GetStrongest%(Task(%Litho_HideHarm).Har,1) IF saxnote < 0 THEN saxnote = %False ELSE IF saxnote < Asa.lowtes THEN DO saxnote = saxnote + 12 LOOP UNTIL saxnote >= Asa.lowtes END IF END IF CASE 1,2 IF saxnote THEN saxnote = oldsaxnote +(RND(1)*3) IF saxnote > 127 THEN saxnote = 127 CASE 3 saxnote = GetStrongest%(Task(%Lithos_SolveHarm).Har,1) IF saxnote < 0 THEN saxnote = %False ELSE IF saxnote < Asa.lowtes THEN DO saxnote = saxnote + 12 LOOP UNTIL saxnote >= Asa.lowtes END IF END IF CASE 4,5 IF saxnote THEN saxnote = oldsaxnote +(RND(1)*3) IF saxnote > 127 THEN saxnote = 127 CASE 6 saxnote = %False END SELECT IF ISFALSE saxnote THEN MM_Asa_Off %MM_Notes oldsaxnote = %False END IF IF saxnote <> oldsaxnote THEN IF oldsaxnote THEN NoteOff Asa.channel, oldsaxnote oldsaxnote = %False END IF IF saxnote >= Asa.lowtes THEN mPlay Asa.channel, saxnote, 127 - ((cnt MOD 7) * 10) oldsaxnote = saxnote IF saxnote <= Asa.hightes THEN Controller Asa.channel, 22, 32 + saxnote '64 + (RND(-32,+32)) ' movement Controller Asa.channel, 23, 64 + (RND(-16,+16)) END IF END IF END IF IF oldsaxnote THEN IF ISFALSE lites THEN MM_Asa_On %MM_Yellow lites = %True END IF ELSE IF lites THEN MM_Asa_Off %MM_Yellow RESET lites END IF END IF INCR cnt END SUB SUB LithoSax_Stop () MM_Asa_Off %MM_Notes MM_Asa_Off %MM_Lights END SUB SUB Monolith1 () ' klung LOCAL aantal_tellen AS WORD LOCAL param AS SINGLE LOCAL cnr AS INTEGER LOCAL i AS DWORD STATIC Ritmeteller AS INTEGER STATIC tiks! STATIC oldcnr AS INTEGER STATIC holdflag AS BYTE STATIC tiks_per_tijd AS WORD STATIC fROOT AS SINGLE STATIC oldnoot AS INTEGER IF ISFALSE Task(%Litho1).tog THEN fROOT = 6! ' was 4! - telt met 6! tot 5/4 aan het einde... tiks_per_tijd = 20 Task(%Litho1).freq = 100 ' was 500 Task(%Litho1).tog = %True MM_Klung_On EXIT SUB END IF param = Tprop!(%litho_scoretime) IF ISFALSE Task(%Litho1).Rit.pattern(Ritmeteller) THEN Ritmeteller = %False aantal_tellen = 3 + INT(param * fROOT) BIT RESET aantal_tellen, 0 ' should always be even FOR i = 0 TO Aantal_tellen - 2 IF ISFALSE BIT(i,0) THEN Task(%Litho1).rit.pattern(i) = 1 + ((tiks_per_tijd -1) * param) ' alsmaar meer legato ELSE Task(%Litho1).rit.pattern(i) = -((tiks_per_tijd + 1) - (Task(%Litho1).rit.pattern(i-1))) END IF NEXT i Task(%Litho1).rit.pattern(i) = -((tiks_per_tijd * fROOT) - (tiks_per_tijd * (1+(Aantal_tellen\2) ))) ' rest is rust... Task(%Litho1).rit.pattern(i+1) = %False tiks! = RitmSigma!(Task(%Litho1).Rit) END IF Task(%Litho1).freq = (tiks! * Task(%Litho1).tempo ) / (60 * ABS(Task(%Litho1).Rit.pattern(Ritmeteller))) IF Task(%Litho1).Rit.pattern(Ritmeteller) > 0 THEN SELECT CASE Ritmeteller CASE %False ' make chord... cnr = GetStrongest (Task(%Litho_HideHarm).Har, 2) CASE ELSE cnr = GetStrongest (Task(%Lithos_SolveHarm).Har, 2) END SELECT IF cnr <= 0 THEN cnr = %False : cnr = AddNoteInChord(cnr, App.Globton) IF cnr <> oldcnr THEN Task(%Litho1).har.vel = NUL$(128) 'AddCnr2Har Task(%Litho1).har, cnr, 48,65, 100 ' vox humanola geschrapt hier - teveel lange noten. 'AddCnr2Har Task(%Litho1).har, cnr, 36,54, 100 ' no overlap with litho0 on humanola 'PlayHar Task(%Litho1).Har, Humanola.channel 'Task(%Litho1).channel AddCnr2Har Klung.Har(1), cnr, Klung.LowTes, Klung.HighTes,100 Task(%Litho1).har.vel = Klung.Har(1).vel ' new InstrumPlay Klung ' no note off required oldcnr = cnr holdflag = %False ELSE holdflag = %True END IF ELSEIF Task(%Litho1).Rit.pattern(Ritmeteller) < 0 THEN IF holdflag = %False THEN Task(%Litho1).Har.vel = NUL$(128) oldcnr = %False Klung.Har(1).vel = NUL$(128) END IF END IF INCR Ritmeteller END SUB SUB Monolith2 () ' try this one on piano and harma (alternating) LOCAL i AS DWORD LOCAL param AS SINGLE LOCAL noot AS INTEGER STATIC Ritmeteller AS INTEGER STATIC aantal_tellen AS WORD STATIC tiks_per_tijd AS WORD STATIC oldcnr AS INTEGER STATIC holdflag AS DWORD STATIC stamteller AS SINGLE STATIC oldnoot AS INTEGER STATIC icnt AS DWORD STATIC oldpiano AS INTEGER STATIC oldharma AS INTEGER STATIC tiks! IF ISFALSE Task(%Litho2).tog THEN stamteller = 8! ' was5! ' 5/4 maat tiks_per_tijd = 25 ' ritmische granulatie MM_Harma_On Task(%Litho2).freq = App.tempo / 60! Task(%Litho2).tog = %True EXIT SUB END IF IF ISFALSE Task(%Litho2).Rit.pattern(Ritmeteller) THEN param = Tprop!(%litho_scoretime) IF param < 0 THEN EXIT SUB Ritmeteller = %False aantal_tellen = 2 + INT(param * stamteller) ' 5/4 BIT RESET aantal_tellen, 0 ' should always be even ' pulsduur = stamteller * 100 ' duur van een maat in tiks ' tiks_per_tijd = 500 / 5 = 100 ' tiks per tijd FOR i = 0 TO Aantal_tellen - 2 IF ISFALSE BIT(i,0) THEN Task(%Litho2).rit.pattern(i) = 1 + ((tiks_per_tijd -1) * param) ' alsmaar meer legato ELSE Task(%Litho2).rit.pattern(i) = -((tiks_per_tijd + 1) - (Task(%Litho2).rit.pattern(i-1))) END IF NEXT i Task(%Litho2).rit.pattern(i)= -((tiks_per_tijd * stamteller) - (tiks_per_tijd * (1+(Aantal_tellen\2) ))) ' rest is rust... Task(%Litho2).rit.pattern(i+1)= %False INCR icnt icnt = icnt AND &H0FF tiks! = RitmSigma!(Task(%Litho2).Rit) IF oldpiano THEN Piano.Har(1).vel = NUL$(128) Instrumplay Piano oldpiano = %False END IF IF oldharma THEN Harma.Har(1).vel = NUL$(128) Instrumplay Harma oldharma = %False END IF END IF Task(%Litho2).freq = (tiks! * Task(%Litho2).tempo ) / (60 * ABS(Task(%Litho2).Rit.pattern(Ritmeteller))) IF Task(%Litho2).Rit.pattern(Ritmeteller) > 0 THEN IF oldnoot <= %False THEN oldnoot = -1 SELECT CASE Ritmeteller CASE 0,2 noot = StealNoteFromHar%(Task(%Litho_HideHarm).Har, oldnoot, 29, 89) ' was 40, 59 IF noot > 0 THEN IF oldnoot > 0 THEN AddNote2Har Task(%Litho_HideHarm).Har, oldnoot, 64 END IF END IF CASE ELSE noot = StealNoteFromHar%(Task(%Lithos_SolveHarm).Har, oldnoot, 29, 89) IF noot > 0 THEN IF oldnoot > 0 THEN AddNote2Har Task(%Lithos_SolveHarm).Har, oldnoot, 64 END IF END IF END SELECT IF noot <> oldnoot THEN IF noot > %False THEN SELECT CASE (icnt MOD 2) CASE %False IF aantal_tellen > %False THEN AddNote2Har Piano.Har(1), noot, MIN(64,64- ((Ritmeteller /aantal_tellen)*48)) InstrumPlay Piano oldpiano = noot END IF CASE 1 IF aantal_tellen > %False THEN AddNote2Har Harma.Har(1), noot, MIN(127,127- ((Ritmeteller /aantal_tellen)*64)) InstrumPlay Harma oldharma = noot END IF END SELECT AddNote2Har Task(%Litho2).Har, noot, 80 oldnoot = noot holdflag = %False END IF ELSE IF noot > %False THEN holdflag = %True END IF END IF ELSEIF Task(%Litho2).Rit.pattern(Ritmeteller) < 0 THEN IF holdflag = %False THEN IF oldnoot > %False THEN IF oldpiano THEN DelNote2Har Piano.Har(1), oldpiano InstrumPlay Piano oldpiano = %False END IF IF oldharma THEN DelNote2Har Harma.Har(1), oldharma InstrumPlay Harma oldharma = %False END IF DelNote2Har Task(%Litho2).Har, oldnoot oldnoot = %False END IF END IF END IF INCR Ritmeteller END SUB SUB Monolith3 () ' 1999: piperola & bourdonola ' 14.10.2016: in the first version this must have done piperola and bourdonola as they were on the ' same port and channel. ' If we want to repair the original version, we will have ' to steer them as two separate instruments! ' 15.10.2016: Changed back to the original intended function. LOCAL i AS DWORD LOCAL h AS Harmtype LOCAL aantal_tellen AS WORD LOCAL param AS SINGLE LOCAL cnr AS INTEGER LOCAL noot AS INTEGER STATIC Ritmeteller AS INTEGER STATIC oldcnr AS INTEGER STATIC holdflag AS DWORD STATIC tiks_per_tijd AS WORD STATIC oldnoot AS INTEGER STATIC tel() AS DWORD 'BYTE STATIC slnr AS DWORD STATIC tiks! IF ISFALSE Task(%Litho3).tog THEN tiks_per_tijd = 30 ' ritmische granulatie DIM tel(14) AS STATIC DWORD 'BYTE tel(0) = 2 tel(1) = 4 tel(2) = 6 tel(3) = 8 tel(4) = 12 tel(5) = 16 tel(6) = 18 tel(7) = 24 tel(8) = 32 '27 tel(9) = 36 '32 tel(10)= 42 '36 tel(11)= 48 tel(12)= 56 '60 tel(13)= 64 tel(14)= 78 DIM TaskParamLabels(0) AS STATIC ASCIIZ * 8 TaskParamLabels(0) = "tpt" IF ISFALSE Task(%Litho3).hParam THEN MakeTaskParameterDialog %Litho3,1,Slider(),0,UDctrl(),TaskParamlabels() END IF slnr = TaskEX(%Litho3).SliderNumbers(0) SendMessage Slider(slnr).h, %TBM_SETPOS,%True, 30 ' tiks_per_tijd Slider(slnr).value = 30 Task(%Litho3).freq = App.tempo/ 60! Task(%Litho3).tog = %True MM_Piperola_On MM_Bourdonola_On EXIT SUB END IF param = Tprop!(%litho_scoretime) IF param < 0 THEN EXIT SUB IF ISFALSE Task(%Litho3).Rit.pattern(Ritmeteller) THEN tiks_per_tijd = Slider(slnr).value Ritmeteller = %False aantal_tellen = tel(param * UBOUND(tel)) ' 2 + INT(param * stamteller) ' 6/8 FOR i = 0 TO Aantal_tellen -2 STEP 2 Task(%Litho3).rit.pattern(i) = 1 + ((tiks_per_tijd -1) * param) ' alsmaar meer legato Task(%Litho3).rit.pattern(i+1) = -((tiks_per_tijd + 1) - (Task(%Litho3).rit.pattern(i))) ' rust NEXT i Task(%Litho3).rit.pattern(i)= %False h.vel = SumHar$(Task(%Litho_HideHarm).Har, Task(%Lithos_SolveHarm).Har) tiks! = RitmSigma!(Task(%Litho3).Rit) END IF Task(%Litho3).freq = (tiks! * Task(%Litho3).tempo ) / (60 * ABS(Task(%Litho3).Rit.pattern(Ritmeteller))) IF Task(%Litho3).Rit.pattern(Ritmeteller) > 0 THEN IF oldnoot <= %False THEN oldnoot = -1 SELECT CASE Ritmeteller CASE 0 noot = StealNoteFromHar(Task(%Litho_HideHarm).Har, oldnoot, 36,108) '64, 81) ' includes bourdonola! CASE < 14 noot = StealNoteFromHar(Task(%Litho_HideHarm).Har, oldnoot, 48,108) '64, 81) IF noot > 0 THEN IF oldnoot > 0 THEN AddNote2Har Task(%Litho_HideHarm).har, oldnoot, 64 END IF END IF CASE < 36 noot = StealNoteFromHar(Task(%Lithos_SolveHarm).Har, oldnoot, 48,108) '64, 81) IF noot > 0 THEN IF oldnoot > 0 THEN AddNote2Har Task(%Lithos_SolveHarm).har, oldnoot, 64 END IF END IF CASE ELSE noot = StealNoteFromHar(h, oldnoot, 60, 108) IF noot > 0 THEN IF oldnoot > 0 THEN AddNote2Har h, oldnoot, 64 END IF END IF END SELECT IF noot = -1 THEN IF oldnoot > 0 THEN IF ISFALSE (Ritmeteller MOD 4) THEN noot = (oldnoot \ 12) * 12 IF noot > 72 THEN noot = 72 noot = noot + ((oldnoot MOD 12) + 5) ELSE noot = oldnoot END IF END IF ELSE IF oldnoot > %False THEN AddNote2Har h, oldnoot,64 END IF IF noot <> oldnoot THEN IF noot > %False THEN AddNote2Har Task(%Litho3).Har, noot, 80 AddNote2Har Task(%Litho3).Har, noot + 12, 80 IF param > 0.6 THEN IF noot + 24 < 127 THEN AddNote2Har Task(%Litho3).Har, noot + 24, 80 mPlay Piperola.channel, noot + 24, 80 END IF END IF IF noot > 62 THEN mPlay Piperola.channel, noot, 64 ELSE mPlay Bourdonola.channel, noot, 64 END IF IF noot + 12 > 62 THEN mPlay Piperola.channel, noot + 12, 64 ELSE mPlay Bourdonola.channel, noot+12, 64 END IF oldnoot = noot holdflag = %False END IF ELSE IF noot > %False THEN holdflag = %True END IF END IF ELSEIF Task(%Litho3).Rit.pattern(Ritmeteller) < 0 THEN ' rust IF holdflag = %False THEN IF oldnoot > %False THEN IF oldnoot > 62 THEN NoteOff Piperola.channel, oldnoot ELSE NoteOff Bourdonola.channel, oldnoot END IF IF oldnoot + 12 > 62 THEN NoteOff Piperola.channel, oldnoot + 12 ELSE NoteOff Bourdonola.channel, oldnoot + 12 END IF IF param > 0.6 THEN IF oldnoot + 24 < 127 THEN NoteOff Piperola.channel, oldnoot + 24 END IF END IF oldnoot = %False Task(%Litho3).Har.vel = NUL$(128) END IF END IF END IF INCR Ritmeteller END SUB SUB Monolith4 () ' now vibi and piano LOCAL i AS LONG LOCAL aantal_tellen AS WORD LOCAL noot AS INTEGER LOCAL velo AS BYTE LOCAL param AS SINGLE LOCAL cnr AS INTEGER STATIC Ritmeteller AS INTEGER STATIC icnt AS DWORD STATIC tiks! STATIC oldnoot AS INTEGER STATIC holdflag AS DWORD STATIC oldvibi AS INTEGER STATIC oldpiano AS INTEGER STATIC tel() AS DWORD IF ISFALSE Task(%Litho4).tog THEN oldnoot = -1 ' start = timeGetTime ' in milliseconds DIM tel(0 TO 17) AS STATIC DWORD 'BYTE tel(0) = 2 ' 1/1 tel(1) = 4 ' 2/2 tel(2) = 6 ' 3/4 tel(3) = 8 ' 4/4 tel(4) = 10 ' 5/4 tel(5) = 12 ' 6/8 tel(6) = 16 ' 4/4 tel(7) = 18 ' 9/8 tel(8) = 24 '20 ' 10/8 tel(9) = 32 '24 ' 12/8 tel(10) = 36 '27 ' tel(11)= 42 '30 ' 15/8 tel(12)= 48 '32 ' 4/4 tel(13)= 56 '36 ' 9/8 tel(14)= 64 '40 ' 5/8 tel(15)= 78 '54 ' 3/2 tel(16)= 80 ' tel(17)= 88 Task(%Litho4).freq = App.Tempo / 60! MM_Vibi_On MM_Piano_On Task(%Litho4).tog = %True EXIT SUB END IF IF ISFALSE Task(%Litho4).Rit.pattern(Ritmeteller) THEN param = Tprop!(%litho_scoretime) Ritmeteller = %False aantal_tellen = tel(param * UBOUND(tel)) '3 + INT((param * 8)^2) ' 2, ... 64 FOR i = 0 TO Aantal_tellen -1 STEP 2 Task(%Litho4).rit.pattern(i) = 1 + (20 * ABS((SIN(Tang!(%Litho4) * 60))))' 1 ---->21 Task(%Litho4).rit.pattern(i+1) = -(21 -Task(%Litho4).rit.pattern(i)) NEXT i Task(%Litho4).rit.pattern(i)=%False tiks! = RitmSigma!(Task(%Litho4).Rit) END IF Task(%Litho4).freq = (tiks! * Task(%Litho4).tempo ) / (60 * ABS(Task(%Litho4).Rit.pattern(Ritmeteller))) IF Task(%Litho4).Rit.pattern(Ritmeteller) > 0 THEN IF oldnoot <= %False THEN oldnoot = -1 SELECT CASE Ritmeteller CASE 0 noot = StealNoteFromHar(Task(%Litho_HideHarm).Har, oldnoot, 36, 96) velo = 80 CASE 2,4,6,8,10 noot = StealNoteFromHar(Task(%Litho_HideHarm).Har, oldnoot, 36, 96) velo = 80 IF noot > %False THEN IF oldnoot > %False THEN ' put the previous note back after use... AddNote2Har Task(%Litho_HideHarm).har, oldnoot, velo END IF END IF CASE 12 TO 18 noot = Har2Mel (%Lithos_SolveHarm, Task(%Lithos_SolveHarm).Har, 36, 96) IF noot > 0 THEN velo = LOBYT(noot) noot = HIBYT(noot) ELSE noot = -1 END IF CASE ELSE noot = StealNoteFromHar(Task(%Lithos_SolveHarm).Har, oldnoot, 36, 96) velo = 120 IF noot > %False THEN IF oldnoot > %False THEN ' put the previous note back after use... AddNote2Har Task(%Lithos_SolveHarm).har, oldnoot, velo END IF END IF END SELECT IF noot <> oldnoot THEN IF noot > %False THEN IF ISFALSE (icnt MOD 2) THEN AddNote2Har Piano.Har(1), noot, velo / 2 InstrumPlay Piano oldpiano = noot INCR icnt ELSE mPlay Vibi.channel, noot, velo * 0.8 oldvibi = noot INCR icnt END IF AddNote2Har Task(%Litho4).Har, noot, velo oldnoot = noot holdflag = %False END IF ELSE IF noot > %False THEN holdflag = %True END IF END IF ELSEIF Task(%Litho4).Rit.pattern(Ritmeteller) < 0 THEN IF holdflag = %False THEN IF oldvibi THEN NoteOff Vibi.channel, oldvibi oldvibi = %False END IF IF oldpiano THEN DelNote2Har Piano.Har(1), oldpiano InstrumPlay piano oldpiano = %False END IF DelNote2Har Task(%Litho4).Har, oldnoot oldnoot = %False END IF END IF icnt = icnt AND &H0FF INCR Ritmeteller END SUB SUB Lithos_Meta () 'Task(%Litho_HideHarm).Har 'Task(%SolveHar).Har ' This task can be manually switched on or off. ' However, as now we risk getting stuck notes on switching off. ' springers mapping corrected to the new values 19.04.2012 '15.10.2016: HybrLo added. LOCAL param AS SINGLE LOCAL sp AS SINGLE LOCAL bellynote AS INTEGER LOCAL vibinote AS INTEGER LOCAL pianonote AS INTEGER LOCAL saxnote AS INTEGER LOCAL bourdonnote AS INTEGER STATIC cnt AS DWORD STATIC oldbourdonola AS INTEGER STATIC oldbellynote AS INTEGER STATIC oldvibinote AS INTEGER STATIC oldpianonote AS INTEGER STATIC oldsaxnote AS INTEGER STATIC tromsnote AS INTEGER STATIC woodblock AS INTEGER STATIC springs AS INTEGER STATIC siren AS INTEGER IF ISFALSE Task(%litho_meta).tog THEN MM_Thunderwood_On MM_Belly_On MM_Autosax_On MM_Springers_On MM_Piano_On MM_HybrLo_On MM_Vibi_On MM_Bourdonola_On cnt = %False tromsnote = 48 woodblock = 15 springs = 36 ' was 120 siren = 15 ProgChange HybrLo.channel, 3 ' 'organ' sound Controller HybrLo.channel, 7, 36 ' level to be confirmed for balance... Task(%litho_meta).freq = App.Tempo/ 60! Task(%litho_meta).tog = %True EXIT SUB END IF ' param = Tprop!(%litho_scoretime) '(%litho_meta) ' SELECT CASE param ' CASE < 0.2 ' sp = 1 ' CASE < 0.3 ' sp = 1.5 ' CASE < 0.4 ' sp = 2 ' CASE < 0.6 ' sp = 3 ' CASE < 0.8 ' sp = 4 ' CASE < 0.9 ' sp = 5 ' CASE < 0.99 ' sp = 6 ' CASE ELSE ' sp = 8 ' END SELECT ' better use GetPromil here.. (as it can go beyond 1000! ) param = GetPromil / 1000.0 SELECT CASE GetPromil CASE < 200 '0.2 sp = 1 CASE < 300 '0.3 sp = 1.5 CASE < 400 '0.4 sp = 2 CASE < 600 '< 0.6 sp = 3 CASE < 800 '< 0.8 sp = 4 CASE < 900 '< 0.9 sp = 5 CASE < 1000 '< 0.99 sp = 6 CASE ELSE sp = 8 END SELECT Task(%litho_meta).freq = (App.Tempo / 60!) * sp ' makes accellerando ! SELECT CASE (cnt MOD (sp+sp)) ' so when sp =8 the cases run from 0 -15 CASE 0 bourdonnote = 36 + (App.Globton MOD 12) IF bourdonnote <> oldbourdonola THEN NoteOff Bourdonola.channel, oldbourdonola Release HybrLo.channel, oldbourdonola - 12, 60 mPlay Bourdonola.channel,bourdonnote, 64 mPlay HybrLo.channel, bourdonnote -12, 40 oldbourdonola = bourdonnote END IF CASE 1 IF oldbourdonola THEN NoteOff Bourdonola.channel, oldbourdonola Release HybrLo.channel, oldbourdonola - 12, 60 oldbourdonola = %False END IF CASE 2 bellynote = StealNoteFromHar (Task(%Litho_HideHarm).Har, oldbellynote, belly.Lowtes, belly.Hightes) IF bellynote THEN IF PlayBelly (bellynote, 10 + (param *64), 20) THEN ' 15.09.2006 AddNote2Har Task(%Litho_HideHarm).har, bellynote, 64 ' old Play Belly.channel, bellynote,10 + (param * 64) oldbellynote = bellynote END IF END IF CASE 3 vibinote = StealNoteFromHar (Task(%Lithos_SolveHarm).Har, oldvibinote, vibi.Lowtes, vibi.Hightes) IF vibinote THEN AddNote2Har Task(%Lithos_SolveHarm).har, vibinote, 64 mPlay Vibi.channel, vibinote,MIN(127, 5 + (param * 64)) oldvibinote = vibinote END IF CASE 4 pianonote = StealNoteFromHar (Task(%Litho_HideHarm).Har, oldpianonote, piano.Lowtes, piano.Hightes) IF pianonote THEN IF oldpianonote THEN DelNote2Har Piano.Har(1),oldpianonote oldpianonote = %False END IF AddNote2Har Task(%Litho_HideHarm).har, pianonote, 64 AddNote2Har Piano.Har(1), Pianonote, MIN(127, 12 + (param * 84)) Instrumplay Piano oldpianonote = pianonote END IF CASE 5 saxnote = StealNoteFromHar (Task(%Lithos_SolveHarm).Har, oldsaxnote, Autosax.Lowtes, Autosax.Hightes) IF saxnote THEN IF oldsaxnote THEN NoteOff AutoSax.channel, oldsaxnote oldsaxnote = %False END IF AddNote2Har Task(%Lithos_SolveHarm).har, saxnote, 64 mPlay AutoSax.channel, Saxnote,24 + MIN(100,(param * 100)) oldsaxnote = saxnote ELSE IF oldsaxnote THEN NoteOff AutoSax.channel, oldsaxnote oldsaxnote = %False END IF END IF CASE 6 DECR tromsnote IF tromsnote < 23 THEN tromsnote = 48 ' modif. 22.04.2004 mPlay Troms.Channel, tromsnote,MIN(127, 12 + (param * 120)) CASE 7 DECR woodblock IF woodblock < 1 THEN woodblock = 14 mPlay ThunderWood.Channel, woodblock,MIN(127, 12 + (param * 64)) CASE 8 mPlay ThunderWood.Channel, 19, 127 ' thundersheet CASE 9 DECR tromsnote IF tromsnote < 24 THEN tromsnote = 47 mPlay Troms.Channel, tromsnote, MIN(127,12 + (param * 120)) CASE 10 mPlay ThunderWood.Channel, 17, 127 ' windchimes CASE 11 DECR woodblock IF woodblock < 1 THEN woodblock = 14 mPlay ThunderWood.Channel, woodblock,MIN(127,12 + (param * 120)) CASE 12 IF springs < 36 THEN springs = 36 ' changed 19.04.2012 ' springers 120,121,122,123 - now 36,37,38,39 ' 124,125 = shaker 1 - now 72,73 ' 126,127 = shaker 2 - now 79,80 ' 1 = siren + velo ' 2 = light + velo ' IF springs < 124 THEN ' Play Springers.Channel, 120, 100 ' ELSE 'mPlay Springers.Channel, springs, 46 '100 ' END IF ' modified 19.04.2012 to: SELECT CASE springs CASE 36 TO 39 mPlay Springers.channel, springs, 90 CASE 40 mPlay Springers.channel, 72, 86 CASE 41 mPlay Springers.channel, 73, 80 CASE 42 mPlay Springers.channel, 79, 88 CASE 43 mPlay Springers.channel, 80, 84 END SELECT INCR springs IF springs > 43 THEN springs = 36 CASE 13 'Play Humanola.Channel, siren, 64 ' castagnetten - this was a bug causing a cluster at the end... IF ISFALSE Task(%LithoPerc).swit THEN logfile "Lithos_Meta section 13: percussion starts " Starttask %LithoPerc END IF CASE 14 'Play Piperola.Channel, siren, 64 ' turkish music - this was a bug causing a cluster at the end... 'IF Task(%LithoPerc).swit THEN stoptask %Lithoperc ' was unremmed in the performance on 19.04.2012 (NoSi, gwr) CASE 15 ' siren - variable starts at value 15 IF siren = 15 THEN logfile "Lithos_Meta section 15: siren " IF BIT(siren,0) THEN mPlay Springers.Channel, 1, siren ' on-off ELSE mPlay Springers.Channel, 1, %False mPlay Springers.Channel, 2, MIN(siren + siren,126) ' light ???? check this ! END IF INCR siren IF siren > 127 THEN 'siren = 126 MM_Springers_Off stoptask %Litho_Meta END IF END SELECT INCR cnt END SUB SUB Lithos_HiddenHarm () ' this task contributes and steers globhar, but does not play itself! LOCAL cnr AS INTEGER LOCAL param AS SINGLE LOCAL hoek! LOCAL Snc! LOCAL index AS WORD LOCAL hCursor AS LONG LOCAL zandloper AS ASCIIZ PTR ' silly !!! (caused by declaration of WinApi) STATIC init AS DWORD STATIC Aantalcycli AS DWORD STATIC oldindex AS WORD STATIC Akk() AS INTEGER STATIC TriLim AS SINGLE IF ISFALSE init THEN REDIM Akk(&H0FFF) AS STATIC INTEGER hCursor = GetCursor () zandloper = %IDC_WAIT SetCursor LoadCursor (%Null, BYVAL(zandloper)) ' cfr. declaration PB WinApi SortChordsOnDissonance Akk(), &HFC19, 127 ' dll procedure ' parameters: %SortNoIsomorphs OR %SortPsyChord, minimum diads, max.hexachords, atonal MSGBOX "Chords sorted. Ubound Akk = " & STR$(UBOUND(Akk)),, FUNCNAME$ ' since this takes long, it would be much better to save the lookup to a ' diskfile Task(%Litho_HideHarm).freq = 12 ' for debug: ' LOCAL h AS LONG ' LOCAL i AS LONG ' LOCAL tm AS STRING ' h = FREEFILE ' i = %False ' OPEN "faust\&HFC19.asc" FOR OUTPUT AS #h ' DO ' tm = BIN$(Akk(i) AND &HFFF) ' IF LEN(tm) < 12 THEN ' tm = STRING$(12 - LEN(tm),"0") + tm ' END IF ' PRINT# h, STR$(i), tm 'BIN$(Akk(i) AND &H0FFF) ' INCR i ' LOOP UNTIL i > UBOUND(Akk) ' CLOSE #h ' end debug SetCursor hCursor ' for debug: 'LOCAL i AS INTEGER TriLim = TriangleNumberLimit(UBOUND(Akk)) ' = 71 for ubound = 2497 init = %True IF Task(%Litho_HideHarm).swit THEN Stoptask %Litho_HideHarm 'Logfile "Triangle-max=" & STR$(INT(i)) & " NrChords=" & STR$(UBOUND(Akk)) EXIT SUB END IF IF ISFALSE Task(%Litho_HideHarm).tog THEN oldindex = %False Task(%Litho_HideHarm).Har.vel = NUL$(128) Task(%Litho_HideHarm).freq = 12 'start = timeGetTime ' in milliseconds AantalCycli = 12 '(App.komposduur \ 60) ' 1 cyclus per minuut Task(%Litho_HideHarm).tog = %True END IF 'GOTO NieuwIdee ' IF Tprop!(%Litho_HideHarm) >= 1 THEN StopTask %Litho_HideHarm 'index = Tprop!(%Litho_HideHarm) * UBOUND(Akk) ' linear index = Tprop!(%litho_scoretime) * UBOUND(akk) ' modif. 28.05.2002 IF index < 0 THEN index = 0 : EXIT SUB ' exit sub added 15.12.2002 IF index > UBOUND(Akk) THEN index = UBOUND(Akk) IF index <> oldindex THEN Task(%Litho_HideHarm).Har.vel = NUL$(128) cnr = TransChordNum(Akk(index) OR &H0F000, App.globton) AddCnr2Har Task(%Litho_HideHarm).Har, cnr ,24,112,27 + (Tprop!(%litho_scoretime) * 100) ' now we do something a bit unorthodox: ' we place the chordnumber into the patch field of %Lithos_SolveHarm task !!! (this field is 16 bit, word) Task(%Lithos_SolveHarm).patch = cnr 'PlayHar Task(%Litho_HideHarm).har, Task(%Litho_HideHarm).channel ' for check and debug only oldindex = index Task(%Litho_HideHarm).freq = Task(%Litho_HideHarm).freq * 1.1 IF Task(%Litho_HideHarm).freq > 30 THEN Task(%Litho_HideHarm).freq = 30 ' new 15.12.2002 ELSE Task(%Litho_HideHarm).freq = Task(%Litho_HideHarm).freq * 0.9 IF task(%Litho_HideHarm).freq < 6 THEN Task(%Litho_HideHarm).freq = 6 ' new 15.12.2002 END IF EXIT SUB NieuwIdee: ' new idea: IF Tprop!(%litho_scoretime) >= 1 THEN StopTask %Litho_HideHarm hoek! = Tang!(%litho_scoretime) * AantalCycli Snc! = SIN(hoek! * (1 + (20 * Tprop!(%litho_scoretime)))) ' -1 to + 1 Snc! = ABS(Snc!) * TriLim ' 0 - 71 index = TriangleNumber!(snc!) IF index < 0 THEN index = 0 IF index > UBOUND(Akk) THEN index = UBOUND(Akk) IF index <> oldindex THEN Task(%Litho_HideHarm).Har.vel = NUL$(128) AddCnr2Har Task(%Litho_HideHarm).Har, Akk(index) OR &HF000,24,112,27 + (Tprop!(%litho_scoretime) * 100) ' now we do something a bit unorthodox: ' we place the chordnumber into the patch field of %Lithos_SolveHarm task !!! (this field is 16 bit, word) Task(%Lithos_SolveHarm).patch = Akk(index) 'PlayHar Task(%Litho_HideHarm).har, Task(%Litho_HideHarm).channel oldindex = index Task(%Litho_HideHarm).freq = Task(%Litho_HideHarm).freq * 1.1 ELSE Task(%Litho_HideHarm).freq = Task(%Litho_HideHarm).freq * 0.9 END IF END SUB SUB Lithos_SolvHarm () LOCAL cnr AS INTEGER STATIC oldcnr AS WORD ' the harmstring of this task will contain the harmonic solution of the Hideharmtask ' the chordnumber is passed via Task(%Lithos_SolveHarm).patch ... IF Task(%Lithos_SolveHarm).patch <> oldcnr THEN Task(%Litho_HideHarm).Har.vel = NUL$(128) ' we delete this one, to get sparse textures 'Task(%Lithos_SolveHarm).Har.vel = NUL$(128) ' this gives way to many notes... cnr = SolveCnr(Task(%Lithos_SolveHarm).patch, App.GlobTon) AddCnr2Har Task(%Lithos_SolveHarm).Har, cnr, 24,112,27 + (Tprop!(%litho_scoretime) * 100) oldcnr = Task(%Lithos_SolveHarm).patch ELSE EXIT SUB END IF END SUB SUB Lithos_Control () ' stops when Tprop! becomes >= 1! STATIC slnr AS DWORD IF ISFALSE Task(%litho_command).tog THEN DIM TaskParamLabels(0) AS STATIC ASCIIZ * 8 TaskParamLabels(0) = "tempo" IF ISFALSE Task(%litho_command).hParam THEN MakeTaskParameterDialog %litho_command,1,Slider(),0,UDctrl(),TaskParamlabels() END IF slnr = TaskEX(%litho_command).SliderNumbers(0) SendMessage Slider(slnr).h, %TBM_SETPOS,%True, 20 ' tempo Slider(slnr).value = 20 Task(%litho_command).tog = %True EXIT SUB END IF ' reeds verstreken tijd = (timegettime - start) / 1000 ' in sekonden ' de slider stelt het percentage van de oorspronkelijke app.duur in dat nog zal gespeeld worden ' IF slider(slnr).value <> oldsl0 THEN ' ' nog te spelen tijd: ' todo = App.komposduur - ((timeGetTime- App.tstart)/ 1000) ' IF todo < %False THEN ' todo = %False ' StopTask %Litho_HideHarm ' StopTask %Lithos_tc ' END IF ' todo = todo * (slider(slnr).value / 128) ' App.komposduur = ((timeGetTime - App.tStart) / 1000) + todo ' Task(%Lithos_Drip).duur = App.komposduur ' Task(%Litho_HideHarm).duur = App.komposduur ' Task(%Lithos_SolveHarm).duur = App.komposduur ' Task(%Lithos_tc).duur = App.komposduur ' Task(%Lithos_tc).freq = 12! / App.komposduur ' Task(%Lithos_tc).tempo = Task(%Lithos_tc).freq * 60! ' Task(%Litho0).duur = App.komposduur ' Task(%Litho1).duur = App.komposduur ' Task(%Litho2).duur = App.komposduur ' Task(%Litho3).duur = App.komposduur ' Task(%Litho4).duur = App.komposduur ' Task(%Goethe).duur = App.komposduur ' END IF IF App.tempo <> Slider(slnr).value THEN App.Tempo = Slider(slnr).value IF App.tempo < 1 THEN App.tempo = 1 Task(%Litho_HideHarm).tempo = App.tempo Task(%Lithos_Drip).tempo = App.tempo Task(%Lithos_SolveHarm).tempo = App.tempo Task(%Litho0).tempo = App.tempo Task(%Litho1).tempo = App.tempo Task(%Litho2).tempo = App.tempo Task(%Litho3).tempo = App.tempo Task(%Litho4).tempo = App.tempo END IF END SUB SUB Lithos_Score_Time () ' this task plays nothing itself. - not resettable. ' Its Tprop is used for timing other tasks !!! ' So, it should never be stopped manually. STATIC slnr AS DWORD STATIC oldtempo AS DWORD STATIC tp() AS DWORD IF ISFALSE Task(%litho_scoretime).tog THEN REDIM tp(5) AS STATIC DWORD slnr = TaskEX(%litho_command).SliderNumbers(0) ' must be the tempo slider! IF ISFALSE slnr THEN EXIT SUB END IF Task(%litho_scoretime).tog = %True END IF IF Tprop!(%litho_scoretime) < 1! THEN EXIT SUB ' so do nothing during the normal duration of the piece... ELSE ' are are past the nominal duration of the piece IF Task(%Litho_command).tog THEN StopTask %Litho_command ' Litho_command sets App.tempo to slider, so here we have to ' block its function, since it would make our accel. impossible here. ' However we do send slider change msg's from here, so we can see ' what happens. SELECT CASE GetPromil CASE < 1005 IF ISFALSE tp(0) THEN stoptask %litho0 App.tempo = App.tempo * (4!/3!) Task(%Litho_HideHarm).tempo = App.tempo Task(%Lithos_Drip).tempo = App.tempo Task(%Lithos_SolveHarm).tempo = App.tempo Task(%Litho1).tempo = App.tempo Task(%Litho2).tempo = App.tempo Task(%Litho3).tempo = App.tempo Task(%Litho4).tempo = App.tempo SendMessage Slider(slnr).h, %TBM_SETPOS,%True, App.tempo ' tempo tp(0) = %true logfile "Lithos: Litho0 stopped " & TIME$ 'INCR tpcnt END IF CASE <1020 IF ISFALSE tp(1) THEN stoptask %litho1 App.tempo = App.tempo * 1.5 Task(%Litho_HideHarm).tempo = App.tempo Task(%Lithos_Drip).tempo = App.tempo Task(%Lithos_SolveHarm).tempo = App.tempo Task(%Litho2).tempo = App.tempo Task(%Litho3).tempo = App.tempo Task(%Litho4).tempo = App.tempo SendMessage Slider(slnr).h, %TBM_SETPOS,%True, App.tempo ' tempo tp(1) = %true logfile "Lithos: Litho 1 stopped " & TIME$ 'INCR tpcnt END IF CASE <1030 IF ISFALSE tp(2) THEN stoptask %Litho2 App.tempo = App.tempo * 2 Task(%Litho_HideHarm).tempo = App.tempo Task(%Lithos_Drip).tempo = App.tempo Task(%Lithos_SolveHarm).tempo = App.tempo Task(%Litho3).tempo = App.tempo Task(%Litho4).tempo = App.tempo SendMessage Slider(slnr).h, %TBM_SETPOS,%True, App.tempo ' tempo tp(2) = %true logfile "Lithos: Litho 2 stopped " & TIME$ 'INCR tpcnt END IF CASE <1040 IF ISFALSE tp(3) THEN stoptask %Litho3 App.tempo = App.tempo * (4!/3!) Task(%Litho_HideHarm).tempo = App.tempo Task(%Lithos_Drip).tempo = App.tempo Task(%Lithos_SolveHarm).tempo = App.tempo Task(%Litho4).tempo = App.tempo SendMessage Slider(slnr).h, %TBM_SETPOS,%True, App.tempo ' tempo tp(3) = %true logfile "Lithos: Litho 3 stopped " & TIME$ 'INCR tpcnt END IF CASE <1050 IF ISFALSE tp(4) THEN stoptask %Litho4 App.tempo = App.tempo * 1.5 Task(%Litho_HideHarm).tempo = App.tempo Task(%Lithos_Drip).tempo = App.tempo Task(%Lithos_SolveHarm).tempo = App.tempo SendMessage Slider(slnr).h, %TBM_SETPOS,%True, App.tempo ' tempo tp(4) = %true logfile "Lithos: Litho 4 stopped " & TIME$ 'INCR tpcnt END IF ' overblijvende taken moeten manueel uitgeschakeld worden... END SELECT ' als het te dun zou worden, aan het einde, voorzien we deze oplossing: IF Task(%Litho_HideHarm).Har.vel = NUL$(128) THEN AddShNo2Har Task(%Litho_HideHarm).har, App.Globton, 127 END IF END IF END SUB SUB Lithos_Percus () '%LithoPerc - speelt in finale. 'start vanzelf vanuit de meta-task STATIC pat AS DWORD Task(%LithoPerc).freq = RoundFreq(App.tempo * 8 / 60) pat = 120 + (RND(1) * 7) mPlay Piperola.channel, pat, 120 pat = 112 + (RND(1) * 15) ' castanets mPlay Humanola.channel, pat, 120 mPlay Casta2.channel, pat, 120 ' added 19.04.2012 END SUB SUB Drip_Test () ' dripper code added 10-13.10.2002 ' this procedure is only for setting up, not for performance. ' changed 14.03.2005 ' mapping changed 19.04.2012 LOCAL param AS SINGLE STATIC slnr AS LONG IF ISFALSE Task(%Drip_test).tog THEN DIM TaskParamLabels(0) AS STATIC ASCIIZ*8 TaskParamLabels(0)="size" IF Task(%drip_test).hParam = %Null THEN MakeTaskParameterDialog BYVAL %drip_test,1, Slider(),0,UdCtrl(), TaskParamLabels() END IF slnr = TaskEX(%drip_test).SliderNumbers(0) Slider(Slnr).value = 80 SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Slider(Slnr).value Task(%drip_test).freq = 0.333333 Task(%Drip_Test).tog = %True END IF ' trigger monoflop for drips: mPlay Dripper.channel, 12, Slider(slnr).value ' connected to 12 in 2012., was 15 END SUB SUB Lithos_Whisper () ' 14.09.2013: This coding uses extensive modulation of the sound with the keypress command. ' The inertia of the motors will be the limiting factor for responsiveness. ' 15.10.2016: Integrated fron Namuda study for Whisper into Faust. ' Looks like not working at all... STATIC xtrig, ytrig, ztrig, trig, xnoot, ynoot, znoot, xvel, yvel, zvel AS LONG STATIC sens AS SINGLE LOCAL velo AS LONG IF ISFALSE Task(%Lithos_Whisper).tog THEN sens = 18 MM_Whisper_On IF ISFALSE Task(%Gesture_Analyser).tog THEN starttask %Gesture_Analyser Task(%Lithos_Whisper).tog = %True END IF ' on accelerating body speed ' X-vektor: ' sens = Slider(slnr).value ' frequency is unipolar data, not normalized velo = MAX(gesture.flue_val(0) * 127, @pDoppler.xa * 127) ' integrated amplitude IF gesture.speedup(0) > gesture.slowdown(0) + sens THEN IF ISFALSE xtrig THEN xnoot = MIN(72 + (gesture.speedup(0) / 4),80) IF xnoot <> ynoot AND xnoot <> znoot THEN mPlay Whisper.channel, xnoot, velo xtrig = %True xvel = velo ELSE DO INCR xnoot IF xnoot > 80 THEN xnoot = 72 LOOP UNTIL xnoot <> ynoot AND xnoot <> znoot mPlay Whisper.channel, xnoot, velo xtrig = %True xvel = velo END IF ELSE IF velo <> xvel THEN Keypress Whisper.channel, xnoot, velo xvel = velo END IF END IF ELSE 'RESET xtrig IF xnoot THEN IF ISFALSE gesture.speedup_dur(0) THEN NoteOff Whisper.channel, xnoot RESET xnoot, xtrig, xvel ELSE IF velo <> xvel THEN KeyPress Whisper.channel, xnoot, velo xvel = velo END IF END IF ELSE RESET xtrig, xvel END IF END IF 'velo = 95 + (MAX(uni.vol * 32, @pDoppler.ya * 32)) velo = MAX(gesture.flue_val(1) * 127, @pDoppler.ya * 127) ' integrated amplitude IF gesture.speedup(1) > gesture.slowdown(1) + sens THEN IF ISFALSE ytrig THEN ynoot = MIN(72 + (gesture.speedup(1) / 4),80) IF ynoot <> xnoot AND ynoot <> znoot THEN mPlay Whisper.channel, ynoot, velo ytrig = %true yvel = velo ELSE DO INCR ynoot IF ynoot > 80 THEN ynoot = 72 LOOP UNTIL ynoot <> xnoot AND ynoot <> znoot mPlay Whisper.channel, ynoot, velo ytrig = %true yvel = velo END IF ELSE IF velo <> yvel THEN Keypress Whisper.channel, ynoot, velo yvel = velo END IF END IF ELSE IF ynoot THEN IF ISFALSE gesture.speedup_dur(1) THEN mPlay Whisper.channel, ynoot, %False RESET ynoot, yvel, ytrig ELSE IF velo <> yvel THEN Keypress Whisper.channel, ynoot, velo yvel = velo END IF END IF ELSE RESET ytrig , yvel END IF END IF ' velo = 95 + (MAX(uni.vol * 32, @pDoppler.za * 32)) velo = MAX(gesture.flue_val(2) * 127, @pDoppler.za * 127) ' integrated amplitude IF gesture.speedup(2) > gesture.slowdown(2) + sens THEN IF ISFALSE ztrig THEN znoot = MIN(72 + (gesture.speedup(2) / 4),80) IF znoot <> xnoot AND znoot <> ynoot THEN mPlay Whisper.channel, znoot, velo ztrig = %True zvel = velo ELSE DO INCR znoot IF znoot > 80 THEN znoot = 72 LOOP UNTIL znoot <> xnoot AND znoot <> ynoot END IF mPlay Whisper.channel, znoot, velo ztrig = %True zvel = velo ELSE IF velo <> zvel THEN Keypress Whisper.channel, znoot, velo zvel = velo END IF END IF ELSE IF znoot THEN IF ISFALSE gesture.speedup_dur(2) THEN mPlay Whisper.channel, znoot, %False RESET znoot, ztrig, zvel ELSE IF velo <> zvel THEN Keypress Whisper.channel, znoot,velo zvel = velo END IF END IF ELSE RESET ztrig END IF END IF IF Gesture.speedup(3) > (sens * 10) THEN 'was * 6 IF gesture.speedup(3) > (gesture.slowdown(3) + (sens * 4)) THEN IF ISFALSE trig THEN PlayDur Whisper.channel, 81, MIN(@pDoppler.zf , 127), 500 ' rubbed string trig = Timegettime + 500 ELSE Keypress Whisper.channel, 81,MIN(@pDoppler.zf , 127) END IF END IF ELSE IF Trig THEN IF TimegetTime > trig THEN RESET Trig ELSE Keypress Whisper.channel, 81,MIN(@pDoppler.zf , 127) END IF END IF END IF END SUB SUB Lithos_Whisper_Stop () Controller Whisper.channel, 123, 85 END SUB SUB Lithos_Tinti () ' based on Tinti_Dec in the tinti namuda study ' mapping on slowdown ' 15.04.2010: extended testing under algo1: FIR. Works very reliably now ' 19.09.2015: Version coded for Tinti ' just tintinabuli, no US as yet. ' Bug: doesn't stop... ' bug solved. ' 15.10.2016: Integrated in Lithos - Technofaustus STATIC xnoot, ynoot, znoot, lites AS WORD STATIC sens AS SINGLE IF ISFALSE Task(%Lithos_Tinti).tog THEN sens = 12 Controller Tinti.channel, 30, %False ' bug solution 1 RESET Tinti.ctrl(30) 'Controller Tinti.channel, 7, %False ' better fade out: ' StartTask %Tinti_Fade_Out Controller Tinti.channel, 8, %False RESET Tinti.ctrl(8) Controller Tinti.channel, 31, 28 Tinti.ctrl(31) = 28 IF ISFALSE Task(%Gesture_Analyser).tog THEN starttask %Gesture_Analyser Logfile "Tinti slowdown start at " & TIME$ Task(%Lithos_Tinti).tog = %True END IF IF Gesture.slowdown(0) > sens THEN ' frequency is unipolar data! - under algo1, can go up to 230 IF xnoot THEN NoteOff Tinti.channel, xnoot ' bug solution 2 xnoot = MIN(Tinti.lowtes - sens + (gesture.slowdown_val(0)/2), Tinti.hightes) 'independent from sens 15.04 mPlay Tinti.channel, xnoot, @pDoppler.xa * 127 ELSE IF xnoot THEN NoteOff Tinti.channel, xnoot RESET xnoot END IF END IF IF Gesture.slowdown(1) > sens THEN IF ynoot THEN NoteOff Tinti.channel, ynoot ynoot = MIN(Tinti.lowtes - sens + (gesture.slowdown_val(1)/2), Tinti.hightes) mPlay Tinti.channel, ynoot, @pDoppler.ya * 127 ELSE IF ynoot THEN NoteOff Tinti.channel, ynoot RESET ynoot END IF END IF IF Gesture.slowdown(2) > sens THEN IF znoot THEN NoteOff Tinti.channel, znoot znoot = MIN(Tinti.lowtes - sens + (gesture.slowdown_val(2)/2), Tinti.hightes) mPlay Tinti.channel, znoot, @pDoppler.za * 127 ELSE IF znoot THEN NoteOff Tinti.channel, znoot RESET znoot END IF END IF IF (gesture.slowdown(3) > sens) AND (gesture.slowdown(3) > gesture.speedup(3)) THEN IF ISFALSE lites THEN MM_Tinti_On %MM_Lights lites = %True END IF ELSE IF lites THEN MM_Tinti_Off %MM_Lights RESET lites END IF END IF END SUB '[EOF]