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 - bplus

Pages: 1 [2] 3 4 ... 537
16
QB64 Discussion / Re: Highlight% changes by itself
« on: April 11, 2022, 03:10:55 pm »
add this in around line 115:
Code: QB64: [Select]
  1. If Highlight% > 8 Then Highlight% = 1  
  2.  

So highlight won't exceed 8

Now I think it will work as intended.

17
QB64 Discussion / Re: Highlight% changes by itself
« on: April 11, 2022, 03:07:48 pm »
Line 110 should be this:
Code: QB64: [Select]
  1.  Highlight% = Highlight% - 1    
  2.  

because the up arrow was not changing the highlight number.

18
QB64 Discussion / Re: Highlight% changes by itself
« on: April 11, 2022, 02:49:09 pm »
Type-O!
Code: QB64: [Select]
  1. Dim Shared RightArroeKey$: rightArrowKey$ = Chr$(0) + "M"
  2.  

need w in arrow where e is!

I found it by watching highlight continuously increasing even when keys not pressed.

19
QB64 Discussion / Re: Highlight% changes by itself
« on: April 11, 2022, 02:27:22 pm »
Yeah working on highlights.. looks like just _limit 30 is enough to stop flicker.

20
QB64 Discussion / Re: Highlight% changes by itself
« on: April 11, 2022, 02:19:33 pm »
Ah, I use "toggle"
toggle = 1 - toggle  0,1,0,1,....

True, False a little misleading, but everyone has their styles and preferences....

You are attempting to highlight line ready to go on Enter maybe after arrow presses, I assume.

21
QB64 Discussion / Re: Highlight% changes by itself
« on: April 11, 2022, 01:57:05 pm »
Oh you are trying to highlite something, ehhh

deja vu again today:

Didn't I suggest False% = 0 ???

An If is going to see both -1 and 1 as True and take the THEN path.

22
QB64 Discussion / Re: Highlight% changes by itself
« on: April 11, 2022, 01:50:20 pm »
I added _display and _limit to stop flicker.

Once you use _display, then you must say _display every time you want to show something immediatedly. To disable _display use _autodisplay and get default automatic "display". You could put that at the end of the sub before exiting. _display once in you main drawing loop is best.
Code: QB64: [Select]
  1.  
  2. _Title "Time Calculator"
  3.  
  4. Const TRUE% = 1
  5. Const FALSE% = -1
  6. Dim Shared LeftArrowKey$: LeftArrowKey$ = Chr$(0) + "K"
  7. Dim Shared RightArroeKey$: rightArrowKey$ = Chr$(0) + "M"
  8. Dim Shared UpArrowKey$: UpArrowKey$ = Chr$(0) + "H"
  9. Dim Shared DownArrowKey$: DownArrowKey$ = Chr$(0) + "P"
  10. Const UpArrowHit% = 18432
  11. Const LeftArrowHit% = 19200
  12. Const RightArrowHit% = 19712
  13. Const DownArrowHit% = 20480
  14. ' for the highlighted option in the GetTimeAmount SUB
  15. Const YearsHO% = 1
  16. Const DaysHO% = 2
  17. Const HoursHO% = 3
  18. Const MinutesHO% = 4
  19. Const SecondsHO% = 5
  20.  
  21. Width 80, 50
  23. Color 14, 1: Cls
  24.  
  25. Call Menu
  26.  
  27. Sub FromNowUntil
  29.  
  30. Sub HowLongSince
  32.  
  33. Sub WhatDateAfterElapsedTime
  35.  
  36. Sub AddElapsedTimes
  38.  
  39. Sub SubtractElapsedTimes
  41.  
  42. Sub Multiply
  44.  
  45. Sub Divide
  47.  
  48.  
  49. Sub Menu
  50.     HaltAndDisplay% = 0: Highlight% = 0: yPos% = 0: UserCommand$ = "": A$ = ""
  51.     xPos% = 0: MaxOption% = 0: SelectedAnOption% = 0
  52.  
  53.     HaltAndDisplay% = TRUE%: Highlight% = 1: yPos% = 13: MaxOption% = 8: SelectedAnOption% = FALSE%
  54.     Do
  55.         UserCommand$ = InKey$
  56.         Locate 45, 1: Print S$(Highlight%)
  57.         Locate 46, 1: Print "|" + UserCommand$ + "|"
  58.         If HaltAndDisplay% = TRUE% Then
  59.             Color 14, 1: Cls
  60.             A$ = "Time Calculator Menu": xPos% = Center(A$)
  61.             Locate yPos%, Center(A$): Print A$: Locate yPos% + 1, Center(A$)
  62.             Print "---- ---------- ----"
  63.  
  64.             A$ = "": A$ = "1.) Find How Long From Now"
  65.             Locate yPos% + 3, Center(A$): If Highlight% = 1 Then
  66.             Color 10, 0: Else Color 14, 1: End If: Print A$
  67.             A$ = "": A$ = "Until A Selected Time"
  68.             Locate yPos% + 4, Center(A$): If Highlight% = 1 Then
  69.             Color 10, 0: Else Color 14, 1: End If: Print A$
  70.  
  71.             A$ = "": A$ = "2.) Find How Long It Has Been Since"
  72.             Locate yPos% + 6, Center(A$): If highlighedoption% = 2 Then
  73.             Color 10, 0: Else Color 14, 1: End If: Print A$
  74.             A$ = "": A$ = "A Selected Time Has Passed"
  75.             Locate yPos% + 7, Center(A$): If Highlight% = 2 Then
  76.             Color 10, 0: Else Color 14, 1: End If: Print A$
  77.  
  78.             A$ = "": A$ = "3.) Find The Date And Time It Will Be After"
  79.             Locate yPos% + 9, Center(A$): If Highlight% = 3 Then
  80.             Color 10, 0: Else Color 14, 1: End If: Print A$
  81.             A$ = "": A$ = "A Selected Amount Of Time Has Passed"
  82.             Locate yPos% + 10, Center(A$): If Highlight% = 3 Then
  83.             Color 10, 0: Else Color 14, 1: End If: Print A$
  84.  
  85.             A$ = "": A$ = "4.) Add Two Elapsed Times"
  86.             Locate yPos% + 12, Center(A$): If Highlight% = 4 Then
  87.             Color 10, 0: Else Color 14, 1: End If: Print A$
  88.  
  89.             A$ = "": A$ = "5.) Subtract One Elapsed Time From Another One"
  90.             Locate yPos% + 14, Center(A$): If Highlight% = 5 Then
  91.             Color 10, 0: Else Color 14, 1: End If: Print A$
  92.  
  93.             A$ = "": A$ = "6.) Multiply An Elapsed Time By A Constant"
  94.             Locate yPos% + 16, Center(A$): If Highlight% = 6 Then
  95.             Color 10, 0: Else Color 14, 1: End If: Print A$
  96.  
  97.             A$ = "": A$ = "7.) Divide An Elapsed Time By A Constant"
  98.             Locate yPos% + 18, Center(A$): If Highlight% = 7 Then
  99.             Color 10, 0: Else Color 14, 1: End If: Print A$
  100.  
  101.             A$ = "": A$ = "8.) Exit"
  102.             Locate 45, Center(A$): If Highlight% = 8 Then
  103.             Color 10, 0: Else Color 14, 1: End If: Print A$
  104.  
  105.             HaltAndDisplay% = FALSE%
  106.         End If
  107.  
  108.         Select Case UserCommand$
  109.             Case UpArrowKey$, LeftArrowKey$
  110.                 Highlight% = highlightedoption - 1
  111.                 If Highlight% = 0 Then Highlight% = MaxOption%
  112.                 HaltAndDisplay% = TRUE%
  113.             Case DownArrowKey$, rightarrowkey$
  114.                 Highlight% = Highlight% + 1
  115.                 If highlightedoption > maxoption Then Highlight% = 1
  116.                 HaltAndDisplay% = TRUE%
  117.             Case Chr$(13)
  118.                 SelectedAnOption% = TRUE%
  119.             Case "1", "2", "3", "4", "5", "6", "7"
  120.                 Highlight% = Val(UserCommand$)
  121.                 SelectedAnOption% = TRUE%
  122.         End Select
  123.         If SelectedAnOption% = TRUE Then
  124.             Select Case Highlight%
  125.                 Case 1
  126.                     Call FromNowUntil: SelectedAnOption% = FALSE%
  127.                 Case 2
  128.                     Call HowLongSince: SelectedAnOption% = FALSE%
  129.                 Case 3
  130.                     Call WhatDateAfterElapsedTime: SelectedAnOption% = FALSE%
  131.                 Case 4
  132.                     Call AddElapsedTimes: SelectedAnOption% = FALSE%
  133.                 Case 5
  134.                     Call SubtractElapsedTimes: SelectedAnOption% = FALSE%
  135.                 Case 6
  136.                     Call Multiply: SelectedAnOption% = FALSE%
  137.                 Case 7
  138.                     Call Divide: SelectedAnOption% = FALSE%
  139.             End Select
  140.         End If
  141.         _Display ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< added this and next
  142.         _Limit 30
  143.     Loop Until UserCommand$ = Chr$(27) Or UserCommand$ = S$(MaxOption%)
  145.  
  146.  
  147.  
  148.  
  149.  
  150. Function Center% (Text$): Center% = Int((80 - Len(Text$)) / 2): End Function
  151. Function S$ (Number!): S$ = LTrim$(Str$(Number!)): End Function
  152. Function P$: pause$ = Input$(1): If pause$ = Chr$(27) Then End
  153. P$ = pause$: End Function
  154.  
  155.  
  156.  

23
Programs / Re: Benchmark_01
« 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.

24
Programs / Benchmark_01
« 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.

25
QB64 Discussion / Re: Particle System
« 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.  

26
QB64 Discussion / Re: Particle System
« 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.

27
QB64 Discussion / Re: Particle System
« 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 :)




28
QB64 Discussion / Re: Puzzling double precision rounding inaccuracy
« on: April 10, 2022, 07:32:26 am »
And as TempodiBasic says, remember it's not a bug, it's a feature.

You learn never to completely trust the computer, good lesson!

29
QB64 Discussion / Re: Puzzling double precision rounding inaccuracy
« on: April 10, 2022, 06:23:56 am »
You've found the solution!

Welcome to the forum!

30
Programs / Re: ASCII Draw(BAM program in progress, QB64 version to follow)
« on: April 09, 2022, 09:29:56 pm »
BTW I am talking about this color picker, in version 6/7? I think they changed to image later?
 
image_2022-04-09_212952330.png

Pages: 1 [2] 3 4 ... 537