oh One-Handed Interpreter

[bplus]

All that said, if you want my humble opinion, get the language part perfect before you worry about mouse input. In fact never worry about mouse input, or graphics, or any of that. Now that you've become a master of string space, stay there and master it.

LOL You don't know what I've planned for mouse and key, it's not a major operation we are talking about, it's simplicity itself! I was hoping to finish it yesterday with the file stuff (which is already simplicity) to be included in the next zip package.

I should be working on it now instead of yapping away but it's fun to throw out teasers. :)

One more: it's so easy now to slip in a string function, just add it to the FunHandler$ function that I can add extended string math functions as easy as I can add the missing right$ and left$ I noticed missing yesterday.

[bplus]

OK I rushed through the remaining changes I had hoped to include in latest update of oh.

In a couple of demos there are two files the before and after, Test an with the Quadratic App has 2 versions, an and an2, the 2nd tests the latest updates made today along with the better looking f(n) lines. There are 2 Dat files created one from each version.

Here is review of section of Change Log for latest update:

Code: [Select]

*** 2021-03-14
Dumped checking the _ClipBoard for a program now with File Dialog and all.

Tidied up oh's menu a tiny bit.

Check cpr handling of embedded variables and or SF[]'s, OK that is fixed up but not sure I want to
 do that for the other print commands? Oh yes!!! I do want that! (Done)
 
Note: it you call edit without a file name you will wind up on the command line, just type exit.
 
Add Command:
Save Astring;Filename
Reminder: Astring is my term for a string with indexed variable length string items.
Save will store each item as a line in given filename.

Add SFunction:
Astring = Load[filename]
So that you can load a file into an Astring for indexed access to lines.

Consolidate Set and RndPt (even though RndPt takes no arguments it assigns a var)
commands with all the other ; delimited commands that do calculations. So now,
you don't have to have middleman variables in the commands, you can calc directly
in the command.

Add preloaded Mouse variables:
MouseX, MouseY, MouseL, MouseR
Locate (x, y) mouse in pix and Boolean Left or Right Button Down

Add preloaded variable:
Key
For keypress detection.

Left$ and Right$ var = Right[a1$, val(a2$)

Ubound of Astring amount = nItems[AString]

And in my rush I forgot to mention the Poll command which updates all those preloaded Mouse and Key variables every time you call it.

See the first post in this thread for latest update zip package, see the next post (Reply #1) to review the commands and SFunctions and Change Log listed at the end.

[bplus]

OK first test with extended String Maths looking good, I just modified Test oh af Recursive Factorial Test to this:

Code: QB64: [Select]

1. ' Test oh ap First test of extended math F!.txt b+ 2021-03-15
2. . Now! with extended String Math Routines added to oh we might be able
3. . to do something impressive with factorials!
4. [
5.         inpn (0 quits) enter a number to find it's factorial;factorialMe
6.         If eq[0,factorialMe]
7.                 . Goodbye!
8.                 End
9.         el
10.                 ' now that save is a command, can't use it as a variable
11.                 ' save the number originally input because it is going to be changed
12.                 savenum = factorialMe
13.                 fac = 1
14.                 GS F!:
15.                 . savenum;! = ;fac
16.                 .
17.         Fi
18. ]
19. F!:
20.         If gt[factorialMe,1]
21.                 'fac is going to get giagantic but factorialMe goes to 1
22.                 'mult instead of simple x indicates calling the extended math Mult handled through Mr$
23.                 fac = mult[fac,factorialMe]
24.                 factorialMe = s[factorialMe,1]
25.                 GS F!:
26.         Fi
27. Rtn
28.  
29.  

Tested 100! and 500! (see attached screen shots)

With just these 4 lines added to the FunHandler$, MR$ is short for Math Regulator, it controls the signs and decimals of String Math calls. The actual Mult Routine just does multiplication of 2 giant pos integer strings.

Code: QB64: [Select]

1.         Case "ADD": FunHandler$ = MR$(a$(1), "+", a$(2))
2.         Case "SUBTRACT": FunHandler$ = MR$(a$(1), "-", a$(2))
3.         Case "MULT": FunHandler$ = MR$(a$(1), "*", a$(2))
4.         Case "DIVIDE": FunHandler$ = MR$(a$(1), "/", a$(2))
5.  

And 11 String Math routines added to oh code, 320 LOC for a total now of 1636.

I will probably add another function for controlling decimals in display strings that came with the String Math Functions.

Well more testing is needed of course but very pleased this worked on the first go!

[bplus]

Oh let's get a copy of that up into the clipboard.

Test oh ap modified with new Clipout command:

Code: [Select]

' Test oh ap First test of extended math F!.txt b+ 2021-03-15
. Now! with extended String Math Routines added to oh we might be able
. to do something impressive with factorials!
[
inpn (0 quits) enter a number to find it's factorial;factorialMe
If eq[0,factorialMe]
. Goodbye!
End
el
' now that save is a command, can't use it as a variable
' save the number originally input because it is going to be changed
savenum = factorialMe
fac = 1
GS F!:
. savenum;! = ;fac
.
inps Say, would you like a clip of that? (Enter y for yes);yes
if seq[cap[left[yes,1]],Y]
clipout bnd[savenum,! = ,fac]
fi
Fi
]
F!:
If gt[factorialMe,1]
'fac is going to get giagantic but factorialMe goes to 1
'mult instead of simple x indicates calling the extended math Mult handled through Mr$
fac = mult[fac,factorialMe]
factorialMe = s[factorialMe,1]
GS F!:
Fi
Rtn


From the clip a paste to a new txt file:
500!.txt

Code: QB64: [Select]

1. 500! = 1220136825991110068701238785423046926253574342803192842192413588385845373153881997605496447502203281863013616477148203584163378722078177200480785205159329285477907571939330603772960859086270429174547882424912726344305670173270769461062802310452644218878789465754777149863494367781037644274033827365397471386477878495438489595537537990423241061271326984327745715546309977202781014561081188373709531016356324432987029563896628911658974769572087926928871281780070265174507768410719624390394322536422605234945850129918571501248706961568141625359056693423813008856249246891564126775654481886506593847951775360894005745238940335798476363944905313062323749066445048824665075946735862074637925184200459369692981022263971952597190945217823331756934581508552332820762820023402626907898342451712006207714640979456116127629145951237229913340169552363850942885592018727433795173014586357570828355780158735432768888680120399882384702151467605445407663535984174430480128938313896881639487469658817504506926365338175055478128640000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
2.  

;-)) It's like magic!

[bplus]

STx

However, once you step off that path, and enter the pseudo-Churchian topology of string space (just to call it something), suddenly your code merges with the very data it manages, and vice-versa. This is like the General Relativity of computer programming: in the same sense that Einstein realized that gravity equals geometry, functional programmers realize that data equals code. Two seemingly unrelated ingredients turned out to be *equal*.

Is it wave or is it particle?

I ran into a problem last night wanting to show an expression before and after being processed.
More particularly, I had just made a new command: ClipAdd to append text to clipboard as opposed to simply replacing whatever contents may be in there with something else.

Of course, I wanted to kill two birds with one stone, test more of the new extended math, string math procedures, just imported and looking good with first Factorial Test.

So I started to convert: Test oh ac Fval tester.txt program to show the expression = evaluation PLUS offer the option to append that line to the ClipBorad to add to the user's the ability to paste it anywhere the user's heart desired so long as the app takes clipboard pastes, but my expression string (and all before it in a Bnd[] SFunction) kept disappearing into the Twilight Zone, no error and everything after showed up just fine and program kept running with the Cheshire cat smile of having swallowed and digested my expression string properly as I have programmed it to do.

Well that's a head scratcher, maybe not so dramatic as gravity = geometry but in my universe, up there ;-))

So I wake up with the solution: inpbs, input bracket string like inps, it prompts the user to enter a value and assigns the variable name in code. Xtra to that, it creates a 2nd variable: variableNameBS and assigns a string that has the [] brackets exchanged out for {} brackets so now a reasonable facsimile of the SFunction expression can be displayed without all the internals trying to convert the string because it's got [] in it!

Well let's make it so....

[bplus]

It's working except I ran into a QB64 error message with the divide test, I continued and think the result was accurate anyway but I am testing so much new stuff at once:

From Clipboard paste into new txt file

Code: [Select]

expressionbs
a{10000000000,.00000000001} = 10000000000
add{1000000000,.00000000001} = 1000000000.00000000001
s{10000000000,.00000000001} = 10000000000
subtract{10000000000,.00000000001} = 9999999999.99999999999
m{10000000000,9999999999} = 1
mult{10000000000,9999999999} = 99999999990000000000
d{11,990000000000} = 1.111111111111111D-11
divide{11,990000000000} = .00000000001111111111111111111111111111111111111111111111111111111111111111111111111111111111111111

Test oh aq...txt:

Code: [Select]

'Test aq Update Fval$ Tester.txt by b+ 2020-03-07 mod 2021-02-21 mod 2021-03-09 mod 2021-03-15&16
[
cpr 2;*** Update Fval$ Tester ***   Note: I had to use {} for Square brackets.
cpr 5;Arith: a{1,1} > 2,  s{1,1} > 0,  x{2,3} > 6,  d{12,4} > 3     Constants: e = exp{1}, pi = pi{1}
cpr 7;Math: modulus use m{3,2} > 1   power use p{2,3} > 8   log{}, exp{}, sqr{}, int{}, rnd{multiplier}
cpr 9;Trig (radians): sin{}, cos{}, tan{}, asin{}, acos{}, atan{}     Angle Conversion: rad{degrees}, deg{radians}
cpr 11;Boolean: #=# use eq{ , } for = numbers    noteq{ , } for <>    lt{ , } for <    lte{ , } for <= 
cpr 13; gt{ , } for >   gte{ , } for >=   and{,,, }   or{,,, }   not{ }    seq{$,$} for string equal
cpr 16;Get the cheat sheet and test string functions! Here a most:
cpr 17;mid1, mid2, mid3, in2, in3, time, date, CAP, low, rtr (RTrim$), ltr (LTrim$), trim, spc, len
cpr 19; New extended maths add{a$,b$} subtract{a$,b$} mult{a$,b$} divide{a$,b$}

' first test ever of fval$ working on arguments to loc, at, tag, graphics...
loc a[19,3];5
' new 3/16 the next line should create 2 variables: expression and expressionbs
' expression value is the expression with regular active []
' expressionbs value will hopefully be expression with the brackets replaced by {}
inpbs (just enter to quit) Enter an expression to evaluate;expression
.
. This is the expression: ;expression
. This is the new expressionbs created by new inpbs command ;expressionbs
.
Jmp seq[expression,mt]
result = fval[expression]
cpr 27;The Tester came up with this result: ;result
inps Say, would you like add that to the clipboard? (Enter y for yes);yes
if seq[cap[left[yes,1]],Y]
clipadd bnd[expressionbs, = ,result]
' brand new clipadd command test 3/16
fi
Cls
]
.
. Goodbye!

Just added this from Toolbox to oh:

Code: QB64: [Select]

1. Function StrReplace$ (s$, replace$, new$) 'case sensitive  2020-07-28 version    added to oh 3/16 for inpbs
2.     Dim p As Long, sCopy$, LR As Long, lNew As Long
3.     If Len(s$) = 0 Or Len(replace$) = 0 Then
4.         StrReplace$ = s$: Exit Function
5.     Else
6.         LR = Len(replace$): lNew = Len(new$)
7.     End If
8.  
9.     sCopy$ = s$ ' otherwise s$ would get changed
10.     p = InStr(sCopy$, replace$)
11.     While p
12.         sCopy$ = Mid$(sCopy$, 1, p - 1) + new$ + Mid$(sCopy$, p + LR)
13.         p = InStr(p + lNew, sCopy$, replace$)
14.     Wend
15.     StrReplace$ = sCopy$
16. End Function
17.  

Added this to the inputs command section:

Code: QB64: [Select]

1.     ElseIf InStr(" inps inpn inpbs ", " " + ProgramMap(Pline).Cmd + " ") > 0 Then ' ====== Input ? prompt; var (mod 3/16)
2.         Split ProgramMap(Pline).ArgLine, ";", Args$()
3.         If UBound(args$) >= 2 Then
4.             varName$ = Args$(2)
5.         Else
6.             Err$ = Err$ + Chr$(10) + "Error: Missing variable name on line " + TS$(Pline)
7.             Exit Sub
8.         End If
9.         _KeyClear 'man all my sleep keypress builds up the buffer!!!!
10.         Print Args$(1);
11.         Line Input " -> ", temp$
12.         If ProgramMap(Pline).Cmd = "inpn" Then temp$ = TD$(Val(temp$)) ' expecting number
13.         AddModVariable varName$, temp$
14.         If ProgramMap(Pline).Cmd = "inpbs" Then ' Xtra work for BS = Bracket String expressions 3/16
15.             temp$ = StrReplace$(temp$, "[", "{") ' bracket racket!
16.             temp$ = StrReplace$(temp$, "]", "}") ' more, yikes!
17.             AddModVariable varName$ + "bs", temp$
18.         End If
19.  

oh at 1663 LOC :)

[bplus]

Another mult test (with a couple tiny edits to oh program aq)

 

 

[bplus]

oh, I had another new SFunction to test:
var = clip[]
dumps the contents of the Clipboard into var.

So add part2 to the Test oh aj...txt program file:

Code: QB64: [Select]

1. 'Test oh aq Update Fval$ Tester.txt by b+ 2020-03-07 mod 2021-02-21 mod 2021-03-09 mod 2021-03-15&16
2. [
3.         cpr 2;*** Update Fval$ Tester ***   Note: I had to use {} for Square brackets.
4.         cpr 5;Arith: a{1,1} > 2,  s{1,1} > 0,  x{2,3} > 6,  d{12,4} > 3     Constants: e = exp{1}, pi = pi{1}
5.         cpr 7;Math: modulus use m{3,2} > 1   power use p{2,3} > 8   log{}, exp{}, sqr{}, int{}, rnd{multiplier}
6.         cpr 9;Trig (radians): sin{}, cos{}, tan{}, asin{}, acos{}, atan{}     Angle Conversion: rad{degrees}, deg{radians}
7.         cpr 11;Boolean: #=# use eq{ , } for = numbers    noteq{ , } for <>    lt{ , } for <    lte{ , } for <=  
8.         cpr 13; gt{ , } for >   gte{ , } for >=   and{,,, }   or{,,, }   not{ }    seq{$,$} for string equal
9.         cpr 16;Get the cheat sheet and test string functions! Here are most:
10.         cpr 17;mid1, mid2, mid3, in2, in3, time, date, CAP, low, rtr (RTrim$), ltr (LTrim$), trim, spc, len
11.         cpr 19; New extended maths add{a$,b$} subtract{a$,b$} mult{a$,b$} divide{a$,b$}
12.        
13.         ' first test ever of fval$ working on arguments to loc, at, tag, graphics...
14.         loc a[19,3];5
15.         ' new 3/16 the next line should create 2 variables: expression and expressionbs
16.         ' expression value is the expression with regular active []
17.         ' expressionbs value will hopefully be expression with the brackets replaced by {}
18.         inpbs (just enter to quit) Enter an expression to evaluate;expression
19.         .
20.         . This is the expression: ;expression
21.         . This is the new expressionbs created by new inpbs command ;expressionbs
22.         .
23.         Jmp seq[expression,mt]
24.         result = fval[expression]
25.         cpr 27;The Tester came up with this result: ;result
26.         inps Say, would you like to add that to the clipboard? (Enter y for yes);yes
27.         if seq[cap[left[yes,1]],Y]
28.                 clipadd bnd[expressionbs, = ,result]
29.                 ' brand new clipadd command test 3/16
30.                 ' with brand new inpbs application using expressionbs variable name created
31.                 ' and value string with brackets swapped.
32.         fi
33.         Cls
34. ]
35. ' OK 3/16 now test clip[], get contents into a var and then cls and print it
36. ' I think I assumed clip was delimited by NL$ Chr$(13) + Chr$(10)
37. ' It might just be Chr$(10), well let's see! Oh I just unloaded clipboard as a simple string!
38. contents = clip[]
39. cls
40. cpr 1;"*** Clipboard Contents: ***"
41. loc 3;1
42. . contents
43. .
44. . zzz... press any to end
45. zzz
46.  

Looks OK
 

Hopefully I will get zip package updated today, need to chase down that divide bump in road.

[bplus]

Ah looks like the long answers from divide was causing a locate problem with CPR. It doesn't all fit on one row so the centering calc was going negative for the LOCATE position. Fixed.

Ehhhh such a habit of putting quotes around strings ha, ha, ha just noticed the title in last screen shot.

You sure can get some interesting patterns of numbers dividing certain little numbers like 1 by certain giant numbers like 99999999999999999999999999999999997.

[STxAxTIC]

You sure can get some interesting patterns of numbers dividing certain little numbers like 1 by certain giant numbers like 99999999999999999999999999999999997.

Remember this convo from August?

It turns out that the first hundred (or so) Fibonacci Numbers can be produced by inverting the integer 999999999999999999999998999999999999999999999999 (bonus points for noticing that one of the digits is not a 9).

[bplus]

Remember this convo from August?

Sure do!

I'd have to make some modifications to code to duplicate that, as I recall I have to set number of decimal places to 1000's or 10,000's.

Here is Change Log for most recent zip package:

Code: QB64: [Select]

1. *** 2021-03-16
2. Added: string math for extended arithmetics in SFunctions
3. add[a1,a2]
4. subtract[a1,a2]
5. mult[a1,a2]
6. divide[a1,a2]
7. (cost 320 new LOC with 11 Routines, MR$ is controller of them all stands for Math Regulator.)
8.  
9. Added command:
10. clipout [a1] + whatever argument 1 is holding: literal, variable value substitution
11.                or expression of SFunctions replaces contents of Clipboard
12.  
13. Added command:
14. clipadd [a1] appends to, instead of replaces, Clipboard data.
15.  
16. Added SFunction clip[] no argument SFunction, you still need the brackets.
17.  This puts the contents of the Clipboard into the spec'd var.
18.  eg var = clip[]
19.  
20. todo:
21. * Not sure I want to automatically run a file anymore. Sometimes I want to just read the file
22.  to see what it is and then go to editor for copy / paste of mod... so
23. Display programs now that we have the ability to do so, instead of automatically running them.
24.  
25. * Since StrReplace$ has been added to oh might as well offer it as another SFunction,
26. it's definitely a handy one.
27.  

[bplus]

Oh has been updated today and mainly features Donut.txt and has been fixed and tweaked to get that working and play nice with all that's gone before.

Here is Donut.txt

Code: [Select]

' Donut.txt b+ 2021-03-17
' attempt #2 to do a fun little graphic

' center screen for circles
cx = d[xmax,2]
cy = d[ymax,2]
' area needed = number of chars we want to layover donut in pixels
' get Donut.txt file loaded as file (AString with Chr$(1) delimiters) and count chars.
file = load[Donut.txt]
LenF = len[file]
' fiddle the multiplier until everything just fits
areaNeeded = x[8,16,lenF,1.09]
' area of circle pi r^2  Big area Needed = hole area + areaNeeded, so big Radius = sqr(that/pi) 
smallRadius = d[cy,3]
holeArea = x[p[smallRadius,2],pi[1]]
bigRadius = sqr[d[a[holeArea,areaNeeded],pi[1]]]
midRadius = d[a[smallRadius,bigRadius],2]
rad = smallRadius
[
if lt[rad,midRadius]
brownInkFrac = s[1,d[s[midRadius,rad],s[midRadius,smallRadius]]]
gs BrownInk:
el
brownInkFrac = d[s[bigRadius,rad],s[bigRadius,midRadius]]
gs BrownInk:
fi
circ cx;cy;rad
rad = a[rad,.25]
jmp gt[rad,bigradius]
]
' transparent background
paper 0;0;0;0
fixSmallRad = a[smallRadius,8]
fixBigRad = s[bigRadius,8]
y = 8
i = 0
[
x = 4
[
' is x,y inside donut
d = sqr[a[p[s[x,cx],2],p[s[y,cy],2]]]
if gt[d,fixSmallRad]
if lt[d,fixBigRad]
'draw char
ink rnd[255];rnd[255];rnd[255]
i = a[i,1]
tag s[x,4];s[y,8];mid1[file,i]
fi
fi
x = a[x,8]
jmp gt[x,xmax]
]
y = a[y,16]
jmp gt[y,ymax]
]
' restore oh colors
paper 0;0;39
ink 100;180;225
tag a[cx,s[bigRadius,50]];a[cy,s[bigRadius,50]];h
end
' according to brownInkFrac ink (color fore, ) a shade of brown
BrownInk:
' 180, 90, 55,    80, 40, 20
  brownInkRed = a[80,x[100,brownInkFrac]]
  brownInkGrn = a[40,x[50,brownInkFrac]]
  brownInkBlu = a[20,x[35,brownInkFrac]]
  ink brownInkRed;brownInkGrn;brownInkBlu
rtn


And screen shot of course!
 

Copy of Change Log for 2021-03-17:

Code: [Select]

*** 2021-03-17
 Basically just a few fixes and tweaks to get Donut.txt to work. Fixed the file line count
  with a different load of a file. Fixed bug from reading the Len[] of a file, thrown off by
  the file containing []'s!!! So a new SafeBS$ Function filter/converter created that
  converts [] to {}. Needed to fix the Ink, Paper and color restoring after Run.

As always the most current zip package for oh is in the 1st post and the Help | Doc | Manual | Change Log is in Reply #1 this thread.

[bplus]

oh's first (graphics) game with Mouse:

Code: [Select]

' Stick with Me.txt b+ 2021-03-17
' inspired by SierraKen's game.

haha:
paper 0;0;39
cls
cnt = a[cnt,1]
if eq[m[cnt, 45],1]
cx = a[rnd[s[xmax,200]],100]
cy = a[rnd[s[ymax,200]],100]
fi
r = 100
[
if m[d[r,10],2]
ink 255;0;0
el
ink 255;255;255
fi
fcirc cx;cy;r
r = s[r,10]
jmp lte[r,0]
]
poll
if lte[sqr[p[s[cx,mousex],2],p[s[cy,mousey],2]],50]
score = a[score,5]
fi
score = s[score,1]
ink 255;255;0
paper 0;0;0;0
cpr 21;score
show -1
wait .005
goto haha:


[bplus]

Update 2021-03-19 Features this 2nd Graphics Game using Mouse for a Shooter Game.

Code: [Select]

' Mouse Action Shooter - Target Practice.txt b+ 2021-03-18 from
' _Title "Mouse Action Shooter #2 Targets fix" 'B+ 2019-04-04
' 2019-04-03 add some targets for practice
' Update Mouse Action Shooter with MB triggers 2019-04-01
' Mouse Action Shooter started from eRATication 5 by bplus 2018-08-06"

' SCORE System:
' Left click to fire a bullet, they cost 10 points each.
' Targets range from 30 for biggest targets to 100 points for smallest Targets
' Get hit by target loose 100 points and delays game with explosion.

NBullets = 15
BSpeed = 50
NTargets = 3
TSpeed = 10
ShooterRadius = 50
Score = 0

restart:
flaghit = 0
' targets init, ti = target index all thru app
ti = 0
[
ti = a[ti,1]
jmp gt[ti,NTargets]
gs NewTarget:
]
' init bLive array, bi = bullet index all thru app
bi = 0
[
bi = a[bi,1]
jmp gt[bi,NBullets]
set bLive;bi;0
]

' shooter or ship, lastX, LastY was the last position of shooter
shooterX = d[xmax,2]
shootery = d[ymax,2]
shooterA = 0
lastx = d[xmax,2]
lasty = d[ymax,2]
gs drawshooter:

' game, mouse display off
mouse 0
[
    cls
'display score
ink 255;255;0
paper 0;0;0;0
cpr 21;score
'get mouse
    poll
    shooterX = MouseX
shooterY = MouseY
'detect mouse movement from last position, point nose to direction of movement
    If or[gt[abs[s[lastx,shooterX]],2],gt[Abs[s[lasty,shooterY]],2]]
        shooterA = atan2[s[shooterY,lasty],s[shooterX,lastx]]
        lastx = shooterX
lasty = shooterY
    fi
'check for bullet firing Left mouse
    t = Timer[]
    if mouseL
if gt[s[t,last1],.15]
mb1 = 1
last1 = t
fi
    fi
'updates targets, shooter and bullets
    gs handleTargets:
    gs drawshooter:
    gs handleBullets:
' collision between target and shooter, explosion
if expX
expRadius = 0
show 1
[
ink s[255,x[.5,expRadius]];s[255,x[expRadius,3]];0;8
fcirc expX;expY;expRadius
expRadius = a[expRadius,1]
jmp gt[expRadius,expR]
show 1
wait .005
]
expX = 0
el
    show 1
wait .03
fi
]
end

NewTarget:
    'pick edge, ti is target index
    edge = Int[Rnd[4]]
if eq[edge,0]
set tX;ti;s[0,ShooterRadius]
set tY;ti;a[rnd[s[ymax,300]],150]
set tA;ti;a[pi[1.5],rnd[pi[1]]]
ei eq[edge,1]
set tX;ti;a[xmax,ShooterRadius]
set tY;ti;a[rnd[s[ymax,300]],150]
set tA;ti;a[pi[.5],rnd[pi[1]]]
ei eq[edge,2]
set tX;ti;rnd[xmax]
set tY;ti;s[0,ShooterRadius]
set tA;ti;rnd[pi[1]]
ei eq[edge,3]
set tX;ti;rnd[xmax]
set tY;ti;a[ymax,ShooterRadius]
set tA;ti;a[pi[1],rnd[pi[1]]]
fi
set tR;ti;x[a[int[rnd[8]],3],10]
rtn

handleTargets:
'ti is target index used in all the gosubs gs
ti = 1
[
set tX;ti;a[get[tX,ti],x[tSpeed,cos[get[tA,ti]]]]
set tY;ti;a[get[tY,ti],x[tSpeed,sin[get[tA,ti]]]]
        'inbounds? if not set new
If lt[get[tx,ti],x[-1,shooterRadius]]
gs NewTarget:
ei gt[get[tx,ti],a[xmax,shooterRadius]]
gs NewTarget:
ei lt[get[ty,ti],x[-1,shooterRadius]]
gs NewTarget:
ei gt[get[ty,ti],a[ymax,shooterRadius]]
gs NewTarget:
el
gs hitShooter:
if hitShooter
score = s[score,100]
beep
'note explosion coordinates but finish drawing things
expX = d[a[shooterX,get[tx,ti]],2]
expY = d[a[shooterY,get[ty,ti]],2]
expR = x[1.3,get[tr,ti]]
'now reassign target coordinates
gs drawTarget:
gs NewTarget:
el
gs drawTarget:
fi
fi
ti = a[ti,1]
jmp gt[ti,NTargets]
]
rtn

drawTarget:
'ti is target index used in all gosubs for Target
drawTargetR = get[tR,ti]
drawTargetStep = d[s[0,drawTargetR],10]
drawTargetCount = 0
[
drawTargetCount = a[drawTargetCount,1]
if m[drawTargetCount,2]
ink 255;0;0
El
ink 255;255;255
fi
fcirc get[tX,ti];get[tY,ti];drawTargetR
drawTargetR = a[drawTargetR,drawTargetStep]
jmp lte[drawTargetR,0]
    ]
rtn

HandleBullets:
bi = 0
[
bi = a[bi,1]
jmp gt[bi,NBullets]
' have a bullet slot and an order to fire?
if and[eq[get[bLive,bi],0],eq[mb1,1]
set bx;bi;a[shooterX,x[.5,shooterRadius,cos[shooterA]]]
set by;bi;a[shooterY,x[.5,shooterRadius,sin[shooterA]]]
set bdx;bi;x[bSpeed,cos[shooterA]]
set bdy;bi;x[bSpeed,sin[shooterA]]
set bLive;bi;1
mb1 = 0
'bullets cost 10 points
score = s[score,10]
ei eq[get[bLive,bi],1]
' Then new location
set bx;bi;a[get[bx,bi],get[bdx,bi]]
set by;bi;a[get[by,bi],get[bdy,bi]]
' in bounds?
'assume it's out
set bLive;bi;0
if gt[get[bx,bi],-50]
if lt[get[bx,bi],a[xmax,50]]
if gt[get[by,bi],-50]
if lt[get[by,bi],a[ymax,50]]
' it's Alive!
set bLive;bi;1
'check for collision with targets
gs HitTarget:
if gt[hitTarget,0]
score = a[score,s[130,get[tr,hitTarget]]
set bLive;bi;0
ti = hitTarget
gs NewTarget:
El
'draw bullet
ink 255;255;0
fcirc get[bx,bi];get[by,bi];4
fi
fi
fi
fi
fi
fi
]
rtn

HitTarget:
hitTarget = 0
ti = 0
[
ti = a[ti,1]
jmp gt[ti,NTargets]
If lte[sqr[a[p[s[get[tx,ti],get[bx,bi]],2],p[s[get[ty,ti],get[by,bi]],2]]],get[tr,ti]]
hitTarget = ti
fi
]
rtn

hitShooter:
'ti is target index for all target gosubs
hitShooter = 0
If lte[sqr[a[p[s[shooterX,get[tX,ti]],2],p[s[shooterY,get[tY,ti]],2]]],a[10,get[tR,ti]]]
hitShooter = ti
fi
rtn

drawshooter:
    x1 = a[shooterX,x[s[shooterRadius,30],cos[shooterA]]]
    y1 = a[shooterY,x[s[shooterRadius,30],sin[shooterA]]]
    x2 = a[shooterX,x[a[shooterRadius,20],cos[a[shooterA,pi[d[11,16]]]]]]
    y2 = a[shooterY,x[a[shooterRadius,20],sin[a[shooterA,pi[d[11,16]]]]]]
    x3 = a[shooterX,x[a[shooterRadius,20],cos[s[shooterA,pi[d[11,16]]]]]]
    y3 = a[shooterY,x[a[shooterRadius,20],sin[s[shooterA,pi[d[11,16]]]]]]
ink 0;130;60
    ftri x1;y1;x2;y2;x3;y3
    x1 = a[shooterX,x[shooterRadius,cos[shooterA]]]
    y1 = a[shooterY,x[shooterRadius,sin[shooterA]]]
    x2 = a[shooterX,x[shooterRadius,cos[a[shooterA,pi[d[7,8]]]]]]
    y2 = a[shooterY,x[shooterRadius,sin[a[shooterA,pi[d[7,8]]]]]]
    x3 = a[shooterX,x[shooterRadius,cos[s[shooterA,pi[d[7,8]]]]]]
    y3 = a[shooterY,x[shooterRadius,sin[s[shooterA,pi[d[7,8]]]]]]
ink 0;0;200
    ftri x1;y1;x2;y2;x3;y3
    x2 = a[shooterX,x[shooterRadius,cos[a[shooterA,pi[d[15,16]]]]]]
    y2 = a[shooterY,x[shooterRadius,sin[a[shooterA,pi[d[15,16]]]]]]
    x3 = a[shooterX,x[shooterRadius,cos[s[shooterA,pi[d[15,16]]]]]]
    y3 = a[shooterY,x[shooterRadius,sin[s[shooterA,pi[d[15,16]]]]]]
ink 255;255;255
    ftri x1;y1;x2;y2;x3;y3
rtn

Change Log for this update:

Code: [Select]

*** 2021-03-19
 For Mouse Action Shooter - Target Practice (Graphics Game #2 attempt)
3/18 added Mouse TF  - command with 1 argument. True to Show Mouse, False to Hide Mouse
3/18 added ABS[arg1] - SFunction with 1 argument. Kind of surprised how much I use ABS.
3/18 added Timer[]   - SFunction no argument, still need brackets.
3/18 added Atan2[a1 (=deltaY's) , a2 (=deltaX's) ] SFunction with 2 args, definitely a plus!
Find the angle of point 1 (x1,y1) from point 2 (x2, y2)
Basic: var = _atan2(y1-y2,x1-x2) or oh: var = atan2[s[y1,y2],s[x1,x2]]
3/19 added Beep (command) no args, main reason: to help debug.

And here is almost the same game in QB64 without a simple little explosion display when target collides with Shooter (this just clears screen and says Ouch!) :

Code: QB64: [Select]

1. _Title "Mouse Action Shooter #2 Targets fix" 'B+ 2021-03-19
2. 'Mouse Action Shooter started from eRATication 5 by bplus 2018-08-06"
3. ' upodate Mouse Action Shooter with MB triggers 2019-04-01
4. ' 2019-04-03 add some targets for practice
5.  
6. ' SCORE System:
7. ' Right click to fire a bullet, they cost 10 points each.
8. ' Targets range from 30 for biggest targets to 100 points for smallest Targets
9. ' Get hit by target loose 100 points and delay of game.
10.  
11. '2019-04-04 Keeping Ashish Target fix, wait until completely off screen.
12. ' Now give the bullets a little long range before deactivating them.
13. ' Fix shooter x, y by locating in center of shooter instead of nose. It's already OK!
14.  
15. ' 2021-03-19 using this code for oh program and want to fix point when target crashes into shooter/ship
16. ' by reassignning target new coordinates by saying NewTarget index that should fix the continuous crashing right?
17. ' Let's see, in oh it doesn't work, how about here?  Works just as expected. So what's up with oh?
18. ' (Fixed it was an index goof for public variables used in GoSubs).
19.  
20.  
21. 'screen dimensions
22. Const xmax = 1200
23. Const ymax = 700
24. Const nBullets = 15
25. Const bSpeed = 30
26. Const nTargets = 3 'should probably depend on level of play
27. Const tSpeed = 5 'should probably depend on level of play
28. Const shooterRadius = 50
29.  
30. Type shooterType
31.     x As Single
32.     y As Single
33.     a As Single
34. End Type
35.  
36. Type bulletType
37.     x As Integer
38.     y As Integer
39.     dx As Integer
40.     dy As Integer
41.     live As Integer
42. End Type
43.  
44. Type targetType
45.     x As Single
46.     y As Single
47.     a As Single
48.     r As Integer
49. End Type
50.  
51. Screen _NewImage(xmax, ymax, 32)
52. _ScreenMove 100, 20
53. Randomize Timer
54.  
55.  
56. Dim Shared GameOn, mb1, last1, score
57.  
58. 'targets
59. Dim Shared t(nTargets - 1) As targetType
60. For i = 0 To nTargets - 1: newTarget i: Next
61.  
62. 'bullets
63. Dim Shared b(nBullets - 1) As bulletType
64.  
65. 'shooter
66. Dim Shared shooter As shooterType
67. shooter.x = xmax / 2
68. shooter.y = ymax / 2
69. shooter.a = 0
70. lastx = xmax / 2: lasty = ymax / 2
71.  
72. 'game
73. GameOn = 1
74. _MouseHide
75. While GameOn
76.     Cls
77.     _Title "Target Practice   Score:" + Str$(score)
78.     mb1 = 0: mb2 = 0
79.     While _MouseInput: Wend
80.     shooter.x = _MouseX: shooter.y = _MouseY
81.     If Abs(lastx - shooter.x) > 3 Or Abs(lasty - shooter.y) > 3 Then
82.         shooter.a = _Atan2(shooter.y - lasty, shooter.x - lastx)
83.         lastx = shooter.x: lasty = shooter.y
84.     End If
85.     t = Timer(.001)
86.     If _MouseButton(1) Then 'when ship is heading north the left button should be left
87.         If t - last1 > .15 Then mb1 = 1: last1 = t
88.     End If
89.     If _KeyDown(27) Then _MouseShow: End
90.     handleTargets
91.     drawshooter
92.     handleBullets
93.     _Display
94.     _Limit 30
95. Wend
96.  
97. Sub handleTargets
98.     For i = 0 To nTargets - 1
99.         'update position
100.         t(i).x = t(i).x + tSpeed * Cos(t(i).a)
101.         t(i).y = t(i).y + tSpeed * Sin(t(i).a)
102.         'inbounds?
103.         If t(i).x < -shooterRadius Or t(i).x > xmax + shooterRadius Or t(i).y < -shooterRadius Or t(i).y > ymax + shooterradiu Then
104.             newTarget i
105.         Else
106.             If hitShooter(i) Then 'now I discovered in oh program this continues to crash and deduct 100 until target moves through shooter
107.                 'explosion
108.                 Cls
109.                 _PrintString (xmax / 2 - 40, ymax / 2 - 10), "Bang!... Ouch!"
110.                 score = score - 100
111.                 _Display
112.                 _Delay .2
113.                 ' fix target crashing into ship by removing target with reassigning
114.                 newTarget i ' in oh this does not work
115.             Else
116.                 drawTarget i
117.             End If
118.         End If
119.     Next
120. End Sub
121.  
122. Sub newTarget (i)
123.     'pick edge
124.     edge = Int(Rnd * 4)
125.     Select Case edge
126.         Case 0: t(i).x = -shooterRadius: t(i).y = Rnd * (ymax - 300) + 150: t(i).a = Rnd * _Pi
127.         Case 1: t(i).x = xmax + shooterRadius: t(i).y = Rnd * (ymax - 300) + 150: t(i).a = _Pi / 2 + Rnd * _Pi
128.         Case 2: t(i).x = Rnd * xmax: t(i).y = -shooterRadius: t(i).a = Rnd * _Pi
129.         Case 3: t(i).x = Rnd * xmax: t(i).y = ymax + shooterRadius: t(i).a = _Pi + Rnd * _Pi
130.     End Select
131.     t(i).r = (Int(Rnd * 8) + 3) * 10 '30 to 100 score 130 - radius 100 to 30
132. End Sub
133.  
134. Sub drawTarget (i)
135.     For r = t(i).r To 0 Step -t(i).r / 10
136.         count = (count + 1) Mod 2
137.         If count Then c~& = _RGB32(255, 0, 0) Else c~& = _RGB32(255, 255, 255)
138.         fcirc t(i).x, t(i).y, r, c~&
139.     Next
140. End Sub
141.  
142. Sub handleBullets ()
143.     For i = 0 To nBullets - 1
144.         If b(i).live = 0 And mb1 = 1 Then 'have in active bullet index to use
145.             b(i).x = shooter.x + .5 * shooterRadius * Cos(shooter.a)
146.             b(i).y = shooter.y + .5 * shooterRadius * Sin(shooter.a)
147.             b(i).dx = bSpeed * Cos(shooter.a)
148.             b(i).dy = bSpeed * Sin(shooter.a)
149.             b(i).live = 1
150.             mb1 = 0
151.             score = score - 10 'bullets cost 10 points
152.  
153.         ElseIf b(i).live = 1 Then 'new location
154.             b(i).x = b(i).x + b(i).dx
155.             b(i).y = b(i).y + b(i).dy
156.             If b(i).x > -50 And b(i).x < xmax + 50 And b(i).y > -50 And b(i).y < ymax + 50 Then 'in bounds draw it
157.                 'check for collision with ...
158.                 t = hitTarget(i)
159.                 If t > -1 Then
160.                     score = score + 130 - t(t).r
161.                     b(i).live = 0
162.                     newTarget t
163.                 Else
164.                     'draw bullet
165.                     ba = _Atan2(b(i).dy, b(i).dx): b = 15
166.                     x1 = b(i).x + b * Cos(ba)
167.                     y1 = b(i).y + b * Sin(ba)
168.                     x2 = b(i).x + b * Cos(ba + _Pi(5 / 6))
169.                     y2 = b(i).y + b * Sin(ba + _Pi(5 / 6))
170.                     x3 = b(i).x + b * Cos(ba + _Pi(7 / 6))
171.                     y3 = b(i).y + b * Sin(ba + _Pi(7 / 6))
172.                     fTri x1, y1, x2, y2, x3, y3, _RGB32(10, 160, 160)
173.                     'fcirc b(i).x, b(i).y, 4, _RGB32(64, 0, 0)
174.                 End If
175.             Else
176.                 b(i).live = 0 'dectiveate
177.             End If
178.         End If
179.     Next
180. End Sub
181.  
182. Function hitTarget (bulletIndex)
183.     hitTarget = -1
184.     For i = 0 To nTargets - 1
185.         If Sqr((t(i).x - b(bulletIndex).x) ^ 2 + (t(i).y - b(bulletIndex).y) ^ 2) <= t(i).r Then hitTarget = i: Exit Function
186.     Next
187. End Function
188.  
189. Function hitShooter (TargetIndex)
190.     If Sqr((shooter.x - t(TargetIndex).x) ^ 2 + (shooter.y - t(TargetIndex).y) ^ 2) <= t(i).r Then hitShooter = 1: Exit Function
191. End Function
192.  
193. Sub drawshooter ()
194.     x1 = shooter.x + (shooterRadius - 30) * Cos(shooter.a)
195.     y1 = shooter.y + (shooterRadius - 30) * Sin(shooter.a)
196.     x2 = shooter.x + (shooterRadius + 20) * Cos(shooter.a + _Pi(11 / 16))
197.     y2 = shooter.y + (shooterRadius + 20) * Sin(shooter.a + _Pi(11 / 16))
198.     x3 = shooter.x + (shooterRadius + 20) * Cos(shooter.a - _Pi(11 / 16))
199.     y3 = shooter.y + (shooterRadius + 20) * Sin(shooter.a - _Pi(11 / 16))
200.     fTri x1, y1, x2, y2, x3, y3, _RGB32(85, 45, 0)
201.     x1 = shooter.x + shooterRadius * Cos(shooter.a)
202.     y1 = shooter.y + shooterRadius * Sin(shooter.a)
203.     x2 = shooter.x + shooterRadius * Cos(shooter.a + _Pi(7 / 8))
204.     y2 = shooter.y + shooterRadius * Sin(shooter.a + _Pi(7 / 8))
205.     x3 = shooter.x + shooterRadius * Cos(shooter.a - _Pi(7 / 8))
206.     y3 = shooter.y + shooterRadius * Sin(shooter.a - _Pi(7 / 8))
207.     fTri x1, y1, x2, y2, x3, y3, _RGB32(0, 0, 200)
208.     x2 = shooter.x + shooterRadius * Cos(shooter.a + _Pi(15 / 16))
209.     y2 = shooter.y + shooterRadius * Sin(shooter.a + _Pi(15 / 16))
210.     x3 = shooter.x + shooterRadius * Cos(shooter.a - _Pi(15 / 16))
211.     y3 = shooter.y + shooterRadius * Sin(shooter.a - _Pi(15 / 16))
212.     fTri x1, y1, x2, y2, x3, y3, _RGB32(255, 255, 255)
213.  
214.     'check shooter x, y  = fixed a long time ago!
215.     'fcirc shooter.x, shooter.y, 4, _RGB32(140, 120, 140)
216. End Sub
217.  
218. ' found at [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]:    http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
219. Sub fTri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
220.     a& = _NewImage(1, 1, 32)
221.     _Dest a&
222.     PSet (0, 0), K
223.     _Dest 0
224.     _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
225.     _FreeImage a& '<<< this is important!
226. End Sub
227.  
228. Sub fcirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
229.     Dim Radius As Integer, RadiusError As Integer
230.     Dim X As Integer, Y As Integer
231.  
232.     Radius = Abs(R)
233.     RadiusError = -Radius
234.     X = Radius
235.     Y = 0
236.  
237.     If Radius = 0 Then PSet (CX, CY), C: Exit Sub
238.  
239.     ' Draw the middle span here so we don't draw it twice in the main loop,
240.     ' which would be a problem with blending turned on.
241.     Line (CX - X, CY)-(CX + X, CY), C, BF
242.  
243.     While X > Y
244.         RadiusError = RadiusError + Y * 2 + 1
245.         If RadiusError >= 0 Then
246.             If X <> Y + 1 Then
247.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
248.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
249.             End If
250.             X = X - 1
251.             RadiusError = RadiusError - X * 2
252.         End If
253.         Y = Y + 1
254.         Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
255.         Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
256.     Wend
257. End Sub
258.  
259.  

[bplus]

OK added inverse[posInteger,numberOfDecimalPlaces] to custom design answers to division problems in case 100 decimal places (for extended math Divide) is just not enough! LOL

Tested with STxNumber whose inverse is the first 100 terms or so of Fibonacci Series.

Code: [Select]

' Test oh ar STx famous number to invert.txt 2021-03-16 need line 9 number in clipboard for line 2 to work.
' Update this test with the new inverse[PosInteger,NumberOfDecimalPlaces]

' copy paste STx number 23-9's, 1-8, 24-9's
STxNumber = 999999999999999999999998999999999999999999999999
. STxNumber to find inverse that equals first 100 plus terms of Fibonacci Series:
. STxNumber
.
. And drum roll.... the inverse is:
Fibonacci = inverse[STxNumber,4000]
. Fibonacci
.
. What do ya say we determine just exactly how many terms we have?

zzz
end

Looks good!