FUNCTION Rotolisten () AS LONG 'note, velo, aftt, ctrl 101 - 105 '%pplisten + 7 ' kl. 07.2001 LOCAL nv AS INTEGER LOCAL noot? LOCAL velo? LOCAL tremolo? LOCAL pBend?? LOCAL value? ' MSGBOX "ack",,"rotolisten" nv = GetMidiNote% (Rotomoton.channel, %Remove OR %Oldest) 'keep %pplisten const ? '' CONTROL SET TEXT gh.cockpit, %GMT_TEXT0_ID + 12, HEX$(nv) IF nv > %NotFalse THEN velo? = LOBYT (nv) noot? = HIBYT (nv) '' MSGBOX "noot"+STR$(noot?) SELECT CASE noot? CASE 41 TO 45 IF velo? THEN Task(Rotomoton.beattask(noot? - 40)).level = velo? ELSEIF BIT(Task(Rotomoton.beattask(noot? - 40)).switch, %TASK_ONOFF) THEN StopTask Rotomoton.beattask(noot? - 40) END IF CASE 48 TO 50 Task(Rotomoton.beattask(1)).level = velo? '?velo scalen? IF velo THEN CALL DWORD task(Rotomoton.beattask(1)).cptr 'Roto_bas_beat END IF CASE 51 TO 53 Task(Rotomoton.beattask(2)).level = velo? IF velo THEN CALL DWORD task(Rotomoton.beattask(2)).cptr 'Roto_ten_beat END IF CASE 54 TO 55 Task(Rotomoton.beattask(3)).level = velo? IF velo THEN CALL DWORD task(Rotomoton.beattask(3)).cptr ' Roto_alt_beat END IF CASE 56 TO 57 Task(Rotomoton.beattask(4)).level = velo? IF velo THEN CALL DWORD task(Rotomoton.beattask(4)).cptr ' Roto_mez_beat END IF CASE 58 TO 59 Task(Rotomoton.beattask(5)).level = velo? IF velo THEN CALL DWORD task(Rotomoton.beattask(5)).cptr ' Roto_sop_beat END IF CASE 114 IF velo THEN Roto_Light 1, 1 'toggles, disregarding value ELSE Roto_light 1, 0 END IF CASE 115 IF velo THEN Roto_Light 2, 1 ELSE Roto_Light 2, 0 END IF END SELECT END IF nv = GetPressure%(Rotomoton.channel, %REMOVE OR %OLDEST) ' used for tremolo speed. IF nv> %NotFalse THEN tremolo? = LOBYT(nv) noot? = HIBYT(nv) IF tremolo? THEN ' MSGBOX STR$(tremolo?) SELECT CASE noot CASE 41 Task(RotoMoton.Beattask(1) ).freq = .1 + ((tremolo * 25) / 127) ' 20 VOORLOPIG check on rotomo /ScaleRotoSpeed 'rescalen!!!!! IF ISFALSE BIT (Task(Rotomoton.beattask(1)).switch, %TASK_ONOFF) THEN StartTask RotoMoton.Beattask(1) '11 END IF CASE 42 Task(RotoMoton.Beattask(2)).freq = .1 + ((tremolo * 25) / 127) '/ScaleRotoSpeed 'rescalen!!!!! IF ISFALSE BIT (Task(Rotomoton.beattask(2)).switch, %TASK_ONOFF) THEN StartTask RotoMoton.Beattask(2) '12 END IF CASE 43 Task(Rotomoton.beattask(3)).freq = .1 + ((tremolo * 30) / 127) '/ScaleRotoSpeed 'rescalen!!!!! IF ISFALSE BIT (Task(Rotomoton.beattask(3)).switch, %TASK_ONOFF) THEN StartTask RotoMoton.Beattask(3) '13 END IF CASE 44 Task(Rotomoton.beattask(4)).freq = .1 + ((tremolo * 30) / 127) '/ScaleRotoSpeed 'rescalen!!!!! IF ISFALSE BIT (Task(Rotomoton.beattask(4)).switch, %TASK_ONOFF) THEN StartTask RotoMoton.Beattask(4) '14 END IF CASE 45 Task(RotoMoton.Beattask(5)).freq = .1 + ((tremolo * 30) / 127) '/ScaleRotoSpeed 'rescalen!!!!! IF ISFALSE BIT (Task(Rotomoton.beattask(5)).switch, %TASK_ONOFF) THEN StartTask RotoMoton.Beattask(5) '15 END IF END SELECT END IF END IF '____________________________________________________________________________ 'we use controllers 101 - 105 for respective rotom's steppingmotors '____________________________________________________________________________ IF ISFALSE RotoMoton.Command(1) THEN '%ROTO_M1 is not busy nv = GetController(Rotomoton.channel, 101, %REMOVE OR %OLDEST) 'ctrl 101 for motor of bas trom IF nv > %NotFalse THEN pbend?? = LOBYT(nv) pbend?? = INT(pbend?? * Rotomoton.MaxStep(1) / 127) 'rescale Rotomoton.Command(1) = %ROTO_POSITION OR pbend?? IF ISFALSE(BIT(task(Rotomoton.Motortask(1)).switch, %TASK_ONOFF)) THEN StartTask Rotomoton.Motortask(1) END IF END IF IF ISFALSE RotoMoton.Command(2) THEN nv = GetController(Rotomoton.channel, 102, %REMOVE OR %OLDEST) IF nv > %NotFalse THEN pbend?? = LOBYT(nv) pbend?? = INT(pbend?? * Rotomoton.MaxStep(2) / 127) Rotomoton.Command(2) = %ROTO_POSITION OR pbend?? IF ISFALSE(BIT(task(Rotomoton.Motortask(2)).switch, %TASK_ONOFF)) THEN StartTask Rotomoton.Motortask(2) END IF END IF IF ISFALSE RotoMoton.Command(3) THEN nv = GetController(Rotomoton.channel, 103, %REMOVE OR %OLDEST) IF nv > %NotFalse THEN pbend?? = LOBYT(nv) pbend?? = INT(pbend?? * Rotomoton.MaxStep(3) / 127) Rotomoton.Command(3) = %ROTO_POSITION OR pbend?? IF ISFALSE(BIT(task(Rotomoton.Motortask(3)).switch, %TASK_ONOFF)) THEN StartTask Rotomoton.Motortask(3) END IF END IF IF ISFALSE RotoMoton.Command(4) THEN nv = GetController(Rotomoton.channel, 104, %REMOVE OR %OLDEST) IF nv > %NotFalse THEN pbend?? = LOBYT(nv) pbend?? = INT(pbend?? * Rotomoton.MaxStep(4) / 127) Rotomoton.Command(4) = %ROTO_POSITION OR pbend?? IF ISFALSE(BIT(task(Rotomoton.Motortask(4)).switch, %TASK_ONOFF)) THEN StartTask Rotomoton.Motortask(4) END IF END IF IF ISFALSE RotoMoton.Command(5) THEN nv = GetController(Rotomoton.channel, 105, %REMOVE OR %OLDEST) IF nv > %NotFalse THEN pbend?? = LOBYT(nv) pbend?? = INT(pbend?? * Rotomoton.MaxStep(5) / 127) Rotomoton.Command(5) = %ROTO_POSITION OR pbend?? IF ISFALSE(BIT(task(Rotomoton.Motortask(5)).switch, %TASK_ONOFF)) THEN StartTask Rotomoton.Motortask(5) END IF END IF nv = GetProgChange(Rotomoton.channel, %REMOVE OR %OLDEST) IF nv > %notfalse THEN value? = LOBYT(nv) ' MSGBOX "progchange "+STR$(value?) 'ok Rotomoton.messagevalue = %WSB_CHANGE_PIECE OR value RotomoMessageHandler END IF nv = GetController(Rotomoton.channel, %WSB_CTRL_VELO, %REMOVE OR %OLDEST) 'velo IF nv > %NotFalse THEN value? = LOBYT(nv) Rotomoton.messagevalue = %WSB_CHANGE_VELO OR value RotomoMessageHandler 'messagehandler should remember what we're playing... END IF nv = GetController(Rotomoton.channel, %WSB_CTRL_SPEED, %REMOVE OR %OLDEST) 'speed IF nv > %NotFalse THEN value? = LOBYT(nv) Rotomoton.messagevalue = %WSB_CHANGE_SPEED OR value RotomoMessageHandler 'messagehandler should remember what we're playing... END IF nv = GetController(Rotomoton.channel, %WSB_CTRL_DENS, %REMOVE OR %OLDEST) 'density IF nv > %NotFalse THEN value? = LOBYT(nv) Rotomoton.messagevalue = %WSB_CHANGE_DENSITY OR value RotomoMessageHandler 'messagehandler should remember what we're playing... END IF ' END FUNCTION ' removed from rotomo.inc 03.05.2001: ' hardware debugging code: SUB SetTim LOCAL n AS BYTE FOR n = 0 TO 11 '47 Roto_SetTimerMode n ' in dll - sets timers to 16 bit resolution NEXT n StopTask 63 END SUB SUB TestP0 ' for measurement with scope. STATIC n AS BYTE IF ISFALSE Task(60).tog THEN n = %False Task(60).tog = %True END IF 'IF (Task(60).switch AND %TASK_BUSY) = %d1 THEN EXIT SUB g_testP0 n ' if this does'nt work, make them functions! INCR n Task(60).freq = Slider(1).value *5 '* 32 ' range 1-635 Hz ' range 1,32 ->4064 Hz IF Task(60).freq < 1 THEN Task(60).freq = 1 END SUB SUB TestP1 STATIC n AS BYTE IF ISFALSE Task(61).tog THEN n = %False Task(61).tog = %True END IF g_TestP1 n INCR n Task(61).freq = Slider(1).value * 5 ' 1Hz - 635Hz '* 32 IF Task(61).freq < 1 THEN Task(61).freq = 1 END SUB SUB TestReg STATIC n AS BYTE STATIC p AS BYTE IF ISFALSE Task(62).tog THEN p = %False n = %False Task(62).tog = %True END IF ppPortOut p, n INCR n INCR p IF p > 7 THEN p = %False Task(62).freq = Slider(1).value * 32 IF task(62).freq < 1 THEN Task(62).freq = 1 END SUB ' motor calibration tasks: Task(16).naam = "CaliBas" Task(16).cptr = CODEPTR(Roto_Calibas) Task(17).naam = "CaliTen" Task(17).cptr = CODEPTR(Roto_Caliten) Task(18).naam = "CaliAlt" Task(18).cptr = CODEPTR(Roto_Calialt) Task(19).naam = "CaliMez" Task(19).cptr = CODEPTR(Roto_Calimez) Task(20).naam = "CaliSop" Task(20).cptr = CODEPTR(Roto_Calisop) ' now buttons. SUB Roto_CaliBas () ' new code: (should become button code) IF ISFALSE Rotomoton.command(1) THEN Rotomoton.command(1) = %Roto_Calibrate StartTask %Roto_M1 stoptask 16 ELSE Rotomoton.command(1) = %Roto_Cancel END IF EXIT SUB ' task 16 STATIC count AS LONG STATIC nr AS LONG LOCAL retval AS INTEGER LOCAL sensor AS BYTE IF ISFALSE task(16).tog THEN count = %False nr = %False Task(16).tog = %True IF ISFALSE task(10).switch THEN starttask 10 Rotomoton.maxstep(1) = 0.8 * 200 * Rotomoton.gearratio(1) ' 1 revolution. END IF Task(16).freq = Rotomoton.freq(1) IF count >= %False THEN ' omhoogdraaien tot voorbij de maximum grens... retval = Roto_Rot (1,+1) INCR count IF count >= Rotomoton.maxstep(1) THEN count = -1 ' limit reached. EXIT SUB ELSE nr = %False ' go on turning higher EXIT SUB END IF ELSE ' terugdraaien en stapjes tellen... retval = Roto_Rot (1,-1) INCR nr sensor = Portin(%Padr+1) IF ISFALSE BIT (sensor,3) THEN IF nr > 24 THEN Rotomoton.maxstep(1) = (nr - (nr/4)) AND &HFFFC ELSE Rotomoton.maxstep(1) = 24 END IF Rotomoton.count(1) = %False count = %False nr = %False stoptask 16 ELSE EXIT SUB END IF END IF END SUB SUB Roto_CaliTen () ' task 17 STATIC count AS LONG STATIC nr AS LONG LOCAL retval AS INTEGER LOCAL sensor AS BYTE IF ISFALSE task(17).tog THEN count = %False nr = %False Task(17).tog = %True IF ISFALSE Task(10).switch THEN starttask 10 Rotomoton.maxstep(2) = 0.8 * 200 * Rotomoton.gearratio(2) END IF Task(17).freq = Rotomoton.freq(2) IF count >= %False THEN ' omhoogdraaien tot voorbij de maximum grens... retval = Roto_Rot (2,+1) INCR count IF count >= Rotomoton.maxstep(2) THEN count = -1 EXIT SUB ELSE nr = %False EXIT SUB END IF ELSE ' terugdraaien en stapjes tellen... retval = Roto_Rot (2,-1) INCR nr sensor = Portin(%Padr+1) IF ISFALSE BIT (sensor,4) THEN IF nr >= 20 THEN Rotomoton.maxstep(2) = (nr - (nr/4)) AND &HFFFC ELSE Rotomoton.maxstep(2) = 20 END IF Rotomoton.count(2) = %False count = %False nr = %False StopTask 17 ELSE EXIT SUB END IF END IF END SUB SUB Roto_CaliAlt () ' task 18 STATIC count AS LONG STATIC nr AS LONG LOCAL retval AS INTEGER LOCAL sensor AS BYTE IF ISFALSE task(18).tog THEN count = %False nr = %False Task(18).tog = %True IF ISFALSE task(10).switch THEN starttask 10 Rotomoton.maxstep(3) = 1.2 * 200 * Rotomoton.gearratio(3) END IF Task(18).freq = Rotomoton.freq(3) IF count >= %False THEN ' omhoogdraaien tot voorbij de maximum grens... retval = Roto_Rot (3,+1) INCR count IF count >= Rotomoton.maxstep(3) THEN count = -1 EXIT SUB ELSE nr = %False EXIT SUB END IF ELSE ' terugdraaien en stapjes tellen... retval = Roto_Rot (3,-1) INCR nr sensor = Portin(%Padr+1) IF ISFALSE BIT (sensor,5) THEN IF nr > 28 THEN Rotomoton.maxstep(3) = (nr - (nr/5)) AND &HFFFC ELSE Rotomoton.maxstep(3) = 28 END IF Rotomoton.count(3) = %False count = %False nr = %False StopTask 18 ELSE EXIT SUB END IF END IF END SUB SUB Roto_CaliMez () ' task 19 STATIC count AS LONG STATIC nr AS LONG LOCAL retval AS INTEGER LOCAL sensor AS BYTE IF ISFALSE task(19).tog THEN count = %False nr = %False Task(19).tog = %True IF ISFALSE task(10).switch THEN starttask 10 Rotomoton.maxstep(4) = 1.5 * 200 * Rotomoton.gearratio(4) END IF Task(19).freq = Rotomoton.freq(4) IF count >= %False THEN ' omhoogdraaien tot voorbij de maximum grens... retval = Roto_Rot (4,+1) INCR count IF count >= Rotomoton.maxstep(4) THEN count = -1 EXIT SUB ELSE nr = %False EXIT SUB END IF ELSE ' terugdraaien en stapjes tellen... retval = Roto_Rot (4,-1) INCR nr sensor = Portin(%Padr+1) IF ISFALSE BIT (sensor,6) THEN IF nr > 32 THEN Rotomoton.maxstep(4) = (nr - (nr/5)) AND &HFFFC ' make sure it's devided through 4 ELSE Rotomoton.maxstep(4) = 32 END IF Rotomoton.count(4) = %False count = %False nr = %False StopTask 19 ELSE EXIT SUB END IF END IF END SUB SUB Roto_CaliSop () ' task 20 STATIC count AS LONG STATIC nr AS LONG LOCAL retval AS INTEGER LOCAL sensor AS BYTE IF ISFALSE task(20).tog THEN count = %False nr = %False Task(20).tog = %True IF ISFALSE Task(10).switch THEN starttask 10 Rotomoton.maxstep(5) = 2 * 200 * Rotomoton.gearratio(5) END IF Task(20).freq= Rotomoton.freq(5) IF count >= %False THEN ' omhoogdraaien tot voorbij de maximum grens... retval = Roto_Rot (5,+1) INCR count IF count >= Rotomoton.maxstep(5) THEN count = -1 EXIT SUB ELSE nr = %False EXIT SUB END IF ELSE ' terugdraaien en stapjes tellen... retval = Roto_Rot (5,-1) INCR nr sensor = Portin(%Padr+1) IF BIT (sensor,7) THEN IF nr > 36 THEN Rotomoton.maxstep(5) = (nr - (nr/6)) AND &HFFFC ELSE Rotomoton.maxstep(5) = 32 END IF Rotomoton.count(5) = %False count = %False nr = %False StopTask 20 ELSE EXIT SUB END IF END IF END SUB DECLARE SUB roto_reset_bas () ' task 27 - motors DECLARE SUB roto_reset_tenor () ' 28 DECLARE SUB roto_reset_alt () ' 29 DECLARE SUB roto_reset_mezzo () ' 30 DECLARE SUB roto_reset_sopraan () ' 31 SUB Roto_Reset_Bas () ' task 27 STATIC stat AS BYTE LOCAL sensors AS BYTE IF ISFALSE Task(27).tog THEN IF ISFALSE Task(10).switch THEN starttask 10 Task(27).tog = %True END IF sensors = Portin(%Padr+1) Task(27).freq = Rotomoton.freq(1) IF BIT(sensors,3) THEN Roto_Rot 1,-1 stat = %False EXIT SUB ELSE IF stat THEN Roto_Rot 1,1 ' draai omhoog tot voorbij microswitch hysteresisch stat= %True EXIT SUB ELSE ' now the sensor ought to be just at zero stoptask 27 stat = %True rotomoton.count(1) = %False END IF END IF END SUB SUB Roto_Reset_Tenor ' task 28 STATIC stat AS BYTE LOCAL sensors AS BYTE IF ISFALSE Task(28).tog THEN IF ISFALSE Task(10).switch THEN starttask 10 Task(28).tog = %True END IF sensors = Portin(%Padr+1) Task(28).freq = Rotomoton.freq(2) IF BIT(sensors,4) THEN Roto_Rot 2,-1 stat = %False EXIT SUB ELSE IF stat THEN Roto_Rot 2,1 ' draai omhoog tot voorbij microswitch hysteresisch stat= %True EXIT SUB ELSE ' now the sensor ought to be just at zero stoptask 28 stat = %True rotomoton.count(2) = %False END IF END IF END SUB SUB Roto_Reset_Alt ' task 29 STATIC stat AS BYTE LOCAL sensors AS BYTE IF ISFALSE Task(29).tog THEN IF ISFALSE Task(10).switch THEN starttask 10 Task(29).tog = %True END IF sensors = Portin(%Padr+1) Task(29).freq = Rotomoton.freq(3) IF BIT(sensors,5) THEN Roto_Rot 3,-1 stat = %False EXIT SUB ELSE IF stat THEN Roto_Rot 3,1 ' draai omhoog tot voorbij microswitch hysteresisch stat= %True EXIT SUB ELSE ' now the sensor ought to be just at zero stoptask 29 stat = %True rotomoton.count(3) = %False END IF END IF END SUB SUB Roto_Reset_Mezzo ' task 30 STATIC stat AS BYTE LOCAL sensors AS BYTE IF ISFALSE Task(30).tog THEN IF ISFALSE Task(10).switch THEN starttask 10 Task(30).tog = %True END IF sensors = Portin(%Padr+1) Task(30).freq = Rotomoton.freq(4) IF BIT(sensors,6) THEN Roto_Rot 4,-1 stat = %False EXIT SUB ELSE IF stat THEN Roto_Rot 4,1 ' draai omhoog tot voorbij microswitch hysteresisch stat= %True EXIT SUB ELSE ' now the sensor ought to be just at zero stat = %True rotomoton.count(4) = %False stoptask 30 END IF END IF END SUB SUB Roto_Reset_Sopraan ' task 31 STATIC stat AS BYTE LOCAL sensors AS BYTE IF ISFALSE Task(31).tog THEN IF ISFALSE Task(10).switch THEN starttask 10 Task(31).tog = %True END IF sensors = Portin(%Padr+1) Task(31).freq = Rotomoton.freq(5) IF ISFALSE BIT(sensors,7) THEN ' bit inverted ! Roto_Rot 5,-1 stat = %False EXIT SUB ELSE IF stat THEN Roto_Rot 5,1 ' draai omhoog tot voorbij microswitch hysteresisch stat= %True EXIT SUB ELSE ' now the sensor ought to be just at zero stat = %True rotomoton.count(5) = %False stoptask 31 END IF END IF END SUB ' motor reset tasks: Task(27).naam = "ResetBas" Task(27).cptr = CODEPTR(Roto_Reset_Bas) Task(27).freq = 100 Task(28).naam = "ResetTen" Task(28).cptr = CODEPTR(Roto_Reset_Tenor) Task(28).freq = 100 Task(29).naam = "ResetAlt" Task(29).cptr = CODEPTR(Roto_Reset_Alt) Task(29).freq = 100 Task(30).naam = "ResetMez" Task(30).cptr = CODEPTR(Roto_Reset_Mezzo) Task(30).freq = 100 Task(31).naam = "ResetSop" Task(31).cptr = CODEPTR(Roto_Reset_Sopraan) Task(31).freq = 100 ' removed from roto_rot 01.05.2001: ' we check for a stop condition. ' This can only be done by reading a switch through an input port. ' On a printer port we have exactly 5 bits available to read... ' These are on port %Padr+1 ' Sensors = PortIn (%Padr + 1) ' BIT TOGGLE sensors,7 ' this bit is inverted! ' IF dir < 0 THEN ' now we have to check the corresponding bits... ' the bit number to check is drum + 2 (drum counts 1,2,3,4,5, so bits are 3,4,5,6,7) ' IF BIT (Sensors,drum + 2)= %False THEN ' IF BIT (Oldsensors, drum + 2) THEN ' 'in this case the switch just toggled its value... (1 to 0 transit) ' Rotomoton.fault(drum) = Rotomoton.maxstep(drum) - Rotomoton.count(drum) ' IF Rotomoton.fault(drum) <> 0 THEN ' Rotomoton.maxstep(drum) = Rotomoton.maxstep(drum) - Rotomoton.fault(drum) ' ' if we allow fault to go negative we can also increase the range... ' END IF ' Rotomoton.count(drum) = %False ' reset count value ' BIT RESET Oldsensors, drum + 2 ' FUNCTION = - dir ' return inverse direction. ' END IF ' END IF ' ELSE ' IF BIT (Sensors,drum + 2) THEN ' IF ISFALSE BIT(Oldsensors,drum+2) THEN ' BIT SET Oldsensors,drum + 2 ' Rotomoton.hysteresis(drum)= Rotomoton.count(drum) ' END IF ' END IF ' IF Rotomoton.count(drum) >= Rotomoton.maxstep(drum) THEN FUNCTION = -dir END IF ' removed 29.04.2001: FUNCTION Roto_Rot_old (BYVAL drum AS BYTE, BYVAL dir AS INTEGER, BYVAL velo AS DWORD) EXPORT AS INTEGER ' first sketch for a procedure advancing or returning a stepping motor a single step. ' dir is controlled by the sign of the number passed . (-1, +1 is ok). ' The stepping motor boards do not need sofware timer events, since pulsewidth is controlled by the onboard DAC ' Note that this procedure is not suitable as a general purpose stepper controller procedure! ' This code is optimised for situations where no holding torque is required from the motor, but only ' impulse control and speed. ' drum: 1,2,3,4, or 5. STATIC St() AS BYTE STATIC pat() AS BYTE STATIC oldvelo () AS DWORD STATIC tog AS BYTE STATIC stepcount() AS LONG STATIC maxcount () AS LONG ' number of steps for maximum ambitus LOCAL dacval AS BYTE LOCAL retval AS LONG LOCAL sensors AS BYTE IF ISFALSE tog THEN DIM St(1 TO 5) AS STATIC BYTE ' remember the pattern performed for each of the five motors. ' the index corresponds to the number of the motor. ' the value stored is the number of the bitpattern. DIM pat(0 TO 7) AS STATIC BYTE ' for lookup table DIM oldvelo(1 TO 5) AS STATIC DWORD DIM stepcount(1 TO 5) AS STATIC LONG DIM maxcount(1 TO 5) AS STATIC LONG maxcount(1) = 900 maxcount(2) = 1200 maxcount(3) = 1200 maxcount(4) = 1200 maxcount(5) = 1500 ' eigth-step mode: pat(0) = &B0001 '10 ' 1010 pat(1) = &H0011 '8 ' 1000 pat(2) = &B0010 '9 ' 1001 pat(3) = &B0110 '1 ' 0001 pat(4) = &B0100 '5 ' 0101 pat(5) = &B1100 '4 ' 0100 pat(6) = &B1000 '6 ' 0110 pat(7) = &B1001 '2 ' 0010 ' four-step mode: pat(0) = &B0001 pat(1) = &B0010 pat(2) = &B0100 pat(3) = &B1000 pat(4) = &B0001 pat(5) = &B0010 pat(6) = &B0100 pat(7) = &B1000 tog = %True ' THEORY: ' range for the velo control is 3 Volt (not below 1V, not above 4V) ' we moeten een waarde uitsturen die begrepen is tussen 52 en 208 (0-255 beslaat immers 0-5V op de DAC) ' wanneer velo als 8 bit getal wordt uitgestuurd, dan komt elke stap overeen met een increment van ' (208-52) / 256 = 156/256 = 0.609 ' PRACTICAL RESULTS & MEASUREMENTS d.d.29.03.2001: ' byte sent voltage on pin 6 opamp pulse width ' 0 29mV 2.8ms ' 80 10ms ' 126 20ms ' 255 2.989V 26ms ' Components changed 15.04.2001: now 240k / 97nF oldvelo(1) = %False oldvelo(2) = %False oldvelo(3) = %False oldvelo(4) = %False oldvelo(5) = %False END IF ' %Padr + 1 is the input port. We use the bits in following mapping to sense end position of motors: ' d3 = motor 1 ' d4 = motor 2 ' d5 = motor 3 ' d6 = motor 4 ' d7 = motor 5 IF velo <> oldvelo(drum) THEN IF velo > 255 THEN velo = 255 dacval = velo ' in teorie moet het zijn: ' dacval = 52 + (velo * 0.609!) ' write this value to the databus (notebus, port 0) PortOut %Preg,%ppP0 PortOut %Padr, dacval retval = g_Strobe (%Preg,%ppP0,0) ' select the correct register (we map the DAC's to the A0,A1,A2 registers) ' note motor 1 and 2 share the same DAC, motor 3 and 4 also, motor 5 has an individual DAC PortOut %Preg,%ppP4 '=%SelNotePort SELECT CASE drum CASE 1,2 PortOut %Padr, 0 ' 0000 for A0 CASE 3,4 PortOut %Padr, 1 ' A1 CASE 5 PortOut %Padr, 2 ' A2 END SELECT retval = g_Strobe (%Preg,%ppP4,0) ' now strobe the data to the DAC latch: PortOut %Preg,%ppP6 '=%NoteOut ' sends a strobe via the low nibble, high nibble is free ' strobe adresses the note-bit latches on note boards retval = g_Strobe (%Preg,%ppP6,0) oldvelo(drum) = velo END IF ' first version: ' motor 1 is mapped on notes 8,9,10,11 (lowest nibble of a single latch) - A1 ' motor 2 on notes 16,17,18,19 - A2 ' motor 3 on notes 24,25,26,27 - A3 ' motor 4 on notes 32,33,34,35 - A4 ' motor 5 on notes 40,41,42,43 - A5 ' mapping changed 15.04.2001 to: ' DAC 1 on notes 0,1,2,3,4,5,6,7 - A0 ' DAC 2 on notes 8,9,10,11,12,13,14,15 - A1 ' DAC 3 on notes 16,17,18,19,20,21,22,23 - A2 ' note holds on notes 48,49,50,51,52,53,54,55,56,57,58,59 - A6 / A7 ' motor 1 on notes 72,73,74,75 - A9 BAS ' motor 2 on notes 80,81,82,83 - A10 TENOR ' motor 3 on notes 88,89,90,91 - A11 ALT ' motor 4 on notes 96,97,98,99 - A12 MEZZO ' motor 5 on notes 104,105,106,107 - A13 SOPRANO ' lights on notes 113,114,114 - A14 SELECT CASE SGN(dir) CASE > 0 IF St(drum) = 7 THEN St(drum)=0 ELSE INCR St(drum) CASE < 0 IF St(drum) = 0 THEN St(drum) = 7 ELSE DECR St(drum) CASE ELSE FUNCTION = %False EXIT FUNCTION END SELECT ' het uit te sturen motor nibble is nu steeds Pat(St(drum)) ' write this value to the databus (notebus) ' old:, port number corresponds to motor number = drum) PortOut %Preg,%ppP0 '%NoteReg PortOut %Padr, Pat(St(drum)) retval = g_Strobe (%Preg,%ppP0,0) ' select the correct register PortOut %Preg,%ppP4 '%SelNotePort PortOut %Padr, drum + 8 ' A9,A10,A11,A12,A13 select the motors retval = g_Strobe (%Preg,%ppP4,0) ' now strobe the data to the motor latch: PortOut %Preg,%ppP6 '=%NoteOut ' sends a strobe via the low nibble, high nibble is free ' strobe adresses the note-bit latches on note boards retval = g_Strobe (%Preg,%ppP6,0) ' since the 555 should only receive a strobe on its trigger input, we should immediately reset the data latch: PortOut %Preg,%ppP0 '%NoteReg PortOut %Padr, %False ' these latches are inverting! so contents will now go high retval = g_Strobe (%Preg,%ppP0,0) PortOut %Preg,%ppP4 '%SelNotePort PortOut %Padr, drum + 8 retval = g_Strobe (%Preg,%ppP4,0) PortOut %Preg,%ppP6 '%NoteOut retval = g_Strobe (%Preg,%ppP6,0) '------------------------------------------------- ' now we check for a stop condition. ' This can only be done by reading a switch through an input port. ' On a printer port we have exactly 5 bits available to read... ' These are on port %Padr+1 Sensors = PortIn (%Padr + 1) ' now we have to check the corresponding bits... ' the bit number to check is drum + 2 (drum counts 1,2,3,4,5, so bits are 3,4,5,6,7) IF BIT (Sensors,drum + 2) THEN FUNCTION = -Dir ELSE FUNCTION = Dir ' ... to be done... ' The function will return the opposite sign, if an end condition is encountered. ' This way it is easy to initialize the drums to their lowest position. END FUNCTION '-------------------- SUB BasB0 Task(48).level = Slider(0).value Task(48).freq = Slider(1).value / 10 Roto_Beat 48, Task(48).level ' note 48 = note 0 END SUB SUB Roto_Beat (BYVAL note AS DWORD,BYVAL velo AS DWORD) EXPORT LOCAL retval AS LONG STATIC tog AS DWORD LOCAL wvelo AS WORD ' 16 bit value - in microseconds LOCAL cw AS BYTE IF ISFALSE tog THEN ' make sure the note-hold latches are OFF on init. FOR retval = 48 TO 59 '0-47 are motor-notes, 48-59 are note hold on the timer board. ppHold retval,0 Wait 2 NEXT retval tog = %True END IF IF ISFALSE velo THEN EXIT SUB wvelo = (LOBYT(velo) * 512) ' linear mapping, for test only - range 0.2ms to 65ms ' now we should program the correct timer: ' het nummer van de 8254 timer-chip is steeds note \ 3 (integer divide!) ' de timer binnen elke 8254 chip is steeds note MOD 3 ' schrijf 11 naar de timer bus (A0,A1): (8254 adres-lines) ' Writing the control word: Roto_SetTimerMode LOBYT(note) EnterCriticalSection CritsecRoto ' PortOut %Preg,%ppP1 ' P1 - velodatabus ' PortOut %Padr, 3 '=&B11 ' A0=1, A1=1 implies command writing to 82C54 ' Strobe %Preg,%ppP1,0,%StrobeLength ' wait 1 ' cw = note MOD 3 ' 00, 01 or 10 for timer 0,1,2 ' SHIFT LEFT cw,6 ' SC1, SC0 als D7 en D6 ' BIT SET cw,5 ' D5 , D4 ' RL1, RL0 : 00 = latch count ' ' 01 = read/write msb only ' ' 10 = read/write lsb only ' ' 11 - read/write lsb first, msb last ' BIT SET cw,4 ' 16 bit loading - lsb first! ' ' M0, M1, M2 = 0 for mode 0 counting D3,D2,D1 ' ' BCD= 0 for 16 bit binary counting, in microsecond units (determined by hardware) D0 ' cw = cw AND &HF0 ' 'check all following code with extreme care!!! ' ' nu zetten we het programmabyte cw op de databus (%Notereg): ' PortOut %Preg,%ppP0 ' P0 ' PortOut %Padr, cw ' Strobe %Preg,%ppP0,0,%Strobelength ' wait 1 ' ' ' ' ' now we have the date in the latches Notes and Velo (P0,P1) ' ' now we have to send this to the 82C54... , so we need to generate a strobe on the 74154 output for ' ' the correct timer chip. The number of this chip is note \ 3 (0-15) ' PortOut %Preg,%ppP5 ' PortOut %Padr, (note \ 3) AND &H0F ' Strobe %Preg,%ppP5,0,%Strobelength ' try it... - this was a bug in g_note I guess... ' wait 1 ' ' now we send this to the correct timer: ' ' send selection data for strobe generators to the velo latch: ' ' !!! this means with pp2000 demultiplexerboards, that we should place the notes ' ' !!! in the range 0-47 !!! [IMPORTANT FOR ROTOMOTON] ' ' !!! 48-95 repeats the same adresses. ' ' now we generate a strobe such that the 74154 selects the correct timer and latches the data ' PortOut %Preg, %ppP7 ' this send a strobe pulse on the A0-A15 pins of the velo bus. ' Strobe %Preg,%ppP7,0,%StrobeLength ' wait 1 ' now we should send 2 bytes of timer data (the velo information in 16 bits): ' set the LSB of the velo data on the note-databus: PortOut %Preg,%ppP0 PortOut %Padr, %False 'LOBYT (wvelo) Strobe %Preg,%ppP0,0,%StrobeLength wait 2 ' set A0,A1 to the correct timer: Portout %Preg,%ppP1 ' we use this port to select the timer adresses via A0,A1 = D0,D1 PortOut %Padr, note MOD 3 ' 0 = timer 0, 1=timer 2, 2= timer 3, 3= controll Strobe %Preg,%ppP1,0,%StrobeLength wait 2 ' we do have to program the latch in front of the 74154: PortOut %Preg,%ppP5 PortOut %Padr, note \ 3 ' select the right chip Strobe %Preg,%ppP5,0,%Strobelength wait 2 ' generate a strobe to latch this byte into the timer: PortOut %Preg, %ppP7 Strobe %Preg,%ppP7,0,%Strobelength wait 2 ' now once again for the MSB of the velo data: PortOut %Preg,%ppP0 PortOut %Padr, velo * 2 'HIBYT (wvelo) Strobe %Preg,%ppP0,0,%StrobeLength wait 2 ' now we can skip setting A0,A1 on the velodatabus, since the latch contents should still be o.k. PortOut %Preg,%ppP7 Strobe %Preg,%ppP7,0,%StrobeLength ' now both lsb and msb have been sent to the timer. It should now be counting... LeaveCriticalSection CritsecRoto END SUB SUB Roto_SetTimerMode (BYVAL counter AS BYTE) EXPORT LOCAL chip AS BYTE LOCAL cw AS BYTE chip = counter \ 3 ' this procedure sets the mode for the 8254 timers once. SELECT CASE counter MOD 3 CASE 0 ' TIMER 0: EnterCriticalSection CritsecRoto PortOut %Preg,%ppP1 ' P1 - velodatabus PortOut %Padr, 3 '=&B11 ' A0=1, A1=1 implies command writing to 82C54 Strobe %Preg,%ppP1,0,%StrobeLength wait 2 cw = &B00110000 ' timer 0 ' RL1, RL0 : 00 = latch count ' 01 = read/write msb only ' 10 = read/write lsb only ' 11 - read/write lsb first, msb last ' M0, M1, M2 = 0 for mode 0 counting D3,D2,D1 ' BCD= 0 for 16 bit binary counting, in microsecond units (determined by hardware) D0 ' nu zetten we het programmabyte cw op de databus (%Notereg): PortOut %Preg,%ppP0 ' P0 PortOut %Padr, cw Strobe %Preg,%ppP0,0,%Strobelength wait 2 ' now we have the control word data in the latches Notes and Velo (P0,P1) ' now we have to send this to the 82C54... , so we need to prepare a strobe on the 74154 output for ' the correct timer chip. ' thus we send the chip number to the latch adressing the 74154 PortOut %Preg,%ppP5 PortOut %Padr, chip ' only low nibble used Strobe %Preg,%ppP5,0,%Strobelength wait 2 ' now we send this to the correct timer: ' send selection data for strobe generators to the velo latch: ' we generate a strobe such that the 74154 selects the correct timer and latches the data PortOut %Preg, %ppP7 ' this sends a strobe pulse on the A0-A15 pins of the velo bus. Strobe %Preg,%ppP7,0,%StrobeLength LeaveCriticalSection CritsecRoto wait 3 CASE 1 ' TIMER 1: EnterCriticalSection CritsecRoto PortOut %Preg,%ppP1 ' P1 - velodatabus PortOut %Padr, 3 '=&B11 ' A0=1, A1=1 implies command writing to 82C54 Strobe %Preg,%ppP1,0,%StrobeLength wait 2 cw = &B01110000 ' timer 1 PortOut %Preg,%ppP0 ' P0 PortOut %Padr, cw Strobe %Preg,%ppP0,0,%Strobelength wait 2 PortOut %Preg,%ppP5 PortOut %Padr, chip Strobe %Preg,%ppP5,0,%Strobelength wait 2 PortOut %Preg, %ppP7 ' this send a strobe pulse on the A0-A15 pins of the velo bus. Strobe %Preg,%ppP7,0,%StrobeLength LeaveCriticalSection CritsecRoto wait 3 CASE 2 ' TIMER 2: EnterCriticalSection CritsecRoto PortOut %Preg,%ppP1 ' P1 - velodatabus PortOut %Padr, 3 '=&B11 ' A0=1, A1=1 implies command writing to 82C54 Strobe %Preg,%ppP1,0,%StrobeLength wait 2 cw = &B10110000 ' timer 2 PortOut %Preg,%ppP0 ' P0 PortOut %Padr, cw Strobe %Preg,%ppP0,0,%Strobelength wait 2 PortOut %Preg,%ppP5 PortOut %Padr, chip Strobe %Preg,%ppP5,0,%Strobelength wait 2 PortOut %Preg, %ppP7 ' this send a strobe pulse on the A0-A15 pins of the velo bus. Strobe %Preg,%ppP7,0,%StrobeLength LeaveCriticalSection CritsecRoto wait 3 END SELECT END SUB FUNCTION Roto_Rot (BYVAL drum AS BYTE, BYVAL dir AS INTEGER, BYVAL velo AS DWORD) EXPORT AS INTEGER ' first sketch for a procedure advancing or returning a stepping motor a single step. ' dir is controlled by the sign of the number passed . (-1, +1 is ok). ' The stepping motor boards do not need sofware timer events, since pulsewidth is controlled by the onboard DAC DIM St(0 TO 4) AS STATIC BYTE ' remember the pattern performed for each of the five motors. ' the index corresponds to the number of the motor. ' the value stored is the number of the bitpattern. DIM pat(0 TO 7) AS STATIC BYTE ' for lookup table STATIC tog AS BYTE STATIC oldvelo AS DWORD LOCAL dacval AS BYTE LOCAL sensors AS BYTE IF ISFALSE tog THEN pat(0) = 10 ' 1010 pat(1) = 8 ' 1000 pat(2) = 9 ' 1001 pat(3) = 1 ' 0001 pat(4) = 5 ' 0101 pat(5) = 4 ' 0100 pat(6) = 6 ' 0110 pat(7) = 2 ' 0010 tog = %True ' range for the velo controll is 3 Volt (not below 1V, not above 4V) ' we moeten een waarde uitsturen die begrepen is tussen 52 en 208 (0-255 beslaat immers 0-5V op de DAC) ' wanneer velo als 8 bit getal wordt uitgestuurd, dan komt elke stap overeen met een increment van ' (208-52) / 256 = 156/256 = 0.609 oldvelo = %False END IF ' %Padr + 1 is the input port. We use the bits in following mapping to sense end position of motors: ' d3 = motor 1 ' d4 = motor 2 ' d5 = motor 3 ' d6 = motor 4 ' d7 = motor 5 IF velo <> oldvelo THEN IF velo > 255 THEN velo = 255 dacval = 208 - (velo * 0.609!) ' hoe hoger de spanning hoe korter de pulsen! ' zoniet (nagaan in hardware) moet het zijn: ' dacval = 52 + (velo * 0.609!) ' write this value to the databus (notebus, port 0) PortOut %Preg,%NoteReg PortOut %Padr, dacval Strobe %Preg,%NoteReg,0,%StrobeLength ' select the correct register (we map the DAC to the A0 register) PortOut %Preg,%SelNotePort PortOut %Padr, 0 ' 0000 for A0 Strobe %Preg,%SelNotePort,0,%StrobeLength ' now strobe the data to the DAC latch: PortOut %Preg,%NoteOut ' sends a strobe via the low nibble, high nibble is free ' strobe adresses the note-bit latches on note boards Strobe %Preg,%NoteOut,0,%StrobeLength oldvelo = velo END IF ' motor 1 is mapped on notes 8,9,10,11 (lowest nibble of a single latch) - A1 ' motor 2 on notes 16,17,18,19 - A2 ' motor 3 on notes 24,25,26,27 - A3 ' motor 4 on notes 32,33,34,35 - A4 ' motor 5 on notes 40,41,42,43 SELECT CASE SGN(dir) CASE > 0 IF St(drum) = 7 THEN St(drum)=0 ELSE INCR St(drum) CASE < 0 IF St(drum) = 0 THEN St(drum) = 7 ELSE DECR St(drum) CASE ELSE FUNCTION = %False EXIT FUNCTION END SELECT ' het uit te sturen motor nibble is nu steeds Pat(St(drum)) ' write this value to the databus (notebus, port number corresponds to motor number = drum) PortOut %Preg,%NoteReg PortOut %Padr, Pat(St(drum)) Strobe %Preg,%NoteReg,0,%StrobeLength ' select the correct register PortOut %Preg,%SelNotePort PortOut %Padr, drum Strobe %Preg,%SelNotePort,0,%StrobeLength ' now strobe the data to the motor latch: PortOut %Preg,%NoteOut ' sends a strobe via the low nibble, high nibble is free ' strobe adresses the note-bit latches on note boards Strobe %Preg,%NoteOut,0,%StrobeLength ' since the 555 should only receive a strobe on its trigger input, we should immediately reset the data latch: PortOut %Preg,%NoteReg PortOut %Padr, %False ' these latches are inverting! so contents will now go high Strobe %Preg,%NoteReg,0,%StrobeLength PortOut %Preg,%SelNotePort PortOut %Padr, drum Strobe %Preg,%SelNotePort,0,%StrobeLength PortOut %Preg,%NoteOut Strobe %Preg,%NoteOut,0,%StrobeLength '------------------------------------------------- ' now we check for a stop condition. ' This can only be done by reading a switch through an input port. ' On a printer port we have exactly 5 bits available to read... ' These are on port %Padr+1 Sensors = PortIn (%Padr + 1) ' now we have to check the corresponding bits... ' the bit number to check is drum + 2 (drum counts 1,2,3,4,5, so bits are 3,4,5,6,7) IF BIT (Sensors,drum + 2) THEN FUNCTION = -Dir ELSE FUNCTION = Dir ' ... to be done... ' The function will return the opposite sign, if an end condition is encountered. ' This way it is easy to initialize the drums to their lowest position. END FUNCTION SUB ppPortOut (BYVAL portnumber AS BYTE, BYVAL param AS BYTE) EXPORT ' added 18.07.2000 ' this procedure is used for hardware debugging . It can also be used as a general purpose ' procedure for people using our demultiplexer boards for other purposes than originally ' intended. ' Portnumber ranges from 0 to 5, since we have only 6 data latches on the board ' portnumbers 6 and 7 select the 74154 strobe generators, by the low nibble of the data. IF portnumber > 7 THEN MSGBOX "Illegal portnumber passed to ppPortOut",,"GMT: [ppPortOut]" ' PortOut %Padr, param SELECT CASE portnumber CASE 0 PortOut %Preg,%NoteReg ' = %ppP0 PortOut %Padr, param Strobe %Preg,%NoteReg,0,%StrobeLength CASE 1 Portout %Preg,%VeloReg ' = %ppP1 PortOut %Padr, param Strobe %Preg,%VeloReg,0,%StrobeLength CASE 2 PortOut %Preg, %Ext1Reg ' = %ppP2 PortOut %Padr, param Strobe %Preg,%Ext1Reg,0,%StrobeLength CASE 3 PortOut %Preg, %Ext2Reg ' = %ppP3 PortOut %Padr, param Strobe %Preg,%Ext2Reg,0,%StrobeLength CASE 4 PortOut %Preg,%SelNotePort ' = %ppP4 PortOut %Padr, param Strobe %Preg,%SelNotePort,0,%StrobeLength CASE 5 PortOut %Preg,%SelVeloPort ' = %ppP5 PortOut %Padr, param Strobe %Preg,%SelVeloPort,0,%StrobeLength CASE 6 ' = %ppP6 PortOut %Preg,%NoteOut ' sends a strobe via the low nibble, high nibble is free ' strobe adresses the note-bit latches on note boards Strobe %Preg,%NoteOut,0,%StrobeLength CASE 7 ' = %ppP7 PortOut %Preg, %VeloOut ' send a strobe pulse ' strobe adresses the velo-bit latches on velo boards Strobe %Preg,%VeloOut,0,%StrobeLength END SELECT END SUB ' removed from dll: SUB Roto_Beat_2000 (BYVAL note AS DWORD,BYVAL velo AS DWORD) EXPORT LOCAL retval AS LONG STATIC tog AS DWORD ' velo values 1 - 127 remapped in this procedure ' this procedure only valid if we use the same hardware as in Troms and Klung. ' In case we decide on using the timer boards, the note mapping will be different and ' the software implementation as well, since these boards have programmable timers.[03.2001] IF note < 96 THEN EXIT SUB IF note > 119 THEN EXIT SUB IF velo > 127 THEN velo = 127 IF ISFALSE velo THEN EXIT SUB ' ppVelo BYVAL number, %False ' the problem if we do this is that the timer ' may not have expired, and we risk another request ' for a timer before is actually runs out... ' was: EXIT SUB ' pulse = INT(5 + velo * 15/127) ' velo scaling ? ' velo = ((velo * 15)/ 127) + 5 ' SHIFT RIGHT velo, 2 ' 1-127 becomes 0 - 31 ' velo = velo + 5 ' 5 to 36 ' ppBeat number, velo 'pulse 'velo ' velo must be smaller the the repeating frequency !!! ' inline ppBeat code: retval = TimeSetEvent(velo,0,CODEPTR(ppVeloPulse),note, %TIME_ONESHOT OR %TIME_CALLBACK_FUNCTION) ' Event(note).TimerId = retval IF ISFALSE retval THEN #IF %DEF(%pp_debug) MSGBOX "[RotoBeat] - Error creating timerevent" #ENDIF ppVelo note, %False ELSE ppVelo note, %True ' set the velo-bit high, immediately after starting the timer, this to avoid double triggering. END IF ' the one-shot resets the velo bit... END SUB