Recent Posts

Pages: 1 ... 8 9 [10]
91
Programs / Re: Benchmark_01
« Last post by jack on April 10, 2022, 02:51:32 pm »
I meant no offense to you bplus, I know who came up with the code
but if you want to do a benchmark you need to do some computations that can't be optimized out and print the result for verification
92
Programs / Re: Benchmark_01
« Last post by bplus on April 10, 2022, 02:44:58 pm »
Thank you Jack! Keybonic Plague also gets way better time than I with optimized QB64 dev 2.1

I know it's lame I didn't make it up just comparing times with other PL's and Basic's.

So I didn't screw up, it's possible to get under .5 secs.
93
Programs / Re: Benchmark_01
« Last post by jack on April 10, 2022, 02:31:04 pm »
it times at .25 seconds on my PC
but as a benchmark it's lame, a good compiler will eliminate the loop entirely and therefore give a meaningless result
94
Programs / Benchmark_01
« Last post by bplus on April 10, 2022, 01:55:11 pm »
Can someone verify this code is correct and it takes under .5 secs to run, Aurel doesn't believe it.
http://basic4all.epizy.com/index.php?topic=21.0

Code: QB64: [Select]
  1. start = Timer(.001)
  3. For n = 1 To 100000000
  4.     r = n * 2 - Sin(88)
  5. Next n&
  6. Print Timer(.001) - start; "seconds"
  7.  

 
image_2022-04-10_135600031.png


BTW oddly it does better with Double than with Single default.
95
QB64 Discussion / Re: Particle System
« Last post by bplus on April 10, 2022, 01:31:12 pm »
A little translation:
Code: QB64: [Select]
  1. ' 2022-04-10 b+ translation of  http://sdlbasic.epizy.com/showthread.php?tid=235  
  2. ' ***************
  3. ' Particle System
  4. ' ***************
  5. ' maximum number of particles slots
  6. ' lower this to get more fluent effect
  7. maximum = 100
  8.  
  9. ' Each particle has 6 parameters
  10. ' 0 : location on the x-axis
  11. ' 1 : location on the y-axis
  12. ' 2 : movement on the x-axis
  13. ' 3 : movement on the y-axis
  14. ' 4 : how old the particle can get
  15. ' 5 : period where particle keeps the same color
  16. Dim particle(maximum, 6)
  17.  
  18. ' ******************************
  19. ' Boiler plate for a nice canvas
  20. ' ******************************
  21. 'setDisplay(700, 400, 32, 1)
  22. Screen _NewImage(700, 400, 32)
  23. f& = _LoadFont("Arial.ttf", 40) ' everyone has arial?
  25.  
  26. 'setCaption("Particles Example")
  27. _Title "Particles Example"
  29. 'autoback(-2)
  30. 'hidemouse
  33. Dim As _Unsigned Long darkred, red, orange, yellow, white
  34. darkred = _RGB32(128, 0, 0)
  35. red = _RGB32(255, 0, 0)
  36. orange = _RGB32(255, 128, 0)
  37. yellow = _RGB32(255, 255, 0)
  38. white = _RGB32(255, 255, 255)
  39.  
  40. ' *************************************************
  41. ' pre-cache sin/cos calculations (small speed gain)
  42. ' *************************************************
  43. Dim degree(361, 2)
  44. pi = 3.141592654
  45. k = 0
  46. For i = 0 To 2 * pi Step (2 * pi / 359)
  47.     k = k + 1
  48.     degree(k, 0) = Sin(i)
  49.     degree(k, 1) = Cos(i)
  51.  
  52. 'initialize text
  53. text_count = 0
  54. t1$ = "Particles Example"
  55. t2$ = "( Cool, isn't it? )"
  56. t3$ = "(   useless too  )"
  57. t4$ = t2$
  58. sw_text = 0
  59.  
  60. ' *************************************************
  61. ' initial particle definition: all particles 'dead'
  62. ' *************************************************
  63. For i = 0 To maximum - 1
  64.     particle(i, 4) = 0
  66.  
  67. '**************************************************
  68. ' main loop
  69. '**************************************************
  70. While _KeyDown(27) = 0
  71.     Cls
  72.     ' create new particles
  73.     ' ********************
  74.     ' select 7 random particles at each cycle
  75.     ' play with this value to get the best result on your computer
  76.     For k = 1 To 7
  77.         spawni = rand(maximum)
  78.  
  79.         ' if age of the random particle = 0, create one
  80.         If particle(spawni, 4) = 0 Then
  81.  
  82.             ' horizontal location
  83.             If rand(100) / 100 > 0.5 Then
  84.                 particle(spawni, 0) = 20
  85.                 lings = 1
  86.             Else
  87.                 particle(spawni, 0) = 660
  88.                 lings = 0
  89.             End If
  90.  
  91.             ' vertical location
  92.             particle(spawni, 1) = 350
  93.             direction = rand(35) + 157
  94.  
  95.             ' horizontal speed vector
  96.             If lings = 1 Then
  97.                 particle(spawni, 2) = rand(6)
  98.             Else
  99.                 particle(spawni, 2) = 0 - (rand(6))
  100.             End If
  101.  
  102.             ' falling speed vector
  103.             particle(spawni, 3) = (0 - rand(6)) - 5
  104.  
  105.             ' particle age
  106.             particle(spawni, 4) = 30 + rand(50)
  107.  
  108.             ' color aging
  109.             particle(spawni, 5) = particle(spawni, 4) / 5
  110.         End If
  111.     Next
  112.  
  113.     ' update position on ALL live particles
  114.     ' *************************************
  115.     For i = 0 To maximum - 1
  116.  
  117.         ' for all live particles
  118.         If particle(i, 4) > 0 Then
  119.  
  120.             ' calculate the new location
  121.             particle(i, 0) = particle(i, 0) + particle(i, 2)
  122.             particle(i, 1) = particle(i, 1) + particle(i, 3)
  123.  
  124.             ' increase the speed of falling
  125.             particle(i, 3) = particle(i, 3) + (rand(100) / 100) / 3
  126.  
  127.             ' make the particle older
  128.             particle(i, 4) = particle(i, 4) - 1
  129.  
  130.             ' if it hits the bottom, make it bounce up
  131.             ' 0=no bounce, 1= full bounce,no damping
  132.             If particle(i, 1) > 370 Then
  133.                 particle(i, 3) = -particle(i, 3) * ((rand(100) / 100) / 2)
  134.             End If
  135.         End If
  136.     Next
  137.  
  138.     ' Color determination of the particle
  140.     '************************************
  141.     For i = 0 To maximum - 1
  142.  
  143.         ' for all live particles
  144.         If particle(i, 4) > 0 Then
  145.  
  146.             ' color it darkred if less than 20% life left
  147.             If particle(i, 4) < particle(i, 5) Then
  148.                 k = darkred
  149.             End If
  150.  
  151.             ' color it red if more than 20% life left
  152.             If particle(i, 4) > (particle(i, 5)) Then
  153.                 k = red
  154.             End If
  155.  
  156.             ' color it orange if more than 40% life left
  157.             If particle(i, 4) > (particle(i, 5) * 2) Then
  158.                 k = orange
  159.             End If
  160.  
  161.             ' color it yellow if more than 60% life left
  162.             If particle(i, 4) > (particle(i, 5) * 3) Then
  163.                 k = yellow
  164.             End If
  165.  
  166.             ' color it white if more than 80% life left
  167.             If particle(i, 4) > (particle(i, 5) * 4) Then
  168.                 k = white
  169.             End If
  170.  
  171.  
  172.             '----------------------------
  173.             ' PLOT ALL THE LIVE PARTICLES
  174.             '----------------------------
  175.  
  176.  
  177.             '--- circles ---
  178.             'circle(particle(i,0), particle(i,1), 2+rand(4))
  179.             '--- filled circles ---
  180.             'fillcircle(particle(i,0), particle(i,1), 2+rand(4))
  181.             '--- squares ---
  182.             'polyline(particle(i,0), particle(i,1), particle(i,0)+6, particle(i,1), particle(i,0)+6, particle(i,1)+6, particle(i,0), particle(i,1)+6, particle(i,0), particle(i,1))
  183.             '--- stars ---
  184.             'polyline(particle(i,0)+4, particle(i,1), particle(i,0)+8, particle(i,1)+12, particle(i,0), particle(i,1)+4, particle(i,0)+12, particle(i,1)+4, particle(i,0)+2, particle(i,1)+12)
  185.              star particle(i, 0), particle(i, 1), 8, 20, 5, 90, k
  186.             '--- polygon seems to 'lock-up' ---
  187.             'polygon(particle(i,0), particle(i,1), particle(i,0)+6, particle(i,1), particle(i,0)+6, particle(i,1)+6, particle(i,0), particle(i,1)+6, particle(i,0), particle(i,1))
  188.             '--- filled squares ---
  189.             'bar(particle(i,0), particle(i,1), particle(i,0)+2+rand(4), particle(i,1)+2+rand(4))
  190.  
  191.         End If
  192.     Next
  193.  
  194.     Color _RGB32(255, 255, 255)
  195.     _PrintString (190, 140), t1$
  196.     Color _RGB32(0, 0, 255)
  197.     _PrintString (192, 142), t1$
  198.     If text_count < 300 Then
  199.         'Text 223, 180, 24, t4$, &HFFFF0000
  200.         Color _RGB32(255, 255, 255)
  201.         _PrintString (213, 190), t4$
  202.         Color _RGB32(255, 0, 0)
  203.         _PrintString (215, 192), t4$
  204.         text_count = text_count + 1
  205.     Else
  206.         If sw_text = 1 Then
  207.             t4$ = t3$
  208.             sw_text = 0
  209.         Else
  210.             t4$ = t2$
  211.             sw_text = 1
  212.         End If
  213.         text_count = 0
  214.     End If
  215.     _Display
  216.     _Limit 10
  218.  
  219. Function rand% (n)
  220.     rand% = Int((n + 1) * Rnd)
  222.  
  223. Sub star (x, y, rInner, rOuter, nPoints, angleOffset, K As _Unsigned Long)
  224.     ' x, y are same as for circle,
  225.     ' rInner is center circle radius
  226.     ' rOuter is the outer most point of star
  227.     ' nPoints is the number of points,
  228.     ' angleOffset = angle offset IN DEGREES, it will be converted to radians in sub
  229.     ' this is to allow us to spin the polygon of n sides
  230.     Dim pAngle, radAngleOffset, x1, y1, x2, y2, x3, y3, i As Long
  231.  
  232.     pAngle = _D2R(360 / nPoints): radAngleOffset = _D2R(angleOffset)
  233.     x1 = x + rInner * Cos(radAngleOffset)
  234.     y1 = y + rInner * Sin(radAngleOffset)
  235.     For i = 0 To nPoints - 1
  236.         x2 = x + rOuter * Cos(i * pAngle + radAngleOffset + .5 * pAngle)
  237.         y2 = y + rOuter * Sin(i * pAngle + radAngleOffset + .5 * pAngle)
  238.         x3 = x + rInner * Cos((i + 1) * pAngle + radAngleOffset)
  239.         y3 = y + rInner * Sin((i + 1) * pAngle + radAngleOffset)
  240.         ftri x1, y1, x2, y2, x3, y3, K
  241.         'triangles leaked
  242.         Line (x1, y1)-(x2, y2), K
  243.         Line (x2, y2)-(x3, y3), K
  244.         Line (x3, y3)-(x1, y1), K
  245.         x1 = x3: y1 = y3
  246.     Next
  247.     Paint (x, y), K, K
  249.  
  250. '2019-12-16 fix by Steve saves some time with STATIC and saves and restores last dest
  251. Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
  252.     Dim D As Long
  253.     Static a&
  254.     D = _Dest
  256.     If a& = 0 Then a& = _NewImage(1, 1, 32)
  257.     _Dest a&
  258.     _DontBlend a& '  '<<<< new 2019-12-16 fix
  259.     PSet (0, 0), K
  260.     _Blend a& '<<<< new 2019-12-16 fix
  261.     _Dest D
  262.     _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
  264.  
  265. 'Sub Text (x, y, textHeight, txt$, k As _Unsigned Long)
  266. '    Dim fg As _Unsigned Long, cur&, I&, multi, xlen
  267. '    fg = _DefaultColor
  268. '    'screen snapshot
  269. '    cur& = _Dest
  270. '    I& = _NewImage(8 * Len(txt$), 16, 32)
  271. '    _Dest I&
  272. '    Color k
  273. '    _PrintString (0, 0), txt$
  274. '    multi = textHeight / 16
  275. '    xlen = Len(txt$) * 8 * multi
  276. '    _PutImage (x, y)-Step(xlen, textHeight), I&, cur&
  277. '    Color fg
  278. '    _FreeImage I&
  279. 'End Sub
  280.  
  281.  
96
Programs / Selecting a folder (a little vbs function)
« Last post by euklides on April 10, 2022, 10:54:15 am »
Little function to select a folder with VBS
(win systems)
Code: QB64: [Select]
  1. MYREP$ = REPSELECTOR$("D:"): Print MYREP$
  2. MYREP$ = REPSELECTOR$(""): Print MYREP$: Sleep
  4.  
  5. Function REPSELECTOR$ (repertoiredemarrage$)
  6.     Repz$ = repertoiredemarrage$:  FS2$ = Chr$(13) + Chr$(10)
  7.     fs1$ = "Dim objFolder, objItem, objShell" + FS2$
  8.     fs1$ = fs1$ + "On Error Resume Next" + FS2$
  9.     fs1$ = fs1$ + "SelectFolder = vbNull" + FS2$
  10.     fs1$ = fs1$ + "myStartFolder = " + "²" + Repz$ + "²" + FS2$
  11.     fs1$ = fs1$ + "Set objShell  = CreateObject( ²Shell.Application² )" + FS2$
  12.     fs1$ = fs1$ + "Set objFolder = objShell.BrowseForFolder( 0, ²Select Folder², 0, myStartFolder )" + FS2$
  13.     fs1$ = fs1$ + "If IsObject( objfolder ) Then SelectFolder = objFolder.Self.Path" + FS2$
  14.     fs1$ = fs1$ + "Set WshShell = WScript.CreateObject(²WScript.Shell²)" + FS2$
  15.     fs1$ = fs1$ + "WshShell.Run ²cmd.exe /c echo ² & SelectFolder & ² | clip², 0, TRUE   " + FS2$
  16.     FS5: J = InStr(fs1$, "²"): If J > 0 Then Mid$(fs1$, J, 1) = Chr$(34): GoTo FS5
  17.     ficvbs$ = _CWD$ + "\TEMP_FS.vbs": CanalLibre% = FreeFile: Open ficvbs$ For Output As CanalLibre%
  18.     Print #1, fs1$: Close CanalLibre%: _Delay 0.1:
  19.     Shell ficvbs$: Kill ficvbs$
  20.     REPSELECTOR$ = _Clipboard$
  22.  
97
Programs / Re: ascII almost smooth pixel scroll
« Last post by PMACKAY on April 10, 2022, 09:56:42 am »
its supposed to show junk. was just a test to smooth scroll the screen. the random was just to show you can print to the screen easy using a similar routine. you can all do as you wish this. it was me messing about as i like to play around making stuff up.

you can change the screen size and size of the scroll quiet easy to make a maze game or ascii side scroller.  not difficult to convert to vertical

Screen _NewImage(40 * 8, 28 * 16, 256) and have it draw a box around the outside and paint it. that will give a border like a commodore64

you can change the font if you want also

screendata$(1) to screendata$(24) : just put in the data what you want eg. screendata$(?) = "your maze data". you can make a maze that you walk through but your man goes up and down why your scrolls in the direction you press make the map roll around and the maze harder.

you could make it draw a map and move monsters around like a PAC man why you gobble dots on a full rotating map. maybe remap the ASCII characters and print monsters chasing you. could maybe dig holes for monsters to fall in so you could run back over them but only dig a hole every 10 seconds. just a thought

it could be made to run much better but I like it.

everyone is right it is showing garbage. its on purpose as a demo. the random print of "/" is to show you how to locate x,y:print "whatever" as the screen updates on a timer. no need to print print:
98
QB64 Discussion / Re: Particle System
« Last post by _vince on April 10, 2022, 09:38:24 am »
Quote from: bplus on April 10, 2022, 07:57:09 am
Found it:
http://sdlbasic.epizy.com/showthread.php?tid=235

Here is a simple particle system that I converted from Basic256. It has a lot of comments that explain what each step does.

Note: On my machine, the 'polygon' command, causes sdlbasic to freeze. SetPixel, Bar, fillcircle and Ployline all work just fine.

Wow, what is Basic256!?  There's a successor to ModernBASIC 128?
99
QB64 Discussion / Re: Particle System
« Last post by bplus on April 10, 2022, 07:57:09 am »
Found it:
http://sdlbasic.epizy.com/showthread.php?tid=235

From 6 years ago!

You call the properties parameters here, OK :)

Oh come to think of it, I think you mentioned losing your computer and a bunch of old work. Well that link is to fine Particle System you did.
100
QB64 Discussion / Re: Particle System
« Last post by bplus on April 10, 2022, 07:45:00 am »
@johnno56

This surprises me! You've done particle systems way back at SdlBasic, just fine!

You probably would like to do them with an array for each... I don't know what to call them Property? is the VB term, characteristic? oh what are they called?!

You could setup an UDT for them like this:
Type Particle
    As Single x, y, dx, dy, life, active
    As _unsigned Long colr
end Type
nParticles = 100
Dim Shared parts(nParticles) as Particle

or do it the old fashioned way
dim x(nParticles), y(nParticles), dx(nParticles), dy(nParticles), life(nParticles), active(nParticles)
dim as _unsigned long colr(nParticles)

Then it's good to have a Sub for creating a new particle depends on your app what to do
Sub NewParticle(index) 'where index is for the shared array Parts
     ' setup Parts(index) for you app here
end sub

I could probably dig up some of your code from SdlBasic for doing particles :)



Pages: 1 ... 8 9 [10]