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

Username/Email:
  

Password
  





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,022
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: 126
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 3,501
Updating The Single Most ...
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:13 PM
» Replies: 7
» Views: 252
QBJS Image Question
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 05:49 PM
» Replies: 5
» Views: 153

 
  Fully Featured Sudoku App
Posted by: bplus - 04-22-2022, 11:45 AM - Forum: bplus - Replies (7)

I will be adding to this little corner of forum my QB64 code as I check them in through Linux QB64 v 1.5 (I don't need debug), they already work fine in Windows v2.0 

Sudoku is by far my most used and favorite app I've created with QB64 and version 2020-08-08 has been tested allot! 

The Sudoku app has 2 screens, the first is just an Info/Help screen from which you enter a level of play.
 
Levels are mostly determined by the number of clues you are given, the more the easier.
The lower levels are for practice or flash card like automatic skills builder. 6 gives intermediate puzzle 7 a little harder intermediate 8 would be hardest but takes longer to build for unique solution and may end up a level 7 puzzle.
9 gives you a blank puzzle and puts you in Make Mode and you can click in a puzzle from newspaper or book.
Remember to click back to Puzzle Mode when done making the puzzle.

The Puzzle screen has some menu buttons:
The first on left toggles the solution, ON OFF
The 2nd from left toggles the check cell mode. ON will not allow you to make a simple error of putting a 2nd number in row, column or 3x3 cell block and beep you if you try. Just because you are not beeped, doesn't mean it is correct.
The Load and Save buttons work with one Temp file. Just rename that file or copy and rename if you want to store a special puzzle, perhaps one that was particularly hard. Otherwise every time you save a puzzle the last one in Temp will be overwritten.

Play: Is basically clicking a number from number palette and left click a cell to answer or right click to toggle a note of that number on and off again. To remove a number clicked in, set the number palette to 0, click that in and then reset to number you want to do next.
[Image: Sudoku-Info-Levels.png]

[Image: Sudoku-Puzzle-sheet.png]


.zip   Sudoku 2020-08-08.zip (Size: 539.28 KB / Downloads: 84)


Oh! This is putting the zip file at the top of the post! No wonder I couldn't find it!

Print this item

  ASCII Picker
Posted by: SMcNeill - 04-22-2022, 03:11 AM - Forum: SMcNeill - No Replies

You guys may have seen something like this somewhere before, but this is the original, prettier version than the one that exists inside the QB64 IDE.  Big Grin

Code: (Select All)
_Title "External ASCII Picker"
Screen _NewImage(640, 480, 32)
f = _LoadFont("cour.ttf", 128) 'a nice large display font, not a 100% match to QB64's inbuilt version,
_Font f '                      but it works easily here for a demo highlight character



_ControlChr Off
Do
    out$ = ASCIIbox$ 'get an ASCII character
    If out$ = "" Then System
    Print out$, Asc(out$) 'preview it
    Sleep: _KeyClear 'hit a key to select another
    Cls
Loop

Function ASCIIbox$
    Static temp As Long, temp1 As Long, ws As Long
    d = _Dest
    font = _Font
    If temp = 0 Then 'static backgrounds so we don't have to make them over and over, or worry about freeing them
        temp = _NewImage(640, 480, 32)
        temp1 = _NewImage(640, 480, 32)
        ws = _NewImage(640, 480, 32)
    End If
    Screen temp
    Dim CurrentASC(1 To 16, 1 To 16)
    Dim CurrentOne As Integer
    Cls , _RGB(0, 0, 170)
    Color , _RGB(0, 0, 170)
    For y = 1 To 16
        For x = 1 To 16
            Line (x * 40, 0)-(x * 40, 480), _RGB32(255, 255, 0)
            Line (0, y * 30)-(640, y * 30), _RGB32(255, 255, 0)
            If counter Then _PrintString (x * 40 - 28, y * 30 - 23), Chr$(counter)
            counter = counter + 1
        Next
    Next

    _Dest temp1
    Cls , _RGB(0, 0, 170)
    Color , _RGB(0, 0, 170)
    counter = 0
    For y = 1 To 16
        For x = 1 To 16
            Line (x * 40, 0)-(x * 40, 480), _RGB32(255, 255, 0)
            Line (0, y * 30)-(640, y * 30), _RGB32(255, 255, 0)
            text$ = LTrim$(Str$(counter))
            If counter Then _PrintString (x * 40 - 24 - (Len(text$)) * 4, y * 30 - 23), text$
            counter = counter + 1
        Next
    Next
    _Dest temp

    x = 1: y = 1
    _PutImage , temp, ws
    Do: Loop While _MouseInput 'clear the mouse input buffer
    oldmousex = _MouseX: oldmousey = _MouseY

    Do
        _Limit 60
        Do: Loop While _MouseInput
        If oldx <> _MouseX And oldy <> _MouseY Then
            x = _MouseX \ 40 + 1 'If mouse moved, where are we now?
            y = _MouseY \ 30 + 1
        End If
        oldx = _MouseX: oldy = _MouseY

        num = (y - 1) * 16 + x - 1
        If num = 0 Then
            text$ = ""
        Else
            flashcounter = flashcounter + 1
            If flashcounter > 30 Then
                Color _RGB32(255, 255, 255), _RGB(0, 0, 170)
                text$ = Chr$(num)
                If Len(text$) = 1 Then text$ = " " + text$ + " "
            Else
                Color _RGB32(255, 255, 255), _RGB(0, 0, 170)
                text$ = RTrim$(LTrim$(Str$(num)))
            End If
        End If
        If flashcounter = 60 Then flashcounter = 1
        Cls
        If toggle Then _PutImage , temp1, temp Else _PutImage , ws, temp
        _PrintString (x * 40 - 24 - (Len(text$)) * 4, y * 30 - 23), text$
        Line (x * 40 - 40, y * 30 - 30)-(x * 40, y * 30), _RGBA32(255, 255, 255, 150), BF

        k1 = _KeyHit
        MouseClick = 0: MouseExit = 0
        If MouseButtonSwapped Then
            MouseClick = _MouseButton(2): MouseExit = _MouseButton(1)
        Else
            MouseClick = _MouseButton(1): MouseExit = _MouseButton(2)
        End If
        Select Case k1
            Case 13: Exit Do
            Case 27
                GoTo cleanexit
            Case 32: toggle = Not toggle
            Case 18432: y = y - 1
            Case 19200: x = x - 1
            Case 20480: y = y + 1
            Case 19712: x = x + 1
        End Select

        If x < 1 Then x = 1
        If x > 16 Then x = 16
        If y < 1 Then y = 1
        If y > 16 Then y = 16
        _Display
        If MouseExit GoTo cleanexit
    Loop Until MouseClick

    ret% = (y - 1) * 16 + x - 1
    If ret% > 0 And ret% < 255 Then
        ASCIIbox$ = Chr$(ret%)
    End If
    cleanexit:
    _AutoDisplay

    Screen d
    _Font font
    _Dest 0: _Delay .2

End Function

Print this item

  Announcements
Posted by: Pete - 04-22-2022, 02:39 AM - Forum: TheBOB - No Replies

This thread is reserved for any upcoming announcements.

Print this item

  New General Discussion Subforums
Posted by: admin - 04-22-2022, 02:05 AM - Forum: General Discussion - Replies (13)

If you're signed in as a member of the forums here, you'll see that we have two new subforums there: NSFW (18+) and Freedom to Speak.

Both of these are completely off-topic and password protected forums.  In fact, they're hidden forums to boot, that only registered members can decide if they want to participate in them, or not.  One thing people always objected about with "off topic" discussions in the past was that "they don't look professional for a site" and blah, blah, blah...

To address those concerns, the forums are hidden from the general public by nature.  Folks have to go through the trouble to sign up and become a member of our boards to even know they exist.

Safeguard #2, these forums are each password protected.  If you're going out of your way to join a forum, read up and ask folks about a password to a subforum, and then decide to be offended at the contents of those forums after having to jump through such hoops...   /sigh   I guess I'll just be happy to offend you, as it's obvious you went out of your way in an attempt to get in that state.  

So what are these two forums??  And what features do they offer that others don't?  Why would any sane person bother with jumping through the hoops to get into them?

Both forums are dedicated to the idea of us being built around a community, and for folks to have a freedom to speak with each other.  One thing I always hated about the old forums, before they disappeared, was the Off-Topic forum being taken away.  There should be some place where people who share the same hobby -- in this case QB64 -- can come together and get to know and talk to each other as people and not just as programmers.  Why shouldn't the users be able to talk about politics, or sports, or religion, or their favorite TV shows?  As members of the same community, they already have at least one trait in common -- they like the BASIC language -- so why shouldn't they be allowed to talk and chat and explore if they share other interests as well??

I dunno!!  In my opinion, they should!

And thus, we have the two dreaded sub-forums that people either tend to love, or else they tend to hate.



NSFW (18+) is for people to talk about adult stuff.  As long as what you post in here isn't illegal, I don't care what you post.  Pictures of your infected toe nail turning green and falling off?  I don't care!  Want to trade nudes with Pete?  I don't care!  (/BLARF!!)  Want to talk about some NC-17 movie?  An erotica book you read?  I don't care!  And neither should anyone else who deliberately decides to force themselves inside a password protected forum.

If 18+ stuff isn't your cup of tea, simply don't go into that forum.  If people post something you object to -- and it's not illegal (like kiddy porn, for example) -- then just ignore it and move on to the next topic.  I'd say that we don't have any members who would post anything *THAT* bad in there, but then somebody would have to go and prove me wrong just for the shits of it.   

Dodgy



Freedom to Speak is a more friendly version of the NSFW channel.  Talk politics.  Religion.  Get into heated arguments with each other over whether C is better than COBOL...  Just try and keep the imagery and such suitable enough that the conversation doesn't end up getting moved into the 18+ forum.



Both forums are going to be VERY lightly moderated, with people free to post and say what they want in them.  Unless things get to the point that they're illegal (discussions about how to build a bomb and blow up the president, with step by step illustrated bomb making guides, for an example...), then I'm not going to step in and moderate people's freedom to speech.  Chat with each other.  Talk about each other's hobbies.  Get peeved and fight with each other.  That's what a community does -- particularly one that exercises its freedom of speech with each other.

And, if you've gotten this far in reading, and think you might be interested in joining in such talks, then let me ask you two last questions:

What do you have to be to view any sort of adult material?  "over 18"

What limits do we place upon free speech and the freedom to speak?  "none"

Print this item

  Fractal Explorer
Posted by: vince - 04-22-2022, 01:42 AM - Forum: Programs - Replies (3)

left click to zoom in
right click to zoom out
mouse wheel to change zoom window
'+' or '-' key to increase or decrease iterations

Code: (Select All)
defint a-z

const sw = 800
const sh = 600

dim shared pi as double
pi = 4*atn(1)

dim shared mx,my,mbl,mbr,mw

dim u as double, v as double
dim uu as double, vv as double
dim xx as double, yy as double
dim x0 as double, y0 as double
dim z as double, zz as double
dim c as single
z = 0.004
zz = 0.1
x0 = -0.5

dim p1 as long
p1 = _newimage(sw, sh, 32)
screen _newimage(sw, sh, 32)

redraw = -1
iter = 100

do
        mw = 0
        getmouse

        if redraw then
                for y = 0 to sh-1
                for x = 0 to sw-1
                        u = 0
                        v = 0

                        xx = (x - sw/2)*z + x0
                        yy = (y - sh/2)*z + y0

                        for i = 0 to iter
                                '''mandelbrot
                                uu = u*u - v*v + xx
                                vv = 2*u*v + yy
                                '''

                                '''burning ship
                                'u = abs(u)
                                'v = abs(v)
                                'uu = u*u - v*v + xx
                                'vv = 2*u*v + yy
                                '''

                                '''tricorn
                                'u = u
                                'v = -v
                                'uu = u*u - v*v + xx
                                'vv = 2*u*v + yy
                                '''

                                '''tetration
                                'u = u
                                'v = v
                                'cexp uu, vv, u, v, u, v
                                'cexp uu, vv, uu, vv, xx, yy
                                '''

                                u = uu
                                v = vv

                                if (u*u + v*v) > 4 then exit for
                        next
                        if i > iter then
                                pset(x, y), _rgb(0,0,0)
                        else
                                c = i/iter
                                r =  80 - 80*sin(2*pi*c - pi/2)
                                g = (114 + 114*sin(2*pi*c*1.5 - pi/2)) * -(c < 0.66)
                                b = (114 + 114*sin(2*pi*c*1.5 + pi/2)) * -(c > 0.33)

                                pset(x, y), _rgb(r, g, b)
                        end if
                next
                next

                'locate 1,1
                'print "iter =";iter
                _title str$(iter)

                _dest p1
                _putimage , 0
                _dest 0

                _putimage , p1
                _autodisplay

                redraw = 0
        end if

        if mw < 0 then
                zz = zz + 0.01
        elseif mw > 0 then
                if zz > 0.01 then zz = zz - 0.01
        end if

        'draw box
        if omx <> mx or omy <> my or mw <> 0 then
                _putimage , p1
                line (mx - (sw*zz/2), my - (sh*zz/2))-step(sw*zz,sh*zz),_rgb(255,255,255),b
                _autodisplay

                omx = mx
                omy = my
        end if

        if mbl then
                do
                        getmouse
                loop while mbl

                x0 = x0 + (mx - sw/2)*z
                y0 = y0 - (sh/2 - my)*z
                z = z*zz

                iter = iter + 100

                redraw = -1
        elseif mbr then
                do
                        getMouse
                loop while mbr

                x0 = x0 + (mx - sw/2)*z
                y0 = y0 - (sh/2 - my)*z
                z = z/zz

                iter = iter - 100

                redraw = -1
        end if

        k = _keyhit
        if k = 43 then
                iter = iter + 50
                redraw = -1
        elseif k = 45 then
                if iter > 50 then iter = iter - 50
                redraw = -1
        end if

loop until k = 27
system

sub getmouse ()
        do
                mx = _mousex
                my = _mousey
                mbl = _mousebutton(1)
                mbr = _mousebutton(2)
                mw = mw + _mousewheel
        loop while _mouseinput
end sub

Print this item

  USA Flag
Posted by: vince - 04-21-2022, 10:35 PM - Forum: Programs - Replies (7)

Waving and shaded 3D US flag.  Drawn according to official specification

Code: (Select All)
deflng a-z

sw = 640
sh = 480

dim shared pi as double
pi = 4*atn(1)

screen _newimage(sw*2, sh, 32)

h = 300
w = 1.9*h
a = h/7

img = _newimage(w, h, 32)
_dest img
x0 = 0
y0 = 0

line (0, 0)-step(w, h),_rgb(255,255,255),bf
for i=0 to 6
        line (0, i*h*2/13)-step(w, h/13),_rgb(255*0.698,255*0.132,255*0.203),bf
next
line (0, 0)-step(w*2/5, h*7/13),_rgb(255*0.234,255*0.233,255*0.430),bf

for i=0 to 4
for j=0 to 5
        starf (j*2 + 1)*w*2/(5*12), (i*2 + 1)*h*7/130, h*4/(13*5*2), _rgb(255,255,255)
next
next

for i=1 to 4
for j=1 to 5
        starf (j*2)*w*2/(5*12), (i*2)*h*7/130, h*4/(13*5*2), _rgb(255,255,255)
next
next

_dest 0
_putimage (sw/2 - w/2, sh/2 - h/2), img
_source img

x0 = sw/2 - w/2 + sw
y0 = sh/2 - h/2 '+ sh

dim t as double
dim z as double

dim xx as double, yy as double
dim dx as double, dy as double
do
        t = t + 0.2

        line (sw,0)-step(sw, sh),_rgb(0,0,0),bf

        for y=0 to h + a*0.707 step 1
        for x=0 to w + a*0.707 step 1
                z = (0.1 + 0.4*(x/w))*a*sin(x/35 - y/70 - t) + 0.5*a
                dz = 50*a*cos(x/35 - y/70 - t)/35

                xx = x + z*0.707 - a*0.707
                yy = y - z*0.707

                if (int(xx) >=0 and int(xx) < w - 1 and int(yy) >= 0 and int(yy) < h - 1) then
                        tl = point(int(xx), int(yy))
                        tr = point(int(xx) + 1, int(yy))
                        bl = point(int(xx), int(yy) + 1)
                        br = point(int(xx) + 1, int(yy) + 1)

                        dx = xx - int(xx)
                        dy = yy - int(yy)

                        r =_round((1 - dy)*((1 - dx)*  _red(tl) + dx*  _red(tr)) + dy*((1 - dx)*  _red(bl) + dx*  _red(br)))
                        g = _round((1 - dy)*((1 - dx)*_green(tl) + dx*_green(tr)) + dy*((1 - dx)*_green(bl) + dx*_green(br)))
                        b = _round((1 - dy)*((1 - dx)* _blue(tl) + dx* _blue(tr)) + dy*((1 - dx)* _blue(bl) + dx* _blue(br)))

                        r = r + dz
                        g = g + dz
                        b = b + dz

                        if r<0 then r = 0
                        if r>255 then r = 255
                        if g<0 then g = 0
                        if g>255 then g = 255
                        if b<0 then b = 0
                        if b>255 then b = 255

                        pset (x0 + x, y0 - a*0.707 + y), _rgb(r,g,b)
                end if
        next
        next

        _display
        _limit 50
loop until _keyhit = 27

sleep
system

sub starf(x, y, r, c)
        pset (x + r*cos(pi/2), y - r*sin(pi/2)),c
        for i = 0 to 5
                xx = r*cos(i*4*pi/5 + pi/2)
                yy = r*sin(i*4*pi/5 + pi/2)
                line -(x + xx, y - yy),c
        next
        paint (x, y),c
        for i = 0 to 5
                xx = r*cos(i*4*pi/5 + pi/2)/2
                yy = r*sin(i*4*pi/5 + pi/2)/2
                paint (x + xx, y - yy),c
        next
end sub

Print this item

  Crop Circles 3 mod 2 Blender
Posted by: bplus - 04-21-2022, 02:33 PM - Forum: Programs - Replies (7)

Dedicated to all farmers who code with Basic ;-))

Code: (Select All)
_Title "Crop Circles #3 Mod 2 Blender" 'b+ trans and mod to QB64 2021-01-25
Randomize Timer

Const Xmax = 1024, Ymax = 730, Cx = Xmax / 2, Cy = Ymax / 2, nCrops = 4
ReDim Shared CCircle As Long
Screen _NewImage(Xmax, Ymax, 32)
_Delay .25
_ScreenMove _Middle
ReDim Shared LowColr As _Unsigned Long, HighColr As _Unsigned Long, cNum As Long
HighColr = _RGB32(240, 220, 80): LowColr = _RGB32(100, 50, 10)
crop0
Do
    _PutImage , CCircle, 0
    While _MouseInput: Wend 'aim with mouse
    mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
    drawShip mx, my, LowColr
    If mb Then
        PLC mx, my, Cx, Cy, 360
        _Display
        _Delay .2
        FlagChange = -1
    End If
    If FlagChange Then
        If Rnd < .5 Then
            crop3
        Else
            cNum = (cNum + 1) Mod nCrops
            Select Case cNum
                Case 0: crop0
                Case 1: crop1
                Case 2: crop2
                Case 3: crop3
            End Select
        End If
        FlagChange = 0
    End If
    _Display
Loop Until _KeyDown(27)

'crop0 uses this
Sub drawc (mx, my)
    ReDim cc As _Unsigned Long
    cr = .5 * Sqr((Cx - mx) ^ 2 + (Cy - my) ^ 2): m = .5 * cr
    dx = (mx - Cx) / m: dy = (my - Cy) / m: dr = cr / m
    For i = m To 0 Step -1
        If i Mod 2 = 0 Then cc = HighColr Else cc = LowColr
        x = Cx + dx * (m - i): y = Cy + dy * (m - i): r = dr * i
        fcirc x, y, r, cc
    Next
End Sub

Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
    Dim Radius As Long, RadiusError As Long
    Dim X As Long, Y As Long
    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
    If Radius = 0 Then PSet (CX, CY), C: Exit Sub
    Line (CX - X, CY)-(CX + X, CY), C, BF
    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    Wend
End Sub

Sub PLC (baseX, baseY, targetX, targetY, targetR) ' PLC for PlasmaLaserCannon
    r = Rnd ^ 2 * Rnd: g = Rnd ^ 2 * Rnd: b = Rnd ^ 2 * Rnd: hp = _Pi(.5) ' red, green, blue, half pi
    ta = _Atan2(targetY - baseY, targetX - baseX) ' angle of target to cannon base
    dist = _Hypot(targetY - baseY, targetX - baseX) ' distance cannon to target
    dr = targetR / dist
    For r = 0 To dist Step .25
        x = baseX + r * Cos(ta)
        y = baseY + r * Sin(ta)
        c = c + .3
        fcirc x, y, dr * r, _RGB32(128 + 127 * Sin(r * c), 128 + 127 * Sin(g * c), 128 + 127 * Sin(b * c))
    Next
    For rr = dr * r To 0 Step -.5
        c = c + 1
        LowColr = _RGB32(128 + 127 * Sin(r * c), 128 + 127 * Sin(g * c), 128 + 127 * Sin(b * c))
        fcirc x, y, rr, LowColr
    Next
    cAnalysis LowColr, rr, gg, bb, aa
    HighColr = _RGB32(255 - rr, 255 - gg, 255 - bb)
End Sub

' PLC uses this
Sub cAnalysis (c As _Unsigned Long, outRed, outGrn, outBlu, outAlp)
    outRed = _Red32(c): outGrn = _Green32(c): outBlu = _Blue32(c): outAlp = _Alpha32(c)
End Sub

Sub drawShip (x, y, colr As _Unsigned Long) 'shipType     collisions same as circle x, y radius = 30
    Static ls
    Dim light As Long, r As Long, g As Long, b As Long
    r = _Red32(colr): g = _Green32(colr): b = _Blue32(colr)
    fellipse x, y, 6, 15, _RGB32(r, g - 120, b - 100)
    fellipse x, y, 18, 11, _RGB32(r, g - 60, b - 50)
    fellipse x, y, 30, 7, _RGB32(r, g, b)
    For light = 0 To 5
        fcirc x - 30 + 11 * light + ls, y, 1, _RGB32(ls * 50, ls * 50, ls * 50)
    Next
    ls = ls + 1
    If ls > 5 Then ls = 0
End Sub

' drawShip needs
Sub fellipse (CX As Long, CY As Long, xr As Long, yr As Long, C As _Unsigned Long)
    If xr = 0 Or yr = 0 Then Exit Sub
    Dim h2 As _Integer64, w2 As _Integer64, h2w2 As _Integer64
    Dim x As Long, y As Long
    w2 = xr * xr: h2 = yr * yr: h2w2 = h2 * w2
    Line (CX - xr, CY)-(CX + xr, CY), C, BF
    Do While y < yr
        y = y + 1
        x = Sqr((h2w2 - y * y * w2) \ h2)
        Line (CX - x, CY + y)-(CX + x, CY + y), C, BF
        Line (CX - x, CY - y)-(CX + x, CY - y), C, BF
    Loop
End Sub

Function rand (low, high)
    rand = Rnd * (high - low) + low
End Function


Sub crop0
    If CCircle Then _FreeImage CCircle
    CCircle = _NewImage(_Width, _Height, 32)
    _Dest CCircle
    Color , HighColr
    Cls
    n = 12: stp = -40
    For br = 360 To 0 Step stp
        shft = shft + 720 / (n * n)
        For i = 1 To n
            x = Cx + br * Cos(_D2R(i * 360 / n + shft))
            y = Cy + br * Sin(_D2R(i * 360 / n + shft))
            drawc x, y
        Next
    Next
    _Dest 0
End Sub

Sub crop1
    If CCircle Then _FreeImage CCircle
    CCircle = _NewImage(_Width, _Height, 32)
    _Dest CCircle
    Color , HighColr
    Cls
    ga = 137.5: bn = 800
    br = 9.5: lr = .5: r = br: dr = (br - lr) / bn
    hc = 180: lc = 120: cr = (hc - lc) / bn
    For n = 1 To bn
        x = Cx + 10 * Sqr(n) * Cos(_D2R(n * ga))
        y = Cy + 10 * Sqr(n) * Sin(_D2R(n * ga))
        r = r - dr
        fcirc x, y, r, LowColr
    Next
    _Dest 0
End Sub

Sub crop2
    If CCircle Then _FreeImage CCircle
    CCircle = _NewImage(_Width, _Height, 32)
    _Dest CCircle
    'this needs big constrast of color
    HighColr = _RGB32(Rnd * 80, Rnd * 80, Rnd * 80) ' field
    LowColr = _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
    Color , HighColr
    Cls
    For i = 45 To Xmax Step 50
        Line (i, 0)-(i + 10, Ymax), LowColr, BF
        Line (0, i)-(Xmax, i + 10), LowColr, BF
    Next
    For y = 50 To 650 Step 50
        For x = 50 To Xmax Step 50
            fcirc x, y, 10, LowColr
        Next
    Next
    _Dest 0
End Sub

Sub crop3
    If CCircle Then _FreeImage CCircle
    CCircle = _NewImage(_Width, _Height, 32)
    _Dest CCircle
    Color , HighColr
    Cls

    r0 = rand(1, 5) / 5: r1 = rand(1, 5) / 10: r2 = rand(1, 5) / 10
    fc = rand(1, 200) / 10: st = rand(10, 500) / 1000
    xol = 0
    yol = 0
    mol = 0
    For i = 0 To 120 Step st
        a0 = (i / r0) * (2 * _Pi)
        a1 = ((i / r1) * (2 * _Pi)) * -1
        x1 = Cx + (Sin(a0) * ((r0 - r1) * fc)) * 30
        y1 = Cy + (Cos(a0) * ((r0 - r1) * fc)) * 30
        x2 = x1 + (Sin(a1) * ((r2) * fc)) * 30
        y2 = y1 + (Cos(a1) * ((r2) * fc)) * 30
        If mol = 0 Then
            mol = 1
            xol = x2
            yol = y2
        Else
            Line (xol, yol)-(x2, y2), LowColr
            xol = x2
            yol = y2
        End If
    Next


    _Dest 0
End Sub

[Image: Crop-Circles-3-Mod-2-Blender.png]

Print this item

  Reaction Diffusion
Posted by: justsomeguy - 04-21-2022, 02:07 PM - Forum: Utilities - Replies (1)

I found this cool little program written by the guy from "The Coding Train", so I ported it to QB64. He has a lot of cool stuff on his channel and I've learned a lot from his videos.

Code: (Select All)
' Program based off of "The Coding Train" Video
' "Coding Challenge #13: Reaction Diffusion Algorithm in p5.js"
' https://www.youtube.com/watch?v=BV9ny785UNc
' Ported to QB64 by justsomeguy

OPTION _EXPLICIT

CONST cSIZEX = 100
CONST cSIZEY = 100
CONST cZOOM = 8

'Some base values to start off with
'dA = 1
'dB = .5
'feed = .055 , white border .45 . no border .65
'k = .062


CONST cREACTDIFF_dA = 1
CONST cREACTDIFF_dB = 0.45
CONST cREACTDIFF_feed = 0.055
CONST cREACTDIFF_k = .062

CONST cRESTARTTIME = 45 ' Timer to restart simulation

TYPE tCELL
  a AS SINGLE
  b AS SINGLE
END TYPE

DIM grid(cSIZEX, cSIZEY) AS tCELL
DIM nextGrid(cSIZEX, cSIZEY) AS tCELL
DIM tmr AS LONG


RANDOMIZE TIMER
_TITLE "Reaction Diffusion"
SCREEN _NEWIMAGE(cSIZEX * cZOOM, cSIZEY * cZOOM, 32)
reactDiffSetup grid(), nextGrid()
tmr = TIMER

DO
  reactDiff grid(), nextGrid()
  reactDiffRender grid(), nextGrid()

  IF TIMER - tmr > cRESTARTTIME THEN
    tmr = TIMER
    reactDiffSetup grid(), nextGrid()
  END IF

  _DISPLAY
  _LIMIT 250
LOOP UNTIL _KEYHIT = 27
SYSTEM

SUB reactDiff (grid() AS tCELL, nextGrid() AS tCELL)
  DIM AS INTEGER x, y
  DIM AS SINGLE a, b
  FOR x = 1 TO cSIZEX - 1
    FOR y = 1 TO cSIZEY - 1
      a = grid(x, y).a
      b = grid(x, y).b
      nextGrid(x, y).a = a + cREACTDIFF_dA * reactDiffLaplaceA##(grid(), x, y) - a * b * b + cREACTDIFF_feed * (1 - a)
      nextGrid(x, y).b = b + cREACTDIFF_dB * reactDiffLaplaceB##(grid(), x, y) + a * b * b - (cREACTDIFF_k + cREACTDIFF_feed) * b
      nextGrid(x, y).a = constrain(nextGrid(x, y).a, 0, 1)
      nextGrid(x, y).b = constrain(nextGrid(x, y).b, 0, 1)
    NEXT
  NEXT
END SUB

SUB reactDiffRender (grid() AS tCELL, nextgrid() AS tCELL)
  DIM AS INTEGER i, j
  DIM AS SINGLE a, b, c
  FOR i = 0 TO cSIZEX
    FOR j = 0 TO cSIZEY
      a = grid(i, j).a
      b = grid(i, j).b
      c = INT((a - b) * 255)
      c = constrain(c, 0, 255)
      ' IF c > 127 THEN c = 255 ELSE c = 0
      LINE (i * cZOOM, j * cZOOM)-(i * cZOOM + cZOOM, j * cZOOM + cZOOM), _RGB32(c, c, c), BF
    NEXT
  NEXT
  reactDiffSwap grid(), nextgrid()
END SUB

SUB reactDiffSetup (grid() AS tCELL, nextGrid() AS tCELL)
  DIM AS INTEGER i, j, iter, iterCount, rsx, rsy, rszx, rszy
  ' Reset Map to all chemical A
  FOR i = 0 TO cSIZEX
    FOR j = 0 TO cSIZEY
      grid(i, j).a = 1
      grid(i, j).b = 0
      nextGrid(i, j).a = 1
      nextGrid(i, j).b = 0
    NEXT
  NEXT
  iterCount = INT(RND * 20) + 10
  FOR iter = 1 TO iterCount
    'Make a random blob a chemical B
    rsx = RND * (cSIZEX * .50) + (cSIZEX * .25)
    rsy = RND * (cSIZEY * .50) + (cSIZEY * .25)
    rszx = RND * (cSIZEX * .10)
    rszy = RND * (cSIZEY * .10)

    FOR i = rsx TO rsx + rszx
      FOR j = rsy TO rsy + rszy
        grid(i, j).b = 1
      NEXT
    NEXT
  NEXT
END SUB

FUNCTION reactDiffLaplaceA## (grid() AS tCELL, x AS INTEGER, y AS INTEGER)
  DIM AS SINGLE sumA: sumA = 0
  sumA = sumA + grid(x, y).a * -1
  sumA = sumA + grid(x - 1, y).a * 0.2
  sumA = sumA + grid(x + 1, y).a * 0.2
  sumA = sumA + grid(x, y + 1).a * 0.2
  sumA = sumA + grid(x, y - 1).a * 0.2
  sumA = sumA + grid(x - 1, y - 1).a * 0.05
  sumA = sumA + grid(x + 1, y - 1).a * 0.05
  sumA = sumA + grid(x + 1, y + 1).a * 0.05
  sumA = sumA + grid(x - 1, y + 1).a * 0.05
  reactDiffLaplaceA## = sumA
END FUNCTION

FUNCTION reactDiffLaplaceB## (grid() AS tCELL, x AS INTEGER, y AS INTEGER)
  DIM AS SINGLE sumB: sumB = 0
  sumB = sumB + grid(x, y).b * -1
  sumB = sumB + grid(x - 1, y).b * 0.2
  sumB = sumB + grid(x + 1, y).b * 0.2
  sumB = sumB + grid(x, y + 1).b * 0.2
  sumB = sumB + grid(x, y - 1).b * 0.2
  sumB = sumB + grid(x - 1, y - 1).b * 0.05
  sumB = sumB + grid(x + 1, y - 1).b * 0.05
  sumB = sumB + grid(x + 1, y + 1).b * 0.05
  sumB = sumB + grid(x - 1, y + 1).b * 0.05
  reactDiffLaplaceB## = sumB
END FUNCTION

SUB reactDiffSwap (grid() AS tCELL, nextGrid() AS tCELL)
  DIM AS INTEGER i, j
  FOR i = 0 TO cSIZEX
    FOR j = 0 TO cSIZEY
      SWAP grid(i, j), nextGrid(i, j)
    NEXT
  NEXT
END SUB

FUNCTION constrain (n AS SINGLE, low AS SINGLE, high AS SINGLE)
  DIM o AS SINGLE
  o = n
  IF o < low THEN o = low
  IF o > high THEN o = high
  constrain = o
END FUNCTION


Coding Challenge #13: Reaction Diffusion Algorithm in p5.js

[Image: screenshot.png]

Print this item

  So what happened??
Posted by: admin - 04-21-2022, 11:16 AM - Forum: General Discussion - Replies (25)

Seems like that's the question that everyone has been asking here lately -- "What the heck happened to the old forums?  Why did everything disappear on us?"

I've been a little busy setting up the new forums and migrating the wiki over for us, bot now that those things are more or less complete, I wanted to take time to do into details and try and explain what's happened over the last week or so, so everyone can understand how we got to be where we currently are.

Things first started to change back in QB64 World back sometime in January.  Fellippe suddenly made an announcement to the community that someone new was popping up in the community and taking over as CEO for the project.  An unexpected move -- why the heck did a hobbyist language need a CEO to manage things, anyway?? -- but one which ultimately changed almost nothing at the time.  RC Cola was introduced to the project, he barely spoke to anyone or got involved with anything, and life moved on with him just more or less existing in the background.

***********************

Time flows, as time will, and suddenly we find ourselves at around a week ago.  Fellippe suddenly decides to just pack up and walk away from the project.  He goes from being a member of the forums to just becoming a "guest".  The Inform channels in the Discord are closed.  He makes no real announcement about anything, and just walks.  People who reach out to him via personal messages and such, get told that he's "Left the project for good and won't be back, for his mental health."  Fellippe did a lot of different things, and he put up with a lot, and it seemed like he'd more or less hit his breaking point and just said waltzed off into the sunset like any good Old Western hero would.

This left RC Cola as suddenly holding the reigns to the project.  At that point, much like at the point where we're at now, people became a little nervous about the state of the project.  RC Cola was asked, "What's the future of QB64?  What do you think QB64 is??"   His response to anything like that was more elusive than a politician two days before election day -- "I'm not going to get into that.  I'm not going to say..."

He's not going to answer any questions about the plans for the project?  Not even going to try and say what he thinks the project is about??

And then, someone brought up the rules of conduct which we were all operating under -- and if you guys are like me, you didn't have a single clue about them!!


[Image: Rules.jpg]

post image


Now, if you guys notice there's a line in there right above the page break that REALLY bothered me.  "Any media uploaded to QB64 sites, are the property of the QB64 Project."

For me, that meant that if I kept working on my little QB64 Bible, and sharing it for the members of the forums to make use, comment, and help point out things that might need editing, that once it was finished, I wouldn't be able to sell a hard copy of it anywhere!!  After all, the QB64 Team would OWN my work!!  If I did publish it, they could sue me for stealing THEIR property!!

And *this* glaring problem was brought up to RC Cola.  His response was just as lackluster as when asked about his plans for QB64.  His response was, "It's better for us to have too much control over stuff posted, than not having enough."

He didn't think that type of rule was over the top at all!!

So, at this point, people *really* started to complain and act up in the Discord channel.  You could almost taste the displeasure in the air, the feeling was so palpable.  Folks were getting quite upset at everything that was going down and was being said.

Rather than try and diffuse the situation, RC Cola decided to drop the mighty Hammer of Justice on people.  Folks were getting silenced for almost nothing in the Discord channel.  People were being banned from Discord.  At this point, one could almost take bets on who was going to be the next person to get kicked from the Discord channels. 

It was at this point that RC decided he was basically the one true ruler of QB64 World:


[Image: Dictator.png]


It was also around this same time when I found myself in RC Cola's crosshairs.  
 

Quote:RCcola198704/15/2022

@SMcNeill you have done a lot for the project and this is the only reason i didnt just ban you right now. Neo Nazi content is not allowed ANYWAEAR on this discords nor is it allowed on discord as a whole. I fyou remove the posts and stop this i will not ban. most of my family died fighting againt Hitler in ww2 and i will not stand for that. most things i will let slide in teh off topic but this is just astounding and not expected from someone like you. 


He... didn't??  Did he??  Just called me a Neo-Nazi supporter and threatened to ban me??  Needless to say, I wasn't very happy...  And the conversation we had after that made me even less happy.

Quote:
  1. RC... You know what... I've tried being a nice guy and ignore all the crap that's been going on, but I just can't do it anymore. At no point have I shared any neo-nazi content, nor do I stand for anything Nazi related. I'm certain I can hop in the car and head to the cemetery and point to just as many graves from my family who fought against the war, as you ever could. From our last genealogical study (my father was an amateur genealogist), we can count 106 members who died in WWI and WWI from both my mother's and father's side. All I posted was links to a lyrics.com collection of SONG LYRICS... in a topic which was tagged "off-topic" and flagged NSFW. There's nothing objectionable about what I posted, but what [b]IS[/b] objectionable is you thinking you're some sort of second rate dictator for the project just because Fellippe left.\
  2. [7:56 PM]
    Here, let me play dictator for a while: [b]I was the [i]only[/i] person who Galleon ever officially welcomed into the QB64 Team, before he stepped down.[/b] My code contributions to the project go all the way to version 0.5 or so, and were in the code well before Fellippe or anyone else branched off Galleon's github account and started pushing their own version of QB64. At no point have I ever given up on my intellectual property rights for the code which I added into the project. Galleon had NO license on QB64 back in the day, and the code anyone committed to the project always retained the property of the coder. Fellippe and them may have pushed to add a MIT license to [i]their[/i] github and QB64 project, but I never gave up the rights to my intellectual property.
    So here's my little asshole dictator demand: Take ALL my work out of the repo. I no longer feel that the project as it exists supports the spirit of BASIC with which I wrote my code and inserted itself into the project, and I refuse to give any rights to keep my code active and inside the source any longer. Failure to remove all my contributions from the language will result in my pursuing legal recourses against copyright infringement.


If the man is going to be an asshole and kick me from what I've always considered to be part of my home, then to hell with him!  If I'm not welcome, then I don't feel like any of my code should be welcomed either.  I'll damn leave, start over somewhere else, and he can do whatever the shit he wants without anything from me being involved with whatever his project was becoming.  It certainly wasn't the QB64 project which I'd grown up and loved working with a being a part of the community with, for all these many years!!

His response??


[Image: Kicked.png]
Yep!  I get kicked from the QB64 Team, and silenced from the Discord.

Which leads me to getting irked and going to bed not long after that...  Needless to say, I said more than a few BLEEPING BLEEPS before I drifted off to sleep that night..

When I woke up, I logged into Discord completely uncertain what the heck to do next, and I find this little gem in my personal message box:


[Image: Transfer.png]


Yep!  Apparently things had continued on during the night while I was sleeping, and in the end, our other developer -- flukiluke -- had decided that he'd had enough of all the drama.  He'd transferred the Discord which he'd owned over to me, and then walked away.  Honestly, it was kind of fitting in a way:  The last post that was ever posted over at QB64.rip was luke's Goodbye post.  

RC Cola, is apparently a very spiteful man.  Once he realized that he could no longer control the Discord, since Luke had passed ownership of the channel over to me, he....

...simply went nuts, is about the only way I know to describe things.


[Image: Tantrum.jpg]

First he kicks out all the editors of the wiki -- even people who don't even have Discord accounts, and who weren't caught up in the internal bruhaha at all!


Then the next thing you know, the forums are down.  The wiki is completely down.  Youtube videos are gone.  The password for the Twitter account is changed.  Everything is taken down and destroyed, with the exception of one thing in particular:  QB64 Team is creating QB64 at QB64.org | Patreon

Yep!! That's right!  He kept the Patreon up so he could keep collecting money from all the people donating to the QB64 team!

After all, that's all that RC Cola was after, when all is said and done.  He wanted money.  Money!  $$$$$$!!


[Image: Money.png]

According to him, the team only pulled in $400 a year or so, and they were going to have to raise Patreon teirs soon to start bringing in more money!!  

And yet, even though I'm not the best person in the world with math, I can click on the link above and go to the QB64 Patreon site even now -- even after all that's happened, he's never taken the Patreon down!!  There's *still* 24 subscribers, at the moment of this writing, and each is donating $2 per month.  That's about $50 per month total, and in 12 months, that's over $600 which people are donating into the project.  (Not counting individual, one-time donations, which people give, nor is it counting the sales which the QB64 team has with whatever merchandise they offered like the coffee cups.)

To give an illustration of costs, here's what it cost for me to set up the forums and the wiki here, and to register the domain name which I've chosen:

[Image: Costs.png]


Less than $100 for a year, and the server here has "unlimited bandwidth" and "unlimited storage".

And yet, he needed to pilfer more money from the user base here, so he could keep things running??



RC Cola might not be able to say what he thinks QB64 is, but I'll happily tell you guys what I think it is:

QB64 is a community of like minded individuals who enjoy writing and coding in BASIC.  Many of us grew up using the language in our youth, and most of us are stubborn, nostalgic "old skoolers".  We know the rest of the world has moved on and embraced other various languages and coding styles over the years, but we like where we're at!  QB64 -- and BASIC, in general -- is a community that is our home.  We've got roots here.  We've lived here.  We've laughed here.  More than once, several of us have butted heads and fought here.

BUT...  At the end of the day, QB64 is the spirit of companionship which we all hold with each other!!  Our forums are secondary.  Discord is a baby come lately.  The majority of folks around here either have memories of IRC, or else they wish they did!  

RC Cola might get rid of a few videos.  We might lose a few posts.  The forums might go down.  The wiki might end up losing a few months of updates... 

At the end of the day, WHO GIVES A SHIT?!!

We're still here.  We're still a community.  If one home burns down, we'll simply form another.  We're family...

...and that's what RC Cola couldn't understand.  He simply couldn't look past the $$$ to truly understand who we are, or what we stand for.  The moment he started relentlessly kicking people and destroying the community, was the moment when he truly lost control of QB64.

**************************************************
**************************************************

And, with all of that said and done, let me finish up by saying:

WELCOME HOME, ONE AND ALL!!!

Print this item

  Running QB64 on a Raspberry PI (And known issues)
Posted by: George McGinn - 04-21-2022, 01:34 AM - Forum: General Discussion - Replies (9)

To run QB64 on a Raspberry PI, you need to do a few things to QB64 in order to compile and run programs.

Also, right now, QB64 will only run on a 32-bit running on the RPI. I haven't yet gotten it to work on 64-bit OS's. I am still researching if this is possible. It just might be a PI ARM issue. I am experimenting with settings in the ARM chip itself and GCC/G++ compiler options from the ARM technical documents I've obtained from the IEEE. Very few in my local chapter have had experience in the ARM, and none with QB64.

However, there are a few issues that are part of the PI's ARM processor that cannot be easily fixed in QB64.

Most programs will compile and run fine. Others will get one or both of the following issues:

1) Racing Conditions (can appear as SIG BUS errors)
2) Misaligned Addresses, or misaligned word errors (appears as SIG BUS errors)

For the most part, identifying where the racing condition is occuring (you will need to do a gdb session to find out), a simple _DELAY .3 will fix it. Racing occurs when QB64 creates multiple threads, and since QB64 isn't really a multithreaded programming language (the backend C++ is), there can be issues.

There are two ways to fix the misaligned address/word issue. One way is to use the -fsanatize compiler option. However, the better fix for most of these issues has been added to the common.h file provided. The code that fixes this and other non-x86 issues is:

Code: (Select All)
//Setup for ARM Processor (Similar to -fsanitize=address GCC compiler flag)
#ifdef __arm__
    #define QB64_NOT_X86
#define POST_PACKED_STRUCTURE
#else
#define POST_PACKED_STRUCTURE __attribute__((__packed__))
#endif /* ARM */

I've included the #define for the non-ARM processors. It doesn't hurt, and on the slim occasion you run into this error, that code will fix it.

The misaligned address, or misaligned word error (SIG BUS), is a hardware issue in the ARM processor. The reason this does not occur on the x86_64 chips is the manufacturers of these chips fixed this issue within its circuitry. If you were to get this error on an x86, it will be a really really bad day for you.

Code, like the following used in the program supplied, is giving the PI ARM processor fits:

Code: (Select All)
TYPE tENTITY
    objectID AS LONG
    objectType AS LONG
    parameters AS tENTITYPARAMETERS
    pathString AS STRING * 1024 ' for A* Path 'U'-Up 'D'-Down 'L'-Left 'R'-Right
    fsmPrimary AS tFSM
    fsmSecondary AS tFSM
END TYPE


It just can't handle these.

One of the ways to fix this on the PI ARM is to rewrite the backend of QB64. This is not practical.

In the enclosed compressed file, I included an example of a program that has both conditions - racing and misaligned addresses.

One of the things I plan to do late summer is to get my hands on an Apple M1 ARM laptop, and test this out. This is important, as Apple plans to roll this out to their other products. Also, INTEL is close to finishing their ARM processor, and last October (2021), Microsoft and AMD announced a joint venture to develop their own ARM processor. God only knows what, if any, standards any of these chips will follow. The ability to run QB64 on these systems, although my sources say they are at least 5 years away, means we need to take a headstart in determining, if any, changes need to be made to QB64 itself.

I am hoping that it will be mostly parameters added to the GCC compiler, and that the chips will follow some of the X86 fixes.

To install QB64 on the PI:

1. Extract QB64 but do not run the install.
2. From the compressed file, copy/replace the common.h file in the /internal/c directory.
3. Replace the setup_lnx.sh script in the qb64 folder with the one from the compressed file.

Note: I have provided the makedat files, just to show you what changes were needed here. Without these changes, your binary executables will get ASAN errors, or malformed binary files. (This is the issue with running QB64 on the 64-bit OS. I have a question in to PI support, and am trying to find out from GNU if there are other things I need to do.

I have run 12 openGL programs with no issues. My EBACCalculator runs fine. I even ran my baseball/softball statistics system, that incorporates mySQL (on the PI they use mariaDB), Zenity, HTML/CSS, and multiple shell calls to programs and use of pipecom with memory allocations, call to C++ functions from header files, runs with no issues.

Right now, it mostly works. If you use UDT types, it may compile, but will not run.


Here are the files.



.zip   qb64RPI.zip (Size: 64.83 KB / Downloads: 82)

George

Print this item