' JMRICLK.BAS JMRI clock test ' LocoNet Personal Use Edition 1.0 Specification ' Connect to JMRI via Locobuffer 19200 with Null Modem Cable ' Written by Robert Rydman for inclusion within TNT ' $INCLUDE: 'TNTCOMM' 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 STIK(4), JBUTTON(4), TTYPE(9), SPEED(9) 'JMRI COM1: DIM SHARED INBYTE(20) 'recieved bytes DIM SHARED OUTBYTE(20) 'send bytes 'LocoNet DIM SHARED SLOT(128), STAT(128) ON ERROR GOTO 15000 FHR = 6 FMN = 0 STARTTIME$ = "06:00:00" 'this test TSTARTTIME$ = STARTTIME$ 'tnt stored starttime GOSUB 3025 'make starttime CLKSPD = 4 TCLKSPD = 4 'tnt clkspd for sync as master 5 FILENUM = 1 'for com1 'IF CHAINTO = 1 THEN GOTO 9 'open com port for JMRI CMD$ = "COM1:19200,N,8,1,,,,,," 9 CLOSE OPEN CMD$ FOR RANDOM AS #1 'open com1 for jmri CLS ECHO = 1 'MAIN 10 IF CLKON = 1 THEN GOSUB 3200 'get fasttime GOSUB 100 COLOR 4 14 LOCATE 1, 1 PRINT " JMRICLK.BAS " PRINT " TRAINS'n'TERMINALS Version: 3.00.00" '(C) Robert Rydman 2010" COLOR 7 PRINT "REAL TIME: "; TIME$; " "; "FAST TIME: "; FASTTIME$ PRINT IF SYNC = 0 THEN COLOR 9 PRINT " MONITORING JMRI/LOCONET CLOCK SLOT 123 " COLOR 7 PRINT "CLKRATE"; CLKRATE PRINT "FRACMINSL"; FRACMINSL, "FRACMINSH"; FRACMINSH PRINT "MINS60:"; MINS60, "HRS24:"; HRS24, "DAYS:"; DAYS, "STARTDAY:"; STARTDAY PRINT "CLKCNTRL:"; CLKCNTRL, "JCLKON:"; JCLKON, "JCLKSTAT:"; JCLKSTAT 'PRINT IF SYNC = 1 THEN COLOR 9 PRINT " CURRENT TNT DATA " COLOR 7 PRINT "CLKSPD:"; CLKSPD PRINT "FHR:"; FHR, "FMN:"; FMN, "SEC:"; SEC, "DAY:"; DAY PRINT "CLKON:"; CLKON, "CLKSTART:"; CLKSTART PRINT "PAUSEON:"; PAUSEON, "SYNC:"; SYNC, "TIMENOW:"; TIMENOW PRINT "PAUSETIME:"; PAUSETIME PRINT " AX"; AX; " BX"; BX; " CX"; CX; " DX"; DX LOCATE 18, 1 COLOR 14: PRINT " F"; : COLOR 7: PRINT "astclock", COLOR 14: PRINT "Q"; : COLOR 7: PRINT "uit" A$ = INKEY$ IF A$ = "" THEN GOTO 10 'keyboard handler 55 IF A$ = " " THEN GOSUB 700 'spacebar emergency stop IF A$ = " " THEN GOTO 10 'return from spacebar IF LEN(A$) = 1 THEN GOTO 56 'not an F key F$ = RIGHT$(A$, 1) 'get second character of function key F = ASC(F$) 56 A$ = UCASE$(A$) 'rhr not need caps lock on F = ASC(A$) T = F - 48 'direct throttle select IF A$ = "Q" THEN GOTO 20000 'quit IF A$ = "F" THEN GOSUB 3000 'fast clock GOTO 10 'jmri input 100 IF EOF(FILENUM) THEN RETURN INBYTE$ = INPUT$(1, #1) 'input JMRI com1 INBYTE = ASC(INBYTE$) IF INBYTE > 127 THEN GOSUB 130 'INBYTE is opcode IF INBYTE < 128 THEN GOSUB 140 'INBYTE is data IF INCNTR = NUMINBYTES THEN GOSUB 150 'echo and do message GOTO 100 'opcode byte >127 1xxxxxxx 130 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 140 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 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 LOCATE 20, 1 PRINT " ECHO TO JMRI: "; PRINT SEE$; " " 'clears trailers PRINT #1, SEND$ COLOR 7 'white SELECT CASE INBYTE(1) 'JMRI opcodes CASE &H81 'opc_busy 'RETURN CASE &H82 'opc_gpoff ' GOSUB 1000 CASE &H83 'opc_gpon ' GOSUB 1001 CASE &H85 'opc_idle ' GOSUB 1010 CASE &HA0 'opc_loco_spd GOSUB 10000 CASE &HA1 'opc_loco_dirf 'GOSUB 10010 CASE &HA2 'opc_loco_snd GOSUB 10020 CASE &HB0 'opc_sw_req GOSUB 11000 CASE &HB4 'opc_long_ack GOSUB 11040 CASE &HB5 'opc_slot_stat GOSUB 11050 CASE &HB6 'opc_consist_func GOSUB 11060 CASE &HB8 'opc_unlink_slot GOSUB 11080 CASE &HB9 'opc_link_slots GOSUB 11090 CASE &HBA 'opc_mov_slot GOSUB 11100 CASE &HBB 'opc_rq_sl_data GOSUB 11110 CASE &HBC 'opc_sw_state GOSUB 11120 CASE &HBD 'opc_sw_ack GOSUB 11130 CASE &HBF 'opc_loco_adr GOSUB 11150 CASE &HE7 'opc_read slot data GOSUB 14070 CASE &HEF 'opc_write_slot_data GOSUB 14150 END SELECT RETURN 'send reply 600 CHK = &HFF 601 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 602 SEND$ = "" FOR N = 1 TO NUMOUTBYTES 'make new strings 603 SEE$ = SEE$ + HEX$(OUTBYTE(N)) + " " 604 SEND$ = SEND$ + CHR$(OUTBYTE(N)) 605 NEXT N LOCATE 21, 1 IF SEND$ = "" THEN GOTO 606 'avoids sending null message PRINT " SENT TO JMRI: "; PRINT SEE$; " " 'blank out old message PRINT #1, SEND$ 'send string 606 COLOR 7 REPLY = 0 'reply is sent RETURN 'spacebar pause - stop all trains 700 'FOR N = 1 TO 9 ' TEMPSPD(N) = SPEED(N) ' SPEED(N) = 0 'NEXT N PAUSEON = PAUSEON + 1 'JMRI pause IF PAUSEON = 2 THEN GOTO 755 'second spacebar - reset CLKON = 0 'stop clock PTIMESTART = FIX(TIMER) 'this pause start IF SYNC = 1 THEN GOSUB 3500 RETURN '[Home] resume from pause 750 'FOR N = 1 TO 9 'restore speeds ' SPEED(N) = TEMPSPD(N) 'NEXT N PTIMEEND = FIX(TIMER) 'this pause end time THISPAUSE = PTIMEEND - PTIMESTART 'elapsed time of this pause PAUSETIME = PAUSETIME + THISPAUSE 'accumulated pause time 752 PAUSEON = 0 CLKON = 1 'here for JMRI pause off IF SYNC = 1 THEN GOSUB 3500 RETURN 'reset at second spacebar 755 LOCATE 22, 1 PRINT " " PRINT " " PAUSEON = 0 PAUSETIME = 0 IF SYNC = 1 THEN GOSUB 3500 RETURN 'clock menu 3000 CLS 3001 IF CLKON = 1 THEN GOSUB 3200 'get fasttime 3002 GOSUB 100 3003 LOCATE 1, 1 PRINT PRINT PRINT "REAL TIME: "; TIME$; " "; "FAST TIME: "; FASTTIME$ IF SYNC = 0 THEN PRINT " JMRI IS MASTER CLOCK " IF SYNC = 1 THEN PRINT " TNT IS MASTER CLOCK " PRINT PRINT " 1. SET FASTTIME RATIO NOW IS: "; CLKSPD; ":1" PRINT " 2. SET CLOCK START TIME NOW IS: "; STARTTIME$ PRINT PRINT " 3. START FASTCLOCK AT "; TSTARTTIME$ 'tnt start time PRINT PRINT " 4. STOP FASTCLOCK " PRINT " 5. RESET FASTCLOCK " PRINT PRINT " 6. RESUME FASTCLOCK " IF SYNC = 0 THEN PRINT " 7. MAKE TNT CLOCK MASTER " END IF IF SYNC = 1 THEN PRINT " 7. MAKE JMRI CLOCK MASTER " END IF PRINT PRINT " ANY OTHER KEY WILL RETURN " A$ = INKEY$: IF A$ = "" THEN GOTO 3001 A = VAL(A$) IF A < 1 OR A > 7 THEN GOTO 3006 3005 ON A GOSUB 3010, 3020, 3030, 3040, 3050, 3060, 3070 IF A = 3 OR A = 6 THEN GOTO 3006 GOTO 3000 'to set or reset fast clock 3006 A$ = "" 'clear to avoid main screen calls CLS RETURN 'clkspd 3010 IF CLKON = 1 THEN RETURN CLS PRINT " ENTER THE FACTOR BY WHICH TIME WILL BE MULTIPLIED" PRINT PRINT " 1 Fast Clock will run normal time " PRINT " 2 A 'half time' CLOCK 8 HRS => 4 hrs" PRINT " 3 A 'one third time' CLOCK 12 HRS => 4 hrs" PRINT " 4 A 'quarter time' CLOCK 12 HRS => 3 hrs and 8HRS => 2hrs" PRINT " 6 12 HRS => 2hrs 24 HRS => 4 hrs " PRINT " 8 8 HRS => 1hr" PRINT " 12 12 HRS => 1hr" PRINT INPUT " ENTER FAST CLOCK FACTOR ie; 1,2,3,4,6,8,12 TIMES FASTER"; CLKSPD IF CLKSPD < 1 OR CLKSPD > 12 THEN GOTO 3010 TCLKSPD = CLKSPD 'tnt clkspd CLS RETURN 'input starttime$ and make starttime 3020 IF CLKON = 1 THEN RETURN CLS TEMP$ = STARTTIME$ GOSUB 3300 'gets HR$, MIN$ 3022 LOCATE 10, 1 PRINT " START TIME IS SET AT "; STARTTIME$ PRINT INPUT " ENTER START HOUR 00 to 23 "; FHR$ IF FHR$ = "" THEN GOTO 3023 FHR = VAL(FHR$) IF FHR < 0 OR FHR > 23 THEN GOTO 3020 IF LEN(FHR$) < 2 THEN FHR$ = "0" + FHR$ HR$ = FHR$ GOSUB 3024 'make new starttime 3023 CLS LOCATE 10, 1 PRINT " START TIME IS SET AT "; STARTTIME$ PRINT INPUT " ENTER START MINUTE 00 to 59 "; FMN$ IF FMN$ = "" THEN GOTO 3024 MIN = VAL(FMN$) IF MIN < 0 OR MIN > 59 THEN GOTO 3023 IF LEN(FMN$) < 2 THEN FMN$ = "0" + FMN$ MIN$ = FMN$ 3024 SEC$ = "00" STARTTIME$ = HR$ + ":" + MIN$ + ":" + SEC$ 'session start time 3025 FASTTIME$ = STARTTIME$ 'set to current starttime$ TSTARTTIME$ = STARTTIME$ 'save as tnt starttime TEMP$ = STARTTIME$ GOSUB 3300 'make starttime in seconds STARTTIME = SUMTIME 'seconds past midnight of fasttime DAY = 0 CLS 3028 RETURN 'start clock at starttime$ 3030 IF CLKON = 1 THEN RETURN STARTTIME$ = TSTARTTIME$ 3031 FASTTIME$ = STARTTIME$ 'defined session starttime 3032 PAUSETIME = 0 PAUSEON = 0 CLKON = 1 CLKRATE = CLKSPD TEMP$ = STARTTIME$ GOSUB 3300 STARTTIME = SUMTIME CLKSTART = FIX(TIMER) 'true clock start seconds from 00:00:00 GOSUB 3200 3035 IF SYNC = 1 THEN GOSUB 3500 'inform JMRI RETURN 'stop clock 3040 IF CLKON = 0 THEN RETURN 'already stopped 3041 CLKON = 0 'stop clock PAUSEON = 1 PTIMESTART = FIX(TIMER) 'this pause start IF SYNC = 1 THEN GOSUB 3500 RETURN 'reset clock to tstarttime and tclkspd 3050 IF CLKON = 1 THEN RETURN 'no reset clock STARTTIME$ = TSTARTTIME$ 'tnt starttime FASTTIME$ = STARTTIME$ 'reset fasttime$ DAY = 0 PAUSETIME = 0 'reset pause PTIMESTART = 0 PTIMEEND = 0 THISPAUSE = 0 PAUSEON = 0 JCLKSTAT = 0 JCLKON = 0 CLKRATE = CLKON CLKSPD = TCLKSPD 'tnt clkspd TEMP$ = FASTIME$ GOSUB 3300 STARTTIME = SUMTIME IF SYNC = 1 THEN GOSUB 3500 CLS RETURN 'resume from pause 3060 IF CLKON = 1 OR PAUSEON = 0 THEN RETURN CLKON = 1 CLKRATE = CLKSPD PTIMEEND = FIX(TIMER) 'pause end time THISPAUSE = PTIMEEND - PTIMESTART PAUSETIME = PAUSETIME + THISPAUSE 'total time paused 3062 PAUSEON = 0 GOSUB 3200 IF SYNC = 1 THEN GOTO 3500 RETURN 'toggle master clock source 3070 SYNC = SYNC + 1 IF SYNC > 1 THEN SYNC = 0 CLKRATE = CLKSPD 'get tnt clkspd IF CLKON = 0 THEN CLKRATE = 0 RETURN 'calculate current fasttime in seconds 'done each screen rewrite when clkon 3200 TIMENOW = FIX(TIMER) 'actual true time TIMENOW = TIMENOW - PAUSETIME 'less true time paused IF TIMENOW < CLKSTART THEN TIMENOW = TIMENOW + 86400 'rollover 24 hrs TELAPSED = TIMENOW - CLKSTART 'true seconds since start FASTTIME = STARTTIME + (TELAPSED * CLKSPD) 'make fasttime from true time 3210 FOR N = 1 TO 48 'make fasttime$ TEMP = 3600 * N 'seconds in hour IF TEMP < FASTTIME OR TEMP = FASTTIME THEN GOTO 3215 FHR = N - 1 REMAIN = FASTTIME - (FHR * 3600) GOTO 3220 3215 NEXT N 3220 IF FHR > 23 THEN DAY = 1 IF DAY = 1 THEN FHR = FHR - 24 FOR N = 1 TO 60 'minutes in hour TEMP = 60 * N IF TEMP < REMAIN OR TEMP = REMAIN THEN GOTO 3225 FMN = N - 1 SEC = REMAIN - (FMN * 60) 'seconds after hours and minutes GOTO 3230 3225 NEXT N 3230 IF FHR > 9 THEN GOTO 3235 'make fasttime string FHR$ = STR$(FHR) T$ = RIGHT$(FHR$, 1) FHR$ = "0" + T$ GOTO 3240 3235 T$ = STR$(FHR) FHR$ = RIGHT$(T$, 2) 3240 IF FMN > 9 THEN GOTO 3245 FMN$ = STR$(FMN) T$ = RIGHT$(FMN$, 1) FMN$ = "0" + T$ GOTO 3250 3245 T$ = STR$(FMN) FMN$ = RIGHT$(T$, 2) 3250 IF SEC > 9 THEN GOTO 3255 SEC$ = STR$(SEC) T$ = RIGHT$(SEC$, 1) SEC$ = "0" + T$ GOTO 3260 3255 T$ = STR$(SEC) SEC$ = RIGHT$(T$, 2) 3260 FASTTIME$ = FHR$ + ":" + FMN$ + ":" + SEC$ 'is fasttime$ IF CLKON = 1 AND SYNC = 1 AND SEC = 0 THEN GOSUB 3500 RETURN 'converts temp$ time to sumtime seconds 3300 HR$ = LEFT$(TEMP$, 2): MIN$ = MID$(TEMP$, 4, 2) 'hrs, min, sec as integer total seconds SEC$ = RIGHT$(TEMP$, 2) HRS = VAL(HR$): MIN = VAL(MIN$): SEC = VAL(SEC$) SUMTIME = (HRS * 3600) + (MIN * 60) + SEC RETURN 'setup for sync message 3500 SLOT = &H7B GOSUB 11115 RETURN 'LOCONET OPCODE ROUTINES '&HA0 opc_loco_spd 10000 SLOT = INBYTE(2) T = FIX(SLOT / 10) A = SLOT - (T * 10) SPEED(T) = INBYTE(3) 'set loco speed 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) STAT(SLOT) = INBYTE(3) 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 = INBYTE(2) STAT(SRC) = 0 'source slot open DEST = INBYTE(3) IF DEST > 119 OR DEST > 119 THEN GOTO 11102 'illegal move T = FIX(DEST / 10) 'get T and A of source A = DEST - (T * 10) SLN = DEST SLOT(SLN) = AADDR(T, A) 'assign address to this slot 'set for E7 slot read STAT(SLN) = 48 '00110000 in use STAT = STAT(SLN) ADR = SLOT(SLN) SLOT = SLN SPD = 0 DIRF = &H30 TRK = 7 SS2 = 0 ADR2 = 0 SND = 0 ID1 = 1 '&H17 ID2 = SLOT '&H6F NUMOUTBYTES = 14 GOTO 14080 'sendreply &HE7 'illegal move LACK 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 &HEF read clock 11110 SLOT = INBYTE(2) 'requested slot IF SLOT = &H7B THEN GOTO 11115 'clk slot T = FIX(SLOT / 10) A = SLOT - (T * 10) STAT = STAT(SLOT) ADR = SLOT(SLOT) 'address low SPD = SPEED(T) '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 dddddddd '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 not in DCC-MB SND = 0 'sound bits ID1 = 1 ID2 = SLOT GOTO 14080 'reply &HE7 slot read '&HBB read clock slot data 11115 CLKRATE = CLKSPD 'from TNT IF CLKON = 0 THEN CLKRATE = 0 'clock is off 'LNTICS = FIX(SEC / .065535) 'LN tics can be > 127 'IF LNTICS > 127 THEN GOTO 11116 'FRACMINSL = 128 - LNTICS 'FRACMINSH = 0 'GOTO 11118 11116 FRACMINSL = &H7F '127 'zero seconds cheap fix FRACMINSH = &H78 '120 MINS60 = FMN + 67 TRK = 7 HRS24 = FHR + 104 DAYS = DAYS CLKCNTRL = 0 '64 '01000000 ID1 = &H7F 'reserved for PC access ID2 = &H7B '&H7B is clock slot 'clock reply 11118 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) = CLKCNTRL: OUTBYTE(12) = ID1 OUTBYTE(13) = ID2 NUMOUTBYTES = 14 REPLY = 1 GOSUB 600 'sendreply 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 REQADDR = INBYTE(3) 'requested address SLN = 0 'clear sln FOR T = 1 TO 9 IF TTYPE(T) <> 4 THEN 11153 'JMRI throttle type 4 FOR A = 1 TO 4 'assigned position JMRI throttle IF AADDR(T, A) <> REQADDR THEN 11152 'not here SLN = (T * 10) + A 'this t,a is assigned in tnt SLOT(SLN) = AADDR(T, A) 'this is it GOTO 11154 'found slot 11152 NEXT A 11153 NEXT T IF SLN = 0 THEN RETURN 'not found 11154 SLOT = SLN STAT(SLN) = &H23 STAT = STAT(SLN) 'for this reply ADR = SLOT(SLN) SPD = 0 DIRF = 48 'forward(32) and lights on(16) TRK = &H7 'TRK is in tnt SS2 = 0 ADR2 = 0 'adr2 not allowed in DCC-MB SND = 0 ID1 = 1 ID2 = SLOT 'makes unique ID '&H6F GOTO 14080 'send E7 LACK reply '&HE6 opc_sync_reply 'undocumented in PUE 14060 RETURN '&HE7 opc_sl_rd_data 14070 SLOT = INBYTE(3) IF SLOT = 123 THEN GOTO 11115 STAT = STAT(SLOT) ADR = SLOT(SLOT) SPD = 0 DIRF = &H30 TRK = 7 '00000111 SS2 = 0 ADR2 = 0 SND = 0 'ID1 = &H17 'ID2 = &H6F ID1 = 1 ID2 = SLOT 'to establish unique ID 'Setup Long Acknowledge 14080 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 'checksum calculated in sendreply NUMOUTBYTES = 14 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 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 '&HB4 reply long ack 'clock_write_data writes to TNT clock slot 14160 IF SYNC = 1 THEN RETURN CLKRATE = INBYTE(4) 'get all clock slot data FRACMINSL = INBYTE(5) FRACMINSH = INBYTE(6) MINS60 = INBYTE(7) TRK = INBYTE(8) HRS24 = INBYTE(9) DAYS = INBYTE(10) CLKCNTRL = INBYTE(11) ID1 = INBYTE(12) ID2 = INBYTE(13) 'convert message to tnt actions IF CLKRATE = 0 THEN JCLKON = 0 'turn TNT clock off IF CLKRATE > 0 THEN JCLKON = 1 'turn TNT clock on IF JCLKON = 1 THEN CLKSPD = CLKRATE 'sets clkspd FHR = HRS24 - 104 '127 - 23 FMN = MINS60 - 67 '127 - 60 LNTICS = (128 * (FRACMINSH - 120)) + (FRACMINSL - 127) 'LocoNet tics SEC = FIX(LNTICS * .065535) IF JCLKSTAT = 1 THEN GOTO 14164 'has been initialized STARTDAY = DAYS 'not initialized not running GOSUB 3230 'make jmri fasttime$ STARTTIME$ = FASTTIME$ 'make this starttime$ IF JCLKON = 1 THEN GOSUB 3031 'jmri start clock JCLKSTAT = 1 'jmri clk has been turned on 14164 'IF CLKON = 1 OR JCLKON = 0 THEN GOTO 14165 GOSUB 3230 'make jmri fasttime$ STARTTIME$ = FASTTIME$ 'make this starttime$ IF JCLKON = 1 THEN GOSUB 3031 'jmri start clock 14165 CLKON = JCLKON IF JCLKSTAT = 1 AND JCLKON = 0 AND PAUSEON = 0 THEN GOSUB 3040 'jmri issued pause IF JCLKSTAT = 1 AND JCLKON = 1 AND PAUSEON = 1 THEN GOSUB 3060 'resume 'DAY = DAYS - STARTDAY 14166 GOSUB 3230 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 RETURN '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 '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 = 57 THEN PRINT " DEVICE I/O ERROR " IF ERR = 64 THEN PRINT " BAD FILE NAME " IF ERR = 57 THEN GOTO 15015 PRINT " ANY KEY TO CONTINUE " 15010 B$ = INKEY$: IF B$ = "" THEN GOTO 15010 IF ERR = 52 THEN FILENUM = 1 15011 LOCATE 19, 1 PRINT " " PRINT " " PRINT " " RESUME 10 15015 CLOSE #1 OPEN CMD$ FOR RANDOM AS #1 GOTO 15011 'utilities 16000 UTIL = 1 CHAINTO = 12000 CHAIN "TNTPRO" 'end 20000 CLS PRINT " DO YOU WANT TO EXIT THE PROGRAM: Y or N ?" 20010 A$ = INKEY$: IF A$ = "" THEN GOTO 20010 A$ = UCASE$(A$) IF A$ = "Y" THEN GOTO 20999 CLS RETURN 20999 CLOSE 'close all com and files END 'START TEST OF JAVA CLOCK FEBRUARY 16,2010 'fixed hours and modulo conventions