10REM> TSDP2
   20MODE7
   30VDU23,1,0;0;0;0;
   40DIM mcode &500 :REM: space for machine code
   50DIM buff 40 :REM: TSDP buffer
   60PROCmcode :REM: assemble machine code
   70ttx$=CHR$(141)+CHR$(132)+CHR$(157)+CHR$(131)+"Television Service Data Packet 2  "+CHR$(156)
   80PRINTTAB(0,1)ttx$
   90PRINTTAB(0,2)ttx$
  100INPUTTAB(10,4)"TV channel (1-4) = "answer$
  110channel?0=EVAL("&"+LEFT$(answer$,1))+&1B
  120IF channel?0 < &1C THEN channel?0 = &1C
  130IF channel?0 > &1F THEN channel?0 = &1F
  140PRINTTAB(5,7)"TSDP type ="
  150PRINTTAB(5,8)"Initial page ="
  160PRINTTAB(5,9)"Network ID code ="
  170PRINTTAB(5,10)"Sound ="
  180PRINTTAB(5,11)"Rating ="
  190PRINTTAB(5,12)"Data ="
  200PRINTTAB(5,13)"Day ="
  210PRINTTAB(5,14)"Month ="
  220PRINTTAB(5,15)"Hours ="
  230PRINTTAB(5,16)"Minutes ="
  240PRINTTAB(5,17)"Country ="
  250PRINTTAB(5,18)"Source ="
  260PRINTTAB(5,19)"Message ="
  270CALL mcode :REM: enable TTX interrupts
  280ONERROR GOTO 320
  290REPEAT
  300IF grabflag?0=2 PROCdisplay
  310UNTIL FALSE
  320CALL mcode :REM: disable TTX interrupts
  330VDU31,0,21,23,1,1;0;0;0;
  340END
  350DEFPROCdisplay
  360PRINTTAB(17,7);buff?0 :REM: TSDP type
  370b0=((buff?4)AND8)<>0:REM: bit 0 of magazine number
  380b1=((buff?6)AND4)<>0:REM: bit 1 of magazine number
  390b2=((buff?6)AND8)<>0:REM: bit 2 of magazine number
  400init=0:REM: initial magazine number
  410IF b0 init=1
  420IF b1 init=init+2
  430IF b2 init=init+4
  440PRINTTAB(20,8);~init;:REM: initial magazine
  450PRINT;~buff?2;~buff?1;:REM: initial page
  460PRINT;" ";~((buff?6)AND3);~buff?5;~((buff?4)AND7);~buff?3:REM: initial sub-page
  470PRINTTAB(23,9);~buff?7;~buff?8;~buff?9;~buff?10 :REM: Network ID code
  480CALL reverse :REM: reverse bits in VPS
  490sound=((vps?0)AND192)DIV64
  500IF sound=0 OR sound=3 PRINTTAB(13,10)"two channel sound"
  510IF sound=1 PRINTTAB(13,10)"stereo"
  520IF sound=2 PRINTTAB(13,10)"mono"
  530rate=((vps?0)AND48)DIV16
  540IF rate=2 PRINTTAB(14,11)"unrated" ELSE PRINTTAB(14,11)"restricted" :REM: programme rating
  550valid=((vps?0)AND12)DIV4 :REM: data validity
  560IF valid>1 PRINTTAB(12,12)"valid" ELSE PRINTTAB(12,12)"invalid":GOTO 650
  570PRINTTAB(11,13);(((vps?0)AND3)*8)+(((vps?1)AND224)DIV32) :REM: day
  580PRINTTAB(13,14);((vps?1)AND30)DIV2 :REM: month
  590PRINTTAB(13,15);(((vps?1)AND1)*32)+(((vps?2)AND240)DIV16) :REM: hours
  600PRINTTAB(15,16);(((vps?2)AND15)*4)+(((vps?3)AND192)DIV64) :REM: minutes
  610country=((vps?3)AND61)DIV4 :REM: country of origin
  620IF country=12 PRINTTAB(15,17)"UK" ELSE PRINTTAB(15,17);country
  630PRINTTAB(14,18);(((vps?3)AND3)*16)+(((vps?4)AND240)DIV16) :REM: source
  640VDU31,15,19 :REM: print message
  650FOR byte=20 TO 39
  660VDU (buff?byte OR &80)
  670NEXT
  680VDU7
  690grabflag?0=0 :REM: grabflag = searching
  700ENDPROC
  710DEFPROCmcode
  720packet=&70 :REM: row number of current packet
  730magazine=&71 :REM: magazine number of current page
  740grabflag=&72 :REM: page grabber flag
  750channel=&73 :REM: TV channel
  760temp=&74 :REM: temporary store
  770vps=&75 :REM: decoded VPS, 5 bytes
  780savereg=&FC :REM: interrupt accumulator save register
  790irq2v=&206 :REM: IRQ2 vector
  800ttxcontrol=&FC10 :REM: TTX control register, write only
  810ttxstatus=&FC10 :REM: TTX status register, read only
  820rowreg=&FC11 :REM: TTX row register, write only
  830datareg=&FC12 :REM: TTX data register, read & write
  840statclr=&FC13 :REM: TTX clear status register, read & write
  850FOR pass=0 TO 2 STEP 2
  860P%=mcode
  870[OPT pass
  880LDA #&00
  890STA grabflag \ grabflag = searching
  900LDX irq2v \ load secondary interrupt vector
  910LDY irq2v+1
  920CPY #interrupt DIV 256 \ has the vector been altered?
  930BEQ disable \ branch if interrupt vector altered
  940STX oldirq2v \ save secondary interrupt vector
  950STY oldirq2v+1
  960LDX #interrupt MOD 256 \ install new interrupt routine
  970LDY #interrupt DIV 256
  980SEI \ disable interrupts when altering vector
  990STX irq2v
 1000STY irq2v+1
 1010CLI \ re-enable interrupts
 1020LDA channel \ load (channel number + #&1C)
 1030STA ttxcontrol \ enable TTX
 1040RTS \ return to BASIC
 1050.disable
 1060LDA #&00
 1070STA ttxcontrol \ disable TTX
 1080LDX oldirq2v \ load original vector
 1090LDY oldirq2v+1
 1100SEI \ disable interrupts when altering vector
 1110STX irq2v \ restore original vector
 1120STY irq2v+1
 1130CLI \ re-enable interrupts
 1140RTS \ return to BASIC
 1150.interrupt
 1160BIT ttxstatus \ poll TTX hardware
 1170BMI ttxinter \ branch if TTX interrupt
 1180JMP (oldirq2v) \ not TTX interrupt
 1190.ttxinter
 1200LDA savereg \ interrupt accumulator save register
 1210PHA \ push interrupt accumulator save register
 1220TXA
 1230PHA \ push X
 1240TYA
 1250PHA \ push Y
 1260LDA grabflag \ has TSDP been grabbed?
 1270BNE clearstatus \ clear status and RTI if TSDP grabbed
 1280CLD \ clear decimal flag
 1290LDY #&00 \ start with row 0
 1300.readttxt
 1310STY rowreg \ try rows 0 to 15
 1320LDA datareg \ load framing code (#&27)
 1330BEQ emptyrow \ if zero try next row
 1340TYA
 1350PHA \ save row number
 1360JSR readpacket
 1370PLA
 1380TAY \ restore row number
 1390.emptyrow
 1400INY \ increment row number
 1410CPY #&10 \ try rows 0 - 15
 1420BNE readttxt
 1430.clearstatus
 1440LDA #&00
 1450LDY #&0F \ clear 16 rows in adaptor
 1460.clearloop
 1470STY rowreg
 1480STA datareg
 1490DEY
 1500BPL clearloop
 1510STA statclr \ clear status flags before returning
 1520PLA
 1530TAY \ restore Y
 1540PLA
 1550TAX \ restore X
 1560PLA
 1570STA savereg \ restore interrupt accumulator save register
 1580RTI \ return from interrupt
 1590.readpacket
 1600LDA grabflag \ just checking
 1610BNE return
 1620LDY datareg \ read magazine number
 1630LDA hamtable,Y \ de-ham it
 1640BMI return \ stop loading if error
 1650STA magazine \ save magazine number
 1660LDY datareg \ read packet number
 1670LDA hamtable,Y \ de-ham it
 1680BMI return \ stop loading if error
 1690STA packet \ save packet number
 1700LDA magazine \ load magazine number
 1710CMP #&08 \ bit 3 of mag. number is bit 0 of packet number
 1720ROL packet \ 5 bit packet number
 1730AND #&07 \ use only bits 0-2
 1740CMP #&00 \ is this magazine 0?
 1750BNE return
 1760LDA packet
 1770CMP #&1E \ look for TSDP
 1780BNE return \ ignore all other packets
 1790LDY #&00 \ read bytes 0 - 39
 1800.readmore
 1810LDX datareg \ read data register
 1820LDA hamtable,X \ de-ham the byte
 1830BMI return \ return if error
 1840STA buff,Y \ store in buffer
 1850INY \ increment index
 1860CPY #&14
 1870BCC readmore \ go back for more
 1880.readagain
 1890LDA datareg \ read data register
 1900STA buff,Y \ store in buffer
 1910INY \ increment index
 1920CPY #&28 \ decimal 40
 1930BNE readagain \ go back for more
 1940LDA buff \ TSDP type byte
 1950AND #&0E \ %00001110
 1960STA grabflag \ grabflag = 0 or 2
 1970.return
 1980RTS
 1990.reverse
 2000LDX #&14 \ VPS nybbles in bytes &0B - &13
 2010LDY #&04 \ decode VPS into 5 bytes
 2020.join
 2030LDA buff,X \ load VPS nybble
 2040ASL A \ move low nybble into high
 2050ASL A
 2060ASL A
 2070ASL A
 2080STA temp \ temporary zero page store
 2090DEX \ point to next nybble
 2100LDA buff,X \ load VPS nybble
 2110ORA temp \ join two nybbles into one byte
 2120STA vps,Y \ and store in zero page
 2130DEX \ point to next nybble
 2140DEY \ point to next byte
 2150BPL join \ branch if more VPS bytes
 2160LDX #&04 \ VPS now in 5 zero page bytes
 2170.outerloop
 2180LDA vps,X \ reverse bits in all VPS bytes
 2190STA temp \ temporary zero page store
 2200LDY #&07
 2210.innerloop
 2220ROL temp \ bit into carry
 2230ROR A \ carry into accumulator
 2240DEY
 2250BPL innerloop
 2260STA vps,X \ store reversed byte
 2270DEX
 2280BPL outerloop \ go back if more VPS bytes
 2290RTS
 2300.oldirq2v
 2310EQUW &00
 2320.hamtable
 2330EQUD &0101FF01
 2340EQUD &FF0100FF
 2350EQUD &FF0102FF
 2360EQUD &07FFFF0A
 2370EQUD &FF0100FF
 2380EQUD &00FF0000
 2390EQUD &0BFFFF06
 2400EQUD &FF0300FF
 2410EQUD &FF010CFF
 2420EQUD &07FFFF04
 2430EQUD &07FFFF06
 2440EQUD &070707FF
 2450EQUD &05FFFF06
 2460EQUD &FF0D00FF
 2470EQUD &FF060606
 2480EQUD &07FFFF06
 2490EQUD &FF0102FF
 2500EQUD &09FFFF04
 2510EQUD &02FF0202
 2520EQUD &FF0302FF
 2530EQUD &05FFFF08
 2540EQUD &FF0300FF
 2550EQUD &FF0302FF
 2560EQUD &0303FF03
 2570EQUD &05FFFF04
 2580EQUD &FF040404
 2590EQUD &FF0F02FF
 2600EQUD &07FFFF04
 2610EQUD &050505FF
 2620EQUD &05FFFF04
 2630EQUD &05FFFF06
 2640EQUD &FF030EFF
 2650EQUD &FF010CFF
 2660EQUD &09FFFF0A
 2670EQUD &0BFFFF0A
 2680EQUD &FF0A0A0A
 2690EQUD &0BFFFF08
 2700EQUD &FF0D00FF
 2710EQUD &0B0B0BFF
 2720EQUD &0BFFFF0A
 2730EQUD &0CFF0C0C
 2740EQUD &FF0D0CFF
 2750EQUD &FF0F0CFF
 2760EQUD &07FFFF0A
 2770EQUD &FF0D0CFF
 2780EQUD &0D0DFF0D
 2790EQUD &0BFFFF06
 2800EQUD &FF0D0EFF
 2810EQUD &09FFFF08
 2820EQUD &090909FF
 2830EQUD &FF0F02FF
 2840EQUD &09FFFF0A
 2850EQUD &FF080808
 2860EQUD &09FFFF08
 2870EQUD &0BFFFF08
 2880EQUD &FF030EFF
 2890EQUD &FF0F0CFF
 2900EQUD &09FFFF04
 2910EQUD &0F0FFF0F
 2920EQUD &FF0F0EFF
 2930EQUD &05FFFF08
 2940EQUD &FF0D0EFF
 2950EQUD &FF0F0EFF
 2960EQUD &0EFF0E0E
 2970]
 2980NEXT
 2990ENDPROC