Shorthand Basic

[bplus]

Well today is the day I get to more than double the string functions that SB1 will host. I am so excited, I am up 5 hours early!

I finally killed a bug way back from original parsing of program line that has been dogging me since first written in ParseProgramStr the same routine that maps the program. It came from a misremembering of what I thought a Filter function, written for the Sub, was doing. I didn't even know the bug existed and had been working around problems by reparsing program lines for numeric expression and string function processing. Again with the redundant processing of what should have been processed right the first time. I first became aware of it when I was trying to allow crazy spacing between first cmd/var of line and the next cmd/var. Along with case insensitive for commands, variables and labels I wanted as much space insensitive as possible as all literals will be picky enough to get right without dbl quote containment. Plus I learned Notpad++ likes to throw invisible tab chars at the end of lines. Such are invisible unless you highlight text for selection, then you see extra fat endings on the lines. The Filter was taking out tabs but it was also doing a trim to save time. Trouble was it was trimming every space out of the program line! ;-)) Yikes! I never noticed because I did a LeftOf$ the first space first before the filter. Then on case by case basis did more leftOf$ next spaces or ... anyway the fix was to filter out the whole program line of chars <32 and then parse by leftof$ stuff or splits on case by case basis.

Anyway the present list of string functions is:
Len, SPC, Mid$, Mid1, Head (revised yesterday), Tail(rev), Instr2, Instr3, $= for string comparison Boolean return
Head now looks for first string in source$ and returns all before that string or whole string if match not found
Tail takes the back end or nothing if match$ not found.
Head, Tail is like Mid$ with a string instead of number positions.
Empty was dumped for a line like this:
 isEmpty $= a1, 
(leaving no 2nd argument, Eval pissed off would Err$ = " Error: Binary Op missing operand."  but not Str Functions ;-))

And proposed additions (Looking at Ed's list for quick start):
Date
Time
Ucase
Lcase
Chr
Asc
Ltrim
Rtrim

String - not to be, Unicorned
Val - not to be, Unicorned (I think) might need in SB2 with Super Evaluator

B+:
Trim
Copy  + is replacement for String which only does 1 char, let's offer to copy more than 1 char, imagine an Astring copied that's like copying arrays. Astrings are array-like but you can insert items, delete items, append items without too much more coding like with DIM or REDIM _Preserve.
A$Sort + Ascending String sort
D$Sort
A#Sort
D#Sort
Split - with Astrings instead of arrays
Join - with Astrings instead of arrays

So am I missing anything obvious?

PS Yes, I already have concatenation:
CASE "&" '                                            Syntax: var & a1,a2,a3...   

[bplus]

Well it's coded, here is test code for Sorts:

Code: QB64: [Select]

1. _TITLE "Sorts test" ' b+ 2021-02-28
2. REDIM SHARED sa$(1 TO 20), na#(1 TO 20)
3.  
4. FOR i = 1 TO 20 'test arrays
5.     sa$(i) = _TRIM$(STR$(INT(RND * 100)))
6.     na#(i) = RND * 100
7. NEXT
8. DNQSort 1, UBOUND(na#)
9. FOR i = 1 TO 20
10.     PRINT na#(i)
11. NEXT
12.  
13. SUB ASQSort (Start, Finish) 'sa$ needs to be   DIM SHARED !!!!     array
14.     DIM i AS LONG, j AS LONG, x$
15.     i = Start: j = Finish: x$ = sa$(INT((i + j) / 2))
16.     WHILE i <= j
17.         WHILE sa$(i) < x$: i = i + 1: WEND
18.         WHILE sa$(j) > x$: j = j - 1: WEND
19.         IF i <= j THEN
20.             SWAP sa$(i), sa$(j)
21.             i = i + 1: j = j - 1
22.         END IF
23.     WEND
24.     IF j > Start THEN ASQSort Start, j
25.     IF i < Finish THEN ASQSort i, Finish
26. END SUB
27. SUB DSQSort (Start, Finish) 'sa$ needs to be   DIM SHARED !!!!     array
28.     DIM i AS LONG, j AS LONG, x$
29.     i = Start: j = Finish: x$ = sa$(INT((i + j) / 2))
30.     WHILE i <= j
31.         WHILE sa$(i) > x$: i = i + 1: WEND
32.         WHILE sa$(j) < x$: j = j - 1: WEND
33.         IF i <= j THEN
34.             SWAP sa$(i), sa$(j)
35.             i = i + 1: j = j - 1
36.         END IF
37.     WEND
38.     IF j > Start THEN DSQSort Start, j
39.     IF i < Finish THEN DSQSort i, Finish
40. END SUB
41. SUB ANQSort (Start, Finish) 'na#  needs to be   DIM SHARED !!!!     array
42.     DIM i AS LONG, j AS LONG, x#
43.     i = Start: j = Finish: x# = na#(INT((i + j) / 2))
44.     WHILE i <= j
45.         WHILE na#(i) < x#: i = i + 1: WEND
46.         WHILE na#(j) > x#: j = j - 1: WEND
47.         IF i <= j THEN
48.             SWAP na#(i), na#(j)
49.             i = i + 1: j = j - 1
50.         END IF
51.     WEND
52.     IF j > Start THEN ANQSort Start, j
53.     IF i < Finish THEN ANQSort i, Finish
54. END SUB
55. SUB DNQSort (Start, Finish) 'na#$ needs to be   DIM SHARED !!!!     array
56.     DIM i AS LONG, j AS LONG, x#
57.     i = Start: j = Finish: x# = na#(INT((i + j) / 2))
58.     WHILE i <= j
59.         WHILE na#(i) > x#: i = i + 1: WEND
60.         WHILE na#(j) < x#: j = j - 1: WEND
61.         IF i <= j THEN
62.             SWAP na#(i), na#(j)
63.             i = i + 1: j = j - 1
64.         END IF
65.     WEND
66.     IF j > Start THEN DNQSort Start, j
67.     IF i < Finish THEN DNQSort i, Finish
68. END SUB
69.  

Here is the sort interface with SB1:

Code: QB64: [Select]

1. FUNCTION SortWrapper$ (Astring$, SortType1to4 AS LONG) '------------------------------- Sorts Stuff
2.     DIM i AS LONG
3.     ' type 1 string ascending, 2 string descending, 3 numeric ascending, 4 numeric descending
4.     'the arrays SA$ and NA# have been dim shared (1 to 1) need to unzip astring$
5.     Split Astring$, CHR$(1), SA$(), 0
6. ReDim NA#(1 To UBound(sa$))  ' <<<<<<<<< Edit yes missed this originally
7.     IF SortType1to4 > 2 THEN 'convert into number
8.         FOR i = LBOUND(sa$) TO UBOUND(sa$)
9.             NA#(i) = VAL(SA$(i))
10.         NEXT
11.     END IF
12.     SELECT CASE SortType1to4
13.         CASE 1: ASQSort LBOUND(sa$), UBOUND(sa$)
14.         CASE 2: DSQSort LBOUND(sa$), UBOUND(sa$)
15.         CASE 3: ANQSort LBOUND(na#), UBOUND(na#)
16.         CASE 4: DNQSort LBOUND(na#), UBOUND(na#)  '< edit case 4 was same as 3, now fixed
17.     END SELECT
18.     'now pack it backup in an Astring$
19.     IF SortType1to4 > 2 THEN 'convert back into string
20.         FOR i = LBOUND(na#) TO UBOUND(na#)
21.             SA$(i) = _TRIM$(STR$(NA#(i)))
22.         NEXT
23.     END IF
24.     SortWrapper$ = Join$(SA$(), CHR$(1))
25. END FUNCTION
26.  

Next up see what wacky thing I did not anticipate '-))
MileStone: LOC just exceeded 1K, the 4 different sorts kind of expensive and redundant but I think faster than a one size fits all Variable Types and Sort Types.

Already I see I will need to REDIM NA# to SA$ bounds, after lunch.

EDIT: code above needed two fixes as pointed at with Commented Edit lines.

[bplus]

Yes the Split function and the Sort Functions are working, a couple of fixes to Sort shown above in Edits.

Sort Test Code:

Code: [Select]

[
cnt = cnt + 1
jmp cnt > 20
rLen = int(rnd * 10) + 2
b "
cnt2 = 0
[
cnt2 = cnt2 + 1
jmp cnt2 > rLen
rChar = int(rnd * 26) + 65
rStr chr rChar
b & b, rstr
]
set AstringS, cnt, b
r = int(rnd * 100 * 100)
set AstringN, cnt, r
loc cnt, 1
; b
row = cnt + 21
loc row, 1
; r
]
saSort a$Sort AstringS
sdSort d$Sort AstringS
naSort a#sort AstringN
ndSort d#Sort AstringN
cnt = 0
[
+= cnt,1
jmp cnt > 20
get sa, saSort, cnt
get sd, sdSort, cnt
get na, naSort, cnt
get nd, ndSort, cnt
at 20, cnt
; sa
at 40, cnt
; sd
row = cnt + 21
at 20, row
; na
at 40, row
; nd
]
Zzz


Those were the String Functions I was most concerned working OK. Next up is to test the remainder of the functions using v 1.5 now. :)

[Aurel]

WOW Mark
You have more  string functions than I in m(A)...well ..fine !!!
heh you say LOC over 1K...dude use more spaghetti code to minimize amount of lines..ok?

[bplus]

Hey Aurel,

What's micro(A) in LOC?
Do you have ElseIf equivalent? Do you map your program out before execution of lines?
Both new for me in SB1.


Today's update, just have Join to work out, there may be several different ones. Then will post code for you all to test drive.

BTW I notice all the functions in my Numeric Eval and Ed Davis more versatile Eval have 0 (Rnd) or 1 Arguments, what do we do for 2 or more? ;-))

[Ed Davis]

BTW I notice all the functions in my Numeric Eval and Ed Davis more versatile Eval have 0 (Rnd) or 1 Arguments, what do we do for 2 or more? ;-))

Something like this:

Code: QB64: [Select]

1. sub get2values(userstr as string, sym as string, n1 as double, n2 as double)
2.     nextsym userstr, sym    ' skip fun
3.     expect "(", userstr, sym
4.     n1 = numeric_expr(0, userstr, sym)
5.     expect ",", userstr, sym
6.     n2 = numeric_expr(0, userstr, sym)
7.     expect ")", userstr, sym
8. end sub
9.  

And then in primary():

Code: QB64: [Select]

1.             case "atan2": call get2values(userstr, sym, n, n2): primary = _atan2(n, n2)
2.  

[bplus]

OK finally got Join thing worked out. Join just takes the psuedo array Split made for array substitute to use Set and Get so we have array like storage and access functions. Join splits by same delimiter Split used to Join to make an Astring, then rejoins it with User spec'd delimiter like space, comma or NL$ = Chr$(13) + Chr$(10) maybe to file the string in lines.

Test and demo code:

Code: [Select]

' Test ak Remaining SFunctions 2-28.txt
' along with testing regular "easy to code" SFunctions get more practice with
' Set and Get our array substitute.

' oh try another way to assign with &
day date
clock time
xpix = xmax - 200
tag xpix, 10, clock
tag xpix, 30, day

sp1 chr 32
sp7 ncopy 7, sp1
test & sp7, B is Fat Left and Right!, sp7
. test string: ";test;"
bltrim ltrim test
brtrim rtrim test
btrim trim test
bshout ucase test
bwhisper lcase test
.
. ltrim B ";bltrim;"
.
. rtrim B ";brtrim;"
.
. B is looking trim ";btrim;"
.
. SHOUTING: ";bshout;"
.
. whisper: ";bwhisper;"
.
' Building an Astring with nCopy of embedded delimiter (space) to split it, brilliant!
fatx10 ncopy 10, fat!
'trim the fat
fatx10 trim fatx10
.
. fatx10
x10 split fatx10, sp1
. x10 split fatx10, sp1 is;
cnt = 1
hyph chr 45
[
x get x10, cnt
. /   ; cnt;.;/ ; x
'OK for fun lets mod with concatenation (binding I am calling it)
x & cnt,hyph,x
'test modified x debug
'. x
' and back into the Astring changed
' set is like a(i) = change ( I was doing change first )
set x10, cnt, x
'debug
'. x10
+= cnt, 1
jmp cnt > 10
]
'another way to assign a string
& c,+,
. & c,+, is ;c

'checks on our new join delimiter
c1 asc c
. c1 asc c is ;c1
c2 chr c1
. c2 chr c1 is ;c2

'' this needs fixed I am too tired to think straight
'' I think it was x10 that needed a trim, YES!
'' and this kind of join is really a rejoin
'' that converts an Astring into another type of Astring
j join x10,c
. j join x10, c is ; j


Oh I changed the ps (_PrintString) clone and renamed it Tag Syntax: Tag Xpix, Ypix, Label$

Also more news on the ? Input front, I now have 2 cmds n? and ?n because who the hell's going to remember which side the n is supposed to go ? And n? or ?n is to inform the Input code that we want a 0 instead of an empty string if user just presses Enter key. And that reminds me of another change, I am preloading the variables Table, names and values with MT for empty string, Xmax for screen width, Ymax for screen height, Rmax for max Row number and Cmax for At or Loc commands, At is Locate with Col, Row reversed to match Basic graphics where X comes before Y just like in the alphabet. :) Have it both ways dang it!

So Steve there is our answer to += or =+ we shall offer both and not challenge 60+ year minds with pickiness of left or right placement. ;-))

And screen shot:
 

And after taking nap today, I got an idea for surprise package to include with SB1, I am eager about.

[Aurel]

What's micro(A) in LOC?
currently cca 1400

Do you have ElseIf equivalent?
no ..i have only ELSE

Do you map your program out before execution of lines?
well yes i transform code into array of tokens and array of token types.

Mark i will try your...SB1

[bplus]

Code: QB64: [Select]

1. Mark i will try your...SB1
2.  

Oh thanks Aurel, that's nice. I will be sure that it requires Stable v 1.5 because you should like that too! ;-))

[bplus]

I had a revelation this morning, just treat the inside of [ contents ] 

[Bplus off on a tangent:
(instead of () to maintain the a goal of SB to avoid top row keys that need shift, maybe I should call this one handed Basic, or Basic with one arm tied behind my back, dang this could actually be a Basic for the one handed not a bad idea ) More ToDO then to be consistent with that idea, there goes any $ what so ever! no more!!!! crap also ha, ha.]

as a program line to do first! How simple is that! well we'll see.

Connecting to Ed Davis, Numeric/String Eval functions, here because he is helping me think about how to handle SFunctions like I have already with numeric Evaluations. I started to post there but here is more appropriate, I think, they are obviously intertwined subjects in my mind.
https://www.qb64.org/forum/index.php?topic=3697.msg130605#msg130605

[bplus]

Yeah I like that, rename this project oh basic, short for one handed basic. Always like o it's looks like a ball or a..., well.

oh, qm  no more ? too, now qm, no # sign now n, no $ sign now v or s? v for variable as all is string anyway, exclamation mark, em...

bplus you are some kind of nut, em

Yeah so who is doing basic with one hand tied behind their back, qm  bplus. Oh wait + is up there too, oh no em.
bt then qm ok so + is shifty too. ewh what about all those symbols for math? Yikes! =,- still ok. t for + can it be done qm

x for *

one handed or oh hell em

maybe 2 for 1 like qm, em, cm.. + then is tw as + is The Way to be. The Tao would be proud if it had feelings.

next up ^

or &

qm

[bplus]

& is bind

Stx would say ^ is hat but I like "up" for power symbol.

Any one see this?

[Aurel]

Yeah AMSTRAD...dogy games ...ha ha !!!

BpAkaMark...you should call it SB (pssst...script...pssstBasic ) ..he he
so you say that i must use new 1.5 hmm..i can ask why but better not ..L:O:L (Y)

by the way where is complete code ?

[bplus]

by the way where is complete code ?

Here with some untested, undocumented graphics commands:(attached)

OK I tested download and seems to be working on my machine OK.

All the Tests included in Folder are working on my machine.

New untested graphics:
Ink command for setting drawing or printing color
Ink 3 arg _RGB or 4 arg _RGB
eg Ink 255, 0, 0  'for red
eg Ink 255, 255, 0, 128  'for yellow alpha layer

Paper command for back color, 3 arg only
for white:
Paper 255, 255, 255

This was late last night I forgot if Paper does a Cls or just sets Shared as _unsigned long Paper, Ink

So for pset use:
Pix x, y

Line:
Line x1, y1, x2, y2

Box:
Box x1, y1, Width, Height

FBox (filled box)
FBox x1, y1, w, h

Circle:
Circ x, y, r

Filled Circle:
Fcirc x, y, r

Filled Triangle (you can make your own triangles with 3 lines)
Ftri x1, y1, x2, y2, x3, y3


Man was I in crazy state yesterday, low blood sugar? We were testing mom's heart monitor for over an hour trying to get the thing to send a test reading. Get to try again later this week with more tech guys on the other end of phone. Every minute of test mom asks how long is this going to take why are we doing this, meanwhile the is beeping like a loud annoying timer gone off, eventually the dog joins in with barking Yikes! what a symphony.

So my mind got a bit scattered for posts above.

Oh crap, I do want transparent paper available too, for printing with clear background color.

Yeah so I was testing random pix with random color and got such an unrandom result I threw in the towel for the day. This was after a session of updating Help for SB1 in which the words would not line up for me in head and not working well with Notepad++ on extra wide because I don't know what width others would be reading the text.

WARNING: the only places where numeric expressions are evaluated are:
Main:
var = expression
+ Sumvar, a2, a3, a4...  and Sumvar = total of Args after first
- MinusVar, a2, a3, a4    MinusVar = a2 - a3 - a4...
* Prodvar, a

+= var, change < literal number only,  change would be easy to run through eval

Yeah run numeric args through eval for Loc, At, Tag,... why am I not doing this?

[bplus]

so you say that i must use new 1.5 hmm..i can ask why but better not ..L:O:L (Y)

'sOK

Which would you rather do:

b4 v1.5

Code: QB64: [Select]

1. DIM x AS LONG, y AS LONG, z AS LONG, xa AS LONG, xb AS LONG, xc AS LONG, xd AS LONG, xe AS LONG

'aftr v 1.5

Code: QB64: [Select]

1. DIM AS LONG x, y, z, xa, xb, xc, xd, xe