DECLARE SUB Delay (nseconds!)
'Program CONT_CPN.EXE for controlling Campbell Pacific Nuclear International
'model 503DR neutron moisture gauge.

'***********************************************************************
'Find number of cycles needed in FOR-NEXT loop to give
'nseconds! = 1!
FindDelayMult:
'ON ERROR GOTO FindDelayMultErr
dtime = TIMER
FOR i! = 1 TO 10000!
    dt = dt + 1
NEXT i!
dtime = TIMER - dtime
nseconds! = 1!
DelayNum = 10000! * nseconds! / dtime'Number of loops for nseconds! s
ON ERROR GOTO 0
PRINT dtime

bksp$ = CHR$(29)
k% = 1000
answer$ = " yesYES"
ack% = 6
nak% = 21
cr% = 13
cr$ = CHR$(13)
ff$ = CHR$(12)
lf$ = CHR$(10)
bk% = 0
Ctrl.R$ = CHR$(4) + CHR$(18)
Ctrl.T$ = CHR$(4) + CHR$(20)
baudrate% = 1200
command.delay! = 1.5
NUL$ = CHR$(0)
BELL$ = CHR$(7)
comm$ = "COM1"

CLS
FileErr% = 0
ON ERROR GOTO FileOpenErr
OPEN "i", #3, "CONT_CPN.DAT"
CLOSE #3
ON ERROR GOTO 0
IF FileErr% = 1 THEN
    OPEN "o", #3, "CONT_CPN.DAT"
ELSE
    PRINT "File CONT_CPN.DAT already exists."
    PRINT "Press [A] to append to it, [O] to overwrite it,"
    PRINT "or [N] to enter a new file name";
    y$ = UCASE$(INPUT$(1))
    SELECT CASE y$
    CASE "O"
        OPEN "o", #3, "CONT_CPN.DAT"
    CASE "A"
        OPEN "a", #3, "CONT_CPN.DAT"
    CASE "N"
NewFile:
        LOCATE 12, 1
        PRINT SPACE$(80);
        LOCATE 12, 1
        INPUT "Enter new file name in DOS 8.3 format:"; filename$
        'test new file name
        FileErr% = 0
        ON ERROR GOTO FileOpenErr
            OPEN "i", #3, filename$  'does it exist?
            IF FileErr% = 1 THEN
                FileErr% = 0            'file doesn't exist (or name is bad)
                OPEN "o", #3, filename$ 'try to open it.
            ELSE
                'file exists
                PRINT "File "; filename$; " already exists."
                PRINT "Press [A] to append to it, [O] to overwrite it,"
                PRINT "or [N] to enter a new file name";
                y$ = UCASE$(INPUT$(1))
                SELECT CASE y$
                CASE "O"
                    OPEN "o", #3, filename$
                CASE "A"
                    OPEN "a", #3, filename$
                CASE "N"
                    CLS : GOTO NewFile
                CASE ELSE
                    CLS : GOTO NewFile
                END SELECT
            END IF
            IF FileErr% = 1 THEN
                PRINT "File name "; filename$; " is improper."
                PRINT "Press a key to enter a different name."
                y$ = INPUT$(1)
                CLS : GOTO NewFile
            END IF
        ON ERROR GOTO 0
    CASE ELSE
        OPEN "a", #3, "CONT_CPN.DAT"
    END SELECT
END IF

MainMenu:
CLS
LOCATE 1, 1
PRINT TAB(5); "Program CONT_CNP to control CPNI 503DR neutron moisture gauge, 10 Dec. 1998."
PRINT TAB(5); "Written by S.R. Evett, USDA-ARS, P.O. Drawer 10, Bushland, TX, 79012 USA"
PRINT TAB(5); "Press Ctrl_Break to stop program execution."
PRINT
PRINT TAB(5); "CONNECT SERIAL CABLE BETWEEN COMPUTER and 503DR BEFORE PROCEEDING."
PRINT TAB(5); "The program baud rate is set to "; LTRIM$(STR$(baudrate%)); " baud ";
PRINT "using "; comm$; "."
PRINT
PRINT TAB(5); "Press [B] to change baud rate, [C] to change comm port,"
PRINT TAB(5); "[H] for help, or press Enter to run program...";
y$ = UCASE$(INPUT$(1))
SELECT CASE y$
CASE "B"
    LOCATE 10, 1
    INPUT "Enter new baud rate (9600, 4800, 2400, 1200, 300)"; newbaud%
    SELECT CASE newbaud%
    CASE 75, 150, 300, 1200, 2400, 4800, 9600
        baudrate% = newbaud%
    CASE ELSE
        PRINT "Baud rate"; newbaud%; "not acceptable...": SLEEP 2
    END SELECT
    GOTO MainMenu
CASE "C"
    LOCATE 10, 1
    PRINT "Press [1] for COM1 or [2] for COM2";
    y% = VAL(INPUT$(1))
    SELECT CASE y%
    CASE 1
        comm$ = "COM1"
    CASE 2
        comm$ = "COM2"
    CASE ELSE
        PRINT "COM"; LTRIM$(STR$(y%)); " not acceptable...": SLEEP 2
    END SELECT
    GOTO MainMenu
CASE "H"
    GOSUB Help
    GOTO MainMenu
CASE CHR$(13)
CASE ELSE
    GOTO MainMenu
END SELECT


PRINT #3, "CPN 503DR data downloaded on: "; DATE$
PRINT #3, "at: "; TIME$

OPEN comm$ + ":" + LTRIM$(STR$(baudrate%)) + ",N,8,2,CS,DS,CD" FOR RANDOM AS #1:

WHILE ans$ <> "Q"
    LOCATE 12, 1
    PRINT SPACE$(80);
    LOCATE 12, 1
    PRINT "Make sure 503DR is set to "; LTRIM$(STR$(baudrate%)); " baud."
    PRINT "Press [D] to dump data, [S] for standard count, or [Q]uit:";
    ans$ = UCASE$(INPUT$(1))
    PRINT ans$
'    SLEEP

    SELECT CASE ans$
    CASE "D"
        WHILE y$ <> "C" AND y$ <> "L"
            LOCATE 20, 1
            PRINT "Press [C] for PRINT CD or [L] for PRINT LP:";
            y$ = UCASE$(INPUT$(1))
        WEND
        PRINT y$
        IF y$ = "C" THEN GOSUB DataDump
        IF y$ = "L" THEN GOSUB PrintLPDump
    CASE "S"
        GOSUB GetStdCnt
    CASE ELSE
    END SELECT
WEND
END

GetStdCnt:
j = 0                'count number of good data
neutroncount = 0     'neutron count
neutroncount2 = 0    'square of neutron count
neutcntsum = 0       'sum of neutron counts
sumneutcnt2 = 0      'sum of squares
DO
PRINT
PRINT "Working, press Ctrl_Break to quit..."
GOTO StartStd

'Next few lines are for the programmer to send commands manually to the 503DR:
quit$ = CHR$(0) + CHR$(16)
PRINT "Press Alt_Q to quit, or press any key to transmit to 503DR"
a$ = "s"
WHILE a$ <> "": a$ = INKEY$: WEND'Clear buffer
a$ = ""
DO
    LOCATE 12, 1
    PRINT "Press a key";
    WHILE a$ = "": a$ = INKEY$: WEND
    IF LEN(a$) > 0 THEN LOCATE 12, 1: PRINT SPACE$(80);
    IF LEN(a$) = 0 THEN a$ = cr$
    y = ASC(RIGHT$(a$, 1))
    LOCATE 13, 1: PRINT "String, ASCII value, ASCII w/ null stripped:"
    PRINT a$; ASC(a$); y
    IF a$ = quit$ THEN EXIT DO
    IF LEN(a$) >= 0 THEN PRINT #1, a$;
    a$ = ""
    Delay (command.delay!)
    LOCATE 14, 1: PRINT SPACE$(80);
LOOP

StartStd:
'Next few lines are to start standard count
'Delay (1.)
'PRINT #1, cr$;
'Delay (1.)
'PRINT #1, cr$;
'Delay (command.delay!)
'PRINT #1, cr$;
IF SuppressCtrl.R% < 1 THEN
    Delay (command.delay!)
    PRINT #1, Ctrl.R$;  'Control "R"
    Delay (command.delay!)
    PRINT #1, Ctrl.R$;  'Control "R"
END IF
Delay (command.delay!)
PRINT #1, Ctrl.R$;  'Control "R"
Delay (command.delay!)
PRINT #1, "g";        'STD CNT
'Delay (1.)
'PRINT "For z.......Press a key...": SLEEP
'PRINT #1, "z"; 'lf$        'LF
'Delay (1.)
'PRINT "For z......Press a key...": SLEEP
'PRINT #1, "z"; 'lf$        'LF
Delay (command.delay!)
PRINT #1, "g";        'START
'Delay (1!)
'PRINT #1, Ctrl.R$;  'Control "R"
'Delay (command.delay!)
'PRINT #1, cr$;
'Delay (1.)
'PRINT #1, CR$;
'Delay (1.)
'PRINT #1, CR$;
'PRINT "Press a key...": SLEEP
'PRINT "Enter Ctrl_R"
'CtrlR$ = INKEY$
'PRINT #1, CtrlR$
'SLEEP
'Delay (1.)

i% = 0
DO
i% = i% + 1
GOSUB GetStdCntLine

IF LEN(Tline$) > 0 THEN
    nogood% = 0
    SuppressCtrl.R% = 0
    IF INSTR(Tline$, "COUNTING") THEN nogood% = 1
    IF INSTR(Tline$, "READY") THEN nogood% = 1
    IF INSTR(Tline$, "G16") THEN nogood% = 1: SuppressCtrl.R% = 1
    IF INSTR(Tline$, "1.CT") THEN nogood% = 1
    IF nogood% < 1 THEN 'INSTR(Tline$, "M") THEN
        j = j + 1'count number of good data
        'get numbers only out of Tline$
        length% = LEN(Tline$)
        dum$ = ""
        FOR i% = 1 TO length%
            s$ = MID$(Tline$, i%, 1)
            SELECT CASE s$
            CASE "1", "2", "3", "4", "5", "6", "7", "8", "9", "0"
                dum$ = dum$ + s$
            CASE ELSE
            END SELECT
        NEXT i%
        Tline$ = dum$
        neutroncount = VAL(Tline$)                  'get count number
        PRINT "neutron count"; neutroncount
        neutroncount2 = neutroncount * neutroncount 'square it
        sumneutcnt2 = sumneutcnt2 + neutroncount2   'build sum of squares
        neutcntsum = neutcntsum + neutroncount      'sum counts
        IF j = 20 THEN
            'calculate statistics and print them
            mean = neutcntsum / j
            sd = SQR((j * sumneutcnt2 - neutcntsum ^ 2) / (j * (j - 1)))
            mean$ = "mean:" + STR$(mean)
            sd$ = "SD:" + STR$(sd)
            'PRINT mean, sd: SLEEP
            chiratio$ = "Chi ratio:" + STR$(sd / SQR(mean))
            Tline$ = Tline$ + ", " + mean$ + ", " + sd$ + ", " + chiratio$
            PRINT #3, DATE$; " "; TIME$; " "; Tline$
            j = 0                'count number of good data
            neutroncount = 0     'neutron count
            neutroncount2 = 0    'square of neutron count
            neutcntsum = 0       'sum of neutron counts
            sumneutcnt2 = 0      'sum of squares
        ELSE
            PRINT #3, DATE$; " "; TIME$; " "; Tline$
        END IF
        GOSUB PrintTline
        PRINT i%
        EXIT DO
    END IF
END IF
GOSUB PrintTline
PRINT i%
IF k = 0 THEN EXIT DO
LOOP

Delay (command.delay!)
PRINT #1, Ctrl.T$;   'Disable terminal mode
Delay (command.delay!)
PRINT #1, CHR$(27);  'CLEAR command

LOOP
RETURN

DataDump:
PRINT
PRINT "   For data download the 503DR must be in PRINT CD mode."
PRINT "   Press PRINT on the 503DR."
PRINT
PRINT "   If you see PRINT CD then press CLEAR, and press Enter on the computer."
PRINT
PRINT "   If you see PRINT LP then press STEP until you see PRINT CD."
PRINT "   Next, press Enter on the computer."
PRINT "   Then, after 3 seconds, press ENTER on the 503DR."
PRINT
INPUT ""; ans$

'Next six lines are to start data dump:
PRINT #1, cr$;
Delay (command.delay!)
PRINT #1, "p";
Delay (command.delay!)
PRINT #1, CHR$(13);
Delay (command.delay!)

resp% = cr%
IF LOC(1) <> 0 THEN junk$ = INPUT$(1, #1)'get garbage from serial port"

GOSUB GetLine
PRINT #3, Tline$
GOSUB PrintTline
nlines% = VAL(Tline$)
PRINT "Number of lines to receive ="; nlines%

'now get data and put in file
k% = 100'initialize timer
numlin% = 0
WHILE (k% > 0) AND (NOT bk%)
    numlin% = numlin% + 1
    GOSUB GetLine
    'IF (k% = 0) OR bk% THEN GOTO 510
    IF (k = 0) THEN
        PRINT numlin%; " lines were downloaded."
        PRINT nlines%; " lines were expected."
        INPUT "Press [C] to download more lines, or [Q] to quit:"; ans$
        ans$ = UCASE$(ans$)
        IF ans$ = "Q" THEN GOTO 510
    END IF
    IF LEN(Tline$) > 0 THEN PRINT #3, Tline$
    IF numlin% > nlines% - 1 THEN
         Tline$ = Tline$ + "$$EXTRA DATA LINE$$"
    END IF
    GOSUB PrintTline
WEND
510

PRINT #1, CHR$(ack%);
CLOSE
RETURN

GetLine:
Delay (command.delay!)
PRINT #1, CHR$(resp%);
Tline$ = ""
cksum% = 0 'reset checksum for new record

710
'waittime = TIMER   '
k = 10
WHILE (LOC(1) = 0) AND (k > 0)
    k = k - 1
    Delay (command.delay!)
WEND
IF k = 0 THEN PRINT "Nothing there...": RETURN 'nothing there

char$ = INPUT$(1, #1)
'PRINT char$
IF ASC(char$) = 13 THEN GOTO 810'is it the end of record?
'if inkey$<>"" then error
IF char$ <> NUL$ AND char$ <> BELL$ AND char$ <> lf$ THEN Tline$ = Tline$ + char$
numb% = ASC(char$)
cksum% = cksum% + numb%
GOTO 710

810 'end of record processing
'PRINT Tline$: 'SLEEP
IF LOC(1) = 0 THEN GOTO 810
char$ = INPUT$(1, #1)'discard line feed
lastchar% = LEN(Tline$)
lstcomma% = lastchar%'initialize comma pointer
comchar$ = MID$(Tline$, lstcomma%, 1)
WHILE comchar$ <> ","
    cksum% = cksum% - ASC(comchar$)
    lstcomma% = lstcomma% - 1 'remove checksum characters from checksum
    comchar$ = MID$(Tline$, lstcomma%, 1)'and find the transimitted checksum field
WEND
'PRINT cksum%: 'SLEEP
'PRINT lastchar%, lstcomma%
'PRINT RTRIM$(LTRIM$(RIGHT$(Tline$, lastchar% - lstcomma%)))
'PRINT VAL(RTRIM$(LTRIM$(RIGHT$(Tline$, lastchar% - lstcomma%)))): SLEEP
IF cksum% = VAL(LTRIM$(RIGHT$(Tline$, lastchar% - lstcomma%))) THEN
    resp% = ack%
    display$ = "OK"
ELSE
    resp% = nak%
    display$ = " REPT"
    GOTO GetLine
END IF
RETURN

GetStdCntLine:
Delay (command.delay!)
'PRINT #1, CHR$(resp%); 'is a prompt needed?
Tline$ = ""
cksum% = 0 'reset checksum for new record

1010
'waittime = TIMER   '
k = 35 / command.delay!  '35 seconds '15
WHILE (LOC(1) = 0) AND (k > 0) 'disable timeout
    k = k - 1
    Delay (command.delay!)
WEND
IF k = 0 THEN PRINT "Nothing there...": RETURN 'nothing there

char$ = INPUT$(1, #1)
IF ASC(char$) = 13 THEN GOTO 1810  'is it the end of record?
'if inkey$<>"" then error
IF char$ <> NUL$ AND char$ <> BELL$ AND char$ <> lf$ THEN
    Tline$ = Tline$ + char$
'Tline$ = Tline$ + char$
    numb% = ASC(char$)
    cksum% = cksum% + numb%
END IF
GOTO 1010

1810 'end of record processing
IF LOC(1) = 0 THEN GOTO 1010 'possible endless loop here

RETURN

char$ = INPUT$(1, #1)                  'discard line feed
lastchar% = LEN(Tline$)
lstcomma% = lastchar%                  'initialize comma pointer
comchar$ = MID$(Tline$, lstcomma%, 1)
WHILE comchar$ <> ","
    cksum% = cksum% - ASC(comchar$)
    lstcomma% = lstcomma% - 1 'remove checksum characters from checksum
    comchar$ = MID$(Tline$, lstcomma%, 1)'and find the transimitted checksum field
WEND
IF cksum% = VAL(RIGHT$(Tline$, lastchar% - lstcomma%)) THEN
    resp% = ack%
    display$ = "OK"
ELSE
    resp% = nak%
    display$ = " REPT"
    GOTO GetLine
END IF
RETURN

PrintTline:
PRINT Tline$; TAB(60); cksum%; TAB(70); resp%; display$
RETURN

PrintLPTline:
PRINT Tline$
RETURN

PrintLPDump:
PRINT
PRINT "   For data download the 503DR must be in PRINT LP mode."
PRINT "   Press PRINT on the 503DR."
PRINT
PRINT "   If you see PRINT CD then press STEP until you see PRINT LP."
PRINT "   Next, press Enter on the computer, and immediately after that"
PRINT "   press ENTER on the 503DR."
PRINT
PRINT "   If you see PRINT LP then press Enter on the computer."
PRINT "   Then, immediately press ENTER on the 503DR."
PRINT
INPUT ""; ans$

'IF LOC(1) <> 0 THEN junk$ = INPUT$(1, #1)'get garbage from serial port"

GOSUB GetLPLine
PRINT #3, Tline$
GOSUB PrintLPTline

'now get data and put in file
k% = 100'initialize timer
numlin% = 0
WHILE (k% > 0) AND (NOT bk%)
    numlin% = numlin% + 1
    GOSUB GetLPLine
    IF (k = 0) THEN
        'PRINT numlin%; " lines were downloaded."
        'PRINT nlines%; " lines were expected."
        INPUT "Press [C] to download more lines, or [Q] to quit:"; ans$
        ans$ = UCASE$(ans$)
        IF ans$ = "Q" THEN GOTO 2510
    END IF
    IF LEN(Tline$) > 0 THEN PRINT #3, Tline$
    GOSUB PrintLPTline
WEND
2510

CLOSE
RETURN

GetLPLine:
Tline$ = ""

3710
k = 10
WHILE (LOC(1) = 0) AND (k > 0)
    k = k - 1
    Delay (command.delay!)
WEND
IF k = 0 THEN PRINT "Nothing there...": RETURN 'nothing there

char$ = INPUT$(1, #1)
IF ASC(char$) = 13 THEN GOTO 3810'is it the end of record?
SELECT CASE char$
CASE NUL$, BELL$, lf$, CHR$(12), CHR$(27), CHR$(15)
    'discard these characters
CASE ELSE
    Tline$ = Tline$ + char$
END SELECT
GOTO 3710

3810 'end of record processing
IF LOC(1) = 0 THEN GOTO 3810
char$ = INPUT$(1, #1)   'discard line feed
RETURN

Help:
CLS
PRINT "Program CONT_CPN.EXE was written in Microsoft Professional BASIC, ver. 7.1"
PRINT "and runs under DOS or in a DOS window under Windows 95.  DOS is preferred."
PRINT "When running under Windows 95 there may be problems with serial port"
PRINT "handling that cause communication failures.  One key to running under"
PRINT "Windows 95 will be to keep the focus on the DOS window running CONT_CPN.EXE."
PRINT "The best solution for use with Windows 95 is to use the boot to DOS feature"
PRINT "found in the shutdown menu."
PRINT
PRINT "The program has two purposes.  One is to collect previously logged data from"
PRINT "the Campbell Pacific Nuclear International 503DR neutron moisture gauge using"
PRINT "the PRINT CD protocol.  The other purpose is to collect a string of counts"
PRINT "automatically and calculate mean, standard deviation (SD), and Chi ratio for"
PRINT "every 20 counts.  In both cases the data are stored in file CONT_CPN.DAT.  The"
PRINT "program will append data to this file if it exists when the program is run."
PRINT
PRINT "The internal battery of the 503DR cannot run it for very long during serial"
PRINT "communications, so make sure that the battery charger is hooked up to the"
PRINT "503DR before beginning.  Also make sure that the 503DR is set to PRINT CD if"
PRINT "previously logged data are to be downloaded.  In any case, make sure that the"
PRINT "baud rates used by the program and DR503 are the same.  Use the serial cable"
PRINT "sold by CPNI to connect the computer to the 503DR.  As of December 1998"
PRINT "the program does not work with the newest version of 503DR that uses the "
PRINT "alkaline battery pack.                              PRESS A KEY TO CONTINUE..."
y$ = INPUT$(1)
CLS
RETURN

FileOpenErr:
FileErr% = 1 'File CONT_CPN.DAT did not exist
CLOSE #3
RESUME NEXT

SUB Delay (nseconds!)
SHARED dtime
DelayNum = 10000! * nseconds! / dtime 'Number of loops for nseconds! s
FOR i! = 1 TO DelayNum
    dt = dt + 1
NEXT i!
END SUB