TheBackShed.com

' IR Remote Control key recorder and translator
Sub MM.STARTUP :Run :End Sub
Const Fname$ = "IR Code Translator 01.bas"
Option base 0
Const IRin = MM.Info(pinno gp1) 'input from IR receiver
Const IRout = MM.Info(pinno gp0) 'outout to IR LED
SetPin IRout, Dout : Pin(IRout) = 0
SetPin IRin, IR

Dim integer K(255), Key.data=0, R.new=0, R.old=0, Set.def.key=0
'Key.data = flag to record codes (0) or send codes (1)
On Error skip
Settings 'replace defaults with recorded values if Sub Settings exists

Dim integer dev.out = R.old, new.IRremote = R.new
Dim integer dev.in, key.in, new.key, new.dev, x=0, ready = 1

Math set Set.def.key, K() 'set undefined keys to "Info" or other harmless key
CLS 255

On error skip
K.data 'Add key data from Sub K.data to K() - over-writing Math Set values for defined keys
Print
Print "settings - Key data recorded"; Key.data,"new device"; R.new,"old device"; R.old,"default key"; Set.def.key
Print
If Key.data Then ' if key data exists use it, else record it
Print "Sending translated Codes"
Text MM.HRes/2,MM.VRes*.5, " Ready ","CM",,2
Else
Print "Recording Codes to:- ";Fname$
Print "press a new remote key then same key on old remote"
Print "The first pair will be used as the default for any un-allocated keys."
Print " Use 'Info.' or other harmless key"
Print "repeat for all keys."
Print "Tap any console key when finished"
If Right$(Date$,3)="000" Then
Dim DT$
Line Input "Type the date ",DT$
Date$=DT$
Line Input "Type the time ",DT$
Time$=DT$
EndIf
Print " 'Recording keys at "+DateTime$(NOW)
On KEY Finished 'Tap a keyboard key to finish recording. Sub Finished completes the file & restarts.
Save Fname$ 'copy program to A:
Pause 500
Open Fname$ For append As #3 'prepare to add data to the program
Pause 30
EndIf

IR dev.in, key.in, IRint 'receive IR codes

Sub IRint 'respond to IR input
If ready Then
ready = 0 'only accept a code if processing of previous one is finished
new.dev = dev.in : new.key = key.in 'save codes to prevent changes during processing
If Key.data Then
If new.dev=R.new Then 'if new remote recorded code exist translate it and send it
NECsend IRout, R.old, K(new.key)
Text MM.HRes/2,MM.VRes*.3, " key in "+Str$(new.dev)+" "+Str$(new.key)+" ","CM",,2
Text MM.HRes/2,MM.VRes*.5, " Translated to:- ","CM",,2
Text MM.HRes/2,MM.VRes*.7, " key out "+Str$(dev.out)+" "+Str$(K(new.key))+" ","CM",,2
Print "in"; new.dev; new.key, "out"; dev.out; K(new.key)
EndIf
Else
log.codes 'if recorded codes don't exist, use Sub log.codes to record the key
EndIf
EndIf
ready = 1
End Sub

Do : Pause 10 : Loop ' spin the wheels between key presses

Sub log.codes

If (x = 0)And(R.new = 0) Then 'the first key press sets the new remote control
R.new = new.dev 'record device code of new remote
Print #3, : Print #3, "Sub K.data"
Print "now press coresponding old remote key "
Print #3, " 'Recorded "+DateTime$(NOW);
EndIf

If (x = 1)And(R.old = 0) Then 'the second key press sets the old remote control
R.old = new.dev 'record device code of old remote
Set.def.key = new.key 'set the default output key for any undefined input keys
EndIf

If (x Mod 2 = 0)And(new.dev = R.new) Then
first.key=new.key :first.dev=new.dev 'record the keys of the new remote control
Print "first dev-key = "; new.dev; new.key," Keys accepted so far = x "; x
EndIf

If (x Mod 2 = 0)And(new.dev = R.old)And(x > 1) Then
Print "Wrong Remote - use the New remote"; new.dev; new.key,," x = "; x
Exit Sub
EndIf

If x Mod 2 = 1 Then Print "second dev-key = "; new.dev; new.key,," x = "; x

If (x Mod 2 = 1)And(new.dev = R.new)And(x > 2) Then
Print "Wrong Remote - use the Old remote"; new.dev; new.key,," x = "; x
Exit Sub
EndIf

If x Mod 16 = 0 Then : Print #3, : Print #3," "; : EndIf 'limit line length to 8 pairs

If (x Mod 2 = 1)And(new.dev=R.old)And(first.dev=R.new) Then
Print #3, "K("+Str$(first.key)+")="+Str$(new.key); 'add the keys of the old remote control & save
If x Mod 16 <> 15 Then Print #3," : "; 'insert colon between records
Print " Key pair recorded - K("+Str$(first.key)+") = "+Str$(new.key)
EndIf
Inc x
Pause 333 'wait for any multiple key interups to pass
End Sub

Sub Finished 'add settings sub and restart program from saved file
On KEY 0
Print #3,
Print #3, "End Sub"
Print #3,
Print #3, "Sub settings"
Print #3, " Key.data=1 : R.new=" R.new" : R.old=" R.old" : Set.def.key=" Set.def.key
Print #3, "End Sub"
Pause 99
Close #3
Key.data=1
Print "Finished and data saved - ressarting program from file"
Pause 500
Run Fname$
End Sub

Sub NECsend IRout As integer, dev As integer, key As integer
Local integer word, d(2060), m, n = 1

word = (dev<<16) + (key<<8) + 255-key '32bit word = Device 16b + Key 8b + inverted Key 8b

Math set 13, d() 'fill array with half-cycles, 13uS = duration of a half cycle @ 38kHz
d(692) = 4500 'uS pause after 9mS of 38kHz to start

For m = 734 To 2058 Step 42 'load data after start sequence
d(m) = (((word>>(32-n)) And 1)*2 + 1) * 562.5'convert bits to pauses (0=562uS, 1=1687uS)
Inc n 'step to next data bit
Next

Device bitstream IRout, 2058, d() 'send the data

Pin(IRout) = 0
End Sub