Octal() function to a string library

[Lunasole]

PB has Bin() and Hex() already, but misses Oct(). It looks nice to have this conversion too for full set and "let it be, it doesn't need any food"

https://rosettacode.org/wiki/Count_in_octal#PureBasic

[skywalk]

I use this for integers to another base$.

Code: Select all

;- Base Conversions
#Base2$     = "01"                    ; Binary
#Base8$     = "01234567"              ; Octal
#Base10$    = "0123456789"            ; Decimal
#Base16LC$  = "0123456789abcdef"      ; Hex, LCase
#Base16$    = "0123456789ABCDEF"      ; Hex, UCase
Procedure$ SF_IntToBase(x.q, BaseToUse$=#Base8$)
  ; Convert positive integer to baseXX string.
  Protected.q BaseLen = Len(BaseToUse$)
  Protected.s r$
  If x > 0
    While x <> 0
      r$ = Mid(BaseToUse$, (x % BaseLen) + 1, 1) + r$
      x / BaseLen
    Wend
  Else
    r$ = "0"
  EndIf
  ProcedureReturn r$
EndProcedure
For i = 0 To 16
  Debug LSet(Str(i),4) + LSet(SF_IntToBase(i),4)
Next

[idle]

I needed an octal representation for setting a file permission in a function, so maybe this will be useful for cases where you'd want to enter numbers in their bases to use in functions. for example if you wanted to set nix file permissions in a function like 644

Code: Select all

Procedure.s OCT(number.q) 
  Protected s.s=Space(8*SizeOf(Character)) 
  For a = 7 To 0 Step -1
    PokeS(@s+a*SizeOf(Character),Str(number & 7),SizeOf(Character),#PB_String_NoZero) 
    number >> 3 
  Next   
  ProcedureReturn Trim(s,"0") 
EndProcedure   

;converts and assigns a variable with a constant in the given base 2,8,16
Macro _DEC(var,val,base) 
  EnableASM 
  CompilerSelect base 
    CompilerCase 2 
      mov var, val#b 
    CompilerCase 8
      mov var, val#o 
    CompilerCase 16
      mov var, 0#val#h    
  CompilerEndSelect 
  DisableASM    
EndMacro 

;take a string from respective bases 16,8,2 convert to decimal  
Procedure.q ConvertToDecimal (v.s,b) 
  Protected slen = Len(v)-1
  Protected *pc.Character = @v 
  Protected r.q 
  For a = slen To 0 Step -1  
    Select *Pc\c 
        Case 65,66,67,68,69 
          r + ((*pc\c-55) * Pow(b,a))
        Case 97,98,99,100,101,102 
          r + ((*pc\c-87) * Pow(b,a))
        Default 
          r + ((*pc\c-48) * Pow(b,a))
    EndSelect       
    *pc+2 
  Next 
  ProcedureReturn r 
EndProcedure   


Define a.q

 _DEC(a,10101,2)   
 Debug "Dec " + Str(a) + " Bin " + Bin(a) 
 _DEC(a,644,8)
 Debug "Dec " + Str(a) + " Oct " + OCT(a) 
 _DEC(a,abc123,16)
 Debug "Dec " + Str(a) + " Hex " + Hex(a) 

Debug ConvertToDecimal("ABC123",16) 
Debug ConvertToDecimal("644",8)
Debug ConvertToDecimal("10101",2)