Welcome, Guest |
You have to register before you can post on our site.
|
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
|
|
|
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.
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
|
|
|
Announcements |
Posted by: Pete - 04-22-2022, 02:39 AM - Forum: TheBOB
- No Replies
|
|
This thread is reserved for any upcoming announcements.
|
|
|
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.
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"
|
|
|
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
|
|
|
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
|
|
|
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
|
|
|
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
|
|
|
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!!
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:
It was also around this same time when I found myself in RC Cola's crosshairs.
Quote:RCcola1987 — 04/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:
- 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.\
[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??
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:
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.
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! $$$$$$!!
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:
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!!!
|
|
|
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.
qb64RPI.zip (Size: 64.83 KB / Downloads: 82)
George
|
|
|
|