Ham Radio 2000 #1/Ham Radio 2000.iso/ham2000/misc/icom_cat/program1.bas

BASIC Source File | 1993-07-29 | 5.1 KB | 193 lines

DECLARE SUB SetupCOM ()
DECLARE SUB ShowMainPrompts ()
'
' Program 1 (MODE AND VFO SETTING)
'
' Program taken from the "CT-17 Communication Interface-V (CI-V) Level
' Converter Instruction Manual". Program converted to IBM QBASIC by Bill
' Heaton, N7WRI.
'
DEFINT G-Z

DECLARE SUB DoCommand (Cmd AS INTEGER, Arg AS STRING)
DECLARE SUB GetReply ()
DECLARE SUB MainPrompts ()
DECLARE FUNCTION STRTOHEX$ (Str AS STRING)

'
' Configuration Information
'

CONST RA = &H3C                 ' Receive Address (IC-737)
CONST TA = &HE0                 ' Transmit Address (Computer)

CONST PORT$ = "COM1"            ' Serial Port to use
CONST PORTNO = 1                ' Serial Port to use
CONST CONF$ = "1200,N,8,1"      ' Baud rate, Parity, Bits, Stop Bits

CONST SHOWCOM = 1               ' Show Com Packets ( 0=No, 1=Yes)

'
' Initialize
'

SetupCOM
ShowMainPrompts

'
'  Endless loop until an event handler kills us
'
DO UNTIL TRUE
LOOP

'
' Event Handlers
'
Serial: GetReply:          RETURN
F1: DoCommand 6, CHR$(0): RETURN
F2: DoCommand 6, CHR$(1): RETURN
F3: DoCommand 6, CHR$(2):  RETURN
F4: DoCommand 6, CHR$(3):  RETURN
F5: DoCommand 6, CHR$(4):  RETURN
F6: DoCommand 6, CHR$(5):  RETURN
F7: DoCommand 7, CHR$(0):  RETURN
F8: DoCommand 7, CHR$(1):  RETURN
F9: DoCommand 7, "":       RETURN
F0: CLOSE : SYSTEM

' +---------------------------------------------------------------------+
' |                                                                     |
' |                      ICOM CI-V Packet Layout                        |
' |     +----------+----------+---------+---------+---------+------+    |
' |     | Preamble | Transmit | Receive | Command | Sub     | EOM  |    |
' |     | <FE><FE> | Address  | Address |         | Command | <FD> |    |
' |     +----------+----------+---------+---------+---------+------+    |
' |                                                                     |
' |     A packet consists of two bytes of &HFE, one byte for the        |
' |     transmit address (Controller), One byte receive address         |
' |     (Rig), one byte command, one to five byte subcommand, and       |
' |     finally the tail of one byte of &HFD.                           |
' |                                                                     |
' +---------------------------------------------------------------------+
SUB DoCommand (Cmd AS INTEGER, SubCmd AS STRING)

  '
  ' Create the packet and send it out
  '
  Out$ = CHR$(&HFE) + CHR$(&HFE) + CHR$(RA) + CHR$(TA) + CHR$(Cmd) + SubCmd + CHR$(&HFD)
  PRINT #1, Out$;

  '
  ' If we're watching packets, send to the screen in hex
  '
  IF SHOWCOM THEN
    CLS
    LOCATE 17, 1: PRINT "Sent: "
    LOCATE 17, 7: PRINT STRTOHEX$(Out$);
    LOCATE 18, 1: PRINT "Echo: "
    LOCATE 19, 1: PRINT "Back: "
  END IF
END SUB

'
' GetReply      - Character has arrived from rig, stuff it away until
'                 have an entire packet and display it.
'
SUB GetReply
  STATIC Hold$

  '
  ' Accumulate the Reply, if its not end of packet get out early
  '
  Hold$ = Hold$ + INPUT$(LOC(PORTNO), PORTNO)
  IF INSTR(Hold$, CHR$(&HFD)) = 0 THEN
    EXIT SUB
  END IF

  '
  ' Echo replys to the screen if we were told to
  '
  IF SHOWCOM THEN
    IF MID$(Hold$, 3, 1) = CHR$(TA) THEN
      LOCATE 19, 7: PRINT STRTOHEX$(Hold$);

      SELECT CASE MID$(Hold$, 5, 1)
        CASE CHR$(&HFB)
            LOCATE 25, 1: PRINT "[OK]     ";
        CASE CHR$(&HFA)
            LOCATE 25, 1: PRINT "[ERROR]  ";
        CASE ELSE
            LOCATE 25, 1: PRINT "  [Unknown]";
      END SELECT
    ELSE
      LOCATE 18, 7: PRINT STRTOHEX$(Hold$);
    END IF
  END IF

  ' Get ready for next reply
  Hold$ = ""
END SUB

'
'  Setup the channel to the serial port
'
SUB SetupCOM

  OPEN PORT$ + ":" + CONF$ + ",CD0,CS0,DS0,OP0,RS" FOR RANDOM AS #1
  ON COM(PORTNO) GOSUB Serial
  COM(PORTNO) ON
END SUB

SUB ShowMainPrompts

  '
  '  Paint the prompts
  '
  CLS
  M1$ = "╔═══════╦═══════╦═══════╦═══════╦═══════╦═══════╦═══════╦═══════╦═══════╦══════╗"
  M2$ = "║  F1   ║  F2   ║  F3   ║  F4   ║  F5   ║  F6   ║  F7   ║  F8   ║  F9   ║ F10  ║"
  M3$ = "║  LSB  ║  USB  ║  AM   ║  CW   ║ RTTY  ║  FM   ║ VFO A ║ VFO B ║  VFO  ║ EXIT ║"
  M4$ = "╚═══════╩═══════╩═══════╩═══════╩═══════╩═══════╩═══════╩═══════╩═══════╩══════╝"

  LOCATE 21, 1: PRINT M1$;
  LOCATE 22, 1: PRINT M2$;
  LOCATE 23, 1: PRINT M3$;
  LOCATE 24, 1: PRINT M4$;
  VIEW PRINT 1 TO 20

  '
  '  Setup function key handlers for each options
  '
  ON KEY(1) GOSUB F1
  ON KEY(2) GOSUB F2
  ON KEY(3) GOSUB F3
  ON KEY(4) GOSUB F4
  ON KEY(5) GOSUB F5
  ON KEY(6) GOSUB F6
  ON KEY(7) GOSUB F7
  ON KEY(8) GOSUB F8
  ON KEY(9) GOSUB F9
  ON KEY(10) GOSUB F0
  '
  '  Turn the key handlers on
  '
  FOR I = 1 TO 10
    KEY(I%) ON
  NEXT I


END SUB

' STRTOHEX$ - Translate all the characters in a string to hex and
'             return the resulting string.
'
FUNCTION STRTOHEX$ (Str AS STRING)
Scn$ = ""
FOR I = 1 TO LEN(Str)
     C$ = HEX$(ASC(MID$(Str, I, 1)))
     Scn$ = Scn$ + C$ + " "
  NEXT I
STRTOHEX$ = Scn$
END FUNCTION