Make CHR() support multiple arguments

[Quin]

It would be great if the Chr() function could accept more than one argument, so I can build strings using raw ASCII codes entirely. For example:

Code: Select all

Debug Chr(80, 117, 114, 101, 66, 97, 115, 105, 99)

output:
PureBasic

[nsstudios]

+1
Asc could do this too, either support a multicharacter input or multiple params.

[Mijikai]

Could be useful.

Workaround:

Code: Select all

EnableExplicit

Procedure.i AllocChr(Codes.s)
  Protected.Ascii *c,*m
  Protected.s s
  Protected.i i
  *c = @Codes
  While *c\a
    If *c\a = ','
      i + 1
    EndIf
    *c + 2
  Wend
  If i
    *m = AllocateMemory(i + 2)
    If *m
      *c = *m
      i = 0
      Repeat
        i + 1
        s = StringField(Codes,i,",")
        If s
          *c\a = Val(s)
          *c + 1
        EndIf
      Until s = #Null$
      ProcedureReturn *m
    EndIf
  EndIf
  ProcedureReturn #Null
EndProcedure

Procedure.i Main()
  Protected *m
  *m = AllocChr("80,117,114,101,66,97,115,105,99")
  ShowMemoryViewer(*m,MemorySize(*m))
  Debug PeekS(*m,-1,#PB_Ascii)
  FreeMemory(*m)
  ProcedureReturn #Null
EndProcedure

End Main()

[Quin]

Neat trick Mijikai!

[AZJIO]

Code: Select all

EnableExplicit

Procedure SplitL(String.s, List StringList.s(), Separator.s = " ")
	Protected S.String, *S.Integer = @S
	Protected.i p, slen
	slen = Len(Separator)
	ClearList(StringList())
	
	*S\i = @String
	Repeat
		AddElement(StringList())
		p = FindString(S\s, Separator)
		StringList() = PeekS(*S\i, p - 1)
		*S\i + (p + slen - 1) << #PB_Compiler_Unicode
	Until p = 0
	*S\i = 0
EndProcedure

Procedure.i Main()
	Protected Result.string, length, *Point
	Protected NewList num.s()
	SplitL("80,117,114,101,66,97,115,105,99", num(), ",")
	length = ListSize(num())
	Result\s = Space(length)
	*Point = @Result\s
	ForEach num()
		CopyMemoryString(Chr(Val(num())), @*Point)
	Next
	ShowMemoryViewer(@Result\s, StringByteLength(Result\s))
	Debug Result\s
EndProcedure

Main()

[idle]

with c backend it's easy

Code: Select all

Structure aAscii 
  a.a[0] 
EndStructure 

Global *pa.aAscii  
!char ca[] = {80,117,114,101,66,97,115,105,99}; 
!gp_pa = &ca;

Debug PeekS(*pa,-1,#PB_Ascii) 

For a = 0 To 8 
  Debug *pa\a[a] 
Next   

[Taz]

with c backend it's easy

Code: Select all

Structure aAscii 
  a.a[0] 
EndStructure 

Global *pa.aAscii  
!char ca[] = {80,117,114,101,66,97,115,105,99}; 
!gp_pa = &ca;

Debug PeekS(*pa,-1,#PB_Ascii) 

For a = 0 To 8 
  Debug *pa\a[a] 
Next

Very interesting, great thing

[AZJIO]

Code: Select all

tmp$ = "PureBasic"
*Buffer = Ascii(tmp$)
; PokeS(*Buffer, tmp$, MemorySize(*Buffer), #PB_Ascii)
; Debug PeekS(*Buffer, MemorySize(*Buffer), #PB_Ascii)
; ShowMemoryViewer(*Buffer, MemorySize(*Buffer))
; Debug Asc(tmp$)
For i = 0 To MemorySize(*Buffer) - 2
	Debug PeekA(*Buffer + i * SizeOf(ASCII))
Next
FreeMemory(*Buffer)

.

Code: Select all

Debug PeekS(?pb, ?pbend - ?pb, #PB_Ascii)
DataSection
    pb:
    Data.b 80, 117, 114, 101, 66, 97, 115, 105, 99
    pbend:
EndDataSection

[Quin]

with c backend it's easy

Code: Select all

Structure aAscii 
  a.a[0] 
EndStructure 

Global *pa.aAscii  
!char ca[] = {80,117,114,101,66,97,115,105,99}; 
!gp_pa = &ca;

Debug PeekS(*pa,-1,#PB_Ascii) 

For a = 0 To 8 
  Debug *pa\a[a] 
Next   

Whoa... now you're making me want to learn much more about inline C. That's super slick!

[NicTheQuick]

A better idea in my opinion would be to extend the possibilities with escaped strings.
For example all these strings could represent the same value if Purebasic would allow it.

Code: Select all

; Basic escape character
Debug ~"\\"

; hexadecimal escape sequence
Debug ~"\x5c"

; octal escape sequence
Debug ~"\134"

And yes, it is not possible to simply use decimal numbers, but hexadecimal and octal are the standard here.

[AZJIO]

Autoit3 has a Binary() function.

Code: Select all

EnableExplicit

Procedure.i BinaryHex(*c.Character, Size)
	Protected *r.ASCII
	Protected tmp.s{3}
	Protected i, *m

	If *c = 0 Or *c\c = 0
		ProcedureReturn 0
	EndIf

	*m = AllocateMemory(Size + 1)
	If *m
		*r = *m
		While *c\c
			tmp = "$"
			tmp + Chr(*c\c)
			*c + 2
			If *c\c
				tmp + Chr(*c\c)
				*r\a = Val(tmp)
				*r + 1
				*c + 2
			Else
				ProcedureReturn 0
			EndIf
		Wend
		If *r > *m
			*r\a = 0
		EndIf
	EndIf

	ProcedureReturn *m
EndProcedure

Define *s, tmp$
tmp$ = "507572654261736963"
If Len(tmp$) & 1
; 	Debug "должна быть чётное число"
	Debug "must be an even number"
EndIf
; *s = BinaryHex(@tmp$, StringByteLength(tmp$) / 4)
*s = BinaryHex(@tmp$, Len(tmp$) / 2)
If *s
	ShowMemoryViewer(*s, MemorySize(*s) - 1)
	Debug PeekS(*s, -1, #PB_Ascii)
	FreeMemory(*s)
EndIf

.

Code: Select all

EnableExplicit

Procedure BinaryHex(String$)
	Protected *m, *r.ASCII, *c.Character
	Protected tmp.s{3}
	Protected Size

	If Not Asc(String$) ; пустая строка
		ProcedureReturn 0
	EndIf
	Size = Len(String$)
	If Size & 1 ; нечётное число
		ProcedureReturn 0
	EndIf
	*c = @String$

	*m = AllocateMemory(Size / 2 + 2)
	If *m
		*r = *m
		; 0-9 и A-F (только в верхнем регистре)
		While (*c\c > 47 And *c\c < 58) Or (*c\c > 64 And *c\c < 71) ; Or (*c\c > 96 And *c\c < 103) ; a-f нижний регистр не берём во внимание
			tmp = "$"
			tmp + Chr(*c\c)
			*c + 2
			If *c\c
				tmp + Chr(*c\c)
				*r\a = Val(tmp)
				*r + 1
				*c + 2
			Else ; повторная проверка чётности, нужна ли она
				FreeMemory(*m)
				ProcedureReturn 0
			EndIf
		Wend
		; проверка дошли ли мы до конца строки, если не 0,
		; то не дошли и в строке есть не шестнадцатеричные символы
		If *c\c <> 0
			ProcedureReturn 0
		EndIf
		If *r > *m
			*r\a = 0
			; Добавляем ещё 0, чтобы можно было использовать UTF8, UTF16
			*r + 1
			*r\a = 0
		EndIf
	EndIf

	ProcedureReturn *m
EndProcedure

Define *s, *u
*s = BinaryHex("507572654261736963") ; Ascii
; *s = BinaryHex("500075007200650042006100730069006300") ; UTF8
; в качестве ошибок можно было бы вывести отрицательные числа -1, -2, -3,
; чтобы сообщить пустая строка или неправильные символы или нечётность длины.
If *s
	ShowMemoryViewer(*s, MemorySize(*s) - 1)
	Debug PeekS(*s, -1, #PB_Ascii) ; Ascii
; 	Debug PeekS(*u) ; UTF8
	FreeMemory(*s)
EndIf

.

Code: Select all

EnableExplicit

Procedure Binary(String$)
	Protected *start, *c.Character, *r.Ascii, *m
	Protected.s s
	Protected Size, Toggle, Num
	
	If Not Asc(String$) ; пустая строка
		ProcedureReturn 0
	EndIf
	; только запятая инициирует чтение числа, поэтому её значение определяет размер выделенной памяти
	
	*c = @String$
	*start = *c
	Toggle = 1
; 	пропускаем мусор в начале
	While *c\c
		If *c\c >= '0' And *c\c <= '9'
			Toggle = 1
			*start = *c
			Num = 1
			Break
		EndIf
		*c + 2
	Wend
	If Not Num
		ProcedureReturn 0
	EndIf
	Size = CountString(PeekS(*start), ",") + 1
	*m = AllocateMemory(Size + 1)
	*r = *m
	While *c\c
		If *c\c >= '0' And *c\c <= '9'
			If Not Toggle ; чтобы запомнить указатель на первое число
				Toggle = 1
				Num = 1
				*start = *c
			EndIf
		ElseIf *c\c = ','
			If Num ; пропускает мусор в конце строки
				Toggle = 0
				Num = 0
				*c\c = 0 ; заменяем запятую нультерминированным нулём
				*r\a = Val(PeekS(*start)) ; считываем число как код символа
				*r + 1
			EndIf
		Else
			; пропуск любого символа, например пробела и сбрасываем, чтобы заново получить указатель
			Toggle = 0
		EndIf
		*c + 2
	Wend
	If Num
		*r\a = Val(PeekS(*start))
		*r + 1
	EndIf
	*r\a = 0
	ProcedureReturn *m
EndProcedure

Define *s
*s = Binary("80,117,114,101,66,97,115,105,99")
; *s = Binary(" , , , , ,")
; *s = Binary("80")
; *s = Binary(", , , ,80 , 117 , 114 , 101 , 66 , 97 , 115 , 105 , 99, , , ,") ; пробелы не будут мешать, но не между цифр
If *s
	ShowMemoryViewer(*s, MemorySize(*s) - 1)
	Debug PeekS(*s, - 1, #PB_Ascii)
	FreeMemory(*s)
EndIf