' TESTJMRI.BAS a program to test input and output to JMRI ' to establish communications, inspect transmitted opcodes ' define com port characteristics for integration into TNT ' written by Robert Rydman begun 12/9/09 TYPE RegType AX AS INTEGER BX AS INTEGER CX AS INTEGER DX AS INTEGER BP AS INTEGER SI AS INTEGER DI AS INTEGER FLAGS AS INTEGER END TYPE DIM SHARED INREGS AS RegType DIM SHARED OUTREGS AS RegType DIM SHARED INBYTE(20) 'recieved bytes DIM SHARED OUTBYTE(20) 'send bytes DIM SHARED SLOT(128) DIM SHARED AADDR(9, 4) 'assigned addresses in TNT DIM SHARED ASTEPS(9) DIM SHARED FUNC(9, 5) 'in TNT trains 9 functions 5 DIRF = 0 'temporary value T = 1 'throttle/train 1 to 9 in TNT A = 1 'assigned position 1 to 4 in consist ASTEPS(T) = 28 'assigned speed steps set in TNT AADDR(T, A) = 3 FILENUM = 1 'generally slot will be train(1-9) X10 + position in consist 1 to 4 'ie 11,12,13,14 then 21,22,23,24 then ... ,91,92,93,94 SLOT(11) = 3 'for test address 3 ON ERROR GOTO 15000 CLOSE CMD$ = "COM1:19200,N,8,1,,,,,," FILENUM$ = "1" 10 CLS COLOR 4 'RED PRINT " TRAINS AND TERMINALS " PRINT " JMRI/TNT LOCOBUFFER TEST " COLOR 7 PRINT PRINT " A TEST PROGAM FOR JMRI INTERFACE " PRINT " USING COM PORT CONFIGURATION:" PRINT " OPEN "; CMD$; "FOR RANDOM AS #"; FILENUM$ PRINT PRINT " 1. TEST JMRI LOCOBUFFER I/O 19,200 BAUD" PRINT " 2. EXIT PROGRAM " PRINT INPUT " CHOOSE MENU SELECTION "; N IF N = 1 THEN GOSUB 100 IF N = 2 THEN GOTO 20000 GOTO 10 100 OPEN CMD$ FOR RANDOM AS #FILENUM 'open com port 101 CLS ECHO = 1 FILTER = 0 LOCATE 1, 1 COLOR 14 PRINT " TNT " PRINT COLOR 7 GOSUB 1005 'query driver GOSUB 1100 'activate loco address 3 asteps = 28 PRINT " SELECT JMRI LOCO ADDRESS 3 SPEED STEPS 28 " PRINT " TESTING I/O OF "; CMD$ PRINT " [S] ENTER SERVICE MODE" PRINT " [Q] WILL QUIT " ' mini terminal for JMRI test 102 DO ' keyboard input KEY$ = INKEY$ KEY$ = UCASE$(KEY$) IF KEY$ = "Q" THEN EXIT DO IF KEY$ = "S" THEN GOSUB 14300 'COM input 105 IF NOT EOF(FILENUM) THEN INBYTE$ = INPUT$(LOC(1), #1) INBYTE = ASC(INBYTE$) 110 IF INBYTE > 127 THEN GOSUB 120 'INBYTE is opcode IF INBYTE < 128 THEN GOSUB 130 'INBYTE is data IF INCNTR = NUMINBYTES THEN GOSUB 150 'echo and do message END IF LOCATE 24, 1 PRINT LOADED$; " MODE IS:"; MODE$; " ACTIVE LOCOS:"; NACTIVE; LOOP CLOSE #FILENUM RETURN 'opcode byte >127 1xxxxxxx 120 INCNTR = 1 'bytes so far in this message INBYTE(INCNTR) = INBYTE 'save to make message MSGLENGTH = INBYTE AND 96 'gets number of bytes 2,4,6,or > IF MSGLENGTH = O THEN NUMINBYTES = 2 ' x00xxxxx IF MSGLENGTH = 32 THEN NUMINBYTES = 4 ' x01xxxxx IF MSGLENGTH = 64 THEN NUMINBYTES = 6 ' x10xxxxx IF MSGLENGTH = 96 THEN NUMINBYTES = 99 ' x11xxxxx temp value RETURN 'data byte < 128 0xxxxxxx 130 INCNTR = INCNTR + 1 'increment input byte counter INBYTE(INCNTR) = INBYTE 'save this byte this message IF NUMINBYTES = 99 THEN NUMINBYTES = INBYTE(2) 'message length >6 RETURN 'echo message 150 VALID = 0 'calculate chksum CHK = &HFF FOR N = 1 TO (NUMINBYTES - 1) CHK = CHK XOR INBYTE(N) NEXT N IF CHK = INBYTE(NUMINBYTES) THEN VALID = 1 LOCATE 6, 1 COLOR 14 'yellow echo IF VALID = 1 THEN PRINT " VALID CHECKSUM " IF VALID = 0 THEN PRINT " CHECKSUM NOT VALID " SEE$ = "" SEND$ = "" FOR N = 1 TO NUMINBYTES SEE$ = SEE$ + HEX$(INBYTE(N)) + " " 'see inbytes SEND$ = SEND$ + CHR$(INBYTE(N)) 'send echo NEXT N PRINT " MESSAGE ECHO TO JMRI " PRINT " "; SEE$; " " PRINT #FILENUM, SEND$ COLOR 7 'white GOSUB 400 'select case do message RETURN 'done this message 'do message 400 SELECT CASE INBYTE(1) 'CASE &H81 'master busy code null ' CASE &H82 'global power off GOSUB 1000 CASE &H83 'global power on GOSUB 1001 CASE &H85 'idle emergency stop GOSUB 1010 CASE &HBF 'opc_loco_adr GOSUB 11150 CASE &HBD 'opc_sw_ack GOSUB 11130 CASE &HBC 'opc_sw_state GOSUB 11120 CASE &HBB 'opc_rq_sl_data GOSUB 11110 CASE &HBA 'opc_mov_slot GOSUB 11100 CASE &HB9 'opc_link_slots GOSUB 11090 CASE &HB8 'opc_unlink_slot GOSUB 11080 CASE &HB6 'opc_consist_func GOSUB 11060 CASE &HB5 'opc_slot_stat GOSUB 11050 CASE &HB4 'opc_long_ack GOSUB 11040 CASE &HB0 'opc_sw_req GOSUB 11000 CASE &HA2 'opc_loco_snd GOSUB 10020 CASE &HA1 'opc_loco_dirf GOSUB 10010 CASE &HA0 'opc_loco_spd GOSUB 10000 CASE &HEF 'opc_write_slot_data GOSUB 14150 CASE &HE7 'opc_read slot data GOSUB 14070 END SELECT RETURN 'send reply 600 CHK = &HFF FOR N = 1 TO (NUMOUTBYTES - 1) 'calculate chksum CHK = CHK XOR OUTBYTE(N) NEXT N OUTBYTE(NUMOUTBYTES) = CHK COLOR 10 'green sendreply SEE$ = "" 'clear strings SEND$ = "" FOR N = 1 TO NUMOUTBYTES 'make new strings SEE$ = SEE$ + HEX$(OUTBYTE(N)) + " " SEND$ = SEND$ + CHR$(OUTBYTE(N)) NEXT N LOCATE 10, 1 PRINT "LAST REPLY SENT TO JMRI " PRINT SEE$; " " 'to blank out old message PRINT #FILENUM, SEND$ 'send string COLOR 7 REPLY = 0 'reply is sent RETURN 'DCC-MB INTERRUPT SERVICE ROUTINES ' SWI0: SetDriverMode ' ah = 0 Sets mode of DCC-MB ' al = 0 OFF ' al = 1 ON ' al = 2 Program ' returns 0 = OK ' -1 = error 1000 INREGS.AX = &H0 '&H0 TO turn DCC-MB system off CALL INTERRUPT(&H70, INREGS, OUTREGS) GOSUB 1005 ' query system RETURN 1001 INREGS.AX = &H1 'set to operate mode turns DCC system on CALL INTERRUPT(&H70, INREGS, OUTREGS) GOSUB 1005 'query system RETURN 1002 INREGS.AX = &H2 'set mode to program CALL INTERRUPT(&H70, INREGS, OUTREGS) GOSUB 1005 RETURN ' SWI0a: QueryDriver ' ah = 0 Queries system for controller mode ' al = 255 ' Returns ax = &hFACE 64206d DCC-MB installed ' bx = current driver mode ' cx = number of active locos 1005 INREGS.AX = &HFF ' query controller mode ah=0 al=255 CALL INTERRUPT(&H70, INREGS, OUTREGS) INSTALLED = OUTREGS.AX MODE = OUTREGS.BX NACTIVE = OUTREGS.CX LOADED$ = "DCC-MB NOT LOADED" IF INSTALLED = &HFACE THEN LOADED$ = "DCC-MB NOW LOADED" 'IF INSTALLED THEN GOSUB 1100 'activate loco addr 3 in test MODE$ = " ERROR " IF MODE = 0 THEN MODE$ = " OFF " IF MODE = 1 THEN MODE$ = "OPERATE" IF MODE = 2 THEN MODE$ = "PROGRAM" RETURN ' SWI1: DCCReset ' sends 20 DCC reset packets and sets speed to 0 all locos ' ah = 1 ' returns 0 = OK 1010 INREGS.AX = &H100 CALL INTERRUPT(&H70, INREGS, OUTREGS) LOCATE 22, 1 IF OUTREGS.AX = 0 THEN PRINT " DCC SYSTEM HAS RESET " IF OUTREGS.AX <> 0 THEN PRINT " DCC SYSTEM NOT RESET " PRINT " ANY KEY WILL CONTINUE " 1015 A$ = INKEY$: IF A$ = "" THEN 1015 RETURN 'SWI10: ActivateLoco ' use assignment data to activate ' activates locos sets speed = 0 direction = forward ' ah = 10 al = speed control mode 1,2,3 -> 14,28,128 ' bl = loco address 1-127 ' returns ax 0 = ok ' -1 = error loco already active ' -2 = speed control out of range ' -3 = DCC address out of range 1100 SELECT CASE ASTEPS(T) CASE 14 INREGS.AX = &HA01 ' standard CASE 28 INREGS.AX = &HA02 ' Digitrax default CASE ELSE OUTREG.AX = -2 ' INREGS.AX = &HA03 not in DCC-MB GOTO 1103 END SELECT 1102 INREGS.BX = AADDR(T, A) ' assigned address CALL INTERRUPT(&H70, INREGS, OUTREGS) IF OUTREGS.AX = 0 THEN GOTO 1105 1103 LOCATE 22, 1 IF OUTREGS.AX = -1 THEN PRINT " LOCO "; 3; " ALREADY ACTIVE " 'ALOCONUM$(T, A); " ALREADY ACTIVE" IF OUTREGS.AX = -2 THEN PRINT " SPEED CONTROL MODE OUT OF RANGE" IF OUTREGS.AX = -3 THEN PRINT " DCC ADDRESS OUT OF RANGE" IF OUTREGS.AX < -3 OR OUTREGS.AX > -1 THEN PRINT " DCC NOT LOADED - LOCO "; 3; "NOT ACTIVATED " 'ALOCONUM$(T, A); " NOT ACTIVATED" PRINT " ANY KEY TO CONTINUE FROM ACTIVATE " 1104 ' A$ = INKEY$: IF A$ = "" THEN GOTO 1104 1105 CLS GOSUB 1005 'to QueryDriver RETURN ' SWI11: DeactivateLoco ' use assigned address to send DCC deactivation data ' ah = 11 speed is set to zero ' bl = loco address 1-127 ' returns ax 0 = OK ' -1 = error 1110 INREGS.AX = &HB00 IF AADDR(T, A) < 1 OR AADDR(T, A) > 127 THEN 1111 INREGS.BX = AADDR(T, A) CALL INTERRUPT(&H70, INREGS, OUTREGS) LOCATE 22, 1 PRINT " " IF OUTREGS.AX = 0 THEN PRINT " LOCO "; ALOCONUM$(T, A); " IS DEACTIVATED " IF OUTREGS.AX = -1 THEN PRINT " LOCO "; ALOCONUM$(T, A); " WAS NOT ACTIVE " GOTO 1112 1111 'LOCATE 22, 1 'PRINT " DEACTIVATION ADDRESS OUT OF RANGE " 1112 'LOCATE 23, 1 'PRINT " ANY KEY WILL CONTINUE FROM DEACTIVATE " 1114 'A$ = INKEY$: IF A$ = "" THEN GOTO 1114 LOCATE 22, 1 PRINT " " PRINT " " GOSUB 1005 'to QueryDriver RETURN ' SWI12: SetLocoSpeed ' speed steps are determined when loco activated ' ah = 12 &h0C00 3072 decimal ' al = new speed depending upon assigned speed steps ' 0-15 when in 14 step mode 0=stop, 1=emerg, 2-15=speed ' 0-31 when in 28 step mode 0,1=stop 2,3=emerg 4-31=speed ' 0-127 when in 128 step mode NOT SUPPORTED DCC-MB ' bl = address ' returns ax = 0 OK ... -1 when not active ' T is throttle A is assignment location number ' SPD(T) = 0 TO 127 1120 IF ASTEPS(T) = 0 THEN RETURN IF ASTEPS(T) = 14 THEN GOTO 1122 DCCSPEED = INT(SPD(T) * .2126) + 4 ' to make 4 - 31 IF DCCSPEED > 31 THEN DCCSPEED = 31 IF DCCSPEED < 5 THEN DCCSPEED = 0 GOTO 1124 ' go send DCC speed 1122 DCCSPEED = INT(SPD(T) * .1102) + 2 ' to make 14 steps IF DCCSPEED < 2 THEN DCCSPEED = 0 IF DCCSPEED > 15 THEN DCCSPEED = 15 ' now send speed 1124 INREGS.AX = &HC00 + DCCSPEED ' ah = 3072 = &hC00 INREGS.BX = AADDR(T, A) ' assigned address CALL INTERRUPT(&H70, INREGS, OUTREGS) 'IF OUTREGS.AX = 0 THEN PRINT " SPEED SET" 'IF OUTREGS.AX = 0 THEN GOTO 1125 'IF OUTREGS.AX = -1 THEN PRINT " LOCO NOT ACTIVE WHEN SETTING SPEED" 'PRINT " ANY KEY TO CONTINUE FROM SPEED NOT SET LOCO NUMBER "; LOCONUM$(R) 1125 'A$ = INKEY$: IF A$ = "" THEN GOTO 1125 'CLS RETURN ' SWI13: SetLocoDirection ' ah = 13 &hD00 3328 decimal ' al = direction 0=rev, 1=for ' bx = decoder address 1 to 127 ' returns 0 = OK ' -1 = error 1130 INREGS.AX = &HD00 + DIR(T) INREGS.BX = AADDR(T, A) 'assigned address CALL INTERRUPT(&H70, INREGS, OUTREGS) 'this added for test, not normally in TNT COLOR 4 LOCATE 14, 1 IF DIR(T) = 1 THEN PRINT " DIRECTION SET TO FORWARD DIR ="; DIR(T) IF DIR(T) = 0 THEN PRINT " DIRECTION SET TO REVERSE DIR ="; DIR(T) COLOR 7 RETURN 1300 ' SWI31: SetGroup1Acc ' Sets one of five on/off multifunction loco accessory functions ' ah = 31 &h1F00 7936 decimal ' al = 0 or 1 off/on ' bl = address 1 to 127 ' cl = function number 0 - 4 = ACC ' returns ax = 0 = OK all else error 1310 ACC = SET ' SET is function 1 to 5 IF SET = 5 THEN ACC = 0 ' restores NMRA convention 1311 INREGS.AX = 7936 + FUNC(T, SET) ' FUNC value is on/off= 1,0 T is throttle INREGS.BX = AADDR(T, 1) ' address of first loco assigned in MU's IF ACC = 0 THEN ACC = 4 ' set to JMRI INREGS.CX = ACC ' NMRA F0 to F4 CALL INTERRUPT(&H70, INREGS, OUTREGS) LOCATE 15, 1 'this for test program COLOR 4 PRINT " LOCO FUNCTION"; ACC; " "; " SET "; SET; " TO "; FUNC(T, SET) COLOR 7 RETURN 'SWI33: SetType1Accy ' usually turnouts or layout accessories ' set one of eight on/off type 1 accessory decoders ' untested in DCC-MB ' ah = 33 ' bx = 0 - 1023 10 bit DCC Type 1 accesory address ' cl = 0 to 7 accesory function number ' return ax = 0 OK ' needs to be written when hardware available 1330 RETURN 'SWI50: WritePagedRegistry ' dcc-mb writes NMRA three byte programming messages ' writes value into register using paged addressing ' ah = 50 ' al = value (0 - 255) ' bl = 8 registers (0 - 7) (000-111) is 00000RRR ' other bits supplied by DCC-MB to make 111RRR ' returns ax = 0 = OK ' -1 = error ' write CV#(1-8) with value 1500 ' direct write cv value to register ' ah = &h3200 selects writepageregister function ' al = value to write ' bl = register (5 is page register) (register 6) 'NMRA definitions 'register 1 (000) = cv1 = short address 'register 2 (001) = cv2 = start voltage 'register 3 (010) = cv3 = accel momentum 'register 4 (011) = cv4 = brake momentum 'register 5 (100) = cv 29 = configuration 'cv29 = configuration byte1 (see NMRA and decoder manual) 'register 6 (101) = page register 'register 7 (110) = cv 7 = version number read only 'register 8 (111) = cv8 = mfg ID writing data = 33 resets to default 'other cvs require paged addressing INREGS.AX = &H3200 + VALUE ' ah = 50 = &H3200 ' al = page 1 is data value INREGS.BX = CV ' register 1 is 000 (decimal value 0) data register 0 ' register 6 is 101 (decimal value 5) paging register CALL INTERRUPT(&H70, INREGS, OUTREGS) ' address register is CV #1 (000) ' which is data register 000 ' decoder address is in register 0 ' when writing short address by any method ' NMRA RP requires the decoder ' to reset extended address bit in CV #29 to 0 ' and clear CV #19 consist address RETURN 'paged register addressing 'see NMRA RP 9.2.3 for more information on 'cv17 = long address high 'cv18 = long address low (not supported in dcc-mb) 'cv19 = consist address 'cv23 = accel trim adds to cv3 'cv24 = decel trim 1550 CLS PRINT PRINT " CV's WILL BE PROGRAMMED BY PAGED REGISTER PROGRAMMING" PRINT " NMRA RP 9.2.3" PRINT " Refer to decoder manufacturer's CV data manuals" PRINT 'INPUT " ENTER CONFIGURATION VARIABLE CV TO WRITE: "; CV 'INPUT " ENTER A DATA VALUE TO WRITE: "; VALUE PRINT PRINT " WRITE CV# "; CV; " WITH VALUE "; VALUE PRINT " Y or N ? " 1555 A$ = INKEY$: IF A$ = "" THEN 1555 A$ = UCASE$(A$) IF A$ = "N" THEN RETURN ' to programming menu ' paged CV addressing needs to write 0111CRRR 0 DDDDDDDD 0 EEEEEEEE 1 ' RRR is register DDDDDDDD is data value ' DCC-MB requires ' ah = &h3200 to call WritePagedRegister ' al = data value 0 to 255 can be page number or data value ' bl = register to write 0 to 7 (eight registers 00000RRR) ' register 1 to 4 (000 - 011) CV registers 0 to 3 ' register 5 (100) basic configuration register CV29 ' register 6 (101) page register ' registers 5,7, and 8 are unaffected by page register 'compute page and datareg to write 'refer to NMRA RP 9.3.2 for example TEMPA = CV - 1 TEMPB = FIX(TEMPA / 4) ' truncates at decimal point PAGE = TEMPB + 1 ' page register 6 is RRR=101 binary DATAREG = TEMPA - (TEMPB * 4) ' DATAREG is integer division remainder INREGS.AX = &H3200 + PAGE ' writepagedregister + page number INREGS.BX = 5 ' into page register 00000101 (6) CALL INTERRUPT(&H70, INREGS, OUTREGS) INREGS.AX = &H3200 + VALUE ' write this data INREGS.BX = DATAREG ' to this register CALL INTERRUPT(&H70, INREGS, OUTREGS) '****** next value (not done) 'when done INREGS.AX = &H3200 ' restore page one ' ah = &H3200 ' al = 0 data for page 1 INREGS.BX = 5 ' register 6 is 101 (decimal value 5) page register ' to set paging register to page 1 CALL INTERRUPT(&H70, INREGS, OUTREGS) RETURN 'LOCONET OPCODE ROUTINES '&HA0 opc_loco_spd 10000 SLOT = INBYTE(2) 'slot = 11 in this test AADDR(T, A) = SLOT(SLOT) 'SLOT(11)=3 in this test SPD(T) = INBYTE(3) 'JMRI sends 0 to 127 GOSUB 1120 'set loco speed LOCATE 13, 1 COLOR 4 'red PRINT " SLOT "; SLOT; " ADDRESS "; AADDR(T, A); " SET TO SPEED "; SPD(T); " " COLOR 7 'white RETURN '&HA1 opc_loco_dirf set loco dir and func 0 - 4 10010 SLOT = INBYTE(2) 'will be slot 11 in test DIRF = INBYTE(3) FOR SET = 1 TO 5 '1 TO 5 FL/F0=5 from TNT F keys TEMP = FUNC(1, SET) FUNC(1, SET) = DIRF AND 2 ^ (SET - 1) 'directional lighting is FL/F0 IF FUNC(1, SET) > 0 THEN FUNC(1, SET) = 1 'make 1 or 0 IF TEMP <> FUNC(1, SET) THEN GOSUB 1310 NEXT SET TEMPDIR = DIR(T) DIR(T) = DIRF AND &H20 DIR(T) = DIR(T) + 1 'invert dir(t) for JMRI IF DIR(T) > 1 THEN DIR(T) = 0 IF DIR(T) <> TEMPDIR THEN GOSUB 1130 'set dir RETURN '&HA2 opc_loco_snd 10020 SLOT = INBYTE(2) SND = INBYTE(3) RETURN '&HB0 opc_sw_req request switch function 11000 SW1 = INBYTE(2) '0,A6,A5,A4,A3,A2,A1,A0 'SW1 7 ls adr bits A1,A0 select 1 of 4 input pairs DS54 SW2 = INBYTE(3) 'SW2 0,0,dir,on a10,a9,a8,a7 'dir 1 = closed 0=set RETURN 'on = 1 for output on 0=output off '&HB1 opc_sw_rep turnout sensor state report 11010 SN1 = INBYTE(2) '0,A6,A5,A4,A3,A2,A1,A0 SN2 = INBYTE(3) '0,1,I,L,A10,A9,A8,A7 for INPUT levels RETURN 'I =0 aux not feedback I=1 turnout feedback 'L=0 input low, L=1 input high 'alternately '0,0,C,T,A10,A9,A8,A7 for OUTPUT levels 'C = 0 closed/off, 1 closed/ON 'T = 0 thrown off, 1=thrown is ON '&HB2 opc_input_rep general sensor input codes 'see DS54 manual 'probably use this with TNT detectors 11020 IN1 = INBYTE(2) IN2 = INBYTE(3) RETURN '&HB4 opc_long_ack 11040 LOPC = INBYTE(1) - 128 'opcode less msb 'ACK1 = &H7F OUTBYTE(1) = &HB4 IF FAIL = 1 THEN OUTBYTE(2) = 0 IF OUTBYTE(2) = &HBD THEN GOTO 11042 'req switch function IF OUTBYTE(2) = &HBC THEN GOTO 11044 'req switch state IF OUTBYTE(2) = &HBA THEN GOTO 11046 'move slot IF OUTBYTE(2) = &HEF THEN OUTBYTE(3) = SLOT 'write slot data OUTBYTE(2) = LOPC: OUTBYTE(3) = ACK1 NUMOUTBYTES = 4 REPLY = 1 GOSUB 600 'sendreply RETURN 11042 'request switch function 11044 'request switch state 11046 'move slot RETURN '&HB5 opc_slot_stat1 write slot stat1 11050 SLOT = INBYTE(2) STAT1 = INBYTE(3) 'write this data to TNT RETURN '&HB6 opc_consist_func set func bits in consist uplink 11060 SLOT = INBYTE(2) DIRF = INBYTE(3) 'this slot address is considered in uplinked slot space RETURN '&HB8 opc_unlink_slots unlink slot1 from slot2 11080 SL1 = INBYTE(2) SL2 = INBYTE(3) 'unlinker execute strategy and returns new slot# 'data/status of unlinked loco inspect data to evaluate unlink 'reply &HE7 RETURN '&HB9 opc_link_slots 'slave slot 1 to slot 2 'linker set conup/dn 11090 SL1 = INBYTE(2) SL2 = INBYTE(3) RETURN '&HBA opc_move_slots move src to dest 11100 SRC = 11 'INBYTE(2) DEST = 11 'INBYTE(3) IF SRC > 119 OR DEST > 119 THEN GOTO 11102 'illegal move SLOT = 11 STAT = &H33 ADR = 3 SPD = 0 'DIRF = &H30 TRK = 7 SS2 = 0 ADR2 = 0 SND = 0 ID1 = &H17 ID2 = &H6F NUMOUTBYTES = 14 GOTO 14072 'sendreply OUT &HE7 11102 OUTBYTE(1) = &HB4: OUTBYTE(2) = &H3A OUTBYTE(3) = 0: NUMOUTBYTES = 4 GOSUB 600 'sendreply RETURN '&HBB opc_rq_sl_data 'reply &HE7 slot read or read clock 11110 SLOT = INBYTE(2) 'requested slot IF SLOT = &H7B THEN GOTO 11115 'clk read STAT = 0 'these to be gotton from TNT IF INBYTE(3) = 11 THEN STAT = 48 '00110000 32+16 ADR = 0 'address low IF SLOT = 11 THEN ADR = 3 'for testing SPD = 0 'get speed this slot from TNT ' DIRF = 0 'get dirf this slot from TNT TRK = 7 'global track status 00000111 SS2 = 0 'slot status 2 'd3 1=exp in id1/2 0=encoded alias 'd2 1=expid1/2 is not id usage 'd0 1 = suppressed advanced consist ADR2 = 0 'address high SND = 0 'sound bits ID1 = 0 ID2 = 0 'reply &HE7 slot read 11112 OUTBYTE(1) = &HE7: OUTBYTE(2) = &HE OUTBYTE(3) = SLOT: OUTBYTE(4) = STAT OUTBYTE(5) = ADR: OUTBYTE(6) = SPD OUTBYTE(7) = DIRF: OUTBYTE(8) = TRK OUTBYTE(9) = SS2: OUTBYTE(10) = ADR2 OUTBYTE(11) = SND: OUTBYTE(12) = ID1 OUTBYTE(13) = ID2: NUMOUTBYTES = 14 'chksum in sendreply REPLY = 1 'reply on GOSUB 600 'sendreply RETURN 'clock read 11115 CLKRATE = 4 'to be gotton from TNT FRACMINSL = &H7F FRACMINSH = &H78 MINS60 = &H59 TRK = 7 HRS24 = &H72 DAYS = &H18 CLKCNTL = 0 'clock off CLOCKON ID1 = 0 ID2 = 0 'make reply OUTBYTE(1) = &HE7: OUTBYTE(2) = &HE: OUTBYTE(3) = &H7B OUTBYTE(4) = CLKRATE: OUTBYTE(5) = FRACMINSL: OUTBYTE(6) = FRACMINSH OUTBYTE(7) = MINS60: OUTBYTE(8) = TRK: OUTBYTE(9) = HRS24 OUTBYTE(10) = DAYS: OUTBYTE(11) = CLKCNTL: OUTBYTE(12) = ID1 OUTBYTE(13) = ID2: NUMOUTBYTES = 14 REPLY = 1 GOSUB 600 RETURN '&HBC opc_sw_state request state of switch 11120 SW1 = INBYTE(2) SW2 = INBYTE(3) 'reply long acknowledge RETURN '&HBD opc_sw_ack req switch with ack (not dt200) 11130 SW1 = INBYTE(2) SW2 = INBYTE(3) 'needs long acknowledge RETURN '&HBF opc_loco_adr request loco address 11150 SLOT = &HB ' 11 for test these will be assigned in tnt STAT = &H23 ' ADR = 3 SPD = 0 ' DIRF = &H30 set in header changed with program TRK = &H7 'TRK is in tnt here is defined in header SS2 = 0 ADR2 = 0 SND = 0 ID1 = &H17 ID2 = &H6F 'setup E7 reply OUTBYTE(1) = &HE7: OUTBYTE(2) = &HE: OUTBYTE(3) = SLOT OUTBYTE(4) = STAT: OUTBYTE(5) = ADR: OUTBYTE(6) = SPD OUTBYTE(7) = DIRF: OUTBYTE(8) = TRK: OUTBYTE(9) = SS2 OUTBYTE(10) = ADR2: OUTBYTE(11) = SND: OUTBYTE(12) = ID1 OUTBYTE(13) = ID2: NUMOUTBYTES = 14 'chksum calc'ed in sendreply REPLY = 1 GOSUB 600 'send reply RETURN '&HE7 opc_sl_rd_data 'these to be gotton from TNT 14070 SLOT = INBYTE(3) STAT = 0 IF INBYTE(3) = 11 THEN STAT = 48 '00110000 32+16 ADR = 3 IF INBYTE(3) = 11 THEN ADRL = 3 SPD = 0 DIRF = DIR(T) TRK = 7 '00000111 SS2 = 0 ADR2 = 0 SND = 0 ID1 = &H17 ID2 = &H6F 'Setup Long Acknowledge 14072 OUTBYTE(1) = &HE7: OUTBYTE(2) = &HE OUTBYTE(3) = SLOT: OUTBYTE(4) = STAT OUTBYTE(5) = ADR: OUTBYTE(6) = SPD OUTBYTE(7) = DIRF: OUTBYTE(8) = TRK OUTBYTE(9) = SS2: OUTBYTE(10) = ADR2 OUTBYTE(11) = SND: OUTBYTE(12) = ID1 OUTBYTE(13) = ID2: NUMOUTBYTES = 14 'CHK byte to be calculated REPLY = 1 GOSUB 600 'sendreply RETURN '&HEF opc_wr_sl_data requires reply LACK 'also write to clock and enter programming mode 14150 OPCODE = INBYTE(1) '&HEF 'inbyte(2) = &HE SLOT = INBYTE(3) IF SLOT = &H7B THEN GOTO 14160 'write clock data IF SLOT = &H7C THEN GOTO 14170 'programmer command IF INBYTE(3) = 11 THEN STAT = 48 '0011 0000 32+16 set for TESTJMRI ADR = INBYTE(5) SPD = INBYTE(6) DIRF = INBYTE(7) DIR(T) = DIRF AND &H20 'for test TRK = INBYTE(8) '00000111 SS2 = INBYTE(9) ADR2 = 0 'dcc-mb 1 TO 127 only INBYTE(10)=0 SND = INBYTE(11) ID1 = INBYTE(12) ID2 = INBYTE(13) GOTO 11040 'reply long ack 'clock_write_data 14160 SLOT = INBYTE(3) 'these enter into TNT CLKRATE = INBYTE(4) FRACMINSL = INBYTE(5) FRACMINSH = INBYTE(6) MINS60 = INBYTE(7) TRK = INBYTE(8) HRS24 = INBYTE(9) DAYS = INBYTE(10) CLKCNTL = INBYTE(11) ID1 = INBYTE(12) ID2 = INBYTE(13) RETURN 'programmer message received 'DCC-MB generates 3 byte NMRA message 14170 DATARDY = 1 'CV data has been recieved PCMD = INBYTE(4) PMODE = PCMD AND 24 'bits 000xx000 8+16 OPS = PCMD AND 4 'bit 00000x00 IF OPS = 1 THEN RETURN 'ops mode not supported in DCC-MB IF PMODE = 8 THEN RETURN 'direct mode 4 byte not supported in DCC-MB HOPSA = 0 'INBYTE(6) 'service mode LOPSA = 0 'INBYTE(7) TRK = INBYTE(8) ' normal value 7 CVHIGH = INBYTE(9) CVLOW = INBYTE(10) 'CVL is a QBASIC word DATA7 = INBYTE(11) OUGHT1 = INBYTE(12) OUGHT2 = INBYTE(13) CHK = INBYTE(14) 'immediate response OUTBYTE(1) = &HB4 OUTBYTE(2) = INBYTE(1) - 128 'opcode - msb 'OUTBYTE(3) = &H40 'accepted blind no reply OUTBYTE(3) = 1 'accepted send E7 when completed NUMOUTBYTES = 4 REPLY = 1 GOSUB 600 'send immediate B4 reply IF MODE = 2 THEN GOTO 14305 'turn on program mode 14300 LOCATE 15, 1 COLOR 4 'red BEEP PRINT " ATTENTION: " PRINT " REQUEST SERVICE MODE PROGRAMMING " PRINT " TURN OFF POWER TO MAINLINE TRACK " PRINT PRINT " [ENTER] WHEN READY " PRINT " [Q] TO QUIT " 14302 A$ = INKEY$: IF A$ = "" THEN GOTO 14302 A$ = UCASE$(A$) IF A$ = "Q" THEN RETURN GOSUB 1002 'set DCC-MB to program mode and query COLOR 7 'white 'program mode 14305 CLS LOCATE 1, 1 PRINT " PROGRAM MODE IS ON " PRINT PRINT " [Q] WILL END PROGRAMMING MODE " PRINT ' mini terminal for JMRI test ' keyboard input DO IF DATARDY = 1 THEN GOSUB 14400 'do in-process cvdata A$ = INKEY$ A$ = UCASE$(KEY$) IF A$ = "Q" THEN EXIT DO 'COM input IF NOT EOF(FILENUM) THEN INBYTE$ = INPUT$(LOC(FILENUM), #1) INBYTE = ASC(INBYTE$) IF INBYTE > 127 THEN GOSUB 120 'is opcode IF INBYTE < 128 THEN GOSUB 130 'is data IF INCNTR = NUMINBYTES THEN GOSUB 150 'echo and do message END IF LOCATE 24, 1 PRINT LOADED$; " MODE IS:"; MODE$; " ACTIVE LOCOS:"; NACTIVE; LOOP 'reset operations mode 14390 GOSUB 1001 'set DCC-MB to operate mode CLS RETURN 101 'to main screen 'do message in program mode 14400 IF PMODE = O THEN 14500 'paged mode 'do PMODE = 16 in register mode MSB = CVHIGH AND 2 'msb of data from message byte VALUE = DATA7 '7 bits of data IF MSB = 1 THEN VALUE = VALUE + 128 'add msb of data CV = CVLOW 'low 7 bits of cv address 0 - 6 CV7 = CVHIGH AND 1 CV8 = CVHIGH AND 16 'bit 2 is data msb and 4,8 = 0 CV9 = CVHIGH AND 32 CV = CV + (CV7 * 128) + (CV8 * 256) + (CV9 * 512) '10 bits 0 to 9 CV = CV AND &HFF '8 bit limit in DCC-MB GOSUB 1500 'cv is register to write value into DATARDY = 0 'done with this cv data 'send E7 reply OUTBYTE(1) = &HE7: OUTBYTE(2) = &HE OUTBYTE(3) = &H7C: OUTBYTE(4) = PCMD OUTBYTE(5) = PSTAT: OUTBYTE(6) = HOPSA OUTBYTE(7) = LOPSA: OUTBYTE(8) = TRK OUTBYTE(9) = CVHIGH: OUTBYTE(10) = CVLOW OUTBYTE(11) = DATA7: OUTBYTE(12) = 0 OUTBYTE(13) = 0: NUMOUTBYTES = 14 GOSUB 600 'send reply RETURN 'to 14305* 'do message in paged mode 14500 RETURN 'error 15000 LOCATE 20, 1 PRINT " ERROR "; ERR; " AT LINE "; ERL IF ERR = 5 THEN PRINT " ILLEGAL FUNCTION CALL " IF ERR = 9 THEN PRINT " SUBSCRIPT OUT OF RANGE " IF ERR = 23 THEN PRINT " LINE BUFFER OVERFLOW " IF ERR = 24 THEN PRINT " DEVICE TIME OUT " IF ERR = 24 THEN CLOSE #1 IF ERR = 52 THEN PRINT " BAD FILE NUMBER " IF ERR = 64 THEN PRINT " BAD FILE NAME " PRINT " ANY KEY TO CONTINUE " 15010 B$ = INKEY$: IF B$ = "" THEN GOTO 15010 IF ERR = 24 THEN RESUME 10 IF ERR = 52 THEN FILENUM = 1 RESUME 'end 20000 CLOSE #FILENUM END ' code begun 12/09/09 ' first reception of JMRI signal 12/2009 ' first dialog established 12/26/09 ' fixed speed update 12/27/09 ' cleaned up presentation ' DCC-MB interrupts for one loco slot 11 address 3 speed steps 28 12/27/09 ' begun DecoderPro write to register using paged addressing 1/7/10 ' fixed opcodes E7 EF read (changed 1 as temp value to 99) 1/10/10 ' began decoder programming routine 1/21/10 ' program a decoder using DecoderPro simple CV programmer 1/30/10 ' programmed simple address to CV#1 1/30/10 ' TO DO ' sense a parallel port sensor to JMRI screen ' test program to be taken into TNT