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 ... 3 4 [5] 6 7 ... 537
61
Programs / Re: and another one for your toolbox...
« on: April 03, 2022, 10:48:58 pm »
Hey while we have this thread pulled down from a year ago, let's get this one posted too!

MessageBox function:

Code: QB64: [Select]
  1. ' Thank you FellippeHeitor!
  2. $If WIN Then
  4.         Function MessageBox (ByVal ignore&, message$, title$, Byval type&)
  5.     End Declare
  7.     DECLARE LIBRARY ""
  8.     FUNCTION MessageBox (BYVAL ignore&, message$, title$, BYVAL type&)
  9.     END DECLARE
  11. ' answer = MessageBox(0, "Hi, bplus. You can do this.", "This is platform-agnostic", 0)
  12. Dim m$, answer, temp
  13. m$ = "Message: press OK to return 1, press Cancel to return 2."
  14. answer = MessageBox(0, m$, "Test MessageBox", 4097) ' 4097 for OK = 1 Cancel = 2 Modal on top messagebox
  15. If answer = 1 Then
  16.     temp = MessageBox(0, "OK was pressed.", "Test MessageBox", 4096)
  18.     temp = MessageBox(0, "Cancel was pressed.", "Test MessageBox", 4096)
  20.  

Thank you Fellippe! Very lightweight in terms of LOC.

62
Programs / Re: QBJS - QBasic for the Web
« on: April 03, 2022, 06:46:03 pm »
Wow you are loading sounds right out of the Internet!

For some reason there seems to be either more circles or they are moving down screen faster than when I first made game. I couldn't of gotten that much older! I can barely make it across the screen 1 time, which is how the new scoring of the game is done in my versions. Remember Frogger Game?

63
QB64 Discussion / Re: How do you deal with floating point rounding errors ?
« on: April 03, 2022, 01:11:37 pm »
Yeah there's STx paper right there:
Quote
Computers don't usually work in base 10, they work in base 2.

So consider yourself warned. :)

64
Programs / Re: QuadraLetterFall game
« on: April 03, 2022, 11:48:59 am »
I was wishing I could move the letters farther left or right than only a single step but I am new to this game. I don't want to appear harsh, I appreciate this is your first game or post and you are proud of your work. Ha! you should see my first from way back... this is way better!

65
QB64 Discussion / Re: How do you deal with floating point rounding errors ?
« on: April 02, 2022, 09:14:04 pm »
Quote
@CharlieJV  you might be in habit of thinking of i as an incremented (by 1) integer index (like for arrays).

No, I am not thinking that.  When I do a For i = 1 to 5, I expect 1,2,3,4,5 to happen.

LOL, I thought April Fools day was yesterday!

And I say this:
Quote
jack is suggesting a While loop I think to try an get that last loop for i when it isn't an incremented (by 1) integer index but I had same idea tried it and still i a single type + .1 collects gabage and passes exactly 1.000 just like in For loop!
Translation While doesn't work either.

And both you and Steve repeat there is no advantage to While, so yeah! we all agree.

66
Programs / Re: QuadraLetterFall game
« on: April 02, 2022, 09:10:04 pm »
Yes it takes awhile to get use to. Is it supposed to start raining letters before you've read the instructions? I guess that's OK, after awhile one would have them memorized.

67
Programs / Re: QuadraLetterFall game
« on: April 02, 2022, 06:10:33 pm »
Welcome to the forum!

68
Programs / Re: B+'s Matrix Rain With World Map Backdrop
« on: April 02, 2022, 04:57:51 pm »
Yeah green and black look pretty good.

69
QB64 Discussion / Re: How do you deal with floating point rounding errors ?
« on: April 02, 2022, 04:41:22 pm »
@CharlieJV  you might be in habit of thinking of i as an incremented (by 1) integer index (like for arrays).

When i is an integer it will do the last loop
Code: QB64: [Select]
  1. for i = 1 to 10
  2.  print i

jack is suggesting a While loop I think to try an get that last loop for i when it isn't an incremented (by 1) integer index but I had same idea tried it and still i a single type + .1 collects gabage and passes exactly 1.000 just like in For loop!



70
Programs / Re: B+'s Matrix Rain With World Map Backdrop
« on: April 02, 2022, 04:30:22 pm »
Interesting background Ken :)

71
QB64 Discussion / Re: How do you deal with floating point rounding errors ?
« on: April 02, 2022, 11:48:20 am »
Yeah it works for Doppler's problem too.
https://qb64forum.alephc.xyz/index.php?topic=4753.msg141737#msg141737

That does not guarantee a panacea, still have rounding errors when garbage builds up with adding and multiplying but this covers allot of problems.

72
QB64 Discussion / Re: defsng math going off the rails, creating a total from list of numbers in file
« on: April 02, 2022, 11:45:35 am »
Removing need to download some data, I put in a data statement and sleeping after each total so you can watch from start on screen.

Code: QB64: [Select]
  1. _Title "Total it" ' from Doppler "defsng math going off the rails, creating a total from list of numbers in file"
  2. ' ref: https://qb64forum.alephc.xyz/index.php?topic=4753.msg141698#msg141698
  3.  
  4. ' b+ mod removed file and replced with data line
  6. total = 0
  7. t = 0
  8.  
  10.     Read t$
  11.     If t$ = "EOD" Then Exit Do
  12.     t = Val(t$)
  13.     Print t
  14.     Print Str$(total) + " plus " + t$ + " equals ";
  15.     total = total + t
  16.     Print format$("#,###.##", Str$(total));
  17.     Print " press any to contiue..."
  18.     Sleep
  23. Data -750,21.71,13.67,22.92,91.25,119.63,10.84,18.46,40.44,171.73,3.08,92.39,57.20,22.79,-2.80,43.87,34.81,83.82,10.85,EOD
  24.  
  25. Function format$ (template As String, Source As String)
  26.     Dim d, s, n, i, t$
  27.     d = _Dest: s = _Source
  28.     n = _NewImage(80, 80, 0)
  29.     _Dest n: _Source n
  30.     Print Using template; Val(Source)
  31.     For i = 1 To 79
  32.         t$ = t$ + Chr$(Screen(1, i))
  33.     Next
  34.     If Left$(t$, 1) = "%" Then t$ = Mid$(t$, 2)
  35.     format$ = _Trim$(t$)
  36.     _Dest d: _Source s
  37.     _FreeImage n
  39.  
  40.  
  41.  

73
QB64 Discussion / Re: How do you deal with floating point rounding errors ?
« on: April 02, 2022, 11:01:46 am »
Steve said it some time ago, I paraphrase: Separate the calculations with variables function from the displaying of the results function.

You just need a good format routine to adjust for garbage that enters into calculations with floats. Probably would include rounding to the precision of decimals you desire in the output (display) format.

For CharlieJV this seems to work:
Code: QB64: [Select]
  1. For i = -1 To 1 Step .1
  2.     Print i, format$("##.#", Str$(i))
  4.  
  5. Function format$ (template As String, Source As String)
  6.     Dim d, s, n, i, t$
  7.     d = _Dest: s = _Source
  8.     n = _NewImage(80, 80, 0)
  9.     _Dest n: _Source n
  10.     Print Using template; Val(Source)
  11.     For i = 1 To 79
  12.         t$ = t$ + Chr$(Screen(1, i))
  13.     Next
  14.     If Left$(t$, 1) = "%" Then t$ = Mid$(t$, 2)
  15.     format$ = _Trim$(t$)
  16.     _Dest d: _Source s
  17.     _FreeImage n
  19.  
  20.  
 [ You are not allowed to view this attachment ]  

Well shoot, seems to be stopping at .9 not 1, dang!

OK this fixes that!
Code: QB64: [Select]
  1. For i = -1 To 1.0001 Step .1
  2.     Print i, format$("##.#", Str$(i))
  4. Function format$ (template As String, Source As String)
  5.     Dim d, s, n, i, t$
  6.     d = _Dest: s = _Source
  7.     n = _NewImage(80, 80, 0)
  8.     _Dest n: _Source n
  9.     Print Using template; Val(Source)
  10.     For i = 1 To 79
  11.         t$ = t$ + Chr$(Screen(1, i))
  12.     Next
  13.     If Left$(t$, 1) = "%" Then t$ = Mid$(t$, 2)
  14.     format$ = _Trim$(t$)
  15.     _Dest d: _Source s
  16.     _FreeImage n
  18.  

74
Programs / Re: Easter Egg Decorating
« on: April 01, 2022, 11:31:12 pm »
Ah but did you try with Rotozoom?
Code: QB64: [Select]
  1. _Title "Matrix Rain 4" 'B+ started 2019-03-16
  2. ' from Matrix Rain 2019-03-14
  3. ' or QB64 Purple Rain!
  4.  
  5. '>>> Save this file as: Matrix Rain 4.bas, so the program can load the strings from it.  <<<
  6.  
  7. '2019-03-15 This will attempt to spin the drops as they fall
  8. '2019-03-16  Don't need no damn Character Set.DAT file!!!
  9. '2019-03-16 Ijust want to see the vertical code strings dangle and twist.
  10.  
  11. '2019-03-19 Matrix Rain 4
  12. ' + added randWeight to weight the random sizes chosen so many more on small side than large
  13. ' + draw letters on a transparent background so the background of the letter does not cover
  14. '   the drops behind it.
  15.  
  16.  
  18. Const xmax = 1280
  19. Const ymax = 740
  20. Const nDrops = 500
  21. Type dropType
  22.     x As Single
  23.     sz As Single
  24.     curY As Integer
  25.     dxs As Single 'direction and change of spin some small fraction of 1, +-1/3, +-1/4, +-1/5...
  27.  
  28. Screen _NewImage(xmax, ymax, 32)
  29. _ScreenMove 80, 0 'for snap shot
  30. '_FULLSCREEN 'as screen saver
  31.  
  32. ReDim Shared fileStrings$(1000) 'container for these program lines that will be dangling
  33. Open "Matrix Rain 4.bas" For Input As #1
  35.     Line Input #1, fs$
  36.     If Len(LTrim$(fs$)) <> 0 Then 'less empty spaces
  37.         fileStrings$(i) = LTrim$(fs$)
  38.         i = i + 1
  39.     End If
  42. ReDim _Preserve fileStrings$(i - 1)
  43. ' check loading
  44. 'FOR i = 0 TO UBOUND(fileStrings$)
  45. '    PRINT i, fileStrings$(i)
  46. 'NEXT
  47. 'END
  48.  
  49. 'setup drops
  50. Dim Shared drop(nDrops) As dropType
  51. Dim Shared s$(nDrops)
  52.  
  53. For i = 0 To nDrops
  54.     newDrop i, 1
  56.  
  57. While _KeyDown(27) = 0
  58.     Cls
  59.     For i = 0 To nDrops
  60.         drawDrop (i)
  61.         drop(i).curY = drop(i).curY + 1
  62.         If drop(i).curY > Len(s$(i)) Then newDrop i, 0
  63.     Next
  64.     _Display
  65.     _Limit 25
  67.  
  68. Sub newDrop (i, start)
  69.     drop(i).x = Rnd * xmax 'set location
  70.     drop(i).sz = randWeight(.3, 5, 3) 'set size  weighted on small sizes
  71.     'length of text string can fit on screen
  72.     charLength = ymax \ (drop(i).sz * 16) + 1 'from size determine how many chars fit on screen
  73.     randLine = Int(Rnd * UBound(fileStrings$)) 'pick a random program line
  74.     s$(i) = Mid$(fileStrings$(randLine), 1, charLength) 'here is text string to dangle
  75.     While Len(s$(i)) < charLength
  76.         If randLine + 1 > UBound(fileStrings$) Then randLine = 0 Else randLine = randLine + 1
  77.         s$(i) = Mid$(s$(i) + " : " + fileStrings$(randLine), 1, charLength)
  78.     Wend
  79.     If start <> 0 Then drop(i).curY = Int(Rnd * (charLength)) + 1 Else drop(i).curY = 1 'flat and readable at curY
  80.     drop(i).dxs = 1 / (Int(Rnd * 7) + 3) 'change of spin rate +-1/3, +-1/4, ... +-1/9
  81.     If Rnd < .5 Then drop(i).dxs = -drop(i).dxs
  83.  
  84. Sub drawDrop (i)
  85.     For j = 1 To drop(i).curY
  86.         d = drop(i).curY - j
  87.         If d = 0 Then
  88.             c~& = _RGBA32(255, 100, 255, 225)
  89.         ElseIf d = 1 Then
  90.             c~& = _RGBA32(255, 50, 255, 205)
  91.         ElseIf d = 2 Then
  92.             c~& = _RGBA32(255, 25, 255, 180)
  93.         ElseIf d >= 3 Then
  94.             c~& = _RGBA32(255, 0, 255, 190 - d * 5)
  95.         End If
  96.         rot = 1: dir = -1
  97.         For k = 0 To d
  98.             rot = rot + drop(i).dxs * dir
  99.             If rot > 1 Then dir = -1 * dir: rot = 1 + drop(i).dxs * dir
  100.             If rot < -1 Then dir = dir * -1: rot = -1 + drop(i).dxs * dir
  101.         Next
  102.         drwChar Mid$(s$(i), j, 1), c~&, drop(i).x + 4 * drop(i).sz, drop(i).sz * 16 * (j - 1) + 8 * drop(i).sz, rot * drop(i).sz, drop(i).sz, 0
  103.     Next
  105.  
  106. Sub drwChar (char$, c As _Unsigned Long, midX, midY, xScale, yScale, Rotation) 'what ever the present color is set at
  107.     I& = _NewImage(8, 16, 32)
  108.     _Dest I&
  109.     Color c, _RGBA32(0, 0, 0, 0)
  110.     _PrintString (0, 0), char$
  111.     _Dest 0
  112.     RotoZoom2 midX, midY, I&, xScale, yScale, Rotation
  113.     _FreeImage I&
  115.  
  116. Sub RotoZoom2 (X As Long, Y As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
  117.     Dim px(3) As Single: Dim py(3) As Single
  118.     W& = _Width(Image&): H& = _Height(Image&)
  119.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
  120.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
  121.     sinr! = Sin(-Rotation): cosr! = Cos(-Rotation)
  122.     For i& = 0 To 3
  123.         x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + Y
  124.         px(i&) = x2&: py(i&) = y2&
  125.     Next
  126.     _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
  127.     _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
  129.  
  130. Function randWeight (manyValue, fewValue, power)
  131.     randWeight = manyValue + Rnd ^ power * (fewValue - manyValue)
  133.  
  134.  

BTW the letters, digits and symbols are the from the source QB64 code.

75
Programs / Re: Easter Egg Decorating
« on: April 01, 2022, 10:54:47 pm »
Yeah here are some cherry picked Textured Eggs:
Code: QB64: [Select]
  1. _Title "drawEasterEgg Textured" 'b+ 2022-03-30 mod 2022-04-01 add r,g,b parameter
  3. Const Xmax = 500, Ymax = 500, Pi = _Pi
  4. Screen _NewImage(Xmax, Ymax, 32)
  5. _ScreenMove 100, 100
  6. scale = 100
  8.     Cls
  9.     drawEasterEgg 250, 250, Rnd * scale + scale, Rnd * 2 * Pi, Rnd, Rnd, Rnd
  10.     Sleep
  12.  
  13.  
  14. Sub drawEasterEgg (xc, yc, scale, radianAngle, r, g, b) ' add rgb so can draw the same
  15.     For x = -1 To 1 Step .01
  16.         For y = -1 To 1 Step .01
  17.             If x < 0 Then c = c + .0005 Else c = c - .0005
  18.             If (x * x + (1.4 ^ x * 1.6 * y) ^ 2 - 1) <= .01 Then ' 1.6 * y orig
  19.                 If y > 0 Then
  20.                     Color _RGB32(128 * (1 - y) + 128 * (1 - y) * Sin(c * r), 128 * (1 - y) + 128 * (1 - y) * Sin(c * g), 127 * (1 - y) + 127 * (1 - y) * Sin(c * b))
  21.                 Else
  22.                     Color _RGB32(128 + 128 * Sin(c * r), 128 + 128 * Sin(c * g), 127 + 127 * Sin(c * b))
  23.                 End If
  24.                 a = _Atan2(y, x)
  25.                 d = scale * Sqr(x * x + y * y)
  26.                 PSet (xc + d * Cos(a + radianAngle), yc + d * Sin(a + radianAngle))
  27.             End If
  28.         Next
  29.     Next
  31.  
  32.  

 
texture but dark.PNG

 
Texture egg 2.PNG

 
Texture egg 3.PNG

Pages: 1 ... 3 4 [5] 6 7 ... 537