'**************************************************************** '* Name : Whisper_Q1.BAS * '* Author : Godfried-Willem RAES * '* Notice : Copyleft (c) 2019 Logosoft Public Domain * '* Date : 20-08-2013 * '* Last revision: 12.12.2019 * '* Version : 1.6 * '* Notes : Based On Whisper-hub code model * '**************************************************************** '08.06.2013: PIC: 18F2525 On MidiHub board, 2 PWM motor, lites '14.08.2013: Version 1.0 '18.08.2013: Further development. '19.08.2013: Hardware finished. Version 1.0 flashed in hub ' renamed Q1.bas for programming the quad pic board. ' This is the source for PIC1 '20.08.2013: Code cleanup '13.04.2015: PWM reduced to range 0-190 instead of 0-255 ' as all motors were found to be burned out... '14.04.2015: new firmware uploaded. ' range too limited now... ' changed to 4V to 16.8V '15.04.2015: This board steers resonators 1 and 2, notes 73 and 74 ' These now use Bi-Sonic Fans. ' Steered with our PWM power, they refused operation. ' Placing 220nF caps across the motors helped us out here. ' CC66 fully implemented. ' note 73 works reasonable now, not really good though ' note 74 does not show any regulation (just on/off with no effect of velo...) '23.04.2015: Recompiled with upgraded Proton Compiler ' apparently the PWM is not working as it should... '24.04.2015: New code checked on Whisper. ' bad regulation with velo << 1, so we have to get back to 128 + velo ' The problem must be due to the fans (Bisonic BP4020 12H-03) '11.12.2019: Start revision and repair of the Whisper robot ' first adapt code to work with the newest compiler version. ' compiles o.k. now. To be tested on hardware. ' to do: add timers such that we can controll overdrive time of the fans. '12.12.2019: start implementation of lookuptables for PWM : Fan_1[] and Fan_2[] ' we may have to introduce timers here to protect the fans against long overvoltage drives... ' Keypressure is now implemented. '14.12.2019: same as the Q1 code, with different note mappings for notes 75 and 76. ' fans: note 75 = Pabst 412H ' note 76 = SanAce40 (Sanyo) Include "18F2525.inc" 'version for the Whisper board. (40MHz) 'Include "18F2520.inc" 'also possible. (40MHz) 'Include "18F2620.inc" 'also possible 'Include "18F25K20.inc" 'for test & debug on an Amicus board. (64MHz) ' Mapping defines for midi-events on pin outputs and inputs: $define Fan1 PORTC.1 ' Fan1 75 $define Fan2 PORTC.2 ' Fan2 76 $define Debug_Led PORTB.5 ' for testing - red led - watchdog $define Loopspeed PORTB.0 ' for loopspeed measurement ' configure the input and output pins: Clear SSPCON1.5 'RC3 must be available for I/O TRISA = %01000111 'bits set to 0 are output, 1 = input TRISB = %11100000 TRISC = %11000000 'RC1 en RC2 zijn pwm outputs and must be set to output 'RC6 en RC7 zijn USART I/O and must be set to input 'constant definitions: 'initialisations for the midi input parser: Symbol Midichannel = 11 ' Whisper_Channel Symbol NoteOff_Status = 128 + Midichannel ' 2 bytes follow Symbol NoteOn_Status = 144 + Midichannel Symbol Keypres_Status = 160 + Midichannel ' 2 bytes follow 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 'application specific constants 'Symbol NrTasks = 1 ' maximum 16 'Symbol fPWM = PWMminF * 8 ' in avoidance of audible artifacts ' was * 4 up to 04/2015 Symbol fPWM = 20000 ' 15.04.2015 set to 20kHz , for 8-bits ' 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 Declare All_Digital = True ' Declare Hserial_Clear = On ' should clear on errors. Bytes get lost of course... ' Create variables Dim Cnt As Dword System Dim CntHw As Cnt.Word1 'used in the timer0 interrupt, to create a 32 bit timer Dim CntLw As TMR0L.Word 'this is the trick to read both TMR0L and TMR0H 'it makes Cntlw the low word of cnt 'We still have to copy the contents of Lw to Cnt 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 prog As Byte System ' program change + program-byte ' Dim aft As Byte System ' channel aftertouch ' Dim pblsb As Byte System ' pitch bend lsb ' Dim pbmsb As Byte System ' pitch bend msb Dim CC66 As Byte System ' global on/off switch Dim PowerOn As CC66.0 Dim pw1 As Word System ' Fan1 73 Dim pw2 As Word System ' Fan2 74 Dim MidiIn As Byte System Dim IndexIn As Byte System Dim IndexOut As Byte System Dim RingBuffer[256] As Byte Dim Fan_1[128] As Word ' lookups Dim Fan_2[128] As Word Dim idx As Byte Dim tmp As Float Dim stap As Float '----------------------------------------------------------------------------------------- ' Load the USART Interrupt handler And buffer read subroutines into memory 'Include "ADC.inc" ' Load the ADC macros into the program - used in the IRQ include. Include "Whisper19_Irq.inc" ' our own new version for UART And Timer0/3 Interrupt Include "hpwm10.inc" 'make sure we initialize the pins on start up: Low Debug_Led $ifdef _HPWM10_INC_ 'OpenAnalog10 ' for 10-bit pwm 39kHz OpenAnalog9 ' for 9 bit pwm 19kHz WriteAnalog1 0 WriteAnalog2 0 $else HPWM 2, 0, fPWM ' connected to RC1 ' for 8-bit pwm 20kHz HPWM 1, 0, fPWM ' connected to RC2 $endif Clear CC66 ' also clears PowerOn '----------------------------------------------------------------------------------------- ' Main program starts here MAIN: High Debug_Led DelayMS 50 ' wait for stability Low Debug_Led GoSub Init_Usart_Interrupt ' Initiate the USART serial buffer interrupt ' this procedure is in the include file GoSub Clear_Serial_Buffer ' Clear the serial buffer and reset its pointers ' in the include as well ' 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 ' Opentimer0 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 ' Open the ADC: ' Fosc/32 ' Right justified for 10-bit operation ' Tad value of 0 ' Vref+ at Vcc : Vref- at Gnd ' Make AN0 an analogue input ' ' OpenADC(ADC_FOSC_32 & ADC_RIGHT_JUST & ADC_0_TAD, ADC_REF_VDD_VSS, ADC_1ANA) ' could be replaced with: ' ADCON2 = %10000010 ' ADCON1 = %00001110 ' ADCON0 = %00000001 ' SensorVal = ReadADC 0 ' initialize with the value on startup - 10 bit resolution ' open and start timer3 for sampling: 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 = %10110000 ' 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 set to 0 for Whisper! ' maximum count = 52.42ms, 1 tick =0.8uS, lowest freq.=19Hz ' read lookup tables: GoSub Dur_Lookup Set idx HRSOut Ctrl, 66, 64 ' dummy to make serial I/O work... ' start the main program loop: Do ' Create an infinite loop Cnt.Word0 = CntLw ' timer GetMidiIn () Bytein = MidiIn ' 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 Set velo Case Keypres_Status ' used for lights - not on this board statusbyte = Bytein Set notePres Set pres Case Control_Status ' only 123 statusbyte = Bytein Set Ctrl Set value End Select Else 'midi byte is 7 bits 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 $ifndef _HPWM10_INC_ Case 75 HPWM 2, 0, fPWM ' connected to RC1 fan1 Case 76 HPWM 1, 0, fPWM ' RC2 fan2 $else Case 75 WriteAnalog2 0 Case 76 WriteAnalog1 0 $endif End Select Set noteUit 'reset EndIf GoTo Check_Timers Case NoteOn_Status If noteAan = 255 Then noteAan = Bytein Else velo = Bytein If velo = 0 Then Select noteAan $ifndef _HPWM10_INC_ Case 75 HPWM 2, 0, fPWM ' connected to RC1 fan1 Case 76 HPWM 1, 0, fPWM ' RC2 fan2 $else Case 75 WriteAnalog2 0 Case 76 WriteAnalog1 0 $endif End Select Set noteAan 'reset !!! GoTo Check_Timers 'jump out EndIf If PowerOn = 1 Then 'CC66 implemented! Select noteAan $ifndef _HPWM10_INC_ Case 75 pw1 = velo + 128 HPWM 2, pw1.Byte0, fPWM ' connected to RC1 fan1 Case 76 pw2 = velo + 128 HPWM 1, pw2.Byte0, fPWM ' RC2 fan2 $else Case 75 WriteAnalog2 Fan_1[velo] Case 76 WriteAnalog1 Fan_2[velo] $endif End Select EndIf Set noteAan 'reset EndIf GoTo Check_Timers Case Keypres_Status 'we use it to implement speed modulation on the fans. If notePres = 255 Then notePres = Bytein Else pres = Bytein Select Case notePres $ifndef _HPWM10_INC_ Case 75 pw1 = pres + 128 HPWM 2, pw1.Byte0, fPWM ' connected to RC1 fan1 Case 76 pw2 = pres + 128 HPWM 1, pw2.Byte0, fPWM ' RC2 fan2 $else Case 75 WriteAnalog2 Fan_1[pres] Case 76 WriteAnalog1 Fan_2[pres] $endif EndSelect Set notePres 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 EndIf GoTo Check_Timers End Select EndIf Check_Timers: ' not yet implemented here. Btg Loopspeed ' for loopspeed measurement - 192kHz !!! Loop ' end of the main loop Controller: Select Ctrl Case 66 'on/off for the robot If value = 0 Then Clear PowerOn $ifndef _HPWM10_INC_ HPWM 2, 0, PWMminF ' connected to RC1 fan1 HPWM 1, 0, PWMminF ' RC2 fan2 $else WriteAnalog2 0 WriteAnalog1 0 $endif Clear CC66 Else Set PowerOn Set CC66 EndIf Case 123 $ifndef _HPWM10_INC_ HPWM 1, 0, fPWM ' connected to RC2 HPWM 2, 0, fPWM ' connected to RC1 $else WriteAnalog2 0 WriteAnalog1 0 $endif End Select Set Ctrl 'mandatory reset Return Dur_Lookup: ' lookups for 9-bit pwm: ' to be checked with the new motors... ' Pabst 412H ' 1 unit = 17V/ 512 = 33.2mV Fan_1[0] = 0 Fan_1[1] = 210 ' minimum value 7V to sound Fan_1[127] = 422 ' 14V stap = Fan_2[127] - Fan_2[1] stap = stap / 127 For i = 2 To 126 tmp = Fan_1[1] + (i * stap) Fan_1[i] = tmp Next i ' with this scaling, runs from 7 V to 14V ' full-range linear scaling: ' Sanyo San Ace40 Fan_2[0] = 0 Fan_2[1] = 99 ' 3.3V Fan_2[127] = 362 ' 12V stap = Fan_2[127] - Fan_2[1] stap = stap / 127 For i = 2 To 126 tmp = Fan_2[1] + (i * stap) Fan_2[i] = tmp Next i Return '[EOF]