Author Topic: and another one for your toolbox...  (Read 21255 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
Re: and another one for your toolbox...
« Reply #30 on: November 01, 2019, 01:03:29 pm »
Another common problem brought up by Zeppelin here:
https://www.qb64.org/forum/index.php?topic=1822.0

inputG SUB
A quick way to get an INPUT variable on a graphics screen.
Code: QB64: [Select]
  1. _TITLE "Graphics Input, inputG test" 'b+ 2019-11-01
  2. '2019-11-01 TempodiBasic makes a fine point, 2 little changes
  3. SCREEN _NEWIMAGE(800, 600, 32)
  4. _SCREENMOVE 300, 20
  5. y = 200: x = 100
  6.     P$ = "Enter something like *testing 1, 2, 3... * about 20 chars max > "
  7.     expectedEnterLen% = 20
  8.     inputG x, y, P$, inpt$, expectedEnterLen%
  9.     IF inpt$ = "" THEN EXIT DO
  10.     PRINT "You entered: "; inpt$
  11.     y = y + 25
  12.     x = x + 30
  13.     IF x + (LEN(P$) + expectedEnterLen% + 5) * 8 > _WIDTH THEN x = 1
  14. PRINT "Test is done when empty string returned by inputG."
  15.  
  16. 'INPUT for Graphics screen
  17. SUB inputG (x, y, prmpt$, var$, expectedLenVar%) 'input for a graphics screen x, y is where the prompt will start , returns through var$
  18.     DIM tmp$, k$, saveAD
  19.     saveAD = _AUTODISPLAY
  20.     _KEYCLEAR
  21.     _PRINTSTRING (x, y), prmpt$ + " {}"
  22.     IF saveAD <> -1 THEN _DISPLAY  ' EDIT: 2019-12-05 added this line
  23.     DO
  24.         k$ = INKEY$
  25.         IF LEN(k$) = 1 THEN
  26.             SELECT CASE ASC(k$)
  27.                 CASE 13: var$ = tmp$: EXIT SUB
  28.                 CASE 27: var$ = "": EXIT SUB
  29.                 CASE 8 'backspace
  30.                     IF LEN(tmp$) THEN
  31.                         IF LEN(tmp$) = 1 THEN tmp$ = "" ELSE tmp$ = LEFT$(tmp$, LEN(tmp$) - 1)
  32.                     END IF
  33.                 CASE ELSE: IF ASC(k$) > 31 THEN tmp$ = tmp$ + k$
  34.             END SELECT
  35.             _PRINTSTRING (x, y), prmpt$ + " {" + tmp$ + "}" + SPACE$(expectedLenVar% - LEN(tmp$)) 'spaces needed at end to clear backspace chars
  36.             IF saveAD <> -1 THEN _DISPLAY
  37.         END IF
  38.     LOOP
  39.  

I expect this will be edited as refinements are brought up.

Steve recommended Terry Ritchie's library but the learning curve for that! Plus he's not here any more to answer questions... this kind of formality is for computer scientists IMHO.

Anyway, another good one or at least a good start for a handy tool.

EDIT #1: TempodiBasic makes a fine point and now 2 little changes have been made.
EDIT #2: Sorry Terry, I can't remember to spell your name correctly.
EDIT #3: 2019-12-05 Discovered a much needed _DISPLAY line when _DISPLAY has been activated.
« Last Edit: September 12, 2020, 03:16:50 pm by bplus »

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
Re: and another one for your toolbox...
« Reply #31 on: November 01, 2019, 05:14:29 pm »
Fine !
The bag of tool has another function!

PS: one little feedback INKEY$ brings also the keys with two bytes into the input taken, for example  arrow keys are added to the string returned by the SUB inputG.
Programming isn't difficult, only it's  consuming time and coffee

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
Re: and another one for your toolbox...
« Reply #32 on: November 01, 2019, 11:40:32 pm »
Fine !
The bag of tool has another function!

PS: one little feedback INKEY$ brings also the keys with two bytes into the input taken, for example  arrow keys are added to the string returned by the SUB inputG.

You make fine point, I make 2 changes 1=2 ;-))

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
Re: and another one for your toolbox...
« Reply #33 on: November 02, 2019, 01:40:19 pm »
Great Bplus
your improvement is clear and makes the SUB inputG more powerful and useful!
Programming isn't difficult, only it's  consuming time and coffee

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
Re: and another one for your toolbox...
« Reply #34 on: November 02, 2019, 02:12:55 pm »
Thank you for your feedback, TempodiBasic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
Re: and another one for your toolbox...
« Reply #35 on: November 03, 2019, 09:38:25 pm »
Update on Load and Sort, cut 4 more lines when applied here using Type definition:
https://www.qb64.org/forum/index.php?topic=1833.msg110748#msg110748

so this Load and Sort tool is on it's 3rd improvement!
https://www.qb64.org/forum/index.php?topic=1511.msg110459#msg110459

hmm... wonder how Steve missed that? ;-) busy on the farm I bet!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
Re: and another one for your toolbox...
« Reply #36 on: November 20, 2019, 12:55:41 am »
Really handy for drawing ftri and fquad to avoid Paint fills for polygons.

Here is demo using fquad (which uses ftri twice) to make a cube:
Code: QB64: [Select]
  1. _TITLE "Cube It"
  2. CONST xmax = 1200, ymax = 600
  3. SCREEN _NEWIMAGE(xmax, ymax, 32)
  4. _SCREENMOVE 100, 40
  5.  
  6. PRINT " bplus was here "
  7. DIM section(127, 16)
  8. FOR y = 0 TO 16
  9.     FOR x = 0 TO 127
  10.         IF POINT(x, y) <> _RGB32(0, 0, 0) THEN section(x, y) = 1
  11.     NEXT
  12.  
  13. FOR l = 0 TO -32 * 4 STEP -4
  14.     FOR y = 8 TO 8 * 16 STEP 8
  15.         FOR x = 127 * 8 TO 0 STEP -8
  16.             IF section(x / 8, y / 8) THEN cube2 x - l + 25, 350 + y + l, 16, &HFF88BBFF
  17.         NEXT
  18.     NEXT
  19.     _DISPLAY
  20.     _LIMIT 30
  21.  
  22. SUB cube2 (x, y, side, c~&)
  23.     sd2 = side / 2
  24.     LINE (x + sd2, y)-STEP(sd2 - 1, sd2 - 1), c~&, BF
  25.     r = _RED32(c~&): g = _GREEN32(c~&): b = _BLUE32(c~&)
  26.     fquad x + sd2, y, x + sd2, y + sd2, x, y + side, x, y + sd2, _RGB32(.25 * r, .5 * g, .75 * b)
  27.     fquad x, y + side, x + sd2, y + sd2, x + side, y + sd2, x + sd2, y + side, _RGB32(.75 * r, .3 * g, .3 * b)
  28.  
  29. ' EDIT 2019-11-20 Improvement by Steve, add a little more speed
  30. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
  31.     STATIC a&
  32.     D = _DEST
  33.     IF a& = 0 THEN a& = _NEWIMAGE(1, 1, 32)
  34.      _DEST a&
  35.     PSET (0, 0), K
  36.     _DEST D
  37.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
  38.  
  39. 'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
  40. SUB fquad (x1, y1, x2, y2, x3, y3, x4, y4, K AS _UNSIGNED LONG)
  41.     ftri x1, y1, x2, y2, x4, y4, K
  42.     ftri x3, y3, x2, y2, x4, y4, K
  43.  
  44.  

EDIT: Update 2019-11-20 Steve strikes again, with Static no longer need to _FREEIMAGE, saves some time plus we preserve old DEST and restore after drawing ftri.
« Last Edit: November 20, 2019, 06:33:20 pm by bplus »

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • Steve’s QB64 Archive Forum
Re: and another one for your toolbox...
« Reply #37 on: November 21, 2019, 12:04:56 pm »
A quick function to tell if a string is a number or not:

Code: [Select]
FUNCTION VerifyNumber (text$)
    t$ = LTRIM$(RTRIM$(text$))
    v = VAL(t$)
    t1$ = LTRIM$(STR$(v))
    IF t$ = t1$ THEN VerifyNumber = -1
END FUNCTION

Works in most cases, unless you overload it and it changes formats on you, such as from 100000000000000000000000000000000 to 1.0E+20 (or whatever that number of 1s and 0s actually is).

We can push it to the point where this little function fails, but in most ordinary cases, it works like a charm.  :)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • Steve’s QB64 Archive Forum
Re: and another one for your toolbox...
« Reply #38 on: November 29, 2019, 01:31:28 pm »
And here's one you might like -- a smart PAUSE routine:

Code: QB64: [Select]
  1. SUB Pause (time AS _FLOAT)
  2.     DIM ExitTime AS _FLOAT
  3.     _KEYCLEAR 'clear the keyboard buffer so we don't automatically exit the routine
  4.     IF time <= 0 THEN ExitTime = 1.18E+1000 ELSE ExitTime = time + Timer
  5.     oldmouse = -1 ‘assume the mouse starts in an invalid down state
  6.     DO
  7.         WHILE _MOUSEINPUT: WEND: IF _MOUSEBUTTON(1) AND NOT oldmouse THEN EXIT SUB
  8.         k = _KEYHIT: IF k > 0 THEN _KEYCLEAR: EXIT SUB 'clear any stray key events so they don't mess with code outside the Pause.
  9.         oldmouse = _MOUSEBUTTON(1)
  10.         _LIMIT 10
  11.     LOOP UNTIL ExitTime < Timer

I suggest using it with ExtendedTimer instead, so you don't have any pesky little "it acts goofy at midnight" glitches, but this works just like SLEEP for us, except it also supports a mouse click as a valid button press to break it.
« Last Edit: December 16, 2019, 01:35:32 pm by SMcNeill »
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
Re: and another one for your toolbox...
« Reply #39 on: November 30, 2019, 06:08:09 am »
I like this toolbox  as more as time goes on.
thanks to share.
Programming isn't difficult, only it's  consuming time and coffee

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
Re: and another one for your toolbox...
« Reply #40 on: November 30, 2019, 05:15:13 pm »
I think this will get us past the midnight problem without dependency on another subroutine:
Code: QB64: [Select]
  1. OPTION _EXPLICIT 'B+ 2019-11-30 get past midnight problem without another routine
  2.  
  3. PRINT "Hello World, press key, click mouse or wait 5 secs for goodbye."
  4. cSleep 5
  5. PRINT "goodbye world"
  6.  
  7. 'c for click + SLEEP, this does force you to commit to a max time to wait
  8. SUB cSleep (secsWait AS DOUBLE) 'wait for keypress or mouseclick, solves midnight problem nicely I think
  9.     DIM wayt AS INTEGER, oldMouse AS INTEGER, k AS LONG, startTime AS DOUBLE
  10.  
  11.     startTime = TIMER
  12.     wayt = 1
  13.     _KEYCLEAR
  14.     WHILE wayt
  15.         WHILE _MOUSEINPUT: WEND
  16.         IF _MOUSEBUTTON(1) AND oldMouse = 0 THEN wayt = 0
  17.         oldMouse = _MOUSEBUTTON(1) ' <<< this is Steve's cool way to get clear of mouse click
  18.         k = _KEYHIT: IF k > 0 THEN _KEYCLEAR: wayt = 0
  19.         IF TIMER - startTime < 0 THEN 'past midnight
  20.             IF TIMER + 24 * 60 * 60 - startTime > secsWait THEN wayt = 0
  21.         ELSE
  22.             IF TIMER - startTime >= secsWait THEN wayt = 0
  23.         END IF
  24.         _LIMIT 30
  25.     WEND
  26.  

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
Re: and another one for your toolbox...
« Reply #41 on: December 01, 2019, 11:00:12 am »
Here is nicer code for BIN$, I picked this version up at JB but I think I saw Petr and/or Steve using similar. It looks more elegant than my previous version.
The &B is my main contribution for a base ID, compare with &H and &O that QB64 uses.

Code: QB64: [Select]
  1. FUNCTION BIN$ (integerBase10 AS _INTEGER64)
  2.     DIM j AS INTEGER, B$
  3.     IF integerBase10 = 0 THEN BIN$ = "&B0": EXIT FUNCTION
  4.     WHILE 2 ^ j <= integerBase10
  5.         IF (integerBase10 AND 2 ^ j) > 0 THEN B$ = "1" + B$ ELSE B$ = "0" + B$
  6.         j = j + 1
  7.     WEND
  8.     BIN$ = "&B" + B$
  9.  

The Librarian may pickup on this and update code in official Toolbox?

Oh we've gone full circle, I will update OP!
« Last Edit: December 01, 2019, 11:03:42 am by bplus »

Offline RhoSigma

  • QB64 Developer
  • Forum Resident
  • Posts: 565
Re: and another one for your toolbox...
« Reply #42 on: December 02, 2019, 08:13:46 am »
Here's yet another one ...

Code: QB64: [Select]
  1. FUNCTION BIN$ (value&&)
  2. DIM v&&, vi&&
  3. BIN$ = "": v&& = value&&
  4.     vi&& = INT(v&& / 2)
  5.     IF v&& / 2 = vi&& THEN BIN$ = "0" + BIN$: ELSE BIN$ = "1" + BIN$
  6.     v&& = vi&&
  7. LOOP UNTIL v&& = 0
  8.  

BTW - It doesn't add the &B prefix, just as HEX$ and OCT$ doesn't add &H and &O respectivly.
My Projects:   https://qb64forum.alephc.xyz/index.php?topic=809
GuiTools - A graphic UI framework (can do multiple UI forms/windows in one program)
Libraries - ImageProcess, StringBuffers (virt. files), MD5/SHA2-Hash, LZW etc.
Bonus - Blankers, QB64/Notepad++ setup pack

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
Re: and another one for your toolbox...
« Reply #43 on: December 02, 2019, 10:34:01 am »
Quote
BTW - It doesn't add the &B prefix, just as HEX$ and OCT$ doesn't add &H and &O respectivly.

Seems a shame too. Look at 10000 that has 4 different possible values.

Offline RhoSigma

  • QB64 Developer
  • Forum Resident
  • Posts: 565
Re: and another one for your toolbox...
« Reply #44 on: December 02, 2019, 10:55:55 am »
Seems a shame too. Look at 10000 that has 4 different possible values.

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 ??
My Projects:   https://qb64forum.alephc.xyz/index.php?topic=809
GuiTools - A graphic UI framework (can do multiple UI forms/windows in one program)
Libraries - ImageProcess, StringBuffers (virt. files), MD5/SHA2-Hash, LZW etc.
Bonus - Blankers, QB64/Notepad++ setup pack