// 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))<