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.


Topics - RhoSigma

Pages: [1] 2 3
1
QB64 Discussion / What happend to the Forum & Wiki?
« on: December 30, 2021, 08:27:18 am »
Forum & Wiki were moved to their own sub-domains recently, certainly a good move for better organization of the respective scripts and databases, however for the Wiki there's still no favicon displayed in the browser shortcut/favourits. The Forum otherwise shows the QB64 icon again.

But there are:
  • no more download counters on files attached to posts (ok, you still get it via your profile, but...)
  • no more syntax highlighting in code sample boxes
  • all OpenGL keywords disappeared from Wiki

2
QB64 Discussion / Found a mysterious command
« on: October 16, 2021, 07:35:46 pm »
When looking over the registered commands and function list in file \source\subs_functions\subs_functions.bas I found a command, which obviously never got real public attention.

It's _FPS, either be called with a SINGLE number designating the desired fps in the range 1-200 or the keyword _AUTO. The command gets not syntax highlighted yet, has no help page in the IDE nor a Wiki entry or anything else.

After deeper investigation I found, that it was first available in v1.0 build 51. It's purpose is to set the maximum frame refresh rate of the _AUTODISPLAY mode. While this is working for given numeric values in the valid range, the _AUTO keyword otherwise is just resetting it to the regular 30fps, but according to the comments in libqb.cpp it was planned, that the _AUTO mode should also dynamically adjust the refresh rate depending on the current CPU load, which obviously never got implemented.

Code: QB64: [Select]
  1. 'this example doubles the refresh rate every 2.5 mil. loops
  2.  
  3. _FPS 1
  4. FOR x = 0 TO 10000000
  5.     PRINT x
  6.     IF x = 2500000 THEN _FPS 2
  7.     IF x = 5000000 THEN _FPS 4
  8.     IF x = 7500000 THEN _FPS 8
  9. _FPS _AUTO 'regular 30fps again
  10.  
  11.  

3
Programs / Official Bin$ function as complement to the &B notation
« on: October 05, 2021, 09:56:19 am »
As I'am the one who's responsible for the proper implementaion of the &B prefixed binary number strings into QB64 (https://qb64forum.alephc.xyz/index.php?topic=1933.msg111935#msg111935), it should be probably me too, who provides an appropriate counterpart, a function to do the conversion from any given hex/oct/dec number into binary string.

Sure there are already many approaches for a Bin$ function in the Forum, some of my own, some from @bplus and @SMcNeill and probably others too. However, I felt there should be a function, which best mimics the regular behavior and results of the built-in HEX$ and OCT$ functions, rather than focusing on speed or extended flexibility.

So here is my official Bin$ function, meant as complement to the &B notation:
  • it can handle positive and negative numbers
  • returns the binary string without &B prefix, just as HEX$ and OCT$ do
  • the result for positive numbers is just as long as needed, ie. no leading zeros are returned
  • the result length for negative numbers is determined by the size of the input
BTW:
This update does also fix the recursion issue (https://qb64forum.alephc.xyz/index.php?topic=4209) of the former Bin$ fucntion.

An example using this Bin$ function:
Save as: BinExample.bas (or whatever)
Code: QB64: [Select]
  1. _TITLE "Bin$ Example"
  2. '=== Full description for the Bin$() function is available
  3. '=== in the separate HTML document.
  4. '=====================================================================
  5.  
  6. '-- some usage examples
  7. PRINT "some simple numbers..."
  8. num& = 5: PRINT num&; "= "; Bin$(num&)
  9. num& = -4: PRINT num&; "= "; Bin$(num&)
  10. num& = 32000: PRINT num&; "= "; Bin$(num&)
  11.  
  12. PRINT "works also with &B, &H and &O..."
  13. PRINT " &B1101 = "; Bin$(&B1101)
  14. PRINT " &H211 = "; Bin$(&H211)
  15. PRINT " &O377 = "; Bin$(&O377)
  16.  
  17. PRINT "and even with floating points (converts integer part only)..."
  18. num# = 123.456: PRINT num#; "= "; Bin$(num#)
  19. num# = -60000.25: PRINT num#; "= "; Bin$(num#)
  20. num# = 0.5: PRINT num#; "= "; Bin$(num#)
  21.  
  22. '-- done
  23.  
  24.  
  25.  
  26.  
  27. '--- Full description available in separate HTML document.
  28. '---------------------------------------------------------------------
  29. FUNCTION Bin$ (value&&)
  30. '--- option _explicit requirements ---
  31. DIM temp~&&, binStr$, charPos%, highPos%
  32. '--- init ---
  33. temp~&& = value&&
  34. binStr$ = STRING$(64, "0"): charPos% = 64: highPos% = 64
  35. '--- convert ---
  36.     IF (temp~&& AND 1) THEN ASC(binStr$, charPos%) = 49: highPos% = charPos%
  37.     charPos% = charPos% - 1: temp~&& = temp~&& \ 2
  38. LOOP UNTIL temp~&& = 0
  39. '--- adjust negative size ---
  40. IF value&& < 0 THEN
  41.     IF -value&& < &H0080000000~&& THEN highPos% = 33
  42.     IF -value&& < &H0000008000~&& THEN highPos% = 49
  43.     IF -value&& < &H0000000080~&& THEN highPos% = 57
  44. '--- set result ---
  45. Bin$ = MID$(binStr$, highPos%)
  46.  
  47.  

As it is required to preserve the UTF-8 encoding of the HTML Documentation, it is packed into an 7-zip archive file attached below. The archive does also contain the example from the codebox above.

4
QB64 Discussion / Testers (cross-platform) wanted for a bit of code
« on: September 29, 2021, 05:33:56 am »
I'm currently fixing stuff, also taking the opportunity to improve things.

Need to know if the following code works on all QB64 supported platforms, but I've only Windows systems to test on, so this is a call on all Mac/Linux users.

The following code does expand a relative path into a fully qualified absolut path, it works on Windows 32- and 64-bit, but what about Mac/Linux?

Code: QB64: [Select]
  1.     FUNCTION ExpandPath%& ALIAS _fullpath (buffer$, filespec$, BYVAL bufSize&)
  2.  
  3. PRINT "First test should work and print full path to qb64.exe"
  4. buff$ = STRING$(1056, CHR$(0))
  5. file$ = "qb64.exe"
  6. succ%& = ExpandPath%&(buff$, file$ + CHR$(0), 1056)
  7. IF succ%& > 0 THEN
  8.     PRINT "Result: success"
  9.     PRINT "Buffer: "; LEFT$(buff$, INSTR(buff$, CHR$(0)) - 1)
  10.     PRINT "Length:"; INSTR(buff$, CHR$(0)) - 1
  11.     PRINT "Result: error"
  12.     PRINT "Buffer: "; LEFT$(buff$, INSTR(buff$, CHR$(0)) - 1)
  13.     PRINT "Length:"; INSTR(buff$, CHR$(0)) - 1
  14.  
  15. PRINT "Second test should fail and print empty buffer and zero length"
  16. buff$ = STRING$(3, CHR$(0))
  17. file$ = "qb64.exe"
  18. succ%& = ExpandPath%&(buff$, file$ + CHR$(0), 3)
  19. IF succ%& > 0 THEN
  20.     PRINT "Result: success"
  21.     PRINT "Buffer: "; LEFT$(buff$, INSTR(buff$, CHR$(0)) - 1)
  22.     PRINT "Length:"; INSTR(buff$, CHR$(0)) - 1
  23.     PRINT "Result: error"
  24.     PRINT "Buffer: "; LEFT$(buff$, INSTR(buff$, CHR$(0)) - 1)
  25.     PRINT "Length:"; INSTR(buff$, CHR$(0)) - 1
  26.  
  27.  
  28.  

5
Programs / Versatile String parsing function
« on: August 27, 2021, 11:35:04 am »
I guess every developer is sooner or later in need of such a parsing function, doesn't matter if it's to split a simple text line into its single words, quickly reading CSV data into an array, break up a path specification into the single folder names or get the individual options of a given command line or of an URL query string.

Obviously such a function must be able to recognize several separator chars and needs to be able to suppress the splitting of components in quoted sections. Special to this function is the ability to optionally use different chars for opening quotes and closing quotes, which e.g. allows to read out sections in parantesis or brackets.

The following short example program will demonstrate some of the possible uses. A detailed function description is provided in the HTML Documentation available for download below the example code block.

An example using the new ParseLine function:
Save as: ParseExample.bas (or whatever)
Code: QB64: [Select]
  1. _TITLE "ParseExample"
  2. '=== Full description for the ParseLine&() function is available
  3. '=== in the separate HTML document.
  4. '=====================================================================
  5. WIDTH 100, 32
  6. REDIM a$(3 TO 4) 'result array (at least one element)
  7.  
  8.  
  9.  
  10. '=== e$ = example description
  11. '=== s$ = used separators (max. 5 chars)
  12. '=== q$ = used quotes (max. 2 chars) (empty = regular ")
  13. '=== l$ = test line to parse
  14. '=====================================================================
  15. e$ = "empty lines or those containing defined separators only, won't give a result"
  16. s$ = " ,.": q$ = ""
  17. l$ = "      ,. , ., ., . ,.,., .,,,,,. ,., "
  18. GOSUB doFunc
  19. e$ = "a simple text line, using space, comma and period as separators and regular quoting"
  20. s$ = " ,.": q$ = ""
  21. l$ = "Hello World, just want to say,greetings " + CHR$(34) + "to all" + CHR$(34) + " from RhoSigma."
  22. GOSUB doFunc
  23. e$ = "now a complex space separated test line with regular quoting and empty quotes"
  24. s$ = " ": q$ = ""
  25. l$ = "     " + CHR$(34) + "  ABC  " + CHR$(34) + " 123 " + CHR$(34) + CHR$(34) + " " + CHR$(34) + CHR$(34) + "X Y Z" + CHR$(34) + CHR$(34)
  26. GOSUB doFunc
  27. e$ = "same space separated test line with reodered quoting and empty quotes"
  28. s$ = " ": q$ = ""
  29. l$ = "       ABC   123" + CHR$(34) + CHR$(34) + CHR$(34) + " X Y Z " + CHR$(34) + CHR$(34) + CHR$(34) + "345  "
  30. GOSUB doFunc
  31. e$ = "again the space separated test line with regular quoting and an unfinished (EOL) quote"
  32. s$ = " ": q$ = ""
  33. l$ = "       ABC   123" + CHR$(34) + " " + CHR$(34) + " X Y Z " + CHR$(34) + " " + CHR$(34) + CHR$(34) + "345  "
  34. GOSUB doFunc
  35. e$ = "an opening quote at EOL is in fact an empty quote, it adds another empty array element"
  36. s$ = " ": q$ = ""
  37. l$ = "  " + CHR$(34) + "a final open quote is empty" + CHR$(34) + "   " + CHR$(34)
  38. GOSUB doFunc
  39. '-----------------------------
  40. '-----------------------------
  41. e$ = "a SUB declaration line using paranthesis as TWO char quoting"
  42. s$ = " ": q$ = "()"
  43. l$ = "SUB RectFill (lin%, col%, hei%, wid%, fg%, bg%, ch$)"
  44. GOSUB doFunc
  45. e$ = "same SUB line with many extra paranthesis, showing that TWO char quoting avoids nesting"
  46. s$ = " ": q$ = "()"
  47. l$ = "SUB RectFill (lin%, col%, ((hei%)), wid%, (fg%), bg%, (ch$))"
  48. GOSUB doFunc
  49. '-----------------------------
  50. '-----------------------------
  51. e$ = "space separated command line with regular quoting"
  52. s$ = " ": q$ = ""
  53. l$ = "--testfile " + CHR$(34) + "C:\My Folder\My File.txt" + CHR$(34) + " --testmode --output logfile.txt"
  54. GOSUB doFunc
  55. e$ = "space and/or equal sign separated command line with regular quoting"
  56. s$ = " =": q$ = ""
  57. l$ = "--testfile=" + CHR$(34) + "C:\My Folder\My File.txt" + CHR$(34) + " --testmode --output=logfile.txt"
  58. GOSUB doFunc
  59. e$ = "space and/or equal sign separated command line with alternative ONE char quoting"
  60. s$ = " =": q$ = "|"
  61. l$ = "--testfile=|C:\My Folder\My File.txt| --testmode --output=logfile.txt"
  62. GOSUB doFunc
  63. e$ = "space and/or equal sign separated command line with alternative TWO char quoting"
  64. s$ = " =": q$ = "{}"
  65. l$ = "--testfile={C:\My Folder\My File.txt} --testmode --output=logfile.txt"
  66. GOSUB doFunc
  67. '-----------------------------
  68. '-----------------------------
  69. e$ = "parsing a filename using (back)slashes as separators but NO spaces"
  70. s$ = "\/": q$ = ""
  71. l$ = "C:\My Folder\My File.txt"
  72. GOSUB doFunc
  73. e$ = "for quoted filenames the quoting char(s) must be separators instead of quotes (see source)"
  74. 'NOTE: a char cannot be used as separator and quote at the same time
  75. s$ = "\/" + CHR$(34): q$ = "*" '* is not allowd in filenames, so it's perfect to knock out the regular quote here
  76. l$ = CHR$(34) + "C:\My Folder\My File.txt" + CHR$(34)
  77. GOSUB doFunc
  78. '=====================================================================
  79.  
  80.  
  81.  
  82. '-- This GOSUB subroutine will execute the examples from above and
  83. '-- print the given inputs and function results.
  84. doFunc:
  85. COLOR 12: PRINT "square brackets just used to better visualize the start and end of strings ..."
  86. COLOR 14: PRINT "Example: ";: COLOR 10: PRINT e$
  87. PRINT "given input to function:"
  88. PRINT "------------------------"
  89. COLOR 14: PRINT "      Line: ";: COLOR 12: PRINT "[";: COLOR 7: PRINT l$;: COLOR 12: PRINT "]"
  90. COLOR 14: PRINT "Separators: ";: COLOR 12: PRINT "[";: COLOR 7: PRINT s$;: COLOR 12: PRINT "]"
  91. COLOR 14: PRINT "    Quotes: ";: COLOR 12: PRINT "[";: COLOR 7: PRINT q$;: COLOR 12: PRINT "]";: COLOR 3: PRINT " (empty = " + CHR$(34) + ")     "
  92. COLOR 14: PRINT "     Array: ";: COLOR 7: PRINT "LBOUND ="; LBOUND(a$), "UBOUND ="; UBOUND(a$)
  93. res& = ParseLine&(l$, s$, q$, a$(), 0)
  94. PRINT "result of function call (new UBOUND or -1 for nothing to parse):"
  95. PRINT "----------------------------------------------------------------"
  96. COLOR 14: PRINT "Result: ";: COLOR 7: PRINT res&
  97. IF res& > 0 THEN
  98.     COLOR 15
  99.     PRINT "array dump:"
  100.     PRINT "-----------"
  101.     FOR x& = LBOUND(a$) TO UBOUND(a$)
  102.         COLOR 14: PRINT "Index:";: COLOR 7: PRINT x&,
  103.         COLOR 14: PRINT "Content: ";: COLOR 12: PRINT "[";: COLOR 7: PRINT a$(x&);: COLOR 12: PRINT "]"; TAB(80);
  104.         COLOR 14: PRINT "Length:";: COLOR 7: PRINT LEN(a$(x&))
  105.     NEXT x&
  106.     PRINT
  107. PRINT "press any key ...": SLEEP
  108.  
  109.  
  110.  
  111.  
  112.  
  113. '--- Full description available in separate HTML document.
  114. '---------------------------------------------------------------------
  115. FUNCTION ParseLine& (inpLine$, sepChars$, quoChars$, outArray$(), minUB&)
  116. '--- option _explicit requirements ---
  117. DIM ilen&, icnt&, slen%, s1%, s2%, s3%, s4%, s5%, q1%, q2%
  118. DIM oalb&, oaub&, ocnt&, flag%, ch%, nest%, spos&, epos&
  119. '--- so far return nothing ---
  120. ParseLine& = -1
  121. '--- init & check some runtime variables ---
  122. ilen& = LEN(inpLine$): icnt& = 1
  123. IF ilen& = 0 THEN EXIT FUNCTION
  124. slen% = LEN(sepChars$)
  125. IF slen% > 0 THEN s1% = ASC(sepChars$, 1)
  126. IF slen% > 1 THEN s2% = ASC(sepChars$, 2)
  127. IF slen% > 2 THEN s3% = ASC(sepChars$, 3)
  128. IF slen% > 3 THEN s4% = ASC(sepChars$, 4)
  129. IF slen% > 4 THEN s5% = ASC(sepChars$, 5)
  130. IF slen% > 5 THEN slen% = 5 'max. 5 chars, ignore the rest
  131. IF LEN(quoChars$) > 0 THEN q1% = ASC(quoChars$, 1): ELSE q1% = 34
  132. IF LEN(quoChars$) > 1 THEN q2% = ASC(quoChars$, 2): ELSE q2% = q1%
  133. oalb& = LBOUND(outArray$): oaub& = UBOUND(outArray$): ocnt& = oalb&
  134. '--- skip preceding separators ---
  135. plSkipSepas:
  136. flag% = 0
  137. WHILE icnt& <= ilen& AND NOT flag%
  138.     ch% = ASC(inpLine$, icnt&)
  139.     SELECT CASE slen%
  140.         CASE 0: flag% = -1
  141.         CASE 1: flag% = ch% <> s1%
  142.         CASE 2: flag% = ch% <> s1% AND ch% <> s2%
  143.         CASE 3: flag% = ch% <> s1% AND ch% <> s2% AND ch% <> s3%
  144.         CASE 4: flag% = ch% <> s1% AND ch% <> s2% AND ch% <> s3% AND ch% <> s4%
  145.         CASE 5: flag% = ch% <> s1% AND ch% <> s2% AND ch% <> s3% AND ch% <> s4% AND ch% <> s5%
  146.     END SELECT
  147.     icnt& = icnt& + 1
  148. IF NOT flag% THEN 'nothing else? - then exit
  149.     IF ocnt& > oalb& GOTO plEnd
  150. '--- redim to clear array on 1st word/component ---
  151. IF ocnt& = oalb& THEN REDIM outArray$(oalb& TO oaub&)
  152. '--- expand array, if required ---
  153. plNextWord:
  154. IF ocnt& > oaub& THEN
  155.     oaub& = oaub& + 10
  156.     REDIM _PRESERVE outArray$(oalb& TO oaub&)
  157. '--- get current word/component until next separator ---
  158. flag% = 0: nest% = 0: spos& = icnt& - 1
  159. WHILE icnt& <= ilen& AND NOT flag%
  160.     IF ch% = q1% AND nest% = 0 THEN
  161.         nest% = 1
  162.     ELSEIF ch% = q1% AND nest% > 0 THEN
  163.         nest% = nest% + 1
  164.     ELSEIF ch% = q2% AND nest% > 0 THEN
  165.         nest% = nest% - 1
  166.     END IF
  167.     ch% = ASC(inpLine$, icnt&)
  168.     SELECT CASE slen%
  169.         CASE 0: flag% = (nest% = 0 AND (ch% = q1%)) OR (nest% = 1 AND ch% = q2%)
  170.         CASE 1: flag% = (nest% = 0 AND (ch% = s1% OR ch% = q1%)) OR (nest% = 1 AND ch% = q2%)
  171.         CASE 2: flag% = (nest% = 0 AND (ch% = s1% OR ch% = s2% OR ch% = q1%)) OR (nest% = 1 AND ch% = q2%)
  172.         CASE 3: flag% = (nest% = 0 AND (ch% = s1% OR ch% = s2% OR ch% = s3% OR ch% = q1%)) OR (nest% = 1 AND ch% = q2%)
  173.         CASE 4: flag% = (nest% = 0 AND (ch% = s1% OR ch% = s2% OR ch% = s3% OR ch% = s4% OR ch% = q1%)) OR (nest% = 1 AND ch% = q2%)
  174.         CASE 5: flag% = (nest% = 0 AND (ch% = s1% OR ch% = s2% OR ch% = s3% OR ch% = s4% OR ch% = s5% OR ch% = q1%)) OR (nest% = 1 AND ch% = q2%)
  175.     END SELECT
  176.     icnt& = icnt& + 1
  177. epos& = icnt& - 1
  178. IF ASC(inpLine$, spos&) = q1% THEN spos& = spos& + 1
  179. outArray$(ocnt&) = MID$(inpLine$, spos&, epos& - spos&)
  180. ocnt& = ocnt& + 1
  181. '--- more words/components following? ---
  182. IF flag% AND ch% = q1% AND nest% = 0 GOTO plNextWord
  183. IF flag% GOTO plSkipSepas
  184. IF (ch% <> q1%) AND (ch% <> q2% OR nest% = 0) THEN outArray$(ocnt& - 1) = outArray$(ocnt& - 1) + CHR$(ch%)
  185. '--- final array size adjustment, then exit ---
  186. plEnd:
  187. IF ocnt& - 1 < minUB& THEN ocnt& = minUB& + 1
  188. REDIM _PRESERVE outArray$(oalb& TO (ocnt& - 1))
  189. ParseLine& = ocnt& - 1
  190.  
  191.  

As it is required to preserve the UTF-8 encoding of the HTML Documentation, it is packed into an 7-zip archive file attached below. The archive does also contain the example from the codebox above.

6
QB64 Discussion / Tech question about file linking, anybody knows?
« on: July 21, 2021, 03:43:52 pm »
On Windows:

When I save a website in Firefox, eg. the QB64 Wiki Main page (Menu: File -> Save As / or respectively Ctrl-S), then Firefox does create a .html file with the actual site contents and a folder which contains all files (such as linked images, css etc.) required to properly show that site offline.

This .html file and the respective folder are linked in such a way, so that every action done to either in the Explorer does automatically do the same with the other. Ie. if I select the .html only and delete it, then it will automatically delete the folder too. If I move the folder to a new location, then the .html file will automatically follow that move. Same with copy.

Now I'm curious how this connection is done, as I could really use this feature for one of my programs. I looked at the properties of both, the .html and the respective folder, but there is nothing obvious telling how it's done.

The MKLINK command line instruction does not do this type of interconnection, and searching the internet for things like "file/folder interconnection", "file bindings", "file/folder link" and several similar phrases do not show up any useful stuff, but points always back to the MKLINK type linking.

So somehow this .html file and the folder must be magically connected, so that every action done on the one, does magically trigger the same action for the other. Is anybody here who could point me into the right direction?, maybe our WinAPI Guru @SpriggsySpriggs?

Any way to do such connections would be acceptable, SHELLing command line, powershell, vbs or even making a C-header directly using the WinAPI.

7
Programs / Bézier Curves (Demo)
« on: July 03, 2021, 07:59:39 pm »
Playing with Bézier curves in 2D and 3D space, see also: https://en.wikipedia.org/wiki/B%C3%A9zier_curve

SUB CalcFracPoints is calculating all intersection points for a specific fraction down from the given start degree to the final curve point, hence the very last point (UBOUND) in the output array contains the regular curve point, while the other points building the intersection lines from the start degree down to the first degree. Each degree ends with a stop flag.

Code: QB64: [Select]
  1. _TITLE "Bezier Curve 2D"
  2.  
  3. SCREEN _NEWIMAGE(640, 480, 256)
  4. ti& = _NEWIMAGE(640, 480, 256)
  5.  
  6.     x AS DOUBLE
  7.     y AS DOUBLE
  8.     z AS DOUBLE
  9.     s AS INTEGER
  10. REDIM points(0 TO 4) AS point
  11. REDIM spans(0 TO 2) AS point
  12.  
  13. points(0).x = 150 'start point
  14. points(0).y = 50
  15.  
  16. points(1).x = 50 'control point (handle)
  17. points(1).y = 430
  18.  
  19. points(2).x = 590 'control point (handle)
  20. points(2).y = 350
  21.  
  22. points(3).x = 320 'control point (handle)
  23. points(3).y = 160
  24.  
  25. points(4).x = 590 'end point
  26. points(4).y = 50
  27.  
  28. again:
  29. FOR f# = 0 TO 1.0 STEP 0.0025
  30.     _LIMIT 30
  31.     CalcFracPoints points(), spans(), f#
  32.     _DEST ti&
  33.     x# = spans(UBOUND(spans)).x
  34.     y# = spans(UBOUND(spans)).y
  35.     CIRCLE (x#, y#), 1, 12
  36.     CIRCLE (x#, y#), 2, 12
  37.     CIRCLE (x#, y#), 3, 12
  38.     _DEST 0
  39.     CLS
  40.     _PUTIMAGE , ti&
  41.     LOCATE 1, 1
  42.     PRINT "Fraction ="; f#
  43.     DrawLines points(), &HFFFF
  44.     DrawLines spans(), &B1001100110011001
  45.     FOR i% = LBOUND(spans) TO UBOUND(spans) - 1
  46.         CIRCLE (spans(i%).x, spans(i%).y), 1, 14
  47.         CIRCLE (spans(i%).x, spans(i%).y), 2, 14
  48.     NEXT i%
  49.     CIRCLE (x#, y#), 1, 4
  50.     CIRCLE (x#, y#), 2, 4
  51.     CIRCLE (x#, y#), 3, 12
  52.     CIRCLE (x#, y#), 4, 15
  53.     CIRCLE (x#, y#), 5, 15
  54.     _DISPLAY
  55. NEXT f#
  56. GOTO again
  57.  
  58. SUB CalcFracPoints (pIn() AS point, pOut() AS point, frac#)
  59. iLns% = UBOUND(pIn) - LBOUND(pIn) 'no +1 here, as lines = 1 less than points
  60. oPts% = (iLns% * (iLns% + 1)) / 2 'sum 1 to n, which is n(n+1)/2
  61. REDIM pOut(0 TO oPts% - 1) AS point
  62.  
  63. p% = 0
  64. FOR i% = LBOUND(pIn) TO UBOUND(pIn) - 1
  65.     pOut(p%).x = pIn(i%).x + frac# * (pIn(i% + 1).x - pIn(i%).x)
  66.     pOut(p%).y = pIn(i%).y + frac# * (pIn(i% + 1).y - pIn(i%).y)
  67.     pOut(p%).z = pIn(i%).z + frac# * (pIn(i% + 1).z - pIn(i%).z)
  68.     p% = p% + 1
  69. NEXT i%
  70. pOut(p% - 1).s = -1 'stop flag for drawing
  71.  
  72. FOR j% = iLns% TO 2 STEP -1
  73.     FOR i% = p% - j% TO p% - 2
  74.         pOut(p%).x = pOut(i%).x + frac# * (pOut(i% + 1).x - pOut(i%).x)
  75.         pOut(p%).y = pOut(i%).y + frac# * (pOut(i% + 1).y - pOut(i%).y)
  76.         pOut(p%).z = pOut(i%).z + frac# * (pOut(i% + 1).z - pOut(i%).z)
  77.         p% = p% + 1
  78.     NEXT i%
  79.     pOut(p% - 1).s = -1 'stop flag for drawing
  80. NEXT j%
  81.  
  82. SUB DrawLines (pIn() AS point, sty%)
  83. col~& = 1
  84. FOR i% = LBOUND(pIn) TO UBOUND(pIn) - 1
  85.     LINE (pIn(i%).x, pIn(i%).y)-(pIn(i% + 1).x, pIn(i% + 1).y), col~&, , sty%
  86.     IF pIn(i% + 1).s THEN
  87.         col~& = (col~& + 1) AND 15
  88.         i% = i% + 1 'skip to next sequence
  89.     END IF
  90. NEXT i%
  91.  
  92.  

Code: QB64: [Select]
  1. _TITLE "Bezier Curve 3D"
  2.  
  3. SCREEN _NEWIMAGE(640, 480, 256)
  4. ti& = _NEWIMAGE(640, 480, 256)
  5.  
  6.     x AS DOUBLE
  7.     y AS DOUBLE
  8.     z AS DOUBLE
  9.     s AS INTEGER
  10. REDIM points(0 TO 4) AS point
  11. REDIM spans(0 TO 2) AS point
  12.  
  13. DIM SHARED cx%, cy%
  14. cx% = -100: cy% = 400 '3D space origin
  15.  
  16. points(0).x = 150 'start point
  17. points(0).y = 50
  18. points(0).z = 0
  19.  
  20. points(1).x = 50 'control point (handle)
  21. points(1).y = 430
  22. points(1).z = 300
  23.  
  24. points(2).x = 590 'control point (handle)
  25. points(2).y = 350
  26. points(2).z = -500
  27.  
  28. points(3).x = 320 'control point (handle)
  29. points(3).y = 160
  30. points(3).z = 300
  31.  
  32. points(4).x = 590 'end point
  33. points(4).y = 50
  34. points(4).z = 0
  35.  
  36. again:
  37. _DEST ti&
  38. FOR i% = 0 TO 700 STEP 50
  39.     Line3D i%, 0, 0, i%, 700, 0, 15
  40.     Line3D 0, i%, 0, 700, i%, 0, 15
  41. NEXT i%
  42.  
  43. FOR f# = 0 TO 1.0 STEP 0.0025
  44.     _LIMIT 30
  45.     CalcFracPoints points(), spans(), f#
  46.     _DEST ti&
  47.     x# = spans(UBOUND(spans)).x
  48.     y# = spans(UBOUND(spans)).y
  49.     z# = spans(UBOUND(spans)).z
  50.     Circle3D x#, y#, z#, 1, 0, 12
  51.     _DEST 0
  52.     CLS
  53.     _PUTIMAGE , ti&
  54.     LOCATE 1, 1
  55.     PRINT "Fraction ="; f#
  56.     DrawLines points()
  57.     DrawLines spans()
  58.     FOR i% = LBOUND(spans) TO UBOUND(spans) - 1
  59.         Circle3D spans(i%).x, spans(i%).y, spans(i%).z, 1, 0, 14
  60.     NEXT i%
  61.     Circle3D x#, y#, z#, 2, 0, 4
  62.     _DISPLAY
  63. NEXT f#
  64. GOTO again
  65.  
  66. SUB CalcFracPoints (pIn() AS point, pOut() AS point, frac#)
  67. iLns% = UBOUND(pIn) - LBOUND(pIn) 'no +1 here, as lines = 1 less than points
  68. oPts% = (iLns% * (iLns% + 1)) / 2 'sum 1 to n, which is n(n+1)/2
  69. REDIM pOut(0 TO oPts% - 1) AS point
  70.  
  71. p% = 0
  72. FOR i% = LBOUND(pIn) TO UBOUND(pIn) - 1
  73.     pOut(p%).x = pIn(i%).x + frac# * (pIn(i% + 1).x - pIn(i%).x)
  74.     pOut(p%).y = pIn(i%).y + frac# * (pIn(i% + 1).y - pIn(i%).y)
  75.     pOut(p%).z = pIn(i%).z + frac# * (pIn(i% + 1).z - pIn(i%).z)
  76.     p% = p% + 1
  77. NEXT i%
  78. pOut(p% - 1).s = -1 'stop flag for drawing
  79.  
  80. FOR j% = iLns% TO 2 STEP -1
  81.     FOR i% = p% - j% TO p% - 2
  82.         pOut(p%).x = pOut(i%).x + frac# * (pOut(i% + 1).x - pOut(i%).x)
  83.         pOut(p%).y = pOut(i%).y + frac# * (pOut(i% + 1).y - pOut(i%).y)
  84.         pOut(p%).z = pOut(i%).z + frac# * (pOut(i% + 1).z - pOut(i%).z)
  85.         p% = p% + 1
  86.     NEXT i%
  87.     pOut(p% - 1).s = -1 'stop flag for drawing
  88. NEXT j%
  89.  
  90. SUB DrawLines (pIn() AS point)
  91. col~& = 1
  92. FOR i% = LBOUND(pIn) TO UBOUND(pIn) - 1
  93.     Line3D pIn(i%).x, pIn(i%).y, pIn(i%).z, pIn(i% + 1).x, pIn(i% + 1).y, pIn(i% + 1).z, col~&
  94.     IF pIn(i% + 1).s THEN
  95.         col~& = (col~& + 1) AND 15
  96.         i% = i% + 1 'skip to next sequence
  97.     END IF
  98. NEXT i%
  99.  
  100. SUB Line3D (x1%, y1%, z1%, x2%, y2%, z2%, col%)
  101. 'x1%/y1%/z1% = start, x2%/y2%/z2% = end, col% = color pen
  102. x1# = (x1% + (y1% * 0.1)): z1# = (z1% + (y1% * 0.1))
  103. x2# = (x2% + (y2% * 0.1)): z2# = (z2% + (y2% * 0.1))
  104. LINE (x1# + cx% - 1, -z1# + cy%)-(x2# + cx% - 1, -z2# + cy%), col%
  105. LINE (x1# + cx%, -z1# + cy%)-(x2# + cx%, -z2# + cy%), col%
  106. LINE (x1# + cx% + 1, -z1# + cy%)-(x2# + cx% + 1, -z2# + cy%), col%
  107.  
  108. SUB Circle3D (x%, y%, z%, r%, ba%, col%)
  109. 'x%/y%/z% = center, r% = radius, ba% = B-Axis angle, col% = color pen
  110. mx# = (x% + (y% * 0.1)): mz# = (z% + (y% * 0.1))
  111. zx# = r% * COS(ba% * 0.017453292519943)
  112. zz# = r% * SIN(ba% * 0.017453292519943)
  113. FOR cir% = 0 TO 359 STEP 5
  114.     x# = zx# * COS(cir% * 0.017453292519943)
  115.     y# = r% * SIN(cir% * 0.017453292519943)
  116.     z# = zz# * COS(cir% * 0.017453292519943)
  117.     x# = (x# + (y# * 0.1)): z# = (z# + (y# * 0.1))
  118.     LINE (x# + mx# + cx% - 1, -z# + -mz# + cy% - 1)-(x# + mx# + cx% + 1, -z# + -mz# + cy% + 1), col%, BF
  119. NEXT cir%
  120.  
  121.  

8
Programs / Antialiasing using Gauss or Average filters
« on: May 10, 2021, 05:10:45 pm »
This is a mini-version of my BinClock screen blanker. I made it to replace the old windows sidebar.exe based Clock, which is not available on Win10 anymore.

However, I mainly post it here to showcase how to achive antialiasing in QB64 programs by using Gauss or Average blurring filters.

Note you also need my Libraries Collection for this (see signature) and if you're not on Windows, then you may have to change the LOCALAPPDATA environment folder, which is used to save the current clock window position.

You may change the month abbreviations in lines 77-79 and assemble the date format (d$) in line 144 for your country if you want to.

Feel free to play with different filters in line 166 (see QB64Library\IMG-Support\docs\imageprocess.bm\ApplyFilter.html for available filters), the magnifying glass may help you to inspect the effects in detail.

Code: QB64: [Select]
  1. '+---------------+---------------------------------------------------+
  2. '| ###### ###### |     .--. .         .-.                            |
  3. '| ##  ## ##   # |     |   )|        (   ) o                         |
  4. '| ##  ##  ##    |     |--' |--. .-.  `-.  .  .-...--.--. .-.        |
  5. '| ######   ##   |     |  \ |  |(   )(   ) | (   ||  |  |(   )       |
  6. '| ##      ##    |     '   `'  `-`-'  `-'-' `-`-`|'  '  `-`-'`-      |
  7. '| ##     ##   # |                            ._.'                   |
  8. '| ##     ###### |  Sources & Documents placed in the Public Domain. |
  9. '+---------------+---------------------------------------------------+
  10. '|                                                                   |
  11. '| === NewClock.bas ===                                              |
  12. '|                                                                   |
  13. '| == A simple binary (BCD) clock inspired by the alien countdown    |
  14. '| == from the movie "Mission to Mars".                              |
  15. '| == For easy reading it also have digital and analog displays.     |
  16. '|                                                                   |
  17. '+-------------------------------------------------------------------+
  18. '| Done by RhoSigma, R.Heyder, provided AS IS, use at your own risk. |
  19. '| Find me in the QB64 Forum or mail to support&rhosigma-cw.net for  |
  20. '| any questions or suggestions. Thanx for your interest in my work. |
  21. '+-------------------------------------------------------------------+
  22.  
  23. 'get my local appdata folder
  24. lad$ = ENVIRON$("LOCALAPPDATA")
  25. IF lad$ <> "" THEN
  26.     IF RIGHT$(lad$, 1) <> "\" THEN lad$ = lad$ + "\"
  27. IF NOT _DIREXISTS(lad$ + "RhoSigma") THEN MKDIR lad$ + "RhoSigma"
  28. lad$ = lad$ + "RhoSigma\"
  29.  
  30. 'get old window position
  31. cfg$ = lad$ + "NewClock.bin"
  32.     OPEN "B", #1, cfg$
  33.     GET #1, , lft%
  34.     GET #1, , top%
  35.     CLOSE #1
  36.     lft% = -1: top% = -1
  37.  
  38. 'setup screen
  39. DIM SHARED scr&, tru&, col&
  40. scr& = _NEWIMAGE(300, 180, 32)
  41. SCREEN scr&
  42. tru& = _NEWIMAGE(300, 180, 32)
  43. col& = _NEWIMAGE(300, 180, 256)
  44. _SOURCE col&: _DEST col&
  45. _DELAY 0.2
  46. IF lft% < 0 OR top% < 0 THEN
  47.     _SCREENMOVE lft%, top%
  48. scrFont& = _LOADFONT("C:\Windows\Fonts\timesbd.ttf", 30)
  49. _FONT scrFont&
  50.  
  51. '3D space origin is on these screen coordinates
  52. DIM SHARED cx%: cx% = 8
  53. DIM SHARED cy%: cy% = 110
  54.  
  55. 'init BCD discs
  56. TYPE Disc
  57.     x AS INTEGER
  58.     y AS INTEGER
  59.     z AS INTEGER
  60.     r AS INTEGER
  61.     a AS INTEGER
  62. DIM SHARED Discs(23) AS Disc
  63. InitDiscs
  64. DIM SHARED curState&: curState& = 0
  65. DIM SHARED newState&: newState& = 0
  66.  
  67. 'init month names
  68. DIM SHARED month$(12)
  69. month$(1) = "Jan": month$(2) = "Feb": month$(3) = "Mar": month$(4) = "Apr"
  70. month$(5) = "May": month$(6) = "Jun": month$(7) = "Jul": month$(8) = "Aug"
  71. month$(9) = "Sep": month$(10) = "Oct": month$(11) = "Nov": month$(12) = "Dec"
  72.  
  73. 'draw hour/minute/seconds separators
  74. Line3D 52, 0, 0, 52, 210, 0, 2
  75. Line3D 52, 0, 0, 52, 0, -30, 2
  76. Line3D 128, 0, 0, 128, 210, 0, 2
  77. Line3D 128, 0, 0, 128, 0, -30, 2
  78.  
  79. 'mark binary factors
  80. _PRINTSTRING (8, 5), "8": Line3D -20, 180, 0, -70, 180, 0, 6
  81. _PRINTSTRING (8, 30), "4": Line3D -20, 130, 0, -45, 130, 0, 6
  82. _PRINTSTRING (280, 55), "2": Line3D 200, 80, 0, 225, 80, 0, 6
  83. _PRINTSTRING (280, 80), "1": Line3D 200, 30, 0, 250, 30, 0, 6
  84.  
  85. 'main loop
  86. _TITLE "Uhrzeit/Datum"
  87.     _LIMIT 1
  88.     FlipDiscs
  89.     IF _SCREENX <> -32000 AND _SCREENY <> -32000 THEN 'minimized?
  90.         IF _SCREENX <> lft% OR _SCREENY <> top% THEN 'position changed?
  91.             lft% = _SCREENX: top% = _SCREENY
  92.             OPEN "B", #1, cfg$
  93.             PUT #1, , lft%
  94.             PUT #1, , top%
  95.             CLOSE #1
  96.         END IF
  97.     END IF
  98.  
  99. 'cleanup
  100. _FREEFONT scrFont&
  101.  
  102. 'run the clock
  103. SUB FlipDiscs
  104. t$ = TIME$
  105. newState& = (VAL(MID$(t$, 1, 1)) * (2 ^ 20)) + (VAL(MID$(t$, 2, 1)) * (2 ^ 16)) +_
  106.             (VAL(MID$(t$, 4, 1)) * (2 ^ 12)) + (VAL(MID$(t$, 5, 1)) * (2 ^ 8)) +_
  107.             (VAL(MID$(t$, 7, 1)) * (2 ^ 4)) + (VAL(MID$(t$, 8, 1)) * (2 ^ 0))
  108. diff& = curState& XOR newState&
  109. curState& = newState&
  110. FOR rot% = 6 TO 90 STEP 6
  111.     FOR n% = 0 TO 23
  112.         IF (n% MOD 4) = 0 THEN AxisSegments Discs(n%).x
  113.         IF diff& AND (2 ^ n%) THEN
  114.             Circle3D Discs(n%).x, Discs(n%).y, Discs(n%).z, Discs(n%).r, Discs(n%).a, 0
  115.             Circle3D Discs(n%).x, Discs(n%).y, Discs(n%).z, Discs(n%).r, Discs(n%).a + 6, 15
  116.             Discs(n%).a = Discs(n%).a + 6
  117.             IF Discs(n%).a = 180 THEN Discs(n%).a = 0
  118.         ELSE
  119.             Circle3D Discs(n%).x, Discs(n%).y, Discs(n%).z, Discs(n%).r, Discs(n%).a, 15
  120.         END IF
  121.     NEXT n%
  122.     IF rot% = 54 THEN
  123.         'digital clock
  124.         COLOR 9
  125.         _PRINTSTRING (14, 117), MID$(t$, 1, 2)
  126.         _PRINTSTRING (84, 117), MID$(t$, 4, 2)
  127.         _PRINTSTRING (157, 117), MID$(t$, 7, 2)
  128.         d$ = MID$(DATE$, 4, 2) + ". " + month$(VAL(LEFT$(DATE$, 2))) + " " + RIGHT$(DATE$, 4)
  129.         _PRINTSTRING (98 - (_PRINTWIDTH(d$) / 2), 145), d$
  130.         'analog clock
  131.         LINE (242 - 34, 142 - 34)-(242 + 34, 142 + 34), 0, BF
  132.         CIRCLE (242, 142), 34, 14
  133.         CIRCLE (242, 142), 32, 6: t# = TIMER
  134.         x% = PolToCartX%((360 / 43200 * t#) - 90, 22)
  135.         y% = PolToCartY%((360 / 43200 * t#) - 90, 22)
  136.         LINE (242, 142)-(x% + 242, y% + 142), 14
  137.         x% = PolToCartX%((360 / 3600 * t#) - 90, 26)
  138.         y% = PolToCartY%((360 / 3600 * t#) - 90, 26)
  139.         LINE (242, 142)-(x% + 242, y% + 142), 10
  140.         x% = PolToCartX%((360 / 60 * t#) - 90, 28)
  141.         y% = PolToCartY%((360 / 60 * t#) - 90, 28)
  142.         LINE (242, 142)-(x% + 242, y% + 142), 12
  143.         x% = PolToCartX%((360 / 60 * t#) + 90, 7)
  144.         y% = PolToCartY%((360 / 60 * t#) + 90, 7)
  145.         LINE (242, 142)-(x% + 242, y% + 142), 12
  146.         CIRCLE (242, 142), 1, 12
  147.         CIRCLE (242, 142), 2, 12
  148.     END IF
  149.     _PUTIMAGE , col&, tru&
  150.     gau& = ApplyFilter&(tru&, "Gauss8", 0, 0, -1, -1, -1, -1, -1)
  151.     _PUTIMAGE , gau&, scr&
  152.     _FREEIMAGE gau&
  153.     _DISPLAY
  154. NEXT rot%
  155.  
  156. 'setup start values for all discs
  157. SUB InitDiscs
  158. n% = 0
  159. FOR i% = 180 TO 150 STEP -30
  160.     FOR j% = 30 TO 180 STEP 50
  161.         Discs(n%).x = i%
  162.         Discs(n%).y = j%
  163.         Discs(n%).z = 0
  164.         Discs(n%).r = 10
  165.         Discs(n%).a = 0
  166.         n% = n% + 1
  167.     NEXT j%
  168. NEXT i%
  169. FOR i% = 105 TO 75 STEP -30
  170.     FOR j% = 30 TO 180 STEP 50
  171.         Discs(n%).x = i%
  172.         Discs(n%).y = j%
  173.         Discs(n%).z = 0
  174.         Discs(n%).r = 10
  175.         Discs(n%).a = 0
  176.         n% = n% + 1
  177.     NEXT j%
  178. NEXT i%
  179. FOR i% = 30 TO 0 STEP -30
  180.     FOR j% = 30 TO 180 STEP 50
  181.         Discs(n%).x = i%
  182.         Discs(n%).y = j%
  183.         Discs(n%).z = 0
  184.         Discs(n%).r = 10
  185.         Discs(n%).a = 0
  186.         n% = n% + 1
  187.     NEXT j%
  188. NEXT i%
  189.  
  190. 'draw rotation axis segments between discs
  191. SUB AxisSegments (x%)
  192. Line3D x%, 0, 0, x%, 20, 0, 12
  193. Line3D x%, 40, 0, x%, 70, 0, 12
  194. Line3D x%, 90, 0, x%, 120, 0, 12
  195. Line3D x%, 140, 0, x%, 170, 0, 12
  196. Line3D x%, 190, 0, x%, 210, 0, 12
  197.  
  198. SUB Line3D (x1%, y1%, z1%, x2%, y2%, z2%, col%)
  199. 'x1%/y1%/z1% = start, x2%/y2%/z2% = end, col% = color pen
  200. x1# = (x1% + (y1% * 0.5)): z1# = (z1% + (y1% * 0.5))
  201. x2# = (x2% + (y2% * 0.5)): z2# = (z2% + (y2% * 0.5))
  202. LINE (x1# + cx%, -z1# + cy%)-(x2# + cx%, -z2# + cy%), col%
  203.  
  204. SUB Circle3D (x%, y%, z%, r%, ba%, col%)
  205. 'x%/y%/z% = center, r% = radius, ba% = B-Axis angle, col% = color pen
  206. mx# = (x% + (y% * 0.5)): mz# = (z% + (y% * 0.5))
  207. zx# = r% * COS(ba% * 0.017453292519943)
  208. zz# = r% * SIN(ba% * 0.017453292519943)
  209. FOR cir% = 0 TO 359 STEP 5
  210.     x# = zx# * COS(cir% * 0.017453292519943)
  211.     y# = r% * SIN(cir% * 0.017453292519943)
  212.     z# = zz# * COS(cir% * 0.017453292519943)
  213.     x# = (x# + (y# * 0.5)): z# = (z# + (y# * 0.5))
  214.     PSET (x# + mx# + cx%, -z# + -mz# + cy%), col%
  215. NEXT cir%
  216.  
  217. '$INCLUDE: 'QB64Library\IMG-Support\converthelper.bm'
  218. '$INCLUDE: 'QB64Library\IMG-Support\imageprocess.bm'
  219.  
  220.  

9
QB64 Discussion / Visual improvements to SUBs dialog. (latest git)
« on: February 15, 2021, 04:54:22 am »
@FellippeHeitor, I hope it is not one of the improvements, that the arguments list is cropped after the first SUB/FUNCTION argument. It's essential for quick reference to see the entire arguments list at least as far as the dialog width allows. That's why I've disabled the line count feature from the first day, to rather have more space for the arguments.

10
QB64 Discussion / DATA constants with type suffix, opinions needed...
« on: February 07, 2021, 08:59:21 am »
I'am currently working on a fix for Github issue #124 to allow type suffixes for numeric values in DATA/READ constructs. However, the current implementation does impose some limits, so I'd like to ask for some opinions on how far the implementation of type suffixes should go here.

In general there are two very similar functions in libqb.cpp called "n_inputnumberfromdata" and "n_inputnumberfromfile". The interresting thing here is, that the "file" function simply ignores any invalid chars, where the "data" function will throw an "Syntax Error", so my first thought was just to ignore those conditions for the "data" function too, but the second thought was: Wait a moment!! - A file may usually be seen as an external 3rd party resource not under control of the application developer, hence it is absolutely legitimate to just ignore any misformatted file data and try to interpret the read number as good as possible (best guess). - In DATA/READ constructs otherwise the application developer can be held responsible for any nonsense he enters into the DATA lines, hence kickin' his ass with a "Syntax Error" is absolutely legitimate here too.

So what "n_inputnumberfromdata" basically does, is not more than copying the chars found in DATAs into a temporary buffer and while doing so is just checking, if there are number related chars only (such as -, +, ., digits 0-9 etc.). It will, however, in no way evaluate the read number yet, as that is just done one step further using the functions "func_read_float", "func_read_int64" and "func_read_uint64". Which of these 3 functions is called depends on the variable types you give at the READ statement. These functions take the chars from the temporary buffer (see above) and evaluate it into the actual number, but as you can see they simply use the biggest possible variable type to do so, hence using type suffixes on the numbers it only easily allow us to distinguish between integer types %%,%,&,&& and floating point types !,#,## and unsigned ~ for integers, but we can't distinguish between the actual size/precision of the variable types. To implement that, it would need a massive intervention into the whole function calling chain involved in reading numbers from DATA, respectively files, which use the same evaluation functions.

I'd prefer to waive to this massive interventions, as we would risk a whole bunch of new number related bugs, so I'll let you know what I have so far and listen to your thoughts, if that is enough type suffix support or not.

1.) Any type suffixes in DATA numbers are ignored in general doesn't matter of their kind or count, ie. you could write any combination of suffixes, even non existing or ambiguous ones like %~&!, ###&~ etc.. However, here I personally tend to improve it to allow real suffixes only, which would be not that big deal to do from the point I'm right now.

2.) If unsigned (~) is found, but the number is obviously entered as a negative number (leading -) in the DATAs, it's an error.

3.) If an integer type (%,&) is found, and the number would obviously evaluate into a floating point value, it's an error. Eg. 1.111&, 1E-5%, but not 1.111E+3& or 1E+5%. Hence, if the exponent (implied or explicitly given) is positive and equal to the number of digits after the decimal dot, then the
integer condition is fulfilled.

4.) If more digits, dots or exponents follow after the first type symbol, it's an error, eg. 125&.45, 125%E+5 etc..

5.) Now for given HEX/OCT/BIN numbers, those are introduced with & and need to be followed by either letter of H/O/B (case ignored), otherwise it's an error, further see 1.), but allowing integer suffixes only is an option.

6.) HEX/OCT/BIN is always evaluated as unsigned value unless it's in the _INTEGER64 range, where it would be signed, if the most significant bit is set (this all is imposed by the fact that the evaluation functions operate on int64/uint64 only). Changing this behaviour would require a lot of intervention, as the type suffixes are known to "n_inputnumberfromdata" only, but the size/sign of the evaluation would need to go into the "func_read_int64/uint64" functions. Also an explicit sign precheck on bits 63/31/15/8 need to be put into "n_inputnumberfromdata" then.
And even if this would all work as expected, then it would impose a new rule how to write HEX/OCT/BIN DATAs correctly, eg. &Hff, &H8000, &H81f2a000 would then evaluate into negative numbers unless they are given with explicit types eg. &Hff&, &H8000~%, &H81f2a000&&, which certainly would again confuse many people, I know we had such discussions several times in the forum already.

So now it's time for you guys, what do you think?? - Done as is, or what??


11
QB64 Discussion / Beautiful BIOS Fonts
« on: January 25, 2021, 02:42:17 am »
Hi there,

just want to bring this fonts collection back to your attention https://int10h.org/oldschool-pc-fonts/fontlist/

It got several updates with lots of new fonts since it was last mentioned here on the forum back in early 2018.

As a pearl in  there I'd also like to point you to this one https://int10h.org/oldschool-pc-fonts/fontlist/?4#robotron

It's my new favorite for now, as it brings back a lot of memories. The Robotron A7100 was the first computer I ever had access to back in school (1985), when I was still behind the wall and never dreamed of, that I once in a time would be able to play and have fun with the rest of the world.
The A7100 was made in the GDR (former East Germany) with mostly soviet electronics components, as far as I remember it was also the first 16bit machine made in the communist east block.
Have a look on that machine at Google: https://www.google.de/search?q=Robotron+A7100&source=lnms&tbm=isch&sa=X&ved=2ahUKEwiw8LLqybbuAhVOWysKHRoWC68Q_AUoAnoECA0QBA&biw=1024&bih=631

Finally the download page for the new font collection:
https://int10h.org/oldschool-pc-fonts/download/

12
Programs / Format$ function with indexed & reusable arguments
« on: August 18, 2020, 05:41:50 pm »
As the title says,
this is a Format$ function (PRINT USING style), which allows for explicit argument indexing in the given format template. The indexing feature lets you change the template being processed while keeping the arguments stream the same.

This can be an invaluable tool in some situations, just think about different date formats. With PRINT USING alone you would probably need to reorder your day, month, year, weekday etc. arguments for every date format to match the order of the respective format tokens in the template, but not so with this function. Another example is when it comes to localizing your programs, where it helps when translating template strings to different languages and the sentence structure and thus the order of the arguments changes.

Beside the indexing, which this function got its name from, it has a couple other useful extensions compared to the regular PRINT USING conventions, such as bin/hex/oct formatting, use of escape sequences to insert control or extended ASCII chars and more. All of this is detailed in the comprehensive HTML Documentation available for download below the example code block.

An example using the new IndexFormat function:
Save as: FormatExample.bas (or whatever)
Code: QB64: [Select]
  1. _TITLE "FormatExample"
  2. '=== Full description for the IndexFormat$() function is available
  3. '=== in the separate HTML document.
  4. '=====================================================================
  5. WIDTH , 30
  6.  
  7.  
  8. '-- The following format templates need its arguments in different order,
  9. '-- no problem with indexing, no need to reorder the given arguments.
  10. '-- You may even use different formatting for the same argument, as long
  11. '-- as its types are compatible (ie. string vs. number).
  12. dateDE$ = "Date format Germany: 0{#}. 1{&} 2{####}" ' 1{} = full string
  13. dateUS$ = "Date format US     : 1{\ \}/0{#} 2{####}" '1{} = first 3 chars only
  14.  
  15. '-- The easiest way to pass a variable number of arguments, which may
  16. '-- even be of different types, to a user function is using a string.
  17. '-- All arguments will be concatenated in this string, separated by a
  18. '-- designated char/string which does not appear in the arguments itself.
  19. '-- Strings can be added as is, numbers can be added as literal strings
  20. '-- too, or in the form STR$(variable).
  21. year% = 2021
  22. argStr$ = "2|Januar|" + STR$(year%)
  23. '-- In this example the | is the argument separator. Use whatever is
  24. '-- suitable for your needs, maybe even a CHR$(0).
  25.  
  26. '-- Now let's test the whole thing, we've different token orders in the
  27. '-- format templates, but use the same argument string for both calls.
  28. PRINT IndexFormat$(dateDE$, argStr$, "|")
  29. PRINT IndexFormat$(dateUS$, argStr$, "|")
  30.  
  31.  
  32.  
  33. '-- And here the examples from the function description, which also
  34. '-- shows the reuse of arguments without the need to pass more arguments
  35. '-- for the additional "feet" and "toes" format tokens.
  36. head = 1: hands = 2: fingers = 10
  37. PRINT USING "## head, ## hands and ## fingers"; head, hands, fingers
  38. PRINT USING "## fingers, ## head and ## hands"; head, hands, fingers
  39.  
  40. argStr$ = STR$(head) + "|" + STR$(hands) + "|" + STR$(fingers)
  41. PRINT IndexFormat$("2{##} fingers, 0{##} head and 1{##} hands", argStr$, "|")
  42. PRINT IndexFormat$("0{##} head, 1{##} hands and 2{##} fingers, also 1{##} feet and 2{##} toes", argStr$, "|")
  43.  
  44.  
  45.  
  46. '-- The function can also handle escape sequences as known from C/C++,
  47. '-- so you may use those sequences within your format templates.
  48. PRINT IndexFormat$("Column-1\tColumn-2\tColumn-3\n0{#.##}\t\t1{#.##}\t\t2{#.##}", "1.11|2.22|3.33", "|")
  49. PRINT IndexFormat$("This is a \x220{&}\x22 section.", "quoted", "|")
  50. '-- Using escape sequences and the new bin/dec/hex/oct/real formatting,
  51. '-- while reusing the same argument for all tokens. Also showing the use
  52. '-- of preferences specifiers to group bin and hex outputs.
  53. PRINT IndexFormat$(" Bin: 0{?4:B16}\n Dec: 0{D}\n Hex: 0{?2:H8}\n Oct: 0{O}\nReal: 0{R}\n", "2021.00548", "|")
  54.  
  55.  
  56.  
  57. '-- Alignment of strings in a fixed length field, the square brackets are
  58. '-- just used to better visualize the field.
  59. PRINT IndexFormat$("[0{?L:\             \}]", "RhoSigma", "|")
  60. PRINT IndexFormat$("[0{?C:\             \}]", "RhoSigma", "|")
  61. PRINT IndexFormat$("[0{?R:\             \}]", "RhoSigma", "|")
  62.  
  63.  
  64.  
  65. '-- Finally a currency example with replaced dollar sign and flipped
  66. '-- comma/dot notation. I'd like to get that much for this function ;)
  67. PRINT IndexFormat$("Account balance: 0{?î,:**$#####,.##}", "12345.67", "|")
  68.  
  69.  
  70. '-- done
  71.  
  72.  
  73.  
  74.  
  75.  
  76. '--- Full description available in separate HTML document.
  77. '---------------------------------------------------------------------
  78. FUNCTION IndexFormat$ (fmt$, arg$, sep$)
  79. '--- option _explicit requirements ---
  80. DIM args$, shan&, dhan&, than&, idx%, cpos&, res$, lit%, tok%, ft$, cch$
  81. DIM och$, opos&, tmp$, fp$, tyl%, typ$, oval&&, temp~&&, curr%, high%
  82. '--- init ---
  83. args$ = arg$ 'avoid side effects
  84. shan& = _SOURCE: dhan& = _DEST: than& = _NEWIMAGE(256, 1, 0)
  85. _SOURCE than&: _DEST than&
  86. REDIM argArr$(0 TO 35) 'all args empty
  87. '--- parse arguments ---
  88. IF RIGHT$(args$, LEN(sep$)) <> sep$ THEN args$ = args$ + sep$
  89. FOR idx% = 0 TO 35
  90.     cpos& = INSTR(args$, sep$): IF cpos& = 0 THEN EXIT FOR
  91.     argArr$(idx%) = LEFT$(args$, cpos& - 1)
  92.     args$ = MID$(args$, cpos& + LEN(sep$))
  93. NEXT idx%
  94. '--- process format template ---
  95. res$ = "": lit% = 0: tok% = 0: ft$ = "": idx% = -1
  96. FOR cpos& = 1 TO LEN(fmt$)
  97.     cch$ = MID$(fmt$, cpos&, 1)
  98.     IF cch$ = "_" AND lit% = 0 THEN 'take next \{} as literal
  99.         IF NOT tok% THEN lit% = -1
  100.     ELSEIF cch$ = "\" AND lit% = 0 AND tok% = 0 THEN 'insert esc sequence
  101.         IF cpos& < LEN(fmt$) THEN
  102.             SELECT CASE UCASE$(MID$(fmt$, cpos& + 1, 1))
  103.                 CASE "A": och$ = CHR$(7) ' audio bell
  104.                 CASE "B": och$ = CHR$(8) ' backspace
  105.                 CASE "T": och$ = CHR$(9) ' tabulator
  106.                 CASE "N": och$ = CHR$(10) 'line feed
  107.                 CASE "V": och$ = CHR$(11) 'vertical tabulator
  108.                 CASE "F": och$ = CHR$(12) 'form feed
  109.                 CASE "R": och$ = CHR$(13) 'carriage return
  110.                 CASE "E": och$ = CHR$(27) 'escape
  111.                 CASE "0", "1", "2", "3" '  octal ASCII (3 digits)
  112.                     och$ = CHR$(VAL("&O" + MID$(fmt$, cpos& + 1, 3)))
  113.                     cpos& = cpos& + 2
  114.                 CASE "X" '                 hex ASCII (x + 2 digits)
  115.                     och$ = CHR$(VAL("&H" + MID$(fmt$, cpos& + 2, 2)))
  116.                     cpos& = cpos& + 2
  117.                 CASE ELSE: och$ = "" '     ignore unknowns
  118.             END SELECT
  119.             res$ = res$ + och$
  120.             cpos& = cpos& + 1: opos& = cpos&
  121.         END IF
  122.     ELSEIF cch$ = "{" AND lit% = 0 THEN 'begin of formatting token
  123.         IF idx% = -1 THEN
  124.             och$ = UCASE$(MID$(fmt$, cpos& - 1, 1)): tok% = -1
  125.             IF ((cpos& - 1) = opos&) OR ((och$ < "0" OR och$ > "9") AND (och$ < "A" OR och$ > "Z")) THEN och$ = "-"
  126.             IF och$ = "-" THEN och$ = "0": ELSE res$ = LEFT$(res$, LEN(res$) - 1)
  127.             IF och$ >= "A" THEN idx% = ASC(och$) - 55: ELSE idx% = VAL(och$)
  128.         END IF
  129.     ELSEIF cch$ = "}" AND lit% = 0 THEN 'end of formatting token
  130.         IF idx% >= 0 THEN
  131.             GOSUB doArgFormat: res$ = res$ + tmp$
  132.             tok% = 0: ft$ = "": idx% = -1
  133.         END IF
  134.     ELSE 'accumulate chars/symbols in correct channel
  135.         IF lit% AND INSTR("\{}", cch$) = 0 THEN cch$ = "_" + cch$
  136.         IF tok% THEN ft$ = ft$ + cch$: ELSE res$ = res$ + cch$
  137.         lit% = 0
  138.     END IF
  139. NEXT cpos&
  140. '--- cleanup & set result ---
  141. ERASE argArr$
  142. _SOURCE shan&: _DEST dhan&: _FREEIMAGE than&
  143. IndexFormat$ = res$
  144. '-----------------------------
  145. doArgFormat:
  146. CLS: tmp$ = "": fp$ = "": ft$ = LTRIM$(RTRIM$(ft$))
  147. IF LEFT$(ft$, 1) = "?" THEN
  148.     tyl% = INSTR(2, ft$, ":")
  149.     IF tyl% > 0 THEN fp$ = LEFT$(MID$(ft$, 2, tyl% - 2), 2): ft$ = LTRIM$(MID$(ft$, tyl% + 1)) 'extract format prefs
  150. IF ft$ = "" THEN RETURN 'empty token = empty formatted
  151.     CASE "!", "&", "\" 'regular string formatting
  152.         IF LEFT$(ft$, 1) = "\" THEN
  153.             tyl% = INSTR(2, ft$, "\"): IF tyl% = 0 THEN ft$ = "\" + ft$: tyl% = 2
  154.             IF LTRIM$(fp$) <> "" AND LEN(argArr$(idx%)) < tyl% THEN
  155.                 SELECT CASE LEFT$(LTRIM$(fp$), 1)
  156.                     CASE "C", "c": tyl% = (tyl% - LEN(argArr$(idx%))) \ 2
  157.                     CASE "R", "r": tyl% = tyl% - LEN(argArr$(idx%))
  158.                     CASE ELSE: tyl% = 0 'L or Unknown is default (left)
  159.                 END SELECT
  160.                 argArr$(idx%) = SPACE$(tyl%) + argArr$(idx%)
  161.             END IF
  162.         END IF
  163.         PRINT USING ft$; argArr$(idx%);: fp$ = ""
  164.     CASE "B", "D", "H", "O", "R" 'extended number formatting (bin/dec/hex/oct/real)
  165.         typ$ = LEFT$(ft$, 1): tyl% = VAL(MID$(ft$, 2))
  166.         SELECT CASE typ$
  167.             CASE "B", "b": GOSUB doBinString
  168.             CASE "D", "d": tmp$ = LTRIM$(STR$(_ROUND(VAL(argArr$(idx%)))))
  169.             CASE "H", "h"
  170.                 tmp$ = HEX$(VAL(argArr$(idx%)))
  171.                 IF typ$ = "H" THEN tmp$ = UCASE$(tmp$): ELSE tmp$ = LCASE$(tmp$)
  172.             CASE "O", "o": tmp$ = OCT$(VAL(argArr$(idx%)))
  173.             CASE "R", "r": tmp$ = LTRIM$(STR$(VAL(argArr$(idx%)))): fp$ = ""
  174.         END SELECT
  175.         IF tyl% > 0 THEN 'adjust field length (if any)
  176.             IF LEN(tmp$) <= tyl% THEN
  177.                 tmp$ = RIGHT$(STRING$(tyl%, "0") + tmp$, tyl%): idx% = INSTR(tmp$, "-")
  178.                 IF idx% > 0 THEN
  179.                     typ$ = UCASE$(MID$(tmp$, idx% - 1, 1))
  180.                     IF typ$ <> "E" AND typ$ <> "D" THEN tmp$ = "-" + LEFT$(tmp$, idx% - 1) + MID$(tmp$, idx% + 1)
  181.                 END IF
  182.             ELSE
  183.                 tmp$ = "%" + tmp$
  184.             END IF
  185.         END IF
  186.         IF LTRIM$(fp$) <> "" THEN 'apply grouping (if any)
  187.             typ$ = "": tyl% = 0
  188.             FOR idx% = LEN(tmp$) TO 1 STEP -1
  189.                 typ$ = MID$(tmp$, idx%, 1) + typ$: tyl% = tyl% + 1
  190.                 IF tyl% = VAL(fp$) THEN typ$ = " " + typ$: tyl% = 0
  191.             NEXT idx%
  192.             tmp$ = LTRIM$(typ$): IF LEFT$(tmp$, 2) = "- " THEN tmp$ = "-" + MID$(tmp$, 3)
  193.         END IF
  194.         RETURN
  195.     CASE ELSE 'regular number formatting (or invalid nonsense)
  196.         IF INSTR(ft$, "**") = 0 AND INSTR(ft$, "$$") = 0 AND INSTR(ft$, "#") = 0 THEN
  197.             PRINT ft$; 'take nonsense as is
  198.         ELSE
  199.             PRINT USING ft$; VAL(argArr$(idx%));
  200.         END IF
  201. tyl% = INSTR(fp$, ","): IF tyl% > 0 THEN MID$(fp$, tyl%, 1) = " "
  202. fp$ = LTRIM$(RTRIM$(fp$))
  203. FOR idx% = 1 TO POS(0) - 1
  204.     typ$ = CHR$(SCREEN(1, idx%)): ft$ = typ$
  205.     IF fp$ <> "" AND typ$ = "$" THEN ft$ = fp$
  206.     IF tyl% > 0 AND typ$ = "," THEN ft$ = "."
  207.     IF tyl% > 0 AND typ$ = "." THEN ft$ = ","
  208.     tmp$ = tmp$ + ft$
  209. NEXT idx%
  210. '-----------------------------
  211. doBinString:
  212. oval&& = VAL(argArr$(idx%)): temp~&& = oval&&
  213. tmp$ = STRING$(64, "0"): curr% = 64: high% = 64
  214.     IF (temp~&& AND 1) THEN ASC(tmp$, curr%) = 49: high% = curr%
  215.     curr% = curr% - 1: temp~&& = temp~&& \ 2
  216. LOOP UNTIL temp~&& = 0
  217. IF oval&& < 0 THEN
  218.     IF -oval&& < &H0080000000~&& THEN high% = 33
  219.     IF -oval&& < &H0000008000~&& THEN high% = 49
  220.     IF -oval&& < &H0000000080~&& THEN high% = 57
  221. tmp$ = MID$(tmp$, high%)
  222.  
  223.  

As it is required to preserve the UTF-8 encoding of the HTML Documentation and some preformatted examples, it is packed into an 7-zip archive file attached below. The archive does also contain the example from the codebox above.

13
Programs / External Module Player (XMP)
« on: August 01, 2020, 04:30:40 pm »
Almost 4 month ago I suggested this as a possible enhancement for QB64 v1.5 here (https://www.qb64.org/forum/index.php?topic=2446). As there were absolutely no reactions to it, I assume that the number of potential users for this stuff is so low, that it's not worth the efforts to put it into QB64.

However, as proof of concept and for the few people who might be interested in, here comes a little demo to showcase the usage of this player library in form of a DLL.

NOTE: This is outdated, please follow the green link above to the most recent update of this demo program.

EDIT: Outdated codebox removed, see note above...

14
QB64 Discussion / What's going on here?
« on: May 04, 2020, 06:21:19 am »
Hi admins,

since approx. 24 houres I notice a massive Guest activity on the Who's online page:
https://www.qb64.org/forum/index.php?action=who

but it seems the same topics are referenced every second, Is our forum being attacked?

15
This library (http://xmp.sourceforge.net/) integrated into the QB64 parts system could greatly improve the sound abilities of QB64 by easily addding dozens of well known and even some obscure music tracker formats from various platforms ontop of the already existing sound functions.

Pages: [1] 2 3