Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Messages - AndyA

Pages: [1] 2 3 ... 5
1
Programs / Re: Petri Dish
« on: October 03, 2021, 09:27:08 pm »
Hi Dav,

Thanks for the nice comment, glad it worked well for you.

I had too much fun working on that little program. I'm working my way up to using the GUI features in another program I'm working on.

2
Programs / Re: Pipes Puzzle v1.0 (was MazeConnect Prototype)
« on: October 03, 2021, 09:23:43 pm »
Hi. Nice game.

I only had the patience to make it to level 6. Will probably finish it at a later date.

Here's a suggestion for when the level is completed.

Create  a screen the size of the  "You did it" message called 'msg" for instance. Just be sure to use an _Unsigned Long to declare the 'msg' variable. Then the "You did it" msg could be drawn at let's say 50% transparency. Use _RGBA(0,0,128,128) as that's a 50% transparent blue. Set _Dest to 'msg' (or _Source, forget which is which), then issue a Line (0,0)-(x, y), msg, BF. That creates a blue filled box in memory at alpha 50%. Do the same for the text at alpha 70%. (Int(0.7 * 255))

_PutImage (x, y), msg, 0 and Voila! A see through "You did it" message.




3
Programs / Re: Petri Dish
« on: October 03, 2021, 08:43:43 pm »
Hi johnno56.

You're trigger finger might have something to shoot at if the critters were larger.  As it is now, it's like shooting a 155mm Howitzer at a mosquito. Yes it will get the job done, it you can find/see the beastie.

As to the other software, it's good old (no longer developed) BlitzPlus basic. The only advantage that BlitzPlus still has over many other languages, are the built in GUI gadgets (buttons, list boxes, radio buttons, text boxes, etc) just like those seen in Windows apps. As noted, BlitzPlus basic is also very fast.

There's always JustBasic that has many GUI features, but is sooooo muuuuch slower. In the end it's more like an interpreter speed wise, vs a truly compiled language.

4
Programs / Re: Petri Dish
« on: October 03, 2021, 12:02:52 pm »
Hi johnno56!

Thanks for the comment.

The double opening of the HTML is probably caused by QB64 being so fast in polling. QB64 processed the first click, and before you could release the mouse button, it processed another click. I think if you increase the delay time a small amount, it will eliminate opening two HTML's.

The QB64 version is tied as the fastest DLA generator I've ported.


5
Programs / Re: Petri Dish
« on: October 02, 2021, 09:53:40 pm »
Hi bplus!

It Diffusion Limited Aggregation just like the kelp. This time it's a circular DLA. It's trickier to do the circular thing, but basically the same Brownian Motion behind the scenes. The thing I like is that it's very fast to complete compared to other languages. I first saw this years ago on Paul Bourke's web site, and even made my own, but it was slow and not optimized at all. Much better results this time.

I also made ports to JB, sdlBasic and BlitzPlus basic. Nearly identical UI's but vastly different results in speed. QB64 and BlitzPlus being the fastest versions.



6
Programs / Petri Dish
« on: October 02, 2021, 04:42:50 pm »
Hi everyone!

I made a nerdy little program that just grew in feature creep. I just made if for myself to see some 'Brownian Motion' plots. And then it just  started to grow! So now's it a full blown app with a GUI. It's still a nerdy program, but it has many features.

You can generate plots, save and load plot data to disk, change the colors that are used in a plot, and save a plot to a bmp. You can also bring up the 'Petri Dish walk through' html file from the program.

And last, but not least, you can change the color theme of the GUI in the source code. There's a   commented line that allows you to change a single number for a different GUI theme color. Yeah, I could have made it change colors by a single button press, but once you find the one you like best (or find the least objectionable), you probably won't change the color theme afterwards.






7
Programs / Re: Voronoi Diagrams with points and region outlines
« on: April 24, 2021, 07:16:39 pm »
Here's a well known Van Gogh




8
Programs / Re: 2D Physics Engine
« on: April 22, 2021, 05:00:21 pm »
Games like moto-cross, mario kart would be much easier with joints. For simple games with low poly counts (like billiards or pinball) the arrays seem like more than  enough to keep track of everything.

At any rate I'll be keeping an eye on your progress, as this would be a very nice addition to something like the 'QB64 tool box' (where SUBs/Functions and libraries) are posted for others to utilize. Whatever you do would be great as I haven't seen any physics engine on this board. So many possible applications for physics base simulations and such.

9
Programs / Re: 2D Physics Engine
« on: April 22, 2021, 02:51:42 pm »
That's a very well done physics engine!

I got between 90 and 200 FPS, it flickered so quickly, it was hard to read.

What method of indexing the objects did you use, a hash table or linked list? Maybe a blend of the two methods.

I looked at the code, but since I haven't use either, it kind of went over my head.

Oh well, maybe you could give a quick overview of how you keep track of everything.

It seems that this 2D physics engine could handle many different types of applications. Angry Birds, pinball, pachinko, etc. 


10
Programs / Re: Voronoi Diagrams with points and region outlines
« on: April 22, 2021, 01:48:35 am »
That's a good start, but the real speed up is storing the distances in dist(x,y) array. Without that you have the same Voronoi code as any other solution. Which is why the the time taken to calc the diagram scales up nearly linearly using the dist(x,y) array, as the distances are calculated one time only.

11
Programs / Re: Voronoi Diagrams with points and region outlines
« on: April 19, 2021, 04:56:21 pm »
It's the same as the code posted on Rosetta. It just has the points and the outlines tacked on, which is more code, but time difference is negligible.

12
Programs / Voronoi Diagrams with points and region outlines
« on: April 19, 2021, 03:42:14 pm »
Here's the code I should have posted. It shows the point locations and region outlines.


Code: QB64: [Select]
  1. _Title "Voronoi Diagram [RC]"
  2.  
  3. Dim As Integer sites, xEdge, yEdge, i, x, y, nearest, startX, startY, endY
  4. Dim As Double startTime
  5.  
  6. '=====================================================================
  7. ' Changes number of sites and screen size here
  8. '=====================================================================
  9. sites = 100
  10. xEdge = 700
  11. yEdge = 700
  12. '=====================================================================
  13.  
  14. Screen _NewImage(xEdge, yEdge, 32)
  16. _ScreenMove (_DesktopWidth - xEdge) \ 2, (_DesktopHeight - (yEdge + 31)) \ 2
  17.  
  18. '_FullScreen _SquarePixels
  20. 'Randomize 0.14159
  21.  
  22. Dim Shared As Integer townX(sites), townY(sites), nearestIndex(xEdge, yEdge)
  23. Dim Shared As Long dist(xEdge, yEdge)
  24. Dim As Long col(sites)
  25.  
  26. For i = 1 To sites
  27.     townX(i) = Int(Rnd * xEdge)
  28.     townY(i) = Int(Rnd * yEdge)
  29.     col(i) = _RGB(Rand(0, 255), Rand(0, 255), Rand(0, 255))
  30.     'col(i) = _RGB32(155 * Rnd + 100, -(Rnd < .5) * 255 * Rnd, -(Rnd < .5) * 255 * Rnd)
  32.  
  33. startTime = Timer(.001)
  34. 'fill distance table with squared distances from the first site
  35. For x = 0 To xEdge - 1
  36.     For y = 0 To yEdge - 1
  37.         'store the distance squared between sites in dist() array to avoid SQR()
  38.         dist(x, y) = (townX(1) - x) * (townX(1) - x) + (townY(1) - y) * (townY(1) - y)
  39.         nearestIndex(x, y) = 1
  40.     Next
  42.  
  43. 'for all the other sites
  44. For i = 2 To sites
  45.     endY = yEdge - 1
  46.     'check left side
  47.     For x = townX(i) To 0 Step -1
  48.         If (checkRow(i, x, endY)) = 0 Then Exit For
  49.     Next x
  50.     'check right side
  51.     For x = townX(i) + 1 To xEdge - 1
  52.         If (checkRow(i, x, endY)) = 0 Then Exit For
  53.     Next
  55.  
  56. 'fill in region colors and draw region outlines
  57. For y = 0 To yEdge - 1
  58.     For x = 0 To xEdge - 1
  59.         startX = x
  60.         nearest = nearestIndex(x, y)
  61.         For x = x + 1 To xEdge
  62.             If nearestIndex(x, y) <> nearest Then x = x - 1: Exit For
  63.         Next
  64.         Line (startX, y)-(x + 1, y), col(nearest)
  65.         'draw region outline x locations
  66.         PSet (startX, y), &HFF000000
  67.         PSet (x + 1, y), &HFF000000
  68.     Next
  70.  
  71. For x = 0 To xEdge - 1
  72.     For y = 0 To yEdge - 1
  73.         startY = y
  74.         nearest = nearestIndex(x, y)
  75.         For y = y + 1 To yEdge
  76.             If nearestIndex(x, y) <> nearest Then y = y - 1: Exit For
  77.         Next
  78.         'draw region outline y locations
  79.         PSet (x, startY), &HFF000000
  80.         PSet (x, y + 1), &HFF000000
  81.     Next
  83.  
  84. showSites = 1
  85. If showSites = 1 Then
  86.     'show the original random sites after regions are filled
  87.     'Draw a 4 pixel circle at each of the random points in px(), py() arrays
  88.     For i = 1 To sites
  89.         Call CircleFill(townX(i), townY(i), 2, &HFF000000)
  90.     Next
  91.     Line (0, 0)-(xEdge - 1, yEdge - 1), &HFF000000, B
  93.  
  94.  
  95. Color &HFFFFFFFF
  96. Print "ET: "; Using "#####.###"; (Timer - startTime) * 1000
  99.  
  100. Function checkRow (site%, x, endY)
  101.     dxSquared& = (townX(site%) - x) * (townX(site%) - x)
  102.     For yt% = 0 To endY
  103.         dSquared& = (townY(site%) - yt%) * (townY(site%) - yt%) + dxSquared&
  104.         If dSquared& <= dist(x, yt%) Then
  105.             dist(x, yt%) = dSquared&
  106.             nearestIndex(x, yt%) = site%
  107.             checkRow = 1
  108.         End If
  109.     Next
  111.  
  112. Function Rand% (lo%, hi%)
  113.     Rand = Int(Rnd * (hi% - lo% + 1) + lo%)
  115.  
  116. Sub CircleFill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
  117.     '=============================
  118.     '  CX = center x coordinate
  119.     '  CY = center y coordinate
  120.     '   R = radius
  121.     '   C = fill color
  122.     '=============================
  123.     Dim As Integer Radius, RadiusError, X, Y
  124.     Radius = Abs(R)
  125.     RadiusError = -Radius
  126.     X = Radius
  127.     Y = 0
  128.     If Radius = 0 Then PSet (CX, CY), C: Exit Sub
  129.     Line (CX - X, CY)-(CX + X, CY), C, BF
  130.     While X > Y
  131.         RadiusError = RadiusError + Y * 2 + 1
  132.         If RadiusError >= 0 Then
  133.             If X <> Y + 1 Then
  134.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  135.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  136.             End If
  137.             X = X - 1
  138.             RadiusError = RadiusError - X * 2
  139.         End If
  140.         Y = Y + 1
  141.         Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  142.         Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  143.     Wend
  145.  
  146.  

13
Programs / Barnsley Fern (Rosetta Code task)
« on: April 16, 2021, 03:23:43 pm »
https://rosettacode.org/wiki/Barnsley_fern#QB64

'==================================================
Task
Create this fractal fern, using the following transformations:

ƒ1   (chosen 1% of the time)
        xn + 1 = 0
        yn + 1 = 0.16 yn
ƒ2   (chosen 85% of the time)
        xn + 1 = 0.85 xn + 0.04 yn
        yn + 1 = −0.04 xn + 0.85 yn + 1.6
ƒ3   (chosen 7% of the time)
        xn + 1 = 0.2 xn − 0.26 yn
        yn + 1 = 0.23 xn + 0.22 yn + 1.6
ƒ4   (chosen 7% of the time)
        xn + 1 = −0.15 xn + 0.28 yn
        yn + 1 = 0.26 xn + 0.24 yn + 0.44.
Starting position: x = 0, y = 0
'==================================================

Code: QB64: [Select]
  1. _Title "Barnsley Fern"
  2. Dim As Integer sw, sh
  3. sw = 400: sh = 600
  4. Screen _NewImage(sw, sh, 8)
  5.  
  6. Dim As Long i, ox, oy
  7. Dim As Single sRand
  8. Dim As Double x, y, x1, y1, sx, sy
  9. sx = 60: sy = 59
  10. ox = 180: oy = 4
  12.  
  13. x = 0
  14. y = 0
  15. For i = 1 To 400000
  16.     sRand = Rnd
  17.     Select Case sRand
  18.         Case Is < 0.01
  19.             x1 = 0: y1 = 0.16 * y
  20.         Case Is < 0.08
  21.             x1 = 0.2 * x - 0.26 * y: y1 = 0.23 * x + 0.22 * y + 1.6
  22.         Case Is < 0.15
  23.             x1 = -0.15 * x + 0.28 * y: y1 = 0.26 * x + 0.24 * y + 0.44
  24.         Case Else
  25.             x1 = 0.85 * x + 0.04 * y: y1 = -0.04 * x + 0.85 * y + 1.6
  26.     End Select
  27.     x = x1
  28.     y = y1
  29.     PSet (x * sx + ox, sh - (y * sy) - oy), 10
  31.  

14
Programs / Magic Squares of Odd Order (Rosetta Code task)
« on: April 16, 2021, 12:14:16 am »
https://rosettacode.org/wiki/Magic_squares_of_odd_order#QB64

'==================================================
Task
For any odd   N,   generate a magic square with the integers   1 ──► N,   and show the results here.

Optionally, show the magic number.

You should demonstrate the generator by showing at least a magic square for   N = 5.
'==================================================

Code: QB64: [Select]
  1. _Title "Magic Squares of Odd Order"
  2. '$Dynamic
  3. DefLng A-Z
  4. Dim Shared As Long m(1, 1)
  5.  
  6. Call magicSquare(5)
  7. Call magicSquare(15)
  8.  
  11.  
  12. Sub magicSquare (n As Integer)
  13.     Dim As Integer inc, count, row, col
  14.  
  15.     If (n < 3) Or (n And 1) <> 1 Then n = 3
  16.     ReDim m(n, n)
  17.     inc = 1
  18.     count = 1
  19.     row = 1
  20.     col = (n + 1) / 2
  21.     While count <= n * n
  22.         m(row, col) = count
  23.         count = count + 1
  24.         If inc < n Then
  25.             inc = inc + 1
  26.             row = row - 1
  27.             col = col + 1
  28.             If row <> 0 Then
  29.                 If col > n Then col = 1
  30.             Else
  31.                 row = n
  32.             End If
  33.         Else
  34.             inc = 1
  35.             row = row + 1
  36.         End If
  37.     Wend
  38.     Call printSquare(n)
  40.  
  41. Sub printSquare (n As Integer)
  42.     Dim As Integer row, col
  43.     'Arbitrary limit ensures a fit within console window
  44.     'Can be any size that fits within your computers memory limits
  45.     If n < 21 Then
  46.         Print "Order "; n; " Magic Square constant is "; Str$(Int((n * n + 1) / 2 * n))
  47.         For row = 1 To n
  48.             For col = 1 To n
  49.                 Print Using "####"; m(row, col);
  50.             Next col
  51.             Print
  52.             ' Print
  53.         Next row
  54.     End If

15
Programs / Sierpinski Carpet (Rosetta Code task)
« on: April 16, 2021, 12:06:09 am »
https://rosettacode.org/wiki/Sierpinski_carpet#QB64

'==================================================
Task
Produce a graphical or ASCII-art representation of a Sierpinski carpet of order   N.
'==================================================

I produced the graphical option.

Code: QB64: [Select]
  1. _Title "Sierpinski Carpet"
  2.  
  3. Screen _NewImage(500, 545, 8)
  4. Cls , 15: Color 1, 15
  5.  
  6. 'labels
  7. _PrintString (96, 8), "Order 0"
  8. _PrintString (345, 8), "Order 1"
  9. _PrintString (96, 280), "Order 3"
  10. _PrintString (345, 280), "Order 4"
  11.  
  12. 'carpets
  13. Call carpet(5, 20, 243, 0)
  14. Call carpet(253, 20, 243, 1)
  15. Call carpet(5, 293, 243, 2)
  16. Call carpet(253, 293, 243, 3)
  17.  
  20.  
  21. Sub carpet (x As Integer, y As Integer, size As Integer, order As Integer)
  22.     Dim As Integer ix, iy, isize, iorder, side, newX, newY
  23.     ix = x: iy = y: isize = size: iorder = order
  24.     Line (ix, iy)-(ix + isize - 1, iy + isize - 1), 1, BF
  25.  
  26.     side = Int(isize / 3)
  27.     newX = ix + side
  28.     newY = iy + side
  29.     Line (newX, newY)-(newX + side - 1, newY + side - 1), 15, BF
  30.     iorder = iorder - 1
  31.     If iorder >= 0 Then
  32.         Call carpet(newX - side, newY - side + 1, side, iorder)
  33.         Call carpet(newX, newY - side + 1, side, iorder)
  34.         Call carpet(newX + side, newY - side + 1, side, iorder)
  35.         Call carpet(newX + side, newY, side, iorder)
  36.         Call carpet(newX + side, newY + side, side, iorder)
  37.         Call carpet(newX, newY + side, side, iorder)
  38.         Call carpet(newX - side, newY + side, side, iorder)
  39.         Call carpet(newX - side, newY, side, iorder)
  40.     End If

Pages: [1] 2 3 ... 5