forked from totalspectrum/spin2cpp
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathstrings.bas
More file actions
1273 lines (1061 loc) · 46.5 KB
/
Copy pathstrings.bas
File metadata and controls
1273 lines (1061 loc) · 46.5 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
'=================================================================================================================================
' NOTICE: M.I.T Copyright applies. See end of file for details
'=================================================================================================================================
'
' LIST OF FUNCTIONS:
'
'*__strs_cl (private class)
' __ScanForChar(s$, t%, idx%, d) (private function. searches for T% in S$ starting at offset IDX. D=direction (0=fwd, !0=rev)
'*Bin$(n%) Returns a binary string representation of N%
'*Chr$(n%) Returns a string character with ASCII code N%
' CountStr(x$, s$) Counts the number of occurances of string S in string X
'*Decuns$(n%) Returns a decimal string representation of N%
' Delete$(t$,o%,c%) Deletes characters in T$ starting at offset O% and continuing for C% characters
'*Hex$(n%) Returns a hexadecimal string representation of N%
' Insert$(b$,i$,o%) Inserts I$ into B$ at offset O%
' Instr(o%,s$,t$) Returns the first occurance of T$ in S$ beginning at offset O%. Search direction is left-to-right
' InstrRev(o%,s$,t$ Reverse-acting version of INSTR$(). Search direction is right-to-left
'*Left$(x$,c%) Returns the leftmost C% chars of X$
' LCase$(x$) Changes all upper case characters in X$ to lower case
' LPad$(x$,w%,ch$) Returns a string of W length consisting of X$ padded on the left side with the character CH$
' LTrim$(x$) Removes leading spaces from X$
'*Mid$(x$,o%,c%) Returns a substring of X$ starting at offset O% consisting of C% characters
'*Number (private function)
'*Oct$(n%) Returns an octal string representation of N%
'*Pfunc (private function)
' RemoveChar$(x$, s$) Removes all occurances of character S in string X
' ReplaceChar$(x$,s$,r$) Replaces all occurances of character S in string X with character R
' Reverse$(x$) Reverses the position of the characters in X$ (swaps first for last, etc)
'*Right$(x$,c%) Returns the rightmost C% characters from X$
' RPad$(x$,w%,ch$) Returns a string of W length consisting of X$ padded on the right side with the character CH$
' RTrim$(x$) Removes trailing spaces from X$
' Space$(count%) Returns a string of CNT length consisting of space characters
'*Str$(n%) Returns a string representation of N% (ie converts N% to a string)
' String$(cnt, x$) Returns a string of CNT length consisting of the character X$
' STRInt$(num%) Integer-only version of STR$() that avoids floating-point math. About 8x faster than STR$()
' Trim$(x$) Removes spaces from the left and right side of string X
' UCase$(x$) Changes all lower case characters in X$ to upper case
'
' NOTE: "*" denotes original ERSmith code copied in unmodified form from the V5.0.7 FlexProp distribution dated 14-Jan-2021.
' All other code by JRoark, except as noted:
' Changes for FlexProp 5.0.8 release:
' Count renamed CountStr and made to handle arbitrary string matches
' Remove$ renamed RemoveChar$ and slightly optimized
' Replace$ renamed ReplaceChar$ and slightly optimized
'
' Changes for FlexProp 5.0.9 release:
' Improved COUNT() speed by ~1.5x for multi-char targets and ~10% for single char targets
' Improved INSTR() speed by 10-50x.
' Improved INSTRREV() speed by 10-50x.
' Improved UCASE$() speed (esp on longer strings, ie > 64 chars) by ~15% - 30% (optimizer level dependent)
' Improved LCASE$() speed (esp on longer strings, ie > 64 chars) by ~15% - 30% (optimizer level dependent)
'
'
'
'=================================================================================================================================
'
FUNCTION CountStr(x as string, s as string) as integer
'
' Purpose: Counts all occurances of the string S in X
' Errors: None known
' Author: JRoark 16Jan2020 / ersmith 19Jan2021 / JRoark 28Jan2021
' Version: 2.2 of 28Jan2021
' Requires: Nothing
' RefDoc: N/A
' RelSpeed: Fast
dim p as ubyte pointer ' setup p as a pointer to ubytes
dim i, j, m, z as integer ' i,j=loop cntr, m=len of input string, z=result
dim slen as integer ' length of source string
dim ch as integer ' temp variable
dim s0 as integer
m = __builtin_strlen(x) ' get the length of the input string
if (m < 1) then ' trap for zero length input string
return 0 ' return a count of zero
end if
slen = __builtin_strlen(s)
if (slen = 0) then ' trap for zero-length S argument
return m ' return appropriate number of matches
end if
if (slen > m) then ' trap for target string longer than input string
return 0 ' no possible matches so return zero
end if
slen -= 1 ' adjust for starting index of 0
m -= 1 ' ditto
m -= slen ' only need to check first (m-slen) positions
if (m < 0) then
return 0
end if
s0 = s(0) ' get ascii val of first char (for speed later)
z = 0 ' set initial match count to zero
i = -1
' special case fast match for a single character target
if slen = 0 then ' searching a single character
do
i+=1
if x(i) = s0 then ' did we match?
z += 1 ' yep. add 1 to match count
end if
loop until i = m
return z ' done. return the match count
end if
' for longer target strings
do
i += 1 ' add 1 to search offset
ch = 0 ' assume no match
if (x(i) = s0) then ' check first character for match
ch = 1 ' possible match. dig deeper
for j = 1 to slen ' iterate thru the remaining search string
if (x(i+j) <> s(j)) then ' look char-by-char for a match in X with S
ch = 0 ' nope. no match
exit for ' break out of the loop
end if
next j
end if
z += ch ' add 0(nomatch) or 1(match) to running match count
loop until i = m
return z ' return count of how many S's were found in X
END FUNCTION
'
'=================================================================================================================================
'
FUNCTION Delete$(target$ as string, offset as integer, count as integer) as string
'
' Purpose: Deletes everything in TARGET$ beginning at OFFSET and continuing for COUNT characters, and returns the resulting string.
' If OFFSET is beyond the end of TARGET$ nothing happens and TARGET$ is returned intact
' If OFFSET is zero or negative, it is constrained to 1 and execution continues without error
' If COUNT goes beyond the length of TARGET$ everything from OFFSET to the end of TARGET$ is deleted without error
' If COUNT is zero or negative, nothing is done and TARGET$ is returned intact without error
' Errors: None known
' Author: JRoark 16Jan2020
' Version: 2.0 of 16Jan2021
' Requires: LEFT$()
' RefDoc: N/A
' RelSpeed: Fast
dim p as ubyte pointer ' setup p as a pointer to ubytes
dim i,m,z as integer ' i=loop cntr, m=len of passed string, z=pointer offset
m = __builtin_strlen(target$) ' get length of passed string
if (m < 1) then ' trap for zero-length string
return "" ' return a null string
end if
if (offset > m) then ' trap for offset beyond length of TARGET$
return target$ ' return the original string unmodified
end if
if (offset < 1) then ' trap for offset zero or negative
offset = 1 ' force offset to 1 and continue
end if
if (count < 1) then ' trap for negative or too small of a length
return target$ ' return the original string
end if
if ((offset + count) > m) then ' trap for where offset+count is larger than the length of TARGET$
return left$(target$, offset - 1) ' return everything to the left of OFFSET
end if
p = new ubyte(m-count) ' attempt to set pointer P to a new array of ubytes
if p then ' if P is non-zero then memory alloc was successful
for i = 0 to offset-2 ' step thru the first part of the string
p(i) = target$(i) ' move char by char from TARGET$ to new string
next i
z = i ' save current value of I (we will need it below)
for i = (offset+count-1) to m-1 ' step thru second part of string
p(z) = target$(i) ' move char by char from TARGET$ to new string
z += 1 ' incr our pointer offset
next i
p(z) = 0 ' append end-of-string char
return p ' return the new string
end if
return p ' if here, memory alloc was unsuccessful. return null string
END FUNCTION
'
'=================================================================================================================================
'
FUNCTION Insert$(base$ as string, toInsert$ as string, offset as integer) as string
'
' Purpose: Inserts TOINSERT$ into BASE$ at the specified OFFSET and returns the resulting string.
' If OFFSET is beyond the end of BASE$, then TOINSERT$ is appended to the end of BASE$
' If OFFSET is zero or negative, TOINSERT$ is pre-pended to the beginning of BASE$
' Errors: None known
' Author: JRoark 16Jan2021
' Version: 2.0 of 16Jan2021
' Requires: Nothing
' Notes: None
' RefDoc: N/A
' Speed: Fast
dim p as ubyte pointer ' setup p as a pointer to ubytes
dim b,i,j,k,n,t as integer
b = __builtin_strlen(base$) ' get length of BASE$
t = __builtin_strlen(toInsert$) ' get length of TOINSERT$
if (offset < 2) then ' trap for 1, zero or negative offset argument
return toInsert$ + base$ ' append base$ to toInsert$ and return it
end if
if (offset > b) then ' trap for a offset argument greater than length of Base$
return base$ + toInsert$ ' append toInsert$ to the end
end if
if (b < 1) orelse (t < 1) then ' trap for empty BASE$ or TOINSERT$
return base$
end if
p = new ubyte(b+t+1) ' attempt to set pointer P to a new array of ubytes
if p then ' if P is non-zero then memory alloc was successful
for i = 0 to offset-2 ' step thru the first part of the string
p(i) = base$(i) ' copy byte by byte from BASE$ to new string
next i
n = 0
for j = i to i + t-1 ' step thru our string to be inserted
p(j) = toInsert$(n) ' copy byte by byte from TOINSERT$ to new string
n += 1
next j
for k = j to (b+t) ' step thru remaining part of base string
p(k) = base$(i) ' copy byte by byte from remaining BASE$ to new string
i += 1 ' incr offset
next k
p(k) = 0 ' mark end-of-string
return p ' return the new string
end if
return p ' if here then the memory alloc failed, so return an empty string
END FUNCTION
'
'=================================================================================================================================
'
FUNCTION Instr(Offset% as integer, Source$ as string, Target$ as string) as integer
'
' Purpose: Returns the position of the first occurance of Target$ in Source$. The search begins at the Offset% character.
' If the Target$ isn't found in Source$, the function returns zero.
' Errors: None known
' Author: JRoark 28Jan2021
' Requires: MID$(), SCANFOR()
' Notes: None
' RefDoc: N/A
' Speed: Fast (~15x faster)
' This is a recode of INSTR() designed for better speed. It employs a "pre-scan" of the SOURCE$ in order to
' determine the offset of the first character of TARGET$. If the first char of TARGET$ isn't found, then logically
' there is no need to go any further and the operation aborts. If the first char of TARGET$ *is* found in
' SOURCE$, then that offset is passed to MID$() to determine if the *rest* of the TARGET$ can be matched.
' This strategy is always faster than the earlier version unless the TARGET$ is located at offset 1, in which
' case it is slightly slower. For all other cases (offset >= 2) it is progressively faster. It becomes MUCH
' faster (10x to 50x) as the lengths of SOURCE$ and TARGET$ increase. There is also accelerated handling for
' when TARGET$ is a single character. This results in very fast results even on long strings.
dim targetSize% as integer
dim sourceSize% as integer
dim idx%, ret%, t% as integer
dim tmp$ as string
targetSize% = __builtin_strlen(Target$) ' get length of TARGET$
sourceSize% = __builtin_strlen(Source$) ' get length of SOURCE$
if (sourceSize% = 0) then ' trap for zero-length SOURCE$ string.
return 0 ' return a zero (no-match) if true
end if
if (targetSize% = 0) then ' trap for zero-length TARGET$ string.
return 0 ' return a zero (no-match) if true
end if
if (Offset% > sourceSize%) then ' trap for an OFFSET% that exceeds the length of the Source.
return 0 ' return a zero (no-match) if true
end if
if (Offset% < 1) then ' trap & correction for a missing or negative Offset%
Offset% = 1 ' rix it quietly and continue without error
end if
t% = (target$(0))
if (targetSize% = 1) then ' trap and shortcut for single-character target
return __ScanForChar(source$, t%, offset%, 0) ' calc offset using SCANFOR and return it (fast!)
end if
idx% = offset%
do
ret% = __ScanForChar(source$, t%, idx%, 0) ' find offset of the FIRST char of TARGET$
if ret% then ' if the offset != 0 then
tmp$ = Mid$(Source$, ret%, targetSize%) ' use the offset to return a candidate string of TARGETSIZE length
if tmp$ = target$ then ' is the returned string = TARGET$?
return ret% ' return the offset
else
idx% = ret% + targetSize% ' only the first char matched. Set scan pointer to next possible offset
end if
else
return 0 ' no match was found. return zero
end if
loop
END FUNCTION
'
'=================================================================================================================================
'
FUNCTION InstrRev(Offset% as integer, Source$ as string, Target$ as string) as integer
'
' Purpose: Returns the position of the first occurance of Target$ in Source$. The search begins at the Offset% character.
' If the Target$ isn't found in Source$, the function returns zero.
' Errors: None known
' Author: JRoark 19Jan2021
' Requires: MID$(), SCANFOR()
' Notes: None
' RefDoc: N/A
' Speed: Fast
' This is a recode of INSTRREV() designed for better speed. It employs a "pre-scan" of the SOURCE$ in order to
' determine the offset of the first character of TARGET$. If the first char of TARGET$ isn't found, then logically
' there is no need to go any further and the operation aborts. If the first char of TARGET$ *is* found in
' SOURCE$, then that offset is passed to MID$() to determine if the *rest* of the TARGET$ can be matched.
' This strategy is always faster than the earlier version unless the TARGET$ is located at offset 1, in which
' case it is slightly slower. For all other cases (offset >= 2) it is progressively faster. It becomes MUCH
' faster (10x to 50x) as the lengths of SOURCE$ and TARGET$ increase. There is also accelerated handling for
' when TARGET$ is a single character. This results in very fast results even on long strings.
dim targetSize% as integer
dim sourceSize% as integer
dim idx%, ret%, t% as integer
dim tmp$ as string
targetSize% = __builtin_strlen(Target$) ' get length of TARGET$
sourceSize% = __builtin_strlen(Source$) ' get length of SOURCE$
if (sourceSize% = 0) then ' trap for zero-length SOURCE$ string.
return 0 ' return a zero (no-match) if true
end if
if (targetSize% = 0) then ' trap for zero-length TARGET$ string.
return 0 ' return a zero (no-match) if true
end if
if (Offset% > sourceSize%) then ' trap for an OFFSET% that exceeds the length of the Source.
Offset% = sourceSize% ' fix it quietly and continue without error
end if
if (Offset% < 1) then ' trap & correction for a missing, zero, or negative Offset%
Offset% = 1 ' fix it quietly and continue without error
end if
t% = target$(0) ' extract first character from possibly multi-char TARGET$
if (targetSize% = 1) then ' trap and shortcut for single-character target
return __ScanForChar(source$, t%, Offset%, 1) ' calc offset using SCANFOR and return it (fast!)
end if
idx% = targetSize%-1 ' set position offset in SOURCE$ to start the matching process
do
ret% = __ScanForChar(source$, t%, idx%, 1) ' find offset of the FIRST char of TARGET$
if ret% then ' if the offset != 0 then
tmp$ = Mid$(Source$, ret%, targetSize%) ' use the offset to return a candidate string of TARGETSIZE length
if tmp$ = target$ then ' is the returned string = TARGET$?
return ret% ' return the offset
else
idx% = ret% - targetSize% ' only the first char matched. Set scan pointer to next possible offset
end if
else
return 0 ' no match was ever found. return zero
end if
loop
END FUNCTION
'
'=================================================================================================================================
'
FUNCTION __ScanForChar(x as string, s as ubyte, o = 1 as uinteger, d = 0 as integer) as integer
'
' Synopsis: Scans for and returns the position of S in X. S must be a single character.
' Optional argument O specifies an offset to start scanning from.
' - Default (if d=0/"forward") is leftmost char in X
' - Default (if d!=0/"reverse") is rightmost char in X
' Optional argument D specifies the scanning direction:
' 0=left to right ("normal"),
' !0=right to left ("backwards")
' - Default is forwards
' Issues: None known
' Author: JRoark 19Jan2021
' Requires: Nothing
' Notes: None
' RefDoc: N/A
' Speed: Weapons grade.
dim i, m as uinteger ' i=loop cntr, m=len of input string, y=pre-calc'd offset value, z=pointer offset
m = __builtin_strlen(x) ' get length of input string
' None of this input conditioning should really be needed since
' the calling functions should already have vetted all input params
' but we'll leave it in for now
if (m = 0) then ' trap for zero-length input string
return 0 ' return zero
end if
if (s = 0) then ' trap for zero target string
return 0 ' return zero
end if
if (o < 1) then ' trap/fix for zero/negative offset
if (d = 0) then ' fwd direction
o = 1 ' fix it. set o to first char and continue without error
else
' rev direction
return 0 ' return zero
end if
end if
if (o > m) then ' trap for offset past end of input string
if (d = 0) then ' fwd direction
return 0 ' return zero
else
' rev direction
o = m ' fix it quietly and continue without error
end if
end if
' Do the scan:
o = o - 1 ' adjust for zero-based index
if (d=0) then
' do a FORWARD scan
for i = o to (m-1) ' step through the input string FORWARD char-by-char
if (x(i)=s) then ' found a match?
return i+1 ' Yes: return the "human-based" (ordinal) position of the match
end if
next i ' next character
else
' do a REVERSE scan
for i = o to 0 step -1 ' step through the input string BACKWARDS char-by-char
if (x(i)=s) then ' found a match?
return i+1 ' Yes: return the "human-based" (ordinal) position of the match
end if
next i ' next character
end if
return 0 ' if here then the target character was not found. Return 0
END FUNCTION
'
'=================================================================================================================================
'
FUNCTION LCase$(x as string) as string
'
' Synopsis: Turns any upper case characters in X to lower case.
' Any non upper case characters are passed thru unaffected.
' Issues: None known
' Author: JRoark 28Jan2021
' Requires: Nothing
' Notes: None
' RefDoc: N/A
' Speed: Fast
dim p as ubyte pointer ' setup p as a pointer to ubytes
dim i, m, ch as integer ' i=loop cntr, m=len of input string
m = __builtin_strlen(x) ' get the length of the input string
if (m=0) then ' trap for zero length input string
return "" ' return null string
end if
p = new ubyte(m+1) ' attempt to set pointer P to a new array of ubytes
if p then ' check if memory alloc was successful
i = -1 ' preset offset to -1
do ' iterate through the input string
i += 1 ' add one to offset
ch = x(i) ' extract a single character
if (ch > 64) andalso (ch < 91) then ' check if its an upper case char
p(i) = ch + 32 ' Yes. its upper case. change it to lower case
else
p(i) = ch ' No. its either already lower case or it isn't a letter. so just copy it
end if
loop until i = m-1 ' keep going until we reach the end of the string
p(m) = 0 ' set end-of-string terminator char
return p ' return the new string
end if
return p ' if here then memory alloc failed. return nil pointer
END FUNCTION
'
'=================================================================================================================================
'
FUNCTION LPad$(x as string, width as ulong, pchar as string) as string
'
' Synopsis: Right-aligns X into a string of size WIDTH using PCHAR as the padding char on the LEFT.
' If the length of ST is greater than WIDTH, the function returns only the rightmost WIDTH characters without
' any padding, ie, LPad$("Testing", 4, "-") would return "ting"'
' Errors: None known
' Author: JRoark 16Jan2020
' Version: 2.0 of 16Jan2021
' Requires: STRING$(), LEFT$()
' RefDoc: N/A
' RelSpeed: Fast
dim p as ubyte pointer ' setup P as a pointer to ubytes
dim i, m, z as uinteger ' i=loop cntr, m=len of input string, z=offset counter
m = __builtin_strlen(x) ' get the length of the input string
if (m=0) then ' trap for zero-length input string
return String$(width,pchar) ' return a string of the proper width completely populated by PCHARs
end if
if (m > width) then ' trap and fix if input string longer than specified WIDTH
return Left$(x,width) ' return the leftmost (unpadded) WIDTH chars of X
end if
if (m=width) then ' speed-up for when input string is same size as WIDTH
return x ' return X unchanged
end if
p = new ubyte(width+1) ' attempt to set pointer P to a new array of ubytes
if p then ' check to see that our memory alloc worked (P<>0 means it worked)
z = 0 ' init Z
for i = 0 to width-1 ' step thru the input string char by char
if i < (width - m) then '
p(i) = pchar(0) ' copy padchars into output string char by char
else
p(i) = x(z) ' copy chars from input string into output string char by char
z = z + 1 ' incr offset
end if
next i
p(width) = 0 ' append string terminator char
return p ' c'ya..
end if
return p ' if here then memory alloc failed. return nil pointer
END FUNCTION
'
'=================================================================================================================================
'
FUNCTION LTrim$(x as string) as string
'
' Purpose: Removes leading spaces from X
' Errors: None known
' Author: JRoark 16Jan2020
' Version: 2.0 of 16Jan2021
' Requires: Nothing
' RefDoc: N/A
' RelSpeed: Fast
dim p as ubyte pointer ' setup p as a pointer to ubytes
dim i, m as integer ' i=loop cntr, m=len of input string
m = __builtin_strlen(x) ' get the length of the input string
if (m=0) return "" ' trap for zero-length input string
for i = 0 to m-1 ' iterate through the input string
if (x(i) <> 32) then ' found a non-space, so copy everything to the right of it and quit
p = new ubyte(m-i+1) ' attempt to set pointer P to a new array of ubytes
if p then ' check if memory alloc was successful
bytemove(p, @x(i), m-i) ' BYTEMOVE (DestAddress, SrcAddress, Count )
p(m-i) = 0 ' terminate the string
return p ' return the string
else
return p ' if here then memory alloc failed. return nil pointer
end if
end if
next i
return x ' if here, the input string was all spaces
END FUNCTION
'
'=================================================================================================================================
'
FUNCTION RemoveChar$(x as string, s as string) as string
'
' Purpose: Finds all occurances of the character S in X and removes (deletes) them
' Note that S must be a single char. If multiple chars are provided, only
' the first character is significant
' Errors: None known
' Author: JRoark 16Jan2020
' Version: 2.0 of 16Jan2021
' Requires: COUNTSTR()
' RefDoc: N/A
' RelSpeed: Fast
dim p as ubyte pointer ' setup p as a pointer to ubytes
dim i, m, z as integer ' i=loop cntr, m=len of input string, z=offset counter
dim removeC as uinteger ' character to remove
m = __builtin_strlen(x) ' get the length of the input string
if (m = 0) then ' trap for zero length input string
return "" ' return a null string
end if
if __builtin_strlen(s) = 0 then ' trap for zero-length S argument
return x ' return X unchanged
end if
z = CountStr(x, s) ' count occurances of target in the source string
' so we know how long to make our output string
p = new ubyte(m-z+1) ' attempt to set pointer P to a new array of ubytes
removeC = s(0) ' extract char
z = 0 ' zero Z for reuse below
if p then ' check if memory alloc was successful
for i = 0 to m-1 ' iterate through the input string
if (x(i) = removeC) then ' if the byte is the same as our target byte...
'skip it ' do nothing (effectively deletes it)
else ' otherwise...
p(z) = x(i) ' copy byte to output string
z += 1 ' incr output string offset
end if
next i
p(z) = 0 ' append string terminator char
return p ' return new string
end if
return p ' if here, memory alloc failed. return nil pointer
END FUNCTION
'
'=================================================================================================================================
'
FUNCTION ReplaceChar$(x as string, s as string, r as string) as string
'
' Purpose: Finds all occurances of character S in X and replaces them with R
' Both R and S must be a single character. If multiple chars are
' supplied, all chars but the first character will be ignored
' Errors: None known
' Author: JRoark 16Jan2020
' Version: 2.0 of 16Jan2021; modified slightly by ersmith
' Requires: Nothing
' RefDoc: N/A
' RelSpeed: Fast
dim p as ubyte pointer ' setup p as a pointer to ubytes
dim i, m as integer ' i=loop cntr, m=len of input string
dim origC, replaceC as uinteger ' original and replacement char
m = __builtin_strlen(x) ' get the length of the input string
if (m = 0) then ' trap for zero length input string
return "" ' return a null string
end if
if __builtin_strlen(s) = 0 then ' trap for zero-length S argument
return x ' return X unchanged
end if
if __builtin_strlen(r) = 0 then ' trap for zero-length R argument
return x ' return X unchanged
end if
p = new ubyte(m+1) ' attempt to set pointer P to a new array of ubytes
origC = s(0)
replaceC = r(0)
if p then ' check if memory alloc was successful
for i = 0 to m-1 ' iterate through the input string
if (x(i) = origC) then ' is this our target char?
p(i) = replaceC ' yes. change to new char
else
p(i) = x(i) ' no. dont change. just copy it to output string
end if
next i
p(m) = 0 ' append string terminator char
return p ' return new string
end if
return p ' if here, memory alloc failed. return nil pointer
END FUNCTION
'
'=================================================================================================================================
'
FUNCTION Reverse$(x as string) as string
'
' Purpose: Reverses the order of the characters in X. (Swaps X end-for-end)
' Issues: None known
' Author: JRoark 16Jan2021
' Requires: Nothing
' Notes: None
' RefDoc: N/A
' Speed: Fast
dim p as ubyte pointer ' setup p as a pointer to ubytes
dim i, m, z as uinteger ' i=loop cntr, m=len of input string, z=offset value
m = __builtin_strlen(x) ' get length of input string
if (m=0) return "" ' if zero lenght, return a null string
p = new ubyte(m+1) ' attempt to set pointer P to a new array of ubytes
z = m ' copy M to Z (Z=pointer offset)
if p then ' check if memory alloc was successful
for i = 0 to m ' step through the input string, left to right, halfway, swapping ends as we go
z -= 1 ' decr pointer offset
p(i) = x(z) ' copy byte by byte
next i ' next victim...
p(m) = 0 ' append string terminator character
return p ' return the result
end if
return p ' if here then memory alloc failed. return nil pointer
END FUNCTION
'
'=================================================================================================================================
'
FUNCTION RPad$(x as string, width as long, pchar as string) as string
'
' Purpose: Left-aligns x into a string of size WIDTH using PCHAR as the padding char on the RIGHT.
' If the length of ST is greater than WIDTH, the function returns only the leftmost WIDTH characters without
' any padding, ie, RPad$("Testing", 4, 45) would return "Test"
' Issues: None known
' Author: JRoark 16Jan2021
' Requires: String$(), Left$()
' Notes: None
' RefDoc: N/A
' Speed: Fast
dim p as ubyte pointer ' setup P as a pointer to ubytes
dim i, m as integer ' I=loop cntr, M=len of input string
m = __builtin_strlen(x) ' get the length of the input string
if (m=0) then ' trap for zero-length input string
return string$(width,pchar) ' return a string of the proper width completely populated by PCHARs
end if
if (m > width) then ' trap for input string longer than specified WIDTH
return left$(x,width) ' return the leftmost (unpadded) WIDTH chars of X
end if
if (m=width) then ' speed-up for when input string is same size as WIDTH
return x ' return X unchanged
end if
p = new ubyte(width+1) ' attempt to set pointer P to a new array of ubytes
if p then ' check if memory alloc was successful...
for i = 0 to width-1 ' iterate forward through the input string
if i < m then
p(i) = x(i) ' copy from input to output string char by char
else
p(i) = pchar(0) ' add-in padchars on right
end if
next i
p(width) = 0 ' add end-of-string terminator char
return p ' return the new string
end if
return p ' if here then memory alloc failed. return nil pointer
END FUNCTION
'
'=================================================================================================================================
'
FUNCTION RTrim$(x as string) as string
'
' Purpose: Removes trailing spaces from X
' Errors: None known
' Author: JRoark 16Jan2020
' Version: 2.0 of 16Jan2021
' Requires: Nothing
' RefDoc: N/A
' RelSpeed: Fast
dim p as ubyte pointer ' setup P as a pointer to ubytes
dim i, m as integer ' I=loop cntr, M=len of input string
m = __builtin_strlen(x) ' get the length of the input string
if (m=0) then ' trap for zero-length input string
return "" ' return a null string
end if
for i = m-1 to 0 step -1 ' iterate backwards through the input string
if (x(i) <> 32) then ' found a non-space, so copy everything to the right of it and quit
p = new ubyte(i+1) ' attempt to set pointer P to a new array of ubytes
if p then ' check if the memory alloc was successful
bytemove(p, @x(0), i+1) ' BYTEMOVE (DestAddress, SrcAddress, Count )
p(i+1) = 0 ' terminate the string
return p ' return the new string
else
return p ' memory alloc failed. return nil pointer
end if
end if
next i
return "" ' if here, the input string was all spaces. return a null string
END FUNCTION
'
'=================================================================================================================================
'
FUNCTION Space$(count% as integer) as string
'
' Purpose: Returns a string containing COUNT space (" ", ASCII 32d) characters.
' Issues: None known
' Author: JRoark 07Jan2021
' Requires: Nothing
' Notes: Trivial function included for compatability with many older BASIC implementations
' RefDoc: N/A
' Speed: Fast
return String$(count%, " ")
END FUNCTION
'
'=================================================================================================================================
'
FUNCTION String$(cnt as integer, x = " " as string) as string
'
' Purpose: Returns a string of CNT length of the character X.
' X must be a single char. If multiple chars are supplied, the addl chars are ignored
' Issues: None known
' Author: JRoark 16Jan2021
' Requires: Nothing
' Notes: Trivial function included for compatability with many older BASIC implementations
' RefDoc: N/A
' Speed: Fast
dim p as ubyte pointer ' setup P as a pointer to ubytes
dim m as integer ' M=len of input string
m = __builtin_strlen(x) ' get length of input string
if (m = 0) then ' trap for a zero-length input string
return "" ' return null string
end if
if (cnt <= 0) then ' trap for zero or negative CNT
return "" ' return null string
end if
p = new ubyte(cnt+1) ' attempt to set pointer P to a new array of ubytes
if p then ' check if memory alloc was successful
bytefill(p, x(0), cnt) ' BYTEFILL (DestAddress, char, Count )
p(cnt+1) = 0 ' terminate the string
return p ' return the new string
end if
return p ' if here, the memory alloc was unsuccessful. return nil pointer
END FUNCTION
'
'=================================================================================================================================
'
FUNCTION STRInt$(number as long) as string
'
' Purpose: A faster (~8x) integer only analog to BASICs native STR$(). This function accepts only integers and thus
' avoids the overhead of floating-point math. If a single/float is supplied, it will be truncated to an integer.
' Note that the input is signed giving the return value a range of -2,147,483,648 to 2,147,483,647
' So "FFFF_FFFFh" is interpreted as -1, not 4,294,967,295.
' Issues: None known
' Author: JRoark 16Jan2021
' Requires: Nothing
' Notes: None
' RefDoc: N/A
' Speed: Fast
dim p as ubyte pointer ' setup p as a pointer to ubytes
dim divisor, i as long ' i=loop cntr '
dim temp as ulong ' running residual
p = new ubyte(12) ' set p to a new array of ubytes (the output string, max 12 chars)
if p then ' check for successful memory alloc
i = 0 ' zero the byte pointer
if (number < 0) then ' is number negative?
p(i) = 45 ' add-in a "-" as first character (ascii 45)
i += 1 ' increment the byte pointer for the next use
if (number = &h80000000) then
p(i) = asc("2") ' add-in a "2" as next char (ascii 50)
i += 1 ' increment the byte pointer for the next use
number += 2_000_000_000 ' add 2 million to number
end if
number = -number ' negate number
else if (number = 0) then ' is number a zero?
p(i) = asc("0") ' yes. force an ASCII zero character into byte string...
i += 1 ' increment the byte pointer for the next use
p(i) = 0 ' add a zero to indicate end-of-string
return p ' return the string to the caller
end if
divisor = 1_000_000_000 ' force divisor to 1 million
while (divisor > number) ' while the divisor is bigger than number...
divisor /= 10 ' divide the divisor by 10
end while
while (divisor > 0) ' while divisor > 0
temp = number / divisor ' divide number by divisor and save to temp
p(i) = temp + asc("0") ' convert tmp to ASCII (add 48) and save to output byte string
i += 1 ' increment the byte pointer for the next use
number -= (temp * divisor) ' subtract temp*divisor from number
divisor /= 10 ' divide divisor by 10
end while
p(i) = 0 ' add a zero to indicate end-of-string
return p ' return the string to the caller
else
return p ' if here, the memory alloc was unsuccessful. return nil pointer
end if
END FUNCTION
'
'=================================================================================================================================
'
FUNCTION Trim$(x as string) as string
'
' Purpose: Removes leading and trailing spaces from X
' Issues: None known
' Author: JRoark 16Jan2021
' Requires: LTRIM$(), RTRIM$()
' Notes: None
' RefDoc: N/A
' Speed: Fast
return LTrim$(RTrim$(x))
END FUNCTION
'
'=================================================================================================================================
'
FUNCTION UCase$(x as string) as string
'
' Purpose: Turns any lower case characters in X to upper case.
' Any non lower case characters are passed thru unaffected.
' Issues: None known
' Author: JRoark 16Jan2021
' Requires: Nothing
' Notes: None
' RefDoc: N/A
' Speed: Fast
dim p as ubyte pointer ' setup P as a pointer to ubytes
dim i, m, ch as integer ' I=loop cntr, M=len of input string
m = __builtin_strlen(x) ' get the length of the input string
if (m = 0) then ' trap for zero length input string
return "" ' return a null string
end if
p = new ubyte(m+1) ' attempt to set pointer P to a new array of ubytes
if p then ' check if memory alloc was successful
for i = 0 to m-1 ' iterate through the input string
ch = x(i) ' extract a character to test
if (ch > 96) andalso (ch < 123) then ' test for a lower-case character
p(i) = ch - 32 ' Found lower case char. change to upper case
else
p(i) = ch ' Not a lower case, so copy it without changing case
end if
next i
p(m) = 0 ' append string terminator char
return p ' return new string
end if
return p ' if here, memory alloc failed. return nil pointer
END FUNCTION