'TR200TST.BAS by S.R. Evett.  Tel: 806-356-5775.
'Program to run coaxial multiplexer through IBM PC/XT/AT compatible personal
'computer's parallel port.  Written in Microsoft Prof. BASIC ver. 7.1
'Works with Microsoft QuickBASIC.

CONST Version$ = "  TR200TST.BAS, version of 12-5-96."

DECLARE SUB VadoseControl (Switch%, LPTAddress%, VadoseNo%)
DECLARE SUB VadoseSelect (Switch%, VadoseNo%)
DECLARE SUB LineAddress (Switch%)
DECLARE SUB GetLPTAddress ()
DECLARE SUB SetUp ()
DECLARE SUB GetSetUp ()
DECLARE SUB SDMX50AddConvert (SDMX50Address%)
DECLARE SUB Menu ()
DECLARE SUB ParaHigh (Switch%, LPTAddress%)
DECLARE SUB ParaLow (Switch%, LPTAddress%)
DECLARE SUB LPT1Address ()
DECLARE SUB LPT2Address ()
DECLARE SUB SDMX50Select (Switch%, SDMX50Address%)
DECLARE SUB SDMX50Control (Switch%, LPTAddress%, SDMX50Address%)
DECLARE FUNCTION Qdate$ (FuncCode$)
DECLARE FUNCTION Julian& (Month%, day%, Year%)
DECLARE SUB jultomdy (julianday&, Month%, day%, Year%)
DECLARE SUB DayWeek (Month%, day%, Year%, DayNumber%, WeekDay$)


'Dimension arrays for data:
'$DYNAMIC
'$STATIC
DIM TreeMPlexType%(20)

'**************** Set default values and arrays ************************
DIM bin%(9)     'Set up array for binary values of parallel port pins.
bin%(9) = 128   'Pin 9
bin%(8) = 64    'Pin 8
bin%(7) = 32    'Pin 7
bin%(6) = 16
bin%(5) = 8
bin%(4) = 4
bin%(3) = 2
bin%(2) = 1

DIM StatusQuo%(9)  'Set up array holding values for pin on or off status.
StatusQuoSum% = 0  'Sum of values of pins that are on.

DIM SDMX50AddressBin%(4) 'To hold binary equivalent of SDMX50 base 4 address.
DIM VadoseAddressBin%(4) 'To hold binary equivalent of Vadose multiplexer number.
DIM LineAddressBin%(4)  'To hold binary equivalent of input line address.

SDMX50Address% = 11  'Default base 4 address for SDMX50 coaxial multiplexer.

'****************Get addresses of parallel ports:**********************
GetLPTAddress

'**********************************************************************
'Turn off pins 2 through 9 on parallel port (logic low)
'so that TDR will not be toggled to output a waveform.
IF Addres2% <> 0 THEN OUT Addres2%, &H0
IF Addres1% <> 0 THEN OUT Addres1%, &H0

'***********************************************************************
'Get setup:
GetSetUp
IF INIErrNo% > 0 THEN
    DATA.Pin% = 6
    CLK.Pin% = 7
    SDE.Pin% = 8
    VDATA.Pin% = 2
    VCLK.Pin% = 3
    VSDE.Pin% = 4
    PRINT "Error in reading initialization file TR200TST.INI."
    PRINT "You will have to enter setup data."
    PRINT "Press any key to continue .....": SLEEP
    SetUp
END IF

'***********************************************************************
'Initialize screen:
KEY OFF
WIDTH 80
SCREEN 0
CLS

'*********************** Main program loop: ****************************
DO
    Menu
    SELECT CASE y$
    CASE "U"
        SetUp
    CASE "Q"
        SCREEN 0
        CLS
        END
    CASE "X"
        CALL SDMX50Select(Switch%, SDMX50Address%)
        CALL SDMX50Control(Switch%, LPTAddress%, SDMX50Address%)
    CASE "V"
        CALL VadoseSelect(Switch%, VadoseNo%)
        CALL VadoseControl(Switch%, LPTAddress%, VadoseNo%)
    CASE ELSE
    END SELECT
    FOR i% = 1 TO 30: dum$ = INKEY$: NEXT i%     'Empty keyboard buffer.
LOOP
END

'************************* ERROR HANDLING ******************************

INIErr:
'Error in reading TR200TST.INI
INIErrNo% = 1
RESUME NEXT

'***********************************************************************
'***********************************************************************
'END OF MAIN PROGRAM, SUBPROGRAMS FOLLOW:

'==============================================================================
SUB DayWeek (Month%, day%, Year%, DayNum%, DayName$)
   CONST DayText = "SunMonTueWedThuFriSat"
   y% = Year%
   M% = Month%
   d% = day%
   DayNum% = 9
   DayName$ = "ERR"
   IF y% < 0 THEN EXIT SUB
   IF (M% < 1) OR (M% > 12) THEN EXIT SUB
   IF (d% < 1) OR (d% > 31) THEN EXIT SUB
   IF y% < 100 THEN y% = y% + 1900
   M% = M% - 2
   IF (M% < 1) OR (M% > 10) THEN
      M% = M% + 12
      y% = y% - 1
   END IF
   Century% = y% \ 100
   y% = y% MOD 100
   Temp% = INT(2.6 * M% - .19) + d% + y% + (y% \ 4)
   DayNum% = (Temp% + (Century% \ 4) - Century% - Century%) MOD 7
   IF DayNum% < 0 THEN DayNum% = DayNum% + 7
   DayName$ = MID$(DayText, DayNum% + DayNum% + DayNum% + 1, 3)
END SUB

'=============================================================================
SUB GetLPTAddress
'Get address of at least one parallel port:
SHARED Addres1%, Addres2%, LPTNo%, LPTAddress%
'Can be &H278, &H3BC or &H378.
LPT1Address
LPT2Address
IF Addres1% = 0 AND Addres2% = 0 THEN
    PRINT "Parallel ports 1 and 2 do not exist."
    PRINT "press any key to quit ...."
    SLEEP: END
ELSE
   'On TELEX use LPT2 if it exists:
   IF Addres2% <> 0 THEN
       LPTAddress% = Addres2%
       LPTNo% = 2
       PRINT "Selected LPT2."
   ELSE
       PRINT "Could not find LPT2.  Using LPT1."
       LPTAddress% = Addres1%
       LPTNo% = 1
   END IF
END IF
END SUB

' ======================================================================
'Get setup for data acquisition:
SUB GetSetUp
SHARED DATA.Pin%, CLK.Pin%, SDE.Pin%
SHARED VDATA.Pin%, VCLK.Pin%, VSDE.Pin%
SHARED TreeMPlexType%() 'Integer value corresponding to multiplexer/addressing type.

f% = FREEFILE
ON ERROR GOTO INIErr
OPEN "i", #f%, "TR200TST.INI"
INPUT #f%, DATA.Pin%
INPUT #f%, CLK.Pin%
INPUT #f%, SDE.Pin%
INPUT #f%, VDATA.Pin%
INPUT #f%, VCLK.Pin%
INPUT #f%, VSDE.Pin%
FOR i% = 1 TO 20
    INPUT #f%, TreeMPlexType%(i%)
NEXT i%
CLOSE #f%
ON ERROR GOTO 0

END SUB

' ======================================================================
FUNCTION Julian& (Month%, day%, Year%)
   y& = Year%
   M& = Month%
   d& = day%
  
   Julian& = -1
  
   IF y& < 0 THEN EXIT FUNCTION                            'Mod. #1
   IF (M& < 1) OR (M& > 12) THEN EXIT FUNCTION
   IF (d& < 1) OR (d& > 31) THEN EXIT FUNCTION
   IF y& < 100 THEN y& = y& + 1900                         'Mod. #1
  
   Temp& = (M& - 14) \ 12
  
   JulPart& = d& - 32075 + (1461 * (y& + 4800 + Temp&) \ 4)
   JulPart& = JulPart& + (367 * (M& - 2 - Temp& * 12) \ 12)
   Julian& = JulPart& - (3 * ((y& + 4900 + Temp&) \ 100) \ 4)

END FUNCTION

' ======================================================================
SUB jultomdy (julianday&, Month%, day%, Year%)
   TempA& = julianday& + 68569
   TempB& = 4 * TempA& \ 146097
   TempA& = TempA& - (146097 * TempB& + 3) \ 4
   Year% = 4000 * (TempA& + 1) \ 1461001
   TempC& = Year%
   TempA& = TempA& - (1461 * TempC& \ 4) + 31
   Month% = 80 * TempA& \ 2447
   TempC& = Month%
   day% = TempA& - (2447 * TempC& \ 80)
   TempA& = Month% \ 11
   Month% = Month% + 2 - (12 * TempA&)
   Year% = 100 * (TempB& - 49) + Year% + TempA&
END SUB

SUB LineAddress (Switch%)
'Get binary equivalent of line number from 1 to 16:
SHARED LineAddressBin%()
FOR i% = 1 TO 4
   LineAddressBin%(i%) = 0
NEXT i%
s% = Switch% - 1
FOR i% = 1 TO 4
    IF s% / 2 ^ (4 - i%) >= 1 THEN
        LineAddressBin%(i%) = 1
        s% = s% - 2 ^ (4 - i%)
    ELSE
        IF s% = 1 THEN
            LineAddressBin%(4) = 1
            EXIT FOR
        ELSE
            LineAddressBin%(i%) = 0
        END IF
    END IF
NEXT i%
END SUB

' ======================================================================
SUB LPT1Address
SHARED Addres1%
'Find the address of parallel port no. 1:
'PRINT "Find the address of parallel port no. 1:"
DEF SEG = &H40
x = PEEK(8)  'Get low byte
y = PEEK(9)  'Get high byte
'PRINT "Low byte is"; x; "   High byte is"; y
Addres1% = y * 256 + x
'PRINT "Address is"; Addres1%; "decimal.";
'IF Addres1% = 0 THEN PRINT "  LPT1 does not exist." ELSE PRINT
'PRINT "Some addresses are:"
'PRINT "  HEX: 378       DECIMAL:"; : PRINT &H378
'PRINT "  HEX: 3BC       DECIMAL:"; : PRINT &H3BC
'PRINT "  HEX: 278       DECIMAL:"; : PRINT &H278
'PRINT "Press any key to continue ....": SLEEP: PRINT
END SUB

'=============================================================================
SUB LPT2Address
SHARED Addres2%
'Find the address of parallel port no. 2:
'PRINT "Find the address of parallel port no. 2:"
DEF SEG = &H40
x = PEEK(10)  'Get low byte
y = PEEK(11)  'Get high byte
'PRINT "Low byte is"; x; "   High byte is"; y
Addres2% = y * 256 + x
'PRINT "Address is"; Addres2%; "decimal.";
'IF Addres2% = 0 THEN PRINT "  LPT2 does not exist." ELSE PRINT
'PRINT "Some addresses are:"
'PRINT "  HEX: 378       DECIMAL:"; : PRINT &H378
'PRINT "  HEX: 3BC       DECIMAL:"; : PRINT &H3BC
'PRINT "  HEX: 278       DECIMAL:"; : PRINT &H278
'PRINT "Press any key to continue ....": SLEEP: PRINT
END SUB

'=============================================================================
SUB Menu
SHARED y$, GotOnce%, ETime, LPTNo%
CLS
LOCATE 2, 1
PRINT "    Example program for running the Vadose coaxial multiplexer,"
PRINT "    model TR-200 from the parallel port of an IBM PC/XT/AT compatible"
PRINT "    personal computer." + Version$
LOCATE 8, 1
PRINT "    Select from the following:"
IF GotOnce% > 0 THEN LOCATE , 44: PRINT "Elapsed time ="; ETime; "s." ELSE PRINT
PRINT "        U> Set up."
PRINT "        V> Control Vadose TR-200 coaxial multiplexer."
PRINT "        X> Control SDMX-50 coaxial multiplexer."
PRINT "        Q> Quit."
PRINT : PRINT "    Enter your selection:";
row% = CSRLIN: col% = POS(0)
DO
   LOCATE 6, 1, 0
   PRINT "    "; DATE$; ".   "; TIME$; ".  DOY: "; Qdate$("D"); TAB(60);
   PRINT "Using LPT"; LTRIM$(STR$(LPTNo%)); "."
   LOCATE row%, col%, 1
   SLEEP 1
   y$ = UCASE$(INKEY$)
   IF LEN(y$) THEN
       IF INSTR("UXVQ", y$) > 0 THEN EXIT DO
   END IF
LOOP
LOCATE 1, 1, 0
END SUB

'=============================================================================
SUB ParaHigh (Switch%, LPTAddress%)
SHARED bin%(), StatusQuo%(), StatusQuoSum%
'Control digital output setting parallel port pin number Switch% high:
'The value in StatusQuo% is the decimal equivalent of the binary number
'representing the pins which are already on.  Note that the first digital
'output pin is number 2 on the D-subminiature 25 pin connector, and the last
'output pin is number 9 on the connector.
IF StatusQuo%(Switch%) > 0 THEN
    EXIT SUB   'Pin number Switch% is already on.
ELSE
   'Set pin number Switch% high without changing status of other pins.
   StatusQuoSum% = StatusQuoSum% + bin%(Switch%)
   OUT LPTAddress%, StatusQuoSum%
   StatusQuo%(Switch%) = 1    'Change status of switch.
END IF
END SUB

'=============================================================================
SUB ParaLow (Switch%, LPTAddress%)
SHARED bin%(), StatusQuo%(), StatusQuoSum%
'Control digital output setting parallel port pin number Switch% low:
'The value in StatusQuo% is the decimal equivalent of the binary number
'representing the pins which are already on.
IF StatusQuo%(Switch%) = 0 THEN
    EXIT SUB   'Pin number Switch% is already off.
ELSE
   'Set pin number Switch% low without changing status of other pins.
   StatusQuoSum% = StatusQuoSum% - bin%(Switch%)
   OUT LPTAddress%, StatusQuoSum%
   StatusQuo%(Switch%) = 0    'Change status of switch.
END IF
END SUB

'=============================================================================
FUNCTION Qdate$ (FuncCode$)
DEFINT A-Z
'FuncCode$ is one of the following:
'D = day of year  : ddd
'E = European date: dd/mm/yy
'J = Julian date  : yyddd
'M = Month        : name of month, RC = length
'N = Normal       : dd MMM yyyy, e.g. 30 Sep 1987.
'O = Ordered date : yy/mm/dd
'S = Sorted date  : yyyymmdd
'U = USA date     : mm/dd/yy
'W = Week day     : day of the week, RC = length.

Func$ = LCASE$(FuncCode$)
Month$ = "JanFebMarAprMayJunJulAugSepOctNovDec"

FirstDay& = Julian&(1, 1, VAL(RIGHT$(DATE$, 2))) - 1
Today& = Julian&(VAL(LEFT$(DATE$, 2)), VAL(MID$(DATE$, 4, 2)), VAL(RIGHT$(DATE$, 2)))

jultomdy Today&, Month, day, Year

DayWeek Month, day, Year, day, WeekDay$

SELECT CASE Func$

CASE "d"                         '******** ddd day of year
Qdate$ = LTRIM$(STR$(Today& - FirstDay&))

CASE "j"                        '******** yyddd julian doy
Qdate$ = RIGHT$(DATE$, 2) + LTRIM$(STR$(Today& - FirstDay&))

CASE "e"                         '******** dd/mm/yy european format
Qdate$ = MID$(DATE$, 4, 2) + "/" + LEFT$(DATE$, 2) + "/" + RIGHT$(DATE$, 2)

CASE "m"                         '******** name of month
Qdate$ = MID$(Month$, (VAL(LEFT$(DATE$, 2)) * 3) - 2, 3)

CASE "o"                         '******** yy/mm/dd
Qdate$ = RIGHT$(DATE$, 2) + "/" + LEFT$(DATE$, 2) + "/" + MID$(DATE$, 4, 2)

CASE "u"                         '******** mm/dd/yy
Qdate$ = LEFT$(DATE$, 2) + "/" + MID$(DATE$, 4, 2) + "/" + RIGHT$(DATE$, 2)

CASE "s"                         '******** yyyymmdd
Qdate$ = RIGHT$(DATE$, 4) + LEFT$(DATE$, 2) + MID$(DATE$, 4, 2)

CASE "w"                         '******** day of week
Qdate$ = WeekDay$

CASE "n"                         '******** dd mmm yyyy [ 30 Sep 1988 ]
Qdate$ = MID$(DATE$, 4, 2) + " " + MID$(Month$, (VAL(LEFT$(DATE$, 2)) * 3) - 2, 3) + " " + RIGHT$(DATE$, 4)

CASE ELSE
PRINT "Case else error in QDATE$."
PRINT "Press any key to end ....."
SLEEP
END

END SELECT

END FUNCTION

DEFSNG A-Z
'=============================================================================
SUB SDMX50AddConvert (SDMX50Address%)
'Convert SDMX50 address from base 4 to binary:
'For addresses see Table 3-1, page 4 of Campbell Scientific Inc's
'"Campbell Scientific TDR Soil Moisture Measurement System Manual".
'For instructions on changing the jumpers see page 3 of that manual.

'SDMX50Address%   'Address of SDMX50 in base 4.
SHARED SDMX50AddressBin%() 'Array holding binary equivalent of SDMX50 address.

SELECT CASE SDMX50Address%
CASE 0
    'SDMX50 jumper settings: MSD = 0, LSD = 0
    SDMX50AddressBin%(1) = 0
    SDMX50AddressBin%(2) = 0
    SDMX50AddressBin%(3) = 0
    SDMX50AddressBin%(4) = 0
CASE 1
    'SDMX50 jumper settings: MSD = 0, LSD = 1
    SDMX50AddressBin%(1) = 1
    SDMX50AddressBin%(2) = 0
    SDMX50AddressBin%(3) = 0
    SDMX50AddressBin%(4) = 0
CASE 2
    'SDMX50 jumper settings: MSD = 0, LSD = 2
    SDMX50AddressBin%(1) = 0
    SDMX50AddressBin%(2) = 1
    SDMX50AddressBin%(3) = 0
    SDMX50AddressBin%(4) = 0
CASE 3
    'SDMX50 jumper settings: MSD = 0, LSD = 3
    SDMX50AddressBin%(1) = 1
    SDMX50AddressBin%(2) = 1
    SDMX50AddressBin%(3) = 0
    SDMX50AddressBin%(4) = 0
CASE 10
    'SDMX50 jumper settings: MSD = 1, LSD = 0
    SDMX50AddressBin%(1) = 0
    SDMX50AddressBin%(2) = 0
    SDMX50AddressBin%(3) = 1
    SDMX50AddressBin%(4) = 0
CASE 11
    'SDMX50 jumper settings: MSD = 1, LSD = 1
    SDMX50AddressBin%(1) = 1
    SDMX50AddressBin%(2) = 0
    SDMX50AddressBin%(3) = 1
    SDMX50AddressBin%(4) = 0
CASE 12
    'SDMX50 jumper settings: MSD = 1, LSD = 2
    SDMX50AddressBin%(1) = 0
    SDMX50AddressBin%(2) = 1
    SDMX50AddressBin%(3) = 1
    SDMX50AddressBin%(4) = 0
CASE 13
    'SDMX50 jumper settings: MSD = 1, LSD = 3
    SDMX50AddressBin%(1) = 1
    SDMX50AddressBin%(2) = 1
    SDMX50AddressBin%(3) = 1
    SDMX50AddressBin%(4) = 0
CASE 20
    'SDMX50 jumper settings: MSD = 2, LSD = 0
    SDMX50AddressBin%(1) = 0
    SDMX50AddressBin%(2) = 0
    SDMX50AddressBin%(3) = 0
    SDMX50AddressBin%(4) = 1
CASE 21
    'SDMX50 jumper settings: MSD = 2, LSD = 1
    SDMX50AddressBin%(1) = 1
    SDMX50AddressBin%(2) = 0
    SDMX50AddressBin%(3) = 0
    SDMX50AddressBin%(4) = 1
CASE 22
    'SDMX50 jumper settings: MSD = 2, LSD = 2
    SDMX50AddressBin%(1) = 0
    SDMX50AddressBin%(2) = 1
    SDMX50AddressBin%(3) = 0
    SDMX50AddressBin%(4) = 1
CASE 23
    'SDMX50 jumper settings: MSD = 2, LSD = 3
    SDMX50AddressBin%(1) = 1
    SDMX50AddressBin%(2) = 1
    SDMX50AddressBin%(3) = 0
    SDMX50AddressBin%(4) = 1
CASE 30
    'SDMX50 jumper settings: MSD = 3, LSD = 0
    SDMX50AddressBin%(1) = 0
    SDMX50AddressBin%(2) = 0
    SDMX50AddressBin%(3) = 1
    SDMX50AddressBin%(4) = 1
CASE 31
    'SDMX50 jumper settings: MSD = 3, LSD = 1
    SDMX50AddressBin%(1) = 1
    SDMX50AddressBin%(2) = 0
    SDMX50AddressBin%(3) = 1
    SDMX50AddressBin%(4) = 1
CASE 32
    'SDMX50 jumper settings: MSD = 3, LSD = 2
    SDMX50AddressBin%(1) = 0
    SDMX50AddressBin%(2) = 1
    SDMX50AddressBin%(3) = 1
    SDMX50AddressBin%(4) = 1
CASE 33
    'SDMX50 jumper settings: MSD = 3, LSD = 3
    SDMX50AddressBin%(1) = 1
    SDMX50AddressBin%(2) = 1
    SDMX50AddressBin%(3) = 1
    SDMX50AddressBin%(4) = 1
CASE ELSE
    PRINT "Address of SDMX50 was specified as"; SDMX50Address%
    PRINT "This address is not included in the list of addresses in"
    PRINT "subprogram SDMX50AddSelect.  Press any key to end ..."
    SLEEP: END
END SELECT
END SUB

'=============================================================================
SUB SDMX50Control (Switch%, LPTAddress%, SDMX50Address%)
'Control Campbell Scientific SDMX-50 coaxial switch using pins on the PC's
'parallel port.  These are usually set to:
'   DATA.Pin% = pin 6
'   CLK.Pin% = pin 7 and
'   SDE.Pin% = pin 8
'Verified to work on SDMX50, 1-22-93.
SHARED SDMX50AddressBin%()  'Holds binary equivalent of SDMX50 base 4 address.
SHARED SDE.Pin%, CLK.Pin%, DATA.Pin%, LineAddressBin%()

'Get binary equivalent of SDMX50 base 4 address:
CALL SDMX50AddConvert(SDMX50Address%)
'Get binary equivalent of line number:
CALL LineAddress(Switch%)

PRINT "Setting SDMX-50 for line"; Switch%

'Reset SDMX50:
CALL ParaLow(SDE.Pin%, LPTAddress%)   'SDE, serial device enable, C3 on SDMX50
CALL ParaLow(CLK.Pin%, LPTAddress%)   'CLK, clock, C2 on SDMX50
CALL ParaLow(DATA.Pin%, LPTAddress%)  'Data, C1 on SDMX50
'wait 0.01 s
Time3 = TIMER
WHILE Time3 + .1 > TIMER: WEND
CALL ParaHigh(CLK.Pin%, LPTAddress%)  'Clock
CALL ParaHigh(SDE.Pin%, LPTAddress%)  'SDE
'wait 0.006 s
Time3 = TIMER
WHILE Time3 + .006 > TIMER: WEND

FOR s% = 1 TO 8
   CALL ParaLow(CLK.Pin%, LPTAddress%)   'clock
   'Channel:
   IF s% = 1 THEN
       'First bit always high:
       CALL ParaHigh(DATA.Pin%, LPTAddress%)'data
   ELSEIF s% < 5 THEN
   'Address of coaxial input is 1st 4 bits of data stream:
       IF LineAddressBin%(6 - s%) = 1 THEN
       'IF LineAddressBin%(s%) = 1 THEN
           CALL ParaHigh(DATA.Pin%, LPTAddress%)'data
       ELSE
           CALL ParaLow(DATA.Pin%, LPTAddress%) 'data
       END IF
   ELSE
   'Address of SDMX50 is last 4 bits of 8 bit stream.
   'Send address stored in SDMX50Address%():
       IF SDMX50AddressBin%(s% - 4) THEN
           CALL ParaHigh(DATA.Pin%, LPTAddress%)  'data 1
       ELSE
           CALL ParaLow(DATA.Pin%, LPTAddress%)   'data 0
       END IF
   END IF
   CALL ParaHigh(CLK.Pin%, LPTAddress%)  'clock
NEXT s%

CALL ParaLow(SDE.Pin%, LPTAddress%)   'SDE
CALL ParaLow(DATA.Pin%, LPTAddress%)   'data
Time3 = TIMER
WHILE Time3 + .03 > TIMER: WEND
CALL ParaLow(CLK.Pin%, LPTAddress%)   'clock
END SUB

'=============================================================================
SUB SDMX50Select (Switch%, SDMX50Address%)
'Subprogram to select Campbell Scientific SDMX-50 coaxial switch line.
CLS
PRINT
PRINT "Control SDMX-50 coaxial switch:"
PRINT "Enter line to switch on (1-8):";
'IF Switch% > 0 AND Switch% < 9 THEN EXIT DO
Switch% = 0
FOR i% = 1 TO 30: y$ = INKEY$: NEXT i%   'Empty keyboard buffer.
WHILE Switch% < 1 OR Switch% > 8: Switch% = VAL(INKEY$): WEND
PRINT Switch%

SDMX50Select1:
PRINT
PRINT "Possible base 4 addresses of the SDMX50 are:"
PRINT "   00, 01, 02, 03, 10, 11, 12, 13, 20, 21, 22, 23, 30, 31, 32, 33."
INPUT "Enter base 4 address of SDMX50 to use (try 11):"; SDMX50Address%
SELECT CASE SDMX50Address%
CASE 0
CASE 1
CASE 2
CASE 3
CASE 10
CASE 11
CASE 12
CASE 13
CASE 20
CASE 21
CASE 22
CASE 23
CASE 30
CASE 31
CASE 32
CASE 33
CASE ELSE
    CLS
    PRINT "Base 4 address you input was"; SDMX50Address%
    PRINT "This address was not acceptable.  Press any key to try again ...."
    SLEEP
    GOTO SDMX50Select1
END SELECT
END SUB

'=============================================================================
SUB SetUp
'Set up:
SHARED DATA.Pin%, CLK.Pin%, SDE.Pin%
SHARED VDATA.Pin%, VCLK.Pin%, VSDE.Pin%
SHARED TreeMPlexType%() 'Integer value corresponding to multiplexer/addressing type.
'Normal set up:
'   DATA.Pin% = pin 6
'   CLK.Pin% = pin 7 and
'   SDE.Pin% = pin 8
'   VDATA.Pin% = pin 2
'   VCLK.Pin% = pin 3 and
'   VSDE.Pin% = pin 4
CLS
accept$ = ""
ParaPin% = 0
FOR i% = 2 TO 9
   IF i% <> ParaPin% THEN accept$ = accept$ + LTRIM$(STR$(i%))
NEXT i%

VadosePins:
CLS : LOCATE 4, 1
PRINT "Parallel port pins used to communicate with Vadose coaxial multiplexer"
PRINT "are normally:"
PRINT "   DATA.Pin% = pin 2"
PRINT "   CLK.Pin% = pin 3"
PRINT "   SDE.Pin% = pin 4"
PRINT "Enter pin number for DATA.  Press <Return> for default ="; VDATA.Pin%
Pin1% = VDATA.Pin%
GOSUB GetPin
VDATA.Pin% = Pin%
PRINT "Enter pin number for CLOCK.  Press <Return> for default ="; VCLK.Pin%
Pin1% = VCLK.Pin%
GOSUB GetPin
VCLK.Pin% = Pin%
PRINT "Enter pin number for SDE.  Press <Return> for default ="; VSDE.Pin%
Pin1% = VSDE.Pin%
GOSUB GetPin
VSDE.Pin% = Pin%

SDMXPins:
CLS : LOCATE 4, 1
PRINT "Parallel port pins used to communicate with SDMX50 coaxial multiplexer"
PRINT "are normally:"
PRINT "   DATA.Pin% = pin 6"
PRINT "   CLK.Pin% = pin 7"
PRINT "   SDE.Pin% = pin 8"
PRINT "Enter pin number for DATA.  Press <Return> for default ="; DATA.Pin%
Pin1% = DATA.Pin%
GOSUB GetPin
DATA.Pin% = Pin%
PRINT "Enter pin number for CLOCK.  Press <Return> for default ="; CLK.Pin%
Pin1% = CLK.Pin%
GOSUB GetPin
CLK.Pin% = Pin%
PRINT "Enter pin number for SDE.  Press <Return> for default ="; SDE.Pin%
Pin1% = SDE.Pin%
GOSUB GetPin
SDE.Pin% = Pin%

f% = FREEFILE
OPEN "o", #f%, "TR200TST.INI"
PRINT #f%, DATA.Pin%
PRINT #f%, CLK.Pin%
PRINT #f%, SDE.Pin%
PRINT #f%, VDATA.Pin%
PRINT #f%, VCLK.Pin%
PRINT #f%, VSDE.Pin%
FOR i% = 1 TO 20
    PRINT #f%, USING "# "; TreeMPlexType%(i%);
NEXT i%
PRINT #f%,
CLOSE #f%
EXIT SUB

GetPin:
PRINT "Acceptable parallel port pin numbers are:";
FOR i% = 1 TO LEN(accept$)
   PRINT " "; MID$(accept$, i%, 1);
   IF i% < LEN(accept$) THEN PRINT ",";  ELSE PRINT ":";
NEXT i%
row% = CSRLIN
col% = POS(0)
GetPin1:
LOCATE , , 1
y$ = INPUT$(1)
IF LEN(y$) = 0 OR y$ = CHR$(13) THEN
    y$ = LTRIM$(RTRIM$(STR$(Pin1%)))
END IF
Pin% = VAL(y$)
IF INSTR(accept$, y$) = 0 THEN
    GOSUB NoGoodMess
    GOTO GetPin1
END IF
'Now remove pin number from list of acceptable:
FOR i% = 2 TO 9
   IF i% = Pin% THEN
       s% = INSTR(accept$, LTRIM$(RTRIM$(STR$(Pin%))))
       a$ = MID$(accept$, 1, s% - 1)
       IF s% < LEN(accept$) THEN b$ = MID$(accept$, s% + 1) ELSE b$ = ""
       accept$ = a$ + b$
   END IF
NEXT i%
PRINT
RETURN

NoGoodMess:
    LOCATE row% + 1, 1:
    PRINT "Pin number"; Pin%; "is not acceptable."
    PRINT "Choose another pin number ..."
    LOCATE row%, col%: PRINT " ";
    LOCATE row%, col%, 1
    SLEEP
    LOCATE row% + 1, 1: PRINT SPACE$(160);
    LOCATE row%, col%, 1
RETURN

END SUB

'=============================================================================
SUB VadoseControl (Switch%, LPTAddress%, VadoseNo%)
'Control Vadose 16 pin coaxial switch using pins on the PC's
'parallel port.  These are usually set to:
'   VDATA.Pin% = pin 2
'   VCLK.Pin% = pin 3 and
'   VSDE.Pin% = pin 4
SHARED VadoseAddressBin%()  'Holds binary equivalent of multiplexer number.
SHARED LineAddressBin%()   'Holds binary equivalent of input cable number.
SHARED VDATA.Pin%, VCLK.Pin%, VSDE.Pin%
'CLS
'Get binary equivalent of multiplexer decimal number:
CALL LineAddress(VadoseNo%)
'PRINT "Binary address of multiplexer is:  ";
'    LOCATE , 40: PRINT LTRIM$(RTRIM$(STR$(LineAddressBin%(1))));
'    LOCATE , 41: PRINT LTRIM$(RTRIM$(STR$(LineAddressBin%(2))));
'    LOCATE , 42: PRINT LTRIM$(RTRIM$(STR$(LineAddressBin%(3))));
'    LOCATE , 43: PRINT LTRIM$(RTRIM$(STR$(LineAddressBin%(4))));
'    PRINT
FOR i% = 1 TO 4
    VadoseAddressBin%(i%) = LineAddressBin%(i%)
NEXT i%
'Get binary equivalent of line number:
CALL LineAddress(Switch%)
'PRINT "Binary address of coaxial input line"; Switch%; "is:  ";
'    LOCATE , 45: PRINT LTRIM$(RTRIM$(STR$(LineAddressBin%(1))));
'    LOCATE , 46: PRINT LTRIM$(RTRIM$(STR$(LineAddressBin%(2))));
'    LOCATE , 47: PRINT LTRIM$(RTRIM$(STR$(LineAddressBin%(3))));
'    LOCATE , 48: PRINT LTRIM$(RTRIM$(STR$(LineAddressBin%(4))));
'PRINT
'PRINT "Setting Vadose coaxial multiplexer no."; VadoseNo%; "for line"; Switch%

'Reset multiplexer:
CALL ParaLow(VSDE.Pin%, LPTAddress%)   'SDE, serial device enable
CALL ParaLow(VCLK.Pin%, LPTAddress%)   'CLK, clock
CALL ParaLow(VDATA.Pin%, LPTAddress%)  'Data
'wait 0.01 s
Time3 = TIMER
WHILE Time3 + .1 > TIMER: WEND
CALL ParaHigh(VCLK.Pin%, LPTAddress%)  'Clock high
CALL ParaHigh(VSDE.Pin%, LPTAddress%)  'SDE high
'wait 0.006 s
Time3 = TIMER
WHILE Time3 + .006 > TIMER: WEND

FOR s% = 1 TO 8
   CALL ParaLow(VCLK.Pin%, LPTAddress%)   'clock low
   IF s% > 4 THEN
   'Channel (line) address is last 4 bits of 8 bit stream:
   'Send out LSB first-> PRINT LineAddressBin%(9 - s%)
   'Send out MSB first-> PRINT LineAddressBin%(s% - 4)
       IF LineAddressBin%(s% - 4) THEN
           CALL ParaHigh(VDATA.Pin%, LPTAddress%)  'data 1
       ELSE
           CALL ParaLow(VDATA.Pin%, LPTAddress%)   'data 0
       END IF
   ELSE
   'Address of multiplexer is first 4 bits of 8 bit stream.
   'Send address stored in VadoseAddressBin%():
   'Send out low bit first:
'       PRINT VadoseAddressBin%(5 - s%)
'       IF VadoseAddressBin%(5 - s%) THEN
   'Send out high bit first:
       PRINT VadoseAddressBin%(s%)
       IF VadoseAddressBin%(s%) THEN
           CALL ParaHigh(VDATA.Pin%, LPTAddress%)  'data 1
       ELSE
           CALL ParaLow(VDATA.Pin%, LPTAddress%)   'data 0
       END IF
   END IF
   CALL ParaHigh(VCLK.Pin%, LPTAddress%)  'clock high enabling data bit.
NEXT s%
'SLEEP
CALL ParaLow(VSDE.Pin%, LPTAddress%)   'SDE low
'PRINT "SDE is low.": SLEEP
CALL ParaLow(VDATA.Pin%, LPTAddress%)  'data low
'PRINT "DATA is low.": SLEEP
Time3 = TIMER
WHILE Time3 + .03 > TIMER: WEND
CALL ParaLow(VCLK.Pin%, LPTAddress%)   'clock low
'PRINT "CLK is low.": SLEEP
END SUB

SUB VadoseSelect (Switch%, VadoseNo%)
'Subprogram to select Campbell Scientific SDMX-50 coaxial switch line.
SHARED LineAddressBin%()

CLS
PRINT
PRINT "Control Vadose coaxial multiplexer:"
VSelect1:
LOCATE 3, 1: PRINT SPACE$(80);
LOCATE 3, 1
INPUT "Enter input line to switch on (1-16):"; Switch%
IF Switch% < 1 OR Switch% > 16 THEN GOTO VSelect1

PRINT "Possible multiplexer numbers and binary addresses are:"
FOR i% = 1 TO 16
    CALL LineAddress(i%)
    PRINT USING "  ###  "; i%;
    LOCATE , 10: PRINT LTRIM$(RTRIM$(STR$(LineAddressBin%(1))));
    LOCATE , 11: PRINT LTRIM$(RTRIM$(STR$(LineAddressBin%(2))));
    LOCATE , 12: PRINT LTRIM$(RTRIM$(STR$(LineAddressBin%(3))));
    LOCATE , 13: PRINT LTRIM$(RTRIM$(STR$(LineAddressBin%(4))));
    PRINT
NEXT i%
PRINT "Enter number of multiplexer (1 to 16):";
row% = CSRLIN
col% = POS(0)
VSelect2:
INPUT VadoseNo%
IF VadoseNo% < 1 OR VadoseNo% > 16 THEN
    LOCATE row%, col%: PRINT "      "
    LOCATE row%, col%
    GOTO VSelect2
END IF
END SUB