|
Post by bplus on May 9, 2021 18:09:19 GMT -5
Hi aurel and johnno56 I saw this: rcbasic.freeforums.net/thread/541/who-free-time-borrowand checked out code on QB64 'from Lauwerier H., 1991. "Fractals Images of Chaos" Penguin 209p. 'Orbits of Henon's Quadratic System 'Name: HENON Screen 12, 0, 0, 0: Cls: Randomize 1 Color 15: Locate 1, 1: Print "Orbits of Henon's quadratic system" For k = 1 To 20 cc = k Mod 8: Color cc + 8 x = -.4 + Rnd: y = -.4 + Rnd Window (-1.6, -1.2)-(1.6, 1.2) a = .24: b = Sqr(1 - a ^ 2) For n = 1 To 500 PSet (x, y) z = x: x = x * a - (y - x * x) * b y = z * b + (y - z * z) * a If (Abs(x) + Abs(y)) > 10 Then GoTo 130 Next n 130 Next k Beep: Color 2: a$ = Input$(1): System
Ran fine even after removed all but one line number. see attached Window just changes the coordinate system. In the above: x ranges from -1.6 to 1.6 and y from -1.2 to 1.2 so -1.6, -1.2 is top left corner of screen and 1.6, 1.2 bottom right of screen. Internally all the graphics map to new coordinates set by the Windows command.
|
|
aurel
Full Member
Posts: 227
|
Post by aurel on May 9, 2021 23:43:15 GMT -5
I have problems with coordinates and with drawing just one object in 500 iterations...yes that is crazy and something is awkward in this code so is not easy translate logic to another dialect
B+ Can you draw this in oh Interpreter ?
|
|
aurel
Full Member
Posts: 227
|
Post by aurel on May 10, 2021 13:08:21 GMT -5
Just finished Henon fractal with a help of Specbas dude Paul D yes Paul put me in right direction with scaling ...
|
|
|
Post by bplus on May 10, 2021 15:02:42 GMT -5
I have problems with coordinates and with drawing just one object in 500 iterations...yes that is crazy and something is awkward in this code so is not easy translate logic to another dialect B+ Can you draw this in oh Interpreter ?OH! I see what you want now, yeah I could do it on oh. oh's screen is 1024 x 672 (42 rows X 16 pixels per) so would need scaling for pixel placement I would write a quick formula for converting an x from the calcs to an x to pset ( the same for y of course) So lets see x range -1.6 to 1.6 that's 3.2 spread to 1024 pixels but 0 is in middle pixel 512 if x >= 0 then psetX = x * (512/1.6) + 512 else psetX = 512 + (x) * (512/1.6) end if and similar calc for psetY. But looks D has you setup already. Update: that is same formula for psetX so dont need IF Block
|
|
|
Post by bplus on May 10, 2021 16:26:42 GMT -5
I have problems with coordinates and with drawing just one object in 500 iterations...yes that is crazy and something is awkward in this code so is not easy translate logic to another dialect B+ Can you draw this in oh Interpreter ?Yes and after I got it working I made some mods for better looking drawing (I think): ' Test oh Aurel Henon code b+ 2021-05-10
'from Lauwerier H., 1991. "Fractals Images of Chaos" Penguin 209p. 'Orbits of Henon's Quadratic System 'Name: HENON
'Screen 12, 0, 0, 0: Cls: Randomize 1 'Color 15: Locate 1, 1: Print "Orbits of Henon's quadratic system" Paper 0;0;0 Ink 255;255;255 cls . Orbits of Henon's quadratic system
' For k = 1 To 20 k = 0 [ k = a[k,1] jmp gt[k,100] 'cc = k Mod 8: Color cc + 8 ' this worst part I use RGB[A] cc = m[k,8] if eq[cc,0] ink 128;64;64;64 ei eq[cc,1] ink 0;0;255;64 ei eq[cc,2] ink 0;128;0;64 ei eq[cc,3] ink 0;128;64 ei eq[cc,4] ink 255;0;0;64 ei eq[cc,5] ink 128;0;128;64 ei eq[cc,6] ink 255;255;0;64 ei eq[cc,7] ink 255;255;255;64 fi 'x = -.4 + Rnd: y = -.4 + Rnd 'Window (-1.6, -1.2)-(1.6, 1.2) x = a[-.4,rnd[1]] y = a[-.4,rnd[1]] 'a = .24: b = Sqr(1 - a ^ 2) a = .24 b = sqr[s[1,p[a,2]]] 'For n = 1 To 500 n = 0 [ n = a[n,1] jmp gt[n,1500] 'if x >= 0 then ' oh same formula dont need if Block 'psetX = x * (512/1.6) + 512 'else 'psetX = 512 + (x) * (512/1.6) 'end if psetX = a[512,x[x,d[512,1.6]]] psetY = a[336,x[y,d[336,1.2]]] 'PSet (x, y) fcirc psetX;psetY;1 'z = x: x = x * a - (y - x * x) * b z = x x = s[x[x,a],x[b,s[y,p[x,2]]]] 'y = z * b + (y - z * z) * a y = a[x[z,b],x[a,s[y,p[z,2]]]] 'If (Abs(x) + Abs(y)) > 10 Then GoTo 130 jmp gt[a[abs[x],abs[y]],10] 'Next n ] '130 Next k ] 'Beep: Color 2: a$ = Input$(1): System beep zzz
Really nice that oh can keep up, though translating code is a challenge!
|
|
aurel
Full Member
Posts: 227
|
Post by aurel on May 10, 2021 17:13:40 GMT -5
Yes your produced fractal is really better . I dont know ..do you see such a fractal with moving outisde parts i see is somewhere ,i think that PaulDunny made it ,translated from somewhere. Yes mark translation can be tricky ...i will investigate your version ...
|
|
|
Post by bplus on May 10, 2021 18:26:09 GMT -5
Yeah that fractal looks like a single case of Mira which has way more variety" 'Mira.bas for QB64 Fork (B+=MGA) 2017-05-01 from: 'Mira.bas for SmallBASIC 0.12.8 [B+=MGA] update 2017-02-20
''update Mira fractals from SmallBASIC '' Martin Latter '' Converted to SB from my old 1992 version in Archimedes BASIC '' - SB and modern computers thankfully plot a bit faster.
'In most Mira all the interesting stuff happens immediately.
'This code will stay with one display until you press a key
Randomize Timer
Const xmax = 1200, ymax = 700 Const xc = xmax / 2 Const yc = ymax / 2 Const dots = 10000 'for one round on Mira
Screen _NewImage(xmax, ymax, 32) _Title "Mira fractal classic translated to QB64 Fork by bplus"
Dim ca(Int(dots / 100)) As _Unsigned Long 'for color array Dim a, b, c, x, y, z, j As Double 'fractal calcs Dim xp, yp, red, green, blue As Integer 'screen x, y and color r, g, b
While 1 'set round a = Rnd b = Rnd * .008 + .993 'originally held const .9998 c = 2 - 2 * a x = 0 j = 0 y = Rnd * 12 + .1
'set palette (originally only 6 colors) For pc = 0 To Int(dots / 100) red = Int(Rnd * 2) * (Rnd * 195 + 60) green = Int(Rnd * 2) * (Rnd * 195 + 60) blue = Int(Rnd * 2) * (Rnd * 195 + 60) ca(pc) = _RGB(red, green, blue) Next
'the outer loop here waits for keypress to move out to new mira Color _RGB(0, 255, 255) Print "Start: a = "; a; " b = "; b; " Use the spacebar to toggle next random screen scene..." While _KeyHit <> 32 _Limit 60 For i = 0 To dots z = x x = b * y + j j = a * x + c * (x ^ 2) / (1 + x ^ 2) y = j - z xp = (x * 20) + xc yp = (y * 20) + yc Color ca(Int(i / 100)) PSet (xp, yp) Next _Display Wend Cls Wend
And even your Hop-Along was more varied. _Title "Glitter Hopalong, any key quits" 'trans from SmallBASIC 2020-04-09 'Glitter hopalong.bas SmallBASIC 2015-05-04 modified for Bpf, B+ ' color changes for the night shift
Const xmax = 1200, ymax = 700 Screen _NewImage(xmax, ymax, 32) _Delay .25 _ScreenMove _Middle
xoffs = xmax * 5 / 12 yoffs = ymax * 5 / 12 Do Cls j = Rnd * 100 k = Rnd * 100 x = 0: y = 0: r = 0: n = 0 For i = 1 To 10000000 r = Rnd * 4000 If r > 3997 Then Color qb(Int(Rnd * 15) + 1) xx = y - Sgn(x) * Sqr(Abs(k * x - 1)) y = j - x x = xx xp = x * 3 + xoffs yp = y * 3 + yoffs Circle (xp, yp), 1 Next i _Delay 1 Loop Until Len(InKey$)
Function qb~& (n As Integer) Select Case n Case 0: qb~& = &HFF000000 Case 1: qb~& = &HFF000088 Case 2: qb~& = &HFF008800 Case 3: qb~& = &HFF008888 Case 4: qb~& = &HFF880000 Case 5: qb~& = &HFF880088 Case 6: qb~& = &HFF888800 Case 7: qb~& = &HFFCCCCCC Case 8: qb~& = &HFF888888 Case 9: qb~& = &HFF0000FF Case 10: qb~& = &HFF00FF00 Case 11: qb~& = &HFF00FFFF Case 12: qb~& = &HFFFF0000 Case 13: qb~& = &HFFFF00FF Case 14: qb~& = &HFFFFFF00 Case 15: qb~& = &HFFFFFFFF End Select End Function
My own name for this is "The Scream" after that famous painting stolen in Europe. en.wikipedia.org/wiki/The_Scream
|
|
aurel
Full Member
Posts: 227
|
Post by aurel on May 11, 2021 1:45:26 GMT -5
I have Mira patterns in micro(A) but i mean on something else with moving inner contures like in ameba shape shifting like i show on image look into wite arrows, like a animation...that is what i am talking about
|
|
aurel
Full Member
Posts: 227
|
Post by aurel on May 11, 2021 1:58:00 GMT -5
B+ main trick i made is to increase variable iterator k by 0.1 not by 1 and i get this result in micro(A) 'from Lauwerier H., 1991. "Fractals Images of Chaos" Penguin 209p.
'Orbits of Henon's Quadratic System
var k,a,b,n,x,y,z,red,green,blue,abx,aby,abxy,px,py
wcolor 0, 0, 0
fcolor 150,150,180: print 10,440, "Orbits of Henon's quadratic system"
k= 1
'For k = 1 TO 20
while k < 20
red=rand(220)+8: green=rand(220)+8 :blue=rand(220)+8
x = -0.4 + rnd(1) : y = -0.4+ rnd(1)
a = 0.24: b = sqr(1-a^2)
n=1
while n < 500
' red=rand(8)+220: green=rand(8)+220 :blue=rand(8)+220
px=x*200+320 : py =y*200+240
fcolor red,green,blue :pset px,py
z = x
x = x * a - (y-x * x) * b
y = z * b + (y-z * z) * a
abx=abs(x) : aby=abs(y) : abxy = abx + aby
if abxy > 10 : goto continue : endif
'rect 8,398,80,24:print 10,400,n
n=n+1
wend
label continue
k=k+0.1
swap
wend
|
|
|
Post by bplus on May 11, 2021 10:25:56 GMT -5
aurel OK I see you are also choosing Rnd RGB color for each orbit as well, more variety. OK I will try stepping k by .1, if that is better then maybe .05 or .01?
|
|
|
Post by bplus on May 11, 2021 10:48:56 GMT -5
I stepped k down to .0001 and now you can see ameba pretty clearly 'from Lauwerier H., 1991. "Fractals Images of Chaos" Penguin 209p. 'Orbits of Henon's Quadratic System 'Name: HENON Screen _NewImage(1024, 672, 32) _Delay .25 'wait for screen to load before cenetering _ScreenMove _Middle Randomize Timer Print "Orbits of Henon's quadratic system" For k = 1 To 20 Step .0001 r = Rnd If r < .25 Then Color _RGB32(Rnd * 200 + 55, 0, 0, 64) ElseIf r < .5 Then Color _RGB32(0, Rnd * 200 + 55, 0, 64) ElseIf r < .75 Then Color _RGB32(0, 0, Rnd * 200 + 55, 64) Else Color _RGB32(Rnd * 200 + 55, Rnd * 200 + 55, Rnd * 200 + 55, 64) 'need brite colors on black background End If x = -.4 + Rnd: y = -.4 + Rnd 'Window (-1.6, -1.2)-(1.6, 1.2) a = .24: b = Sqr(1 - a ^ 2) For n = 1 To 500 Circle (512 + x * 512 / 1.6, 336 + y * 336 / 1.2), 1 ' scale x, y to Window dimensions in commented out line z = x: x = x * a - (y - x * x) * b y = z * b + (y - z * z) * a If (Abs(x) + Abs(y)) > 10 Then GoTo 130 '_Limit 1500 ' this lets me see the shift of dots in direction Aurel mentions on each orbit Next n 130 Next k Beep Sleep
|
|
aurel
Full Member
Posts: 227
|
Post by aurel on May 12, 2021 0:54:30 GMT -5
Yes B+ I see it ,but now i am wondering why is colors on my image brighter and better than on yours..hmmm it looks that GDI works better with colors than SDL or GL what qb64 use . But effect of pulsating in your example is great ..
|
|
|
Post by bplus on May 12, 2021 12:34:46 GMT -5
Yes B+ I see it ,but now i am wondering why is colors on my image brighter and better than on yours..hmmm it looks that GDI works better with colors than SDL or GL what qb64 use . But effect of pulsating in your example is great .. Yours are brighter because I tried Alpha at level 64 (it tends to blend into mud with too many overlaps) you will see now that you know what to look for... This has been fun exchange! I like comparing oh to micro(A) I hope to catch up to you with something for Functions & Subs.
|
|
aurel
Full Member
Posts: 227
|
Post by aurel on May 12, 2021 13:49:40 GMT -5
Ahh Functions i already have just Sub-routines called func name(). Currently i would like to have better or improved error checkings which is very important part of any interpreter or compiler , and also i have to add more event-driven messages to add GUI-s in micro(A) ...so for now no local variables in functions
todo list : arrays more string functions some GUI controls sprites...maybe ? Image manipulation and maybe some GDI+ wrappers
|
|
|
Post by bplus on May 12, 2021 14:15:49 GMT -5
Ahh Functions i already have just Sub-routines called func name(). Currently i would like to have better or improved error checkings which is very important part of any interpreter or compiler , and also i have to add more event-driven messages to add GUI-s in micro(A) ...so for now no local variables in functions todo list :arrays more string functions some GUI controls sprites...maybe ? Image manipulation and maybe some GDI+ wrappersOh, I am not so far behind then, I do have syntax checking and thank goodness because of the rude way I make coder decide priority order of math functions LOL also something very much like arrays. and I have GOSUBs that handle recursive calls but alas, no local stuff yet. Frankly I let myself get distracted too easily with forums. I like helping folks get started with programming Basic's any flavor I can help with and those tend to be ones inspired by original QB.
|
|
aurel
Full Member
Posts: 227
|
Post by aurel on May 12, 2021 14:49:05 GMT -5
Yes i know that, and well i just made addition to error checking like this :
If whileCounter > wendCounter MsgBox "WHILE without WEND , check code!","LOOP ERROR" : return 0 End If If wendCounter > whileCounter MsgBox "WEND without WHILE , check code!","LOOP ERROR" : return 0 End If If ifCounter > endifCounter MsgBox "IF without ENDIF , check code!","IF/ENDIF ERROR": return 0 End If If endIfCounter > ifCounter MsgBox "ENDIF without IF , check code!","IF/ENDIF ERROR": return 0 End If If fnCounter > endFnCounter MsgBox "FUNC without ENDFN , check code!","FUNC ERROR" : return 0 End If If endFnCounter > fnCounter MsgBox "ENDFN without FUNC , check code!","FUNC ERROR" : return 0 End If
Looking simple but is practical because everyone can forget some simple things typing ...
|
|
|
Post by bplus on May 12, 2021 14:55:46 GMT -5
Oh Hey! Message boxes! yeah got to put those in I have non API ones I made in QB64 for both Messages and Input that should add a whole K to the code put me somewhere around 3K then
|
|
aurel
Full Member
Posts: 227
|
Post by aurel on May 12, 2021 14:58:04 GMT -5
I don't have GOSUB than just simple name of function with parens ,is a caller like :
myFunc()
func myFunc() print x,y,"name" endFn
Function code is ignored or skiped if is not called.
Arrays..ahh I was thinking about creating array as list (not linked list - to be precise) In fact it is list of specific type, because of that i alredy can use method i made in ruben interpreter. Or i will use method like i see in JImage Interpreter written in Java but very clean code to loook. etc..etc
|
|
aurel
Full Member
Posts: 227
|
Post by aurel on May 12, 2021 15:04:02 GMT -5
In a API way , MessageBox is also very useful for more information and also stop execution of program. I will add it of course...almost trivial to add,i mean very simple without lot of extra coding . well micro(A) have currently 1500 lines of code , and tokenizer have 155 lines of Oxygen Basic code.
|
|
|
Post by bplus on May 12, 2021 16:14:49 GMT -5
In a API way , MessageBox is also very useful for more information and also stop execution of program. I will add it of course...almost trivial to add,i mean very simple without lot of extra coding . well micro(A) have currently 1500 lines of code , and tokenizer have 155 lines of Oxygen Basic code. Oops! I meant oh has 2K lines (almost) not bytes, that would be something. So you got me there too, but I have 4 different sorts and a simple file load and save contents to and from array like Astring. Yeah and my array things are more list like than multi-dim, but you can turn any linear array to multi-dim with a little calculation.
|
|