%UPort = 16001 GLOBAL glstop AS LONG GLOBAL msgbuffer$ GLOBAL whobuffer$ GLOBAL patternbuf$ GLOBAL robolist$ GLOBAL robo() AS musician GLOBAL player$() GLOBAL scaletype AS LONG GLOBAL serv$ THREAD FUNCTION wwwthread(BYVAL prm AS LONG) AS LONG LOCAL x AS LONG, y AS LONG DO wwwretrieve SLEEP 1500 LapCtrlReply SLEEP 1500 DIALOG GET SIZE gh.cockpit TO x, y IF ISFALSE x THEN EXIT LOOP LOOP warning "www thread terminated" END FUNCTION FUNCTION LapCtrl_Init AS LONG STATIC hThread AS DWORD ' task(32).naam = "wget" 'slowed down the playing task way too much -> in another thread now.. ' task(32).freq = 4 ' task(32).cptr = CODEPTR(wwwretrieve) task(33).naam="play" task(33).freq = 100 task(33).cptr = CODEPTR(PlayIt) Init_MM MM_PanicButtonWindow "", 0, 10, 1 Troms.Lowtes = 24 piano.naam="piano" ScaleType = 1 THREAD CREATE wwwthread(1) TO hThread 'LapCtrlReply "GMT:entering the chat room.." 'first message only connects.. msgbuffer$ = msgbuffer$ + "GMT:entering the chat room.." + CHR$(0) lapctrl_controlroom END FUNCTION MACRO LogosConnect 'opens TCP connection with handle f to wwwwpage$ and sends headers. resets busy flag if connecting failed 'also passes cookie if filled in f = FREEFILE TCP OPEN PORT 80 AT "logosfoundation.eu" AS #f TIMEOUT 15000 'Open server IF ERR THEN Warning "failed connecting to " + serv$ + STR$(ERRCLEAR) busy = 0 TCP CLOSE #f EXIT SUB END IF TCP PRINT #f, "GET " + wwwpage$+ " HTTP/1.0" TCP PRINT #f, "Host: logosfoundation.eu" TCP PRINT #f, "User-Agent: Logos Foundation " IF LEN(cookie$) > 1 THEN 'sic! cookie set to "1" temproary for chat login.. TCP PRINT #f, "Cookie: $version=0;" + cookie$ END IF TCP PRINT #f, "" END MACRO SUB wwwretrieve LOCAL serverport AS LONG '80 LOCAL f AS LONG LOCAL buffer$ LOCAL received$ LOCAL hdr$ 'although we don't really need it.. LOCAL nw$ LOCAL tt$ LOCAL lin$ LOCAL wwwpage$ LOCAL cookie$ 'dummy here.. STATIC lastt$ STATIC busy AS DWORD STATIC lastlen AS DWORD LOCAL p AS LONG LOCAL i AS LONG IF busy THEN warning "function still busy - couldn't perform " + FUNCNAME$ + " at " + TIME$ EXIT SUB END IF busy = 1 'we presume that wwwpage$ is a full url which is syntactically valid and that serv$ is the corresponding server.. wwwpage$ = "http://logosfoundation.eu/RoboJam/msg.html" LogosConnect buffer$=SPACE$(4096) 'Download file received$="" DO TCP RECV #f, 4096, Buffer$ received$ = received$ + Buffer$ LOOP WHILE ISTRUE LEN(Buffer$) AND ISFALSE ERR TCP CLOSE #f 'split off the headers hdr$ = PARSE$(received$, CHR$(13, 10, 13, 10), 1) received$ = PARSE$(received$, CHR$(13, 10, 13, 10), 2) 'show the status in gmt CONTROL SET TEXT gh.cockpit, %GMT_MSG1, "Http Status: " + PARSE$(hdr$, CHR$(13), 1) ' logfile "###DUMP###" ' logfile hdr$ ' logfile received$ ' logfile "###END DUMP### 'check the last changed time p = INSTR(hdr$, "Last-Modified: ") tt$ = RIGHT$(hdr$, 1 + LEN(hdr$) - p) tt$ = PARSE$(tt$, CHR$(13), 1) IF ISFALSE LEN(lastt$) THEN 'ignore anything posted before gmt was started up.. 'TO DO: check if this doesn't give problems when we start with an empty chatbox lastt$ = tt$ lastlen = LEN(received$) busy = 0 EXIT SUB END IF IF tt$ <> lastt$ THEN logfile "update*****************************************************" lastt$ = tt$ nw$ = RIGHT$(received$, LEN(received$) - lastlen) logfile "new---" logfile "'" + nw$ + "'" lastlen = LEN(received$) logfile "LASTLEN:" + STR$(lastlen) REPLACE "

" WITH "*" IN nw$ 'we will use * to discriminate content fom headers.. nw$ = REMOVE$(nw$, "") nw$ = REMOVE$(nw$, "") nw$ = REMOVE$(nw$, "") nw$ = REMOVE$(nw$, "

") FOR i = 1 TO PARSECOUNT(nw$, CHR$(13, 10)) lin$ = PARSE$(nw$, CHR$(13, 10), i) IF LEFT$(lin$, 1) = "*" THEN ChatMsgProc(MID$(lin$, 2)) NEXT END IF busy = 0 END SUB SUB ChatMsgProc(msg$) LOCAL nick$ LOCAL answ$ ' logfile "proc-->" + msg$ nick$ = TRIM$(PARSE$(msg$, ":", 1)) ' warning "nick: '" + nick$ + "'" msg$ = LTRIM$(RIGHT$(msg$, (LEN(msg$) - LEN(Nick$)) - 1)) ' warning "saying: '" + msg$ + "'" 'het volgende is eigenlijk een overbodige tssstap gewordne.. IF nick$ <>"LogosBot" THEN ' warning "msg1: '" + UCASE$(PARSE$(msg$, " ", 1)) + "'" SELECT CASE UCASE$(PARSE$(msg$, " ", 1)) CASE "TALK" 'disregard CASE "CHOOSE", "PATTERN", "SPEED", "PITCH", "PAUSE", "CONTINUE", "RESET", "VOLUME", "REVERSE", "INVERSE", "PREPEND", "APPEND", "SCALE" PlayIt (nick$, msg$) ' CASE "VOLUME" CASE "HEY", "HELLO", "HI", "HOI", "DAG" answ$ = "Hi " + nick$+ "!" ' case "WHO" 'make separate window that's allways up to date.. ' for i = lbound(Player$) to ubound(Player$) ' if trim$(Player$) = "" then iterate for ' msgbuffer$ = msgbuffer$ + Player$(i) + ": " + lcase$(trim$(Robo(i).naam)) + chr$(10) ' next ' !************************************************ CASE ELSE answ$ = nick$ +", '" + msg$ + "' is not understood by LogosBot" END SELECT IF LEN(answ$) THEN msgbuffer$ = msgbuffer$ + answ$ + CHR$(0) 'LapCtrlReply answ$ END IF 'let's try to make some sort of echo server first.. 'normally some processing should happen here, which possibly returns a message.. ' if nick$ <> "GMT" then msg$ = "thanks for saying " + msg$ ' ' end if END SUB SUB LapCtrlReply '(msg$) LOCAL f AS LONG LOCAL wwwpage$ LOCAL buffer$ LOCAL received$ LOCAL busy AS LONG 'dummy for LogosConnect macro LOCAL p AS LONG LOCAL msg$ LOCAL i AS LONG STATIC cookie$ STATIC busyflag AS DWORD 'update online who is playing what IF LEN(whobuffer$) THEN'separate buffer/page to tell who's laying on what.. wwwpage$ = "http://logosfoundation.eu/RoboJam/who.php?" + whobuffer$ ' warning wwwpage$ whobuffer$ = "" LogosConnect buffer$= SPACE$(4096) received$="" DO 'do we need to do this? in fact we don't need the information.. TCP RECV #f, 4096, Buffer$ received$ = received$ + Buffer$ LOOP WHILE ISTRUE LEN(Buffer$) AND ISFALSE ERR ' if len(received$) then warning received$ TCP CLOSE #f END IF 'send list of current patterns - only shown on screen when user clicks button.. IF LEN(patternbuf$) THEN wwwpage$ = "http://logosfoundation.eu/RoboJam/grab.php?" + patternbuf$ patternbuf$ = "" Logosconnect buffer$ = SPACE$(4096) received$ = "" DO 'do we need to do this? in fact we don't need the information.. TCP RECV #f, 4096, Buffer$ received$ = received$ + Buffer$ LOOP WHILE ISTRUE LEN(Buffer$) AND ISFALSE ERR TCP CLOSE #f END IF IF ISFALSE LEN(msgbuffer$) THEN EXIT SUB IF busyflag THEN logfile "still busy.. buffer: "+ msgbuffer$: EXIT SUB busyflag = 1 FOR i = 1 TO PARSECOUNT(msgbuffer$, CHR$(0)) msg$ = PARSE$(msgbuffer$, CHR$(0), i) logfile "send msg:" + STR$(i) + msg$ IF ISFALSE LEN(TRIM$(msg$)) THEN ITERATE FOR CONTROL SET TEXT gh.cockpit, %GMT_MSG2, msg$ REPLACE " " WITH "%20" IN msg$ wwwpage$ = "http://logosfoundation.eu/RoboJam/message.php?nick=LogosBot&msg=" + msg$ LogosConnect buffer$=SPACE$(4096) 'Download file received$="" DO TCP RECV #f, 4096, Buffer$ received$ = received$ + Buffer$ LOOP WHILE ISTRUE LEN(Buffer$) AND ISFALSE ERR NEXT msgbuffer$ = "" TCP CLOSE #f busyflag = 0 END SUB TYPE lcttype basenote AS LONG transp AS LONG note AS LONG velo AS BYTE tickspernote AS CURRENCY 'task freq = 100 tnextnote AS LONG 'in ticks cnt AS LONG 'counter in pattern pitched AS LONG 'pitched ornon-piched instrument warned AS LONG 'flag to prevent superfluous warnings , bit 0 for range limits pause AS LONG END TYPE FUNCTION cleanrobolist(robolist$, b$) AS STRING robolist$ = TRIM$(REMOVE$(robolist$, b$)) REPLACE " " WITH " " IN robolist$ REPLACE ", ," WITH "," IN robolist$ IF LEFT$(robolist$, 1) = "," THEN robolist$ = MID$(robolist$, 2) IF RIGHT$(robolist$, 1) = "," THEN robolist$ = MID$(robolist$, 1, LEN(robolist$) - 1) FUNCTION = robolist$ END FUNCTION MACRO LapCtrl_PArseMessagesIns SELECT CASE UCASE$(PARSE$(msg$, " ", 1)) CASE "CHOOSE" b$ = LCASE$(TRIM$(PARSE$(msg$, " ", 2))) IF ISFALSE(INSTR(robolist$, b$)) THEN msgbuffer$ = msgbuffer$ + nick$ + ", '" + b$ + "' is not an available robot. Please choose from this list: " + robolist$ + CHR$(0) busyflag = 0 EXIT SUB END IF robolist$ = CleanRoboList$(robolist$, b$) last$ = REMOVE$(TRIM$(LCASE$(robo(uid).naam)), CHR$(0)) IF (LEN(last$) > 0) AND (last$ <> b$) THEN InstrumPlay robo(uid) 'notesoff.. 'add it again to the list robolist$ = last$ + ", " + robolist$ END IF msgbuffer$ = msgbuffer$ + "Robots that are still available: " + robolist$ + CHR$(0) lct(i).pitched = 1 lct(i).note = 0 SELECT CASE b$ CASE "vibi": robo(uid) = vibi: lct(i).basenote = 72 CASE "xy": robo(uid) = xy: lct(i).basenote = 84 CASE "tubi": robo(uid) = tubi: lct(i).basenote = 96 CASE "piperola": robo(uid) = piperola: lct(i).basenote = 84 CASE "harma": robo(uid) = harma: lct(i).basenote = 60 CASE "bourdonola": robo(uid) = bourdonola: lct(i).basenote = 48 CASE "krum": robo(uid) = krum: lct(i).basenote = 60 CASE "qt": robo(uid) = qt: lct(i).basenote = 60 CASE "piano": robo(uid) = piano: lct(i).basenote = 60 CASE "troms": robo(uid) = troms: lct(i).basenote = 35: lct(i).pitched = 0 CASE "thunderwood": robo(uid) = thunderwood: robo(uid).lowtes = 1: robo(uid).hightes = 15: lct(i).basenote = 7: lct(i).pitched = 0 CASE "psch": robo(uid) = psch: lct(i).basenote = 77: lct(i).pitched = 0 CASE "snar": robo(uid) = snar: lct(i).basenote = 66: lct(i).pitched = 0 CASE "belly": robo(uid) = belly: lct(i).basenote = 85: lct(i).pitched = 0 'considered non-pitched for now. if we have time we can implement special handling with notematching.. CASE "vacca": robo(uid) = vacca: lct(i).basenote = 72: lct(i).pitched = 0 CASE "casta1": robo(uid) = casta: lct(i).basenote = 113: lct(i).pitched = 0 CASE "casta2": robo(uid) = casta2: lct(i).basenote = 112: lct(i).pitched = 0 CASE "heli": robo(uid) = Heli: lct(i).basenote = 36 CASE "ob": robo(uid) = Ob: lct(i).basenote = 60 CASE "korn": robo(uid) = Korn: lct(i).basenote = 60 CASE "simba": robo(uid) = Simba: lct(i).basenote = 60: lct(i).pitched = 0 CASE "toypi": robo(uid) = Toypi: lct(i).basenote = 72 END SELECT IF ISFALSE lct(i).pitched THEN RESET lct(i).transp LOCAL nic$, ins$ FOR i = LBOUND(player$) TO UBOUND(player$) IF ISFALSE LEN(TRIM$(player$(i))) THEN ITERATE FOR IF LEN(nic$) THEN nic$ = nic$ + "-" ins$ = ins$ + "-" END IF nic$ = nic$ + player$(i) ins$ = ins$ + TRIM$(LCASE$(robo(i).naam)) NEXT whobuffer$ = "nicks=" + nic$ + "&instrums=" + ins$ 'sent by LapCtrlReply (separate thread) CASE "PITCH BIT RESET lct(i).warned, 0 b$ = LCASE$(TRIM$(PARSE$(msg$, " ", 2))) SELECT CASE b$ CASE "up": INCR lct(i).transp CASE "down": DECR lct(i).transp CASE ELSE: lct(i).transp = VAL(b$) END SELECT END SELECT END MACRO MACRO LapCtrl_ParseSpeedVol SELECT CASE UCASE$(PARSE$(msg$, " ", 1)) CASE "SPEED" b$ = LCASE$(TRIM$(PARSE$(msg$, " ", 2))) SELECT CASE b$ CASE "up" tmp = lct(i).tickspernote lct(i).tickspernote = MAX(6.144, lct(i).tickspernote * .8) IF tmp = lct(i).tickspernote THEN msgbuffer$ = msgbuffer$ + nick$ + ", you reached the maximum speed allowed" + CHR$(0) ' LapCtrlReply nick$ + ", you reached the maximum speed allowed" CASE "down" tmp = lct(i).tickspernote lct(i).tickspernote = MIN(58.59375, lct(i).tickspernote * 1.25) IF tmp = lct(i).tickspernote THEN msgbuffer$ = msgbuffer$ +nick$ + ", you reached the minimum speed allowed" + CHR$(0) ' LapCtrlReply nick$ + ", you reached the minimum speed allowed" CASE "reset" lct(i).tickspernote = 30 CASE ELSE LOCAL v AS LONG IF VAL(b$) THEN tmp = 30 v = MAX(1, MIN(11, VAL(b$))) lct(i).tickspernote = CHOOSE (v, 58.593, 48.875, 37.5, 30, 24, 19.2, 15.36, 12.288, 9.83, 7.864, 6.2914) ELSE msgbuffer$ = msgbuffer$ + nick$ + ", your message was not correct. Please use 'SPEED up', 'SPEED down or SPEED reset'" + CHR$(0) END IF END SELECT logfile robo(i).naam + " tpn" + STR$(lct(i).tickspernote) CASE "VOLUME" b$ = LCASE$(PARSE$(msg$, " ", 2)) IF b$ = "up" THEN lct(i).velo = lct(i).velo + 7 'idealy we would make min/max instrument specific IF lct(i).velo > 112 THEN lct(i).velo = 112 msgBuffer$ = nick$ +", maximum volume on " + Robo(uid).naam + " reached" END IF ELSEIF b$ = "down" THEN lct(i).velo = lct(i).velo - 7 IF lct(i).velo < 16 THEN lct(i).velo = 16 msgBuffer$ = nick$ +", minimum volume on " + Robo(uid).naam + " reached" END IF ELSEIF b$ = "reset" THEN lct(i).velo = 48 ELSEIF VAL(b$) THEN lct(i).velo = MAX(16, MIN(112, lct(i).velo + VAL(b$))) ELSE msgbuffer$ = msgbuffer$ + nick$ + ", your message was not correct. Please use 'VOLUME up', 'VOLUME down or 'VOLUME reset'" + CHR$(0) END IF END SELECT END MACRO MACRO LapCtrl_PArseMessagesPat 'A was too long for pb.. SELECT CASE UCASE$(PARSE$(msg$, " ", 1)) CASE "PATTERN" b$ = LCASE$(PARSE$(msg$, " ", 2)) IF ISFALSE LEN(RETAIN$(b$, ANY "*nr")) THEN ' LapCtrlReply nick$ + ", your pattern should contain at least one note (*) or rest (r)" msgbuffer$ = msgbuffer$ + nick$ + ", your pattern should contain at least one note (*/n) or rest (r)" + CHR$(0) busyflag = 0 EXIT SUB END IF pattern$(i) = RETAIN$(b$, ANY "*nr_^vud") ' msgbuffer$ = msgbuffer$ + nick$ + "'s pattern is now " + pattern$(uid) + CHR$(0) lct(i).cnt = 0 BIT RESET lct(i).warned, 0 'also reset this on PITCH newpattern = 1 'TO reset basenote CASE "INVERSE" REPLACE "^" WITH "1" IN pattern$(i) REPLACE "u" WITH "2" IN pattern$(i) REPLACE "v" WITH "3" IN pattern$(i) REPLACE "d" WITH "4" IN pattern$(i) REPLACE "1" WITH "v" IN pattern$(i) REPLACE "2" WITH "d" IN pattern$(i) REPLACE "3" WITH "^" IN pattern$(i) REPLACE "4" WITH "u" IN pattern$(i) msgBuffer$ = nick$ + "'s pattern has been inversed and is now " + pattern$(i) + CHR$(0) lct(i).warned = 0 newpattern = 1 CASE "REVERSE" temp$ = "" FOR j = LEN(pattern$(i)) TO 1 STEP -1 temp$ = temp$ + MID$(pattern$(i), j, 1) NEXT pattern$(i) = temp$ msgBuffer$ = nick$ + "'s pattern has been reversed and is now " + pattern$(i) + CHR$(0) lct(i).warned = 0 newpattern = 1 CASE "PREPEND" b$ = LCASE$(PARSE$(msg$, " ", 2)) temp$ = RETAIN$(b$, ANY "*nr_^vud") IF LEN(temp$) THEN pattern$(i) = temp$ + pattern$(i) msgBuffer$ = nick$ + "'s pattern now is " + pattern$(i) + CHR$(0) END IF newpattern = 1 CASE "APPEND" b$ = LCASE$(PARSE$(msg$, " ", 2)) temp$ = RETAIN$(b$, ANY "*nr_^vud") IF LEN(temp$) THEN pattern$(i) = pattern$(i) + temp$ msgBuffer$ = nick$ + "'s pattern now is " + pattern$(i) + CHR$(0) END IF newpattern = 1 CASE "PAUSE" lct(i).pause = 1 InstrumPlay Robo(i) CASE "CONTINUE" lct(i).pause = 0 CASE "STOP", "RESET" ' pattern$(i) = "" ' RESET robo(i) ' lct(i).transp = 0 ' lct(i).tickspernote = 30 ' lct(i).velo = 48 ' msgbuffer$ = msgbuffer$ + "Reset for " + nick$ + " please choose a new robot and pattern" + CHR$(0) + "Available robots are: " + robolist$ + CHR$(0) ' logfile "reset" + str$(i) + nick$ msgbuffer$ = msgbuffer$ + "Reset has been disabled. Use pause and set the params the way you like.." + CHR$(0) END SELECT IF newpattern THEN 'cmpile message for server.. patternbuf$ = "patterns=" FOR i = LBOUND(pattern$) TO UBOUND(pattern$) IF LEN(TRIM$(pattern$(i))) THEN IF i > LBOUND(pattern$) THEN patternbuf$ = patternbuf$ + "-" END IF patternbuf$ = patternbuf$ + pattern$(i) END IF NEXT newpattern = 0 END IF END MACRO MACRO LapCtrl_ParseScale LOCAL s AS SINGLE SELECT CASE UCASE$(PARSE$(msg$, " ", 1)) CASE "SCALE" IF (timegettime - lastscalechange) < 20000 THEN msgBuffer$ = nick$ + ", changing the scale is allowed only once every 30 seconds. Plese wait " + STR$(30 - (timegettime - lastscalechange) /1000) + "." ELSE 'do scale lastscalechange = timegettime b$ = LCASE$(PARSE$(msg$, " ", 2)) SELECT CASE b$ CASE "spectral" scaletype = 1 s = VAL(PARSE$(msg$, " ", 3)) IF ISFALSE s THEN s = 1 specfac = MAX(.25, MIN(4, s)) msgbuffer$ = msgbuffer$ + "Now using a spectral mapping with augmentation factor" + STR$(specfac) + CHR$(0) CASE "chromatic" scaletype = 2 msgbuffer$ = msgbuffer$ + "Now using the chromatic scale" + CHR$(0) CASE "diatonic" scaletype = 3 msgbuffer$ = msgbuffer$ + "Now using the diatonic scale" + CHR$(0) CASE "pentatonic" scaletype = 4 msgbuffer$ = msgbuffer$ + "Now using the pentatonicc scale" + CHR$(0) CASE ELSE msgbuffer$ = msgbuffer$ + "'" + b$ + "' is not a supported scale type." + CHR$(0) END SELECT END IF END SELECT END MACRO SUB PlayIt(OPT BYVAL nick$, OPT BYVAL msg$) 'main task, when called with nick$/msg$ filled in, it registers the new info in stead of fulfilling it's function a a task ' static robolist$ STATIC pattern$() STATIC newpattern AS LONG ' STATIC player$() 'global STATIC lct() AS lcttype STATIC init AS DWORD STATIC cc AS DWORD 'tickcount STATIC specbase AS SINGLE STATIC specfac AS SINGLE STATIC busyflag AS DWORD STATIC LAstScaleChange AS DWORD LOCAL i AS LONG, j AS LONG LOCAL uid AS LONG LOCAL b$ LOCAL last$ LOCAL tmp AS LONG LOCAL temp$ IF ISFALSE init THEN init = 1 DIM pattern$(12) DIM player$(12) DIM robo(12) DIM lct(12) FOR i = 0 TO UBOUND(lct) lct(i).tickspernote = 30 '4 notes/sec lct(i).velo = 48 NEXT specbase = 24 specfac = 1 robolist$ = "vibi, xy, tubi, piperola, qt, piano, troms" ' LapCtrlReply "Please choose a robot with the command 'CHOOSE [robotname]' ' LapCtrlReply "List of available robots: " + robolist$ msgbuffer$ = msgbuffer$ + "Please choose a robot with the command 'CHOOSE [robotname]'" + CHR$(0) + "List of available robots: " + robolist$ + CHR$(0) Slider(1).value = 64 MM_Piperola_On %MM_Wind OR %MM_Motor MM_Qt_On %MM_WIND OR %MM_Motor MM_Krum_On %MM_Wind OR %MM_Motor MM_HArma_On %MM_Wind OR %MM_Motor MM_Bourdonola_On %MM_Wind OR %MM_Motor Progchange Piano.channel, 122 Progchange Xy.channel, 122 ProgChange Thunderwood.channel, 122 ProgChange Troms.Channel, 122 ProgChange Vacca.Channel, 122 ProgChange Casta2.Channel, 122 END IF 'this function is a task, but can also be called by the thread 'following construction should make this safe - can create problems though if it gets called too much DO WHILE busyflag IF ISFALSE LEN(msg$) THEN EXIT SUB 'when called as tak, just quit - we get back in 1/100 " anyway.. DIALOG DOEVENTS LOOP INCR busyflag ' specfac = .5 + 1.5 * Slider(1).value / 127 CONTROL SET TEXT gh.cockpit, %GMT_author, "spec:" + STR$(specfac) ' logfile nick$ + " - " + msg$ + " - " + robolist$ IF LEN(nick$ + msg$) > 0 THEN logfile FUNCNAME$ + " " + nick$ + " " + msg$ 'first see if nick is known allready FOR i = 0 TO UBOUND(player$) IF ISFALSE LEN(TRIM$(player$(i))) THEN player$(i) = nick$ ' LapCtrlReply "welcome " + nick$ + "!" msgbuffer$ = msgbuffer$ +"welcome " + nick$ + "!" + CHR$(0) uid = i EXIT FOR END IF IF player$(i) = nick$ THEN uid = i EXIT FOR END IF NEXT IF i > UBOUND(player$) THEN ' LapCtrlReply "sorry, the maximum number of users has been exceeded! " + nick$ + " can not participate anymore" msgbuffer$ = msgbuffer$ + "sorry, the maximum number of users has been exceeded! " + nick$ + " can not participate anymore" + CHR$(0) EXIT SUB END IF logfile msgbuffer$ LapCtrl_ParseMessagesIns LapCtrl_ParseSpeedVol LapCtrl_ParseMessagesPat LapCtrl_ParseScale busyflag = 0 EXIT SUB END IF INCR cc ' logfile " cc:" + str$(cc) FOR i = LBOUND(robo) TO UBOUND(robo) 'only start playing after a robot and a pattern are chosen IF ISFALSE LEN(REMOVE$(TRIM$(LCASE$(robo(uid).naam)), CHR$(0))) THEN ITERATE FOR IF ISFALSE LEN(pattern$(i)) THEN ITERATE FOR IF lct(i).pause THEN ITERATE FOR ' logfile str$(lct(i).basenote) IF lct(i).tnextnote - 4 = cc THEN IF MID$(pattern$(i), lct(i).cnt + 1, 1) <> "_" THEN InstrumPlay Robo(i) END IF END IF IF lct(i).tnextnote > cc THEN ITERATE FOR logfile robo(i).naam + "... can play... right now!" + STR$(cc) IF ISFALSE(lct(i).pitched) THEN 'separaate treatment for percussion ' logfile "nonpitcheed - TO DO" IF ISFALSE(lct(i).note) THEN lct(i).note = lct(i).basenote + lct(i).transp DO INCR lct(i).cnt IF lct(i).cnt > LEN(pattern$(i)) THEN lct(i).cnt = 1: lct(i).note = lct(i).basenote + lct(i).transp b$ = MID$(pattern$(i), lct(i).cnt, 1) logfile "read from " + nick$ + " pattern " + STR$(lct(i).cnt) + " " + b$ SELECT CASE LCASE$(b$) CASE "*", "n" 'play note logfile "play" + STR$(lct(i).note) + STR$(lct(i).velo) + " on " + robo(uid).naam + " @" + STR$(cc) + STR$(TIMER) AddNote2Har robo(i).har(1), lct(i).note, lct(i).velo InstrumPlay robo(i) lct(i).tnextnote = cc + lct(i).tickspernote logfile "schedule next note:" + STR$(lct(i).tnextnote) EXIT LOOP CASE "_" 'hold = do nothing lct(i).tnextnote = cc + lct(i).tickspernote EXIT LOOP CASE "r" 'rest logfile "rest @" + STR$(cc) InstrumPlay robo(uid) lct(i).tnextnote = cc + lct(i).tickspernote EXIT LOOP CASE "^", "u" '!pitch up INCR lct(i).note IF lct(i).note > robo(uid).hightes THEN lct(i).note = robo(uid).hightes IF ISFALSE BIT(lct(i).warned, 0) THEN ' LapCtrlReply nick$ + ", the upper limit of " + REMOVE$(TRIM$(LCASE$(robo(i).naam)), CHR$(0)) + "'s range has been reached" msgbuffer$ = msgbuffer$ + nick$ + ", the upper limit of " + REMOVE$(TRIM$(LCASE$(robo(i).naam)), CHR$(0)) + "'s range has been reached" + CHR$(0) BIT SET lct(i).warned, 0 END IF END IF CASE "v","d" DECR lct(i).note IF lct(i).note < robo(uid).lowtes THEN lct(i).note = robo(uid).lowtes IF ISFALSE BIT(lct(i).warned, 0) THEN ' LapCtrlReply nick$ + ", the upper limit of " + REMOVE$(TRIM$(LCASE$(robo(i).naam)), CHR$(0)) + "'s range has been reached" msgbuffer$ = msgbuffer$ + nick$ + ", the lower limit of " + REMOVE$(TRIM$(LCASE$(robo(i).naam)), CHR$(0)) + "'s range has been reached" + CHR$(0) BIT SET lct(i).warned, 0 END IF END IF CASE ELSE Warning "unexpected character in pattern: " + b$ 'zou niet mogen kunnen gebeuren.. EXIT LOOP END SELECT LOOP ' TO DO TO DO !separate handling for perc.. ' !ook flag voor qtt ins toevoegen? ELSE ' logfile "pitched" + str$(lct(i).basenote) IF ISFALSE(lct(i).note) THEN lct(i).note = lct(i).basenote '+ lct(i).transp SELECT CASE scaletype CASE 1: lct(i).note = MatchSpecNote(lct(i).note, specbase, specfac,0, lct(i).transp) 'match to available set of notes CASE 3: lct(i).note = lct(i).note + CHOOSE(1 + lct(i).note MOD 12, 0,1,0,1,0,0,1,0,1,0,1,0) 'diatonic CASE 4: lct(i).note = lct(i).note + CHOOSE(1 + lct(i).note MOD 12, 1,0,1,0,2,1,0,1,0,1,0,2): logfile "startnote "+ STR$(lct(i).note) END SELECT logfile "set note" + STR$(lct(i).note) END IF DO INCR lct(i).cnt IF lct(i).cnt > LEN(pattern$(i)) THEN lct(i).cnt = 1 'reset pitch lct(i).note = lct(i).basenote + lct(i).transp SELECT CASE scaletype CASE 1: lct(i).note = MatchSpecNote(lct(i).note, specbase, specfac,0, lct(i).transp) 'match to available set of notes CASE 3: lct(i).note = lct(i).note + CHOOSE(1 + lct(i).note MOD 12, 0,1,0,1,0,0,1,0,1,0,1,0) 'diatonic CASE 4: lct(i).note = lct(i).note + CHOOSE(1 + lct(i).note MOD 12, 1,0,1,0,2,1,0,1,0,1,0,2): logfile "startnote "+ STR$(lct(i).note) END SELECT logfile "reset note" + STR$(lct(i).note) END IF ' !patroon lezen en interpreteren tem noot/rust en dan loop exiten - er is al gechecked dat er minstenes 1 noot/rust is.. b$ = MID$(pattern$(i), lct(i).cnt, 1) logfile "read from " + nick$ + " pattern " + STR$(lct(i).cnt) + " " + b$ SELECT CASE b$ CASE "*", "n" 'play note logfile "play" + STR$(lct(i).note) + STR$(lct(i).velo) + " on " + robo(uid).naam + " @" + STR$(cc) + STR$(TIMER) AddNote2Har robo(i).har(1), lct(i).note, lct(i).velo InstrumPlay robo(i) lct(i).tnextnote = cc + lct(i).tickspernote logfile "schedule next note:" + STR$(lct(i).tnextnote) EXIT LOOP CASE "_" 'hold = do nothing lct(i).tnextnote = cc + lct(i).tickspernote EXIT LOOP CASE "r" 'rest logfile "rest @" + STR$(cc) InstrumPlay robo(uid) lct(i).tnextnote = cc + lct(i).tickspernote EXIT LOOP CASE "^","u" '!pitch up ' ! hie gaat nog iets mis 'look for a note in the spectrum that is at least logfile "old note" + STR$(lct(i).note) SELECT CASE scaletype CASE 1 'spectral lct(i).note = MatchSpecNote(lct(i).note, specbase, specfac, 1,lct(i).transp) logfile " try note up" + STR$(lct(i).note) IF lct(i).note > robo(i).highTes THEN IF ISFALSE BIT(lct(i).warned, 0) THEN ' LapCtrlReply nick$ + ", the upper limit of " + REMOVE$(TRIM$(LCASE$(robo(i).naam)), CHR$(0)) + "'s range has been reached" msgbuffer$ = msgbuffer$ + nick$ + ", the upper limit of " + REMOVE$(TRIM$(LCASE$(robo(i).naam)), CHR$(0)) + "'s range has been reached" + CHR$(0) BIT SET lct(i).warned, 0 END IF lct(i).note = MatchSpecNote(robo(uid).hightes, specbase, specfac, -1) END IF CASE 2 'chromatic INCR lct(i).note IF lct(i).note > robo(i).highTes THEN IF ISFALSE BIT(lct(i).warned, 0) THEN ' LapCtrlReply nick$ + ", the upper limit of " + REMOVE$(TRIM$(LCASE$(robo(i).naam)), CHR$(0)) + "'s range has been reached" msgbuffer$ = msgbuffer$ + nick$ + ", the upper limit of " + REMOVE$(TRIM$(LCASE$(robo(i).naam)), CHR$(0)) + "'s range has been reached" + CHR$(0) BIT SET lct(i).warned, 0 END IF DECR lct(i).note END IF CASE 3 'diatonic lct(i).note = lct(i).note + CHOOSE(1 + lct(i).note MOD 12, 2, 1, 2,1, 1, 2,1, 2,1, 2, 1,1) IF lct(i).note > robo(i).highTes THEN IF ISFALSE BIT(lct(i).warned, 0) THEN ' LapCtrlReply nick$ + ", the upper limit of " + REMOVE$(TRIM$(LCASE$(robo(i).naam)), CHR$(0)) + "'s range has been reached" msgbuffer$ = msgbuffer$ + nick$ + ", the upper limit of " + REMOVE$(TRIM$(LCASE$(robo(i).naam)), CHR$(0)) + "'s range has been reached" + CHR$(0) BIT SET lct(i).warned, 0 END IF lct(i).note = lct(i).note - 12 END IF CASE 4 'pentatonic lct(i).note = lct(i).note + CHOOSE(1 + lct(i).note MOD 12, 1, 2, 1,3, 2, 1, 2, 1, 2, 1,3, 2) IF lct(i).note > robo(i).highTes THEN IF ISFALSE BIT(lct(i).warned, 0) THEN ' LapCtrlReply nick$ + ", the upper limit of " + REMOVE$(TRIM$(LCASE$(robo(i).naam)), CHR$(0)) + "'s range has been reached" msgbuffer$ = msgbuffer$ + nick$ + ", the upper limit of " + REMOVE$(TRIM$(LCASE$(robo(i).naam)), CHR$(0)) + "'s range has been reached" + CHR$(0) BIT SET lct(i).warned, 0 END IF lct(i).note = lct(i).note - 12 END IF END SELECT logfile "set note up" + STR$(lct(i).note) CASE "v","d" '!pitch down logfile "old note" + STR$(lct(i).note) SELECT CASE scaletype CASE 1 lct(i).note = MatchSpecNote(lct(i).note, specbase, specfac, -1, lct(i).transp) logfile " try note down" + STR$(lct(i).note) IF lct(i).note < robo(uid).lowTes THEN IF ISFALSE BIT(lct(i).warned, 0) THEN ' LapCtrlReply nick$ + ", the lower limit of " + REMOVE$(TRIM$(LCASE$(robo(i).naam)), CHR$(0)) + "'s range has been reached" msgbuffer$ = msgbuffer$ + nick$ + ", the lower limit of " + REMOVE$(TRIM$(LCASE$(robo(i).naam)), CHR$(0)) + "'s range has been reached" + CHR$(0) BIT SET lct(i).warned, 0 END IF lct(i).note = MatchSpecNote(robo(i).lowtes, specbase, specfac, 1) logfile "set note down" + STR$(lct(i).note) END IF CASE 2 DECR lct(i).note IF lct(i).note < robo(i).lowTes THEN IF ISFALSE BIT(lct(i).warned, 0) THEN ' LapCtrlReply nick$ + ", the upper limit of " + REMOVE$(TRIM$(LCASE$(robo(i).naam)), CHR$(0)) + "'s range has been reached" msgbuffer$ = msgbuffer$ + nick$ + ", the lower limit of " + REMOVE$(TRIM$(LCASE$(robo(i).naam)), CHR$(0)) + "'s range has been reached" + CHR$(0) BIT SET lct(i).warned, 0 END IF INCR lct(i).note END IF CASE 3 lct(i).note = lct(i).note - CHOOSE(1 + lct(i).note MOD 12, 1,1,2,1,2,1,1,2,1,2,1,2) IF lct(i).note < robo(i).lowTes THEN IF ISFALSE BIT(lct(i).warned, 0) THEN ' LapCtrlReply nick$ + ", the upper limit of " + REMOVE$(TRIM$(LCASE$(robo(i).naam)), CHR$(0)) + "'s range has been reached" msgbuffer$ = msgbuffer$ + nick$ + ", the lower limit of " + REMOVE$(TRIM$(LCASE$(robo(i).naam)), CHR$(0)) + "'s range has been reached" + CHR$(0) BIT SET lct(i).warned, 0 END IF lct(i).note = lct(i).note + 12 END IF CASE 4 lct(i).note = lct(i).note - CHOOSE(1 + lct(i).note MOD 12, 2,3,1,2,1,2,3,1,2,1,2,1) IF lct(i).note < robo(i).lowTes THEN IF ISFALSE BIT(lct(i).warned, 0) THEN ' LapCtrlReply nick$ + ", the upper limit of " + REMOVE$(TRIM$(LCASE$(robo(i).naam)), CHR$(0)) + "'s range has been reached" msgbuffer$ = msgbuffer$ + nick$ + ", the lower limit of " + REMOVE$(TRIM$(LCASE$(robo(i).naam)), CHR$(0)) + "'s range has been reached" + CHR$(0) BIT SET lct(i).warned, 0 END IF lct(i).note = lct(i).note + 12 END IF END SELECT 'CASE "!" 'accented note? CASE ELSE Warning "unexpected character in pattern: " + b$ 'zou niet mogen kunnen gebeuren.. EXIT LOOP END SELECT LOOP END IF NEXT busyflag = 0 END SUB SUB lapctrl_controlroom(OPT BYVAL proc AS LONG) STATIC masterrobolist$ STATIC wh AS DWORD LOCAL t$ LOCAL i AS LONG, j AS LONG , n AS LONG IF ISFALSE wh THEN masterrobolist$ = "vibi, xy, tubi, piperola, harma, bourdonola, krum, qt, piano, troms, thunderwood, psch, snar, belly, vacca, casta1, casta2, heli, ob, korn, simba, toypi" DIALOG NEW 0, "controlroom",,,100, 360 TO wh FOR i = 1 TO PARSECOUNT(masterrobolist$, ",") CONTROL ADD CHECKBOX, wh, 1000 + i, PARSE$(masterrobolist$, ",", i),1, 13 * i, 98, 12, %BS_PUSHLIKE NEXT CONTROL ADD BUTTON, wh, 2000, "** post changes **", 1, 13 * i, 98, 12, CALL cblapctrlctrl DIALOG SHOW MODELESS wh EXIT SUB END IF IF proc THEN FOR i = 1 TO PARSECOUNT(masterrobolist$, ",") logfile "add " +STR$(i) + PARSE$(masterrobolist$, ",", i) + "???" CONTROL GET CHECK wh, 1000 + i TO j FOR n = LBOUND(robo) TO UBOUND(robo) IF (LCASE$(TRIM$(REMOVE$(robo(n).naam, CHR$(0)))) = PARSE$(masterrobolist$, ",", i)) THEN ITERATE FOR 'i sin use and will be added automatically wwhen given free NEXT IF j THEN t$ = t$ + IIF$(LEN(t$), ",","") + PARSE$(masterrobolist$, ",", i): logfile "yes!" NEXT robolist$ = t$ msgbuffer$ = msgbuffer$ + "The list with available robots has changed. Now you can choose between " + robolist$ + CHR$(0) END IF END SUB CALLBACK FUNCTION cblapctrlctrl IF CBCTLMSG <> %BN_CLICKED THEN EXIT FUNCTION lapctrl_controlroom 1 END FUNCTION FUNCTION MatchSpecNote(BYVAL note AS SINGLE,BYVAL specbase AS SINGLE,BYVAL specfac AS SINGLE, OPT BYVAL flags AS LONG, OPT BYVAL transp AS INTEGER) AS SINGLE 'returns the first note in the spectrum that is matching (or just higher/lower) then a given note LOCAL i AS LONG LOCAL tn AS SINGLE ' logfile FUNCNAME$ + STR$(note) + STR$(specbase) + STR$(specfac) + STR$(flags) SELECT CASE flags CASE 0 'just the first highest note FOR i = 1 TO 500 tn = SpectralNotef(specbase, i, specfac, %expspec) ' logfile " con" + STR$(i) + str$(tn) IF tn > note THEN tn = SpectralNoteF(specbase, i + transp, specfac, %expspec) IF ISFALSE tn THEN tn = SpectralNotef(specbase, i, specfac, %expspec) FUNCTION = tn ' logfile " ok:" + STR$(tn) EXIT FUNCTION END IF NEXT IF ISFALSE tn THEN tn = note ' íf we get tihs far, overtones are so close that they have to wit the note (more or less) CASE 1 'the first note that is at least half a tone higher note = note + 1 FOR i = 1 TO 100 tn = SpectralNotef(specbase, i, specfac, %expspec) IF tn > note THEN FUNCTION = tn EXIT FUNCTION END IF NEXT IF ISFALSE tn THEN tn = note + 1 ' íf we get tihs far, overtones are so close that they have to wit the note (more or less) CASE -1 note = note - 1 FOR i = 100 TO 1 STEP -1 tn = SpectralNotef(specbase, i, specfac, %expspec) IF tn = 0 THEN ITERATE FOR ' logfile " con" + STR$(i) + STR$(tn) IF tn < note THEN FUNCTION = tn ' logfile " ok:" + STR$(tn) EXIT FUNCTION END IF NEXT IF ISFALSE tn THEN tn = note - 1 ' íf we get tihs far, overtones are so close that they have to wit the note (more or less) END SELECT END FUNCTION #IF %DEF (%ouwetroep) 'might be interesting for late rprojects.. this time we won't need it as we will use http GET.. DECLARE FUNCTION ProcessBuffer(BYVAL Buffer AS STRING) AS STRING 'declare FUNCTION DottedIP (BYVAL ip AS LONG) AS STRING DECLARE FUNCTION LapCtrl_Init AS LONG DECLARE THREAD FUNCTION ServerThread(BYVAL dummy AS LONG) AS LONG 'dummy could become a pinter .. 'FUNCTION DottedIP (BYVAL ip AS LONG) AS STRING ' 'convert numeral ip adress to dotted form ' LOCAL x AS BYTE PTR ' x = VARPTR(ip) ' FUNCTION = USING$("#_.#_.#_.#", @x, @x[1], @x[2], @x[3]) ' 'END FUNCTION FUNCTION LapCtrl_Init AS LONG 'as the g_net functions are M&M specific by design, and we want to try a callback-less design, we use do the udp handling here.. maybe parts can go into g_net later on.. LOCAL idThread AS LONG THREAD CREATE ServerThread(0) TO idThread MSGBOX "thread created.." + $CRLF + STR$(ERRCLEAR) THREAD CLOSE idThread TO idThread 'closing it doesn't stop it. the thread sops itself when the gmt window disappears FUNCTION = 1 END FUNCTION THREAD FUNCTION ServerThread(BYVAL dummy AS LONG) AS LONG LOCAL ip AS LONG ' This machines IP address LOCAL hUdp AS LONG ' UDP file number LOCAL Buffer AS STRING ' UDP data received LOCAL ipAddr AS LONG ' IP address of sending machine LOCAL ipPort AS LONG ' UDP Port of sending machine to reply to LOCAL x AS LONG ' Hold the size of the Dialog to test for closure LOCAL Op AS STRING ' Status text Op = "Starting UDP TIME Server." Warning Op ' Get this machines IP address HOST ADDR TO ip ' Open a specific UDP/IP port with a 60 second timeout hUdp = FREEFILE UDP OPEN PORT %UPort AS hUdp TIMEOUT 60000 IF ERR THEN Warning "Failed opeing UDP port" + STR$(%UPort) EXIT FUNCTION END IF ' We opened the UDP/IP port Ok, so inform the user Op = "Listening for broadcasts to " + DottedIP$(ip) + ":" _ + FORMAT$(%UPort) + "..." warning Op DO ' Start listening to the UDP/IP port ERRCLEAR UDP RECV #hUdp, FROM ipAddr, ipPort, Buffer DIALOG GET SIZE gh.cockpit TO x, x 'check if gmt cockpit till exists, which means gmt is still running.. IF ISFALSE(x) THEN EXIT LOOP ' Ignore any timout or other errors IF ERR THEN ITERATE ' We got one, so update the status screen Op = "Received from " + DottedIP$(ipAddr) + ":" + _ FORMAT$(ipPort) + " at " + TIME$ + " -> " + $DQ + Buffer + $DQ warning Op Buffer = ProcessMessage(Buffer) ' Reply with our time and update the screen IF LEN(Buffer) THEN UDP SEND #hUdp, AT ipAddr, ipPort, Buffer Op = "-> Replied with " + TIME$ warning Op LOOP CLOSE #hUdp glStop=0 END FUNCTION FUNCTION ProcessMessage(BYVAL Buffer AS STRING) AS STRING 'receives directly the strings sent over udp. 'the return value is sent back in reply. no reply is sent if the result is an empty string.. LOCAL b$ b$ = UCASE$(TRIM$(PARSE$(Buffer, 1))) SELECT CASE b$ CASE "ACK?" FUNCTION = "ACK!" CASE ELSE 'don't respond FUNCTION = "" END SELECT END FUNCTION #ENDIF