' ProbeLPT by James B
' A DOS tool for reading and setting values on the printer port.

DIM bit(16)                   ' temporary storage for manip of bit values
DIM pin(25)                   ' status of parallel port pins
DIM strobe(25)                ' set strobe(n) to strobe that port pin
DIM rLoc(25)                  ' row location for printing output
DIM cLoc(25)                  ' column location for printing output


DECLARE FUNCTION makeBinary! (base10val!, bit())
DECLARE FUNCTION printPins! (pin!(), rLoc(), cLoc())
DECLARE FUNCTION updateDataPins! (pin!(), bit(), register)
DECLARE FUNCTION updateStatusPins! (pin!(), bit(), register)
DECLARE FUNCTION updateControlPins! (pin!(), bit(), register)
DECLARE FUNCTION changeBit (bitNo, register)

strobeSpeed = 10000           ' lower is faster

' LPT1 port addresses
' if LPTx addresses are used, change values in changeBit() as well
pData = &H378
status = &H379
control = &H37A

' initialize pins as ground until set otherwise
FOR r = 1 TO 25: pin(r) = 2: strobe(r) = 0: NEXT r


CLS

' initialize arrays
x = updateDataPins(pin(), bit(), pData)
x = updateStatusPins(pin(), bit(), status)
x = updateControlPins(pin(), bit(), control)
x = printPins(pin(), rLoc(), cLoc())

' initialize one of the output windows
LOCATE 20, 35
COLOR 1, 15
PRINT "  last out to CONTROL port: xxx : ";
FOR r = 8 TO 0 STEP -1: PRINT "x"; : NEXT r
LOCATE 19, 35
COLOR 1, 15
PRINT "     last out to DATA port: xxx : ";
FOR r = 8 TO 0 STEP -1: PRINT "x"; : NEXT r

' display pin data
LOCATE 19, 1
COLOR 1, 15
PRINT " current pin: 1         "
LOCATE 20, 1
PRINT "       value:  ?        "
LOCATE 21, 1
PRINT "   direction:           ";
LOCATE 22, 1
PRINT " description:           ";
LOCATE 23, 1
PRINT " strobe rate:           ";

' initialize vars for main scan loop
currentPin = 1                  ' current pin selected with arrow keys
strobeCount = 0                 ' used to count loops for strobeSpeed

' ********************************************************************
' main key scan loop
' ********************************************************************
100 a$ = INKEY$
  
   ' if no key pressed go through loop anyway, but don't take some actions
   IF a$ = "" THEN
      a$ = "0"
      noAction = 1
   ELSE
      noAction = 0
   END IF
  
   ' update counter for strobing
   strobeCount = strobeCount + 1

   ' toggle a pin if space bar is pressed
   '    (only changes output pins)
   IF ASC(RIGHT$(a$, 1)) = 32 THEN
      IF currentPin >= 2 AND currentPin <= 9 THEN
         x = changeBit(currentPin - 2, pData)
      END IF
      IF currentPin = 1 THEN x = changeBit(0, control)
      IF currentPin = 14 THEN x = changeBit(1, control)
      IF currentPin = 16 THEN x = changeBit(2, control)
      IF currentPin = 17 THEN x = changeBit(3, control)
      noAction = 0
   END IF

   ' set strobe bit
   IF a$ = "s" OR a$ = "S" THEN
      IF strobe(currentPin) = 0 THEN strobe(currentPin) = 1 ELSE strobe(currentPin) = 0
   END IF
     
   ' do strobes
   IF strobeCount > strobeSpeed THEN
      strobeCount = 0
      FOR r = 1 TO 25
         IF strobe(r) = 1 THEN
            IF r >= 2 AND r <= 9 THEN
               x = changeBit(r - 2, pData)
            END IF
            IF r = 1 THEN x = changeBit(0, control)
            IF r = 14 THEN x = changeBit(1, control)
            IF r = 16 THEN x = changeBit(2, control)
            IF r = 17 THEN x = changeBit(3, control)
         END IF
      NEXT r
      noAction = 0
   END IF
   
   ' a key was pressed, so do some additional actions
   ' ------------------------------------------------
   IF noAction = 0 THEN
     
      ' update pins
      x = updateDataPins(pin(), bit(), pData)
      x = updateStatusPins(pin(), bit(), status)
      x = updateControlPins(pin(), bit(), control)
      x = printPins(pin(), rLoc(), cLoc())
     
      ' bail if q or esc
      IF a$ = "q" OR a$ = "Q" THEN
         CLS
         SYSTEM
      END IF
      IF ASC(RIGHT$(a$, 1)) = 27 THEN
         CLS
         SYSTEM
      END IF

      ' update strobe speed
      IF a$ = "<" OR a$ = "," THEN strobeSpeed = strobeSpeed + 100
      IF a$ = ">" OR a$ = "." THEN strobeSpeed = strobeSpeed - 100
      IF strobeSpeed < 100 THEN strobeSpeed = 100
      IF storbeSpeed > 1000000 THEN strobeSpeed = 100

      ' scan for left or right arrows and update
      priorPin = currentPin
      IF ASC(RIGHT$(a$, 1)) = 75 THEN currentPin = currentPin + 1
      IF ASC(RIGHT$(a$, 1)) = 77 THEN currentPin = currentPin - 1

      ' keep pin numbers in bounds
      IF currentPin <= 0 THEN currentPin = 25
      IF currentPin > 25 THEN currentPin = 1

      ' refresh pin cursor is being moved off of
      LOCATE rLoc(priorPin), cLoc(priorPin)
      IF pin(priorPin) = 0 THEN
         COLOR 11, 4
         PRINT USING "##"; priorPin
      END IF
      IF pin(priorPin) = 1 THEN
         COLOR 11, 2
         PRINT USING "##"; priorPin
      END IF
      IF pin(priorPin) = 2 THEN
         COLOR 11, 6
         PRINT USING "##"; priorPin
      END IF
     
      ' refresh pin cursor is pointing to
      LOCATE rLoc(currentPin), cLoc(currentPin)
      IF pin(currentPin) = 0 THEN
         COLOR 0, 4
         PRINT USING "##"; currentPin
      END IF
      IF pin(currentPin) = 1 THEN
         COLOR 0, 2
         PRINT USING "##"; currentPin
      END IF
      IF pin(currentPin) = 2 THEN
         COLOR 0, 6
         PRINT USING "##"; currentPin
      END IF

      ' display pin data
      ' ----------------
      LOCATE 19, 1
      COLOR 1, 15
      PRINT USING " current pin: ##       "; currentPin
      LOCATE 20, 1
      IF pin(currentPin) > 1 THEN
               PRINT "       value:  ?       "
      ELSE
         PRINT USING "       value:  #     "; pin(currentPin)
      END IF
      LOCATE 21, 1
      PRINT "   direction: ";
     
      SELECT CASE currentPin
         CASE 10, 11, 12, 13, 15
         PRINT "input    "
         CASE 2, 3, 4, 5, 6, 7, 8, 9, 1, 15, 16, 17
            PRINT "output   "
         CASE 18, 19, 20, 21, 22, 23, 24, 25
            PRINT "ground   "
       END SELECT

      LOCATE 22, 1
      PRINT " description: ";
      SELECT CASE currentPin
         CASE 1
            PRINT "!C0       "
         CASE 2
            PRINT "D0        "
         CASE 3
            PRINT "D1        "
         CASE 4
            PRINT "D2        "
         CASE 5
            PRINT "D3        "
         CASE 6
            PRINT "D4        "
         CASE 7
            PRINT "D5        "
         CASE 8
            PRINT "D6        "
         CASE 9
            PRINT "D7        "
         CASE 10
            PRINT "S6        "
         CASE 11
            PRINT "!S7       "
         CASE 12
            PRINT "S5        "
         CASE 13
            PRINT "S4        "
         CASE 14
            PRINT "!C1       "
         CASE 15
            PRINT "S3        "
         CASE 16
            PRINT "C2        "
         CASE 17
            PRINT "!C3       "
         CASE 18, 19, 20, 21, 22, 23, 24, 25
            PRINT "ground  "
       END SELECT

      LOCATE 23, 1
      PRINT USING " strobe rate: #########"; strobeSpeed
     
      ' update ports by reading in fresh data, then print it
      inVal = INP(pData)
      LOCATE 21, 35
      COLOR 1, 15
      PRINT USING "         current DATA port: ### : "; inVal;
      x = makeBinary(inVal, bit())
      FOR r = 8 TO 0 STEP -1: PRINT USING "#"; bit(r); : NEXT r

      inVal = INP(status)
      LOCATE 22, 35
      COLOR 1, 15
      PRINT USING "       current STATUS port: ### : "; inVal;
      x = makeBinary(inVal, bit())
      FOR r = 8 TO 0 STEP -1: PRINT USING "#"; bit(r); : NEXT r

     
      inVal = INP(control)
      LOCATE 23, 35
      COLOR 1, 15
      PRINT USING "      current CONTROL port: ### : "; inVal;
      x = makeBinary(inVal, bit())
      FOR r = 8 TO 0 STEP -1: PRINT USING "#"; bit(r); : NEXT r

      ' print info window
      IF a$ = "i" OR a$ = "I" OR a$ = "?" OR a$ = "/" THEN
         LOCATE 1, 1
         PRINT " ProbeLPT  1.0b         "
         LOCATE 2, 1
         PRINT " by James B.            "
         LOCATE 3, 1
         PRINT " diluded000@yahoo.com   "
         LOCATE 4, 1
         PRINT " -------------------    "
      END IF
        
         ' print instructions
         LOCATE 1, 35
         PRINT "   esc    exit                   "
         LOCATE 2, 35
         PRINT "  <- ->   select  pins           "
         LOCATE 3, 35
         PRINT "   < >    change strobe rate     "
         LOCATE 4, 35
         PRINT "    s     toggle strobing on pin "
         LOCATE 5, 35
         PRINT " [space]  toggle value of pin    "
         LOCATE 6, 35
         PRINT "    i     display  program info  "
   END IF

GOTO 100

' takes a bit number and a LPT register address
' toggles the specified bit and writes it to the address
FUNCTION changeBit (bitNo, register)

   DIM itx(16)       ' used for storing input bits
   DIM it(8)         ' used for printing outval

   ' LPT1 port addresses
   pData = &H378
   status = &H379
   control = &H37A

   IF register = pData THEN
     
      ' read the data
      inVal = INP(pData)
     
      ' clear the array
      FOR r = 1 TO 16: itx(r) = 0: NEXT r
     
      ' store byte input from port in itx() as a binary array
      x = makeBinary(inVal, itx())
     
      ' toggle the bit
      IF itx(bitNo) = 1 THEN
         itx(bitNo) = 0
      ELSE
         itx(bitNo) = 1
      END IF

      ' store the new value, with the toggled bit, in outVal
      outVal = 0
      FOR r = 0 TO 7
         IF itx(r) = 1 THEN outVal = outVal + (2 ^ r)
      NEXT r

      ' write the output value to the port
      OUT pData, outVal
     
      ' print the value in decimal and binary
      LOCATE 19, 35
      COLOR 1, 15
      PRINT USING "     last out to DATA port: ### : "; outVal;
      x = makeBinary(outVal, it())
      FOR r = 8 TO 0 STEP -1: PRINT USING "#"; it(r); : NEXT r
   END IF

   IF register = control THEN
     
      ' read the current value from the port
      inVal = INP(control)
     
      ' clear the array
      FOR r = 1 TO 16: itx(r) = 0: NEXT r
     
      ' store the byte from the port in an binary array
      x = makeBinary(inVal, itx())
     
      ' toggle the bit
      IF itx(bitNo) = 1 THEN
         itx(bitNo) = 0
      ELSE
         itx(bitNo) = 1
      END IF

      ' clear the output var
      outVal = 0
     
      ' put the value with the toggled bit in outVal
      FOR r = 0 TO 7
         IF itx(r) = 1 THEN outVal = outVal + (2 ^ r)
      NEXT r

      ' write outVal to the port
      OUT control, outVal
     
      ' update the screen with the last value written
      LOCATE 20, 35
      COLOR 1, 15
      PRINT USING "  last out to CONTROL port: ### : "; outVal;
      x = makeBinary(outVal, it())
      FOR r = 8 TO 0 STEP -1: PRINT USING "#"; it(r); : NEXT r
   END IF

END FUNCTION

' take a base 10 number and store it in an array
' where each element in the array corresponds to
' the approproate bit number for the base10val
FUNCTION makeBinary (base10val, bit())
  
   FOR r = 8 TO 0 STEP -1
      pow2 = 2 ^ r
      IF pow2 <= base10val THEN
         bit(r) = 1
         base10val = base10val - pow2
      ELSE
         bit(r) = 0
      END IF
   NEXT r

END FUNCTION

' print the pins on the screen with color coding
FUNCTION printPins (pin(), rLoc(), cLoc())

' dont forget to clear the screen up front
   
   FOR r = 1 TO 25
     
      IF r < 14 THEN
         rowPos = 8
         colPos = 55 - r * 3
      ELSE
         rowPos = 10
         colPos = 53 - (r - 13) * 3
      END IF
     
      LOCATE rowPos, colPos
      rLoc(r) = rowPos
      cLoc(r) = colPos
     
     
      IF pin(r) = 2 THEN COLOR 11, 6
      IF pin(r) = 1 THEN COLOR 11, 2
      IF pin(r) = 0 THEN COLOR 11, 4
      PRINT USING "##"; r
   NEXT r

END FUNCTION

FUNCTION updateControlPins! (pin!(), bit(), register)
 
   ' syncs the bit values for the port with the pin value array
   dataval = INP(register)
   x = makeBinary(dataval, bit())
   pin(1) = bit(0)
   pin(14) = bit(1)
   pin(16) = bit(2)
   pin(17) = bit(3)
END FUNCTION

FUNCTION updateDataPins (pin(), bit(), register)
   ' syncs the bit values for the port with the pin value array
   dataval = INP(register)
   x = makeBinary(dataval, bit())
   bitNo = 0
   FOR r = 2 TO 9
      pin(r) = bit(bitNo)
      bitNo = bitNo + 1
   NEXT r
END FUNCTION

FUNCTION updateStatusPins! (pin!(), bit(), register)
  
   ' syncs the bit values for the port with the pin value array
   dataval = INP(register)
   x = makeBinary(dataval, bit())
   pin(15) = bit(3)
   pin(13) = bit(4)
   pin(12) = bit(5)
   pin(10) = bit(6)
   pin(11) = bit(7)


END FUNCTION