XProfan

WindowTitle "Profan-11: PS_Explode$, PS_Implode$ & PS_Revert$, PS_ArrayPrint$"
cls
declare s$,a1$[],t$,sz&
s$="The quick brown fox jumps over the lazy dog!"
a1$[]=PS_Explode$(s$," "):sz&=sizeof(a1$[])
print " 0: ";a1$[0]
print str$(int(sz&-1));": ";a1$[sz&-1]
print " ---"
s$=PS_Implode$(a1$[],"´")
print s$
print PS_Revert$(s$,"'")
print
PS_Arrayprint$(PS_Revert$(a1$[]),".......","|",6,"\n")
waitinput
end

Proc PS_Explode$ :parameters s$,t$:declare arr$[]:if t$>""

    arr$[]=explode(s$,t$):else :setsize arr$[],len(s$)
    arr$[]=mid$(s$,1+&index,1):endif:return arr$[]

Endproc

Proc PS_Implode$ :parameters arr$[],t$:declare s$,sz&

    sz&=sizeof(arr$[]):whileloop 0,sz&-1:s$=if(s$="",s$,s$+t$)+\
    arr$[&Loop]:endwhile:return s$

EndProc

Proc PS_Revert$

    if left$(ptype$(1),2)="$[":parameters arr$[]

        declare ass$[],sz&:sz&=sizeof(arr$[]):casenot sz&:return arr$[]
        setsize ass$[],sz&:dec sz&:ass$[]=arr$[sz&-&index]:return ass$[]

    elseif ptype$(1)="$":parameters s$,t$:declare r$,sz&:sz&=len(s$)

        :Whileloop sz&:r$=mid$(s$,&Loop,1)+t$+r$:endwhile:return r$

    endif

endproc

proc PS_Arrayprint$

    if left$(ptype$(1),2)="$[":parameters a__$[],ra$,sp$,nbr&,t$

        declare sz&,ct&:sz&=sizeof(a__$[])
        print ra$;

        whileloop 0,sz&-1:inc ct&:print a__$[&Loop];sp$;

            if ct&=nbr&:print t$;ra$;:ct&=0:endif

            endwhile

            else:print " *type?* ";

        endif

    endproc

WindowTitle "H.Brill-Implode for XProfan-11.2a free"
'Programm von Heinz Brill, von p.specht nach XProfan 11 portiert
CLS:font 2
Declare A$[],B&[],C![],D%[],tmp$[]
A$[] = explode("Hallo,du,da !",",")
tmp$[]=explode("1, 2, 3, 4, 5",",")
setsize B&[],sizeof(tmp$[]):B&[]=val(tmp$[&index])
clear tmp$[]:tmp$[]=explode("1.5, 2.6, 10.7, 15.0, 20.30",",")
setsize C![],sizeof(tmp$[]):c![]=val(tmp$[&index])
clear tmp$[]:tmp$[]=explode("987,654,321",",")
setsize D%[],sizeof(tmp$[]):D%[]=val(tmp$[&index])
clear tmp$[]
print sizeof(A$[]), sizeof(B&[]), sizeof(C![]), sizeof(D%[])
Print "\n Anfang>";Implode(A$[],"|");"<Ende"
Print "\n Anfang>";Implode(B&[],",");"<Ende"
Print "\n Anfang>";Implode(C![]," *** ");"<Ende"
Print "\n Anfang>";IntImplode(D%[],",");"<Ende"
Waitinput
End

Declare A$[], B&[], C![], D$[]
CLS
A$[0] = "Hallo"
A$[1] = "du"
A$[2] =  "da !"
B&[0] = 1
B&[1] = 2
B&[2] = 3
B&[3] = 4
B&[4] = 5
C![0] = 1.5
C![1] = 2.6
C![2] = 10.7
C![3] = 15.0
C![4] = 20.30
Print Implode(A$[], "-")
Print Implode(B&[], ",")
Print Implode(D$[], "")
Print Implode(C![], ",")
WaitKey

PROC Implode

    CLEARLIST

    Select pType$(1)

        CaseOf  "$[]"

        Parameters B$[], D$
        RETURN IF(MoveArrToList(B$[]), MoveListToStr$(D$), "")

        CaseOf "&[]"

        Parameters B&[], D$
        RETURN If(MoveArrToList(B&[]), MoveListToStr$(D$), "")

        CaseOf "%[]"

        Parameters B%[], D$
        If(MoveArrToList(B%[]), MoveListToStr$(D$), "")

        CaseOf "![]"

        Parameters B![], D$
        Set("Decimals", 2)
        RETURN If(MoveArrToList(B![]), MoveListToStr$(D$), "")

    EndSelect

ENDPROC

End