'===========================================================================
' Subject: LONGBYTE BITSTREAM ARRAYS          Date: 04-17-98 (22:23)       
'  Author: Tony L. Damigo                     Code: PB                     
'  Origin: kvdojo@lightspeed.net            Packet: BINARY.ABC
'===========================================================================
CLS
DEFLNG A-Z

' ***********************    L O N G B Y T E    ************************

' Create & Manipulate LongByte Bitstream Arrays
'
' Coded by: Tony Damigo                    Date:
' 100% PUBLIC DOMAIN                       E-Mail  : kvdojo@lightspeed.net
'
' PowerBasic 3.1
'
' Purpose: Create a large Bitstream that can be used for flagging elements,
'          saving the eliments for file storage, retreival, and anything
'          else your mind comes up with :-)
'
' Disclaimer: I have tested this code and had no problems with it.
'             I will assume no respondsibility for problems, or damages.
'             Use this code at your own risk.
'
' *********************************************************************
'                          LONGBYTE PROCEDURES
' **********************************************************************

' FUNCTION GetLongByte ( BitStream$ )
'   Calculates the array size and returns amount of elements in "BitList"

' SUB ReadLongByte( BitStream$, ByteArray() )
'   Extracts information from BitStream$, and loads it in the LongByte Array

' FUNCTION ZapLongByte ( BitFlag, ByteArray() )
'   Sets the complete bitstream to zero, or one

' FUNCTION MKLongByte$ ( ByteArray())
'   Converts the LongByte array into STRING format for storage

' SUB SetLongByte ( BitLoc, BitFlag, ByteArray() )
'   Sets, or Resets one element in the bitstream. BitFlag=1, or 0

' FUNCTION  ChkLongByte ( BitLoc, ByteArray() )
'   Checks to see if a LongByte element is ON '1', or OFF '0'

' ---------------------------------------------------------------------

FUNCTION GetLongByte(BitStream$) PUBLIC
  SHARED BitList
  BitList=0
  Bitz=LEN(BitStream$)*8
  ByteLen=(Bitz\8)
  IF (Bitz\8 <> Bitz/8) THEN INCR ByteLen
  BitList=Bitz
  FUNCTION=ByteLen
END FUNCTION

SUB ReadLongByte( BYVAL BitStream$, ByteArray(0)) PUBLIC
  Bitz=LEN(BitStream$)*8
  ByteLen=(Bitz\8)
  IF (Bitz\8 <> Bitz/8) THEN INCR ByteLen
  FOR Bytes=1 TO ByteLen
    ByteArray(Bytes)=CVBYT(Mid$(BitStream$,Bytes,1))
  NEXT
END SUB


SUB ZapLongByte(BitFlag, ByteArray(0)) PUBLIC
 FOR X=1 TO (UBOUND(ByteArray)*8)
   SetLongByte X,BitFlag, ByteArray()
 NEXT X
END SUB


FUNCTION MKLongByte$(ByteArray(0)) PUBLIC
  BitStream$=""
  FOR Bytes=1 TO UBOUND(ByteArray)
    BitStream$=(BitStream$+MKBYT$(ByteArray(Bytes)))
  NEXT
  FUNCTION=BitStream$
END FUNCTION


SUB SetLongByte( BYVAL BITLOC, BYVAL BitFlag, ByteArray(0)) PUBLIC
  BYTES=((BITLOC-1)\8)+1
  Bitz=BITLOC-((BYTES-1)*8)
  IF BitFlag=1 THEN
    BIT SET ByteArray(BYTES),(Bitz-1)
  ELSE
    BIT RESET ByteArray(BYTES),(Bitz-1)
  END IF
END SUB

FUNCTION ChkLongByte( BYVAL BITLOC, ByteArray(0)) PUBLIC
  BYTES=((BITLOC-1)\8)+1
  Bitz=BITLOC-((BYTES-1)*8)
  FUNCTION=BIT (ByteArray(BYTES),Bitz-1)
END FUNCTION

' **********************************************************************
'                           END OF PROCEDURES
' **********************************************************************

' I've run arrays up to 9,999 but it can be persuaded to go beyond that
' if you change the integer, or DEF type. You can play with that part :-)
' ----------------------------------------------------------------------


Appts$  =  SPACE$( 5 )                        ' 8 X Bytes/Spaces = Elements

REDIM AnyArray( GetLongByte( Appts$ ) )       ' Dimension the Array while
ListCount  =  BitList                         ' adjusting the eliments
                                              ' then return the BitList

CAll ReadLongByte( Appts$ , AnyArray() )      ' Load the LongByte Array


CALL ZapLongByte( 0 , AnyArray() )            ' Normaly we don't want to
                                              ' ZAP our LongByte. However,
                                              ' we've just created a one
                                              ' so we'll set all eliments
                                              ' to zero.

FOR  X = 1 TO LISTCOUNT STEP 3                ' Turn every third bit ON
 CALL SetLongByte( X,1, ANYArray())
NEXT

SaveThis$=mkLongByte$(anyarray())             ' Save the new changes

ByteSize=UBOUND(AnyArray())

COLOR 15,1
CLS
PRINT
PRINT " LONGBYTE by Tony Damigo  [public domain]
PRINT
PRINT " The LONGBYTE porcedures will allows you to load & manipulate a numeric array,"
PRINT " and treat is as a large 'Bitstream', and you will be able store & retrieve"
PRINT " this information in string formate.  As an example:  an array representing"
PRINT   STR$(ByteSize)+" Bytes >"+ STRING$(ByteSize,176) +"< will contain"+STR$(ListCount)_
      +" ELEMENTS, or BITS. This could be useful in"
PRINT " flagging appointments, dates, etc."

PRINT

  HR=7 : MOMENTS=0 : GAP=0

  FOR Bitz = 1 TO ListCount
     IF MOMENTS = 0 THEN INCR HR
     IF HR > 12 THEN HR=1
     HR$=LTRIM$(RTRIM$(STR$(HR)))
     IF HR < 10 THEN HR$=" "+HR$
     MO$=LTRIM$(RTRIM$(STR$(MOMENTS*15)))
     IF MO$="0" THEN MO$="00"
     OK=ChkLongByte(Bitz, AnyArray())
     PRINT "  ";HR$+":"+MO$;
     IF OK THEN
       PRINT CHR$(32,176),
     ELSE
       PRINT,
     END IF

     INCR GAP
     IF GAP > 3 THEN
        PRINT
        GAP=0
     END IF

     INCR MOMENTS
     IF MOMENTS > 3 THEN MOMENTS =0
  NEXT Y


' ---------------------------- Second Demo ------------------------------

 Days$  =  SPACE$( 10 )
 REDIM DAYArray( GetLongByte( Days$ ) )
 ListCount  =  BitList
 CAll ReadLongByte( Days$ , DayArray() )
 CALL ZapLongByte( 0 , DAYArray() )

 FOR X =1 TO ListCount STEP 3
    CALL SetLongByte(X,1, DAYArray())           ' Toggle part of the array
 NEXT X

 ByteSize=UBOUND(DayArray())



 LOCATE 21,10 : PRINT "An";Listcount;"Element LONGBYTE looks like this > ";
 LOCATE 24,3  : PRINT "ENTER to 'Toggle' through the bitstream. Use Arrows keys. Press ESC to Exit";

 PTR =1
 LPTR=1
 DO
   SaveThis$=mkLongByte$(DAYarray())
   LOCATE 21,52
   COLOR 7,0
      PRINT SaveThis$;
    COLOR 15,1
      PRINT " <"

   COLOR 7,0
   LOCATE 22,1
     FOR X = 1 TO ListCount
       FLAG= ChkLongByte( X, DAYArray())
         IF FLAG=1 THEN
           PRINT "°";
         ELSE
           PRINT " ";
         END IF
      NEXT X

 COLOR 15,1
 LOCATE 23, LPTR : PRINT " ";
 LOCATE 23,PTR   : PRINT "^";
 LPTR=PTR

   DO : LOOP UNTIL INSTAT
      A$=INKEY$
      SELECT CASE A$
      CASE CHR$(27)
       CLS : END
      CASE CHR$(13)
        CHK= ChkLongByte( PTR, DAYArray())
        IF CHK=1 THEN
           CALL SetLongByte(PTR,0, DAYArray())
        ELSE
           CALL SetLongByte(PTR,1, DAYArray())
        END IF
        INCR PTR
        IF PTR > 80 THEN PTR=1

      CASE CHR$(0,77)
        INCR PTR
        IF PTR > 80 THEN PTR=1
      CASE CHR$(0,75)
        DECR PTR
        IF PTR < 1 THEN PTR=80
      CASE ELSE
      END SELECT

LOOP
END