// UtilStr.bcpl -- miscellaneous utility and string procedures
// 19 October 1976 by B.L. Parsley
// 8 March 1977 by B.L. Parsley
// commented out (//FLOAT) all references to FloatStr package
get "UtilStr.D"
// outgoing procedures
external
[
// string procedutes
CopyString // (sourceStr, destStr) -> destStr
AppendChar // (char, destStr) -> destStr
AppendString // (sourceStr, destStr) -> destStr
AppendNum // (number, destStr, [radix/10]) -> destStr
MakeString // (destStr, radix,value, [radix,value, ...]) -> destStr
ImbedChar // (char, destStr, [index/destStr>>SL+1]) -> destStr
ExtractString // (sStr, dStr, bIndex, [eIndex/sStr>>SL+1]) -> destStr
SearchChar // (str, char, [index/0]) -> index/0
SearchString // (str1, str2, [index/0, [sw/false]]) -> index/0
StringEqual // (str1, str2, [sw/false]) -> true/false
StringToValue // (sourceStr, [radix/10, [pointer]]) -> value
StrToValErr // (str, char, radix)
ValueToString // (value, destStr, [radix/10]) -> destStr
]
// incoming procedures
external
[
MoveBlock
Allocate
Wss
CallSwat
]
// Procedures
let CopyString (sourceStr, destStr) = valof
[
MoveBlock (destStr, sourceStr, (sourceStr>>SL rshift 1) + 1)
resultis destStr
]
and AppendChar (char, destStr) = valof
[
let strL = destStr>>SL + 1
destStr>>CH↑strL = char
destStr>>SL = strL
resultis destStr
]
and AppendString (sourceStr, destStr) = valof
[
let strLS, strLD = sourceStr>>SL, destStr>>SL
for i = 1 to strLS do destStr>>CH↑(strLD + i) = sourceStr>>CH↑i
destStr>>SL = strLD + strLS
resultis destStr
]
and AppendNum (number, destStr, radix; numargs na) = valof
[
let str = vec lSTRING
resultis AppendString (ValueToString (number, str, (na eq 3 ? radix, 10)), destStr)
]
and MakeString (destStr, radix0,val0,
nil,nil, nil,nil, nil,nil, nil,nil, nil,nil, nil,nil, nil,nil, nil,nil, nil,nil; numargs na) be
[
let arg = lv radix0
let str = vec lSTRING
destStr!0 = 0
for i = 0 to na - 2 by 2 do AppendString (ValueToString (arg!(i+1), str, arg!i), destStr)
]
and ImbedChar (char, destStr, index; numargs na) = valof
[
let strL = destStr>>SL
if na ls 3 do index = strL + 1
for i = strL to index by -1 do destStr>>CH↑(i + 1) = destStr>>CH↑i
destStr>>CH↑index = char
destStr>>SL = strL + 1
resultis destStr
]
and ExtractString (sourceStr, destStr, bIndex, eIndex; numargs na) = valof
[
let length = sourceStr>>SL - bIndex
if na eq 4 do [ let x = eIndex - bIndex - 1; if x ls length do length = x ]
for i = 1 to length do destStr>>CH↑i = sourceStr>>CH↑(bIndex + i)
destStr>>SL = length gr 0 ? length, 0
resultis destStr
]
and SearchChar (str, char, index; numargs na) = valof
[
for idx = (na eq 3 ? index + 1, 1) to str>>SL do
if str>>CH↑idx eq char do resultis idx
resultis 0
]
and SearchString (str1, str2, index, sw; numargs na) = valof
[
if na ls 4 do sw = false
let str1L, str2L = str1>>SL, str2>>SL
for idx = (na ge 3 ? index, 0) to str1L - str2L do
[
let strEq = true
for j = 1 to str2L do
[
let c1, c2 = str1>>CH↑(idx + j), str2>>CH↑j
unless sw do
[
if $a le c1 & c1 le $z do c1 = c1 - #40
if $a le c2 & c2 le $z do c2 = c2 - #40
]
if c1 ne c2 do [ strEq = false; break ]
]
if strEq do resultis idx + str2L
]
resultis 0
]
and StringEqual (str1, str2, sw; numargs na) = valof
[
let sl = str1>>SL
if sl ne str2>>SL do resultis false
if na ls 3 do sw = false
for i = 1 to sl do
[ let c1, c2 = str1>>CH↑i, str2>>CH↑i
unless sw do
[
if $a le c1 & c1 le $z do c1 = c1 - #40
if $a le c2 & c2 le $z do c2 = c2 - #40
]
if c1 ne c2 do resultis false
]
resultis true
]
and StringToValue (sourceStr, radix, pointer; numargs na) = valof
[
if na ls 2 do radix = 10
let strL = sourceStr>>SL
let str1c = (strL eq 0 ? (na eq 3 ? pointer, 0), sourceStr>>CH↑1)
switchon radix into
[
case radixFileName:
for i = 1 to strL do
[
let c = sourceStr>>CH↑i
unless ($a le c & c le $z) % ($A le c & c le $Z) % ($0 le c & c le $9) %
c eq $. % c eq $! % c eq $$ % c eq $+ % c eq $- do
StrToValErr (sourceStr, c, radix)
]
// no endcase
case radixString:
[ MoveBlock (pointer, sourceStr, (sourceStr>>SL rshift 1) + 1); resultis pointer ]
case radixSwitch: resultis str1c eq $Y % str1c eq $y % str1c eq $T % str1c eq $t
case radixCharStr: resultis str1c
case radixCharCode:
[
if str1c eq $** do [ sourceStr>>CH↑1 = $0; resultis StringToValue (sourceStr, 8) ]
resultis str1c
]
//FLOAT case radixFloatS:
//FLOAT case radixFloat:
//FLOAT [
//FLOAT if StrToFPNum eq 0 do CallSwat ("StrToFPNum not loaded")
//FLOAT resultis StrToFPNum (sourceStr, pointer)
//FLOAT ]
default:
[
let n = strL eq 0 ? str1c, 0
if str1c eq $- do sourceStr>>CH↑1 = $0
for i = 1 to strL do
[
let x = sourceStr>>CH↑i - $0
unless (0 le x & x le radix - 1) do StrToValErr (sourceStr, x + $0, radix)
n = n*radix + x
]
resultis str1c eq $- ? -n, n
]
]
]
and StrToValErr (str, char, radix) be CallSwat ("StringToValue error in: ", str)
and ValueToString (value, destStr, radix; numargs na) = valof
[
if na ls 3 do radix = 10
destStr!0 = 0
switchon radix into
[
case radixFloatS:
case radixFileName:
case radixString: resultis CopyString (value, destStr)
case radixSwitch: resultis AppendChar ((value ? $Y, $N), destStr)
case radixCharStr: resultis AppendChar (value, destStr)
case radixCharCode:
[
if value le cntrlZ do [ AppendChar ($↑, destStr); value = value + #100 ]
resultis AppendChar (value, destStr)
]
//FLOAT case radixFloat:
//FLOAT [
//FLOAT if FPNumToStr eq 0 do CallSwat ("FPNumToStr not loaded")
//FLOAT resultis FPNumToStr (value, destStr)
//FLOAT ]
case 2:
[
for col = 1 to 16 do AppendChar ($0 + (value rshift (16 - col))<<ODD, destStr)
endcase
]
case 8:
[
let zero = true
for i = 0 to 16/3 do
[
let v = (value rshift 3*(16/3 - i)) & #7
if v eq 0 & zero loop
AppendChar ($0 + v, destStr)
zero = false
]
if zero do destStr!0 = 1b8 + $0
endcase
]
case 16:
[
for col = 1 to 4 do
[ let v = (value rshift 4*(4 - col)) & #17
AppendChar ((v le 9 ? ($0 + v), ($A + (v - 10))), destStr)
]
endcase
]
default:
[
let min = value ls 0
if min do value = -value
[ ImbedChar ((value rem radix) + $0, destStr, 1)
value = value/radix
] repeatuntil value eq 0
if min do ImbedChar ($-, destStr, 1)
]
]
resultis destStr
]