REM Save this file as (say) TALKRCX.BAS and run it under QBasic
REM Amend the line which selects COM1 if you wish.


DECLARE SUB centre (t$)
DECLARE FUNCTION reply$ (message$)
DECLARE FUNCTION badmessage% (message$)
DECLARE FUNCTION tidy$ (message$)
DECLARE SUB send (message$)
DECLARE FUNCTION string2hex$ (s$)
DIM SHARED seqno AS INTEGER, true AS INTEGER, false AS INTEGER
DIM SHARED cr$, lf$, crlf$, FF00$
DIM SHARED messageheader$

REM Revision History
REM rev$ = "1.00 1999/01/01": REM  Original issue
    rev$ = "1.01 1999/01/02": REM  Revision History and title screen added

REM set up a few useful constants
true = -1
false = 0
cr$ = CHR$(13)
lf$ = CHR$(10)
crlf$ = cr$ + lf$
FF00$ = CHR$(&HFF) + CHR$(0)
CLS
CLOSE
LOCATE 10, 1
centre "T A L K R C X"
PRINT
centre "Revision " + rev$
PRINT
centre "Acknowledgements to Kekoa Proudfoot, Russell Nelson, Dave Baum"
centre "and especially Paul Haas whose TALKRCX.TXT Perl script was"
centre "the inspiration for this program"
PRINT
PRINT
centre "Type in a command such as 10 (ping) and see the reply"
PRINT

REM Alternate commands have hex 08 set.
REM Initialise this sequence
seqno = 1

REM Choose your serial port (no colon)
port$ = "COM1"

REM Or add it to the command line (no colon)
REM This gives an error in interpreted Qbasic
ON ERROR GOTO handler
IF COMMAND$ > "" THEN port$ = UCASE$(COMMAND$)

skip:
ON ERROR GOTO 0
REM Check the port name
p = INSTR(" COM1 COM2 COM3 COM4 ", UCASE$(" " + port$ + " "))
IF p = 0 THEN
  PRINT "Usage:"
  PRINT "  talkrcx [com1 | com2 | com3 | com4]"
  PRINT "  (defaults to com1)"
  END
END IF


REM This OPEN command is taken from the Qbasic help file.
OPEN port$ + ":2400,N,8,1,CD0,CS0,DS0,OP0,RS,TB2048,RB2048" FOR RANDOM AS #1

REM QBasic doesn't like 8 + odd, so zap the UART
REM First find the UART parity-register address
REM NB Some PC BIOSes don't follow these rules correctly
REM so you may have to amend this lookup string.
lookup$ = "COM1 &H3FB, COM2 &H2FB, COM3 &H3EB, COM4 &H2EB"

register = VAL(MID$(lookup$, INSTR(lookup$, UCASE$(port$)) + 5, 5))
OUT register, &HB: REM odd/8/1


REM  All messages start the same way.
messageheader$ = CHR$(&H55) + CHR$(&HFF) + CHR$(0)

DO
  INPUT "Send >", message$
  IF INSTR("Qq", message$) THEN EXIT DO
 
  REM message$ is of the form "xx xx xx xx"
  REM IE valid hex digits separated by spaces
  IF NOT badmessage((message$)) THEN
    PRINT reply$((message$))
    seqno = seqno XOR 1: REM Alternate commands have Hex 08 set.
  END IF
LOOP
END

handler:
RESUME skip

FUNCTION badmessage% (message$)

  REM the Tidy$ function returns an empty string if the message is bad.
 
  IF tidy$(message$) = "" THEN
    badmessage% = true
  ELSE
    badmessage% = false
  END IF

END FUNCTION

SUB centre (t$)

  LOCATE CSRLIN, 40 - LEN(t$) / 2
  PRINT t$

END SUB

FUNCTION reply$ (message$)

  tidymessage$ = tidy$((message$))
  send tidymessage$
  r$ = ""
  t = TIMER + 1: REM Wait for 1 second after last byte
  DO
    REM Stat to receive bytes into r$
    IF LOC(1) > 0 THEN
      r$ = r$ + INPUT$(1, 1)
      t = TIMER + 1
    END IF
  LOOP UNTIL TIMER > t
  IF r$ = "" THEN
    PRINT "Nothing received after sending " + string2hex$(tidymessage$)
    PRINT "Have you plugged in the IR Tower, and checked the 9v battery?"
    EXIT FUNCTION
  END IF

  IF r$ = tidymessage$ THEN
    REM All we got back was the transmitted message.
    PRINT "Received an echo, but no reply from RCX"
    PRINT "Have you switched on the RCX?"
    EXIT FUNCTION
  END IF

  IF LEFT$(r$, LEN(tidymessage$)) <> tidymessage$ THEN
    PRINT "Bad echo.  Sent " + string2hex$(tidymessage$)
    PRINT "but received    " + string2hex$(r$)
    EXIT FUNCTION
  END IF

  REM Remove the echo from the front of the reply
  rawreply$ = MID$(r$, LEN(tidymessage$) + 1)
  REM Now check integrity of reply

  REM Hex FF 00 must be within first 3 bytes
  p = INSTR(LEFT$(rawreply$, 3), FF00$)
  IF p = 0 THEN
    PRINT "Reply does not start with FF 00"
    PRINT "Sent         " + string2hex$(tidymessage$)
    PRINT "but received " + string2hex$(r$)
    EXIT FUNCTION
  END IF

  REM remove preamble
  rawreply$ = MID$(rawreply$, p + 2)
  REM must be even number of bytes
  IF (LEN(rawreply$) AND 1) = 1 THEN
    PRINT "Reply should contain even number of bytes after FF 00"
    PRINT "Sent         " + string2hex$(tidymessage$)
    PRINT "but received " + string2hex$(r$)
    EXIT FUNCTION
  END IF

  checksum = 0
  tidyreply$ = ""
  FOR i = 1 TO LEN(rawreply$) STEP 2
    REM Check for complements, assemble message, and calculate sumcheck
    c = ASC(MID$(rawreply$, i, 1))
    IF c + ASC(MID$(rawreply$, i + 1, 1)) <> 255 THEN
      PRINT string2hex(rawreply$)
      PRINT "Reply contains bad complement on bytes"; i; "and"; i + 1
      EXIT FUNCTION
    END IF
    IF i < LEN(rawreply$) - 2 THEN
      REM These are data bytes
      tidyreply$ = tidyreply$ + CHR$(c AND &HF7)
      checksum = checksum + c
    ELSE
      REM This is the checksum.  Check it.
      IF (checksum AND 255) <> c THEN
        PRINT "Bad checksum on reply"
        PRINT "Sent         " + string2hex$(tidymessage$)
        PRINT "but received " + string2hex$(r$)
        EXIT FUNCTION
      END IF
    END IF
  NEXT

  REM check that first received byte is the complement of command
  IF ((255 - ASC(LEFT$(tidyreply$, 1))) AND &HF7) <> (ASC(MID$(tidymessage$, 4, 1)) AND &HF7) THEN
    PRINT "RCX reply does not complement the transmitted command"
    PRINT "Sent         " + string2hex$(tidymessage$)
    PRINT "but received " + string2hex$(r$)
    EXIT FUNCTION
  END IF


  reply$ = string2hex$(tidyreply$)

END FUNCTION

SUB send (message$)

  PRINT #1, message$;

END SUB

FUNCTION string2hex$ (s$)

  REM Turn a raw binary string into space-separated hex pairs
  answer$ = ""
  FOR i = 1 TO LEN(s$)
    answer$ = answer$ + " " + RIGHT$("0" + HEX$(ASC(MID$(s$, i, 1))), 2)
  NEXT
  string2hex$ = answer$

END FUNCTION

FUNCTION tidy$ (message$)

  DIM p%
  REM Check that format is "xx xx xx" and compress to a binary string
  message$ = LCASE$(message$)
  p = 1: REM pointer within message$
  tidymessage$ = "": REM Resulting compressed message
  checksum% = 0
  DO WHILE LTRIM$(MID$(message$, p)) > ""
    REM Extract the next xx
    bytestring$ = RTRIM$(LEFT$(LTRIM$(MID$(message$, p)), 2))
    IF LEN(bytestring$) <> 2 THEN
      PRINT "Hex symbols must be two characters each, eg 0D 0A"
      tidy$ = ""
      EXIT FUNCTION
    END IF
    IF INSTR("0123456789abcdef", LEFT$(bytestring$, 1)) = 0 OR INSTR("0123456789abcdef", RIGHT$(bytestring$, 1)) = 0 THEN
      PRINT "Message contains a non-hex character"
      tidy$ = ""
      EXIT FUNCTION
    END IF
    byteval = VAL("&H" + bytestring$)
    IF p = 1 THEN
      REM this is the command byte so sequence it
      IF seqno = 1 THEN
        byteval = byteval OR 8
      ELSE
        byteval = byteval AND &HF7
      END IF
    END IF
    checksum% = checksum% + byteval
    tidymessage$ = tidymessage$ + CHR$(byteval) + CHR$((NOT byteval) AND 255)
    REM P points to the next byte
    p = LEN(message$) - LEN(LTRIM$(MID$(message$, p))) + 3

  LOOP

  tidy$ = messageheader$ + tidymessage$ + CHR$(checksum% AND 255) + CHR$((NOT checksum%) AND 255)

END FUNCTION