; ; Preamp_Ctl.ASM ; ; Digital Preamplifier controller ; for the PIC16F84A @ 4 MHz ; ; v1.3 ; ; Jim George (jimgeorge@softhome.net), 2002 ; IR decoder by Edward Cardew (Edward_Cardew@aia.com) ; ; Use freely, but don't blame me if your PIC/preamp is damaged ; ; Hardware attached: LM1973 ęPot (SPI), CD4094 shift register w/ latch, ; HD44170 Compatible LCD (via 'HC164 shift register), DS1305 Real ; Time Clock (via SPI), three momentary-contact switches, TSOP1738 ; Infrared receiver/decoder, headphone socket switch, relay driver ; ; ; History ; ------- ; ; v1.3 ; Included the smooth volume indicator bar. ; ; v1.2 ; Included volume indicator bar and display of the source when in Time mode ; ; v1.1 ; Included support for keypad and speaker muting when the headphones are ; plugged in. Speakers are also muted until LCD completes initializing, giving ; a half-second delay before speakers are enabled: free click-protection! ; ; v1.0 ; Initial release. ; list p=16f84a #include p16f84a.inc #define KYB_RPT 30h ;Front panel keypad repeat delay #define SEL_BANK_0 bcf STATUS, RP0 #define SEL_BANK_1 bsf STATUS, RP0 #define CARRY STATUS, C #define ZERO STATUS, Z #define Last_RC5_Bit flags,1 ;Last RC5 bit received #define RC5_2nd_Bit flags,2 ;Add 2 RC5 bits #define RC5_2nd_Value flags,3 ;2nd RC5 bit received #define RC5_Bit flags,4 ;1st RC5 bit received #define Time_Set_Mode flags,5 ;We are currently changing ;the time... #define Key_Rdy flags,6 ;Keypad is ready to accept new input #define IR_RCV PORTB,0 ;IR Receiver #define SPI_CLK PORTB,1 ;SPI bus clock line #define SPI_DATA PORTB,2 ;SPI bus data line #define RTC_DATA PORTB,3 ;RTC's output line #define Button_Dec PORTB, 4 ;Decrement button #define Button_Menu PORTB, 5 ;Menu button #define Button_Inc PORTB, 6 ;Increment button #define Headphone_SW PORTB, 7 ;Headphone Socket Switch #define CD4094_STB PORTA,4 ;4094's strobe pin #define LCD_STB PORTA,1 ;LCD strobe (enable) #define LM1973_CE PORTA,2 ;Chip Enable for volume ctl. #define DS1305_CE PORTA,3 ;Chip Enable for RTC ;These are the output pins of the 4094 #define LCD_REGSEL LED_Port, 0 #define BASS_CTL_0 LED_Port, 1 #define BASS_CTL_1 LED_Port, 2 #define BASS_CTL b'00000110' #define INPUT_SEL_0 LED_Port, 3 #define INPUT_SEL_1 LED_Port, 4 #define INPUT_SEL b'00011000' #define LED_0 LED_Port, 7 #define Mute_L Vol_L, 7 #define Mute_R Vol_R, 7 __CONFIG _PWRTE_ON & _XT_OSC & _WDT_OFF RAMbase equ 12 cblock RAMbase temp temp2 temp3 spi_temp W_Temp S_Temp T_Temp Old_T_Temp oldtime RC5_Bit_Count RC5_Command flags count w_count LED_Port Vol_L Vol_R MenuNum BassLevel Source TapeMon Cmd MenuTime st_hrs st_min key_pacifier endc #define quotient st_hrs #define remainder st_min ORG 0 ; start at program memory location zero reset_vector: movlw b'10010010' ;Enable GIE, INTE and INTF movwf INTCON clrf flags goto start interrupt_vector: if (interrupt_vector != 4) error "interrupt vector not at 0x0004" endif ;Save the state of W and STATUS push: movwf W_Temp swapf STATUS,W movwf S_Temp SEL_BANK_0 bcf INTCON, GIE ;Disable all interrupts within the ISR btfsc INTCON, INTF ;Check if RB0/INT0 caused the interrupt goto RB0_Int btfsc INTCON, T0IF ;Was the interrupt caused by the timer? goto Timer_Int ;yeah, so go do the timer stuff ;Restore W and STATUS to their former state pop: swapf S_Temp, W movwf STATUS swapf W_Temp, F swapf W_Temp, W retfie ;Return, setting GIE ; ; *** Interrupt Handler for RB0 *** ; RB0_Int: bcf INTCON, T0IE bcf INTCON, T0IF movf TMR0, W movwf T_Temp ;save the timer value ;movlw b'00000011' clrf TMR0 ;reset the timer ;SEL_BANK_1 ;iorwf OPTION_REG, F ;Set the timer divisor to 1:16 ;SEL_BANK_0 bcf RC5_2nd_Bit movf RC5_Bit_Count, F btfsc ZERO ;If this is first bit, it must be 1 goto RC5_Add_1 ;Not 1st bit, so find out how much time elapsed since last bit was received movlw h'8C' ;Corresponds to ~2.2ms subwf T_Temp, W btfss CARRY ;if the time > 0x8C, then skip goto Timer_is_2T movlw h'CF' ;Corresponds to ~3.3ms subwf T_Temp, W btfss CARRY ;if the time > 0xCF, then skip goto Timer_is_3T Timer_is_4T: btfss Last_RC5_Bit goto RC5_Rx_Error ;If the last bit recv'd is not 1, error goto RC5_Add_01 Timer_is_2T: btfss Last_RC5_Bit goto RC5_Add_0 goto RC5_Add_1 Timer_is_3T: btfss Last_RC5_Bit goto RC5_Add_1 goto RC5_Add_00 ;The following is becoz for all 2-bit additions, first bit is zero RC5_Add_01: bsf RC5_2nd_Value goto RC5_Add_0x RC5_Add_00: bcf RC5_2nd_Value RC5_Add_0x: bsf RC5_2nd_Bit RC5_Add_0: bcf RC5_Bit goto RC5_Add_Bit RC5_Add_1: bsf RC5_Bit RC5_Add_Bit: btfss RC5_Bit goto RC5_was_0 bsf Last_RC5_Bit goto RC5_Test_End RC5_was_0: bcf Last_RC5_Bit RC5_Test_End: incf RC5_Bit_Count, F movlw d'2' subwf RC5_Bit_Count, W btfsc ZERO goto RC5_Command_Rotate movlw d'9' subwf RC5_Bit_Count, W btfss CARRY goto RC5_Add_Bit_End RC5_Command_Rotate: rlf RC5_Command ;rotate the command bcf RC5_Command, 0 ;first clear the bit btfsc RC5_Bit bsf RC5_Command, 0 ;if RC5_Bit is set, set the bit RC5_Add_Bit_End: btfss RC5_2nd_Bit ;skip to the end if only 1 bit to be added goto RC5_Int_End bcf RC5_2nd_Bit ;clear the 2-bits flag btfsc RC5_2nd_Value ;depending on the value of the 2nd bit... goto RC5_Add_1 ;...call either add_1 or add_0 goto RC5_Add_0 RC5_Rx_Error RC5_Int_End bsf INTCON, T0IE ;enable timer interrupts bcf INTCON, INTF ;clear the interrupt goto pop ;return ; ; *** Interrupt Handler for TMR0 *** ; ;Will reach here only if the timer is allowed to expire (ie, no bits arrive ; for 255 ticks) Timer_Int: bcf INTCON, T0IE bcf INTCON, T0IF ;disable ints, clear the flag movlw d'13' subwf RC5_Bit_Count, W btfss ZERO goto No_Zero_Needed incf RC5_Bit_Count, F rlf RC5_Command bcf RC5_Command, 0 No_Zero_Needed: movlw b'01000000' xorwf RC5_Command, F ;Dispatch commands to main loop movlw h'2C' ;Menu Decrease subwf RC5_Command, W movlw d'2' btfsc ZERO goto Send_Cmd movlw h'2B' ;Menu Increase subwf RC5_Command, W movlw d'1' btfsc ZERO goto Send_Cmd movlw h'11' ;Volume Decrease subwf RC5_Command, W btfss ZERO goto Not_Vol_Dec movlw 01h ;Select the volume menu and... movwf MenuNum movlw d'2' ;...make it look like a volume decrease goto Send_Cmd Not_Vol_Dec: movlw h'10' ;Volume Increase subwf RC5_Command, W btfss ZERO goto Not_Vol_Inc movlw 01h ;Select the volume menu and... movwf MenuNum movlw d'1' ;...make it look like a volume increase goto Send_Cmd Not_Vol_Inc: movlw h'2E' ;Menu subwf RC5_Command, W movlw d'3' btfsc ZERO goto Send_Cmd movlw h'0D' ;Mute subwf RC5_Command, W movlw d'4' btfsc ZERO goto Send_Cmd movlw h'0F' ;Center Balance subwf RC5_Command, W movlw d'5' btfsc ZERO goto Send_Cmd ;unknown command, do nothing. goto RC5_Timer_Reset Send_Cmd: movwf Cmd RC5_Timer_Reset: bsf Last_RC5_Bit clrf RC5_Bit_Count clrf RC5_Command goto pop ;return ; ; *** Wait for 60us (give time for LCD to settle) *** ; Wait_60us: movlw d'6' movwf w_count Wait_Loop: ;This wastes 10ęs nop nop nop clrwdt nop nop nop decfsz w_count, 1 goto Wait_Loop return ; ; *** Wait for 2ms (give time for LCD to settle) *** ; Wait_2ms: movlw d'200' movwf w_count goto Wait_Loop ; ; *** Read RTC into W (assume address already sent) *** ; Read_RTC: clrf temp movlw 08h ;8 bits to send movwf count bcf CARRY ;bsf SPI_CLK read_RTC_loop: rlf temp, F bcf SPI_CLK bcf temp, 0 btfsc RTC_DATA bsf temp, 0 bsf SPI_CLK decfsz count goto read_RTC_loop movf temp, W ;Put the read value into W return ; ; *** Write W to RTC *** ; Write_RTC: movwf spi_temp ;Save the data ;bsf SPI_CLK ;goto SPI_Transfer ;Fall through to SPI_Transfer ; ; *** Do a SPI bus write of byte in 'spi_temp' ; SPI_Transfer: movlw 08h ;Send 8 bits movwf count SPI_T_loop: bcf SPI_CLK bcf SPI_DATA btfsc spi_temp, 7 bsf SPI_DATA SPI_T_cont: rlf spi_temp bsf SPI_CLK decfsz count goto SPI_T_loop return ; ; *** Write byte in LED_Port register to the 4094 *** ; Write_4094: movf LED_Port, W movwf spi_temp call SPI_Transfer bsf CD4094_STB ;rising edge of strobe bcf SPI_DATA bcf SPI_CLK bcf CD4094_STB ;falling edge of strobe, ;latch the data just sent return ; ; *** Write byte in W to the LM1973 *** ; Write_Vol: movwf spi_temp ;bcf SPI_CLK call SPI_Transfer ;CHECKME! ;bcf SPI_DATA bcf SPI_CLK return ; ; *** Converts Decimal to BCD *** ; Dec_2_BCD: movwf temp movf temp, F btfsc ZERO return clrf temp2 ;Clear the output var. DD_Loop: incf temp2, F ;Increment the output movlw 0fh andwf temp2, W ;Extract lower nibble sublw 09h btfsc CARRY goto DD_No_Change movlw 06h addwf temp2, F DD_No_Change: decfsz temp, F ;Decrement src, keep going if != 0 goto DD_Loop movf temp2, W return ; ; *** Show the byte (in W) in decimal form on the LCD *** ; note: assumes the result will fit in 2 digits ; Disp_Dec: call Dec_2_BCD ;Now fall through to Disp_Hex with the converted num. in W ; ; *** Show the byte (in W) in hex form on the LCD *** ; Disp_Hex: movwf temp ;Store the number movwf temp2 ;'temp2' stores higher nibble rrf temp, F rrf temp, F rrf temp, F rrf temp, F movf temp, W andlw 0Fh movwf temp sublw 09h movlw 30h btfss CARRY movlw 37h addwf temp, W ;Add the offset and keep in W call Write_LCD ;Show the MSB on the LCD movf temp2, W ;restore number andlw 0Fh movwf count ;'count' stores lower nibble sublw 09h movlw 30h btfss CARRY movlw 37h addwf count, W ;Add the offset and keep in W call Write_LCD ;Show the LSB on the LCD return ; ; *** Clear the LCD *** ; LCD_Cls: bcf LCD_REGSEL ;select cmd reg call Write_4094 movlw b'00000001' ;Send the clear display command call Write_LCD call Wait_2ms bsf LCD_REGSEL ;select data reg call Write_4094 return ; ; *** Read a single byte from location W in the RTC *** ; RTC_Read: bsf SPI_CLK bsf DS1305_CE ;Start the transfer call Write_RTC ;Send Address in W call Read_RTC ;Read data into W bcf DS1305_CE ;End transfer return ;return with read byte in W ; ; *** Get the menu timer in W *** ; Get_Menu_Time: movlw 00h call RTC_Read BCD_2_Bin: movwf temp ;Save it in temp ;now convert the seconds from BCD to binary andlw h'0F' ;Mask off lower 4 bits movwf temp2 rrf temp, F ;right-shift, make MSN -> LSN rrf temp, F rrf temp, F rrf temp, F movlw h'0F' andwf temp, F ;mask off the lower 4 bits movlw d'10' movwf count clrw mult_loop: addwf temp, W ;multiply temp by 10 decfsz count goto mult_loop addwf temp2, W ;store result in W return ; ; *** Write byte in W register to the LCD *** ; Write_LCD: movwf temp ;save W into temp movlw 08h ;8 bits to send movwf count send_LCD_loop: bcf SPI_CLK btfsc temp, 7 goto send_LCD_1 bcf SPI_DATA goto send_LCD_cont send_LCD_1: bsf SPI_DATA send_LCD_cont: rlf temp bsf SPI_CLK ;clock rising edge decfsz count goto send_LCD_loop call Wait_60us ;Wait for LCD to finish bsf LCD_STB ;rising edge of strobe bcf SPI_DATA bcf SPI_CLK bcf LCD_STB ;falling edge of strobe, ;latch the data just sent return ; ; *** Position LCD cursor to W, assuming a 2x16 LCD *** ; Set_LCD_Cursor: movwf temp ;Save W movlw 08h subwf temp, W btfss CARRY ;Cursor is less than 8 goto Cursor_LT_8 ;movlw d'32' ;add 40 to the cursor pos, but subtract 8 ;addwf temp, F Cursor_LT_8: bcf LCD_REGSEL ;select cmd reg call Write_4094 movlw b'10000000' iorwf temp, W call Write_LCD bsf LCD_REGSEL ;select data reg call Write_4094 return ; ; *** Write the CGRAM *** ; Set_LCD_CGRAM: movwf quotient movlw 8 movwf temp2 Write_CGRAM_Loop: movf quotient, W call Write_LCD decfsz temp2 goto Write_CGRAM_Loop return ; ; *** Save all important info in the RTC's RAM *** ; Save_To_RTC: bsf SPI_CLK bsf DS1305_CE ;Start the transfer movlw 0A0h call Write_RTC ;Send Address for RAM start movf Vol_L, W ;Send Left volume call Write_RTC movf Vol_R, W ;Send Right volume call Write_RTC movf BassLevel, W ;BassLevel call Write_RTC movf Source, W ;Send Source call Write_RTC movf TapeMon, W ;Send Tape Monitor selection call Write_RTC bcf DS1305_CE ;End transfer return ; ; *** Read important info from the RTC's RAM *** ; Read_From_RTC: movlw 20h call RTC_Read movwf Vol_L movlw 21h call RTC_Read movwf Vol_R movlw 22h call RTC_Read movwf BassLevel movlw 03h subwf BassLevel, W btfsc CARRY clrf BassLevel movlw 23h call RTC_Read movwf Source movlw 03h subwf Source, W btfsc CARRY clrf Source movlw 24h call RTC_Read movwf TapeMon movlw 03h subwf TapeMon, W btfsc CARRY clrf TapeMon return ; ; *** Show the volume bargraph *** ; Show_Bargraph: btfsc Mute_L goto Show_BG_Muted movlw 40 call Set_LCD_Cursor movf Vol_L, W subwf Vol_R, W btfsc CARRY goto BG_Show_Left movf Vol_R, W sublw d'78' goto BG_Show BG_Show_Left: movf Vol_L, W sublw d'78' BG_Show: movwf remainder clrf quotient BG_Show_Div_Loop: incf quotient movlw 5 subwf remainder, F btfsc CARRY goto BG_Show_Div_Loop decf quotient movlw 5 addwf remainder, F Bargraph_Loop: movf quotient, W btfsc ZERO goto Bargraph_Loop_End movlw 0FFh call Write_LCD decfsz quotient goto Bargraph_Loop Bargraph_Loop_End: movf remainder, W call Write_LCD return Show_BG_Muted: movlw 45 call Set_LCD_Cursor ;call Show_Mute ;Fall through to Show_Mute ; ; *** Show the string "" at the current cursor pos. *** ; Show_Mute: movlw '<' call Write_LCD movlw 'M' call Write_LCD movlw 'U' call Write_LCD movlw 'T' call Write_LCD movlw 'E' call Write_LCD movlw '>' call Write_LCD return ;Entry point is here... start: clrf RC5_Bit_Count clrf RC5_Command clrf PORTA clrf PORTB SEL_BANK_1 ; movlw b'11010000' movlw b'11010011' andwf OPTION_REG, F bcf OPTION_REG, NOT_RBPU;Enable pullups bcf OPTION_REG, INTEDG ;Falling edge interrupt movlw b'11111001' ;RB1 and 2 are outputs, rest inputs movwf TRISB movlw b'00000000' ;All of port A are outputs movwf TRISA SEL_BANK_0 clrf LED_Port call Write_4094 movlw h'FF' ;Total of 512ms delay (for LCD and spkr relay) movwf temp2 wait_loop: call Wait_2ms decfsz temp2 goto wait_loop call Read_From_RTC ;Get all params from DS1302 NVRAM bsf SPI_CLK bsf DS1305_CE ;Start the transfer movlw 8Fh call Write_RTC ;Send Address for Control Reg write movlw b'00000011' call Write_RTC ;Osc. enable, write enable, no alarms call Write_RTC ;Write dummy to status reg. movlw b'10101001' ;Enable trickle chg, 2 diodes, 2k resisitor call Write_RTC ;Write the power ctl. register bcf DS1305_CE ;End transfer ;Write the new data to the preamp call Set_Src_and_Bass call Set_Volume bcf LCD_REGSEL ;select cmd reg call Write_4094 movlw b'00110000' ;LCD Init sequence call Write_LCD movlw b'00110000' call Write_LCD movlw b'00110000' call Write_LCD movlw b'00111000' ;For 1 line (on 1x16) or 2 line (on 2x16) ;movlw b'00110100' ;For 1 line on 2x16 call Write_LCD movlw b'00000001' call Write_LCD call Wait_2ms movlw b'00000110' call Write_LCD ;movlw b'00001110' ;underline cursor movlw b'00001100' ;no cursor call Write_LCD bsf LCD_REGSEL ;select data reg call Write_4094 clrf temp3 movwf quotient ;Save W bcf LCD_REGSEL ;select cmd reg call Write_4094 movlw b'01000000' call Write_LCD bsf LCD_REGSEL ;select data reg call Write_4094 movlw 0 call Set_LCD_CGRAM movlw 10h call Set_LCD_CGRAM movlw 18h call Set_LCD_CGRAM movlw 1Ch call Set_LCD_CGRAM movlw 1Eh call Set_LCD_CGRAM clrf Cmd idle_loop: ;clrwdt bsf LED_0 btfss Headphone_SW bcf LED_0 call Wait_2ms decf key_pacifier, F btfsc ZERO bsf Key_Rdy btfss Key_Rdy ;If keyboard is ready, dont skip over the button check. goto nobutton movlw KYB_RPT movwf key_pacifier andwf PORTB, W ;Find out if front panel buttons were pressed sublw 70h btfsc ZERO goto nobutton bcf Key_Rdy ;Keypad is locked out for the next KYB_RPT*2 ms. clrw btfss Button_Inc movlw 01h ;dispatch increment cmd btfss Button_Dec movlw 02h ;dispatch decrement cmd btfss Button_Menu movlw 03h ;dispatch menu cmd movwf Cmd ;Store into Cmd command_jumptable: if ((command_jumptable < 100) || (command_jumptable > 1FF)) error "command handler jump table not in bank 1" endif nobutton: movlw 01h movwf PCLATH movf Cmd, W ;Get Current Command addwf PCL, F ;Set up a jump Table goto show_time ;Cmd=0 means no command, keep waiting goto handle_inc ;Cmd=1 means '+' button is pushed goto handle_dec ;Cmd=2 means '-' button is pushed goto handle_menu ;Cmd=3 means Menu cmd goto handle_mute ;Cmd=4 is Mute command goto handle_center ;Cmd=5 is Center command goto idle_loop show_time: movf MenuNum btfsc ZERO goto st_disp_time call Get_Menu_Time movwf temp movf MenuTime, W subwf temp, W ;Find out (temp - MenuTime) btfss CARRY goto st_clear_menu ;clear menu if seconds roll over sublw 04h ;Find out 4 - W btfsc CARRY goto idle_loop ;no overflow, so 4 seconds not yet up. st_clear_menu: clrf MenuNum ;Make current menu blank ; movlw 07h ; call Set_LCD_Cursor ; movlw ' ' ; call Write_LCD ; movlw 08h ; call Set_LCD_Cursor call LCD_Cls ; movlw 08h ; movwf temp2 ;st_clear_disp_loop: ; movlw ' ' ; call Write_LCD ; decfsz temp2 ; goto st_clear_disp_loop st_disp_time: movlw 02h call Set_LCD_Cursor movlw 02h call RTC_Read ;read hours call Disp_Hex movlw ':' ;Show the colon call Write_LCD movlw 01h call RTC_Read ;read minutes call Disp_Hex movlw ':' ;Show the colon call Write_LCD movlw 00h call RTC_Read ;read seconds call Disp_Hex movlw ' ' call Write_LCD movf TapeMon, W btfss ZERO goto ShowSourceAsTape call Show_Source goto ShowSourceContinue ShowSourceAsTape: ;movf TapeMon, W call Show_TapeMon ShowSourceContinue: call Show_Bargraph goto idle_loop handle_menu: clrf Cmd incf MenuNum, F btfss Time_Set_Mode ;If we're setting time, bend rules goto Not_Time_Set ;Now we're setting the time, so if the menu is 07h (set hours), allow ; menu to be incremented, else set menu to zero and get out of time mode movlw 08h subwf MenuNum, W btfsc ZERO goto show_current_menu ;We're in time set mode and moving from ;'set hours' to 'set minutes' clrf MenuNum ;take down the menu... bcf Time_Set_Mode ;no longer setting time goto st_clear_menu Not_Time_Set: movlw 07h subwf MenuNum, W btfss CARRY goto Menu_LT_7 movlw 01h movwf MenuNum Menu_LT_7: show_current_menu: ;some cmds jump here... call Save_To_RTC ;Save all params to NVRAM call LCD_Cls call Show_Bargraph call Get_Menu_Time ;Get the menu time movwf MenuTime ;and store it movf MenuNum, W movwf temp3 ;temp3 stores the table offset decf temp3, F bcf CARRY rlf temp3, F ;Multiply by 8 rlf temp3, F ;to select the menu number rlf temp3, F clrw call Set_LCD_Cursor clrf temp2 msg_loop: movf temp2, W ;offset within the menu addwf temp3, W ;Add the menu number ;call Menu_Text ;Get the menu char movwf EEADR ;Send the offset as the address SEL_BANK_1 bsf EECON1, RD SEL_BANK_0 movf EEDATA, W ;Copy data read from EEPROM to W call Write_LCD ;Show on screen incf temp2, F ;Increment the offset movf temp2, W sublw d'8' ;until it's = 8 btfss ZERO goto msg_loop menu_draw_done: movlw d'9' call Set_LCD_Cursor movlw 08h movwf temp3 clear_data_area_loop: movlw ' ' call Write_LCD decfsz temp3 goto clear_data_area_loop movlw d'9' call Set_LCD_Cursor menu_jumptable: if ((menu_jumptable < 200) || (menu_jumptable > 2FF)) error "menu handler jump table not in bank 2" endif movlw 02h movwf PCLATH movlw 01h subwf MenuNum, W ;Get Current Menu - 1 addwf PCL, F ;Set up a jump Table goto Volume_Menu goto Balance_Menu goto Bass_Menu goto Source_Menu goto TapeMon_Menu goto Set_Time goto Set_Hrs goto Set_Min Volume_Menu: btfsc Mute_L goto Vol_Menu_Muted movf Vol_L, W subwf Vol_R, W btfsc CARRY goto Vol_Show_Left movf Vol_R, W sublw d'78' call Disp_Dec goto idle_loop Vol_Show_Left: movf Vol_L, W sublw d'78' call Disp_Dec goto idle_loop Vol_Menu_Muted: call Show_Mute goto idle_loop Balance_Menu: movf Vol_R, W subwf Vol_L, W btfsc ZERO goto Balance_Show_Centered btfss CARRY goto Balance_Show_Left movlw 'R' call Write_LCD movf Vol_R, W subwf Vol_L, W call Disp_Dec goto idle_loop Balance_Show_Left: movlw 'L' call Write_LCD movf Vol_L, W subwf Vol_R, W call Disp_Dec goto idle_loop Balance_Show_Centered: movlw 'C' call Write_LCD movlw 'e' call Write_LCD movlw 'n' call Write_LCD movlw 't' call Write_LCD movlw 'e' call Write_LCD movlw 'r' call Write_LCD goto idle_loop Bass_Menu: clrf temp2 movf BassLevel, W movwf temp3 bcf CARRY rlf temp3, F rlf temp3, F bass_msg_loop: movf temp2, W addwf temp3, W call Bass_Text call Write_LCD ;Show on screen incf temp2, F ;Increment the offset movf temp2, W sublw d'4' ;until it's = 4 btfss ZERO goto bass_msg_loop goto idle_loop Source_Menu: call Show_Source goto idle_loop TapeMon_Menu: movf TapeMon, W call Show_TapeMon goto idle_loop Set_Time: movlw ' ' call Write_LCD movlw '+' call Write_LCD movlw '~' ;'~' prints on the LCD as a right arrow. call Write_LCD movlw 'S' call Write_LCD movlw 'e' call Write_LCD movlw 't' call Write_LCD goto idle_loop Set_Hrs: movf st_hrs, W goto Set_Min_Write Set_Min: movf st_min, W Set_Min_Write: call Disp_Dec goto idle_loop handle_inc: handle_dec: decf Cmd, F incdec_jumptable: if ((incdec_jumptable < 200) || (incdec_jumptable > 2FF)) error "menu handler jump table not in bank 2" endif movlw 02h movwf PCLATH movf MenuNum, W addwf PCL, F ;Set up a jump Table goto NoMenu_IncDec ;If no menu is selected, make it volume goto Volume_IncDec goto Balance_IncDec goto Bass_IncDec goto Source_IncDec goto TapeMon_IncDec goto Set_Time_IncDec goto Set_Hrs_IncDec goto Set_Min_IncDec NoMenu_IncDec: movlw 01h movwf MenuNum ;Make current menu 'volume' ;Fall through to volume handler Volume_IncDec: bcf Mute_L ;Un-mute both channels on vol change bcf Mute_R movf Cmd, F btfsc ZERO goto Volume_Dec incf Vol_L, F ;Increment left volume movlw 4Fh subwf Vol_L, W movlw 4Eh btfsc CARRY movwf Vol_L incf Vol_R, F ;Increment right volume movlw 4Fh subwf Vol_R, W movlw 4Eh btfsc CARRY movwf Vol_R goto Volume_Set Volume_Dec: movf Vol_L, F ;Decrement left volume btfss ZERO decf Vol_L, F movf Vol_R, F ;Decrement right volume btfss ZERO decf Vol_R, F Volume_Set: clrf Cmd call Set_Volume goto show_current_menu Set_Volume: bcf LM1973_CE movlw 01h call Write_Vol movf Vol_L, W call Write_Vol bsf LM1973_CE bcf LM1973_CE movlw 00h call Write_Vol movf Vol_R, W call Write_Vol bsf LM1973_CE return Balance_IncDec: movf Cmd, F btfsc ZERO goto Balance_Inc movf Vol_L, W subwf Vol_R, W btfsc CARRY goto Bal_Dec_Left_GT movf Vol_L, F ;Decrement left vol only if it's not 0 btfss ZERO decf Vol_L goto Balance_Set Bal_Dec_Left_GT: incf Vol_R, F ;Increment right volume movlw 4Fh subwf Vol_R, W movlw 4Eh ;Safety check btfsc CARRY movwf Vol_R goto Balance_Set Balance_Inc: movf Vol_R, W subwf Vol_L, W btfsc CARRY goto Bal_Inc_Left_GT movf Vol_R ;Decrement right only if it's not 0 btfss ZERO decf Vol_R goto Balance_Set Bal_Inc_Left_GT: incf Vol_L, F ;Increment left volume movlw 4Fh subwf Vol_L, W movlw 4Eh btfsc CARRY movwf Vol_L Balance_Set: clrf Cmd ;go set Vol_L and Vol_R in the LM1973 ;At the end, show_current_menu is called, so it shd show the balance, ; not the volume. goto Volume_Set Bass_IncDec: movf Cmd, F btfss ZERO goto Bass_Dec incf BassLevel, F movlw 3h subwf BassLevel, W movlw 2h btfsc CARRY movwf BassLevel Set_SrcBass_and_Show: call Set_Src_and_Bass goto show_current_menu Bass_Dec: movf BassLevel, F btfss ZERO decf BassLevel, F goto Set_SrcBass_and_Show Source_IncDec: movf Cmd, F btfss ZERO goto Source_Dec ;increment incf Source, F movlw 3h subwf Source, W movlw 2h btfsc CARRY movwf Source goto Set_SrcBass_and_Show Source_Dec: movf Source, F btfss ZERO decf Source, F goto Set_SrcBass_and_Show TapeMon_IncDec: movf Cmd, F btfss ZERO goto TapeMon_Dec ;increment incf TapeMon, F movlw 3h subwf TapeMon, W movlw 2h btfsc CARRY movwf TapeMon goto Set_SrcBass_and_Show TapeMon_Dec: movf TapeMon, F btfss ZERO decf TapeMon, F goto Set_SrcBass_and_Show Set_Src_and_Bass: clrf Cmd movlw b'10000001' ; .......x LCD Reg. Select ; .....xx. Source ; ...xx... Bass Boost ; .xx..... Tape Monitor ; x....... Speaker Mute Relay andwf LED_Port, F bcf CARRY rlf BassLevel, W iorwf LED_Port, F bcf CARRY rlf Source, W ;That's one shift, into W movwf temp2 ;copy that shifted version into temp2 rlf temp2, F ;shift once more, keep in temp2 rlf temp2, W ;shift last time, into W iorwf LED_Port, F ;Write it to LED_Port movf TapeMon, W sublw 2 movwf temp2 ;copy 2 - TapeMon to temp2 bcf CARRY rlf temp2, F ;shift once more, keep in temp2 rlf temp2, F ;shift once more, keep in temp2 rlf temp2, F ;shift once more, keep in temp2 rlf temp2, F ;shift once more, keep in temp2 rlf temp2, W ;shift last time, into W iorwf LED_Port, F ;Write it to LED_Port call Write_4094 return Set_Time_IncDec: clrf Cmd movlw 01h call RTC_Read ;Get minutes call BCD_2_Bin ;Convert to binary movwf st_min movlw 02h call RTC_Read ;Get hours call BCD_2_Bin ;Convert to binary movwf st_hrs incf MenuNum ;Move into Set Hours menu bsf Time_Set_Mode ;Enable timeset mode (for menu logic) goto show_current_menu Set_Hrs_IncDec: movf Cmd, F btfss ZERO goto Set_Hrs_Dec incf st_hrs, F movlw d'24' ;Check for bounds subwf st_hrs, W btfsc ZERO clrf st_hrs goto set_time_update Set_Hrs_Dec: movf st_hrs, W btfss ZERO goto sh_dec_cont movlw d'23' movwf st_hrs goto set_time_update sh_dec_cont: decf st_hrs goto set_time_update Set_Min_IncDec: movf Cmd, F btfss ZERO goto Set_Min_Dec incf st_min, F movlw d'60' ;Check for bounds subwf st_min, W btfsc ZERO clrf st_min goto set_time_update Set_Min_Dec: movf st_min, W btfss ZERO goto sm_dec_cont movlw d'59' movwf st_min goto set_time_update sm_dec_cont: decf st_min set_time_update: clrf Cmd bsf SPI_CLK bsf DS1305_CE ;Start the transfer movlw 80h call Write_RTC ;Send Address for write seconds movlw 0 call Write_RTC ;Write seconds (set to zero) movf st_min, W call Dec_2_BCD ;convert to BCD call Write_RTC ;Write minutes movf st_hrs, W call Dec_2_BCD ;convert to BCD call Write_RTC ;Write hours bcf DS1305_CE ;End transfer goto show_current_menu handle_mute: clrf Cmd clrf MenuNum ;Set menu to Volume incf MenuNum, F btfsc Mute_L goto Muted bsf Mute_L bsf Mute_R goto Volume_Set Muted: bcf Mute_L bcf Mute_R goto Volume_Set handle_center clrf Cmd movlw 02h movwf MenuNum movf Vol_R, W ;Find out which volume is greater subwf Vol_L, W btfss CARRY goto Handle_Center_Left movf Vol_R, W ;...and copy it to the other one movwf Vol_L goto Volume_Set Handle_Center_Left: movf Vol_L, W movwf Vol_R goto Volume_Set ; ; *** Show the current source at the current cursor pos. *** ; Show_Source: movf Source, W movwf temp3 ;temp3 stores the table offset bcf CARRY rlf temp3, F ;Multiply by 4 rlf temp3, F ;to select the menu number clrf temp2 source_text_loop: movf temp2, W ;offset within the menu addwf temp3, W ;Add the menu number call Source_Text ;Get the source name char call Write_LCD ;Show on screen incf temp2, F ;Increment the offset movf temp2, W sublw d'4' ;until it's = 4 btfss ZERO goto source_text_loop return ; ; *** Show TapeMonitor in W at the current cursor pos. *** ; Show_TapeMon: movwf temp3 ;temp3 stores the table offset bcf CARRY rlf temp3, F ;Multiply by 4 rlf temp3, F ;to select the menu number movlw 4 movwf temp2 TapeMon_text_loop: movf temp3, W ;offset within the menu call TapeMon_Text ;Get the source name char call Write_LCD ;Show on screen incf temp3, F ;Increment the offset decfsz temp2 goto TapeMon_text_loop return ; ; *** Tables *** ; org h'03CD' Bass_Text: movwf temp movlw 03h movwf PCLATH movf temp, W addwf PCL, F dt "Off " dt "Med." dt "High" Source_Text: movwf temp movlw 03h movwf PCLATH movf temp, W addwf PCL, F dt "CD " dt "Aux1" dt "Aux2" TapeMon_Text: movwf temp movlw 03h movwf PCLATH movf temp, W addwf PCL, F dt "Src." dt "Tape" dt "DNR " ; ; *** Main menu *** ; ; Note: this table is stored in the ; PIC's EEPROM, not in the Flash ; ORG h'2100' de " Volume:" ;1 de "Balance:" ;2 de " Bass:" ;3 de " Source:" ;4 de "Monitor:" ;5 de "SetTime:" ;6 de "Set Hrs:" ;7 de "Set Min:" ;8 end