Dim x, oldx(3) As Long

Dim i, cnt, cy, cx As Integer

Screen _NewImage(800, 600, 8)

Cls

font = _LoadFont("cyberbit.ttf", 24)

unifont = _LoadFont("cyberbit.ttf", 24, "UNICODE")

_Font font

Do

    x = _KeyHit

    If x And x <> oldx(1) And x <> oldx(2) And x <> oldx(3) Then

        Select Case x

            Case Is > 0

                Color 10

                Print "Pressed "; ' Positive value means key was pressed.

                cnt = cnt + 1 ' Tracking on.

                oldx(cnt) = x

            Case Else ' Negative value means key was released.

                Color 2

                Print "Released ";

                x = -x

                i = 0: Do ' Tracking off.

                    i = i + 1

                    If oldx(i) = x Then cnt = cnt - 1: oldx(i) = 0: Exit Do

                Loop Until i = 3

        End Select

        Select Case x

            Case Is < 256

                If x < 256 Then ' ASCII code values.

                    Print "ASCII "; x;

                    If x >= 32 And x <= 255 Then Print "[" + Chr$(x) + "]" Else Print

                End If

            Case 256 To 65536 ' 2 byte key codes.

                Print "2-BYTE-COMBO "; x And 255; x \ 256;

                x2 = x \ 256

                If x2 >= 32 And x2 <= 255 Then Print "[" + Chr$(x2) + "]" Else Print

            Case 100000 To 199999 ' QB64 Virtual Key codes.

                Print "SDL VK"; x - 100000

            Case 200000 To &H3FFFFFFF

                Print "QB64 VK"; x - 200000

            Case Is >= &H40000000 ' Unicode values. (IME Input mode)

                Print "UNICODE "; x - &H40000000; "0x" + Hex$(x - &H40000000) + " ...";

                cx = Pos(1): cy = CsrLin

                _Font unifont

                Locate cy, cx

                Color 15

                z$ = MKL$(x - &H40000000) + MKL$(0)

                Print z$ + z$ + z$;

                _Font font

                Locate cy, 1: Print

        End Select

    End If

Loop

Hey guys, would one increment less than

&H40000000 be...

&H3FFFFFFF 

Thanks, 

Pete

While youse guys are studying cause and effect, I've been experimenting with the DefInt function, and I don't understand the results.
The DefInt function truncates all variables of that name to their integer values, and they then operate with this integer value, right?
But why do I get the Inf result in this snippet? I guess it's to do with their binary expression? 
t1 and t2 are "simple" integers aren't they?

I noticed that ON ERROR line labels can't be placed within subroutines:

SUB MySub()

    ON ERROR GOTO ErrHandler

    ... code

    ErrHandler:

END SUB

Is this normal? I'm using QB64pe v3.13.1

The Wiki states ON ERROR can be used in Subs/Functions but no mention of label being required to be outside of the Sub/Function.

in the Wiki the Len function is described for strings only but QBasic uses the Len function also to get the size in bytes of data types including udts
but QB64pe also gives the size in bytes of an array, but this seems to be a feature and it behaves strangely
the following works and prints 50, 100 and 200

Dim As Integer i(4, 4)

Dim As Long l(4, 4)

Dim As _Integer64 ll(4, 4)



Print Len(i())

Print Len(l())

Print Len(ll())

Print Len(l()) / Len(i())

this is only an example of accumulated errors in double floating-point

_Title "MatMul"

$Console:Only

_Dest _Console



Dim As Double a(3, 3), b(3, 3), c(3, 3), d(3, 3)

Dim As Long i



a(0, 0) = 1#: a(0, 1) = 1#: a(0, 2) = 1#: a(0, 3) = 1#

a(1, 0) = 2#: a(1, 1) = 4#: a(1, 2) = 8#: a(1, 3) = 16#

a(2, 0) = 3#: a(2, 1) = 9#: a(2, 2) = 27#: a(2, 3) = 81#

a(3, 0) = 4#: a(3, 1) = 16#: a(3, 2) = 64#: a(3, 3) = 256#



'b() = Inverse of a()

b(0, 0) = 4#: b(0, 1) = -3#: b(0, 2) = 4 / 3#: b(0, 3) = -1 / 4#

b(1, 0) = -13 / 3#: b(1, 1) = 19 / 4#: b(1, 2) = -7 / 3#: b(1, 3) = 11 / 24#

b(2, 0) = 3 / 2#: b(2, 1) = -2#: b(2, 2) = 7 / 6#: b(2, 3) = -1 / 4#

b(3, 0) = -1 / 6#: b(3, 1) = 1 / 4#: b(3, 2) = -1 / 6#: b(3, 3) = 1 / 24#



MatMul d(), a(), a()

MatMul c(), d(), b()

printm c()

Print

For i = 1 To 4

    MatMul d(), c(), c()

    MatMul c(), d(), b()

    printm c()

    Print

Next



Sub MatMul (ans() As Double, a() As Double, b() As Double)

    Dim As Long i, j, k, n, m, p

    If (UBound(a, 2) = UBound(b)) Then 'if valid dims

        n = UBound(a, 2)

        m = UBound(a)

        p = UBound(b, 2)



        For i = 0 To m

            For j = 0 To p

                For k = 0 To n

                    ans(i, j) = 0

        Next k, j, i



        For i = 0 To m

            For j = 0 To p

                For k = 0 To n

                    ans(i, j) = ans(i, j) + (a(i, k) * b(k, j))

        Next k, j, i

    Else

        Print "invalid dimensions"

    End If

End Sub



Sub printm (a() As Double)

    Dim As Long i, j, m, p

    m = UBound(a)

    p = UBound(a, 2)

    For i = 0 To m

        For j = 0 To p

            Print Using "####.##############"; a(i, j);

        Next j

        Print

    Next i

End Sub

Hi all,

Back in 2022 I made this with the help of Petr and probably others on this forum. It simulates a Tesla Coil that shoots lightning from a rod and the lightning dances with the music you choose. Tonight I added a file dialog box to easily be able to choose a song to play on it. I also added the ability to stop it during play to choose another song. I included an old album I created on my computer around 20 years ago in the zip file. The album has no lyrics, just electronic music.  
Tell me what you think, thanks.

Edit: An improved version is on the next reply post. I removed this one.

I am changing all of my libraries to be agnostic to color depth...or at least trying.  I want them to automatically detect whether we are in 16 color, 256 color, or 32 bit color mode and automatically make adjustments on the fly to compensate for the colors being used, and use the proper colors.

So far so good, EXCEPT that I am having an issue with accurately detecting whether we are in 16 color, 256 color, or 32 bit color.

I cannot find this as a command for QB64.  Is there an easy way to accurately detect this?

So here's a challenge which I'd like to propose for all of our coders here to undertake -- particularly @TerryRitchie @bplus @Pete @Dav , but which I'd truly LOVE to see everyone tackle.

The program concept is very simple -- Write a program that simulates you being a merchant in ancient times.  You have a whole bunch of lead weights, which you can use to measure out how much a customer's gold nugget weighs.

Your available weights are all in the power of two -- you have:

1 four-pound weight.
1 two-pound weight.
1 one-pound weight.
1 half-pound weight.
1 quarter-pound weight.
1 1/8-pound weight.
And so on to give you one of each weight from 4 pounds to 1/256 pounds.

Now the task is to figure out what weights are required to properly and perfectly weigh the following:

A 3 pound gold nugget
A 3/8 pound gold nugget
A 11/32 pound gold nugget
A 1/10 pound gold nugget

Now the first solution is obviously 1 2-pound weight + 1 1-pound weight. 
The question is -- can you find the proper combination for the other three nuggets I've mentioned??

Here is a modified version of the _KEYHIT Wiki example...

DefLng A-Z

Screen _NewImage(800, 600, 8)

Cls , 1

font = _LoadFont("cyberbit.ttf", 24)

unifont = _LoadFont("cyberbit.ttf", 24, "UNICODE")

_Font font



Do

    x = _KeyHit

    If x And x <> oldx Then

        Select Case x

            Case Is > 0

                Color 10

                Print "Pressed "; 'positive value means key pressed

                oldx = x

            Case Else 'negative value means key released

                Color 2

                Print "Released ";

                x = -x

                oldx = 0

        End Select

        Select Case x

            Case Is < 256

                If x < 256 Then 'ASCII code values

                    Print "ASCII "; x;

                    If x >= 32 And x <= 255 Then Print "[" + Chr$(x) + "]" Else Print

                End If

            Case 256 To 65536 '2 byte key codes

                Print "2-BYTE-COMBO "; x And 255; x \ 256;

                x2 = x \ 256

                If x2 >= 32 And x2 <= 255 Then Print "[" + Chr$(x2) + "]" Else Print

            Case 100000 To 199999 'QB64 Virtual Key codes

                Print "SDL VK"; x - 100000

            Case Else

                If x >= 200000 And x < &H40000000 Then

                    Print "QB64 VK"; x - 200000

                    _Continue

                End If

                If x >= &H40000000 Then 'Unicode values (IME Input mode)

                    Print "UNICODE "; x - &H40000000; "0x" + Hex$(x - &H40000000) + " ...";

                    cx = Pos(1): cy = CsrLin

                    _Font unifont

                    Locate cy, cx

                    Color 15

                    z$ = MKL$(x - &H40000000) + MKL$(0)

                    Print z$ + z$ + z$;

                    _Font font

                    Locate cy, 1: Print

                End If

        End Select

    End If

Loop