DECLARE SUB assemblecmds ()
DECLARE SUB help ()
DECLARE SUB init ()
DECLARE SUB checkkeyboard ()
DECLARE SUB sendcmd (x%)
DECLARE SUB displaydata (x%)


DECLARE FUNCTION MouseInit% ()
DECLARE SUB MouseStatus (Lb%, Rb%, xMouse%, yMouse%)
DECLARE SUB MouseRange (X1%, Y1%, x2%, Y2%)
DECLARE SUB MousePut (x%, y%)
DECLARE SUB MouseHide ()
DECLARE SUB MouseDriver (ax%, bx%, cx%, dx%)
DECLARE SUB MouseShow ()
DEFINT A-Z: DEF SEG = &HA000:
DIM SHARED mouse$: mouse$ = SPACE$(57)

' ************************************************************
' ------------------------------------------------------------
' Program   A2D.BAS
' by:       Dave Acre
' last rev: 24Apr97
' ------------------------------------------------------------
' ************************************************************
'
' ************************************************************
' *** DECLARATIONS ****** DECLARATIONS ****** DECLARATIONS ***
' ************************************************************
DEFINT A-Z

' *** CONSTANTS *** color definitions
CONST black = 0, blue = 1, green = 2, cyan = 3, red = 4, magenta = 5
CONST yellow = 6, white = 7, brite = 8, blink = 16

' *** VARIABLES ***
' *** integer declarations ***

DIM SHARED y, chan, c, channeldata(10), t, flag1
DIM SHARED dataportaddr, statusportaddr, controlportaddr
DIM SHARED pwron, pwrOFF, dinon, dinoff, sclkON, sclkoff
DIM SHARED testON, testOFF, dout, strb, testpin
DIM SHARED testMON, doutMON, strbMON, sel(8), sel2, sel1, sel0
DIM SHARED ledRED, ledGRN, ledOFF, bit
DIM SHARED cmd(50, 8)
DIM SHARED EPS, numchan

' *** single precision real declarations ***
DIM SHARED lsb AS SINGLE, chgain AS SINGLE
DIM datum(8) AS SINGLE

' ************************************************************


CLS
SCREEN 12
FOR I% = 1 TO 57:  READ A$:  H$ = CHR$(VAL("&H" + A$))
MID$(mouse$, I%, 1) = H$: NEXT I%
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B
DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53
DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F
DATA 8B,5E,06,89,17,5D,CA,08,00
RESTORE
ms% = MouseInit%
IF NOT ms% THEN
  PRINT "Mouse not found"
  END
END IF

 
begin:
MouseHide
MousePut 100, 100

init
assemblecmds
chan = 0
numchan = 8
lsb = 6.1035E-04 ' vdc
REM chgain = .0829 * 2
chgain = 1

GOSUB getvars
GOSUB pscreen
GOSUB temp
GOSUB temp
air.trend! = 0
primary.trend! = 0
secondary.trend! = 0
tube.trend! = 0


TIMER ON
ON TIMER(10) GOSUB temp




main:
REM DEFLNG A-Z
akey$ = INKEY$
IF akey$ = "x" OR A$ = "X" THEN GOTO theend
GOSUB Keys
GOSUB Switch
GOSUB mouse
GOSUB filter
GOSUB dome
GOSUB focus
GOSUB motors
GOSUB scrn
GOTO main

END

Keys:
IF akey$ = "t" OR akey$ = "T" THEN dome.track = dome.track + 1
IF dome.track > 1 THEN dome.track = 0
IF akey$ = "h" OR akey$ = "H" THEN Handpad = Handpad + 1
IF Handpad > 2 THEN Handpad = 0
IF akey$ = "s" OR akey$ = "S" THEN focus.step = focus.step / 10
IF focus.step < 1 THEN focus.step = 1000
IF akey$ = "a" OR akey$ = "A" THEN target.focus! = target.focus! + (focus.step * 1.5)
IF akey$ = "z" OR akey$ = "Z" THEN target.focus! = target.focus! - (focus.step * 1.5)

IF akey$ = "c" OR akey$ = "C" THEN current.dome! = current.scope!
IF akey$ = "g" OR akey$ = "G" THEN
stall = 0
stall.count = 0
END IF


IF akey$ = "r" OR akey$ = "R" THEN
target.focus! = 1000
focus.reset = 1
END IF
IF akey$ = "1" THEN target.filter = filter.pos(1)
IF akey$ = "2" THEN target.filter = filter.pos(2)
IF akey$ = "3" THEN target.filter = filter.pos(3)
IF akey$ = "4" THEN target.filter = filter.pos(4)



RETURN



Switch:
sinp = INP(957)
IF sinp AND 16 THEN sw.speed = 1 ELSE sw.speed = 0
sw.dir = 0
IF (sinp AND 32) = 0 THEN sw.dir = 1
IF sinp AND 128 THEN sw.dir = -1

RETURN


mouse:

MouseStatus Lb%, Rb%, x%, y%
ddome = y% - 100
dscope = x% - 100
MousePut 100, 100
ddome = ddome * -1


REM get mouse ddome, dscope
current.scope! = current.scope! + (dscope * 1.59138)
current.dome! = current.dome! + ddome
REM reset mouse

RETURN


filter:

IF current.filter! > target.filter THEN current.filter! = current.filter! - 1
IF current.filter! < target.filter THEN current.filter! = current.filter! + 1
IF current.filter! = target.filter THEN filter.move = 0 ELSE filter.move = 1
col$ = "Moving"
FOR x = 1 TO 4
IF current.filter! = filter.pos(x) THEN col$ = colour$(x)
NEXT x


RETURN


dome:

difference! = current.dome! - current.scope!

IF dome.track = 1 THEN
        IF dome.move = 0 THEN
                IF difference! > 50 OR difference! < -50 THEN dome.move = 1
        ELSE
                IF difference! < 10 AND difference! > -10 THEN dome.move = 0
        END IF
END IF

IF dome.track = 0 THEN dome.move = 0

IF Rb% <> 0 THEN
dome.move = 1
dome.direction = 1
current.dome! = current.scope!
END IF

IF Lb% <> 0 THEN
dome.move = 1
dome.direction = 0
current.dome! = current.scope!
END IF

IF Lb% + Rb% = 0 THEN
IF difference! > 0 THEN dome.direction = 0 ELSE dome.direction = 1
END IF

IF Handpad = 2 AND dome.track = 0 THEN
        IF sw.dir = 0 THEN
                dome.move = 0
                ELSE
                dome.move = 1
        END IF
        IF sw.dir = -1 THEN dome.direction = 0 ELSE dome.direction = 1
END IF



RETURN


focus:
focus.move = 0
IF INT(current.focus!) = 1000 THEN
        current.focus! = 5000
        target.focus! = 6500
        focus.reset = 0
END IF

IF sw.speed = 1 THEN increment! = .5 ELSE increment! = .05

IF Handpad = 1 THEN
        IF sw.dir = 1 THEN current.focus! = current.focus! - increment!
        IF sw.dir = -1 THEN current.focus! = current.focus! + increment!
        IF sw.dir <> 0 THEN
                focus.move = 1
                target.focus! = current.focus!
        END IF
END IF

IF current.focus! > target.focus! THEN
        current.focus! = current.focus! - 1
        focus.move = 1
END IF

IF current.focus! < target.focus! THEN
        current.focus! = current.focus! + 1
        focus.move = 1
END IF
IF (target.focus! < 5000 OR current.focus! < 5000) AND focus.reset <> 1 THEN
target.focus! = 5000
current.focus! = 5000
END IF

REM max travel 8100 (5000+3100)



IF current.focus! > 7400 THEN
        focus.move = 0
        current.focus! = 7400
        target.focus! = 7400
END IF




RETURN

motors:
IF dome.direction = 1 THEN n = 2 ELSE n = 0

IF dome.move <> 0 THEN
IF dome.track = 1 THEN
IF current.dome! = dome.last! THEN stall.count = stall.count + 1
END IF
n = n + 4
ELSE
stall.count = 0
END IF
dome.last! = current.dome!
IF stall.count = 6000 THEN stall = 1
IF stall = 1 THEN n = 0

OUT 958, n
nf = 0
fwind = (ABS(INT(current.focus!)) MOD 8) + 1


IF focus.move <> 0 THEN nf = focus.motor(fwind)


filwind = (ABS(INT(current.filter!)) MOD 8) + 1
nfil = filter.motor(filwind)
IF filter.move = 0 THEN nfil = 0
nf = nf + nfil

OUT 956, nf
RETURN

scrn:
COLOR 14
LOCATE 6, 1
PRINT INT((current.focus! - 5000) * .6666);
LOCATE 6, 25
PRINT "       ";
LOCATE 6, 25
PRINT col$;
LOCATE 6, 50
PRINT INT(current.dome!);
LOCATE 6, 68
PRINT USING "####.##"; air.temp!;
PRINT " `C";
LOCATE 7, 68
PRINT USING "####.##"; air.trend!;
PRINT " /hr";
LOCATE 9, 68
PRINT USING "####.##"; primary.temp!;
PRINT " `C";
LOCATE 10, 68
PRINT USING "####.##"; primary.trend!;
PRINT " /hr";
LOCATE 12, 68
PRINT USING "######.##"; secondary.temp!;
PRINT " `C";
LOCATE 13, 68
PRINT USING "######.##"; secondary.trend!;
PRINT " /hr";
LOCATE 15, 68
PRINT USING "######.##"; tube.temp!;
PRINT " `C";
LOCATE 16, 68
PRINT USING "######.##"; tube.trend!;
PRINT " /hr";
LOCATE 18, 68
IF heater = 1 THEN PRINT "   On  ";  ELSE PRINT "  Off  ";



LOCATE 8, 1
IF Handpad = 1 THEN PRINT "Active";  ELSE PRINT " -      ";
LOCATE 8, 50
PRINT INT(current.scope!);
LOCATE 10, 1
PRINT focus.step;
LOCATE 10, 50
IF dome.track = 1 THEN PRINT " On ";  ELSE PRINT " Off";
LOCATE 12, 50
IF Handpad = 2 THEN PRINT "Active";  ELSE PRINT "  -    ";
LOCATE 14, 50
IF stall = 0 THEN PRINT " No   ";  ELSE PRINT " Yes ";

COLOR 15
RETURN

theend:
REM set all safe
OUT 958, 0
OUT 956, 0
OUT &H378, 0
CLOSE
SYSTEM







pscreen:

REM PRINT SCREEN
CLS
PRINT
COLOR 12

PRINT "Focus                  Filter                   Dome                 Temperature"
COLOR 15
PRINT
PRINT
PRINT "Current                Current                  Current              Air"
PRINT
PRINT "Handpad                                         Scope"
PRINT "                                                                     Primary"
PRINT "Step                                            Tracking"
PRINT
PRINT "                                                Handpad              Secondary"
PRINT
PRINT "                                                Stall"
PRINT "                                                                     Tubes"
PRINT
PRINT
PRINT "                                                                     Heater"
PRINT
PRINT
PRINT
PRINT
PRINT "A=>in                  1=>"; colour$(1); "               T=>Togel Track"
PRINT "Z=>out                 2=>"; colour$(2); "               C=>sync"
PRINT "S=>Step                3=>"; colour$(3); "                H=>Handpad"
PRINT "H=>Handpad             4=>"; colour$(4); "              G=>Reset"
PRINT "R=>Reset              "
PRINT
PRINT "                 x => Exit"
RETURN

getvars:

clog = -2
air.temp! = 0
primary.temp! = 0
secondary.temp! = 0
tube.temp! = 0
l.air.temp! = 0
l.primary.temp! = 0
l.secondary.temp! = 0
l.tube.temp! = 0
air.trend! = 0
primary.trend! = 0
secondary.trend! = 0
tube.trend! = 0

heater = 0
INPUT "Log file name "; log$
IF log$ = "" THEN
logging = 0
ELSE
logging = 1
OPEN log$ FOR OUTPUT AS #4
PRINT #4, "Dome logging prog, "; DATE$; ","; TIME$
PRINT #4, "Time,Air,Primary,Secondary,Tubes,Focus"
END IF



stall = 0
stall.count = 0

focus.step = 10
current.focus! = 5000
target.focus! = 5000
REM handpad 0 none 1 focus 2 dome
Handpad = 1
REM focus speed 1 fast 10 slow
focus.speed = 1
current.filter! = 11750
target.filter = 11750
RESTORE 100
FOR x = 1 TO 4
READ filter.pos(x)
NEXT
RESTORE 110
FOR x = 1 TO 8
READ focus.motor(x)
NEXT
RESTORE 120
FOR x = 1 TO 4
READ colour$(x)
NEXT x
RESTORE 130
FOR x = 1 TO 8
READ filter.motor(x)
NEXT x

filter.speed = 1
dome.move = 0
dome.current = 0
scope.current = 0
dome.track = 0
dome.last! = 0
100 DATA 17206,11750,5800,0
REM focus
110 DATA 9,8,12,4,6,2,3,1
120 DATA Blue,None,Red,Green
130 DATA 16,48,32,96,64,192,128,144

RETURN

temp:
l.air.temp! = air.temp!
l.primary.temp! = primary.temp!
l.secondary.temp = secondary.temp!
l.tube.temp! = tube.temp!

FOR y = 0 TO 3
sum! = 0
FOR x = 1 TO 10
sendcmd (y)
IF channeldata(x) AND 2048 THEN
channeldata(x) = -1 * (channeldata(x) XOR 4095) - 1
END IF
sum! = sum! + channeldata(y)
NEXT x
datum(y) = sum!
NEXT y
FOR x = 0 TO 3
datum(x) = ((datum(x) * lsb * (1 / chgain)) * 100) / 10
NEXT x
air.temp! = datum(0)
primary.temp! = datum(1)
secondary.temp! = datum(2)
tube.temp! = datum(3)
IF (secondary.temp! - 1) < air.temp! THEN heater = 1 ELSE heater = 0
IF heater = 1 THEN OUT &H378, 144 ELSE OUT &H378, 128
REM leave power on
air.trend! = (.997 * air.trend!) + .003 * (air.temp! - l.air.temp!)
primary.trend! = (.997 * primary.trend!) + .003 * (primary.temp! - l.primary.temp!)
secondary.trend! = (.997 * secondary.trend!) + .003 * (secondary.temp! - l.secondary.temp!)
tube.trend! = (.997 * tube.trend!) + .003 * (tube.temp! - l.tube.temp!)
clog = clog + 1
IF clog = 7 THEN clog = 1

IF logging = 1 AND clog = 1 THEN
PRINT #4, TIME$; ","; air.temp!; ","; primary.temp!; ","; secondary.temp!; ","; tube.temp!; ","; current.focus!
END IF



RETURN


maint:
checkkeyboard
FOR y = 0 TO numchan - 1

    sendcmd (y) ' sends command and saves data
    LOCATE 3 + y, 2
    PRINT USING " #     ##.####"; y; channeldata(y) * lsb * (1 / chgain)
    IF channeldata(y) AND 2048 THEN
    channeldata(y) = (-1 * (channeldata(y) XOR 4095)) - 1
    END IF
    LOCATE 3 + y, 40
    PRINT channeldata(y) * lsb * (1 / chgain) * 100

    NEXT y

GOTO maint


END

' ************************************************************

SUB assemblecmds
   
    ' map the channel select according to the MAX147 data sheet
    sel(0) = 0
    sel(1) = 4
    sel(2) = 1
    sel(3) = 5
    sel(4) = 2
    sel(5) = 6
    sel(6) = 3
    sel(7) = 7
    
    ' precalculate all data to shift out to MAX147 (DIN data setup)
    FOR c = 0 TO 7
        IF ((sel(c) AND 1) = 1) THEN sel0 = 1 ELSE sel0 = 0
        IF ((sel(c) AND 2) = 2) THEN sel1 = 1 ELSE sel1 = 0
        IF ((sel(c) AND 4) = 4) THEN sel2 = 1 ELSE sel2 = 0
        cnt = 0
        cmd(cnt, c) = pwron OR dinoff OR sclkoff
        cnt = cnt + 1
        cmd(cnt, c) = pwron OR dinoff OR sclkoff
        cnt = cnt + 1
        cmd(cnt, c) = pwron OR dinon OR sclkoff  ' set START bit
        cnt = cnt + 1
        cmd(cnt, c) = pwron OR dinon OR sclkON   ' clkin START bit
        cnt = cnt + 1
        cmd(cnt, c) = pwron OR sel2 OR sclkoff   ' set SEL2 bit
        cnt = cnt + 1
        cmd(cnt, c) = pwron OR sel2 OR sclkON    ' clk in SEL2
        cnt = cnt + 1
        cmd(cnt, c) = pwron OR sel1 OR sclkoff   ' set SEL1 bit
        cnt = cnt + 1
        cmd(cnt, c) = pwron OR sel1 OR sclkON    ' clk in SEL1
        cnt = cnt + 1
        cmd(cnt, c) = pwron OR sel0 OR sclkoff   ' set SEL0 bit
        cnt = cnt + 1
        cmd(cnt, c) = pwron OR sel0 OR sclkON    ' clk in SEL0
        cnt = cnt + 1
        cmd(cnt, c) = pwron OR dinoff OR sclkoff  ' set UNIPOLAR bit
        cnt = cnt + 1
        cmd(cnt, c) = pwron OR dinon OR sclkON   ' clk in UNIPOLAR bit
        cnt = cnt + 1
        cmd(cnt, c) = pwron OR dinon OR sclkoff  ' set SINGLE ended bit
        cnt = cnt + 1
        cmd(cnt, c) = pwron OR dinon OR sclkON   ' clk in SINGLE ended bit
        cnt = cnt + 1
        cmd(cnt, c) = pwron OR dinon OR sclkoff  ' set PD1 bit
        cnt = cnt + 1
        cmd(cnt, c) = pwron OR dinon OR sclkON   ' clk in PD1 bit
        cnt = cnt + 1
        cmd(cnt, c) = pwron OR dinoff OR sclkoff ' set PD0 bit
        cnt = cnt + 1
        cmd(cnt, c) = pwron OR dinoff OR sclkON  ' clk in PD0 bit
        cnt = cnt + 1
        cmd(cnt, c) = pwron OR dinoff OR sclkoff ' set all off but power
        NEXT c

    END SUB

SUB checkkeyboard
    x$ = INKEY$
    IF LEN(x$) <> 0 THEN
        IF (x$ = "Q") OR (x$ = "q") THEN STOP
        IF (x$ = "C") OR (x$ = "c") THEN
            LOCATE 1, 1
            PRINT "Number of Channels [1-8]: ";
            INPUT numchan
            IF (numchan > 8) THEN numchan = 8
            CLS
            END IF
        END IF
END SUB

SUB init
    ' set base parallel port address
    dataportaddr = &H378
    statusportaddr = dataportaddr + 1
    controlportaddr = dataportaddr + 2

    ' data port bits (output only)
    pwron = &H80      ' top 1 bit   d7
    pwrOFF = &H0
    dinon = &H1       ' bit.0  d0
    dinoff = &H0
    sclkON = &H2      ' bit.1  d1
    sclkoff = &H0

    ' status port bits (input only)
    testMON = &H8     ' bit.3  s3
    doutMON = &H20    ' bit.5  s5
    strbMON = &H40    ' bit.6  s6

    ' control port bits (open collector outputs with 4.7Kohm pullups)

    ledRED = &H2      '   c1 on   and   c3 off
    ledGRN = &H8      '   c1 off  and   c3 on
    ledOFF = &HF      '   c1 on   and   c3 on
    testON = &H4      '   c2 on
    testOFF = &H0     '   c2 off

    OUT dataportaddr, pwron     ' turn on MAX147 A2D power
    OUT controlportaddr, ledRED ' set LED to red
           
END SUB

SUB MouseDriver (ax%, bx%, cx%, dx%)
  DEF SEG = VARSEG(mouse$)
  mouse% = SADD(mouse$)
  CALL Absolute(ax%, bx%, cx%, dx%, mouse%)
END SUB

SUB MouseHide
 ax% = 2
 MouseDriver ax%, 0, 0, 0
END SUB

FUNCTION MouseInit%
  ax% = 0
  MouseDriver ax%, 0, 0, 0
  MouseInit% = ax%
END FUNCTION

SUB MousePut (x%, y%)
  ax% = 4
  cx% = x%
  dx% = y%
  MouseDriver ax%, 0, cx%, dx%
END SUB

SUB MouseRange (X1%, Y1%, x2%, Y2%)
  ax% = 7
  cx% = X1%
  dx% = x2%
MouseDriver ax%, 0, cx%, dx%
  ax% = 8
  cx% = Y1%
  dx% = Y2%
  MouseDriver ax%, 0, cx%, dx%
END SUB

SUB MouseShow
  ax% = 1
  MouseDriver ax%, 0, 0, 0
END SUB

SUB MouseStatus (Lb%, Rb%, xMouse%, yMouse%)
  ax% = 3
  MouseDriver ax%, bx%, cx%, dx%
  Lb% = ((bx% AND 1) <> 0)
  Rb% = ((bx% AND 2) <> 0)
  xMouse% = cx%
  yMouse% = dx%
END SUB

SUB sendcmd (chan) STATIC
    ' init channel data first to get ready
    channeldata(chan) = 0

    ' clock out the data bits to inform MAX147 which channel, etc
    FOR cmdbit = 1 TO 18    ' send out 8-bit cmd to MAX 147
        OUT dataportaddr, cmd(cmdbit, chan)
        NEXT cmdbit

    ' delay here while the STRB line from the MAX147 is low
    exitcntr = 0
    WHILE ((INP(statusportaddr) AND &H40) = 0) AND (exitcntr < 100)
        exitcntr = exitcntr + 1
        WEND

    ' clock back the 12 data bits (MSB comes first), and leave power on
    FOR x = 1 TO 12
        OUT dataportaddr, &HF2      ' set clk hi
        OUT dataportaddr, &HF0      ' DOUT data was valid on the falling edge
        dout = INP(statusportaddr) ' MSB comes out first (bit.11)
        IF (dout AND &H20) = &H20 THEN bit = 1 ELSE bit = 0
        ' shift in each bit
        channeldata(chan) = (channeldata(chan) * 2) OR bit
        NEXT x
   
    OUT dataportaddr, &HF2    ' set clk hi
    ' clock in (and ignore) last 4 bits (all zeros)

    FOR x = 1 TO 4
        OUT dataportaddr, &HF0    ' set clk lo
        OUT dataportaddr, &HF2    ' set clk hi
        NEXT x
END SUB