' *************************************************************************** ' * * ' * an automated reed organ by dr.Godfried-Willem Raes * ' * first version used windows timers for note & velo steering * ' * since windows, in later versions, was less and less reliable * ' * with regard to microtiming, we changed the hardware in july * ' * 2005 such as to make Harma listen to midi directly. * ' * The midi version is operational since 03.12.2005 * ' *************************************************************************** ' code module first developed 16.05.2001 ' composition finished 15.06.2001 ' finished 16.06.2001 ' finished 20.06.2001 ' 23.07.2001: code checked for NiDAQ compatibility. ' The printerport version is compiled as gmt_pp.exe ' The NiDAQ version is now compiled with gmt_ii.exe ' 24.07.2001: Now should be part of the g_robots.exe compilation. ' Enable %NiDAQ for the NiDAQ DIO card support in _roboko.inc ' Prefered version uses NiDaq from now on. ' 28.09.2001: Now we can select LPT1 even on machines equiped with NiDAQ and DIO card inserted. ' Of course, using LPT1 is taboo under Win NT/2000 ' 26.01.2002: Fujisan code moved to harmony studies (gmt_alg.exe) ' 29.05.2002: Support for NT & XP with UserPort driver added. ' 29.07.2002: Hidden C harms not working anymore under XP and NT, ok under Me... ' 23.11.2002: Network support for Harma added, replacing midi. ' 08.12.2002: Motor task removed and replaced with dll based periodic timer function. ' 12.12.2002: Debug session UDP-Midi. ' 22.09.2003: file player support added by Kristof Lauwers. ' 24.07.2004: listen masks added. Listentask freq omlaag.(in dll) ' 10.12.2004: rode LED spots toegevoegd ' 12.07.2005: rebuild of harma started. Previous hardware code renamed harma_hw.inc ' 16.05.2005: complete light tests added. ' merged with harma_midi file (kl code) ' 03.12.2005: harma is now a midi robot. Revision completed. ' 04.12.2005: debug session ' 19.11.2009: start work on implementation of an alternative robot for Harma: Harmo. Should be compatible. %hh1 = 32 ' kompositiekode. ' %hh1+1, +2, +3 also used %hh2 = %hh1 + 4 ' for Harma ' %hh2 +1, +2 also used ' %hh2 + 1 = bass voice ' %hh2 + 2 = vocal part, soprano '%hh3 = %hh2 + 4 ' for Harma - no longer present here. %harma_duur = 340000 ' in ms %hsmstrcht = 45 'instalatiekode met harma en sire - geschreven voor maastricht %h_fileplay = 46 %h_tst = 48 ' start number for test tasks - scale test %h_mot = 49 ' dummy task to create slider %h_bel = 50 %h_wit = 52 %h_rood = 53 %h_centr = 54 %h_inside = 55 %h_display = 56 GLOBAL seq() AS HarmType GLOBAL hwCtrlHarma AS LONG GLOBAL hHarmaWindTrackBar AS LONG DECLARE FUNCTION Harma_Init () AS DWORD DECLARE SUB Harma_ButnSWHandler () DECLARE SUB Harma_ButnOSHandler () DECLARE SUB Harma_test () ' scale test for harmonium ' 48 DECLARE SUB Harma_fbell () ' test bell DECLARE SUB Harma_lampjes () ' wit 2x 2 lampjes DECLARE SUB Harma_Rood () ' led spots DECLARE SUB Harma_Centr () ' 1 x 2 lampjes DECLARE SUB Harma_Internal_Red () DECLARE SUB Harma_Display () DECLARE SUB Harma_Lights_Off () DECLARE SUB HarmaMot () ' motor control task DECLARE SUB Harma_Wind_Handler () DECLARE SUB Harma_MidiPlayer (OPT BYVAL resetplaser AS LONG) DECLARE CALLBACK FUNCTION procHarmaMidiPlayerStartWin () DECLARE SUB Harma_MidiPlayerStop () DECLARE SUB Harma_controlroom () DECLARE CALLBACK FUNCTION CB_Harma_Controlroom () DECLARE SUB Harma_Reg1() DECLARE SUB Harma_Reg2() DECLARE SUB Harma_Reg3() DECLARE SUB Harma_Reg4() ' kode voor Harm for Harma DECLARE SUB Harma_Harm1 () ' kompositiekode voor '32 DECLARE SUB Harma_Harm2 () ' sopraan '33. DECLARE SUB Harma_Harm3 () ' baslijn '34 DECLARE SUB Harma_Harm4 () ' startup task '35 ' kode voor studie nr. 2 DECLARE SUB Harma_hh () ' '36 DECLARE SUB Harma_hh_bas () ' baslijn '37 DECLARE SUB Harma_hh_sop () ' soplijn '38 GLOBAL pRadPic() AS RadarPicController PTR ' in g_lib.dll - g_midi.inc #INCLUDE "c:\b\pb\gmt\robots\harma\harma_pics.inc" 'must be preceeded by the declaration for pRadPic FUNCTION Harma_Init () EXPORT AS DWORD LOCAL CockpitLayo AS CockpitLabels LOCAL i AS DWORD LOCAL m AS ASCIIZ * 40 LOCAL zText AS ASCIIZ * 25 LOCAL retval AS LONG GetInstrumentParams Harma, %IDM_HARMA MSGBOX BIN$(harma.patch),,"patch" retval = SetRobotport (Harma, Inifilename, hMidiO()) ReadCockpitLabelsFromFile $HarmaIni, CockpitLayo Task(App.ReadSeqScoreTaskNr).cPtr = %False ' remove from cockpit. App.butnSWCptr = CODEPTR(Harma_ButnSWHandler) App.butnOSCptr = CODEPTR(Harma_ButnOSHandler) ' delete buttons that are not required or functional: ButnSW(2).tag0 = "Motor On" ButnSW(2).tag1 = "Motor Off" ButnSW(2).cptr = %False ButnSW(5).tag0 = "" ButnSW(5).tag1 = "" ButnSW(5).cptr = %False ButnSW(7).tag0 = "HarmaCtrl tog" ButnSW(7).tag1 = "HarmaCtrl tog" ButnSW(7).cptr = CODEPTR(Harma_Controlroom) ButnSW(8).tag0 = "Reg1 Off" 'eerst op off, want alleregisters worden automatisch opengezet ButnSW(8).tag1 = "Reg1 On" ButnSW(8).cptr = CODEPTR(Harma_Reg1) '%False ButnSW(9).tag0 = "Reg2 Off" ButnSW(9).tag1 = "Reg2 On" ButnSW(9).cptr = CODEPTR(Harma_Reg2) '%False ButnSW(10).tag0 = "Reg3 Off" ButnSW(10).tag1 = "Reg3 On" ButnSW(10).cptr = CODEPTR(Harma_Reg3) '%False ButnSW(11).tag0 = "Reg4 Off" ButnSW(11).tag1 = "Reg4 On" ButnSW(11).cptr = CODEPTR(Harma_Reg4) '%False ButnOS(3).tag = "" ButnOS(4).tag = "" ButnOS(5).tag = "" ButnOS(6).tag = "" ButnOS(7).tag = "H_Off" ButnOS(8).tag = "Clear" ProgChange Harma.channel, Harma.patch ' =&B1111 'all registers open IF ISFALSE hMidiI(0) THEN Task(16).naam = "" Task(16).cptr = %False END IF ' harma test code Task(%h_tst).cPtr = CODEPTR(Harma_Test) ' scale with velo Task(%h_tst).freq = 2 Task(%h_tst).naam = "Harma" Task(%h_tst).flags = %False Task(%h_bel).cPtr = CODEPTR(Harma_fbell) Task(%h_bel).freq = 10 Task(%h_bel).naam = "Bell" Task(%h_bel).flags = %False Task(%h_wit).cptr = CODEPTR(Harma_lampjes) Task(%h_wit).freq = 1 Task(%h_wit).naam = "Licht1" Task(%h_wit).flags = %False TaskEX(%h_wit).stopcptr = CODEPTR(Harma_Lights_Off) Task(%h_rood).cptr = CODEPTR(Harma_rood) Task(%h_rood).freq = 4 Task(%h_rood).naam = "Rood" Task(%h_rood).flags = %False TaskEX(%h_rood).stopcptr = CODEPTR(Harma_Lights_Off) Task(%h_centr).cptr = CODEPTR(Harma_centr) Task(%h_centr).freq = 10 Task(%h_centr).naam = "CLite" Task(%h_centr).flags = %False TaskEX(%h_centr).stopcptr = CODEPTR(Harma_Lights_Off) Task(%h_inside).cptr = CODEPTR(Harma_Internal_Red) Task(%h_inside).freq = 10 Task(%h_inside).naam = "Inside" Task(%h_inside).flags = %False TaskEX(%h_inside).stopcptr = CODEPTR(Harma_Lights_Off) Task(%h_display).cptr = CODEPTR(Harma_Display) Task(%h_display).freq = 10 Task(%h_display).naam = "Disp" Task(%h_display).flags = %False TaskEX(%h_display).stopcptr = CODEPTR(Harma_Lights_Off) Task(%h_mot).cPtr = CODEPTR(HarmaMot) Task(%h_mot).freq = 25 Task(%h_mot).naam = "Wind" Task(%h_mot).flags = %False ' --------------------------------------------------- Task(%hh1).naam = "G_hh" '"Harm" Task(%hh1).cptr = CODEPTR(Harma_Harm1) Task(%hh1).freq = 10 Task(%hh1).flags = %HARM_TASK 'OR %MIDI_TASK 'Task(%hh1).patch = 22 Task(%hh1+1).naam = "G_hm" '"Harmel" Task(%hh1+1).cptr = CODEPTR(Harma_Harm2) Task(%hh1+1).freq = 16 Task(%hh1+1).flags = %Harm_TASK 'Task(%hh1+1).patch = 22 Task(%hh1+2).naam = "G_hb" '"Harbas" Task(%hh1+2).cptr = CODEPTR(Harma_Harm3) Task(%hh1+2).freq = 16 Task(%hh1+2).flags = %HARM_TASK 'OR %MIDI_TASK 'Task(%hh1+2).patch = 22 Task(%hh1+3).naam = "" '"HarMeta" Task(%hh1+3).cptr = CODEPTR(Harma_Harm4) Task(%hh1+3).freq = 30 Task(%hh1+3).flags = %HARM_TASK 'OR %MIDI_TASK 'Task(%hh1+3).patch = 22 ' --- --------------------------------------------- ' for the version with human performers, use the midi file! Task(%hh2).naam = "" Task(%hh2).cptr = CODEPTR(Harma_hh) ' hidden harmony Task(%hh2).freq = 1 Task(%hh2).flags = %SCORE_TASK OR %HARM_TASK Task(%hh2).channel = Harma.channel ' harma channel - also used for midi-recording. Task(%hh2).patch = Harma.patch Task(%hh2+1).naam = "hh_bas" Task(%hh2+1).cptr = CODEPTR(Harma_hh_bas) ' baslijn - not played on Harma Task(%hh2+1).freq = 4 Task(%hh2+1).flags = %AUTO_TASK OR %SCORE_TASK OR %HARM_TASK Task(%hh2+1).channel = Bourdonola.channel Task(%hh2+1).patch = 0 Task(%hh2+2).naam = "hh_sop" Task(%hh2+2).cptr = CODEPTR(Harma_hh_sop) ' melodielijn Task(%hh2+2).freq = 3 Task(%hh2+2).flags = %AUTO_TASK OR %SCORE_TASK OR %HARM_TASK Task(%hh2+2).channel = Piperola.channel ' Harma.channel '%Vibi_Channel '2 '--------------------------------------------------------------------------------- Task(%hsmstrcht).naam = "Har+Sir" Task(%hsmstrcht).cptr = CODEPTR(HarmSir) Task(%hsmstrcht).freq = 3 Task(%hsmstrcht).flags = %False TaskEx(%hsmstrcht).StopCptr = CODEPTR(MM_AllOff) Task(%harm_acc).naam = "HarmasPic" 'in robots/harma/harma_pics.inc Task(%harm_acc).cptr = CODEPTR(Harma_RadPic) Task(%harm_acc).freq = 8 Task(%harm_acc).flags = %False TaskEx(%harm_acc).StopCptr = CODEPTR(MM_Harma_Off) '--------------------------------------------------------------------------------- App.MidiPlayerTasknr = %h_fileplay 'the playertask expects itself to be located here - if we don't set the ReadSeqscoreTasknr we get a crash! Task(%h_fileplay).naam = "PlayMid" task(%h_fileplay).cptr = GetProcAddress(GetModuleHandle("g_lib.dll"),"MM_MIDIPLAYER") task(%h_fileplay).freq = 100 taskEX(%h_fileplay).stopcptr = GetProcAddress(GetModuleHandle("g_lib.dll"),"MM_MIDIPLAYERSTOP") '---------------------------------------------------------------------------------- SetDlgItemText gh.Cockpit, %GMT_LABEL_TEMPO, "Wind" SetDlgItemText gh.Cockpit, %GMT_TEXT_TEMPO, STR$(Harma.ctrl(7)) DIM Seq(0 TO 50) AS GLOBAL Harmtype ' to make memory space on startup... App.id = %IDM_HARMA m = "" SendMessage gh.Cockpit, %WM_SETTEXT,0, VARPTR(m) FUNCTION = %True END FUNCTION 'SUB Harma_MidiPlayer(OPT BYVAL resetplayer AS LONG) ' OBSOLETE! - use MM_MidiPlayer ' ' !!! in the works.. !!! ' 'task %mplay ' 'prompts for filename and plays it ' 'filtering allready done for channel (chmap) ' ' filter gets opportunity to process entire msg, and then is supposed to return -1 ' ' a pointer to an alternative mapping funct can be passed to chmap. chmap wil return the return val of that funct ' 'second event type specific filtering mechanism receives event and is supposed to do midioutput itself ' ' - - probably second filter can completely replace first in the end (in the works..) ' 'tempo controll added .2 to 5 * original tempo, scaled log ' 'further filters for note/velo/ctrl needed ' 'check allnotesoff for harma! (in gh.bas?) ' STATIC stat AS LONG '' STATIC md() AS ParsedMidiType ' STATIC events AS DWORD, maxevents AS DWORD 'event counter ' STATIC starttime AS DWORD ' STATIC nfo$, trackinfo$ ' STATIC hProg AS LONG 'progressbar handle ' STATIC hTrack AS LONG 'tempo slider ' STATIC LastScale AS SINGLE ' STATIC stacflag AS BYTE ' STATIC tracks2play AS STRING ' STATIC progress AS DWORD ' STATIC hDlgStart AS LONG ' LOCAL fn AS STRING 'filename ' LOCAL ch AS LONG ' LOCAL i AS DWORD, j AS LONG, k AS LONG ' LOCAL POS AS LONG, length AS LONG ' LOCAL b$ ' IF resetplayer THEN ' IF stat THEN 'stoptask calls function with reset flag also, for the case task is stopped by user ' 'only stop task once or we create an infinite loop here! ' stat = %false: maxevents = %false: starttime = %false: StopTask %h_fileplay ' END IF ' IF hDlgStart THEN DIALOG END hDlgStart: hDlgStart = 0 ' EXIT SUB ' END IF ' IF ISFALSE stat THEN 'we're not playing anything right now.. ' StopTask %h_fileplay ' Starttime = %false ' Task(%h_fileplay).rit.minduur = 1 'we misuse rit.minduur for tempo scaling! ' LastScale = 1 ' nfo$ = "": trackinfo$ = "" '' MSGBOX "rrasenredim" ' ' reset md() ' ' sleep 0 ' REDIM md(100000) AS STATIC ParsedMidiType '' DIALOG DOEVENTS '' MSGBOX "ok" + STR$(UBOUND(md)) '' DIALOG DOEVENTS '' MSGBOX "fileopennamerequest.." ' fn = MidiPlayer_FileOpenName '' MSGBOX fn ' IF TRIM$(fn) = "" THEN EXIT SUB ' 'create control window '' MSGBOX "hdlgstart="+STR$(hDlgStart) + " - win setup.." ' IF ISFALSE hDlgStart THEN ' DIALOG NEW gh.cockpit, FUNCNAME$, , , 300, 60, %WS_POPUP OR %WS_CAPTION TO hDlgStart ' CONTROL ADD LABEL, hDlgStart, 1, "Reading file " + fn, 1, 1, 298, 12 ' CONTROL ADD "msctls_progress32", hDlgStart, 1000, "Progress", 1, 15, 298, 10, _ ' %WS_CHILD OR %WS_VISIBLE OR %WS_BORDER OR %WS_DISABLED OR %PBS_SMOOTH , 0 ' CONTROL ADD LABEL, hDlgStart, 2000, "Speed: 01.00", 1, 30, 45, 12 ' CONTROL ADD "msctls_trackbar32", hDlgStart, 2001, "Speed", 50, 30, 248, 12, %WS_CHILD OR %WS_VISIBLE OR _ ' %TBS_HORZ OR %TBS_NOTICKS ' CONTROL ADD BUTTON, hDlgStart, 100, "&start", 1, 45, 148, 11, %BS_FLAT OR %WS_DISABLED OR %WS_TABSTOP ' CONTROL ADD BUTTON, hDlgStart, 101, "&cancel", 151, 45, 148, 11, %BS_FLAT OR %WS_DISABLED OR %WS_TABSTOP ' CONTROL HANDLE hDlgStart, 1000 TO hProg ' SendMessage hProg, %PBM_SETRANGE, 0, MAKLNG(0,1000) ' CONTROL HANDLE hDlgStart, 2001 TO hTrack ' SendMessage hTrack, %TBM_SETRANGE,%TRUE, MAKLNG(0, 1000) ' SendMessage hTrack, %TBM_SETpagesize, 0, 5 'means shift by 5 if usr clicks next 2 current position/presses pgup ' DIALOG SHOW MODELESS hDlgStart CALL procHarmaMidiPlayerStartWin ' END IF ' SendMessage(hTrack, %TBM_SETPOS,%TRUE, 408) 'set current pos. 408 = tempo 1 (log scaling..) ' FOR i = 0 TO 20: DIALOG DOEVENTS: NEXT 'otherwise dialog doesn't get drawn before the file is parsed '' MSGBOX "win ok - parse midifile ' maxevents = ParseMidiFile(BYVAL fn, BYREF md(), BYREF nfo$, BYREF trackinfo$) '' MSGBOX "parsing done" ' IF ISFALSE LEN(nfo$) THEN nfo$ = "-" ' IF ISFALSE LEN(trackinfo$) THEN trackinfo$ = "-" ' IF ISFALSE maxevents THEN ' MSGBOX "Couldn't read file: " + fn,, FUNCNAME$ + "@harma.inc" ' Harma_MidiPlayer 1: EXIT SUB ' END IF '' MSGBOX "parsing ok - maxevents:" + STR$(maxevents) ' 'prepare filters ' IF ISFALSE INSTR(REMOVE$(nfo$, " "), "") THEN ' MSGBOX "This file is not adapted for use for " + $CRLF + "Try the general purpose player in g_tools",,FUNCNAME$ ' Harma_MidiPlayer 1: EXIT SUB ' END IF ' tracks2play = "" ' FOR i = 1 TO PARSECOUNT (trackinfo$, CHR$(1)) STEP 2 ' j = VAL(PARSE$(trackinfo$, CHR$(1), i)) ' IF j > 127 THEN MSGBOX "the harma midi player doesn't support more then 127 tracks!",,FUNCNAME$ ' b$ = PARSE$(trackinfo$, CHR$(1), i + 1) ' REGEXPR "<([a-zA-Z0-9_ ]+)>" IN b$ TO POS, length ' b$ = UCASE$(REMOVE$(MID$(b$, POS, length), ANY "<> ")) ' IF b$ = "HARMA" THEN tracks2play = tracks2play + CHR$(j) 'max 127 tracks this way !! ' NEXT ' IF ISFALSE LEN(tracks2play) THEN MSGBOX "No tracks found in file!",,FUNCNAME$: Harma_Midiplayer 1: EXIT SUB ' CONTROL ENABLE hDlgStart, 100: CONTROL ENABLE hDlgStart, 101: CONTROL ENABLE hDlgStart, 1000 ' CONTROL SET TEXT hDlgStart, 1, "Ready to play " + fn ' events = 0: stat = 1 ' starttime = %false 'wait 4 startbutton 2 b pressed '' MSGBOX "init ok" ' EXIT SUB ' END IF ' IF ISFALSE starttime THEN starttime = timegettime ' IF LastScale <> task(%h_fileplay).rit.minduur THEN ' FOR i = events TO maxevents ' md(i).time = md(events).time + (md(i).time - md(events).time) * LastScale / task(%h_fileplay).rit.minduur ' NEXT ' LastScale = task(%h_fileplay).rit.minduur ' END IF ' i = 0 ' DO WHILE (md(events).time < (timegettime - starttime)) '' msgbox str$(md(events).time) + str$(timegettime - starttime) ' IF ISFALSE INSTR(tracks2play, CHR$(md(events).track)) THEN ' INCR events ' IF events < UBOUND(md) THEN ITERATE LOOP ELSE GOTO handleendoffile 'empty tracks2play prevention ' 'happened above.. (instr would return 1) ' END IF ' INCR i ' IF i > 10 THEN EXIT LOOP 'safety - max 10 notes at a time ' 'ctrl 123, 7, progchange, note ' SELECT CASE md(events).bStat ' CASE &H090 TO &H09F 'note on ' SELECT CASE md(events).bDat1 ' CASE 29 TO 89 ' IF ISFALSE stacflag THEN ' 'Harma_Note md(events).bDat1, md(Events).bDat2\2 ' Play Harma.channel, md(events).bDat1, md(Events).bDat2\2 ' ELSEIF md(Events).bdat2 THEN ' 'Harma_Stac md(events).bDat1, md(Events).bDat2\2 ' ' ??? will we implement this ' END IF ' CASE 90 ' ' : Harma_Bell md(events).bDat2\2 ' Play Harma.channel, 90, md(events).bDat2\2 ' CASE 91,92 ' ': Harma_Light md(events).bDat1-90, md(events).bDat2 AND 1 ' Play Harma.channel, md(events).bDat1-90, md(events).bDat2 AND 1 ' END SELECT ' CASE &H0B0 TO &H0BF 'control change ' SELECT CASE md(Events).bDat1 ' CASE 7 ' ': Harma_Pwm md(events).bDat2 ' Controller Harma.channel, 7, md(events).bDat2 ' CASE 123 ' 'Harma_AllNotesOff ' Controller Harma.channel, 123, %False ' END SELECT ' CASE &H0C0 TO &H0CF 'progchange ' ProgChange Harma.channel, &B01111 ' ' Harma_Reg 1, BIT(md(events).bDat1, 0): Harma_Reg 2, BIT(md(Events).bDat1, 1) ' ' Harma_Reg 3, BIT(md(events).bDat1, 2): Harma_Reg 4, BIT(md(events).bDat1, 3) ' IF BIT(md(events).bDat2, 4) THEN stacflag = %True ELSE stacflag = %False ' END SELECT ' INCR events ' IF events => MIN(UBOUND(md), maxevents) THEN 'handleendoffile: '' MSGBOX "end - events, ub, max:" + STR$(events) + STR$(UBOUND(md)) + STR$(maxevents) ' Harma_midiplayer 1 ' IF hDlgStart THEN DIALOG END hDlgStart: hDlgstart = 0 ' EXIT SUB ' END IF ' LOOP ' IF INT(1000 * md(events).time / md(maxevents - 1).time) <> progress THEN '<> as we can go back when tempo is slowed down!! ' progress = INT(1000 * md(events).time / md(maxevents - 1).time) ' SendMessage hProg, %PBM_SETPOS, progress, 0 ' END IF 'END SUB 'SUB Harma_MidiPlayerStop ' STATIC initialised AS LONG ' Controller Harma.channel, 123, %False ' Controller Harma.channel, 7, %False ' IF initialised THEN ' Harma_MidiPlayer 1: initialised = 0 ' ELSE ' initialised = 1 ' END IF 'END SUB CALLBACK FUNCTION procHarmaMidiPlayerStartWin LOCAL b$ STATIC hTempoTrack AS DWORD SELECT CASE CBMSG CASE %WM_COMMAND IF CBCTLMSG = %BN_CLICKED THEN SELECT CASE CBCTL CASE 100 'start StartTask %h_fileplay CONTROL GET TEXT CBHNDL, 1 TO b$ REPLACE "Ready to play" WITH "Playing" IN b$ CONTROL SET TEXT CBHNDL, 1, b$ CONTROL DISABLE CBHNDL, CBCTL CASE 101 'cancel StopTask %h_fileplay ' Harma_MidiPlayer 1 'resets.. END SELECT END IF CASE %WM_SHOWWINDOW IF ISFALSE hTempoTrack THEN CONTROL HANDLE CBHNDL, 2001 TO hTempoTrack 'so we can check wich trackbar we have CASE %WM_CLOSE hTempoTrack = %false 'window closed - forget handle so it is updated if win is recreated Destroywindow CBHNDL 'appears to be necessary!! CASE %WM_HSCROLL, %WM_VSCROLL 'note: id doesn't correspond at all with the one given at creation SELECT CASE CBLPARAM CASE hTempoTrack 'tempo trackbar moved IF (LOWRD(CBWPARAM) = %TB_THUMBPOSITION) OR (LOWRD(CBWPARAM) = %TB_THUMBTRACK) THEN Task(%h_fileplay).rit.minduur = .2 + 4.8 * (HIWRD(CBWPARAM)/1000)^2 'we misuse rit.minduur for temdpo scaling 'we should rescale this! ELSE Task(%h_fileplay).rit.minduur= .2 + 4.8 * (SendMessage (CBLPARAM, %TBM_GETPOS,%Null, %Null)/1000)^2 END IF CONTROL SET TEXT CBHNDL, 2000, "Speed: " + FORMAT$(Task(%h_fileplay).rit.minduur, "00.00") END SELECT END SELECT END FUNCTION SUB Harma_ButnSWHandler () LOCAL ButtonNr AS LONG ButtonNr = App.butnSWparam - %GMT_BUTNSW_ID SELECT CASE ButtonNr 'case 0 = Midi Thru CASE 1 ' starts the promil counter. The MT should already be running! ' Starting the cockpit will at the same time block reception of sysex messages, by ' setting the blocking flags in SxThread.flags. IF ButnSW(Buttonnr).flag THEN App.MTstart = %True App.tstart = timeGetTime ' start the chronometerfunction SetDlgItemText gh.Cockpit, %GMT_BUTNSW_ID + ButtonNr, "STOP" ClearMiBuf 0 ' start with a blank midi input buffer BlockSysExReception hMidiI(0) ' dll procedure ELSE App.MTstart = %False SetDlgItemText gh.Cockpit, %GMT_BUTNSW_ID + ButtonNr, "CONT" END IF CASE 2 ' motor on off switch IF ButnSW(Buttonnr).flag THEN Controller Harma.channel, 66, 127 ' 03.12.2005 Harma.ctrl(66) = 127 ELSE Controller Harma.channel, 66, %False Harma.ctrl(66) = %False END IF CASE 4 IF ButnSW(Buttonnr).flag THEN MakeHarVelWindow ' displays Har.vel structure ELSE DestroyWindow gh.HarVel END IF CASE 6 IF ButnSW(Buttonnr).flag THEN MakeHarPsyWindow ' small har.psy window ELSE DestroyWindow gh.HarPsy END IF CASE 7 IF ButnSW(Buttonnr).flag THEN MakeSpectrumWindow ELSE DestroyWindow gh.Spec END IF 'REMARK: buttons 8 -> 11 are handled by individual functions END SELECT App.butnSWparam = %False END SUB SUB Harma_ButnOSHandler () LOCAL ButtonNr AS LONG ButtonNr = App.butnOSparam - %GMT_BUTNOS_ID SELECT CASE ButtonNr CASE 7 Controller Harma.channel, 123, %False CASE 8 ClearDelayArrays ClearMiBuf 0 END SELECT App.butnOSparam = %False END SUB SUB Harma_test () STATIC noot AS BYTE STATIC oldnote AS INTEGER STATIC slnr AS BYTE LOCAL velo AS BYTE IF ISFALSE Task(%h_tst).tog THEN Task(%h_tst).tog = %True ' create a parameter window ' The handle for this window will be returned in Task(Tasknr).hParam DIM TaskParamLabels(0 TO 3) AS ASCIIZ * 8 TaskParamLabels(0) = "Tempo" TaskParamLabels(1) = "Level" TaskParamLabels(2) = "High " TaskParamLabels(3) = "Low " IF Task(%h_tst).hParam = %Null THEN MakeTaskParameterDialog BYVAL %h_tst,4,Slider(),0,UDctrl(),TaskParamLabels() END IF Controller Harma.channel, 123, 0 EXIT SUB END IF IF ISFALSE slnr THEN slnr = TaskEX(%h_tst).SliderNumbers(0) END IF IF oldnote THEN NoteOff Harma.channel, oldnote noot = oldnote + 1 oldnote = %False END IF velo = Slider(slnr+1).value IF noot > Harma.lowtes + ((Slider(slnr+2).value/127!)*61) THEN noot = Harma.lowtes + ((Slider(slnr+3).value/127!)*61) IF noot < Harma.lowtes THEN noot = Harma.lowtes IF noot > Harma.hightes THEN noot = Harma.hightes mPlay Harma.channel, noot, velo oldnote = noot Task(%h_tst).freq = 16! * ((Slider(slnr).value) / 128!) IF Task(%h_tst).freq < 1 THEN Task(%h_tst).freq = 1 ' speed limit in function of velocity: [applicable for repeated notes!] ' max_period = v in ms. ( velo time = v/2 ms, but we need recovery time, thus we take v = v) ' --> fmax = 1000/v 'IF velo THEN ' IF Task(%h_tst).freq > 1000/velo THEN Task(%h_tst).freq = 1000/velo 'END IF END SUB SUB HarmaMot () ' we can control the motor speed in software from here... STATIC slnr AS DWORD IF ISFALSE Task(%h_mot).tog THEN Task(%h_mot).tog = %True ' create a parameter window automatically: ' The handle for this window will be returned in Task(Tasknr).hParam DIM TaskParamLabels(0 TO 0) AS ASCIIZ * 8 TaskParamLabels(0) = "Wind" IF ISFALSE Task(%h_mot).hParam THEN MakeTaskParameterDialog %h_mot,1,Slider(),0,UDctrl(),TaskParamLabels() END IF slnr = TaskEX(%h_mot).SliderNumbers(0) Slider(slnr).cptr = CODEPTR(Harma_Wind_Handler) SendMessage Slider(Slnr).h, %TBM_SETPOS,%True, Harma.ctrl(7) SetDlgItemText gh.Cockpit, %GMT_Text_TEMPO, STR$(Harma.ctrl(7)) Controller Harma.channel, 7, Harma.ctrl(7) EXIT SUB END IF Task(%h_mot).freq = 3 Stoptask %h_mot END SUB SUB Harma_fbell () STATIC slnr AS BYTE LOCAL velo AS BYTE IF ISFALSE Task(%h_bel).tog THEN Task(%h_bel).tog = %True ' create a parameter window automatically: ' The handle for this window will be returned in Task(Tasknr).hParam DIM TaskParamLabels(0 TO 1) AS ASCIIZ * 8 TaskParamLabels(0) = "Tempo" TaskParamLabels(1) = "velo " IF Task(%h_bel).hParam = %Null THEN MakeTaskParameterDialog %h_bel,2,Slider(),0,UDctrl(),TaskParamLabels() END IF EXIT SUB END IF IF ISFALSE slnr THEN slnr = TaskEX(%h_bel).SliderNumbers(0) END IF velo = Slider(slnr+1).value PLAY Harma.channel, 90, velo Task(%h_bel).freq = 32! * ((Slider(slnr).value) / 128!) IF Task(%h_bel).freq < 1 THEN Task(%h_bel).freq = 1 END SUB SUB Harma_Lampjes () STATIC COUNT AS LONG Task(%h_wit).freq = 2 INCR COUNT IF ISFALSE COUNT MOD 3 THEN PLAY Harma.channel, 91, 127 EXIT SUB ELSE PLAY Harma.channel, 91, %False END IF IF ISFALSE COUNT MOD 5 THEN PLAY Harma.channel, 92, 127 EXIT SUB ELSE PLAY Harma.channel, 92, %False END IF END SUB SUB Harma_Rood () STATIC COUNT AS LONG Task(%h_rood).freq = 1.5 INCR COUNT IF ISFALSE COUNT MOD 3 THEN PLAY Harma.channel, 93, 127 EXIT SUB ELSE PLAY Harma.channel, 93, %False END IF IF ISFALSE COUNT MOD 5 THEN PLAY Harma.channel, 94, 127 ELSE NoteOff Harma.channel, 94 END IF END SUB SUB Harma_Centr () STATIC cnt AS LONG Task(%h_centr).freq = 3 INCR cnt IF ISFALSE (cnt MOD 2) THEN PLAY Harma.channel, 95, 127 ELSE PLAY Harma.channel, 95, %False END IF END SUB SUB Harma_Lights_Off () MM_Harma_Off %MM_Lights END SUB SUB Harma_Internal_Red () STATIC cnt AS LONG Task(%h_inside).freq = 4.1 INCR cnt IF ISFALSE (cnt MOD 2) THEN PLAY Harma.channel, 96, 127 ELSE PLAY Harma.channel, 96, %False END IF IF ISFALSE (cnt MOD 3) THEN PLAY Harma.channel, 97, 127 ELSE PLAY Harma.channel, 97, %False END IF END SUB SUB Harma_display () STATIC cnt AS LONG Task(%h_display).freq = 4.7 INCR cnt IF ISFALSE cnt MOD 2 THEN PLAY Harma.channel, 98, 127 ELSE PLAY Harma.channel, 98, %False END IF END SUB ' ****************************************** ' * kompositiekode voor voor Harma * ' ****************************************** SUB Harma_Harm1 () STATIC start AS DWORD STATIC Ritmeteller% STATIC oldcnr AS INTEGER STATIC holdflag AS BYTE STATIC tiks_per_tijd AS WORD STATIC ROOT AS SINGLE STATIC oldnoot AS INTEGER LOCAL tiks! LOCAL param AS SINGLE LOCAL cnr AS INTEGER LOCAL aantal_tellen AS WORD LOCAL i AS DWORD LOCAL teller AS LONG LOCAL lowlim AS BYTE LOCAL highlim AS BYTE IF ISFALSE Task(%hh1).tog THEN Ritmeteller%= %False teller = %False oldnoot = %False holdflag = %False oldcnr = %False Task(%hh1).har.vel = NUL$(128) 'STRING$(128,0) Task(0).har.vel = NUL$(128) 'STRING$(128,0) ' used as dummy... ROOT = 7! tiks_per_tijd = 9 '30 start = timeGetTime ' in milliseconds IF ISFALSE Task(%hh1).duur THEN EXIT SUB ' must have been set by the %hh1+3 task. Task(%hh1).tog = %True END IF ' was before 20.01.2007: 'param = GetAkuDis (Task(%hh1).har) ' 0-1 ' now changed to: FillHarType (Task(%hh1).har, %use_fuzzypsy) param = Task(%hh1).har.dis ' should give identical result as before. ' may work better with the %use_velo flag... App.tempo =(Slider(0).value / 64)* 60 IF App.tempo < 10 THEN App.tempo = 10 Task(%hh1).tempo = App.tempo * (1+param) ' tempo in function of dissonance... param = (timeGetTime - start) / Task(%hh1).duur IF param > 1 THEN Task(%hh1).duur = %False stoptask %hh1 EXIT SUB END IF IF ISFALSE Task(%hh1).Rit.pattern(Ritmeteller%) THEN Ritmeteller% = %False aantal_tellen = 2 + INT(param * ROOT) BIT RESET aantal_tellen, 0 ' should always be even FOR i = 0 TO Aantal_tellen - 2 Task(%hh1).rit.pattern(i) = 1 + ((tiks_per_tijd -1) * param) ' alsmaar langer NEXT i Task(%hh1).rit.pattern(i) = %False END IF tiks! = RitmSigma!(Task(%hh1).Rit) IF tiks! < 1 THEN EXIT SUB ' het tempo voor een gehele maat is frq = task(tasknr%).tempo / 60 ' zo'n gehele maat beslaat een aantal eenheden gegeven in tiks! Task(%hh1).freq = (tiks! * Task(%hh1).tempo ) / (60 * ABS(Task(%hh1).Rit.pattern(Ritmeteller%))) IF Task(%hh1).Rit.pattern(Ritmeteller%) > 0 THEN SELECT CASE Ritmeteller% CASE %False cnr = ParDisChord%( -1,0.1 + ((teller MOD 8)/8!),0.1) CASE ELSE IF ISFALSE (oldcnr AND &H0FFF) THEN cnr = ParConChord%(-1,9.9 - ((teller MOD 7)/7!),0.1) ELSE cnr = SolveCnr (oldcnr,(teller MOD 13)-1) END IF END SELECT IF cnr <> oldcnr THEN Task(%hh1).har.vel = NUL$(128) 'STRING$(128,0) lowlim= 28 + (36 * SIN(3.14 * param)) ' 1/2 sinus highlim = 90 - ( 36 * ABS(COS(3.14 * param))) ' 1/2 cosinus AddCnr2Har Task(%hh1).har, cnr, lowlim,highlim, 30 ' pass to melody and bass task via scratchpad har string in task 0: Task(0).har.vel = Task(%hh1).har.vel PlayHar Task(%hh1).Har, Harma.channel oldcnr = cnr holdflag = %false ELSE holdflag = %true END IF ELSEIF Task(%hh1).Rit.pattern(Ritmeteller%) < 0 THEN IF holdflag = %false THEN Task(%hh1).Har.vel = NUL$(128) 'STRING$(128,0) PlayHar Task(%hh1).Har, Harma.channel oldcnr = %False END IF END IF INCR Ritmeteller% INCR teller END SUB SUB Harma_Harm2 () ' melody generator... STATIC start AS DWORD LOCAL i AS LONG LOCAL v AS BYTE LOCAL nv AS INTEGER LOCAL param AS SINGLE STATIC note AS BYTE STATIC newnote AS BYTE STATIC oldnote AS BYTE IF ISFALSE task(%hh1+1).tog THEN Task(%hh1+1).har.vel = STRING$(128,0) start = timegettime IF ISFALSE task(%hh1+1).duur THEN EXIT SUB Task(%hh1+1).tog = %True END IF param = (timeGetTime - start) / Task(%hh1+1).duur IF param < 1 THEN nv = GetHighestNote (Task(0).Har,29,90) ELSE nv = 29 ' to cause final descent... END IF IF nv > %False THEN newnote = HIBYT(nv) v = LOBYT(nv) ELSE newnote = oldnote END IF IF newnote THEN SELECT CASE newnote - note CASE > 0 ' this means newnote is higher... note = note + (RND(1) * 3) ' IF note < newnote - 15 THEN note = newnote - 15 - remmed 14.06.2001 CASE < 0 ' this means newnote is lower note = note - (RND(1) * 2) CASE 0 ' notes are the same END SELECT SELECT CASE param CASE > 1 'niks CASE > 0.90 IF note < 79 THEN note = note + 12 END IF CASE > 0.65 ' niks CASE > 0.55 ' with 0.6 , the bell does never sound... IF (note MOD 12) = 6 THEN PLAY Harma.channel, 90, v 'Harma_Bell v CASE > 0.5 IF note < 79 THEN note = note + 12 END IF END SELECT IF newnote <> note THEN IF oldnote <> note THEN IF oldnote THEN PLAY Harma.channel, oldnote, %False DelNote2Har Task(%hh1+1).Har, oldnote oldnote = %False END IF PLAY Harma.channel,note, MIN(v*2,127) AddNote2Har Task(%hh1+1).Har, note, MIN(v*2,127) oldnote = note END IF END IF END IF Task(%hh1+1).freq = (App.tempo/ 60) * 4 END SUB SUB Harma_Harm3 () ' bassline generator... STATIC start AS DWORD LOCAL i AS LONG LOCAL v AS BYTE LOCAL nv AS INTEGER LOCAL param AS SINGLE STATIC note AS BYTE STATIC newnote AS BYTE STATIC oldnote AS BYTE IF ISFALSE task(%hh1+2).tog THEN Task(%hh1+2).har.vel = STRING$(128,0) start = timegettime IF ISFALSE Task(%hh1+2).duur THEN EXIT SUB Task(%hh1+2).tog = %True END IF nv = GetLowestNote (Task(0).Har,29,90) IF nv > %False THEN newnote = HIBYT(nv) v = LOBYT(nv) ELSE newnote = oldnote END IF param = (timeGetTime - start) / Task(%hh1+2).duur IF newnote THEN SELECT CASE newnote - note CASE > 0 ' this means newnote is higher... note = note + (RND(1) * 3) IF note < newnote - 15 THEN note = newnote - 15 CASE < 0 ' this means newnote is lower note = note - (RND(1) * 2) CASE 0 ' notes are the same END SELECT SELECT CASE param CASE > 1.05 ' niks CASE > 0.95 IF note > 40 THEN note = note - 12 END IF CASE > 0.7 ' niks CASE > 0.6 IF note > 40 THEN note = note - 12 END IF END SELECT IF newnote <> note THEN IF oldnote <> note THEN IF oldnote THEN PLAY Harma.channel, oldnote, %False DelNote2Har Task(%hh1+2).Har, oldnote oldnote = %False END IF PLAY Harma.channel,note, MIN(v*2,127) AddNote2Har Task(%hh1+2).Har, note, MIN(v*2,127) oldnote = note END IF END IF END IF Task(%hh1+2).freq = (App.tempo/ 60) * 3 END SUB SUB Harma_Harm4 () ' this proc. starts the others! ' handle motor and bell in function of globhar. ' also valid for registration LOCAL param AS SINGLE LOCAL t AS DWORD LOCAL i AS LONG STATIC start AS DWORD STATIC winddruk AS INTEGER STATIC trigval() AS DWORD STATIC togs() AS BYTE STATIC noot1 AS BYTE STATIC noot2 AS BYTE STATIC noot3 AS BYTE STATIC oldnoot1 AS BYTE STATIC oldnoot2 AS BYTE STATIC oldnoot3 AS BYTE STATIC t_ending AS DWORD IF ISFALSE task(%hh1+3).tog THEN Task(%hh1+3).har.vel = STRING$(128,0) Task(%hh1+3).duur = %Harma_duur '360000 start = timegettime Controller Harma.channel, 7, 100 DIM trigval(10) AS STATIC DWORD DIM togs(10) AS STATIC BYTE trigval(0) = Task(%hh1+3).duur / 36 '10000 ' 10 sec trigval(1) = Task(%hh1+3).duur / 20 '18000 ' 18 trigval(2) = Task(%hh1+3).duur / 10 '36 sec was /12 30000 ' 30 - start algo's trigval(3) = Task(%hh1+3).duur / 8 '45 sec was 10 '36000 trigval(4) = Task(%hh1+3).duur / 6 '1'00" 60000 ' 1' trigval(5) = Task(%hh1+3).duur / 3 '2'00" 120000 ' 2' trigval(6) = Task(%hh1+3).duur / 2 '3'00" 180000 ' 3' trigval(7) = Task(%hh1+3).duur / 1.5 '4'00" 240000 ' 4' trigval(8) = Task(%hh1+3).duur / 1.2 '5'00" 300000 ' 5' trigval(9) = Task(%hh1+3).duur / 1.0909 '5'30" 330000 ' end algo's trigval(10) = Task(%hh1+3).duur '6'00" 360000 FOR i= 0 TO 10 togs(i)= %False ' reset NEXT i SetDlgItemText gh.Cockpit, %GMT_TITLE, " for Harma" SetDlgItemText gh.Cockpit, %GMT_AUTHOR, $gwr SetDlgItemText gh.Cockpit, %GMT_TEXT_SLIDER0, "tempo" SetDlgItemText gh.Cockpit, %GMT_TEXT_SLIDER1, "density" SendMessage Slider(0).h, %TBM_SETPOS,%True, 28 ' set initial tempo - slider 0 in cockpit t_ending = %False Task(%hh1+3).tog = %True EXIT SUB END IF t = timegettime - start ' in ms. param = t / Task(%hh1+3).duur ' first we handle the one shot events: i = 0 DO IF t >= trigval(i) THEN IF ISFALSE togs(i) THEN SELECT CASE i CASE 0 ProgChange Harma.channel, &H0001 SetDlgItemText gh.Cockpit, %GMT_MSG2, STR$(i) CASE 1 SetDlgItemText gh.Cockpit, %GMT_MSG2, STR$(i) CASE 2 task(%hh1).duur = task(%hh1+3).duur - trigval(i) - (task(%hh1+3).duur /12) starttask %hh1 SetDlgItemText gh.Cockpit, %GMT_MSG2, STR$(i) CASE 3 task(%hh1+2).duur = task(%hh1+3).duur - trigval(i) - (task(%hh1+3).duur /12) starttask %hh1+2 ' bassline ProgChange Harma.channel, &B01001 SetDlgItemText gh.Cockpit, %GMT_MSG2, STR$(i) CASE 4 task(%hh1+1).duur = task(%hh1+3).duur - trigval(i) - (task(%hh1+3).duur /14) starttask %hh1+1 ' melody line ProgChange Harma.channel, &B01011 NoteOff Harma.channel, 39 'Harma_note 39, %False ' was left on , first run in random numbers... SetDlgItemText gh.Cockpit, %GMT_MSG2, STR$(i) CASE 5 ProgChange Harma.channel, &B01111 SetDlgItemText gh.Cockpit, %GMT_MSG2, STR$(i) CASE 6 SetDlgItemText gh.Cockpit, %GMT_MSG2, STR$(i) CASE 7 SetDlgItemText gh.Cockpit, %GMT_MSG2, STR$(i) CASE 8 SetDlgItemText gh.Cockpit, %GMT_MSG2, STR$(i) CASE 9 noot3 = 29 PLAY Harma.channel, noot3, 100 AddNote2Har Task(%hh1+3).har,noot3,60 oldnoot3 = noot3 SetDlgItemText gh.Cockpit, %GMT_MSG2, STR$(i) CASE 10 SetDlgItemText gh.Cockpit, %GMT_MSG2, STR$(i) 'EXIT SUB ' einde stuk END SELECT togs(i)= %True END IF END IF INCR i LOOP UNTIL i > UBOUND(togs) ' next we handle the processes: SELECT CASE t 'param CASE < trigval(1) Task(%hh1+3).freq = (App.tempo/ 60) * (2+param) noot1= 29 + (RND(1) * 4) IF noot1 <> oldnoot1 THEN IF oldnoot1 THEN NoteOff Harma.channel, oldnoot1 DelNote2Har Task(%hh1+3).har,oldnoot1 oldnoot1 = %False END IF AddNote2Har Task(%hh1+3).har,noot1,10 PLAY Harma.channel, noot1,10 oldnoot1 = noot1 END IF ' changed 08.12.2002 to: winddruk = (param/0.1) * 100 ' 120 changed 04.12.2005 IF winddruk > 100 THEN winddruk = 100 IF winddruk < 18 THEN winddruk = 18 Harma.ctrl(7) = Winddruk Controller Harma.channel, 7, winddruk CASE < trigval(2) Task(%hh1+3).freq = (App.tempo/ 60) * (3+param) noot1= 29 + (RND(1) * 4) IF noot1 <> oldnoot1 THEN IF oldnoot1 THEN DelNote2Har Task(%hh1+3).har,oldnoot1 NoteOff Harma.channel,oldnoot1 oldnoot1 = %False END IF AddNote2Har Task(%hh1+3).har,noot1,10 PLAY Harma.channel, noot1,10 oldnoot1 = noot1 END IF noot2= 30 + (RND(1) * 5) IF noot2 <> oldnoot2 THEN IF oldnoot2 THEN DelNote2Har Task(%hh1+3).har,oldnoot2 NoteOff Harma.channel,oldnoot2 oldnoot2 = %False END IF IF noot2 <> noot1 THEN AddNote2Har Task(%hh1+3).har,noot2,10 PLAY Harma.channel, noot2,10 oldnoot2 = noot2 END IF END IF winddruk = (param/0.1) * 120 IF winddruk > 120 THEN winddruk = 120 IF winddruk < 20 THEN winddruk = 20 Controller Harma.channel, 7, winddruk Harma.ctrl(7) = winddruk EXIT SUB CASE < trigval(3) '=36000 '< 0.21 ' tot 1'15" Task(%hh1+3).freq = (App.tempo/ 60) * (20 * param) winddruk = (param/0.1) * 120 IF winddruk > 120 THEN winddruk = 120 IF winddruk < 20 THEN winddruk = 20 Controller Harma.channel, 7, winddruk Harma.ctrl(7) = winddruk IF oldnoot1 THEN DelNote2Har Task(%hh1+3).har,oldnoot1 NoteOff Harma.channel,oldnoot1 oldnoot1 = %False END IF IF oldnoot2 THEN DelNote2Har Task(%hh1+3).har,oldnoot2 NoteOff Harma.channel,oldnoot2 oldnoot2 = %False END IF EXIT SUB CASE < trigval(4) Task(%hh1+3).freq = (App.tempo/ 60) * (25 * param) EXIT SUB CASE < trigval(5) IF oldnoot1 THEN DelNote2Har Task(%hh1+3).har,oldnoot1 NoteOff Harma.channel,oldnoot1 oldnoot1 = %False END IF IF oldnoot2 THEN DelNote2Har Task(%hh1+3).har,oldnoot2 NoteOff Harma.channel,oldnoot2 oldnoot2 = %False END IF CASE < trigval(9) Task(%hh1+3).freq = (App.tempo/ 60) * (30 * param) EXIT SUB CASE < trigval(10) ' van 330000 (param= to 360000 Task(%hh1+3).freq = (App.tempo/ 60) * (15 * param) winddruk = 120 - (((param - 0.91666!)/0.0833)* 120) IF winddruk > 120 THEN winddruk = 120 IF winddruk < 15 THEN winddruk = 15 Controller Harma.channel, 7, winddruk Harma.ctrl(7) = winddruk noot1 = 89 ' start for final scale down oldnoot1 = %False EXIT SUB CASE ELSE ' ending code Task(%hh1+3).freq = (App.tempo / 60) * 5 noot1 = noot1 - (RND(1) * 3) IF ISFALSE IsNoteInHar(Task(15).Har,noot1) THEN IF noot1 <> oldnoot1 THEN IF oldnoot1 THEN DelNote2Har Task(%hh1+3).har,oldnoot1 NoteOff Harma.channel,oldnoot1 oldnoot1 = %False END IF AddNote2Har Task(%hh1+3).har,noot1,10 PLAY Harma.channel, noot1,10 oldnoot1 = noot1 END IF END IF IF ISFALSE Harma.ctrl(7) THEN IF ISFALSE t_ending THEN t_ending = timeGetTime + 20000 ' uitlooptijd motor... EXIT SUB END IF ELSE Harma.ctrl(7) = %False Controller Harma.channel, 7, %False EXIT SUB END IF IF timeGetTime > t_ending THEN Stoptask %hh1+1 StopTask %hh1+2 Controller Harma.channel, 123, 0 DelNote2Har Task(%hh1+3).har,oldnoot3 StopTask %hh1+3 END IF END SELECT END SUB ' HIDDEN (c) HARMS ************************************************************************ SUB Harma_hh () ' this tasks generates chordal progressions. ' It generates the underlying harmony of the piece ' for soprano, bass and Harma ' rev. 06.12.2005 LOCAL tiks! LOCAL param AS SINGLE LOCAL cnr AS INTEGER LOCAL i AS DWORD LOCAL j AS DWORD LOCAL lowlim AS BYTE LOCAL highlim AS BYTE LOCAL zandloper AS ASCIIZ PTR ' silly !!! (caused by declaration of WinApi) LOCAL hCursor AS LONG STATIC start AS DWORD STATIC Ritmeteller AS INTEGER STATIC tiks_per_tijd AS WORD STATIC teller AS LONG STATIC Akk() AS INTEGER STATIC init AS LONG STATIC p AS LONG STATIC pstart AS LONG IF ISFALSE init THEN REDIM Akk(&HFFF) AS STATIC INTEGER hCursor = GetCursor () zandloper = %IDC_WAIT SetCursor LoadCursor (%Null, BYVAL(zandloper)) ' cfr. declaration PB WinApi SortChordsOnDissonance Akk(), &HFC1C, 127 ' dll procedure ' parameters: %SortNoIsomorphs OR %SortPsyChord MSGBOX "Chords sorted. Ubound Akk = " & STR$(UBOUND(Akk)),,FUNCNAME$ ' = 350 Controller Harma.channel, 7, Slider(1).value Progchange Harma.channel, &B01111 init = %True stoptask %hh2 ' restart required to start the piece. EXIT SUB END IF IF ISFALSE Task(%hh2).tog THEN SetDlgItemText gh.Cockpit, %GMT_TITLE, " for Harma" SetDlgItemText gh.Cockpit, %GMT_AUTHOR, $gwr SetDlgItemText gh.Cockpit, %GMT_TEXT_SLIDER0, "tempo" SetDlgItemText gh.Cockpit, %GMT_TEXT_SLIDER1, "wind " SendMessage Slider(0).h, %TBM_SETPOS,%True, 10 ' set initial tempo - slider 0 in cockpit Ritmeteller = %False teller = %False Task(%hh2).har.vel = STRING$(128,0) Task(0).har.vel = STRING$(128,0) tiks_per_tijd = 19 start = timeGetTime ' in milliseconds Task(%hh2).duur = 240000 Task(%hh2).tog = %True REDIM seq(%RitmArraySize) AS GLOBAL Harmtype p = UBOUND(Akk) pstart = %False END IF App.tempo =(Slider(0).value / 64)* 60 IF App.tempo < 4 THEN App.tempo = 4 IF ISFALSE Task(%hh2).Rit.pattern(Ritmeteller) THEN Ritmeteller = %False ' calculate a new harmonic progression: 'DO ' cnr = ParDisChord%((teller MOD 13)-1,0.1 + ((teller MOD 2)/2!),0.2) 'LOOP UNTIL GetNrNotes%(cnr) < 8 DO cnr = Akk(p) DECR p ' IF p = 0 THEN ' stoptask %hh2 ' EXIT SUB ' END IF IF p <0 THEN p = 0 : EXIT LOOP LOOP UNTIL GetNrNotes%(cnr) < 5 '6 IF ISFALSE pstart THEN pstart = p+1 param = 1! - ((p * 1!) / (pstart*1!)) 'now calculate the whole harmonic sequence beforehand for this bar: Seq(0).vel = STRING$(128,0) ' delete previous contents lowlim = 60 + (30 * SIN(3.14 * param)) ' 1/2 sinus highlim = 60 - ( 30 * ABS(COS(3.14 * param))) ' 1/2 cosinus AddCnr2Har Seq(0), cnr, lowlim,highlim, 50 i = 1 DO REDIM PRESERVE Seq(i) AS GLOBAL HarmType Seq(i).vel = STRING$(128,0) SELECT CASE i MOD 4 CASE 0 Seq(i).vel = SolveMin2$(Seq(i-1),-1,0) CASE 1 Seq(i).vel = SolveHar$(Seq(i-1),(Teller MOD 13)-1,0.01) CASE 2 Seq(i).vel = SolveTrit$(Seq(i-1),-1,0) CASE 3 Seq(i).vel = SolveMaj2$(Seq(i-1),-1,0) END SELECT FillHarType Seq(i), %use_velo FOR j = 0 TO i - 1 IF Seq(i).vel = Seq(j).vel THEN EXIT LOOP NEXT j INCR i LOOP UNTIL i = %RitmArraySize -2 ' now we have 0 to i-1 different chords (= i), and hence we should have that number of notes FOR j = 0 TO i Task(%hh2).rit.pattern(j) = 4 + ((j+1)*tiks_per_tijd * param) ' alsmaar langer NEXT j Task(%hh2).rit.pattern(j) = %False Task(%hh2).har.vel = Seq(0).vel END IF param = 1! - ((p * 1!) / (pstart*1!)) SetDlgItemText gh.Cockpit, %GMT_MSG2, STR$(Ritmeteller) & " " & STR$(p) & " &H" & HEX$(Har2Cnr(Seq(ritmeteller),0),4) '& " " & STR$(i) IF Task(%hh2).Rit.pattern(Ritmeteller) > 0 THEN IF ISFALSE Ritmeteller THEN SELECT CASE param CASE >= 1 Task(%hh2).duur = %False stoptask %hh2 EXIT SUB CASE > 0.2 IF ISFALSE Task(%hh2+1).tog THEN starttask %hh2 + 1 ' bas lijn END IF CASE > 0.1 IF ISFALSE Task(%hh2+2).tog THEN Starttask %hh2 + 2 ' melodie END IF END SELECT END IF Task(%hh2).har.vel = Seq(ritmeteller).vel FillHarType Task(%hh2).har, %use_Velo PlayHar Task(%hh2).Har, Harma.channel ' this makes that the other parts cannot be ' played on Harma! ELSE Task(%hh2).har.vel = STRING$(128,0) PlayHar Task(%hh2).Har, Harma.channel ' note off's END IF Task(%hh2).tempo = (App.tempo / 4) tiks! = RitmSigma!(Task(%hh2).Rit) IF tiks! < 1 THEN EXIT SUB ' het tempo voor een gehele maat is frq = task(tasknr%).tempo / 60 ' zo'n gehele maat beslaat een aantal eenheden gegeven in tiks! Task(%hh2).freq = (tiks! * Task(%hh2).tempo ) / (60 * ABS(Task(%hh2).Rit.pattern(Ritmeteller))) IF task(%hh2).freq > 3 THEN Task(%hh2).freq = 3 INCR Ritmeteller INCR teller ' wind control: j = %False FOR i = 30 TO 91 IF MID$(Task(%hh2).Har.vel,i,1) <> CHR$(0) THEN INCR j NEXT i ' changed to: j = (j* 3) OR 1 IF j > 126 THEN j = 126 IF j < Slider(1).value THEN j = Slider(1).value Controller Harma.channel,7,j Harma.ctrl(7) = j END SUB SUB Harma_hh_bas () ' bassline generator... ' this line should be reserved for another automat (piano or vox humanola) or a human player LOCAL i AS LONG LOCAL v AS BYTE LOCAL nv AS INTEGER STATIC note AS BYTE STATIC newnote AS BYTE STATIC oldnote AS BYTE IF ISFALSE task(%hh2+1).tog THEN Task(%hh2+1).har.vel = STRING$(128,0) Task(%hh2+1).tog = %True oldnote = 29 note = 60 END IF nv = GetLowestNote (Task(%hh2).Har,29,60) IF nv > %False THEN newnote = HIBYT(nv) v = LOBYT(nv) IF (newnote MOD 12) = (oldnote MOD 12) THEN EXIT SUB ELSE newnote = oldnote END IF IF newnote THEN SELECT CASE newnote - note CASE > 0 ' this means newnote is higher... note = note + (RND(1) * 3) CASE < 0 ' this means newnote is lower note = note - (RND(1) * 2) CASE 0 ' notes are the same EXIT SUB END SELECT IF IsNoteInHar (Task(%hh2).Har,note) THEN IF INT(RND(1) * 3) = 1 THEN note = note - 12 END IF END IF ' IF note < 29 THEN note = note + 12 IF note < 36 THEN note = note + 12 ' for bourdonola IF newnote <> note THEN Task(%hh2+1).Har.vel = STRING$(128,0) PlayHar Task(%hh2+1).Har, Task(%hh2+1).channel 'NoteOff Task(%hh2+1).channel, oldnote IF oldnote <> note THEN AddNote2Har Task(%hh2+1).Har, note, MIN(v*2,127) PlayHar Task(%hh2+1).har, Task(%hh2+1).channel 'Play Task(%hh2+1).channel, note, MIN(v*2, 127) oldnote = note END IF ELSE oldnote = note END IF END IF Task(%hh2+1).freq = Task(%hh2).freq * 2 END SUB SUB Harma_hh_sop () ' soprano line generator... ' this should be confined to a violin, a voice or piperola... LOCAL i AS LONG LOCAL v AS BYTE LOCAL nv AS INTEGER STATIC note AS BYTE STATIC newnote AS BYTE STATIC oldnote AS BYTE IF ISFALSE task(%hh2+2).tog THEN Task(%hh2+2).har.vel = STRING$(128,0) Task(%hh2+2).tog = %True oldnote = 90 note = 60 END IF nv = GetHighestNote (Task(%hh2).Har,60,90) IF nv > %False THEN newnote = HIBYT(nv) v = LOBYT(nv) IF (newnote MOD 12) = (oldnote MOD 12) THEN EXIT SUB ELSE newnote = oldnote END IF IF IsNoteInHar (Task(%hh2).Har,note) THEN note = note + 12 IF note > 90 THEN note = note - 12 IF newnote THEN SELECT CASE newnote - note CASE > 0 ' this means newnote is higher... note = note + (RND(1) * 3) CASE < 0 ' this means newnote is lower note = note - (RND(1) * 2) CASE 0 ' notes are the same EXIT SUB END SELECT IF newnote <> note THEN Task(%hh2+2).Har.vel = STRING$(128,0) IF oldnote <> note THEN AddNote2Har Task(%hh2+2).Har, note, MIN(v*2,127) 'Play Task(%hh2+2).channel, note, MIN(v*2, 127) PlayHar Task(%hh2+2).Har, Task(%hh2+2).Channel oldnote = note ELSE PlayHar Task(%hh2+2).Har, Task(%hh2+2).Channel 'NoteOff Task(%hh2+2).channel, oldnote oldnote = %False END IF ELSE oldnote = note END IF END IF Task(%hh2+2).freq = Task(%hh2).freq * 3 END SUB SUB Harma_Wind_Handler () ' called on reception of slider changes in the parameter window of the Motor-task. STATIC slnr AS DWORD LOCAL value AS DWORD IF ISFALSE slnr THEN slnr = TaskEX(%h_mot).SliderNumbers(0) END IF value = Slider(slnr).value Controller Harma.channel, 7,value Harma.ctrl(7) = value SetDlgItemText gh.Cockpit, %GMT_Text_TEMPO, STR$(Harma.ctrl(7)) END SUB SUB Harma_controlroom () 'debugged kl 040928 ' rev. gwr 16.07.2005 LOCAL i AS LONG LOCAL x AS LONG LOCAL b$ IF ISFALSE hwCtrlHarma THEN DIALOG NEW 0, "Harma Control",1,150 ,400, 104, %WS_CAPTION OR %WS_POPUP OR %WS_SYSMENU TO hwCtrlHarma x = 5 FOR i = Harma.lowtes TO Harma.LowTes + (Harma.HighTes - Harma.LowTes)/2 '((Harma.LowTes + Harma.HighTes)/2) - 1 SELECT CASE (i MOD 12) CASE 0 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "C", x, 55, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 1 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "C#", x, 43, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 2 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "D", x, 55, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 3 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "D#", x, 43, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 4 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "E", x, 55, 18, 12, %BS_PUSHLIKE x = x + 20 CASE 5 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "F", x, 55, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 6 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "F#", x, 43, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 7 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "G", x, 55, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 8 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "G#", x, 43, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 9 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "A", x, 55, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 10 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "Bb", x, 43, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 11 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "B", x, 55, 18, 12, %BS_PUSHLIKE x = x + 20 END SELECT NEXT x = 5 FOR i = Harma.LowTes + (Harma.HighTes - Harma.LowTes)/2 TO Harma.Hightes SELECT CASE (i MOD 12) CASE 0 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "C", x, 24, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 1 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "C#", x, 12, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 2 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "D", x, 24, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 3 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "D#", x, 12, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 4 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "E", x, 24, 18, 12, %BS_PUSHLIKE x = x + 20 CASE 5 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "F", x, 24, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 6 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "F#", x, 12, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 7 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "G", x, 24, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 8 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "G#", x, 12, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 9 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "A", x, 24, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 10 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "Bb", x, 12, 18, 12, %BS_PUSHLIKE x = x + 10 CASE 11 CONTROL ADD CHECKBOX, hwCtrlHarma, i, "B", x, 24, 18, 12, %BS_PUSHLIKE x = x + 20 END SELECT NEXT CONTROL ADD LABEL, hwCtrlHarma, 500, "WindPress:", 5, 76, 30, 12 CONTROL ADD "msctls_trackbar32", hwCtrlHarma, 501, _ "WindPress", 36, 76, 135, 12, %WS_CHILD OR %WS_VISIBLE OR _ %TBS_HORZ OR %TBS_BOTTOM CONTROL ADD LABEL, hwCtrlHarma, 503, "?", 174, 76, 30, 12 hHarmaWindTrackBar = GetDlgItem(hwCtrlHarma,501) CONTROL ADD BUTTON, hwCtrlHarma, 600, "All Off", 247, 76, 30, 12 DIALOG SHOW MODELESS hwCtrlHarma CALL CB_Harma_Controlroom ELSE DIALOG END hwCtrlHarma hwCtrlHarma = 0 END IF END SUB CALLBACK FUNCTION CB_Harma_Controlroom () ' adapted gwr 16.07.2005 LOCAL wind AS BYTE LOCAL valve AS SINGLE LOCAL i AS LONG LOCAL note AS BYTE SELECT CASE CBMSG CASE %WM_COMMAND SELECT CASE CBCTL CASE Harma.Lowtes TO Harma.hightes 'note checkboxes CONTROL GET CHECK CBHNDL, CBCTL TO i note = CBCTL PLAY Harma.channel, note, BYVAL i CASE 600 'all off Controller Harma.channel, 123, %False FOR i = Harma.lowtes TO Harma.hightes 'Play Harma.channel, i, 0 CONTROL SET CHECK CBHNDL, i, 0 SLEEP 10 DIALOG DOEVENTS NEXT Harma.ctrl(7) = %False Controller Harma.channel, 7, Harma.ctrl(7) CONTROL SET TEXT CBHNDL, 503, "0"' END SELECT CASE %WM_HSCROLL, %WM_VSCROLL 'note: id doesn't correspond at all with the one given at creation SELECT CASE CBLPARAM CASE hHarmaWindTrackBar 'wind pressure IF (LOWRD(CBWPARAM) = %TB_THUMBPOSITION) OR (LOWRD(CBWPARAM) = %TB_THUMBTRACK) THEN wind = HIWRD(CBWPARAM) ELSE wind = SendMessage (CBLPARAM, %TBM_GETPOS,%Null, %Null) END IF wind = wind * 1.27 CONTROL SET TEXT CBHNDL, 503, STR$(wind) Harma.ctrl(7) = wind Controller Harma.channel, 7, Harma.ctrl(7) END SELECT CASE %WM_CLOSE, %WM_QUIT hwCtrlHarma = 0 Controller Harma.channel, 123, %False Harma.ctrl(7) = %False Controller Harma.channel, 7, Harma.ctrl(7) END SELECT END FUNCTION SUB HarmSir 'installatiecode voor harma en sire LOCAL vl AS SINGLE LOCAL i AS LONG Controller Harma.channel, 7, 100 FOR i = Sire.LowTes TO Sire.HighTes vl = SIN(i + 6.28 * TIMER/(120 + i)) IF vl < 0 THEN PLAY sire.channel, i, 1 ITERATE FOR END IF vl = 5 + 40 * vl ^ 6 ' logfile STR$(i) + STR$(vl) PLAY Sire.channel, i, vl vl = Sire_Velo2MidiNoot (vl, i) IF FRAC(vl) < .3 OR FRAC(vl) > .7 THEN AddNote2Har Harma.Har(1), vl, 10 AddNote2Har Harma.Har(1), vl + 12, 10 END IF NEXT PLAY Sire.channel, 86 + INT(RND * 6), INT(RND + .5) InstrumPlay Harma END SUB SUB Harma_Reg1 BIT TOGGLE Harma.patch, 0 MSGBOX BIN$(harma.patch),,"patch" ProgChange Harma.channel, Harma.patch END SUB SUB Harma_Reg2 BIT TOGGLE Harma.patch, 1 MSGBOX BIN$(harma.patch),,"patch" ProgChange Harma.channel, Harma.patch END SUB SUB Harma_Reg3 BIT TOGGLE Harma.patch, 2 MSGBOX BIN$(harma.patch),,"patch" ProgChange Harma.channel, Harma.patch END SUB SUB Harma_Reg4 BIT TOGGLE Harma.patch, 3 MSGBOX BIN$(harma.patch),,"patch" ProgChange Harma.channel, Harma.patch END SUB '[eof]