QB64 Phoenix Edition

Welcome, Guest

You have to register before you can post on our site.

Search Forums

(Advanced Search)

Forum Statistics

» Members: 308
» Latest member: Donaldvem
» Forum threads: 1,741
» Forum posts: 17,901

Full Statistics

Latest Threads

The QB64 IDE shell
Forum: Utilities
Last Post: JasonPag
09-16-2024, 05:37 PM
» Replies: 9
» Views: 762

Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 31

Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 32

DAY 009:_PutImage
Forum: Keyword of the Day!
Last Post: grymmjack
09-02-2023, 02:57 PM
» Replies: 54
» Views: 2,032

Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 1,261

ColorPicker - Function th...
Forum: Dav
Last Post: Dav
08-31-2023, 11:04 PM
» Replies: 3
» Views: 315

Goals(1) = New Tile()
Forum: Works in Progress
Last Post: RhoSigma
08-31-2023, 09:45 PM
» Replies: 3
» Views: 127

micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 3,589

Updating The Single Most ...
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:13 PM
» Replies: 7
» Views: 254

QBJS Image Question
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 05:49 PM
» Replies: 5
» Views: 155

Numbers at end of Play strings

Posted by: PhilOfPerth - 06-23-2023, 05:41 AM - Forum: Terry Ritchie - Replies (13)

	In some music strings (eg. the William Tell Overture presented in the Tutorial), quite a lot of lines end with a number (mostly 4 or 8), that's not related to length or anything that I can identify. Are they just "strays", or is there a function that's not documented?

Retro-style game: Clay Pigeon!

Posted by: CharlieJV - 06-23-2023, 01:56 AM - Forum: QBJS, BAM, and Other BASICs - Replies (3)

	Nothing fancy, but old-school charm. This is a BASIC Anywhere Machine port with slight mods of a neat little FreeBASIC program by electricwalrus: play the game. Source code listed below the console window.

What extra features does VARPTR provide?

Posted by: PhilOfPerth - 06-22-2023, 03:53 AM - Forum: Help Me! - Replies (10)

I'm in trouble again!
I'm experimenting with VARPTR$ and built the experimental prog below, to compare with a sample given in Help that uses VARPTR$.
It seems I can get the same result without VARPTR$, so I don't see the reason for using it.
What am I missing?

Code: (Select All)
Screen 2

Cls

WIND$ = "r10 d7 l10 u7 br20" '                                        wind$ is a rectangle and "blind" move to right

ROW$ = WIND$ + WIND$ + WIND$ + WIND$ + "bl80 bd11" '                  row$ is four wind$, and "blind" moves left and down

For a = 1 To 4: Draw ROW$: Next '                                     draw four rows of wind$

Sleep: Cls '                                                          and to include the TA feature...

WIND$ = "ta45 r10 d7 l10 u7 br20"

ROW$ = WIND$ + WIND$ + WIND$ + WIND$ + "bl80 bd11"

For a = 1 To 4: Draw ROW$: Next

SHARED Array values with SUBs and FUNCTIONs

Posted by: Donald Foster - 06-22-2023, 02:39 AM - Forum: General Discussion - Replies (11)

Hello All,

I usually use GOSUB for all my subroutines mainly because I'm comfortable with them and know how to use them. But there are times when I must be careful not to use the same variable names for loops when I inside a loop with the same name. For this reason, it seems SUBs and FUNCTIONs would help to prevent this problem. However, I don't know how to access ARRAYs created in the main code and SHARE it with SUBs and FUNCTIONs. I can find no examples in the WIKI.

Donald

QB64 GUI Dialogs Question

Posted by: Ultraman - 06-21-2023, 12:37 PM - Forum: General Discussion - Replies (5)

	The open dialog works great. It pops open the expected native Windows open dialog. The "Save As" button still opens the old dialog. Is this intentional? I'd assume not, since that would be some inconsistency. I'm on Windows 11 64 bit, by the way. Haven't tried it on Linux yet to confirm if it does it there as well. Forgot to mention I am running the latest release.

Console Multi_prompt Input

Posted by: James D Jarvis - 06-20-2023, 02:21 PM - Forum: Utilities - Replies (4)

Use the Console for multi-prompt inputs.
The routine is shown here with a simple example.

Code: (Select All)
'Console multi_input

'

'an example program for a routine to use the console window for multi-line input prompts

$Console

_Console Off 'turn off the console for now

_Delay 0.1

Print "Press any key when ready."

Sleep

Cls

Dim p$(5), aa$(5)

'setup the input prompts

p$(1) = "First Name : "

p$(2) = "Middle     : "

p$(3) = "Last Name  : "

p$(4) = "Street     : "

p$(5) = "City/Town  : "

multi_input "Multi_Input Sample", p$(), aa$()

Print aa$(3); ", "; aa$(1); " "; aa$(2)

Print aa$(4); ", "; aa$(5)

End

Sub multi_input (cptitle$, prompt$(), ia$())

    'cptitle$ is the console prompt title

    'prompt$() array of prompts

    'ia$() array of input data

    ind& = _Dest 'get the screen

    _Console On 'turn the console back on

    If cptitle$ = "" Then _ConsoleTitle "Prompt" Else _ConsoleTitle cptitle$ 'set the console title

    _ScreenHide 'hide the mainscreen

    _Dest _Console

    Cls 'clear the console

    mi = UBound(prompt$) 'check how many entries are being asked for

    For n = 1 To mi 'print the prompts

        Print prompt$(n)

    Next n

    Locate 1, 1 'reset cursor to top left corner

    For n = 1 To mi 'reprint prompts and get the input

        Print prompt$(n);

        Input ia$(n)

    Next n

    _ScreenShow

    _Dest ind&

    _Console Off

End Sub

BAM: starting to use railroad diagrams to document syntax

Posted by: CharlieJV - 06-20-2023, 02:19 AM - Forum: QBJS, BAM, and Other BASICs - No Replies

	For example, the MAX function.

Fisher Yates Shuffle for cards or any number of items

Posted by: bplus - 06-19-2023, 11:19 PM - Forum: Utilities - Replies (4)

As discussed in Ranking Poker Hands:

Code: (Select All)
TopN = 52

ReDim n(1 To TopN) 'repeatable for ref

For i = 1 To TopN

    n(i) = i

Next

For i = TopN To 2 Step -1 ' Fisher Yates Shuffle of N Items

    Swap n(i), n(Int(Rnd * (i) + 1))

Next

For i = 1 To TopN

    Print "  "; i; "-"; n(i); Chr$(9);

Next

Print

At maximum you need only swap n-1 items!

Drawcards

Posted by: James D Jarvis - 06-19-2023, 08:49 PM - Forum: Programs - Replies (8)

Ascii card drawing routine and a simple deck shuffling routine. I'm using the 8x8 font set but it's in "amazing" RGB32 graphics!

Code: (Select All)

'drawcards v1

'ascii playing cards but for 32 bit graphics

'by James D. Jarvis

'use as you wish

Screen _NewImage(480, 288, 32)

_Font 8

_FullScreen

Color _RGB32(5, 5, 5), _RGB32(250, 250, 250)

_ControlChr Off

Dim Shared card$(0 To 52)

_Title "DRAWCARDS v1.0"

buildcards 'got to build the deck

Do

    shuffledeck 'shuffle the whole deck

    'just a demo of the first 21 cards laid out  after shuffling hte deck

    drawcard 0, 10, card$(1)

    drawcard 50, 10, card$(2)

    drawcard 100, 10, card$(3)

    drawcard 150, 10, card$(4)

    drawcard 200, 10, card$(5)

    drawcard 250, 10, card$(6)

    drawcard 300, 10, card$(7)



    drawcard 50, 110, card$(8)

    drawcard 80, 115, card$(9)

    drawcard 110, 120, card$(10)

    drawcard 140, 125, card$(11)

    drawcard 170, 120, card$(12)

    drawcard 200, 115, card$(13)

    drawcard 230, 110, card$(14)



    drawcard 300, 90, card$(15)

    drawcard 320, 105, card$(16)

    drawcard 340, 120, card$(17)

    drawcard 360, 135, card$(18)

    drawcard 380, 150, card$(19)

    drawcard 400, 165, card$(20)

    drawcard 420, 180, card$(21)



    _PrintString (10, 250), "Press any key to reshuffle, <esc> to quit"

    Do

        _Limit 60

        kk$ = InKey$

    Loop Until kk$ <> ""

Loop Until kk$ = Chr$(27)

Sub buildcards

    'build a deck of cards

    Dim cc$(13)

    Dim st$(4)

    cc$(1) = "A": cc$(10) = "T": cc$(11) = "J": cc$(12) = "Q": cc$(13) = "K"

    cc$(2) = "2": cc$(3) = "3": cc$(4) = "4": cc$(5) = "5": cc$(6) = "6": cc$(7) = "7": cc$(8) = "8": cc$(9) = "9"

    st$(1) = "H": st$(2) = "C": st$(3) = "S": st$(4) = "D"

    c = 0

    For ss = 1 To 4

        For rr = 1 To 13

            c = c + 1

            card$(c) = cc$(rr) + st$(ss)

        Next rr

    Next ss

End Sub



Sub shuffledeck

    'shuffle the whole deck by randomly swapping pairs of cards

    For x = 1 To 676 'this should sort the deck enoguh

        a = Int(1 + Rnd * 52)

        Do

            b = Int(1 + Rnd * 52)

        Loop Until a <> b

        Swap card$(a), card$(b)

    Next x

End Sub



Sub drawcard (cx, cy, card$)

    'draws a ascii graphics card using the 8x8 fonts

    Dim klr As _Unsigned Long

    suit$ = Mid$(card$, 2, 1)

    rank$ = Mid$(card$, 1, 1)

    st = 0

    _PrintString (cx, cy), Chr$(201) + Chr$(205) + Chr$(205) + Chr$(205) + Chr$(187)

    _PrintString (cx, cy + 8), Chr$(186) + Chr$(32) + Chr$(32) + Chr$(32) + Chr$(186)

    _PrintString (cx, cy + 16), Chr$(186) + Chr$(32) + Chr$(32) + Chr$(32) + Chr$(186)

    _PrintString (cx, cy + 24), Chr$(186) + Chr$(32) + Chr$(32) + Chr$(32) + Chr$(186)

    _PrintString (cx, cy + 32), Chr$(186) + Chr$(32) + Chr$(32) + Chr$(32) + Chr$(186)

    _PrintString (cx, cy + 40), Chr$(186) + Chr$(32) + Chr$(32) + Chr$(32) + Chr$(186)

    _PrintString (cx, cy + 48), Chr$(186) + Chr$(32) + Chr$(32) + Chr$(32) + Chr$(186)

    _PrintString (cx, cy + 56), Chr$(186) + Chr$(32) + Chr$(32) + Chr$(32) + Chr$(186)

    _PrintString (cx, cy + 64), Chr$(200) + Chr$(205) + Chr$(205) + Chr$(205) + Chr$(188)

    Select Case suit$

        Case "H"

            st = 3

            klr = _RGB32(250, 0, 0)

        Case "C"

            st = 5

            klr = _RGB32(50, 50, 50)

        Case "S"

            st = 6

            klr = _RGB32(50, 50, 50)

        Case "D"

            st = 4

            klr = _RGB32(250, 0, 0)

    End Select

    Color klr, _RGB32(250, 250, 250)

    Select EveryCase rank$

        Case "2", "3"

            _PrintString (cx + 8, cy + 8), Chr$(Asc(rank$))

            _PrintString (cx + 8, cy + 48), Chr$(st)

            _PrintString (cx + 24, cy + 16), Chr$(st)

            _PrintString (cx + 24, cy + 56), Chr$(Asc(rank$))

        Case "4", "5"

            _PrintString (cx + 8, cy + 16), Chr$(st)

            _PrintString (cx + 8, cy + 48), Chr$(st)

            _PrintString (cx + 24, cy + 16), Chr$(st)

            _PrintString (cx + 24, cy + 48), Chr$(st)

        Case "6", "7"

            _PrintString (cx + 8, cy + 16), Chr$(st)

            _PrintString (cx + 8, cy + 32), Chr$(st)

            _PrintString (cx + 8, cy + 48), Chr$(st)

            _PrintString (cx + 24, cy + 16), Chr$(st)

            _PrintString (cx + 24, cy + 32), Chr$(st)

            _PrintString (cx + 24, cy + 48), Chr$(st)

        Case "8", "9"

            _PrintString (cx + 8, cy + 16), Chr$(st)

            _PrintString (cx + 8, cy + 24), Chr$(st)

            _PrintString (cx + 8, cy + 40), Chr$(st)

            _PrintString (cx + 8, cy + 48), Chr$(st)

            _PrintString (cx + 24, cy + 16), Chr$(st)

            _PrintString (cx + 24, cy + 24), Chr$(st)

            _PrintString (cx + 24, cy + 40), Chr$(st)

            _PrintString (cx + 24, cy + 48), Chr$(st)

        Case "T"

            _PrintString (cx + 8, cy + 8), "10"

            _PrintString (cx + 8, cy + 16), Chr$(st)

            _PrintString (cx + 8, cy + 24), Chr$(st)

            _PrintString (cx + 8, cy + 32), Chr$(st)

            _PrintString (cx + 8, cy + 40), Chr$(st)

            _PrintString (cx + 8, cy + 48), Chr$(st)

            _PrintString (cx + 24, cy + 16), Chr$(st)

            _PrintString (cx + 24, cy + 24), Chr$(st)

            _PrintString (cx + 24, cy + 32), Chr$(st)

            _PrintString (cx + 24, cy + 40), Chr$(st)

            _PrintString (cx + 24, cy + 48), Chr$(st)

            _PrintString (cx + 16, cy + 56), "10"



        Case "A", "3", "5", "7", "9"

            _PrintString (cx + 16, cy + 32), Chr$(st)

        Case "J"

            _PrintString (cx + 12, cy + 26), Chr$(192) + Chr$(217)

            _PrintString (cx + 16, cy + 26), Chr$(193)



        Case "Q"

            _PrintString (cx + 8, cy + 26), Chr$(192) + Chr$(st) + Chr$(217)

            _PrintString (cx + 10, cy + 32), Chr$(40)

            _PrintString (cx + 24, cy + 32), Chr$(41)

        Case "K"

            _PrintString (cx + 16, cy + 18), Chr$(215)

            _PrintString (cx + 8, cy + 26), Chr$(200) + Chr$(202) + Chr$(188)

            _PrintString (cx + 16, cy + 38), Chr$(31)

        Case "J", "Q", "K"

            _PrintString (cx + 8, cy + 8), Chr$(Asc(rank$)) + Chr$(st)

            _PrintString (cx + 16, cy + 32), Chr$(1)

        Case "2", "3", "4", "5", "6", "7", "8", "9", "A", "J", "Q", "K"

            _PrintString (cx + 8, cy + 8), Chr$(Asc(rank$))

            _PrintString (cx + 24, cy + 56), Chr$(Asc(rank$))

    End Select

    Color _RGB32(5, 5, 5), _RGB32(250, 250, 250)

End Sub

Audio Presentation of Number

Posted by: bplus - 06-18-2023, 11:06 PM - Forum: Programs - No Replies

Using a Sound for Lowest Prime Divisor:

Code: (Select All)
' Audio presentation of numbers.bas for QB64 fork (B+=MGA) 2017-09-20

' Using Owens 2X Deluxe Mod

_Title "Audio Presentation of Numbers as Primes = 0 or First Factor"

_Define A-Z As _INTEGER64

Option Base 1

Common Shared ff(), topN

topN = 1000000

testlimitN = Sqr(topN)

Dim ff(topN + 30)

For i = 0 To topN Step 30

    ff(i + 2) = 2: ff(i + 3) = 3: ff(i + 4) = 2: ff(i + 5) = 5: ff(i + 6) = 2: ff(i + 8) = 2: ff(i + 9) = 3

    ff(i + 10) = 2: ff(i + 12) = 2: ff(i + 14) = 2: ff(i + 15) = 3: ff(i + 16) = 2: ff(i + 18) = 2

    ff(i + 20) = 2: ff(i + 21) = 3: ff(i + 22) = 2: ff(i + 24) = 2: ff(i + 25) = 5

    ff(i + 26) = 2: ff(i + 27) = 3: ff(i + 28) = 2: ff(i + 30) = 2

Next

ff(2) = 0: ff(3) = 0: ff(5) = 0

pattern(1) = 4: pattern(2) = 2: pattern(3) = 4: pattern(4) = 2

pattern(5) = 4: pattern(6) = 6: pattern(7) = 2: pattern(8) = 6

pcand = 7: patternI = 0

While pcand < testlimitN

    If ff(pcand) = 0 Then

        i = pcand * pcand

        patternI2 = patternI

        Do

            If ff(i) = 0 Then ff(i) = pcand

            patternI2 = patternI2 + 1

            If patternI2 = 9 Then patternI2 = 1

            i = i + pattern(patternI2) * pcand

            If i > topN Then Exit Do

        Loop

    End If

    patternI = patternI + 1

    If patternI = 9 Then patternI = 1

    pcand = pcand + pattern(patternI)

Wend

For i = 2 To topN

    Cls

    Print i, ff(i)

    If ff(i) = 0 Then Sound 137, 2 Else Sound 137 + (ff(i) Mod 30) * 10, 2 - ff(i) * .001

    _Limit 60

Next

Pages (165): « Previous 1 … 14 15 16 17 18 … 165 Next »

Login
Username/Email:
Password:	Lost Password?
	Remember me