Mid statement

Share your advanced PureBasic knowledge/code with the community.
BorisTheOld
Enthusiast
Enthusiast
Posts: 542
Joined: Tue Apr 24, 2012 5:08 pm
Location: Ontario, Canada

Mid statement

Post by BorisTheOld »

A number of PB users have complained about the lack of certain statements in PB that are common to other BASIC dialects. When we first started using PB, we spent a few months creating macros and support procedures to replicate, as much as possible, the standard BASIC syntax. We also included many macros to implement some useful PowerBasic statements, such as StrPtr, to make it easier to do the conversion.

So for those like myself, who migrated to PB from PowerBasic, here's a simple solution for the Mid statement. It uses macros, in conjunction with a procedure, to hide the quirky PB syntax and to avoid PB's messy ByRef "feature". We didn't include PowerBasic's ability to do reverse text substitutions, by means of negative lengths, but this would be easy to add if needed.

To be consistent with our naming conventions, we implemented the Mid-function and Mid-statement as MidGet and MidSet.

Code: Select all

Macro StrPtr (bvsString)
  @bvsString
EndMacro

Macro MidGet (bvsString, bviPosn, bviLength)
  Mid(bvsString, bviPosn, bviLength)
EndMacro

Macro MidSet (bvsString1, bviPosn, bviLen2, bvsString2)
  subMidSet (StrPtr(bvsString1), Len(bvsString1), bviPosn, bviLen2, bvsString2, Len(bvsString2))
EndMacro

Procedure subMidSet (bviStringPtr1.i, bviLength1.i, bviPosn.i, bviLen2.i, bvsString2.s, bviLength2.i)
  
  Protected iLength1.i       ; calculated new length of string1, before truncation to its original length
  Protected iLen2.i          ; the number of characters to copy from string2 to string1
  Protected iStringPtr1.i    ; address in string1 that receives the copied characters

  If bviLength1 < 1 Or bviLen2 < 1 Or bviLength2 < 1 Or bviPosn > bviLength1
    ProcedureReturn                          ; no characters need to be copied
  EndIf

  If bviLen2 < bviLength2                    ; select the fewest number of characters to be copied
    iLen2 = bviLen2
  Else
    iLen2 = bviLength2
  EndIf

  iLength1 = bviPosn + iLen2 - 1             ; calculate the new length of string1

  If iLength1 > bviLength1
    iLen2 = iLen2 - (iLength1 - bviLength1)  ; reduce the number of copied characters to fit into string1
  EndIf

  iStringPtr1 = bviStringPtr1 + bviPosn - 1

  CopyMemory(StrPtr(bvsString2), iStringPtr1, iLen2)

EndProcedure

Define Text.s = "Hello World"
  
MidSet(Text, 9, 10, "12345") ; this requests that 10 characters be copied from "12345", starting at position 9 in Text

Debug Text                   ; Text = "Hello Wo123"

Define Text.s = "Hello World"
  
MidSet(Text, 1, 5, MidGet(Text, 7, 5))

Debug Text                   ; Text = "World World"
For ten years Caesar ruled with an iron hand, then with a wooden foot, and finally with a piece of string.
~ Spike Milligan
IdeasVacuum
Always Here
Always Here
Posts: 6426
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: Mid statement

Post by IdeasVacuum »

MidGet:

Code: Select all

Result$ = Mid(String$, StartPosition [, Length])
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
BorisTheOld
Enthusiast
Enthusiast
Posts: 542
Joined: Tue Apr 24, 2012 5:08 pm
Location: Ontario, Canada

Re: Mid statement

Post by BorisTheOld »

IdeasVacuum wrote:MidGet:

Code: Select all

Result$ = Mid(String$, StartPosition [, Length])
We always specify a length for Mid statements, that's why the MidGet macro is written the way it is.

The MidGet macro isn't really needed, but it fits better into our naming conventions. PB's statement names aren't always consistent, so I've mandated that we use macros to create consistent, self-documenting names.
For ten years Caesar ruled with an iron hand, then with a wooden foot, and finally with a piece of string.
~ Spike Milligan
User avatar
Danilo
Addict
Addict
Posts: 3036
Joined: Sat Apr 26, 2003 8:26 am
Location: Planet Earth

Re: Mid statement

Post by Danilo »

To support Unicode UTF-16/UCS-2 characters $0-$FFFF (Basic Multilingual Plane only), a simple change is required:

Code: Select all

Macro StrPtr (bvsString)
  @bvsString
EndMacro

Macro MidGet (bvsString, bviPosn, bviLength)
  Mid(bvsString, bviPosn, bviLength)
EndMacro

Macro MidSet (bvsString1, bviPosn, bviLen2, bvsString2)
  subMidSet (StrPtr(bvsString1), Len(bvsString1), bviPosn, bviLen2, bvsString2, Len(bvsString2))
EndMacro

Procedure subMidSet (bviStringPtr1.i, bviLength1.i, bviPosn.i, bviLen2.i, bvsString2.s, bviLength2.i)
  
  Protected iLength1.i       ; calculated new length of string1, before truncation to its original length
  Protected iLen2.i          ; the number of characters to copy from string2 to string1
  Protected iStringPtr1.i    ; address in string1 that receives the copied characters

  If bviLength1 < 1 Or bviLen2 < 1 Or bviLength2 < 1 Or bviPosn > bviLength1
    ProcedureReturn                          ; no characters need to be copied
  EndIf

  If bviLen2 < bviLength2                    ; select the fewest number of characters to be copied
    iLen2 = bviLen2
  Else
    iLen2 = bviLength2
  EndIf

  iLength1 = bviPosn + iLen2 - 1             ; calculate the new length of string1

  If iLength1 > bviLength1
    iLen2 = iLen2 - (iLength1 - bviLength1)  ; reduce the number of copied characters to fit into string1
  EndIf
  
  CompilerIf #PB_Compiler_Unicode
    ; Attention! Supports Basic Multilingual Plane only (characters $0-$FFFF)
    iStringPtr1 = bviStringPtr1 + (bviPosn - 1)*SizeOf(Character)
    CopyMemory(StrPtr(bvsString2), iStringPtr1, iLen2*SizeOf(Character))
  CompilerElse
    iStringPtr1 = bviStringPtr1 + bviPosn - 1
    CopyMemory(StrPtr(bvsString2), iStringPtr1, iLen2)
  CompilerEndIf

EndProcedure

Define Text.s = "Hello World"
  
MidSet(Text, 9, 10, "12345") ; this requests that 10 characters be copied from "12345", starting at position 9 in Text

Debug Text                   ; Text = "Hello Wo123"

Define Text.s = "Hello World"
  
MidSet(Text, 1, 5, MidGet(Text, 7, 5))

Debug Text                   ; Text = "World World"
Post Reply