All Inclusive...

Seymour Clufley · Post by **Seymour Clufley** » Mon Mar 08, 2010 6:58 pm

I have loads of include files, each for a different category- strings, internet, drawing, GUI, cgi etc. - and I'll put them on my homepage when it's online.

Meantime, here's a few procedures I find very useful:

Code: Select all

Procedure.b CompilationIsTest()
  
  prog.s = ProgramFilename()
  prog = GetFilePart(prog)
  prog = LCase(prog)
  If FindString(prog,"purebasic",0)
      If FindString(prog,"compilation",0)
          ProcedureReturn #True
      EndIf
  EndIf
  
EndProcedure



Macro IsBetween(num,a,b)
  (num>a And num<b)
EndMacro

Macro IsContained(num,a,b)
  (num=>a And num<=b)
EndMacro




Procedure.d Beat(a.d,b.d)
  
  If a>b
      ProcedureReturn a
  Else
      ProcedureReturn b
  EndIf
  
EndProcedure


Procedure.d Defeat(a.d,b.d)
  
  If a<b
      ProcedureReturn a
  Else
      ProcedureReturn b
  EndIf
  
EndProcedure


Macro DefeatThis(a,b)
  a = Defeat(a,b)
EndMacro
Macro BeatThis(a,b)
  a = Beat(a,b)
EndMacro





Procedure.d Centrify(span.d,object.d)
  
  If span=object
      ProcedureReturn 0
  EndIf
  
  outer.d = Beat(span,object)
  inner.d = Defeat(span,object)
  
  ProcedureReturn (outer/2)-(inner/2)
  
EndProcedure



Procedure.s StrB(int.i,capitalise.b=#False)
  
  If int=0
      ProcedureReturn ByteTruth(#False,capitalise)
  Else
      ProcedureReturn ByteTruth(#True,capitalise)
  EndIf
  
EndProcedure

Procedure.b ValB(t.s)
  
  t = LCase(t)
  Select t
      Case "true", "1", "yes"
          ProcedureReturn #True
      Default
          ProcedureReturn #False
  EndSelect
  
EndProcedure

Procedure.b ReverseByte(byte.b)
  
  If byte
      ProcedureReturn #False
  Else
      ProcedureReturn #True
  EndIf
  
EndProcedure

Procedure.i RandomRGB(minlevel.w,maxlevel.w)
  
  r = Random(maxlevel-minlevel)+minlevel
  g = Random(maxlevel-minlevel)+minlevel
  b = Random(maxlevel-minlevel)+minlevel
  
  ProcedureReturn RGB(r,g,b)
  
EndProcedure

charvista · Post by **charvista** » Sun Mar 21, 2010 2:05 pm

A function I added in my list of functions: zPokeText(). Because PureBasic is writing the string WITH an ending zero, this procedure first saves the character where the zero will be placed, then writes the string (with the unavoidable ending 'zero'), then overwrites the zero with the saved character with PokeA().

Code: Select all

Procedure zPokeText(*MemBuffer,Offset.i,Text.s)
    SaveZero.s = PeekS(*MemBuffer+Offset+Len(Text.s),1,#PB_Ascii)
    PokeS(*MemBuffer+Offset,Text.s,Len(Text.s),#PB_Ascii)
    PokeA(*MemBuffer+Offset+Len(Text.s),Asc(SaveZero.s))
EndProcedure

Perhaps there is a better way to do that? I tried

Code: Select all

    For Q=1 To Len(Text.s)
        PokeA(*MemBuffer+Offset+Q-1,Asc(Mid(Text,Q,1)))
    Next

but when the Buffer has a string of 10 million of characters, moving one by one takes really, really too long.
Blueznl, this is my 2 cents from your Survival Guide, Chapter 3, paragraph 7, where you says:

PokeS is the risky sibling to PeekS. It writes a string into memory. You can specify a length, BUT... it will always write the terminating zero!

charvista · Post by **charvista** » Sun Mar 21, 2010 2:20 pm

PureBasic has no Boolean. Hence I wrote two procedures for that.

Code: Select all

;==================================================================================================================================
; Procedure Name ....:  zBool
; Description .......:  Returns the Boolean value after Comparison between two Numeric Values
; Syntax ............:  zBool(Value1.d, ComparisonOperator.s, Value2.d)
; Parameter(s) ......:  Value1.d              First Value
;                       ComparisonOperator.s  Operator for comparison, valid are <, <=, =<, =, >, >=, =>, <>, ><
;                       Value2.d              Second Value
; Return value(s) ...:  Success:  Returns #True (1)
;                       Failure:  Returns #False (0)
; Author(s) .........:	Richard Vinck
; Creation Date .....:	2010-01-19
; Version ...........:	0.0.0.1
; Last Update .......:	2010-01-19
; Remarks ...........:	
;==================================================================================================================================
Procedure zBool(Value1.d, Comparison.s, Value2.d)
    Select Comparison
        Case "<"
            If Value1 < Value2
                ProcedureReturn #True
            Else
                ProcedureReturn #False
            EndIf
        Case "<=", "=<"
            If Value1 <= Value2
                ProcedureReturn #True
            Else
                ProcedureReturn #False
            EndIf
        Case "="
            If Value1 = Value2
                ProcedureReturn #True
            Else
                ProcedureReturn #False
            EndIf
        Case ">"
            If Value1 > Value2
                ProcedureReturn #True
            Else
                ProcedureReturn #False
            EndIf
        Case ">=", "=>"
            If Value1 >= Value2
                ProcedureReturn #True
            Else
                ProcedureReturn #False
            EndIf
        Case "<>", "><"
            If Value1 <> Value2
                ProcedureReturn #True
            Else
                ProcedureReturn #False
            EndIf
        Default
            MessageRequester("Error", "Invalid Boolean Compare", #PB_MessageRequester_Ok|#MB_ICONERROR)
       ;EndCase
   EndSelect
EndProcedure
;==================================================================================================================================
; Procedure Name ....:  zBoolS
; Description .......:  Returns the Boolean value after Comparison between two String Values
; Syntax ............:  zBoolS(Value1.s, ComparisonOperator.s, Value2.s)
; Parameter(s) ......:  Value1.s              First String
;                       ComparisonOperator.s  Operator for comparison, valid are <, <=, =<, =, >, >=, =>, <>, ><
;                       Value2.s              Second String
; Return value(s) ...:  Success:  Returns #True (1)
;                       Failure:  Returns #False (0)
; Author(s) .........:	Richard Vinck
; Creation Date .....:	2010-01-27
; Version ...........:	0.0.0.1
; Last Update .......:	2010-01-27
; Remarks ...........:	
;==================================================================================================================================
Procedure zBoolS(Value1.s, Comparison.s, Value2.s)
    Select Comparison
        Case "<"
            If Value1 < Value2
                ProcedureReturn #True
            Else
                ProcedureReturn #False
            EndIf
        Case "<=", "=<"
            If Value1 <= Value2
                ProcedureReturn #True
            Else
                ProcedureReturn #False
            EndIf
        Case "="
            If Value1 = Value2
                ProcedureReturn #True
            Else
                ProcedureReturn #False
            EndIf
        Case ">"
            If Value1 > Value2
                ProcedureReturn #True
            Else
                ProcedureReturn #False
            EndIf
        Case ">=", "=>"
            If Value1 >= Value2
                ProcedureReturn #True
            Else
                ProcedureReturn #False
            EndIf
        Case "<>", "><"
            If Value1 <> Value2
                ProcedureReturn #True
            Else
                ProcedureReturn #False
            EndIf
        Default
            MessageRequester("Error", "Invalid Boolean Compare", #PB_MessageRequester_Ok|#MB_ICONERROR)
       ;EndCase
   EndSelect
EndProcedure
;==================================================================================================================================

I use this to see if the result will become 0 (false) or 1 (true) in a nested checking like this:

Code: Select all

If Not(zBool(X.i, "=", 1) + zBool(X.i, "=", Len(Mask.s)))

blueznl · Post by **blueznl** » Sun Mar 21, 2010 2:35 pm

Yeah, CharVista, I did the same thing

My take on PokeS():

Code: Select all

Procedure.l x_pokes(addr.i,string.s,Length.i=-1,flags.i=-1)          ; writes a string into memory without the terminating zero if the string is too long
  Protected n.i,m.i
  ; Global x_retval.i
  ;
  ; *** similar to pokes() but will not write a terminating zero if the string is too long to fit, length is specified in bytes not in chars
  ;
  ; in:      addr.l                    - address to write to
  ;          string.s                  - string to write (either unicode or regular ascii)
  ;          [ length.i = n ]          - number of BYTES, not CHARS (see note below)
  ;                       -1           - auto detect
  ;          [ flags.i = #PB_Ascii ]   - write as regular ascii (default mode if program is compiled in ascii mode)
  ;                      #PB_Unicode   - write as unicode (default mode if program is compiled in unicode)
  ;                      #PB_UTF8      - write as UTF8
  ;                      -1            - automatically choose between unicode and ascii, see above
  ; retval:  .i                        - number of bytes written
  ; out:     x_retval.i                - same as retval
  ;
  ; notes:
  ;
  ; - x_pokes() 'lenght' parameter specifies the number of BYTES, not the number of chars!
  ; - x_pokes() ONLY writes one or two terminating zeroes if there is enough space!
  ; - purebasic's pokes() 'length' parameter specifies the number of CHARS, not the number of bytes!
  ; - purebasic's pokes() ALWAYS writes a terminating zero into memory (2 if writing unicode)!
  ; - no support for UTF8 in memory (use ASCII)
  ;
  ;
  If flags = -1
    CompilerIf #PB_Compiler_Unicode
      flags = #PB_Unicode
    CompilerElse
      flags = #PB_Ascii
    CompilerEndIf
  EndIf
  ;
  x_retval = StringByteLength(string,flags)
  If flags = #PB_Unicode
    x_retval = x_retval+2
  Else
    x_retval = x_retval+1
  EndIf
  ;
  m = AllocateMemory(x_retval)
  If flags = -1
    PokeS(m,string)
  Else
    PokeS(m,string,-1,flags)
  EndIf
  ;
  If length > -1 And length < x_retval
    x_retval = length
  EndIf
  CopyMemory(m,addr,x_retval)
  FreeMemory(m)
  ;
  ProcedureReturn x_retval
EndProcedure

jamba · Post by **jamba** » Mon Mar 29, 2010 4:09 pm

I use this VERY frequently. Trond actually wrote the code, and I modified it to fit my purpose.

Code: Select all

Procedure ReadFile2Array(Array sarr.s(1), fname.s, RemoveComments.i = #False, Commenter.s = "!")
  ;trond's take on the readfile2array proc.
  ;reads in the entire file at once, before using pointers to look at the string in memory, split it at the correct places and put the lines into the array:
  ;Forum link: http://www.purebasic.fr/english/viewtopic.php?f=13&t=40675&start=0  
  Protected Length, n.l
  Protected File.s
  Protected *Memory.Character, *Linestart
  Protected I
  Protected JumpCR.i
  If ReadFile(0, fname)
    Length = Lof(0)
    File = Space(Length)
    ReadData(0, @File, Length) ; Read in the entire file at once
    CloseFile(0)
    n=CountString(File, #LF$)-1
    Dim sarr(n)
    *Memory = @File
    *Linestart = *Memory
    While *Memory\c
      ;Read until linefeed
      If *Memory\c <> #LF
        *Memory + 1          
      Else
        ; Handle the optional CR part of CRLF
        *Memory - 1
        If *Memory\c = #CR
          JumpCR = 1
        Else
          *Memory + 1
          JumpCR = 0
        EndIf
        ; Copy string into array
        If RemoveComments
          ;Trim out the whitespace and any comments, leading or trailing
          sarr(I) = TrimComments(PeekS(*Linestart, *Memory-*Linestart),Commenter)
        Else
          ;just trim the whitespace
          sarr(I) = Trim(PeekS(*Linestart, *Memory-*Linestart))
        EndIf
        *Linestart = *Memory+1 + JumpCR
        *Memory + 2 + JumpCR
        If (sarr(I) <> "") : I + 1 : EndIf ;overwrite blank strings
      EndIf
    Wend
    If n > (I-1)
      ;This means that blank lines were present, and overwritten.  
      ;ReDimming will shorten the array, and eliminate the white space.
      ReDim sarr(I-1)
    EndIf
  EndIf
EndProcedure

and this goes along with it

Code: Select all

Procedure.s TrimComments(s.s, Commenter.s = "!")
  Protected pos.i
  
  s=Trim(s)    
  pos = FindString(s, Commenter,1)
    
  If pos = 0 ;no comments    
    ProcedureReturn s
  ElseIf pos = 1 ;whole line is a comment
    ProcedureReturn "" ;return blank line
  EndIf
    
  ProcedureReturn Trim(Left(s, pos - 1))
EndProcedure

here's another. simple, but I use it a lot:

Code: Select all

Procedure.s GetStrBetween (WholeString.s, FirstVal.s, SecondVal.s) 
  WholeString = Right(WholeString, Len(WholeString) - (FindString(WholeString, FirstVal,1) + Len(FirstVal) - 1))
  ProcedureReturn Left(WholeString, (FindString(wholeString, SecondVal,1) - 1))
EndProcedure

I'm sure I have some more to share. I'm still converting a lot of code from VB, though.

PureBasic Forums - English

All Inclusive...

Re: All Inclusive...

Re: All Inclusive...

Re: All Inclusive...

Re: All Inclusive...

Re: All Inclusive...