PureBasic Forums - English

Code: Select all

;BitField wrangler  
;idle 19/4/2016 
;supports byte, word, long and integer width fields 
;usage see example 

Structure BitField 
  *bits.Integer  
  Size.l 
  BF_Index.l 
  BF_Offset.l 
  BF_Mask.i  
  Array BF.i(1,0) 
EndStructure  

Procedure NewBitField(NumFields,Address=0,size=4) 
  Protected *this.BitField 
  *this = AllocateStructure(BitField) 
  If *this
    *this\size = size 
    *this\bits = Address 
     ReDim *this\bf(1,NumFields) 
     ProcedureReturn *this 
  EndIf  
EndProcedure  

Procedure FreeBitField(*BitField) 
  FreeStructure(*BitField) 
EndProcedure   
  
Procedure AddBitField(*BitField.BitField,NumBits) 
  Select *BitField\size 
    Case 1 
      *BitField\BF_Mask = $FF
      *BitField\BF_Mask >> (8-NumBits)
    Case 2 
      *BitField\BF_Mask = $FFFF
      *BitField\BF_Mask >> (16-NumBits)
    Case 4   
      *BitField\BF_Mask = $FFFFFFFF
      *BitField\BF_Mask >> (32-NumBits)
    Case 8 
      *BitField\BF_Mask = $FFFFFFFFFFFFFFFF
      *BitField\BF_Mask >> (64-NumBits)
  EndSelect     
  
  *BitField\bf(0,*BitField\BF_Index) = (*BitField\BF_Mask << *BitField\BF_Offset) 
  *BitField\bF(1,*BitField\BF_Index) = *BitField\BF_Offset 
  *BitField\BF_Offset + NumBits 
  *BitField\BF_Index+1
EndProcedure  

Macro GetBitField(BitField,Index) 
  ((BitField\bits\i & BitField\bf(0,index)) >> BitField\bf(1,index)) 
EndMacro   

Macro SetBitField(BitField,index,val)
   BitField\bits\i | (val << BitField\bf(1,index))
EndMacro   

Macro ReSetBitField(BitField,index,val) 
  BitField\bits\i & ~BitField\bf(0,index) | (val << BitField\bf(1,index))
EndMacro    

Macro SetBitFieldPointer(BitField,Address) 
  BitField\bits = Address 
EndMacro   

;Example of a date and time 

Global The_date.l, Future_date.l, strdate.s, Month.l=4

Global *date.BitField = NewBitField(5); define a bitfield wrangler specifying number of field entries  

Enumeration  ;optional set up indicies for the bitfield    
  #date_day         
  #date_month  
  #date_year  
  #date_hour  
  #date_min   
EndEnumeration 

AddBitField(*date,5)  ;Add the bitfields specifiying the required bit widths 
AddBitField(*date,4)         
AddBitField(*date,12)  
AddBitField(*date,5)
AddBitField(*date,6) 

;use the *date.bitfield wrangler macros   
SetBitFieldPointer(*date,@The_date) ;set the wrangler to work on the var "The_date"  

SetBitField(*date,#date_day,18+1)  ;set the date and time    
SetBitField(*date,#date_month,month)  
SetBitField(*date,#date_year,2016)  
SetBitField(*date,#date_hour,1)
ReSetBitField(*date,#date_hour,16) ;clears and sets a field (just a longer opperation)  
SetBitField(*date,#date_min,59) 

Debug The_date ;check the var was set by the wrangler  

;extract the date into a string 
strdate + Str(GetBitField(*date,#date_day)) + "/"  
strdate + Str(GetBitField(*date,#date_month)) + "/"
strdate + Str(GetBitField(*date,#date_year)) + " " 
strdate + Str(GetBitField(*date,#date_hour)) + ":" 
strdate + Str(GetBitField(*date,#date_min)) 

Debug strdate 
strdate ="" 

Future_date = -300906349  ;future date a 100 years forward   
SetBitFieldPointer(*date,@future_date) ;point the wrangler to work with Future_date 
;extract it to a string 
strdate + Str(GetBitField(*date,#date_day)) + "/"   
strdate + Str(GetBitField(*date,#date_month)) + "/"
strdate + Str(GetBitField(*date,#date_year)) + " " 
strdate + Str(GetBitField(*date,#date_hour)) + ":" 
strdate + Str(GetBitField(*date,#date_min)) 

Debug strdate 

;done, free the wrangler  
FreeBitField(*date) 

Code: Select all

Procedure.i Truecolor24to8bit(r,g,b)
  ProcedureReturn (((r*8)/256) << 5) | (((g*8)/256) << 2) | ((b*4)/256)
EndProcedure

Code: Select all

For i = 0 To 255
  r = ((i & %11100000) * 73) >> 6
  g = ((i & %00011100) * 73) >> 3
  b = (i & %00000011) * 85
  Debug Hex(RGBA(r, g, b, 255), #PB_Long)
Next

Code: Select all

Enumeration ;enum indices lowest bits to highest bits 
  #mblue
  #mgreen
  #mred 
EndEnumeration 

Define color.a 

*col.BitField = NewBitField(3,@color,1) ;define a template for 1 byte 
AddBitField(*col,2)  ;set the bit widths
AddBitField(*col,3)
AddBitField(*col,3)

Procedure.i Truecolor24to8bit(r,g,b)
  ProcedureReturn (((r*8)/256) << 5) | (((g*8)/256) << 2) | ((b*4)/256)
EndProcedure

r = 127
g = 127
b = 255 

color = Truecolor24to8bit(r,g,b) 
 
Debug (r*8)/256
Debug (g*8)/256
Debug (b*4)/256

Debug GetBitField(*col,#mred) ;extract in what order you want 
Debug GetBitField(*col,#mgreen)
Debug GetBitField(*col,#mblue)