DECLARE SUB acquire_xclk ()
'Copyright 2001 Raymond J. Allen
'Parallel Port Oscilloscope:  Phase 1
'Quickly upload from ppo and graph  10mar00
DECLARE SUB acquire_fast ()
DECLARE SUB upload_fast ()
DECLARE SUB upload_ppo ()
DECLARE SUB acquire_ppo ()
DECLARE SUB reset_ppo ()
DECLARE SUB setup_ppo ()
DECLARE SUB waitkey ()
DECLARE SUB timedelay (t)
DECLARE SUB readdata ()
DECLARE SUB readstatus ()
DECLARE SUB readcontrol ()
DECLARE SUB readall ()
OPTION EXPLICIT

'define base address of parallel port
CONST lpt1a = &H378   'Change to "lpt2a = &H278" to use LPT2 instead of LPT1
CONST basea = lpt1a   'Change to "lpt2a" to use LPT2 instead of LPT1
CONST statusa = basea + 1         'status port address of parallel port
CONST controla = basea + 2        'control port address of parallel port

CONST validf = 128      'Using bit 7 of status port (S7) for "DataValid" flag
CONST groundf = 64      '      bit 6 of status port (S6) is grounded
CONST eff = 32          'Using bit 5 of status port (S5) for "FifoEmpty" flag
CONST hff = 16          'Using bit 4 of status port (S4) for "FifoHalfFull" flag
CONST fff = 8           'Using bit 3 of status port (S3) for "FifoFull" flag

CONST enablebif = 32   'Using bit 5 of control port to enable bidirectional data flow
CONST enableirqf = 16  'Using bit 4 of control port to enable IRQ
CONST nclockf = 8      'Using bit 3 of control port (C3) for "Clock" signal (active low)
CONST resetf = 4       'Using bit 2 of control port (C2) for "Reset" signal
CONST nacquiref = 2    'Using bit 1 of control port (C1) for "Acquire" signal (active low)
CONST nreadf = 1       'Using bit 0 of control port (C0) for "Read" signal (active low)

DIM SHARED count AS INTEGER     'stores the number of sucessful waveform uploads
DIM i AS INTEGER


'start
readall
   'subroutine "readall" reads and displays the status of data, status, and control ports
LOCATE 1, 1: PRINT "Ready..."
waitkey
   'subroutine "waitkey" waits for the user to press any key.


'setup
setup_ppo
    'subrouting "setup_ppo" prepares parallel port for use
readall
LOCATE 1, 1: PRINT "Setup Complete..."
waitkey
SCREEN 9, 1
CLS

'MAIN LOOP:  Infinite loop of reset, aquire, upload...
DO
    count = count + 1
    LOCATE 23, 1: PRINT count

    'reset:  reset the chips and prepare to aquire
    reset_ppo
    LOCATE 1, 1: PRINT "Reset Complete..."


    'acquire:  There are 3 subroutines one can use here...
        'use "acquire_xclk" if you want to use an external clock
        'use "acquire_ppo" for internal clock with status checks
        'use "acquire_fast" for internal clock, max. speed
    acquire_fast
    LOCATE 1, 1: PRINT "Acquire Complete..."

    'upload:  Bring in the data from the FIFO and display it
        'subroutine "upload_ppo" is an earlier version
    upload_fast
    'LOCATE 1, 1: PRINT "Upload Complete..."
    
LOOP UNTIL INKEY$ <> ""

'Pressing any key stops loop and ends program

SUB acquire_fast ()
'acquire data from FIFO with no display
DIM i, j, k, o AS INTEGER

LOCATE 1, 1: PRINT "Enabling Acquire..."
'enable acquire
o = enablebif + nclockf + nreadf
OUT controla, o

'check for empty
j = INP(statusa)
IF (j AND eff) = 0 THEN
    PRINT "Fifo not Empty"
    STOP
END IF

'cycle clock 2048 times
FOR i = 0 TO 2047
    'label1.caption = STR$(i)
    'LOCATE 1, 1: PRINT "Writing #" + STR$(i) + "         "

    'clock high
    o = enablebif + nreadf
    OUT controla, o


    'Check for FF
    j = INP(statusa)
    IF j AND fff THEN
        IF i <> 2047 THEN
            PRINT
            PRINT "FIFO Full!   "
            STOP
        END IF
    END IF
    IF j AND eff THEN
        PRINT
        PRINT "FIFO Empty!   "
        STOP
    END IF

    'clock low
    o = enablebif + nclockf + nreadf
    OUT controla, o


NEXT i


END SUB

SUB acquire_ppo ()
'acquire data
DIM i, j, k, o AS INTEGER

CALL readall
LOCATE 1, 1: PRINT "Enabling Acquire..."
'enable acquire
o = enablebif + nclockf + nreadf
OUT controla, o

'check for empty
j = INP(statusa)
IF (j AND eff) = 0 THEN
    PRINT "Fifo not Empty"
    STOP
END IF

'cycle clock 2048 times
FOR i = 0 TO 2047
    'label1.caption = STR$(i)
    LOCATE 1, 1: PRINT "Writing #" + STR$(i) + "         "

    'clock high
    o = enablebif + nreadf
    OUT controla, o

    'updata display
    CALL readdata
    CALL readstatus
    CALL readcontrol
    LOCATE 3, 1

    'Check for FF
    j = INP(statusa)
    IF j AND fff THEN
        IF i <> 2047 THEN
            PRINT
            PRINT "FIFO Full!   "
            STOP
        END IF
    ELSE
        PRINT "Fifo not Full"
    END IF
    IF j AND eff THEN
        PRINT
        PRINT "FIFO Empty!   "
        STOP
    ELSE
        PRINT "Fifo not Empty"
    END IF
    IF j AND hff THEN
        PRINT "Fifo Half Full    "
    ELSE
        PRINT "Fifo not Half Full"
    END IF
    
    'clock low
    o = enablebif + nclockf + nreadf
    OUT controla, o


    'IF i < 5 THEN CALL timedelay(1)
    'IF i > 1020 AND i < 1030 THEN CALL timedelay(1)
    'IF i > 2040 THEN CALL timedelay(1)
NEXT i



END SUB

SUB acquire_xclk ()
'acquire using external clock
'acquire data with no display
DIM i, j, k, o AS INTEGER




'check for empty
j = INP(statusa)
IF (j AND eff) = 0 THEN
    PRINT "Fifo not Empty"
    STOP
END IF

'cycle clock 2048 times
'FOR i = 0 TO 2047
    'label1.caption = STR$(i)
    'LOCATE 1, 1: PRINT "Writing #" + STR$(i) + "         "

    'enable clock
    'clock high
    o = enablebif + nreadf + nacquiref
    OUT controla, o
    'timedelay (.1)

    LOCATE 1, 1: PRINT "Enabling Acquire..."
    'enable acquire
    o = enablebif + nreadf
    OUT controla, o
    'timedelay (.1)


    'wait for full
    'Check for FF
    DO
        j = INP(statusa)
        'IF (j AND fff) = 0 THEN
        '        PRINT "FIFO not Full!   "
        '        STOP
        'END IF
    LOOP UNTIL (j AND fff) <> 0

    'clock and aqcuire low
    o = enablebif + nclockf + nreadf + nacquiref
    OUT controla, o


'NEXT i

END SUB

SUB readall ()
'read all ports
SCREEN 0
COLOR 15, 1
CLS

CALL readdata
CALL readstatus
CALL readcontrol

END SUB

SUB readcontrol ()
'read control port and adjust backcolor of text2 to match
DIM i, j, k AS INTEGER
i = INP(controla)
j = 128
COLOR 15, 1
LOCATE 22, 1: PRINT "Control"

FOR k = 0 TO 7
    LOCATE 22, 10 + k
    IF i AND j THEN
        i = i - j
        COLOR 15, 4
    ELSE
        COLOR 15, 0
    END IF
    PRINT LTRIM$(STR$(k))
    j = j / 2
NEXT k
COLOR 15, 1
              
END SUB

SUB readdata ()
'read data port and adjust backcolor of text3 to match
DIM i, j, k AS INTEGER
i = INP(basea)
j = 128
COLOR 15, 1
LOCATE 20, 1: PRINT "DATA"

FOR k = 0 TO 7
    LOCATE 20, 10 + k
    IF i AND j THEN
        i = i - j
        COLOR 15, 4
    ELSE
        COLOR 15, 0
    END IF
    PRINT LTRIM$(STR$(k))
    j = j / 2
NEXT k
COLOR 15, 1

END SUB

SUB readstatus ()
'read status port and adjust backcolor of text1 to match
DIM i, j, k AS INTEGER
i = INP(statusa)
j = 128
COLOR 15, 1
LOCATE 21, 1: PRINT "STATUS"

FOR k = 0 TO 7
    LOCATE 21, 10 + k
    IF i AND j THEN
        i = i - j
        COLOR 15, 4
    ELSE
        COLOR 15, 0
    END IF
    PRINT LTRIM$(STR$(k))

    j = j / 2
NEXT k
COLOR 15, 1

END SUB

SUB reset_ppo ()
'reset
DIM o, i AS INTEGER

'toggle reset bit
'timedelay (.1)
o = resetf + enablebif + nclockf + nreadf + nacquiref
OUT controla, o
'timedelay (.1)
o = enablebif + nclockf + nreadf + nacquiref
OUT controla, o
'timedelay (.1)

'check status port
i = INP(statusa)
IF (i AND eff) = 0 THEN
    'MSGBOX "PPO Reset Failed"
    STOP
ELSE
    'MSGBOX "PPO Reset Success"
END IF

END SUB

SUB setup_ppo ()

'setup
DIM o AS INTEGER
o = enablebif + nclockf + nreadf + nacquiref
OUT controla, o
'CALL readall
'MSGBOX "PPO Setup Complete"

END SUB

SUB timedelay (t AS SINGLE)
DIM t0 AS SINGLE
t0 = TIMER
WHILE TIMER < t0 + t: WEND

END SUB

SUB upload_fast ()
'upload data
DIM i, j, k, o AS INTEGER
DIM fifodata(2047)
DIM orl, orh

'CALL readall
LOCATE 1, 1: PRINT "Uploading Data..."
'disable acquire
o = enablebif + nclockf + nacquiref + nreadf
OUT controla, o

'check for full
j = INP(statusa)
IF (j AND fff) = 0 THEN
    PRINT "Fifo not Full"
    STOP
END IF

'cycle clock 2048 times
orl = enablebif + nacquiref + nclockf + nreadf
orh = enablebif + nclockf + nacquiref

FOR i = 0 TO 2047
    'LOCATE 2, 1: PRINT "Reading #" + STR$(i) + "         "

    'read high
    OUT controla, orh

    'timedelay (.1)

    'input byte
    fifodata(i) = INP(basea)

    'read low
    OUT controla, orl


    'Check for EF
    j = INP(statusa)
    IF j AND eff THEN
        IF i <> 2047 THEN
            PRINT
            PRINT "FIFO Empty!     "
            STOP
        END IF
    END IF


NEXT i

'graph result
LINE (0, 0)-(512, 255), 1, BF
FOR i = 0 TO 2047
    PSET (i / 4, 256 - fifodata(i))
NEXT i
'CALL waitkey
'CALL readall


END SUB

SUB upload_ppo ()
'upload data
DIM i, j, k, o AS INTEGER
DIM fifodata(2047)

CALL readall
LOCATE 1, 1: PRINT "Uploading Data..."
'disable acquire
o = enablebif + nclockf + nacquiref + nreadf
OUT controla, o

'check for full
j = INP(statusa)
IF (j AND fff) = 0 THEN
    PRINT "Fifo not Full"
    STOP
END IF

'cycle clock 2048 times
FOR i = 0 TO 2047
    'label1.caption = STR$(i)
    LOCATE 2, 1: PRINT "Reading #" + STR$(i) + "         "

    'read high
    o = enablebif + nacquiref + nclockf
    OUT controla, o

    'updata display
    CALL readdata
    CALL readstatus
    CALL readcontrol
    LOCATE 3, 1
    'CALL waitkey

    'input byte
    fifodata(i) = INP(basea)

    'Check for EF
    j = INP(statusa)
    IF j AND eff THEN
        IF i <> 2047 THEN
            PRINT
            PRINT "FIFO Empty!     "
            STOP
        END IF
    ELSE
        PRINT
        PRINT "Fifo not Empty"
    END IF
    'Check for HF
    j = INP(statusa)
    IF j AND hff THEN
        PRINT
        PRINT "FIFO Half Full    "
    ELSE
        PRINT
        PRINT "Fifo not Half Full"
    END IF


    'read low
    o = enablebif + nacquiref + nclockf + nreadf
    OUT controla, o
    'CALL waitkey
NEXT i

'graph result
SCREEN 9
FOR i = 0 TO 2047
    PSET (i / 4, 256 - fifodata(i))
NEXT i
CALL waitkey
CALL readall
END SUB

SUB waitkey ()
DIM i$
WHILE INKEY$ <> "": WEND
i$ = ""
WHILE i$ = "": i$ = INKEY$: WEND
END SUB