%UPort = 16001 GLOBAL glstop AS LONG GLOBAL msgbuffer$ GLOBAL robolist$ GLOBAL robo() AS musician GLOBAL serv$ THREAD FUNCTION wwwthread(BYVAL prm AS LONG) AS LONG LOCAL x AS LONG, y AS LONG DO wwwretrieve SLEEP 50 LapCtrlReply SLEEP 50 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 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.org" 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.org" 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 header$ '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.org/chat/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 header$ = 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$(header$, CHR$(13), 1) ' logfile "###DUMP###" ' logfile received$ ' logfile "###END DUMP### 'check the last changed time p = INSTR(header$, "Last-Modified: ") tt$ = RIGHT$(header$, 1 + LEN(header$) - 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" PlayIt (nick$, msg$) ' CASE "VOLUME" CASE "HEY", "HELLO", "HI", "HOI", "DAG" answ$ = "Hi " + nick$+ "!" 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 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.org/chat/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_PArseMessages SELECT CASE UCASE$(PARSE$(msg$, " ", 1)) CASE "CHOOSE" b$ = LCASE$(TRIM$(PARSE$(msg$, " ", 2))) warning b$ + " - " + robolist$ + " - " + STR$(INSTR(robolist$, b$)) IF ISFALSE(INSTR(robolist$, b$)) THEN ' LapCtrlReply nick$ + ", '" + b$ + "' is not an available robot. Please choose from this list: " + robolist$ 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$) ' LapCtrlReply nick$ + " is now playing on " + b$ + ". msgbuffer$ = msgbuffer$ + nick$ + " is now playing on " + b$ + "." + CHR$(0) last$ = REMOVE$(TRIM$(LCASE$(robo(uid).naam)), CHR$(0)) 'warning "last robot was:" + last$ IF (LEN(last$) > 0) AND (last$ <> b$) THEN ' warning "add " + last$ + " again" InstrumPlay robo(uid) 'notesoff.. 'add it again to the list robolist$ = last$ + ", " + robolist$ ' warning "result:" + robolist$ END IF ' LapCtrlReply "Robots that are still available: " + robolist$ 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 = 120: lct(i).pitched = 0 CASE "casta2": robo(uid) = casta2: lct(i).basenote = 120: lct(i).pitched = 0 END SELECT CASE "PATTERN" b$ = LCASE$(PARSE$(msg$, " ", 2)) IF ISFALSE LEN(RETAIN$(b$, ANY "*r")) 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 (*) or rest (r)" + CHR$(0) busyflag = 0 EXIT SUB END IF pattern$(i) = RETAIN$(b$, ANY "*r_^v") 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 'TO reset basenote 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 msgbuffer$ = msgbuffer$ + nick$ + ", your transposition factor is now" + STR$(lct(i).transp) + CHR$(0) CASE "SPEED" b$ = LCASE$(TRIM$(PARSE$(msg$, " ", 2))) SELECT CASE b$ CASE "up" tmp = lct(i).tickspernote lct(i).tickspernote = MAX(12, 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 ELSE ' LapCtrlReply nick$ + ", your message was not correct. Please use 'SPEED up' or 'SPEED down'" msgbuffer$ = msgbuffer$ + nick$ + ", your message was not correct. Please use 'SPEED up' or 'SPEED down'" + CHR$(0) END SELECT logfile robo(i).naam + " tpn" + STR$(lct(i).tickspernote) 'TO DO TO DO TO DO 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$ CASE "VOLUME" b$ = LCASE$(TRIM$(PARSE$(msg$, " ", 2))) SELECT CASE b$ CASE "up": lct(i).velo = MIN(100, lct(i).velo + 5) CASE "down": lct(i).velo = MAX(10, lct(i).velo = lct(i).velo - 5) CASE ELSE: lct(i).velo = 48 END SELECT 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 player$() 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 LOCAL i AS LONG LOCAL uid AS LONG LOCAL b$ LOCAL last$ LOCAL tmp AS LONG 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 + 1/3 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 '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_ParseMessages 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 b$ CASE "*" '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 "^" '!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" 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 lct(i).note = MatchSpecNote(lct(i).note, specbase, specfac,0, lct(i).transp) 'match to available set of notes 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 lct(i).note = MatchSpecNote(lct(i).note , specbase, specfac,0, lct(i).transp) 'match to available set of notes 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 "*" '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 "^" '!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) 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 logfile "set note up" + STR$(lct(i).note) CASE "v" '!pitch down logfile "old note" + STR$(lct(i).note) 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 "!" '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" DIALOG NEW 0, "controlroom",,,100, 300 TO wh FOR i = 1 TO PARSECOUNT(masterrobolist$, ",") CONTROL ADD CHECKBOX, wh, 1000 + i, PARSE$(masterrobolist$, ",", i),1, 14 * i, 98, 12, %BS_PUSHLIKE NEXT CONTROL ADD BUTTON, wh, 2000, "** post changes **", 1, 14 * 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 100 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 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 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 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