Pete's QBASIC Site

QBASIC and QB64 Questions & Answers • Re: old N54 forum

2022-09-28T11:37:05-05:00

That graphics guy was probably QB4321 or The Bob from Canada

Statistics: Posted by burger2227 — Wed Sep 28, 2022 11:37 am

QBASIC and QB64 Questions & Answers • Re: old N54 forum

2022-09-27T06:28:11-05:00

This old forum on n54 should be online for research, there was a huge amount of highly technical posts and resources; I made a huge program and got a lot of help from there, foremost from a guy specialized in graphics. He drew characters and told the routines for that... it was amazing.

It was in another life for me, now for example i find java script useful, to program theses ESP8266 modules.

Anyway it was a great time...

L

Statistics: Posted by lisztfr — Tue Sep 27, 2022 6:28 am

QBASIC and QB64 Questions & Answers • Re: [SOLVED][QB64] Need help with the hour hand of my clock

2022-02-26T15:17:34-05:00

Hi there!

It's cool to see you're still working on your clock. If I could suggest a bigger optimization, it would be to remove the several calls to COS(), SIN() and the two multiplications done every update for each hand because it's fairly costly. It's not a problem for a simple clock program but could become a true time waster on more complex loops. If memory is of no concern, you may precache the values you need for each hand: you calculate them once, store the result somewhere and just fetch the result as needed (there's a really simple feature for that called "arrays," I haven't seen any in your program so I assume you're not familiar with it yet.) If you want to preserve memory, precache SIN() and COS() for all 360 degrees.

A cool feature you may not know about: did you know you can use the STEP parameter on the second coordinate of LINE to make it relative to the 1st point, rather than absolute to the screen coordinate system? For instance:

Code:

LINE (160, 160) - (160 + 20, 160 - 50), jaune&

Is equivalent to:

Code:

LINE (160, 160) - STEP(20, -50), jaune&

Since we know about LINE STEP, why not build a custom type to keep the delta (the relative distance) between the hand origin and edge as X and Y values? Custom types allow you to create variables that contain other variables. So instead of having a variable that is "just" an integer, you can have a variable that contains multiple variables of different type (and those variables can also use custom types, like nesting dolls.) For instance:

Code:

TYPE vec  x AS INTEGER  y AS INTEGEREND TYPEDIM v AS vecv.x = 20v.y = -50LINE(160, 160) - STEP(v.x, v.y), jaune&

Custom types are especially useful with arrays. Arrays are like a bunch of variables that have the same name and same type and can be identified by an index value. Arrays are one of the most essential things you'll ever learn in BASIC (or any programming language, really.) For instance, instead of doing:

Code:

DIM x0 AS INTEGER, x1 AS INTEGER, x2 AS INTEGER, x3 AS INTEGERx0 = -155x1 = 1x2 = 99x3 = INT(RND * 100)PRINT x0PRINT x1PRINT x2PRINT x3

You can:

Code:

DIM x(0 TO 3) AS INTEGERx(0) = -155x(1) = 1x(2) = 99x(3) = INT(RND * 100)FOR i% = 0 TO 3  PRINT x(i%)NEXT i%

Now, we know that the seconds hand only needs 60 stops. So we just have to create an array of 60 elements (from 0 to 59,) perform the most complex operations there and store the result for later use:

Code:

CONST PI = 3.14159' our custom typeTYPE vec  x AS INTEGER  y AS INTEGEREND TYPE' our seconds hand stops arrayDIM sHand(0 to 59) AS vec' fill the arrayFOR i% = 0 to 59  ‘ adding 270 degrees here is equivalent to removing 15 seconds later  ' 360 is divided by 60 because the hand makes 60 stops per cycle  rad! = (270 + (i% * (360 \ 60))) * (PI / 180)  ' 50 is the length of the hand  sHand(i%).x = COS(rad!) * 50  sHand(i%).y = SIN(rad!) * 50NEXT i%

Now that we have the values stored in sHand(), we no longer need to compute these numbers. We can start our main loop and access the X and Y delta stored in the array:

Code:

DO  ' Seconds% contains a value between 0 and 59  Seconds% = VAL(RIGHT$(TIME$, 2))  ' Get deltas from our array  LINE(160,160) - STEP(sHand(Seconds%).x, sHand(Seconds%).y), jaune&LOOP UNTIL LEN(INKEY$)

You can easily adapt that system to work with your minutes and hours. Or be super adventurous and write a routine to initialize any hand with any number of stops, like a hand that would only move every 20 minutes.

Statistics: Posted by MikeHawk — Sat Feb 26, 2022 3:17 pm

QBASIC and QB64 Questions & Answers • [SOLVED][QB64] Need help with the hour hand of my clock

2022-02-25T09:56:46-05:00

Hello,

Everything is still fine, but I did optimizations :

• the drawing of the seconds hand is the last thing displayed, as well as the center of the clock (the same color as the seconds hand). That gives the illusion of an hand that is above the others;
• I changed the size of the window (it was 640×320, it's now 320×320), the presentation is slightly different;
• I changed my arc2! variable, it was 2π/60, it's now 2π/120;
• when I found how to move the hour hand correctly, I made it move every 12 minutes, now, it moves every 6 minutes (that's why I changed arc2!);
• I had an IF… ENDIF for each minute on which I wanted the hour hand to move, I made a loop FOR I=6 TO 59 STEP 6 (I gained 45 lines of code just with that!);
• I added little stars to decorate (the number of them will vary depending on the length of the modified DATE$ string).

Here's the new code :

Code:

'Horloge analogique_TITLE "Horloge analogique vintage"SCREEN _NEWIMAGE(320, 320, 32)CONST Jaune& = _RGB32(255, 255, 0)CONST Cyan& = _RGB32(64, 224, 208)CONST Vert& = _RGB32(0, 255, 0)CONST Rouge& = _RGB32(255, 0, 0)CONST Noir& = _RGB32(0, 0, 0)Pi2! = 8 * ATN(1)sec! = Pi2! / 60min! = Pi2! / 60heure! = Pi2! / 60arc! = Pi2! / 12arc2! = Pi2! / 120FOR t! = 0 TO Pi2! STEP arc!    cx% = CINT(COS(t!) * 70)    cy% = CINT(SIN(t!) * 70)    CIRCLE (cx% + 160, cy% + 160), .5, Vert&    CIRCLE (cx% + 160, cy% + 160), 1, Vert&    CIRCLE (cx% + 160, cy% + 160), 2, Vert&NEXT t!DO    _LIMIT 1000    Year% = VAL(RIGHT$(DATE$, 4))    Jour% = VAL(RIGHT$(DATE$, 7))    Mois% = VAL(RIGHT$(DATE$, 11))    mois$ = LEFT$(DATE$, 2)    M = VAL(mois$)    SELECT CASE M        CASE 1: Lune$ = "janvier"        CASE 2: Lune$ = "f" + CHR$(130) + "vrier"        CASE 3: Lune$ = "mars"        CASE 4: Lune$ = "avril"        CASE 5: Lune$ = "mai"        CASE 6: Lune$ = "juin"        CASE 7: Lune$ = "juillet"        CASE 8: Lune$ = "ao" + CHR$(150) + "t"        CASE 9: Lune$ = "septembre"        CASE 10: Lune$ = "octobre"        CASE 11: Lune$ = "novembre"        CASE 12: Lune$ = "d" + CHR$(130) + "cembre"    END SELECT    LOCATE 2, 1    COLOR Cyan&    PRINT " Horloge analogique vintage * ";    COLOR Jaune&    PRINT "(c) Wilou"    Longueur = LEN(Lune$) + 17    Stars = ((40 - Longueur - 3) - 1)    FOR I = 2 TO Stars        LOCATE 3, I        COLOR Cyan&        PRINT "*";    NEXT I    LOCATE 3, (40 - Longueur - 3)    PRINT Jour%; Lune$; Year%; "| "; TIME$    Seconds% = VAL(RIGHT$(TIME$, 2)) - 15    s! = sec! * Seconds%    Minutes% = VAL(RIGHT$(TIME$, 5)) - 15    M! = min! * Minutes%    Heure% = VAL(RIGHT$(TIME$, 8)) - 15    H! = (heure! * 5) * Heure%    IF Heure% >= 13 OR Heure% <= 24 THEN Heure% = Heure% - 12    IF VAL(RIGHT$(TIME$, 5)) = 0 AND VAL(RIGHT$(TIME$, 2)) = 0 THEN        _LIMIT 1000        BEEP    END IF    Sx% = CINT(COS(s!) * 50)    Sy% = CINT(SIN(s!) * 50)    Mx% = CINT(COS(M!) * 60)    My% = CINT(SIN(M!) * 60)    Hx% = CINT(COS(H!) * 45)    Hy% = CINT(SIN(H!) * 45)    FOR I = 6 TO 59 STEP 6        IF VAL(RIGHT$(TIME$, 5)) >= I THEN            _LIMIT 1000            H! = H! + arc2!            Hx% = CINT(COS(H!) * 45)            Hy% = CINT(SIN(H!) * 45)        END IF    NEXT I    LINE (160, 160)-(Mx% + 160, My% + 160), Jaune&    LINE (160, 160)-(Hx% + 160, Hy% + 160), Jaune&    CIRCLE (160, 160), 1, Rouge&    CIRCLE (160, 160), 2, Rouge&    CIRCLE (160, 160), 3, Rouge&    LINE (160, 160)-(Sx% + 160, Sy% + 160), Rouge&    DO        _LIMIT 1000        Verif% = VAL(RIGHT$(TIME$, 2)) - 15        Verif1% = VAL(RIGHT$(TIME$, 5)) - 15        Verif2% = VAL(RIGHT$(TIME$, 8)) - 15    LOOP UNTIL Verif% <> Seconds% OR Verif1% <> Minutes% OR Verif2% <> Heure%    _DISPLAY    LINE (160, 160)-(Sx% + 160, Sy% + 160), Noir&    LINE (160, 160)-(Mx% + 160, My% + 160), Noir&    LINE (160, 160)-(Hx% + 160, Hy% + 160), Noir&    LOCATE 18, 4    COLOR Jaune&    PRINT "Clic gauche | <"; CHR$(144); "chap> pour quitter"    Mouse = _MOUSEINPUT    K$ = INKEY$    IF K$ = CHR$(27) OR _MOUSEBUTTON(1) THEN SYSTEMLOOP UNTIL INKEY$ = CHR$(27)

Statistics: Posted by wilou — Fri Feb 25, 2022 9:56 am

QBASIC and QB64 Questions & Answers • Re: [SOLVED][QB64] Need help with the hour hand of my clock

2022-02-23T14:02:13-05:00

Hello,

Thanks for your reply. Indeed, I've found the solution by myself and I'm proud of it as it's the most difficult program I've done so far.

And :

For a reason I ignore, I must do the same routine in the four "if... end if", as if the minutes influenced the hours (M! influences H!)?

I'm so stupid sometimes. At the beginning, I used arc2!, then two times arc2! then 3 times... But when I use arc2! for the first time (or heure!), the new H! is H! + heure! so I just have to add heure! again, not two, three or four times heure! (I had only considered the initial H! and not the H! that was increasing each 12 minutes)!

W.

Statistics: Posted by wilou — Wed Feb 23, 2022 2:02 pm

QBASIC and QB64 Questions & Answers • Re: [QB64] Need help with the hour hand of my clock

2022-02-26T15:38:44-05:00

Hi there! I'm a little bit of an autist when it comes to numbers, so I'll use the TIMER function to extract the hour in number form rather than convert the TIME$ string (TIMER returns the number of seconds elapsed since midnight:)

EDIT: as it turns out, TIMER doesn't return the number of seconds elapsed since midnight under Windows and probably other platforms too. Mea maxima culpa.

Code:

DIM t AS LONGDIM s AS INTEGER, m AS INTEGER, h AS INTEGERDIM sA AS INTEGER, mA AS INTEGER, hA as INTEGERt = CLNG(TIMER)     ' get the integer part of the number of seconds since midnights = t MOD 60        ' seconds - MOD (modulo) returns the remainder of an integral divisionm = (t \ 60) MOD 60 ' minutes - backslash for integral division (no fractional part)h = t \ 3600        ' hours (3600 is the number of seconds in an hour)

The angle is determined as a proportion between the complete range (360 degrees on your clock) and the number of stops. For instance, seconds and minutes move the same amount of degrees per stop: 360 (your clock) / 60 (number of stops,) multiply by either the number of seconds or minutes:

Code:

sA = 360 / 60 * s ' angle for the second hand, in degreesmA = 360 / 60 * m ' angle for the minute hand, in degrees

For a "hard" hour hand with 12 stops, we divide 360 (your clock) by 12 (number of stops,) and multiply by the number of hours modulo 12 (modulo returns the remainder of an integral division, the result will be in range 0 to 11.) We do:

Code:

hA = (360 / 12) * (h MOD 12) ' angle for the "hard" hour hand, in degrees

Now, if we want the hour hand to move, we need to know how much should it move, and when. Should it move every minute or every second? I'm going to say every minute... so we have to convert the number of hours to minutes, and then add the remaining number of minutes:

Code:

DIM h2 AS INTEGERDIM h2A AS INTEGERh2 = h MOD 12 ' hour, in range 0-11h2 = h2 * 60  ' hour in minutes, in range 0-660 (661 values, max is 11 * 60)h2 = h2 + m   ' hour with minutes included, in range 0-719 (720 values, max is 11 * 60 + 59)

So there you have it: 720 stops for a full cycle. So we divide 360 (your clock) by 720 (number of stops,) and multiply by the number of minutes (including the converted hours) and presto, you go the angle for your "soft" hour hand (moving every minute:)

Code:

h2A = (360 / 720) * h2 ' angle for the "soft" hour hand, in degrees

I hope this helps.

EDIT: too late, you came up with your own solution to the problem.

Statistics: Posted by MikeHawk — Tue Feb 22, 2022 10:24 pm

QBASIC and QB64 Questions & Answers • [QB64] Need help with the hour hand of my clock

2022-02-23T01:53:27-05:00

Hello again,

Night brings advice!

I think I found the solution all alone. I had all the elements right in front of my eyes. And what is under our nose isn't always seen like it should be (philosophic moment of the day )

As you may have noticed, there is a arc2! variable declared, that I added to the original code, but not used.
Initially, I wanted to display points all around the clock for each minute. I tried but it didn't looked good, the clock is too small and I prefer the minimalistic look you can see now. So I only displayed a point every 5 minute (with the arc! variable).

But if the arc2! variable is coming handy as it was meant to display a dot for every minute, it can also be used to compute the placement of the hour hand!

So, I updated my code as follows (still no fractions and the calculations don't happen at the same place) :

Code:

'Horloge analogique_TITLE "Horloge analogique vintage"SCREEN _NEWIMAGE(640, 320, 32)Blanc& = _RGB32(255, 255, 255)Jaune& = _RGB32(255, 255, 0)Cyan& = _RGB32(64, 224, 208)Vert& = _RGB32(0, 255, 0)Rouge& = _RGB32(255, 0, 0)Noir& = _RGB32(0, 0, 0)Gris& = _RGB32(63, 63, 63)Pi2! = 8 * ATN(1)sec! = Pi2! / 60min! = Pi2! / 60heure! = Pi2! / 60arc! = Pi2! / 12arc2! = Pi2! / 60FOR t! = 0 TO Pi2! STEP arc!    cx% = CINT(COS(t!) * 70)    cy% = CINT(SIN(t!) * 70)    CIRCLE (cx% + 320, cy% + 160), 1, Vert&    CIRCLE (cx% + 320, cy% + 160), 2, Vert&NEXT t!DO    _LIMIT 1000    CIRCLE (320, 160), 1, Blanc&    CIRCLE (320, 160), 2, Blanc&    CIRCLE (320, 160), 3, Blanc&    Year% = VAL(RIGHT$(DATE$, 4))    Jour% = VAL(RIGHT$(DATE$, 7))    Mois% = VAL(RIGHT$(DATE$, 11))    LOCATE 2, 28    COLOR Cyan&    mois$ = LEFT$(DATE$, 2)    M = VAL(mois$)    SELECT CASE M        CASE 1: Lune$ = "janvier"        CASE 2: Lune$ = "février"        CASE 3: Lune$ = "mars"        CASE 4: Lune$ = "avril"        CASE 5: Lune$ = "mai"        CASE 6: Lune$ = "juin"        CASE 7: Lune$ = "juillet"        CASE 8: Lune$ = "août"        CASE 9: Lune$ = "septembre"        CASE 10: Lune$ = "octobre"        CASE 11: Lune$ = "novembre"        CASE 12: Lune$ = "décembre"    END SELECT    Longueur = LEN(Lune$) + 17    LOCATE 2, (80 - Longueur - 3)    PRINT Jour%; Lune$; Year%; "| "; TIME$    Seconds% = VAL(RIGHT$(TIME$, 2)) - 15    S! = sec! * Seconds%    Minutes% = VAL(RIGHT$(TIME$, 5)) - 15    M! = min! * Minutes%    Heure% = VAL(RIGHT$(TIME$, 8)) - 15    H! = (heure! * 5) * Heure%    IF Heure% >= 13 OR Heure% <= 24 THEN Heure% = Heure% - 12    IF VAL(RIGHT$(TIME$, 5)) = 0 AND VAL(RIGHT$(TIME$, 2)) = 0 THEN        _LIMIT 1000        BEEP    END IF    Sx% = CINT(COS(S!) * 50)    Sy% = CINT(SIN(S!) * 50)    Mx% = CINT(COS(M!) * 60)    My% = CINT(SIN(M!) * 60)    Hx% = CINT(COS(H!) * 45)    Hy% = CINT(SIN(H!) * 45)    IF VAL(RIGHT$(TIME$, 5)) >= 12 THEN        _LIMIT 1000        H! = H! + heure!        Hx% = CINT(COS(H!) * 45)        Hy% = CINT(SIN(H!) * 45)    END IF    IF VAL(RIGHT$(TIME$, 5)) >= 24 THEN        _LIMIT 1000        H! = H! + heure!        Hx% = CINT(COS(H!) * 45)        Hy% = CINT(SIN(H!) * 45)    END IF    IF VAL(RIGHT$(TIME$, 5)) >= 36 THEN        _LIMIT 1000        H! = H! + heure!        Hx% = CINT(COS(H!) * 45)        Hy% = CINT(SIN(H!) * 45)    END IF    IF VAL(RIGHT$(TIME$, 5)) >= 48 THEN        _LIMIT 1000        H! = H! + heure!        Hx% = CINT(COS(H!) * 45)        Hy% = CINT(SIN(H!) * 45)    END IF    LINE (320, 160)-(Sx% + 320, Sy% + 160), Rouge&    LINE (320, 160)-(Mx% + 320, My% + 160), Jaune&    LINE (320, 160)-(Hx% + 320, Hy% + 160), Jaune&    DO        _LIMIT 1000        Verif% = VAL(RIGHT$(TIME$, 2)) - 15        Verif1% = VAL(RIGHT$(TIME$, 5)) - 15        Verif2% = VAL(RIGHT$(TIME$, 8)) - 15    LOOP UNTIL Verif% <> Seconds% OR Verif1% <> Minutes% OR Verif2% <> Heure%    _DISPLAY    LINE (320, 160)-(Sx% + 320, Sy% + 160), Noir&    LINE (320, 160)-(Mx% + 320, My% + 160), Noir&    LINE (320, 160)-(Hx% + 320, Hy% + 160), Noir&    LOCATE 18, 45    COLOR Jaune&    PRINT "Clic gauche ou <"; CHR$(144); "chap> pour quitter"    Mouse = _MOUSEINPUT    K$ = INKEY$    IF K$ = CHR$(27) OR _MOUSEBUTTON(1) THEN SYSTEMLOOP UNTIL INKEY$ = CHR$(27)

Thank you to those who have read me. Hope this code will be useful to someone one day. I might beef it up by setting up an alarm system for example, or give the choice between different sizes.

W.

EDIT: well, finally, it didn't work and I modified the code again, using heure! instead of arc2! For a reason I ignore, I must do the same routine in the four "if... end if", as if the minutes influenced the hours (M! influences H!)? Strange! For now, that's good but I'll see how that evolves.

EDIT 2 : it runs for 5 hours straight and I didn't see anything wrong. I think it's good this time !

Statistics: Posted by wilou — Tue Feb 22, 2022 9:33 pm

QBASIC and QB64 Questions & Answers • [SOLVED][QB64] Need help with the hour hand of my clock

2022-02-23T01:51:33-05:00

Hello,

I've decided to code an analog clock using a portion of code I found on https://qb64sourcecode.com/:
https://qb64sourcecode.com/task12code2.png

Everything is going fine but one : the hour hand.
It moves one time on each new hour and I'd like to make it move as time passes by.
I've tried differents values, but so far, I didn't succeed.

Here is my code:

Code:

'Horloge analogique_TITLE "Horloge analogique vintage"SCREEN _NEWIMAGE(640, 320, 32)Blanc& = _RGB32(255, 255, 255)Jaune& = _RGB32(255, 255, 0)Cyan& = _RGB32(64, 224, 208)Vert& = _RGB32(0, 255, 0)Rouge& = _RGB32(255, 0, 0)Noir& = _RGB32(0, 0, 0)Gris& = _RGB32(63, 63, 63)Pi2! = 8 * ATN(1)sec! = Pi2! / 60min! = Pi2! / 60heure! = Pi2! / 60arc! = Pi2! / 12arc2! = Pi2! / 60FOR t! = 0 TO Pi2! STEP arc!    cx% = CINT(COS(t!) * 70)    cy% = CINT(SIN(t!) * 70)    CIRCLE (cx% + 320, cy% + 160), 1, Vert&    CIRCLE (cx% + 320, cy% + 160), 2, Vert&NEXT t!DO    _LIMIT 1000    CIRCLE (320, 160), 1, Blanc&    CIRCLE (320, 160), 2, Blanc&    CIRCLE (320, 160), 3, Blanc&    Year% = VAL(RIGHT$(DATE$, 4))    Jour% = VAL(RIGHT$(DATE$, 7))    Mois% = VAL(RIGHT$(DATE$, 11))    LOCATE 2, 28    COLOR Cyan&    mois$ = LEFT$(DATE$, 2)    M = VAL(mois$)    SELECT CASE M        CASE 1: Lune$ = "janvier"        CASE 2: Lune$ = "février"        CASE 3: Lune$ = "mars"        CASE 4: Lune$ = "avril"        CASE 5: Lune$ = "mai"        CASE 6: Lune$ = "juin"        CASE 7: Lune$ = "juillet"        CASE 8: Lune$ = "août"        CASE 9: Lune$ = "septembre"        CASE 10: Lune$ = "octobre"        CASE 11: Lune$ = "novembre"        CASE 12: Lune$ = "décembre"    END SELECT    Longueur = LEN(Lune$) + 17    LOCATE 2, (80 - Longueur - 3)    PRINT Jour%; Lune$; Year%; "| "; TIME$    Seconds% = VAL(RIGHT$(TIME$, 2)) - 15    S! = sec! * Seconds%    Minutes% = VAL(RIGHT$(TIME$, 5)) - 15    M! = min! * Minutes%    Heure% = VAL(RIGHT$(TIME$, 8)) - 15    H! = (heure! * 5) * Heure%    IF Heure% >= 13 OR Heure% <= 24 THEN Heure% = Heure% - 12    IF VAL(RIGHT$(TIME$, 5)) >= 12 THEN        _LIMIT 1000        H! = H! + 0.016    END IF    IF VAL(RIGHT$(TIME$, 5)) >= 24 THEN        _LIMIT 1000        H! = H! + 0.033    END IF    IF VAL(RIGHT$(TIME$, 5)) >= 36 THEN        _LIMIT 1000        H! = H! + 0.05    END IF    IF VAL(RIGHT$(TIME$, 5)) >= 48 THEN        _LIMIT 1000        H! = H! + 0.067    END IF    IF VAL(RIGHT$(TIME$, 5)) = 0 AND VAL(RIGHT$(TIME$, 2)) = 0 THEN        _LIMIT 1000        BEEP    END IF    Sx% = CINT(COS(S!) * 50)    Sy% = CINT(SIN(S!) * 50)    Mx% = CINT(COS(M!) * 60)    My% = CINT(SIN(M!) * 60)    Hx% = CINT(COS(H!) * 45)    Hy% = CINT(SIN(H!) * 45)    LINE (320, 160)-(Sx% + 320, Sy% + 160), Rouge&    LINE (320, 160)-(Mx% + 320, My% + 160), Jaune&    LINE (320, 160)-(Hx% + 320, Hy% + 160), Jaune&    DO        _LIMIT 1000        Verif% = VAL(RIGHT$(TIME$, 2)) - 15        Verif1% = VAL(RIGHT$(TIME$, 5)) - 15        Verif2% = VAL(RIGHT$(TIME$, 8)) - 15    LOOP UNTIL Verif% <> Seconds% OR Verif1% <> Minutes% OR Verif2% <> Heure%    _DISPLAY    LINE (320, 160)-(Sx% + 320, Sy% + 160), Noir&    LINE (320, 160)-(Mx% + 320, My% + 160), Noir&    LINE (320, 160)-(Hx% + 320, Hy% + 160), Noir&    LOCATE 18, 45    COLOR Jaune&    PRINT "Clic gauche ou <"; CHR$(144); "chap> pour quitter"    Mouse = _MOUSEINPUT    K$ = INKEY$    IF K$ = CHR$(27) OR _MOUSEBUTTON(1) THEN SYSTEMLOOP UNTIL INKEY$ = CHR$(27)

And the part that's bothering me is this one:

Code:

    IF VAL(RIGHT$(TIME$, 5)) >= 12 THEN        _LIMIT 1000        H! = H! + 0.016    END IF    IF VAL(RIGHT$(TIME$, 5)) >= 24 THEN        _LIMIT 1000        H! = H! + 0.033    END IF    IF VAL(RIGHT$(TIME$, 5)) >= 36 THEN        _LIMIT 1000        H! = H! + 0.05    END IF    IF VAL(RIGHT$(TIME$, 5)) >= 48 THEN        _LIMIT 1000        H! = H! + 0.067    END IF

I have the feeling that the numbers like 0.016, 0.033 and so on should be replaced by fractions, but I don't find what fractions.

Do you have an idea?

Thanks,

W.

Statistics: Posted by wilou — Tue Feb 22, 2022 7:13 am

QBASIC and QB64 Questions & Answers • Need second opinion on ASM snippet (MULTIKEY issues)

2021-09-01T14:44:22-05:00

I need the opinion of someone who knows assembly and the obscure intricacies of messing with pointers in an interrupt because I'm an ASM noob.

I used to use Milo Sedlacek's MULTIKEY assembly code to replace the keyboard interrupt service routine because up until recently, it never failed to deliver. I understood the basics of what the code was doing, but never looked into HOW it did it. To get it to work, you have to reserve an array in QuickBASIC, get its pointer (both segment and offset) and then use that to reprogram four bytes into the assembly code, so the code knows where it should store the status of each key (the rest is standard stuff like reading port 0x60, checking if the status is press or release, acknowledge interrupt, etc.)

I recently came across an annoying bug that rendered MULTIKEY unusable. I assumed it was due to the fact I was forcing QuickBASIC to consolidate the memory reserved for variables (and thus moving variables -including the array where key status would be stored- in memory) by reserving memory via a DOS interrupt (QuickBASIC always reserves all the available space for your code and variables; if you want a static memory address, you have to put it away from its control by first telling it to free some memory and then reserving it via DOS.) The obvious side-effect was that the array meant to contain the key status would move and MULTIKEY would write to the old address, where something else is stored. At that point, I decided to also reserve memory for the key status buffer via the DOS interrupt to make sure it wouldn't move. But that didn't exactly fix the issue as it seemed that my own PEEK and POKE calls would not land where I expected them to.

So I read Milo's code going instruction by instruction and realized he was modifying the code segment address to access the key status buffer. Since the code is designed to be an interrupt, it means that it can be executed at any time during the main program's execution - for instance, in the middle of a loop that reads/writes stuff to memory via PEEK and POKE - which means the interrupt could impact DEF SEG silently, and there would be no way of knowing. Here's Milo's interrupt code:

Code:

; pushing registers to stack so they can be restored to their initial value9C          PUSHF50          PUSH AX53          PUSH BX51          PUSH CX52          PUSH DX1E          PUSH DS56          PUSH SI06          PUSH ES57          PUSH DI; port readingEA 60       IN   AL, 60       ; Read port 0x60, store in ALB4 01       MOV  AH, 01       ; Assume the key is pressedA8 80       TEST AL, 80       ; Test bit-7 in AL, modifies Sign, Zero and Parity flag register.74 04       JZ   4            ; If Zero flag is SET, skip 4 bytes (2 instructions)B4 00       MOV  AH, 00       ; The key was in fact released24 7F       AND  AL, 7F       ; Strip bit-7 from AL (only keep scancode); getting offset from begining of the arrayD0 E0       SHL  AL, 1        ; Multiply AL by 2 (target is an INTEGER array of 129 elements)88 C3       MOV  BL, AL       ; Set BX (lower byte) to ALB7 00       MOV  BH, 00       ; Set BX (high byte) to 0B0 00       MOV  AL, 00       ; Set AL to 0; going to the array memory address and write key status2E          CS:               ; Change code segment, set BX (offset)03 1E 12 00 ADD  BX, [0012]   ; Add BX to the value stored at 0x12 (array memory offset)2E          CS:               ; Change code segment, set DS (segment)8E 1E 10 00 MOV  DS, [0010]   ; Set DS to the value stored at 0x10 (array memory segment)86 E0       XCHG AH, AL       ; Swap AH and AL (AH contains the key status)89 07       MOV  [BX], AX     ; Write AX (2 bytes) to [BX] (array memory offset); the rest is the standard:; acknowledge interrupt; restore registers with POP and POPF; terminate interrupt execution with IRET

So, as I noob, I assume CS is not restored at the end of the execution of the interrupt and it somehow disrupts the flow of the main QuickBASIC program. I never noticed that bug before so I'm not sure what's up. I rewrote some code so that the buffer (starting at byte 0) and the interrupt code (starting at byte 129) would be stored in the same memory segment, would be out of QuickBASIC's reach, and it would be possible to easily access the key status buffer (129 bytes rather than 129 words) by simply PEEKING memory. It seems to work but I'd like a second opinion:

Code:

; pushing registers like aboveEA 60       IN   AL, 60       ; Read port 0x60, store in ALB4 01       MOV  AH, 01       ; Assume the key is pressedA8 80       TEST AL, 80       ; Test bit-7 in AL, modifies Sign, Zero and Parity flag register.74 04       JZ   4            ; If Zero flag is SET, skip 4 bytes (2 instructions)B4 00       MOV  AH, 00       ; Our bad, key is actually released.24 7F       AND  AL, 7F       ; Only preserve bits 6-0 in AL, discard bit 7.88 C3       MOV  BL, AL       ; Set BX to scancode: BL = ALB7 00       MOV  BH, 0        ; Set BX to scancode: BH = 02E 88 27    MOV  CS:[BX], AH  ; Copy key status to specified address; the rest is the standard:; acknowledge interrupt; restore registers with POP and POPF; terminate interrupt execution with IRET

And here's the full code in QuickBASIC (it will exit on its own after 5 seconds, so all keys can be tested:)

Code:

'$INCLUDE: 'QB.BI'DECLARE SUB memFree (segAdr AS INTEGER)DECLARE FUNCTION memAlloc% (numBytes AS LONG)DECLARE FUNCTION keyInit% ()DIM keySegm AS INTEGER, tmr AS DOUBLECLStmr = TIMER + 5keySegm = keyInit%DODEF SEG = keySegmLOCATE 1, 1FOR i% = 0 TO 128PRINT PEEK(i%);NEXT i%LOOP UNTIL (tmr < TIMER)keySegm = keyInit%FUNCTION keyInit%STATIC oldISRSeg AS INTEGER, oldISROfs AS INTEGER, newISRSeg AS INTEGERDIM regs AS RegTypeXIF (newISRSeg = 0) THEN' Reserve memory for buffer & codenewISRSeg = memAlloc%(182) ' key status buffer (129) + code (53)' Clear key strokes (starting at offset 0 of segment [newISRSeg])DEF SEG = newISRSegFOR i% = 0 TO 128POKE i%, 0NEXT i%' Write code (starting at offset 129 of segment [newISRSeg])FOR i% = 0 TO 52POKE i% + 129, VAL("&H" + MID$("FB9C505351521E560657E460B401A8807404B400247F88C3B7002E8827E4610C80E661247FE661B020E6205F075E1F5A595B589DCF", 1 + i% * 2, 2))NEXT i%' Preserve vector interrupt 9 (BIOS keyboard ISR)regs.ax = &H3509CALL INTERRUPTX(&H21, regs, regs)oldISRSeg = regs.esoldISROfs = regs.bx' Clear keyboard bufferDEF SEG = 0POKE (&H41A), PEEK(&H41C)DEF SEG' Hook custom keyboard handlerregs.ax = &H2509regs.ds = newISRSeg ' interrupt code (and buffer) memory segmentregs.dx = 129       ' interrupt code offsetCALL INTERRUPTX(&H21, regs, regs)ELSE' Restore BIOS keyboard ISRregs.ax = &H2509regs.ds = oldISRSegregs.dx = oldISROfsCALL INTERRUPTX(&H21, regs, regs)' Deallocate memory reserved for buffer & codememFree newISRSegEND IFkeyInit% = newISRSeg ' offset to key status bufferEND FUNCTION'''' QuickBASIC always reserves the largest block of memory available for'' the far heap. If we need to allocate memory for our purpose, we must'' first tell QuickBASIC to free part of that memory.''FUNCTION memAlloc% (numBytes AS LONG)DIM memReq AS INTEGER, junk AS LONG, regs AS RegTypeX' Paragraphs are groups of 16 bytesmemReq = (numBytes \ 16) - ((numBytes AND 15) > 0)' Tell QuickBASIC to free some memory (not sure why a margin is needed)junk = SETMEM(-CLNG(memReq + 1) * 16)' Use DOS Interrupt 0x48 to request  paragraphs of memoryregs.ax = &H4800regs.bx = memReqCALL INTERRUPTX(&H21, regs, regs)' If CF is not clear, something went wrongIF (regs.flags AND &H1) THENjunk = SETMEM(650000)ELSEmemAlloc% = regs.axEND IFEND FUNCTION'''' Free memory reserved via DOS Interrupt 0x21, function 0x48''SUB memFree (segAdr AS INTEGER)DIM junk AS LONG, regs AS RegTypeX' No segment specified, abortIF (segAdr = 0) THEN EXIT SUB' Free allocated memoryregs.ax = &HA900regs.es = segAdrCALL INTERRUPTX(&H21, regs, regs)' Clear segment and offsetsegAdr = 0' Give back memory to QuickBASICjunk = SETMEM(650000)END SUB

Does it work as expected? Is it safe (or at the very least safer?) Milo also took the safe path by preserving every register, but I think only FLAG, AX and BX need to be preserved in my code (I don't know what instruction could mess with the other registers.) Is that right? I'm probably going to stick to my own version from now on unless someone notices something really terrible going on.

Statistics: Posted by MikeHawk — Wed Sep 01, 2021 2:44 pm

QBASIC and QB64 Questions & Answers • Re: Missing game: Hackman

2021-08-25T14:40:30-05:00

I tried searching the web too but wasn't able to find any working links for anything besides 2&3. I also checked all my stuff that I have on my computer and I don't have a copy of it. (Unless it's floating around on an old hard drive I have stacked away).

Closest thing I could find was his YouTube channel where he mentions it. It doesn't seem like he's posted in a while but maybe you could try messaging him there for a copy?

Related video: https://www.youtube.com/watch?v=982eKRzFReI

Statistics: Posted by Erik — Wed Aug 25, 2021 2:40 pm

QBASIC and QB64 Questions & Answers • Missing game: Hackman

2021-08-22T11:31:09-05:00

I've been looking for Hackman (the first one) by James Robert Osborne (aka Wisdomdude.) I'm certain it exists since his old website mentions the game, but I've been unable to locate any copy of it on the Internet. Most QB repositories still provide a link to either Hackman 2 or 3 (or both,) but never the first one. I suppose it was either released in 1999 (like Hackman 2 and 3) or 1998. Anyone has that game backed up somewhere?

Statistics: Posted by MikeHawk — Sun Aug 22, 2021 11:31 am

QBASIC and QB64 Questions & Answers • Re: THE TIC-TAC-TOE THREAD

2021-08-19T08:06:12-05:00

THEARBTICTACTOEV3X3PROGRAM {The Strongest Program in the World!} A.R.B

http://www.petesqbsite.com/phpBB3/viewt ... =4&t=14873

Statistics: Posted by Anthony.R.Brown — Thu Aug 19, 2021 8:06 am

QBASIC and QB64 Questions & Answers • Re: File search in QB without crash

2021-08-18T21:28:49-05:00

I wrote an answer, but I'm dumb and tired so I'm revising it.

Short answer to your problem: you don't have to search all folders and keep track of the whole directory tree starting from the root IF you parse your folders linearly (one scope at the time.) That means you only need to keep track of folders located inside parents. In your example you try to search all folders and subfolders of both "x:/qb/[directories]" and "x:/win/[directories]", but you don't need to because you won't be parsing both directories at the same time.

Keep track of the currently searched folder via an absolute path string (something that would look like X:/QB/PROJECTS/FINISHED/). This way, you know where you are and most importantly, you know the name of the folder you leave when going DOWN. For instance, if there's nothing of interest in FINISHED/, you just go down to X:/QB/PROJECTS/ and search for the next folder after FINISHED/ on your list and enter it. Here's what I'd do:

When you enter a new folder/begin your search (going UP:)
1. Find First with your file.
- If a file exists, add to result array.
2. Now, Find First for all objects (discard files, retain folders.)
- For as long as you have folders, add them to the folder list for this scope.
3. When no more folders are found
- You found no folder at all. You already searched for your file so go DOWN to parent.
- You have some folders, go UP via the first on your list (update absolute path)

When you leave a folder (going DOWN:)
1. Search for the folder you left in this scope's folder list.
- If there's another folder available, go UP via that folder.
- If there's no more folder available, go DOWN to parent.

Since you search for your file upon entering (going UP) a new folder, the only thing left to do is listing all directories contained within and visit each one of them. When you're going DOWN to the parent directory, you can trash the directory list: going DOWN means you parsed all directories and already looked for your file. This should keep the array size in check (each entry will be at most 12 bytes - I mean, it's DOS) and since there's only one list per scope, you don't have exponentially growing directory names.

Does it make sense?

EDIT: Alright, I gave it a fair shake and it seems to work under DOSBox although I haven't tested it extensively. There's a 20,000 bytes buffer for directories and an extra 384 bytes to keep track of parent directories composition. There's a debug system to show where the program is searching, and the buffer content (with colors so you can see how each scope is processed.)

Code:

' The basics:' 1. Only when going UP (or on initialization):'    > Get all folders from current directory, seek file' 2. Seek next folder we should search'    > If there's a folder, enter it (going UP) and repeat all steps.'    > If there's no folder left, go to parent (going DOWN), repeat all steps.' You're done when you're no longer allowed to go DOWN.'$INCLUDE: 'QB.BI'DEFINT A-ZCONST debugLevel = 1 ' set to 0 for silent, 1 for path, 2 for path & bufferDECLARE SUB searchFile (where AS STRING, query AS STRING)DECLARE SUB getObjects (where AS STRING, query AS STRING)DECLARE SUB debugBuffer ()DECLARE FUNCTION scopeDown% ()DECLARE FUNCTION scopeUp$ ()DECLARE FUNCTION scopeAppend% (folder AS STRING)DECLARE FUNCTION INSTRREV% (source AS STRING, find AS STRING)CONST moveROOT = 0CONST moveDOWN = -1CONST moveUP = 1TYPE scopeInfo          ' OFS SZE   DESCRIPTION  start AS INTEGER      ' 000 ..2   Starting offset in pathLst (starts at 1)  count AS INTEGER      ' 002 ..2   Number of folders  visit AS INTEGER      ' 004 ..2   Index of last visited folder (0 for none)END TYPE                ' 6 BYTES - Scope descriptorDIM SHARED pathLst AS STRING * 20000      ' Parent and current sub-foldersDIM SHARED pathOfs AS INTEGER             ' Writing offset for pathLstDIM SHARED levlNfo(0 TO 63) AS scopeInfo  ' Root plus 63 levels deepDIM SHARED levlNow AS INTEGER             ' How deep we are' Search for all files named "duke3d.grp" starting from "c:/games/"' Note: the program assumes more than one file can have this name; finding a' file won't stop the program. There's not user escape implemented.searchFile "c:/games/", "duke3d.grp"'''' Display folder name buffer, DEBUG PURPOSE ONLY''SUB debugBuffer  DIM length AS INTEGER, offset AS INTEGER, scopeId AS INTEGER  offset = 1  DO    IF (offset = levlNfo(scopeId).start) THEN      COLOR 1 + (scopeId AND &HF)      scopeId = scopeId + 1    END IF    length = ASC(MID$(pathLst, offset, 1))    PRINT MID$(pathLst, offset + 1, length); " ";    offset = offset + length + 1  LOOP WHILE (offset < pathOfs)  COLOR 8: PRINT pathOfsEND SUB'''' Get all objects in current directory''SUB getObjects (where AS STRING, query AS STRING)  DIM DTA AS STRING * 44, MaskZ AS STRING  DIM regs AS RegTypeX, objName AS STRING  '' SETUP DTA SO WE DON'T DESTROY COMMAND$ ''  regs.ax = &H1A00                  ' Set DTA function  regs.dx = VARPTR(DTA)             ' DS:DX points to our DTA  regs.ds = -1                      ' Use current value for DS  CALL INTERRUPTX(&H21, regs, regs) ' Do the interrupt  MaskZ = where + "*.*" + CHR$(0)   '  Mask (search all)  regs.ax = &H4E00                  '  FindFirst  regs.cx = 16                      '  Get all object types  regs.dx = SADD(MaskZ)             '  DS:DX points to ASCIIZ file mask  regs.ds = -1                      '  Use current DS  '' PARSE ALL OBJECTS ''  DO    CALL INTERRUPTX(&H21, regs, regs)    ' Do the interrupt    IF (regs.flags AND &H1) THEN EXIT DO ' No object left    objName = UCASE$(MID$(DTA, 31, INSTR(31, DTA, CHR$(0)) - 31))    ' Folder, append to scope    IF (ASC(MID$(DTA, &H15 + 1, 1)) AND &H10) THEN      IF ((objName <> ".") AND (objName <> "..")) THEN        IF scopeAppend%(objName) THEN PRINT "Buffer overflow!": END      END IF    ' File, compare with query    ELSE      IF (objName = query) THEN        PRINT "Found file in " + CHR$(34) + where + CHR$(34) + " there might be more! (PRESS ANY KEY)": SLEEP      END IF    END IF    ' FindNext    regs.ax = &H4F00  LOOPEND SUB'''' Last occurence of a string''FUNCTION INSTRREV% (source AS STRING, find AS STRING)  DIM ofs AS INTEGER  DO    INSTRREV% = ofs    ofs = INSTR(ofs + 1, source, find)  LOOP WHILE ofsEND FUNCTION'''' Append subfolder to scope. One byte is reserved to provide the length in'' bytes of the folder name. This takes less memory than assuming that all'' folders have 12-byte long names. This function returns -1 if the memory'' buffer is saturated. Returns 0 if the sub-folder was successfully added.''FUNCTION scopeAppend% (folder AS STRING)  DIM tmp AS STRING  IF (levlNfo(levlNow).start = 0) THEN levlNfo(levlNow).start = pathOfs  levlNfo(levlNow).count = levlNfo(levlNow).count + 1  tmp = LTRIM$(RTRIM$(UCASE$(folder)))  tmp = CHR$(LEN(tmp)) + tmp  IF ((pathOfs + LEN(tmp)) >= LEN(pathLst)) THEN    scopeAppend% = -1  ELSE    MID$(pathLst, pathOfs, LEN(tmp)) = tmp    pathOfs = pathOfs + LEN(tmp)    scopeAppend% = 0  END IFEND FUNCTION'''' Free current scope and go back to parent. Freeing means that we no longer'' need the sub-folder list for this scope so we can rewrite it. We also clear'' the descriptor so it can be re-used. This function returns -1 if root as'' been reached (there's no parent directory.)''FUNCTION scopeDown%  IF levlNfo(levlNow).start THEN pathOfs = levlNfo(levlNow).start  levlNfo(levlNow).start = 0  levlNfo(levlNow).count = 0  levlNfo(levlNow).visit = 0  scopeDown% = (levlNow = 0)END FUNCTION'''' Search for the next sub-folder in this scope we should be browsing. The'' "folder" argument returns the name of the next folder to enter (variable is'' never read, only written.) If there is no more folder to visit, "folder" is'' empty (you have to scopeDown.)''FUNCTION scopeUp$  DIM offset AS INTEGER, length AS INTEGER  levlNfo(levlNow).visit = levlNfo(levlNow).visit + 1  IF (levlNfo(levlNow).visit > levlNfo(levlNow).count) THEN    scopeUp$ = "" ' nothing left to see here  ELSE    ' get next folder in line to browse    offset = levlNfo(levlNow).start    FOR i% = 1 TO levlNfo(levlNow).visit      length = ASC(MID$(pathLst, offset, 1))      offset = offset + length + 1    NEXT i%    scopeUp$ = MID$(pathLst, offset - length, length)  END IFEND FUNCTION'''' Where is the base directory (where we start looking for the file,) it must'' be an absolute path and be terminated with a forward slash ("/".) Query is'' the file name we're looking for.''SUB searchFile (where AS STRING, query AS STRING)  DIM pathNxt AS STRING, pathAll AS STRING  DIM move AS INTEGER  pathOfs = 1     ' Always set to 1 before starting  move = moveROOT ' Pretend we're moving up (for folder list)  levlNow = 0     ' We start at level 0  pathAll = where  query = LTRIM$(RTRIM$(UCASE$(query)))  DO    IF (move <> moveDOWN) THEN      if (debugLevel = 1) then PRINT CHR$(34) + pathAll + CHR$(34)      ' Append directories, search for file      IF (move) THEN levlNow = levlNow + 1      CALL getObjects(pathAll, query)    END IF    if (debugLevel = 2) then      CLS : PRINT CHR$(34) + pathAll + CHR$(34); TAB(75); levlNow: debugBuffer    end if    ' Enter next sub-directory    pathNxt = scopeUp$    IF LEN(pathNxt) THEN      pathAll = pathAll + pathNxt + "/"      move = moveUP    ELSE      IF (scopeDown%) THEN EXIT DO      levlNow = levlNow - 1      pathAll = LEFT$(pathAll, INSTRREV%(LEFT$(pathAll, LEN(pathAll) - 1), "/"))      move = moveDOWN    END IF  LOOPEND SUB

This can be optimized. For instance, searching for the next folder via an index is slower than using an offset since we're parsing the same strings over and over again. I also suspect searching for the file separately could be a tiny bit faster than using the same code for both folders and file match. Using fixed-length folder names will be a lot faster, but will require more memory...

EDIT AGAIN: I made the tiny optimization I mentioned earlier (using an offset rather than an index for string parsing) and it really speeds things up when directories have many sub folders (it's easy to add and really worth it!) I tried a compiled version of the program on a disk with 43,902 files and 2,699 folders, it didn't crash. At most, only 10% of the string buffer was used (2,139 bytes out of 20,000 allocated - so really, no need for XMS or virtual memory,) and the deepest the program had to go was 11 levels (it can go up to 63 - there's no check for that so beware.) It found "ultramid.ini" 10 times in 44 seconds (DOSBox at 3,000 cycles,) and took about 3 seconds with 100% cycles.

Attaching a file containing the dirty (yet somewhat usable) program. Source included, use at your own risks, etc.

RE-EDIT AGAIN: adding another version, it supports file masking and displays the result in a somewhat orderly fashion (including file size and time stamp.) It's usable. Tested under DOSBox only.

FINDME2.ZIP

FINDME.ZIP

Statistics: Posted by MikeHawk — Wed Aug 18, 2021 9:28 pm

QBASIC and QB64 Questions & Answers • Re: Parallelport communication.

2021-08-14T08:25:57-05:00

I am looking for help using Qbasic with Windows
I have a program that I want to access the printer port, not to print but to provide binary outputs. It works sometimes and sometimes won't. I know Windows redirects the printer port or something. This would be the standard 25 pin printer port. Thanks for any help. kc0nfs@arrl.net

Statistics: Posted by kc0nfs — Sat Aug 14, 2021 8:25 am

QBASIC and QB64 Questions & Answers • Re: Parallelport communication.

2021-09-23T20:58:21-05:00

I am looking for help using Qbasic with any Windows Operating system.
I have a program that I want to access the printer port, not to print but to provide binary outputs. It works sometimes and sometimes won't. I know Windows redirects the printer port or something. This would be the standard 25 pin printer port. Thanks for any help.

Statistics: Posted by kc0nfs — Sat Aug 14, 2021 8:24 am