'///////////////////////////////////////////////////////////////////////////////////////
'///  FastAVR Basic Compiler for AVR by MICRODESIGN  www.FastAVR.com                 ///
'///  TagReader.bas   Wireless ReadOnly TAG reader (Miro,......)                     /// 
'///  using Phillips chip HTRC110                                                    ///
'///  readOnly Tags gas 64 bit unique number (manchester coded wireless)             ///
'///  continious reads Tags and comunicate result via RS-485                         ///
'///////////////////////////////////////////////////////////////////////////////////////
$Device  = 4433							' used device
$Stack   = 32							' stack depth
$Clock   = 8							' adjust for used crystal
$Timer0  = Timer, Prescale=64
$Timer1  = Timer, Prescale=256, Compare=DisConnect, Clear
$Baud=19200

$Def RTX=PORTD.4

$Def DOUT = PIND.2
$Def SCLK = PORTB.2
$Def DIN = PORTB.1

$Def Z=PORTD.6
$Def R=PORTD.7
'$Def Z=PORTB.4
'$Def R=PORTB.5

$Def xx=PORTB.0

Declare Sub Init()
Declare Sub SendCmd(db As Byte)
Declare Sub ASTadjust(Offset As Byte)
Declare Sub SetSampTime(Stime As Byte)
Declare Sub GeneralSetling()
Declare Sub MakeCmd(pCmd As Byte, adr As Byte)
Declare Sub ReceiveMIRO()
Declare Sub ProcessCommand()
Declare Sub SendID()
Declare Sub SendBack(Data As Byte)

Declare Function GetSerNumber() As Byte
Declare Function LastParCheck() As Byte
Declare Function ReceiveData() As Byte
Declare Function ReadPhase() As Byte
Declare Function CalcCrc(ptr As Byte, j As Byte) As Byte

Declare Interrupt Oc1A()
Declare Interrupt Int0()
Declare Interrupt Urxc()
Declare Interrupt Utxc()

Dim TXbuff(12) As Byte, TXlen As Byte, TXn As Byte, Char As Byte, x As Byte
Dim RXbuff(8) As Byte, RXlen As Byte, c(7) As Byte
Dim ID(8) As Byte, ReadyID(8) As Byte, Crc As Byte

Dim OldTime As Byte, BitNum As Byte, State As Byte
Dim ByteNum As Byte, DataByte As Byte
Dim OldBit As Byte, NewBit As Byte
Dim Adr As Byte, Time As Byte
Dim db As Byte
Dim Crc8Tab As Flash Byte

Dim Bussy As Bit, ParBit As Bit, DataBit As Bit
Dim Flanka As Bit, GorDol As Bit, ByteFull As Bit
Dim Kratek As Bit, Escape As Bit, Received As Bit
Dim b As Bit, TimeOut As Bit

Const WriteDIN=&hc0, ReadDIN =&he0

Const True=1, False=0, Frame=&h7e, ESC=&h7d

Const StartBits=0, SerialNum=1, ParCheck=2, StopBit=3, Error=4

Const cmdWriteNum=&h55, cmdReadNum=&h33
Const cmdWritePage=&h50, cmdReadPage=&h56
Const cmdReadID=&h8e

Init()
Set DDRD.7: Set DDRD.6	' here are LEDs
'Set DDRB.4: Set DDRB.5:
Set z: Set r	' here are LEDs
Set DDRB.0

SendCmd(&h16)			' write pages to HTRC110
SendCmd(&h4f)
SendCmd(&h50)
SendCmd(&h60)
SendCmd(&h71)
'Do
	ASTadjust(&h3f)
	GeneralSetling()
	WaitMs 3
	SendCmd(&h69)
	SendCmd(WriteDIN)
	WaitUs 25
	SendCmd(&h6b)
	WaitUs 30
	SendCmd(&h60)
	SendCmd(ReadDIN)
Do
	ReceiveMIRO()			' decode manchester coded ID
	
Loop

'///////////////////////////////////////////////////////////////////////////////////////
Sub Init()
Set DDRB.1: Set DDRB.2: Set DDRD.4
Set DIN: Escape=False
'WriteEE(1,18)
Compare1=&h0c35			'  100 ms
Start Timer0
Start Timer1
Int0 Falling
Enable Urxc
Enable Interrupts
ByteFull=False: BitNum=0: RXlen=0: TXn=0
End Sub

'///////////////////////////////////////////////////////////////////////////////////////
Sub ReceiveMIRO()
Local Delta As Byte, CurTime As Byte

ByteNum=0: State=StartBits
TimeOut=False: DataByte=0: ParBit=0
Reset Int0: Enable Int0
Timer1=0: Enable Oc1A
Do

	If Flanka Then							' waiting for interrupt
		Flanka=False
		' measuring time beetween transitions
		CurTime=Timer0:	Delta=CurTime-OldTime: OldTime=CurTime
		If GorDol Then						' change Int0 trigg
			Int0 Rising: GorDol=False
		Else
			Int0 Falling: GorDol=True
		End If
	
		If Delta>18 And Delta<46 Then				' short bit
			DataBit=0
		ElseIf Delta>48 And Delta<82 Then			' long bit
			DataBit=1
		Else
			State=StartBits							' error
		End If
	
		If Not DataBit And GorDol Then 				' after short0
			NewBit=0
		ElseIf Not DataBit And Not GorDol Then		' after short1
			NewBit=1
		ElseIf DataBit And GorDol Then				' after long0
			NewBit=2
		Else										' after long1
			NewBit=3
		End If
	
		If Kratek Then			' if short then get another
			OldBit=NewBit
			Kratek=False
		Else
			Kratek=True
		
			If OldBit=0 And NewBit=1 Then DataBit=1	' logical bits
			If OldBit=0 And NewBit=3 Then DataBit=1
			If OldBit=1 And NewBit=0 Then DataBit=0
			If OldBit=1 And NewBit=2 Then DataBit=0
			If OldBit=2 And NewBit=1 Then DataBit=1
			If OldBit=2 And NewBit=3 Then DataBit=1
			If OldBit=3 And NewBit=0 Then DataBit=0
			If OldBit=3 And NewBit=2 Then DataBit=0

			If NewBit=2 Or NewBit=3 Then	' if last bit was long
				Kratek=False				' must be used also next time
				OldBit=NewBit
			End If
	
			Select Case State
				Case StartBits					' wait for 9 start bits (1)
					If DataBit Then					
						Incr BitNum
						If BitNum=9 Then		' found, advanced State
							BitNum=0
							State=SerialNum
						End If
					Else						' not found 9 1s
						BitNum=0				' start again
					End If
					
				Case SerialNum
					GetSerNumber()				' Get ID and check
												' Rows parity bits
				Case ParCheck
					Shift(Left, 1, DataByte)	' receiving last 5 bits
					DataByte.0=DataBit			' DataByte=---43210
					Incr BitNum					'                 ^ Stop
					If BitNum=5 Then			'             ^^^^  
						BitNum=0				'        Column parity
						LastParCheck()			' check this 5 bits
					End If						' if no Errors
					
				Case StopBit
					If DataByte.0 Then			' if last bit=1 
						State=Error				' error, Error
					Else
						Set Z: Reset R
						MemCopy(5, VarPtr(ID), VarPtr(ReadyID))
						Exit Do
					End If
					
				Case Error						' to Main loop after
					Exit Do						' any Error
					
			End Select
		End If
	
	End If
	
	If TimeOut Then				' after 100 ms
		TimeOut=False			' we clear last ID
		ReadyID(1)=0:ReadyID(2)=0:ReadyID(3)=0:ReadyID(4)=0
		Set R: Reset Z			
		Exit Do
	End If

	If UCSRA.Udre And TXn<TXlen Then	' have we something to transmit
		Set RTX							' yes, so switch 485 to TX
		PrintBin Peek(VarPtr(TXbuff)+TXn)	' send byte
		Incr TXn							' increment pointer to next
		If TXn=TXlen Then Enable Utxc		' if last byte then enable
	End If								' TX interrupt (to switch 485 back)

	If Received Then ProcessCommand()	' proccess request
	
Loop
Disable Oc1A: Disable Int0
End Sub

'///////////////////////////////////////////////////////////////////////////////////////
Sub GetSerNumber()				' decodes 5 bytes ID

Incr BitNum
If BitNum=5 Then				' every 4 bits is column parity
	BitNum=0
	If DataBit<>ParBit Then 	' parity dont match, so
		State=Error
	End If
	ParBit=0
	If ByteFull Then			' received 8 bits, so
		ID(ByteNum)=DataByte	' save it to array
		DataByte=0
		ByteFull=False
		Incr ByteNum
		If ByteNum=5 Then		' ID received
			State=ParCheck		' proccess next 5 parity bits
			ByteNum=0
		End If
	Else
		ByteFull=True
	End If
Else
	Shift(Left, 1, DataByte)	' continue receiving bits
	DataByte.0=DataBit
	ParBit=ParBit Xor DataBit
End If	
End Sub

'///////////////////////////////////////////////////////////////////////////////////////
Sub LastParCheck()		' check column parity bits
Local i As Byte

BitNum=1: NewBit=0

NextPar:
	parbit=0
	OldBit=NewBit+4
	For i=0 To 4
		db=ID(i)
		b=db.OldBit
		ParBit=ParBit Xor b
		b=db.NewBit
		ParBit=ParBit Xor b
	Next
	b=DataByte.BitNum
	If ParBit<>b Then
		State=Error
		Exit Sub
	End If
	Incr BitNum: Incr NewBit
	If NewBit<4 Then GoTo NextPar
	
State=StopBit
End Sub

'///////////////////////////////////////////////////////////////////////////////////////
Sub SendCmd(db As Byte)
Local i As Byte

Reset DIN: Set SCLK: Set DIN: Reset SCLK
If db>&hbf Then
	i=3
Else
	i=8
End If	
Do
	DIN=db.7
	Set SCLK
	Shift(Left, 1, db)
	Reset SCLK
	Decr i
Loop While i
Reset DIN
End Sub

'///////////////////////////////////////////////////////////////////////////////////////
Function ReceiveData() As Byte
Local tmp As Byte, i As Byte

For i=0 To 7
	Set SCLK: WaitUs 1
	Shift(Left,1,tmp)
	tmp.0=DOUT
	Reset SCLK: WaitUs 1
Next
Return tmp
End Function

'///////////////////////////////////////////////////////////////////////////////////////
Function ReadPhase() As Byte
SendCmd(&h08)
Return ReceiveData()
End Function

'///////////////////////////////////////////////////////////////////////////////////////
Sub ASTadjust(Offset As Byte)
Local tmp As Byte

tmp=ReadPhase()
Shift(Left, 1, tmp)
tmp=tmp+Offset
tmp=tmp And &h3f
SetSampTime(tmp)
End Sub

'///////////////////////////////////////////////////////////////////////////////////////
Sub SetSampTime(Stime As Byte)
SendCmd((&h80 Or Stime))
End Sub

'///////////////////////////////////////////////////////////////////////////////////////
Sub GeneralSetling()
SendCmd(&h6b)
WaitMs 5
SendCmd(&h68)
WaitMs 1
SendCmd(&h60)
End Sub

'///////////////////////////////////////////////////////////////////////////////////////
Interrupt Int0()			' trigg with manchester coded signal
Flanka=True
End Interrupt

'///////////////////////////////////////////////////////////////////////////////////////
Interrupt Oc1A()			' generate 100 ms timeout
TimeOut=True
End Interrupt

'///////////////////////////////////////////////////////////////////////////////////////
Interrupt Utxc(), Save 1	' need to know when to switch 485 back
Reset RTX					' to receive
Disable Utxc
End Interrupt

'///////////////////////////////////////////////////////////////////////////////////////
Interrupt Urxc(), Save 4	' saves received char in ID
Local tmp As Byte

InputBin tmp
Select Case tmp
	Case Frame			' ~
		If CalcCrc(VarPtr(RXbuff), RXlen)=0 Then
			If RXbuff(0)=ReadEE(1) Or RXbuff(0)=&hff Then 
				Received=True
			End If
		End If
		
	Case ESC
		Escape=True		' }

	Case Else
		If Escape Then
			tmp=tmp Xor &h20
			Escape=False
		End If
		Poke(VarPtr(RXbuff)+RXlen, tmp)
		Incr RXlen
		
End Select
End Interrupt

'///////////////////////////////////////////////////////////////////////////////////////
Sub ProcessCommand()	' cmd is RXbuff(1)
Local Data As Byte

Select Case RXbuff(1)
	Case cmdReadID
		SendID()
	Case cmdWriteNum
		If RXbuff(0)=&hff And RXlen=4 Then
			Data=RXbuff(2)
			WriteEE(1,Data)
			SendBack(Data)
		End If
	Case cmdReadNum
		SendBack(ReadEE(1))
End Select
Received=False: RXlen=0
End Sub

'///////////////////////////////////////////////////////////////////////////////////////
Sub SendBack(Data As Byte)
Set xx
TXbuff(0)=Data
TXbuff(1)=Frame
WaitMs 1
Reset xx
TXlen=2: TXn=0
End Sub

'///////////////////////////////////////////////////////////////////////////////////////
Sub SendID()	' builds ID packet
Local i As Byte, j As Byte, Data As Byte

j=1
TXbuff(0)=ReadEE(1)
For i=1 To 4
	Data=ReadyID(i)
	Select Case Data
		Case Frame		' if data=~ then esc them
			TXbuff(j)=ESC: Incr j
			TXbuff(j)=&h5e
		Case ESC		' if data=esc then esc them
			TXbuff(j)=ESC: Incr j
			TXbuff(j)=&h5d
		Case Else
			TXbuff(j)=Data
	End Select
	Incr j
Next
TXbuff(j)=CalcCrc(VarPtr(TXbuff),j): Incr j
TXbuff(j)=Frame: Incr j		
TXlen=j: TXn=0			' this defference drives TX
End Sub

'///////////////////////////////////////////////////////////////////////////////////////
Function CalcCrc(ptr As Byte, j As Byte) As Byte
Local crc As Byte, tmp As Byte, i As Byte

crc=0: i=0
While i<j
	tmp=crc Xor Peek(ptr)
	crc=Crc8Tab(tmp)
	Incr i: Incr ptr
Wend
Return crc
End Function

'///////////////////////////////////////////////////////////////////////////////////////
Crc8Tab=&h00,&h5E,&hBC,&hE2,&h61,&h3F,&hDD,&h83,&hC2,&h9C,&h7E,&h20,&hA3,&hFD,&h1F,&h41,
		&h9D,&hC3,&h21,&h7F,&hFC,&hA2,&h40,&h1E,&h5F,&h01,&hE3,&hBD,&h3E,&h60,&h82,&hDC,
		&h23,&h7D,&h9F,&hC1,&h42,&h1C,&hFE,&hA0,&hE1,&hBF,&h5D,&h03,&h80,&hDE,&h3C,&h62,
		&hBE,&hE0,&h02,&h5C,&hDF,&h81,&h63,&h3D,&h7C,&h22,&hC0,&h9E,&h1D,&h43,&hA1,&hFF,
		&h46,&h18,&hFA,&hA4,&h27,&h79,&h9B,&hC5,&h84,&hDA,&h38,&h66,&hE5,&hBB,&h59,&h07,
		&hDB,&h85,&h67,&h39,&hBA,&hE4,&h06,&h58,&h19,&h47,&hA5,&hFB,&h78,&h26,&hC4,&h9A,
		&h65,&h3B,&hD9,&h87,&h04,&h5A,&hB8,&hE6,&hA7,&hF9,&h1B,&h45,&hC6,&h98,&h7A,&h24,
		&hF8,&hA6,&h44,&h1A,&h99,&hC7,&h25,&h7B,&h3A,&h64,&h86,&hD8,&h5B,&h05,&hE7,&hB9,
		&h8C,&hD2,&h30,&h6E,&hED,&hB3,&h51,&h0F,&h4E,&h10,&hF2,&hAC,&h2F,&h71,&h93,&hCD,
		&h11,&h4F,&hAD,&hF3,&h70,&h2E,&hCC,&h92,&hD3,&h8D,&h6F,&h31,&hB2,&hEC,&h0E,&h50,
		&hAF,&hF1,&h13,&h4D,&hCE,&h90,&h72,&h2C,&h6D,&h33,&hD1,&h8F,&h0C,&h52,&hB0,&hEE,
		&h32,&h6C,&h8E,&hD0,&h53,&h0D,&hEF,&hB1,&hF0,&hAE,&h4C,&h12,&h91,&hCF,&h2D,&h73,
		&hCA,&h94,&h76,&h28,&hAB,&hF5,&h17,&h49,&h08,&h56,&hB4,&hEA,&h69,&h37,&hD5,&h8B,
		&h57,&h09,&hEB,&hB5,&h36,&h68,&h8A,&hD4,&h95,&hCB,&h29,&h77,&hF4,&hAA,&h48,&h16,
		&hE9,&hB7,&h55,&h0B,&h88,&hD6,&h34,&h6A,&h2B,&h75,&h97,&hC9,&h4A,&h14,&hF6,&hA8,
		&h74,&h2A,&hC8,&h96,&h15,&h4B,&hA9,&hF7,&hB6,&hE8,&h0A,&h54,&hD7,&h89,&h6B,&h35