'**************************************************************** '* Name : Rodo_Beaters1.BAS * '* Author : dr.Godfried-Willem RAES * '* Notice : Copyleft (c) 2014 Logosoft Public Domain * '* Date : 09-04-2014 * '* Version : 1.3 * '* Notes : code for the 18F4620 * '**************************************************************** Include "18F4620.inc" ' for the beater processor (40MHz) ' Mapping defines for midi-events on pin outputs and inputs: ' beaters - in order of output on the PC board $define Noot48 PORTA.2 ' #1 $define Noot49 PORTA.1 ' #2 $define Noot50 PORTA.0 ' #3 $define Noot51 PORTA.3 ' #4 $define Noot52 PORTA.4 ' #5 $define Noot53 PORTA.5 ' #6 $define Noot54 PORTE.0 ' #7 $define Noot55 PORTE.1 ' #8 $define Noot56 PORTE.2 ' #9 $define Noot57 PORTB.4 ' #10 $define Noot58 PORTB.3 ' #11 $define Noot59 PORTB.2 ' #12 $define Noot60 PORTB.1 ' #13 $define Noot61 PORTB.0 ' #14 $define Noot62 PORTD.7 ' #15 $define Noot63 PORTD.6 ' #16 ' alias defines for lites: $define Lite124 PORTC.0 ' #23 steered by Lites.0 24V lights -LED strips $define Lite125 PORTC.1 ' #24 Lites.1 $define Lite126 PORTC.2 ' #25 24V RED rotating light $define Lite127 PORTC.3 ' #26 'red LED for debug: $define Debug_Led PORTB.5 ' for testing - red led - watchdog Declare All_Digital = True ' makes all analog pins, digital for I/O Clear SSPCON1.5 ' make sure RC3 is free for use. ' configure the input and output pins: TRISA = %11000000 'bits set to 0 are output, 1 = input - bits 6 and 7 are the clock! TRISB = %11100000 'bits 6 and 7 are for the ICP, bit 5 is the red LED TRISC = %11000000 'RC6 en RC7 zijn USART I/O and must be set to input TRISD = %00000000 'all bits can be used TRISE = %11101000 'low nibble only, bit3 (RE3) is MCLR ' bit 4 must be cleared for port D to work normally!!! 'constant definitions: Symbol Midichannel = 7 ' Rodo_Channel Symbol NoteOff_Status = 128 + Midichannel ' 2 bytes follow Symbol NoteOn_Status = 144 + Midichannel Symbol Keypres_Status = 160 + Midichannel Symbol Control_Status = 176 + Midichannel Symbol ProgChange_Status = 192 + Midichannel ' 1 byte message Symbol Aftertouch_Status = 208 + Midichannel ' 1 byte follows Symbol Pitchbend_Status = 224 + Midichannel ' lsb msb follow Symbol Minvel = 84 ' 20 was the value used for high blocks on temblo ' Setup the USART Declare Hserial_Baud = 31250 ' Set baud rate for the USART to MIDI specs. Declare Hserial_TXSTA = 0x24 ' instead of the normal 0x20 - ?? 0x24 Dim Cnt As Dword System '32 bit counter Dim CntHw As Cnt.Word1 'used in the timer0 interrupt, where it is incremented Dim CntLw As TMR0L.Word 'this is the trick to read both TMR0L and TMR0H 'it makes Cntlw the low word of cnt, when we use cnt.word0=CntLw Dim Tim1 As TMR1L.Word Dim Cnt3 As Dword System Dim Cnt3Hw As Cnt3.Word1 Dim Tim3 As TMR3L.Word ' same trick for timer3 Dim Bytein As Byte System ' midi byte read from buffer Dim StBit As Bytein.7 ' highest bit of ByteIn Dim i As Byte System ' general purpose counter ' midi variables Dim statusbyte As Byte System Dim noteUit As Byte System ' note off + release value Dim release As Byte System Dim noteAan As Byte System ' note on + release value Dim velo As Byte System Dim notePres As Byte System ' note pressure + pressure value Dim pres As Byte System Dim Ctrl As Byte System ' continuous controller + value Dim value As Byte System Dim aft As Byte System ' channel aftertouch Dim veltim0 As Dword System ' faster, replaces the arrays Dim veltim1 As Dword System Dim veltim2 As Dword System Dim veltim3 As Dword System Dim veltim4 As Dword System Dim veltim5 As Dword System Dim veltim6 As Dword System Dim veltim7 As Dword System Dim veltim8 As Dword System Dim veltim9 As Dword System Dim veltim10 As Dword System Dim veltim11 As Dword System Dim veltim12 As Dword System Dim veltim13 As Dword System Dim veltim14 As Dword System Dim veltim15 As Dword System Dim VelFlags0 As Byte System ' so we can have only 8 tasks Dim Velflags1 As Byte System ' another 8 tasks Dim CC66 As Byte System ' global on/off switch Dim PowerOn As CC66.0 Dim st As Byte System Dim b1 As Byte System Dim b2 As Byte System '----------------------------------------------------------------------------------------- ' Load the USART Interrupt handler and buffer read subroutines into memory Include "Rodo_Beaters_Midi_Irq.inc" ' our own version for UART,Timer0, Timer3 Interrupt '----------------------------------------------------------------------------------------- ' Main program starts here MAIN: High Debug_Led DelayMS 20 ' wait for stability Low Debug_Led GoSub PowerDown Clear CC66 Init_Usart_Interrupt ' Initiate the USART serial buffer interrupt ' this procedure is in the include file Clear_Serial_Buffer ' Clear the serial buffer and reset its pointers ' in the include as well ' following only required for pulse outputs: ' Note that we can only use timer0 since the other timers ' are used by the PWM subsystem ' Configure Timer0 for: ' Clear TMR0L and TMR0H registers ' Interrupt on Timer0 overflow ' 16-bit operation ' Internal clock source 40MHz ' 1:256 Prescaler : thus 40MHz / 256 = 156.250kHz ' 6.4 us per clock-tick ' Opentimer0 (Timer_INT_On & T0_16BIT & T0_SOURCE_INT & T0_PS_1_256) ' replacing above macro with in-line coding: Clear T1CON Clear IntConBits_T0IF ' clear interrupt flag Set INTCONBITS_T0IE ' enable interrupt on overflow T0CON = %10000111 ' bit 7 = enable/disable ' bit 6 = 1=8 bot, 0=16 bit ' bit 5 = 1 pin input, 0= Internal Clk0 ' bit 4 = HL or LH transition when bit5 =1 ' bit 3 = 1= bypass prescaler, 0= input from prescaler ' bit 2-0 = prescaler select: 111= 1:256 ' Setup the High priorities for the interrupts Clear T3CON Clear PIR2BITS_TMR3IF ' clear IRQ flag Set PIE2BITS_TMR3IE ' irq on Clear Tim3 ' Clear TMR3L And TMR3H registers Set RCONbits_IPEN ' Enable priority interrupts Clear IPR2bits_TMR3IP ' Set Timer3 as a low priority interrupt source ' we can also set T3Con in one instruction as: T3CON = %10110001 ' oef, now it works... ' bit 7 = 16 bit mode ' bit 6,3 = 0, 0 ' bit 5,4 = 1:8 prescale ' bit 2 = 0 ' bit 1 = 0 Internal clock = Fosc/4 ' bit 0 : 1= enable timer 3, 0= disable ' maximum count = 52.42ms, 1 tick =0.8uS, freq.=19Hz LOOP: ' Create an infinite loop Bytein = HRSIn ' Read data from the serial buffer, with no timeout ' Start the midi parser. Midi_Parse: If Bytein > Control_Status Then ' here higher statusses are not implemented. If Bytein > 253 Then '254 = midiclock, 255= reset 'midiclock can interrupt all other msg's... '255 had to be intercepted since thats what we 'get when no new byte flows in (?) GoTo Check_Timers 'throw away... Else Clear statusbyte 'reset the status byte GoTo Check_Timers 'throw away End If EndIf If StBit =1 Then 'should be faster than If Bytein > 127 Then 'status byte received, bit 7 is set Clear statusbyte 'if on another channel, the statusbyte needs a reset Select Bytein 'eqv to Select case ByteIn Case NoteOff_Status statusbyte = Bytein Set noteUit 'reset value. Cannot be 0 !!! Set release '0 is a valid midi note! Case NoteOn_Status statusbyte = Bytein Set noteAan '= 255 Set velo '= 255 ' Case Keypres_Status 'could be used for note repetitions ' statusbyte = Bytein ' Set notePres ' Set pres Case Control_Status statusbyte = Bytein Set Ctrl Set value ' Case ProgChange_Status ' could be used ' statusbyte = Bytein ' prog = 255 ' Case Aftertouch_Status ' not used here ' statusbyte = Bytein ' Set aft ' Case Pitchbend_Status ' statusbyte = Bytein ' pblsb = 255 ' pbmsb = 255 End Select Else 'midi byte is 7 bits, bit 7 is 0 Select statusbyte Case 0 'not a message for this channel GoTo Check_Timers 'disregard Case NoteOff_Status If noteUit = 255 Then noteUit = Bytein Else release = Bytein 'message complete, so we can do the action... Select noteUit Case 48 ' the potential problem here is that if Velflags0.0 is still set, we risk ' burning out coils at high repetition speeds. Clear Noot48 Clear VelFlags0.0 Case 49 Clear Noot49 Clear VelFlags0.1 Case 50 Clear Noot50 Clear VelFlags0.2 Case 51 Clear Noot51 Clear VelFlags0.3 Case 52 Clear Noot52 Clear VelFlags0.4 Case 53 Clear Noot53 Clear VelFlags0.5 Case 54 Clear Noot54 Clear VelFlags0.6 Case 55 Clear Noot55 Clear VelFlags0.7 Case 56 Clear Noot56 Clear Velflags1.0 Case 57 Clear Noot57 Clear Velflags1.1 Case 58 Clear Noot58 Clear Velflags1.2 Case 59 Clear Noot59 Clear Velflags1.3 Case 60 Clear Noot60 Clear Velflags1.4 Case 61 Clear Noot61 Clear Velflags1.5 Case 62 Clear Noot62 Clear Velflags1.6 Case 63 Clear Noot63 Clear Velflags1.7 ' further notes (64-78) are for the next board. Case 124 ' Clear Lites.0 Clear Lite124 Case 125 ' Clear Lites.1 Clear Lite125 Case 126 ' Clear Lites.2 Clear Lite126 Case 127 ' Clear Lites.3 Clear Lite127 End Select Set noteUit '= 255 'reset EndIf 'GoTo Check_Timers Case NoteOn_Status If noteAan = 255 Then noteAan = Bytein Else velo = Bytein If velo = 0 Then Select noteAan Case 48 Clear Noot48 Clear VelFlags0.0 Case 49 Clear Noot49 Clear VelFlags0.1 Case 50 Clear Noot50 Clear VelFlags0.2 Case 51 Clear Noot51 Clear VelFlags0.3 Case 52 Clear Noot52 Clear VelFlags0.4 Case 53 Clear Noot53 Clear VelFlags0.5 Case 54 Clear Noot54 Clear VelFlags0.6 Case 55 Clear Noot55 Clear VelFlags0.7 Case 56 Clear Noot56 Clear Velflags1.0 Case 57 Clear Noot57 Clear Velflags1.1 Case 58 Clear Noot58 Clear Velflags1.2 Case 59 Clear Noot59 Clear Velflags1.3 Case 60 Clear Noot60 Clear Velflags1.4 Case 61 Clear Noot61 Clear Velflags1.5 Case 62 Clear Noot62 Clear Velflags1.6 Case 63 Clear Noot63 Clear Velflags1.7 ' further notes (64-78) are for the next board. Case 124 'Clear Lites.0 Clear Lite124 Case 125 'Clear Lites.1 Clear Lite125 Case 126 'Clear Lites.2 Clear Lite126 Case 127 'Clear Lites.3 Clear Lite127 End Select Else Select noteAan Case 48 velo = velo << 1 ' to protect the coils we could add following condition: If VelFlags0.0 = 0 Then Set VelFlags0.0 ' start velo-timer: Cnt.Word0 = CntLw veltim0 = Cnt + Minvel + velo Set Noot48 Else ' we refuse to activate the coil again and wait for the timer to run out. ' we could also set the timer and clear the note, such that we would guarantee a 50% duty cycle. Set VelFlags0.0 ' ' start velo-timer: Cnt.Word0 = CntLw veltim0 = Cnt + Minvel + velo Clear Noot48 EndIf ' however, this would only protect the coils for code not sending note-offs. ' if we want to fully protect, we need to refuse note-off also when the timer is still running. ' furthermore, we would need 16 silence-timers set in function of the previous velo byte. Case 49 velo = velo << 1 If VelFlags0.1 = 0 Then Set VelFlags0.1 Cnt.Word0 = CntLw veltim1 = Cnt + Minvel + velo Set Noot49 Else Set VelFlags0.1 Cnt.Word0 = CntLw veltim1 = Cnt + Minvel + velo Clear Noot49 EndIf Case 50 velo = velo << 1 If VelFlags0.2 = 0 Then Set VelFlags0.2 Cnt.Word0 = CntLw veltim2 = Cnt + Minvel + velo Set Noot50 Else Set VelFlags0.2 Cnt.Word0 = CntLw veltim2 = Cnt + Minvel + velo Clear Noot50 EndIf Case 51 velo = velo << 1 If VelFlags0.3 = 0 Then Set VelFlags0.3 Cnt.Word0 = CntLw veltim3 = Cnt + Minvel + velo Set Noot51 Else Set VelFlags0.3 Cnt.Word0 = CntLw veltim3 = Cnt + Minvel + velo Clear Noot51 EndIf Case 52 velo = velo << 1 If VelFlags0.4 = 0 Then Set VelFlags0.4 Cnt.Word0 = CntLw veltim4 = Cnt + Minvel + velo Set Noot52 Else Set VelFlags0.4 Cnt.Word0 = CntLw veltim4 = Cnt + Minvel + velo Clear Noot52 EndIf Case 53 velo = velo << 1 If VelFlags0.5 = 0 Then Set VelFlags0.5 Cnt.Word0 = CntLw veltim5 = Cnt + Minvel + velo Set Noot53 Else Set VelFlags0.5 Cnt.Word0 = CntLw veltim5 = Cnt + Minvel + velo Clear Noot53 EndIf Case 54 velo = velo << 1 If VelFlags0.6 = 0 Then Set VelFlags0.6 Cnt.Word0 = CntLw veltim6 = Cnt + Minvel + velo Set Noot54 Else Set VelFlags0.6 Cnt.Word0 = CntLw veltim6 = Cnt + Minvel + velo Clear Noot54 EndIf Case 55 velo = velo << 1 If VelFlags0.7 = 0 Then Set VelFlags0.7 Cnt.Word0 = CntLw veltim7 = Cnt + Minvel + velo Set Noot55 Else Set VelFlags0.7 Cnt.Word0 = CntLw veltim7 = Cnt + Minvel + velo Clear Noot55 EndIf Case 56 velo = velo << 1 If Velflags1.0 = 0 Then Set Velflags1.0 Cnt.Word0 = CntLw veltim8 = Cnt + Minvel + velo Set Noot56 Else Set Velflags1.0 Cnt.Word0 = CntLw veltim8 = Cnt + Minvel + velo Clear Noot56 EndIf Case 57 velo = velo << 1 If Velflags1.1 = 0 Then Set Velflags1.1 Cnt.Word0 = CntLw veltim9 = Cnt + Minvel + velo Set Noot57 Else Set Velflags1.1 Cnt.Word0 = CntLw veltim9 = Cnt + Minvel + velo Clear Noot57 EndIf Case 58 velo = velo << 1 If Velflags1.2 = 0 Then Set Velflags1.2 Cnt.Word0 = CntLw veltim10 = Cnt + Minvel + velo Set Noot58 Else Set Velflags1.2 Cnt.Word0 = CntLw veltim10 = Cnt + Minvel + velo Clear Noot58 EndIf Case 59 velo = velo << 1 If Velflags1.3 = 0 Then Set Velflags1.3 Cnt.Word0 = CntLw veltim11 = Cnt + Minvel + velo Set Noot59 Else Set Velflags1.3 Cnt.Word0 = CntLw veltim11 = Cnt + Minvel + velo Clear Noot59 EndIf Case 60 velo = velo << 1 If Velflags1.4 = 0 Then Set Velflags1.4 Cnt.Word0 = CntLw veltim12 = Cnt + Minvel + velo Set Noot60 Else Set Velflags1.4 Cnt.Word0 = CntLw veltim12 = Cnt + Minvel + velo Clear Noot60 EndIf Case 61 velo = velo << 1 If Velflags1.5 = 0 Then Set Velflags1.5 Cnt.Word0 = CntLw veltim13 = Cnt + Minvel + velo Set Noot61 Else Set Velflags1.5 Cnt.Word0 = CntLw veltim13 = Cnt + Minvel + velo Clear Noot61 EndIf Case 62 velo = velo << 1 If Velflags1.6 = 0 Then Set Velflags1.6 Cnt.Word0 = CntLw veltim14 = Cnt + Minvel + velo Set Noot62 Else Set Velflags1.6 Cnt.Word0 = CntLw veltim14 = Cnt + Minvel + velo Clear Noot62 EndIf Case 63 velo = velo << 1 If Velflags1.7 = 0 Then Set Velflags1.7 Cnt.Word0 = CntLw veltim15 = Cnt + Minvel + velo Set Noot63 Else Set Velflags1.7 Cnt.Word0 = CntLw veltim15 = Cnt + Minvel + velo Clear Noot63 EndIf Case 124 'Set Lites.0 Set Lite124 Case 125 'Set Lites.1 Set Lite125 Case 126 'Set Lites.2 Set Lite126 Case 127 'Set Lites.3 Set Lite127 End Select 'Set noteAan '= 255 'reset !!! this was the 08.04.2014 bug!!! EndIf Set noteAan EndIf 'GoTo Check_Timers ' Case Keypres_Status ' 'we could use it for note repeats ' If notePres = 255 Then ' notePres = Bytein ' Else ' pres = Bytein ' 'GoSub KeyPres ' EndIf ' GoTo Check_Timers Case Control_Status 'this is where the action takes place for controllers If Ctrl = 255 Then Ctrl = Bytein Else value = Bytein GoSub Controller ' fingerings implemented here EndIf 'GoTo Check_Timers ' Case ProgChange_Status ' could be used to select alternative fingering lookups ' If prog = 255 Then 'single byte message ' prog = Bytein 'weak coding... ' GoSub ProgChange ' EndIf ' Case Aftertouch_Status ' could be used for amplitude modulation during note repeats ' If aft = 255 Then ' aft = Bytein ' GoSub Aftertouch ' EndIf ' GoTo Check_Timers End Select EndIf Check_Timers: ' here we check the Task counters and compare them with the 32 bit cnt value ' using the Velflags dword variable: If VelFlags0 > 0 Then If VelFlags0.0 = 1 Then Cnt.Word0 = CntLw If Cnt >= veltim0 Then Clear Noot48 Clear VelFlags0.0 ' one shot EndIf EndIf If VelFlags0.1 = 1 Then Cnt.Word0 = CntLw If Cnt >= veltim1 Then Clear Noot49 Clear VelFlags0.1 ' one shot EndIf EndIf If VelFlags0.2 = 1 Then Cnt.Word0 = CntLw If Cnt >= veltim2 Then Clear Noot50 Clear VelFlags0.2 ' one shot EndIf EndIf If VelFlags0.3 = 1 Then Cnt.Word0 = CntLw If Cnt >= veltim3 Then Clear Noot51 Clear VelFlags0.3 ' one shot EndIf EndIf If VelFlags0.4 = 1 Then Cnt.Word0 = CntLw If Cnt >= veltim4 Then Clear Noot52 Clear VelFlags0.4 ' one shot EndIf EndIf If VelFlags0.5 = 1 Then Cnt.Word0 = CntLw If Cnt >= veltim5 Then Clear Noot53 Clear VelFlags0.5 ' one shot EndIf EndIf If VelFlags0.6 = 1 Then Cnt.Word0 = CntLw If Cnt >= veltim6 Then Clear Noot54 Clear VelFlags0.6 ' one shot EndIf EndIf If VelFlags0.7 = 1 Then Cnt.Word0 = CntLw If Cnt >= veltim7 Then Clear Noot55 Clear VelFlags0.7 ' one shot EndIf EndIf EndIf ' tweede groep van 8 beaters/timers: If Velflags1 > 0 Then If Velflags1.0 = 1 Then Cnt.Word0 = CntLw If Cnt >= veltim8 Then Clear Noot56 Clear Velflags1.0 EndIf EndIf If Velflags1.1 = 1 Then Cnt.Word0 = CntLw If Cnt >= veltim9 Then Clear Noot57 Clear Velflags1.1 EndIf EndIf If Velflags1.2 = 1 Then Cnt.Word0 = CntLw If Cnt >= veltim10 Then Clear Noot58 Clear Velflags1.2 EndIf EndIf If Velflags1.3 = 1 Then Cnt.Word0 = CntLw If Cnt >= veltim11 Then Clear Noot59 Clear Velflags1.3 EndIf EndIf If Velflags1.4 = 1 Then Cnt.Word0 = CntLw If Cnt >= veltim12 Then Clear Noot60 Clear Velflags1.4 EndIf EndIf If Velflags1.5 = 1 Then Cnt.Word0 = CntLw If Cnt >= veltim13 Then Clear Noot61 Clear Velflags1.5 EndIf EndIf If Velflags1.6 = 1 Then Cnt.Word0 = CntLw If Cnt >= veltim14 Then Clear Noot62 Clear Velflags1.6 EndIf EndIf If Velflags1.7 = 1 Then Cnt.Word0 = CntLw If Cnt >= veltim15 Then Clear Noot63 Clear Velflags1.7 EndIf EndIf EndIf GoTo LOOP ' end of the main loop Controller: Select Ctrl Case 66 'on/off for the robot If value = 0 Then Clear PowerOn 'CC66.0 =0 GoSub PowerDown Else Set PowerOn 'CC66.0 =1 ' here we should also reset all controllers to their cold boot value EndIf Case 123 GoSub PowerDown End Select Set Ctrl 'mandatory reset Return PowerDown: 'should switch off all valves activated Clear VelFlags0 'stop all running timers Clear Velflags1 Clear CntHw ' reset timer Clear Noot48 Clear Noot49 ' = 0 Clear Noot50 ' = 0 Clear Noot51 ' = 0 Clear Noot52 ' = 0 Clear Noot53 ' = 0 Clear Noot54 ' = 0 Clear Noot55 ' = 0 Clear Noot56 ' = 0 Clear Noot57 ' = 0 Clear Noot58 ' = 0 Clear Noot59 ' = 0 Clear Noot60 ' = 0 Clear Noot61 ' = 0 Clear Noot62 ' = 0 Clear Noot63 ' = 0 ' CLEAR spare1 ' = 0 ' CLEAR spare2 ' = 0 Clear Lite124 Clear Lite125 Clear Lite126 Clear Lite127 Return '[EOF]