String Library#

(c) 1991 Carsten Strotmann

```
;********************************
;**                            **
;** Phoenix SoftCrew ACTION!   **
;** Programme und Tips f. 8Bit **
;**                            **
;********************************

; Programmname:Stringroutinen
; Programmierer:Carsten Strotmann
; Filename:STRING.ACT
; erste Version:
; letzte Aenderung:
; Zweck:
; Bemerkung:
; benoetigt DIVERS.ACT
;

; INCLUDE "DIVERS.ACT"

BYTE FUNC Find (BYTE ARRAY str2,str1)

BYTE len1,len2,z1,z2,flg,pos

IF str1(0)>=str2(0) THEN
len2=str2(0)
len1=str1(0)
len1==-len2+1
z1=0
z2=0
DO
flg=\$FF
z1==+1
FOR z2=1 to len2
DO
IF str1(z1+z2-1)#str2(z2) THEN
flg=0
FI
OD
UNTIL z1=len1 OR flg#0
OD
IF flg#0 THEN
pos=z1
ELSE
pos=0
FI
ELSE
pos=0
FI

RETURN (pos)

;----------------------------------

PROC Hex (CARD value,BYTE ARRAY hex)

BYTE u,v1,v2

BYTE ARRAY hexx (\$10)=~['0 '1 '2 '3 '4 '5 '6 '7 '8 '9 'A 'B 'C 'D 'E 'F]

v1=value RSH 8
v2=value

u=v1 RSH 4
hex(1)=hexx(u)
u=v1 MOD \$10
hex(2)=hexx(u)
u=v2 RSH 4
hex(3)=hexx(u)
u=v2 MOD \$10
hex(4)=hexx(u)

hex(0)=4

IF v1=0 THEN
hex(1)=hex(3)
hex(2)=hex(4)
hex(0)=2
FI

RETURN

;-----------------------------------

CARD FUNC Dec (BYTE ARRAY hexc)

BYTE v1,v2,pos
BYTE ARRAY such(2),hexd(\$11)
CARD result

pos=1
v1=0
v2=0
Scopy (hexd,"0123456789ABCDEF")

IF hexc(0)=4 THEN
such(0)=1
such(1)=hexc(pos)
v1=Find (such,hexd)-1
v1==*\$10
pos==+1
such(1)=hexc(pos)
v1==+Find (such,hexd)-1
pos==+1
FI

IF hexc(0)=4 OR hexc(0)=2 THEN
such(0)=1
such(1)=hexc(pos)
v2=Find (such,hexd)-1
v2==*\$10
pos==+1
such(1)=hexc(pos)
v2==+Find (such,hexd)-1
FI

result=v1
RESULT==*\$100
result==+v2

RETURN (result)

;----------------------------------

PROC Upper (BYTE ARRAY text)

BYTE u

FOR u=1 TO text(0)
DO
IF text(u)>\$60 AND text(u)<\$7B THEN
text(u)==-\$20
FI
OD

RETURN

;-----------------------------------

PROC Lower (BYTE ARRAY text)

BYTE u

FOR u=1 TO text(0)
DO
IF text(u)>\$40 AND text(u)<\$5B THEN
text(u)==+\$20
FI
OD

RETURN

PROC Getin (BYTE ARRAY text,BYTE len)

BYTE ascii,pos,u,inv

pos=text(0)+1
inv=0

IF text(0)#0 THEN
Print (text)
FI

DO
ascii=Inkey ()

IF ascii=129 THEN
inv==!\$80
FI
IF ascii=\$1E AND pos>1 THEN
pos==-1
PutD (0,\$1E)
FI
IF ascii=\$7E AND pos>1 THEN
pos==-1
PutD (0,\$7E)
FI
IF ascii=\$1F AND pos#len+1 THEN
pos==+1
PutD (0,\$1F)
FI
IF ascii>26 AND ascii<32 THEN
ascii=128
FI
IF pos#len+1 AND ascii<\$7E THEN
ascii==+inv
PutD (0,ascii)
text(pos)=ascii
pos==+1
FI
text(0)=pos-1
Klick (2)
UNTIL ascii=\$9B
OD

RETURN

PROC ClearChar (BYTE ARRAY text)

text(0)=0

RETURN

PROC FillString (BYTE ARRAY string,BYTE ch,BYTE len)

BYTE u

FOR u=1 TO len
DO
string(u)=ch
OD

string(0)=len

RETURN

PROC Sort (BYTE ARRAY field)

BYTE len,flg,u

len=field(0)
DO
flg=0
FOR u=1 TO len-1
DO
IF field(u)>field(u+1) THEN
flg=field(u+1)
field(u+1)=field(u)
field(u)=flg
flg=1
FI
OD
UNTIL flg=0
OD

RETURN

PROC Inters (BYTE ARRAY string)

BYTE u

FOR u=1 TO string(0)
DO
string(u)=Inter(string(u))
OD

RETURN

PROC RSet (BYTE ARRAY dest,source)

BYTE l1,l2,u

l1=dest(0)
l2=source(0)

IF l1>=l2 THEN
FOR u=1 TO l1-l2
DO
dest(u)=32
OD
FOR u=1 TO l2
DO
dest (l1-l2+u)=source(u)
OD

FI

RETURN
```