'*********************************************
'* This Program Writing By : Behnam Razmi    *
'* Send code of Sony IR Remote Controls      *
'* For to get more details visit :           *
'*         WWW.ETRmodern.blogfa.com          *
'* Contact to me by : etrmodern@yahoo.com    *
'*********************************************

$regfile = "M16def.dat"
$crystal = 8000000

Dim Key As Byte
Dim Ir_frame As Byte
Dim Ir_bit As Byte
Dim Ir_data As Word

Const Carrier_on = &B01000000                               'IR 40kHz carrier on
Const Carrier_off = &B11000000                              'IR 40kHz carrier off

Const Ir_repeat = 3                                         'number code frames (at least 2)

Config Kbd = Porta , Debounce = 10 , Delay = 10             'keyboard connected at Port A of Mega16

Config Pind.5 = Output
Config Timer1 = Timer , Prescale = 1 , Compare A = Toggle , Clear Timer = 1
Timer1 = 0
Compare1a = 99                                              'OC1 = IR carrier = 40 kHz

Config Lcdpin = Pin , Db4 = Pinb.1 , Db5 = Pinb.2 , Db6 = Pinb.3 , _
 Db7 = Pinb.4 , Rs = Pinb.5 , E = Pinb.6
Config Lcd = 16 * 2
Cursor Off
Cls
Lcd "*  ETRmodern   *"
Waitms 500

Tccr1a = Carrier_off
'---[ main program loop ]-------------------------------------------------------
Do
  Key = Getkbd()
  Locate 2 , 4 : Lcd "Key=" ; Key ; "   "
  Waitms 1                                                  'small delay
  If Key < 16 Then                                          'test if key is pressed else key=16
    Ir_data = Lookup(key , Ir_code)                         'lookup pressed key IR Remote Code
    'Ddrd.5 = 1                                              'set OC1 (Pd.5 of Mega16) = IR carrier output
    Set Portd.5

'---[ convert and transmit Sony 12bit IR code ]---------------------------------

    For Ir_frame = 1 To Ir_repeat                           'number of code frames
      Tccr1a = Carrier_on
      Waitus 2400                                           'start = 2.4mS
      For Ir_bit = 0 To 11                                  '12 bit code, msb first
        Tccr1a = Carrier_off
        Waitus 600                                          '0.6mS delay
        Tccr1a = Carrier_on
        Waitus 600                                          '0.6mS delay
        If Ir_data.ir_bit = 1 Then Waitus 600               'if bit=1 then 1.2mS delay
      Next
      Tccr1a = Carrier_off
      Waitms 30                                             'frame gap 30mS delay
    Next
  End If
Loop
'-------------------------------------------------------------------------------
End

'*******************************************************************************

Ir_code:
Data &H1D1% , &H2D1% , &H3D1% , &H815%
Data &H4D1% , &H5D1% , &H6D1% , &H812%
Data &H7D1% , &H8D1% , &H9D1% , &H813%
Data &H4F1% , &HAD1% , &H814% , &H6F1%