and another one for your toolbox...

[bplus]

For sure, I'd like it too, if each function would add its respective prefix, but it would break compatiblity with legacy code. But on the other side HEX$, OCT$ and now BIN$ belong to the same type of function and should behave the same way, that's why I didn't add the &B prefix.

From a different point of view, &B is a new addition added in or after v1.0, that's basically the reason why QB64 misses the built-in BIN$ function. So if BIN$ is QB64 specific, shouldn't it be _BIN$ intead? And what do we do with the binary prefix then, _&B ??

Of course _&B is silly but hmm... _HEX$, _OCT$, _BIN$ that use prefixes all! not terrible ;)

[bplus]

Reconsidered again, I use the string all the time without the &B (we have the number value already when we call the function so not likely need to convert back Plus it is easier to add than to remove, so

Code: QB64: [Select]

1. FUNCTION BIN$ (integerBase10 AS _INTEGER64) 'no more &B because easier to add than to remove
2.     DIM j AS INTEGER
3.     IF integerBase10 = 0 THEN BIN$ = "0": EXIT FUNCTION
4.     WHILE 2 ^ j <= integerBase10
5.         IF (integerBase10 AND 2 ^ j) > 0 THEN BIN$ = "1" + BIN$ ELSE BIN$ = "0" + BIN$
6.         j = j + 1
7.     WEND
8. END FUNCTION
9.  

The function just needs 1 variable, so I use something of Rho's

[RhoSigma]

And finally ... a speed test:

Code: QB64: [Select]

1. _TITLE "BIN$ speed test..."
2. PRINT "BIN$ speed test ... System: "; _OS$: PRINT
3. PRINT "TB = current version from Toolbox board"
4. PRINT "BP = latest version from B+"
5. PRINT "RS = version from RhoSigma"
6. PRINT
7.  
8. '--- for a fair test we need the same numbers for all
9. '--- functions, so we first fill an array with numbers
10. REDIM num&(1000000)
11. FOR i& = 0 TO 1000000
12.     num&(i&) = INT(RND(1) * 1000000000) + 1000000000
13. NEXT i&
14.  
15. '--- Toolbox ---
16. st# = TIMER(0.001)
17. PRINT "TB-Start:"; st#
18. FOR i& = 0 TO 1000000
19.     b$ = BIN_TB$(num&(i&))
20. NEXT i&
21. et# = TIMER(0.001)
22. IF et# = st# THEN et# = et# + 0.001 'avoid div by zero below
23. PRINT "TB-End..:"; et#
24. PRINT "Run-Time:"; et# - st#; "sec."
25. PRINT "Speed...:"; 1000000 / (et# - st#); "LONGs/sec."
26. PRINT
27.  
28. '--- bplus ---
29. st# = TIMER(0.001)
30. PRINT "BP-Start:"; st#
31. FOR i& = 0 TO 1000000
32.     b$ = BIN_BP$(num&(i&))
33. NEXT i&
34. et# = TIMER(0.001)
35. IF et# = st# THEN et# = et# + 0.001 'avoid div by zero below
36. PRINT "BP-End..:"; et#
37. PRINT "Run-Time:"; et# - st#; "sec."
38. PRINT "Speed...:"; 1000000 / (et# - st#); "LONGs/sec."
39. PRINT
40.  
41. '--- RhoSigma ---
42. st# = TIMER(0.001)
43. PRINT "RS-Start:"; st#
44. FOR i& = 0 TO 1000000
45.     b$ = BIN_RS$(num&(i&))
46. NEXT i&
47. et# = TIMER(0.001)
48. IF et# = st# THEN et# = et# + 0.001 'avoid div by zero below
49. PRINT "RS-End..:"; et#
50. PRINT "Run-Time:"; et# - st#; "sec."
51. PRINT "Speed...:"; 1000000 / (et# - st#); "LONGs/sec."
52. PRINT
53. '--- cleanup & wait ---
54. PRINT "...done, press any key"
55. ERASE num&
56. SLEEP
57. SYSTEM
58.  
59. '================================
60. '=== AND HERE COMES THE MAGIC ===
61. '================================
62.  
63. FUNCTION BIN_TB$ (integerBase10 AS _INTEGER64)
64.     DIM i AS _INTEGER64, pow AS INTEGER, b$
65.     IF integerBase10 = 0 THEN BIN_TB$ = "&B0": EXIT FUNCTION
66.     i = integerBase10 'copy
67.     pow = 0
68.     WHILE i > 0
69.         IF i AND 2 ^ pow THEN
70.             b$ = "1" + b$
71.             i = i - 2 ^ pow
72.         ELSE
73.             b$ = "0" + b$
74.         END IF
75.         pow = pow + 1
76.     WEND
77.     BIN_TB$ = "&B" + b$
78. END FUNCTION
79.  
80. FUNCTION BIN_BP$ (integerBase10 AS _INTEGER64) 'no more &B because easier to add than to remove
81.     DIM j AS INTEGER
82.     IF integerBase10 = 0 THEN BIN_BP$ = "0": EXIT FUNCTION
83.     WHILE 2 ^ j <= integerBase10
84.         IF (integerBase10 AND 2 ^ j) > 0 THEN BIN_BP$ = "1" + BIN_BP$ ELSE BIN_BP$ = "0" + BIN_BP$
85.         j = j + 1
86.     WEND
87. END FUNCTION
88.  
89. FUNCTION BIN_RS$ (value&&)
90.     DIM v&&, vi&&
91.     BIN_RS$ = "": v&& = value&&
92.     DO
93.         vi&& = INT(v&& / 2)
94.         IF v&& / 2 = vi&& THEN BIN_RS$ = "0" + BIN_RS$: ELSE BIN_RS$ = "1" + BIN_RS$
95.         v&& = vi&&
96.     LOOP UNTIL v&& = 0
97. END FUNCTION
98.  
99.  

[RhoSigma]

And here is my final one,
it's even twice as fast as my first one (which is in the speed test) by simply avoiding the temporary string operations done under the QB64 hood when adding the "0" or "1" into an existing string. It cuts the times to approx. 3.05 sec. with the x86 build and 2.54 sec. with x64.

Code: QB64: [Select]

1. FUNCTION BIN$ (value&&)
2.     'chp% = char position, msp% = most significant position
3.     'tlv&& = temporary loop value, ivq&& = integer value quotient
4.     DIM chp%, msp%, tlv&&, ivq&&
5.     tlv&& = value&&
6.     BIN$ = STRING$(64, "0"): chp% = 64: msp% = 64
7.     DO
8.         ivq&& = INT(tlv&& / 2)
9.         IF tlv&& / 2 <> ivq&& THEN MID$(BIN$, chp%, 1) = "1": msp% = chp%
10.         chp% = chp% - 1: tlv&& = ivq&&
11.     LOOP UNTIL tlv&& = 0
12.     BIN$ = MID$(BIN$, msp%)
13. END FUNCTION
14.  
15.  

[bplus]

Dang now I have to revise mine! OK very nice lesson about concatenation!

Here is my new version (and NOT final version) against RhoSigma's, had to add another 0 to the test and dump the time consuming array:

Code: QB64: [Select]

1. _TITLE "BIN$ speed test..." 'Bplus mod of RhoSigma's 2019-12-03
2. PRINT "BIN$ speed test ... System: "; _OS$: PRINT
3. PRINT "BP = latest version from B+"
4. PRINT "RS = latest from RhoSigma"
5. PRINT
6.  
7. '--- for a fair test we need the same numbers for all
8. '--- functions, so we first fill an array with numbers
9.  
10. PRINT "First test print BIN$ of 0:"
11. PRINT "Bplus has "; bpBIN$(0)
12. PRINT "RhoSigma has "; rsBIN$(0)
13. PRINT "Press key to continue... "
14. SLEEP
15. CLS
16. FOR i = 1 TO 7
17.     r = INT(RND * 10 ^ i)
18.     PRINT "For random number r = "; r
19.     PRINT "   Bplus has "; bpBIN$(r)
20.     PRINT "RhoSigma has "; rsBIN$(r)
21. NEXT
22. PRINT "Press key to continue... "
23. SLEEP
24. CLS
25. '--- bplus ---
26. st# = TIMER(0.001)
27. PRINT "BP-Start:"; st#
28. FOR i&& = 0 TO 10000000
29.     b$ = bpBIN$(i&&)
30. NEXT
31. et# = TIMER(0.001)
32. IF et# = st# THEN et# = et# + 0.001 'avoid div by zero below
33. PRINT "BP-End..:"; et#
34. PRINT "Run-Time:"; et# - st#; "sec."
35. PRINT
36.  
37. '--- RhoSigma ---
38. st# = TIMER(0.001)
39. PRINT "RS-Start:"; st#
40. FOR i&& = 0 TO 10000000
41.     b$ = rsBIN$(i&&)
42. NEXT
43. et# = TIMER(0.001)
44. IF et# = st# THEN et# = et# + 0.001 'avoid div by zero below
45. PRINT "RS-End..:"; et#
46. PRINT "Run-Time:"; et# - st#; "sec."
47. PRINT
48. '--- cleanup & wait ---
49. PRINT "...done, press any key"
50.  
51. SLEEP
52. SYSTEM
53.  
54. '================================
55. '=== AND HERE COMES THE MAGIC ===
56. '================================
57.  
58. FUNCTION rsBIN$ (value&&)
59.     'chp% = char position, msp% = most significant position
60.     'tlv&& = temporary loop value, ivq&& = integer value quotient
61.     DIM chp%, msp%, tlv&&, ivq&&
62.     tlv&& = value&&
63.     rsBIN$ = STRING$(64, "0"): chp% = 64: msp% = 64
64.     DO
65.         ivq&& = INT(tlv&& / 2)
66.         IF tlv&& / 2 <> ivq&& THEN MID$(rsBIN$, chp%, 1) = "1": msp% = chp%
67.         chp% = chp% - 1: tlv&& = ivq&&
68.     LOOP UNTIL tlv&& = 0
69.     rsBIN$ = MID$(rsBIN$, msp%)
70. END FUNCTION
71.  
72. FUNCTION bpBIN$ (integerBase10 AS _INTEGER64) 'no more &B because easier to add than to remove
73.     DIM j AS _INTEGER64, place AS INTEGER
74.     j = 1: place = 64: bpBIN$ = STRING$(64, "0")
75.     WHILE j <= integerBase10
76.         IF (integerBase10 AND j) > 0 THEN MID$(bpBIN$, place, 1) = "1" ELSE MID$(bpBIN$, place, 1) = "0"
77.         j = j * 2: place = place - 1
78.     WEND
79.     bpBIN$ = MID$(bpBIN$, place + 1)
80.     IF bpBIN$ = "" THEN bpBIN$ = "0"
81. END FUNCTION
82.  
83.  

[RhoSigma]

The really final one ??? :)

used bitshift instead of division, and unrolled the loop for the smallest integer type (_BYTE). Have also tweaked yours a bit B+, j=j+j (instead j*2) and removed the "0" (ELSE) branch from your condition. Your string consists of zeros, no need to write them for each tested bit.

Make sure your QB64 version is recent enough to have the _SHR instruction...

Code: QB64: [Select]

1. _TITLE "BIN$ speed test..." 'Bplus mod of RhoSigma's 2019-12-03
2. PRINT "BIN$ speed test ... System: "; _OS$: PRINT
3. PRINT "BP = latest version from B+"
4. PRINT "RS = latest from RhoSigma"
5. PRINT
6.  
7. '--- for a fair test we need the same numbers for all
8. '--- functions, so we first fill an array with numbers
9.  
10. PRINT "First test print BIN$ of 0:"
11. PRINT "Bplus has "; bpBIN$(0)
12. PRINT "RhoSigma has "; rsBIN$(0)
13. PRINT "Press key to continue... "
14. SLEEP
15. CLS
16. FOR i = 1 TO 7
17.     r = INT(RND * 10 ^ i)
18.     PRINT "For random number r = "; r
19.     PRINT "   Bplus has "; bpBIN$(r)
20.     PRINT "RhoSigma has "; rsBIN$(r)
21. NEXT
22. PRINT "Press key to continue... "
23. SLEEP
24. CLS
25. '--- bplus ---
26. st# = TIMER(0.001)
27. PRINT "BP-Start:"; st#
28. FOR i&& = 0 TO 10000000
29.     b$ = bpBIN$(i&&)
30. NEXT
31. et# = TIMER(0.001)
32. IF et# = st# THEN et# = et# + 0.001 'avoid div by zero below
33. PRINT "BP-End..:"; et#
34. PRINT "Run-Time:"; et# - st#; "sec."
35. PRINT
36.  
37. '--- RhoSigma ---
38. st# = TIMER(0.001)
39. PRINT "RS-Start:"; st#
40. FOR i&& = 0 TO 10000000
41.     b$ = rsBIN$(i&&)
42. NEXT
43. et# = TIMER(0.001)
44. IF et# = st# THEN et# = et# + 0.001 'avoid div by zero below
45. PRINT "RS-End..:"; et#
46. PRINT "Run-Time:"; et# - st#; "sec."
47. PRINT
48. '--- cleanup & wait ---
49. PRINT "...done, press any key"
50.  
51. SLEEP
52. SYSTEM
53.  
54. '================================
55. '=== AND HERE COMES THE MAGIC ===
56. '================================
57.  
58. FUNCTION rsBIN$ (value&&)
59.     'tlv&& = temporary loop value
60.     'chp% = char position, msp% = most significant position
61.     DIM tlv&&, chp%, msp%
62.     tlv&& = value&&
63.     rsBIN$ = STRING$(64, "0"): chp% = 64: msp% = 64
64.     DO
65.         IF (tlv&& AND 1) THEN MID$(rsBIN$, chp%, 1) = "1": msp% = chp%
66.         IF (tlv&& AND 2) THEN MID$(rsBIN$, chp% - 1, 1) = "1": msp% = chp% - 1
67.         IF (tlv&& AND 4) THEN MID$(rsBIN$, chp% - 2, 1) = "1": msp% = chp% - 2
68.         IF (tlv&& AND 8) THEN MID$(rsBIN$, chp% - 3, 1) = "1": msp% = chp% - 3
69.         IF (tlv&& AND 16) THEN MID$(rsBIN$, chp% - 4, 1) = "1": msp% = chp% - 4
70.         IF (tlv&& AND 32) THEN MID$(rsBIN$, chp% - 5, 1) = "1": msp% = chp% - 5
71.         IF (tlv&& AND 64) THEN MID$(rsBIN$, chp% - 6, 1) = "1": msp% = chp% - 6
72.         IF (tlv&& AND 128) THEN MID$(rsBIN$, chp% - 7, 1) = "1": msp% = chp% - 7
73.         chp% = chp% - 8
74.         tlv&& = _SHR(tlv&&, 8)
75.     LOOP UNTIL tlv&& = 0
76.     rsBIN$ = MID$(rsBIN$, msp%)
77. END FUNCTION
78.  
79. FUNCTION bpBIN$ (integerBase10 AS _INTEGER64) 'no more &B because easier to add than to remove
80.     DIM j AS _INTEGER64, place AS INTEGER
81.     j = 1: place = 64: bpBIN$ = STRING$(64, "0")
82.     WHILE j <= integerBase10
83.         IF (integerBase10 AND j) > 0 THEN MID$(bpBIN$, place, 1) = "1"
84.         j = j + j: place = place - 1
85.     WEND
86.     bpBIN$ = MID$(bpBIN$, place + 1)
87.     IF bpBIN$ = "" THEN bpBIN$ = "0"
88. END FUNCTION
89.  
90.  

[RhoSigma]

And now my really really really FINAL one, yes REALLY :)

improved using _MEM and CHECKING:OFF

Once again, make sure your QB64 version is recent enough to have the _SHR instruction...

Code: QB64: [Select]

1. _TITLE "BIN$ speed test..." 'Bplus mod of RhoSigma's 2019-12-03
2. PRINT "BIN$ speed test ... System: "; _OS$: PRINT
3. PRINT "BP = latest version from B+"
4. PRINT "RS = latest from RhoSigma"
5. PRINT
6.  
7. '--- for a fair test we need the same numbers for all
8. '--- functions, so we first fill an array with numbers
9.  
10. PRINT "First test print BIN$ of 0:"
11. PRINT "Bplus has "; bpBIN$(0)
12. PRINT "RhoSigma has "; rsBIN$(0)
13. PRINT "Press key to continue... "
14. SLEEP
15. CLS
16. FOR i = 1 TO 7
17.     r = INT(RND * 10 ^ i)
18.     PRINT "For random number r = "; r
19.     PRINT "   Bplus has "; bpBIN$(r)
20.     PRINT "RhoSigma has "; rsBIN$(r)
21. NEXT
22. PRINT "Press key to continue... "
23. SLEEP
24. CLS
25. '--- bplus ---
26. st# = TIMER(0.001)
27. PRINT "BP-Start:"; st#
28. FOR i&& = 0 TO 10000000
29.     b$ = bpBIN$(i&&)
30. NEXT
31. et# = TIMER(0.001)
32. IF et# = st# THEN et# = et# + 0.001 'avoid div by zero below
33. PRINT "BP-End..:"; et#
34. PRINT "Run-Time:"; et# - st#; "sec."
35. PRINT
36.  
37. '--- RhoSigma ---
38. st# = TIMER(0.001)
39. PRINT "RS-Start:"; st#
40. FOR i&& = 0 TO 10000000
41.     b$ = rsBIN$(i&&)
42. NEXT
43. et# = TIMER(0.001)
44. IF et# = st# THEN et# = et# + 0.001 'avoid div by zero below
45. PRINT "RS-End..:"; et#
46. PRINT "Run-Time:"; et# - st#; "sec."
47. PRINT
48. '--- cleanup & wait ---
49. PRINT "...done, press any key"
50.  
51. SLEEP
52. SYSTEM
53.  
54. '================================
55. '=== AND HERE COMES THE MAGIC ===
56. '================================
57.  
58. FUNCTION rsBIN$ (value&&)
59.     'tlv&& = temporary loop value, b$64 = fixed length temporary string
60.     'chp% = char position mem offset, msp% = most significant string position
61.     'one% = ascii code of "1", mp = memory pointer to b$64
62.     DIM tlv&&, b$64, chp%, msp%, mp AS _MEM
63.     $CHECKING:OFF
64.     tlv&& = value&&
65.     b$64 = STRING$(64, "0"): chp% = 63: msp% = 64: one% = 49
66.     mp = _MEM(b$64)
67.     DO
68.         IF (tlv&& AND 1) THEN _MEMPUT mp, mp.OFFSET + chp%, one% AS _BYTE: msp% = chp% + 1
69.         IF (tlv&& AND 2) THEN _MEMPUT mp, mp.OFFSET + chp% - 1, one% AS _BYTE: msp% = chp%
70.         IF (tlv&& AND 4) THEN _MEMPUT mp, mp.OFFSET + chp% - 2, one% AS _BYTE: msp% = chp% - 1
71.         IF (tlv&& AND 8) THEN _MEMPUT mp, mp.OFFSET + chp% - 3, one% AS _BYTE: msp% = chp% - 2
72.         IF (tlv&& AND 16) THEN _MEMPUT mp, mp.OFFSET + chp% - 4, one% AS _BYTE: msp% = chp% - 3
73.         IF (tlv&& AND 32) THEN _MEMPUT mp, mp.OFFSET + chp% - 5, one% AS _BYTE: msp% = chp% - 4
74.         IF (tlv&& AND 64) THEN _MEMPUT mp, mp.OFFSET + chp% - 6, one% AS _BYTE: msp% = chp% - 5
75.         IF (tlv&& AND 128) THEN _MEMPUT mp, mp.OFFSET + chp% - 7, one% AS _BYTE: msp% = chp% - 6
76.         chp% = chp% - 8
77.         tlv&& = _SHR(tlv&&, 8)
78.     LOOP UNTIL tlv&& = 0
79.     _MEMFREE mp
80.     rsBIN$ = MID$(b$64, msp%)
81.     $CHECKING:ON
82. END FUNCTION
83.  
84. FUNCTION bpBIN$ (integerBase10 AS _INTEGER64) 'no more &B because easier to add than to remove
85.     DIM j AS _INTEGER64, place AS INTEGER
86.     j = 1: place = 64: bpBIN$ = STRING$(64, "0")
87.     WHILE j <= integerBase10
88.         IF (integerBase10 AND j) > 0 THEN MID$(bpBIN$, place, 1) = "1"
89.         j = j + j: place = place - 1
90.     WEND
91.     bpBIN$ = MID$(bpBIN$, place + 1)
92.     IF bpBIN$ = "" THEN bpBIN$ = "0"
93. END FUNCTION
94.  
95.  

[SMcNeill]

I still like this version, for myself:

Code: QB64: [Select]

1. n$ = bin$(12, 1)
2. PRINT n$, VAL(n$)
3.  
4. n$ = bin$(-2, 1) 'byte
5. PRINT n$, VAL(n$)
6.  
7. n$ = bin$(-2, 2) 'integer
8. PRINT n$, VAL(n$)
9.  
10. FUNCTION bin$ (n AS _INTEGER64, Rbytes AS _BYTE)
11.     STATIC m AS _MEM
12.     DIM b AS _BYTE, i AS INTEGER, l AS LONG, i64 AS _INTEGER64
13.     IF n < 1 THEN 'the user needs to tell us how many return bytes they expect
14.         SELECT CASE Rbytes 'assign the value to the proper mem type
15.             CASE 1: m = _MEM(b): b = n '1 for a byte
16.             CASE 2: m = _MEM(i): i = n '2 for an integer
17.             CASE 4:: m = _MEM(l): l = n '4 for a long
18.             CASE 8: m = _MEM(i64): i64 = n '8 for an integer64
19.             CASE ELSE: bin$ = "WRONG RETURN TYPE!": EXIT FUNCTION
20.         END SELECT
21.     ELSE
22.         m = _MEM(n): l = 8 'just use the number as we passed it
23.     END IF
24.  
25.     $CHECKING:OFF
26.     FOR i1 = 0 TO Rbytes - 1
27.         FOR j = 0 TO 7 '8 bytes per length and 8 bits in each byte
28.             IF _MEMGET(m, m.OFFSET + i1, _BYTE) AND 2 ^ j THEN b$ = "1" + b$ ELSE b$ = "0" + b$
29.     NEXT j, i1
30.     $CHECKING:ON
31.     bin$ = "&B" + MID$(b$, INSTR(b$, "1"))
32. END FUNCTION
33.  

Unlike all the rest, this is isn't built with speed being it's deciding factor -- flexibility is.  It returns BIN$ for both positive and negative values, and for various variable types.  I don't usually find myself needing to be concerned with "how fast can I turn a number into a binary string", so this is designed more for "how useful can it be, when turning a number into a binary string". 

n$ = bin$(-2, 1) <--- This would return the binary value of -2, if I was dealing with bytes.
n$ = bin$(-2, 4) <--- This would return the binary value of -2, if I was dealing with longs.

Not only does it work for positive numbers, but it also works with negative ones, and returns them back to us for whatever variable type which we might want it to.

[bplus]

Yeah I suspected this was going to get into bit shifting and MEM but did not expect for Type variables, ha ;-))

And agree it's getting kind of crazy to be completely focused on speed. (Specially since I don't think I am going to get a faster one than RhoSigma. LOL)

@Steve, you really have an actual use for binary strings for different variable types or are you going to make one up now? ;) Even for MEM stuff I would think you need number values not strings?

[SMcNeill]

Yeah I suspected this was going to get into bit shifting and MEM but did not expect for Type variables, ha ;-))

And agree it's getting kind of crazy to be completely focused on speed.

@Steve, you really have an actual use for binary strings for different variable types or are you going to make one up now? Even for MEM stuff I would think you need number values not strings?

Mainly for teaching purposes, to help explain to people why COLOR -1 in 32-bit is the same as color &HFFFFFFFF.   (A shortcut I use all the time!)

As you say, normally you use AND bit_value, rather than AND VAL(MID$(BIN$(number), position,1)).  ;)

[bplus]

I put this in edit but decided it's best in full reply to RhoSigma's efforts:
Update: oh heck I missed the ELSE replace with "0" thing, nice catch.

RhoSigma, really, really nice work! you make my version better and then cut that time in half or so... :)

[RhoSigma]

Thanks B+,

I saw it already in your edit. And yes, in general I do also prefer readability end elegance over speed (GuiTools is the best prove), but nevertheless it was a nice brain training to see what's possible and what you can do to take out as many as possible of the time consuming "under the hood" operations, which regulary nobody even think of.

[bplus]

Added a much needed line to InputG function when _DISPLAY is activated.
https://www.qb64.org/forum/index.php?topic=1511.msg110651#msg110651

[bplus]

A number of tools have been updated or added, here is best versions of some routines discussed earlier in this thread.

8 routines added or improved to my toolbox today 2019-12-16, what a day!

Code: QB64: [Select]

1. ' 2019-12-16 updates to my Toolbox Listing
2.  
3. '2019-12-16 fix by Steve saves some time with STATIC and saves and restores last dest
4. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
5.     DIM D AS LONG
6.     STATIC a&
7.     D = _DEST
8.     IF a& = 0 THEN a& = _NEWIMAGE(1, 1, 32)
9.     _DEST a&
10.     _DONTBLEND a& '  '<<<< new 2019-12-16 fix
11.     PSET (0, 0), K
12.     _BLEND a& '<<<< new 2019-12-16 fix
13.     _DEST D
14.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
15. END SUB
16.  
17. 'update 2019-12-16 needs updated fTri 2019-12-16  I like this ordering of points better
18. 'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
19. SUB fquad (x1, y1, x2, y2, x3, y3, x4, y4, K AS _UNSIGNED LONG)
20.     ftri x1, y1, x2, y2, x3, y3, K
21.     ftri x3, y3, x4, y4, x1, y1, K
22. END SUB
23.  
24. ' 2019-12-16 this should have been in here earlier
25. SUB EllipseFill (CX AS INTEGER, CY AS INTEGER, a AS INTEGER, b AS INTEGER, C AS _UNSIGNED LONG)
26.     ' CX = center x coordinate
27.     ' CY = center y coordinate
28.     '  a = semimajor axis
29.     '  b = semiminor axis
30.     '  C = fill color
31.     IF a = 0 OR b = 0 THEN EXIT SUB
32.     DIM h2 AS _INTEGER64
33.     DIM w2 AS _INTEGER64
34.     DIM h2w2 AS _INTEGER64
35.     DIM x AS INTEGER
36.     DIM y AS INTEGER
37.     w2 = a * a
38.     h2 = b * b
39.     h2w2 = h2 * w2
40.     LINE (CX - a, CY)-(CX + a, CY), C, BF
41.     DO WHILE y < b
42.         y = y + 1
43.         x = SQR((h2w2 - y * y * w2) \ h2)
44.         LINE (CX - x, CY + y)-(CX + x, CY + y), C, BF
45.         LINE (CX - x, CY - y)-(CX + x, CY - y), C, BF
46.     LOOP
47. END SUB
48.  
49. 'thanks STxAxTIC from Toolbox
50. SUB EllipseTilt (CX, CY, a, b, ang, C AS _UNSIGNED LONG)
51.     DIM k, i, j
52.     '  CX = center x coordinate
53.     '  CY = center y coordinate
54.     '   a = semimajor axis  major radius
55.     '   b = semiminor axis  minor radius
56.     ' ang = clockwise orientation of semimajor axis in radians (0 default)
57.     '   C = fill color
58.     FOR k = 0 TO 6.283185307179586 + .025 STEP .025 'not sure about the stepper it should depend on a and b
59.         i = a * COS(k) * COS(ang) + b * SIN(k) * SIN(ang)
60.         j = -a * COS(k) * SIN(ang) + b * SIN(k) * COS(ang)
61.         i = i + CX
62.         j = -j + CY
63.         IF k <> 0 THEN
64.             LINE -(i, j), C
65.         ELSE
66.             PSET (i, j), C
67.         END IF
68.     NEXT
69. END SUB
70.  
71. 'relace toolbox code  2019-12-16
72. 'this needs RotoZoom3 to rotate image and EllipseFill to make the image BUT it can now scale it also!
73. SUB fTiltEllipse (destH AS LONG, ox AS INTEGER, oy AS INTEGER, majorRadius AS INTEGER, minorRadius AS INTEGER, radianAngle AS SINGLE, c AS _UNSIGNED LONG)
74.     'setup isolated area, draw fFlatEllipse and then RotoZoom the image into destination
75.     'ox, oy is center of ellipse
76.     'majorRadius is 1/2 the lonest axis
77.     'minorRadius is 1/2 the short axis
78.     'radianAngle is the Radian Angle of Tilt
79.     'c is of course color
80.     DIM sd&, temp&
81.     sd& = _DEST
82.     temp& = _NEWIMAGE(2 * majorRadius, 2 * minorRadius, 32)
83.     _DEST temp&
84.     _DONTBLEND temp& '<< test 12-16
85.     'fEllipse majorRadius, minorRadius, majorRadius, minorRadius, c
86.     EllipseFill majorRadius, minorRadius, majorRadius, minorRadius, c
87.     _BLEND temp& '<< test 12-16
88.     _DEST destH
89.     RotoZoom3 ox, oy, temp&, 1, 1, radianAngle
90.     _FREEIMAGE temp&
91.     _DEST sd&
92. END SUB
93.  
94. SUB RotoZoom3 (X AS LONG, Y AS LONG, Image AS LONG, xScale AS SINGLE, yScale AS SINGLE, radianRotation AS SINGLE)
95.     ' this assumes you have set your drawing location with _dest or default to screen
96.     ' X, Y is where you want to put the middle of the image
97.     ' Image is the handle assigned with _LOADIMAGE
98.     ' xScale, yScale are shrinkage < 1 or magnification > 1 on the given axis
99.     ' radianRotation is the Angle in Radian units to rotate the image
100.  
101.     DIM px(3) AS SINGLE: DIM py(3) AS SINGLE ' simple arrays for x, y to hold the 4 corners of image
102.     DIM W&, H&, sinr!, cosr!, i&, x2&, y2& '   variables for image manipulation
103.     W& = _WIDTH(Image&): H& = _HEIGHT(Image&)
104.     px(0) = -W& / 2: py(0) = -H& / 2 'left top corner
105.     px(1) = -W& / 2: py(1) = H& / 2 ' left bottom corner
106.     px(2) = W& / 2: py(2) = H& / 2 '  right bottom
107.     px(3) = W& / 2: py(3) = -H& / 2 ' right top
108.     sinr! = SIN(-radianRotation): cosr! = COS(-radianRotation) ' rotation helpers
109.     FOR i& = 0 TO 3 ' calc new point locations with rotation and zoom
110.         x2& = xScale * (px(i&) * cosr! + sinr! * py(i&)) + X: y2& = yScale * (py(i&) * cosr! - px(i&) * sinr!) + Y
111.         px(i&) = x2&: py(i&) = y2&
112.     NEXT
113.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
114.     _MAPTRIANGLE _SEAMLESS(0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
115. END SUB
116.  
117. '=================================================================================================================== String stuff
118. '---------------------------------------------------------------------
119. 'RhoSigma keeps saying final version but then...
120. 'here is reference: https://www.qb64.org/forum/index.php?topic=1933.msg112096#msg112096
121. 'Function:  Convert any given dec/hex/oct number into a binary string.
122. '           Can handle positive and negative values and works in that
123. '           similar to the QB64 built-in HEX$ and OCT$ functions.
124. '
125. 'Synopsis:  binary$ = BIN$ (value&&)
126. '
127. 'Result:    binary$ --> the binary representation string of the given
128. '                       number without leading zeros for positive values
129. '                       and either 8/16/32 or 64 chars for negatives,
130. '                       depending on the input size
131. '
132. 'Inputs:    value&& --> the pos./neg. number to convert, may also be
133. '                       given as &H or &O prefixed value
134. '
135. 'Notes:     You may also pass in floating point values, as long as its
136. '           represented value fits into the _INTEGER64 (&&) input, hence
137. '           approx. -9.223372036854776E+18 to 9.223372036854776E+18.
138. '           Different from HEX$ and OCT$, BIN$ won't throw an overflow
139. '           error, if this range is exceeded, but the result is probably
140. '           wrong in such a case.
141. '---------------------------------------------------------------------
142. FUNCTION BIN$ (value&&)
143. '--- option _explicit requirements ---
144. DIM temp~&&, charPos%, highPos%
145. '--- init ---
146. temp~&& = value&&
147. BIN$ = STRING$(64, "0"): charPos% = 64: highPos% = 64
148. '--- convert ---
149. DO
150.     IF (temp~&& AND 1) THEN MID$(BIN$, charPos%, 1) = "1": highPos% = charPos%
151.     charPos% = charPos% - 1: temp~&& = temp~&& \ 2
152. LOOP UNTIL temp~&& = 0
153. '--- adjust negative size ---
154. IF value&& < 0 THEN
155.     IF -value&& < &HFFFFFFFF~& THEN highPos% = 33
156.     IF -value&& < &H0000FFFF~& THEN highPos% = 49
157.     IF -value&& < &H000000FF~& THEN highPos% = 57
158.     IF -value&& < &H00000000~& THEN highPos% = 1
159. END IF
160. '--- set result ---
161. BIN$ = MID$(BIN$, highPos%)
162. END FUNCTION
163.  
164. 'update 2019-12-16 in ...test\graphics\fTri tests.bas  SLEEP with a click
165. SUB cSleep (secsWait AS DOUBLE) 'wait for keypress or mouseclick, solves midnight problem nicely I think
166.     DIM wayt AS INTEGER, oldMouse AS INTEGER, k AS LONG, startTime AS DOUBLE
167.     oldMouse = -1 '2019-12-16 2nd fix today assume an old mouse click is still active
168.     startTime = TIMER
169.     wayt = 1
170.     _KEYCLEAR
171.     WHILE wayt
172.         WHILE _MOUSEINPUT: WEND
173.         IF _MOUSEBUTTON(1) AND oldMouse = 0 THEN wayt = 0
174.         oldMouse = _MOUSEBUTTON(1) ' <<< this is Steve's cool way to get clear of mouse click
175.         k = _KEYHIT: IF k > 0 THEN _KEYCLEAR: wayt = 0
176.         IF TIMER - startTime < 0 THEN 'past midnight
177.             IF TIMER + 24 * 60 * 60 - startTime > secsWait THEN wayt = 0
178.         ELSE
179.             IF TIMER - startTime >= secsWait THEN wayt = 0
180.         END IF
181.         _LIMIT 30
182.     WEND
183. END SUB
184.  
185.  

EDIT: 2019-12-17 RhoSigma changed final version of BIN$ again

EDIT: 2020-03-03 Discovered big error in revised RotoZoom3 now fixed

[FellippeHeitor]

8 routines added or improved to my toolbox today 2019-12-16, what a day!

It is wholesome to see this community so active and going so strong. Moment of appreciation here.