' =============================================================================
' Program..... BitOps.bas
' Author...... Jon Williams (jonwms@aol.com)
' Copyright... Copyright (c) 1999 Jon Williams
'
' Started..... 04 NOV 1999
' Updated..... 17 NOV 1999
' =============================================================================


' --[ Module Description ]-----------------------------------------------------
'
' This BasicX module was designed for dealing with bit flags stored in a byte
' variable or array of bytes.
'
' Functions:
'   - MaskValB(bit) : Byte; returns 2^bit
'   - IsSetB(byte, bit) : Boolean; returns True if bit of byte is set (1)
'   - IsSetA(array, bit) : Boolean; returns True if bit of array is set (1)
'
' Subroutines:
'   - SetBitB(byte, bit) : Sets (makes 1) bit of byte (byte is changed)
'   - ClearBitB(byte, bit) : Clears (makes 0) bit of byte (byte is changed)
'   - PutBitB(byte, bit, val) : Puts val into bit of byte (byte is changed)
'   - PubBitA(array, bit, val) : Puts val into bit of array (array is changed)


' --[ Revision History ]-------------------------------------------------------
'
' 04 NOV 99 : Written and tested.
' 17 NOV 99 : Added IsSetA and PutBitA (per Jack Schoof suggestion)


' --[ Functions ]--------------------------------------------------------------
'
Public Function MaskValB(ByVal theBit As Byte) As Byte

  Dim temp As Byte

  temp = bx00000001                 	' start with LSB

  Do While (theBit > 0)             	' is mask bit correct?
    temp = temp * 2                 	' not yet, shift left
    theBit = theBit - 1             	' mark the shift
  Loop

  MaskValB = temp                   	' return mask to caller

End Function


Public Function IsSetB(ByVal theByte As Byte, ByVal theBit As Byte) As Boolean

  Dim test As Byte

  test = theByte And MaskValB(theBit)	' remove other bits
  IsSetB = (test > 0)			' return T or F

End Function


Public Function IsSetA(ByRef bitString() As Byte, _
                       ByVal theBit As Byte) As Boolean

  ' Note: bitString() requires a lower bound of 1

  Dim pos As Integer
  Dim test As Byte

  pos = (CInt(theBit) \ 8) + 1		' get array element
  theBit = theBit Mod 8			' get bit in element

  test = bitString(pos) And MaskValB(theBit)

  IsSetA = (test > 0)			' return T or F

End Function


' --[ Subroutines ]------------------------------------------------------------
'
Public Sub SetBitB(ByRef theByte As Byte, ByVal theBit As Byte)

  theByte = theByte Or MaskValB(theBit)	' Or with mask to set

End Sub


Public Sub ClearBitB(ByRef theByte As Byte, ByVal theBit As Byte)

  Dim mask As Byte

  mask = MaskValB(theBit) XOr &HFF		' invert mask bits
  theByte = theByte And mask		' preserve all but spec'd bit

End Sub


Public Sub PutBitB(ByRef theByte As Byte, _
                   ByVal theBit As Byte, _
                   ByVal bitVal As Byte)

  If (bitVal = 0) Then
    Call ClearBitB(theByte, theBit)
  Else
    Call SetBitB(theByte, theBit)		' non-zero bitVal sets the bit
  End If

End Sub


Public Sub PutBitA(ByRef bitString() As Byte, _
                   ByVal theBit As Byte, _
                   ByVal bitVal As Byte)

  ' Note: bitString() requires a lower bound of 1

  Dim pos As Integer

  pos = (CInt(theBit) \ 8) + 1
  theBit = theBit Mod 8

  If (bitVal = 0) Then
    Call ClearBitB(bitString(pos), theBit)
  Else
    Call SetBitB(bitString(pos), theBit)
  End If

End Sub