Programmer 7500/MAX_PROGRAMMERS.iso/INFO/CLIPPER/NFSRC.ZIP/BITTEST.PRG

Text File | 1991-08-16 | 7.6 KB | 240 lines

/*
 * File......: BITTEST.PRG
 * Author....: Forest Belt, Computer Diagnostic Services, Inc.
 * Date......: $Date:   15 Aug 1991 23:02:54  $
 * Revision..: $Revision:   1.2  $
 * Log file..: $Logfile:   E:/nanfor/src/bittest.prv  $
 *
 * This is an original work by Forest Belt and is placed in the
 * public domain.
 *
 *   Execution times on 286/10Mhz clone machine          Execute times
 *                                                       -------------
 *   FT_ISBIT        Test any bit in a byte                     2 MSEC
 *   FT_BITSET       Set one bit in a byte                      1 MSEC
 *   FT_BITCLR       Clear one bit in a byte                    2 MSEC
 *
 *   FT_BYTEAND      AND two bytes together, return result     27 MSEC
 *   FT_BYTEOR       OR two bytes together, return result      36 MSEC
 *   FT_BYTEXOR      XOR two bytes together, return result     38 MSEC
 *   FT_BYTENOT      Return one's complement of a byte         19 MSEC
 *   FT_BYTENEG      Return two's complement of a byte         20 MSEC
 *
 *   FT_BYT2BIT      Return bit (binary) representation of byte
 *   FT_BYT2HEX      Return hexadecimal representation of byte
 *
 * MODIFICATION HISTORY:
 * ---------------------
 *
 * $Log:   E:/nanfor/src/bittest.prv  $
 *
 *    Rev 1.2   15 Aug 1991 23:02:54   GLENN
 * Forest Belt proofread/edited/cleaned up doc
 *
 *    Rev 1.1   14 Jun 1991 19:51:02   GLENN
 * Minor edit to file header
 *
 */


#IFDEF FT_TEST
  FUNCTION MAIN()


     SET CONFIRM ON

     CLEAR
     @ 1,2 TO 23,77 DOUBLE    // make a border box

     SETCOLOR("w+/n")
     @ 1,5 SAY "[ BIT MANIPULATIONS DEMONSTRATOR - NANFOR.LIB ]"

     DO WHILE .t.       // MAIN LOOP

         @ 2,3 CLEAR TO 22,76    // clear the box

         SETCOLOR("n/w")         // reverse box for instructions
         @ 5,5 CLEAR TO 20,74

         @  7, 10 SAY "DO YOU WANT TO DEMONSTRATE..."
         @  9, 15 SAY "1 - Bit Test, Set, Clear"
         @ 10, 15 SAY "2 - Bit-Wise Logical Manipulations"
         @ 12, 15 SAY "0 - Exit from here"
         @ 14, 10 SAY "Select by Number"

         nSlct := 0
         DO WHILE (nSlct < 48 .OR. nSlct > 50)
            nSlct := INKEY(0)
         END

         IF nSlct == 48
            EXIT
         END

         DO WHILE .t.      // OPERATIONS LOOP


            SETCOLOR("w/n")
            @ 2,3 CLEAR TO 22,76    // clear the box

            @ 3,10 SAY ;
               "Use numeric value of the byte(s) you wish to test.  This"
            @ 4,10 SAY ;
               "makes it easier to evaluate what's happening bit-wise."
            @ 11,10 SAY "Leave blanks empty to Quit"

            cInbyte1 := SPACE(3)

            IF nSlct == 49
               cInbyte2 := SPACE(1)
               @ 6,15 SAY "Byte value:   " GET cInbyte1 picture "###"
               @ 8,15 SAY "Bit position: " GET cInbyte2 picture "#"
            ELSE
               cInbyte2 := SPACE(3)
               @ 6,10 SAY "First byte value:  " GET cInbyte1 picture "###"
               @ 8,10 SAY "Second byte value: " GET cInbyte2 picture "###"
            END

            READ

            IF EMPTY(cInbyte1) .AND. EMPTY(cInbyte2)
               EXIT
            END

            @ 3,10 SAY SPACE(60)    // Cleanup display
            @ 4,10 SAY SPACE(60)
            @ 11,10 SAY SPACE(40)

            // Validations
            IF EMPTY(cInbyte1)
               QQOUT(CHR(7))
               @ 6,36 SAY "NEED BOTH VALUES"
               INKEY(3)
               LOOP
            END

            IF (nSlct == 49 ;
                  .AND. (VAL(cInbyte1) > 255 .OR. VAL(cInbyte2) > 7)) ;
                  .OR. (nSlct == 50 ;
                  .AND. (VAL(cInbyte1) > 255 .OR. VAL(cInbyte2) > 255))
               QQOUT(CHR(7))
               @ 6,36 SAY "0 - 255"
               IF nSlct == 49
                  @ 8,36 SAY "0 - 7"
               END
               INKEY(3)
               LOOP
            END

            // assign values in correct types
            nBytval := VAL(cInbyte1)
            nBitpos := VAL(cInbyte2)

            IF nSlct == 49
               cByte1 := CHR(nBytval)
            ELSE
               cByte1 := cByte3 := cByte5 := cByte7 := cByte8 := CHR(nBytval)
               cByte2 := cByte4 := cByte6 := CHR(nBitpos)
            END

            // Headings
            @ 3,28 SAY "Bit No. 7654 3210"
            @ 3,49 SAY "Hex"
            @ 3,55 SAY "Dec"
            @ 3,61 SAY "ASCII"

            @ 4,36 SAY REPLICATE(CHR(25),4)+" "+REPLICATE(CHR(25),4)
            @ 4,49 SAY "---"
            @ 4,55 SAY "---"
            @ 4,61 SAY "-----"

            @ 6,36 SAY FT_BYT2BIT(cByte1)    // full display 1st value
            @ 6,49 SAY FT_BYT2HEX(cByte1)
            @ 6,55 SAY STR(ASC(cByte1),3)
            @ 6,63 SAY cByte1

            IF nSlcT == 49

               // full displays of manipulated bytes

               @ 10,22 SAY "TEST Bit " + STR(nBitpos,1)
               @ 10,38 SAY IIF(FT_ISBIT(cByte1,nBitpos), ;
                  "* It is SET *","* It is CLEAR *")

               cByte3 := FT_BITSET(cByte1,nBitpos)
               @ 12,22 SAY "SET Bit " + STR(nBitpos,1)
               @ 12,36 SAY FT_BYT2BIT(cByte3)
               @ 12,49 SAY FT_BYT2HEX(cByte3)
               @ 12,55 SAY STR(ASC(cByte3),3)
               @ 12,63 SAY cByte3

               cByte5 := FT_BITCLR(cByte1,nBitpos)
               @ 14,22 SAY "CLEAR Bit " + STR(nBitpos,1)
               @ 14,36 SAY FT_BYT2BIT(cByte5)
               @ 14,49 SAY FT_BYT2HEX(cByte5)
               @ 14,55 SAY STR(ASC(cByte5),3)
               @ 14,63 SAY cByte5

            ELSE

               @ 8,36 SAY FT_BYT2BIT(cByte2)    // full display 2nd value
               @ 8,49 SAY FT_BYT2HEX(cByte2)
               @ 8,55 SAY STR(ASC(cByte2),3)
               @ 8,63 SAY cByte2

               // full displays of manipulated bytes

               cByte1 := FT_BYTEAND(cByte1,cByte2)
               @ 10,28 SAY "ANDed"
               @ 10,36 SAY FT_BYT2BIT(cByte1)
               @ 10,49 SAY FT_BYT2HEX(cByte1)
               @ 10,55 SAY STR(ASC(cByte1),3)
               @ 10,63 SAY cByte1

               cByte3 := FT_BYTEOR(cByte3,cByte4)
               @ 12,28 SAY "ORed"
               @ 12,36 SAY FT_BYT2BIT(cByte3)
               @ 12,49 SAY FT_BYT2HEX(cByte3)
               @ 12,55 SAY STR(ASC(cByte3),3)
               @ 12,63 SAY cByte3

               cByte5 := FT_BYTEXOR(cByte5,cByte6)
               @ 14,28 SAY "XORed"
               @ 14,36 SAY FT_BYT2BIT(cByte5)
               @ 14,49 SAY FT_BYT2HEX(cByte5)
               @ 14,55 SAY STR(ASC(cByte5),3)
               @ 14,63 SAY cByte5

               cByte7 := FT_BYTENOT(cByte7)
               @ 16,15 SAY "First byte - NOTed"
               @ 16,36 SAY FT_BYT2BIT(cByte7)
               @ 16,49 SAY FT_BYT2HEX(cByte7)
               @ 16,55 SAY STR(ASC(cByte7),3)
               @ 16,63 SAY cByte7

               cByte8 := FT_BYTENEG(cByte8)
               @ 18,15 SAY "First byte - NEGed"
               @ 18,36 SAY FT_BYT2BIT(cByte8)
               @ 18,49 SAY FT_BYT2HEX(cByte8)
               @ 18,55 SAY STR(ASC(cByte8),3)
               @ 18,63 SAY cByte8

            END         // nSlct 49 or 50?


            @ 21,10 SAY "Press a Key to Continue"
            INKEY(0)

         END            // End OPERATIONS LOOP

     END       // End MAIN LOOP

     SETCOLOR("w/n")
     CLEAR
  RETURN ( NIL )

#endif