Has anyone else noticed this using FireFox or even another browser:
Often times I'll leave Firefox run for weeks at a time. Every now and then I'll get up in the morning to notice Task Manager showing FireFox using over 4GB of RAM and climbing.
I've narrowed this down to this site. To verify this I let FireFox run with this site as its only tab (I used another browser to do other things, yuck). For the past few months I have been tracking the issue using this method. With only this site loaded I'll get a run away memory issue in FireFox within a few days. I can let FireFox run for weeks with many tabs open and no memory issue. As soon as I open this site I'm guaranteed to have a run away memory issue within a day or two.
I came up with something rather silly and visual to enjoy. I used pretty much these computations to come up with the "jaggies personalities" earlier. Press the arrow keys to pan around in the view. Press escape to quit this program.
Originally this program was in SCREEN 0 but I desired higher resolution and 32-bit color.
Code: (Select All)
'by mnrvovrfc 15-May-2023
OPTION _EXPLICIT
TYPE being
AS SINGLE x, y, a1, c1, f1, s1, m1, n1, a2, c2, f2, s2, m2, n2, a3, c3, m3
AS INTEGER xn, yn
END TYPE
'a1 = angle (to convert to radians); c1 = coefficient; f1 = equation variety; s2 = added angle always sin
'm1 = increase a1; n1 = increase s1
'this is for first "wing" only, second "wing" doesn't have "f2"
'xn, yn = nudge; c = color; a3, m3 = outer "wing" angle
CONST NUMB = 100, VSLIM = 300
DIM SHARED vs(-VSLIM TO VSLIM, -VSLIM TO VSLIM)
DIM SHARED b(1 TO NUMB) AS being
DIM SHARED AS INTEGER xpan, ypan, rr, gg, bb
DIM AS INTEGER i, j
DIM upd AS _BYTE
DIM SHARED colr(1 TO NUMB) AS LONG
SCREEN _NEWIMAGE(960, 488, 32)
_DELAY 0.5
_TITLE "Press [ESC] to quit. Arrow keys to pan the view."
_FONT 8
xpan = 0
ypan = 0
RANDOMIZE TIMER
FOR i = 1 TO NUMB
rr = (Rand(48, 191) \ 8) * 8
gg = (Rand(80, 223) \ 8) * 8
bb = (Rand(112, 255) \ 8) * 8
IF Random1(2) = 1 THEN SWAP rr, gg
IF Random1(2) = 1 THEN SWAP bb, gg
IF Random1(2) = 1 THEN SWAP rr, bb
colr(i) = _RGB(rr, gg, bb)
NEXT
upd = 1
DO
_LIMIT 60
FOR i = 1 TO NUMB
changebeing i
NEXT
IF _KEYDOWN(18432) THEN
ypan = ypan + 1
upd = 1
ELSEIF _KEYDOWN(20480) THEN
ypan = ypan - 1
upd = 1
END IF
IF _KEYDOWN(19200) THEN
xpan = xpan + 1
upd = 1
ELSEIF _KEYDOWN(19712) THEN
xpan = xpan - 1
upd = 1
END IF
update upd
IF upd = 1 THEN upd = 0
LOOP UNTIL _KEYDOWN(27)
SYSTEM
SUB update (uf AS _BYTE)
STATIC AS INTEGER xrig, ybot, i, j, xx, yy
STATIC ufo AS _BYTE
ufo = 1
IF xpan < -VSLIM THEN xpan = -VSLIM: ufo = 0
xrig = xpan + 239
IF xrig > VSLIM THEN
xpan = xpan - 1
xrig = xpan + 239
ufo = 0
END IF
IF ypan < -VSLIM THEN ypan = -VSLIM: ufo = 0
ybot = ypan + 119
IF ybot > VSLIM THEN
ypan = ypan - 1
ybot = ypan + 119
ufo = 0
END IF
IF uf AND ufo THEN CLS
_PRINTSTRING (0, 480), "|" + STR$(xpan) + "|" + STR$(ypan)
yy = 0
FOR j = ypan TO ybot
xx = 0
FOR i = xpan TO xrig
IF vs(j, i) THEN
LINE (xx, yy)-STEP(3, 3), colr(vs(j, i)), BF
END IF
xx = xx + 4
NEXT
yy = yy + 4
NEXT
END SUB
SUB changebeing (w AS INTEGER)
STATIC AS LONG x, y
b(w).a1 = b(w).a1 + b(w).m1
b(w).s1 = b(w).s1 + b(w).n1
IF b(w).a1 > 360 THEN b(w).a1 = b(w).a1 - 360
IF b(w).s1 > 360 THEN b(w).s1 = b(w).s1 - 360
b(w).a2 = b(w).a2 + b(w).m2
b(w).s2 = b(w).s2 + b(w).n2
IF b(w).a2 > 360 THEN b(w).a2 = b(w).a2 - 360
IF b(w).s2 > 360 THEN b(w).s2 = b(w).s2 - 360
b(w).a3 = b(w).a3 + b(w).m3
IF b(w).a3 > 360 THEN b(w).a3 = b(w).a3 - 360
SELECT CASE b(w).f1
CASE 1
b(w).x = b(w).c1 * (SIN(_D2R(b(w).a1)) + SIN(_D2R(b(w).s1))) + b(w).c3 * SIN(_D2R(b(w).a3))
b(w).y = b(w).c2 * (SIN(_D2R(b(w).a2)) + SIN(_D2R(b(w).s2)))
CASE 2
b(w).x = b(w).c1 * (COS(_D2R(b(w).a1)) + SIN(_D2R(b(w).s1))) + b(w).c3 * SIN(_D2R(b(w).a3))
b(w).y = b(w).c2 * (SIN(_D2R(b(w).a2)) + SIN(_D2R(b(w).s2)))
CASE 3
b(w).x = b(w).c1 * (SIN(_D2R(b(w).a1)) + SIN(_D2R(b(w).s1))) * b(w).c3 * SIN(_D2R(b(w).a3))
b(w).y = b(w).c2 * (SIN(_D2R(b(w).a2)) + SIN(_D2R(b(w).s2)))
CASE 4
b(w).x = b(w).c1 * (COS(_D2R(b(w).a1)) + SIN(_D2R(b(w).s1))) * b(w).c3 * SIN(_D2R(b(w).a3))
b(w).y = b(w).c2 * (SIN(_D2R(b(w).a2)) + SIN(_D2R(b(w).s2)))
CASE 5
b(w).x = b(w).c1 * (SIN(_D2R(b(w).a1)) + SIN(_D2R(b(w).s1))) + b(w).c3 * COS(_D2R(b(w).a3))
b(w).y = b(w).c2 * (SIN(_D2R(b(w).a2)) + SIN(_D2R(b(w).s2)))
CASE 6
b(w).x = b(w).c1 * (COS(_D2R(b(w).a1)) + SIN(_D2R(b(w).s1))) + b(w).c3 * COS(_D2R(b(w).a3))
b(w).y = b(w).c2 * (SIN(_D2R(b(w).a2)) + SIN(_D2R(b(w).s2)))
CASE 7
b(w).x = b(w).c1 * (SIN(_D2R(b(w).a1)) + SIN(_D2R(b(w).s1))) * b(w).c3 * COS(_D2R(b(w).a3))
b(w).y = b(w).c2 * (SIN(_D2R(b(w).a2)) + SIN(_D2R(b(w).s2)))
CASE 8
b(w).x = b(w).c1 * (COS(_D2R(b(w).a1)) + SIN(_D2R(b(w).s1))) * b(w).c3 * COS(_D2R(b(w).a3))
b(w).y = b(w).c2 * (SIN(_D2R(b(w).a2)) + SIN(_D2R(b(w).s2)))
END SELECT
x = INT(b(w).x + b(w).xn)
y = INT(b(w).y + b(w).yn)
IF x >= -VSLIM AND y >= -VSLIM AND x <= VSLIM AND y <= VSLIM THEN
IF vs(y, x) = 0 THEN vs(y, x) = w
END IF
END SUB
FUNCTION Rand& (fromval&, toval&)
DIM sg%, f&, t&
IF fromval& = toval& THEN
Rand& = fromval&
EXIT FUNCTION
END IF
f& = fromval&
t& = toval&
IF (f& < 0) AND (t& < 0) THEN
sg% = -1
f& = f& * -1
t& = t& * -1
ELSE
sg% = 1
END IF
IF f& > t& THEN SWAP f&, t&
Rand& = INT(RND * (t& - f& + 1) + f&) * sg%
END FUNCTION
FUNCTION Random1& (maxvaluu&)
DIM sg%
sg% = SGN(maxvaluu&)
IF sg% = 0 THEN
Random1& = 0
ELSE
IF sg% = -1 THEN maxvaluu& = maxvaluu& * -1
Random1& = INT(RND * maxvaluu& + 1) * sg%
END IF
END FUNCTION
How to attach data (sound, image, etc.) to EXE files has been shown here several times.
My only question is, can the actual program also write itself, or is that only possible with a separate program?
If a program is running, you can still open it for reading, but writing is denied.
So the system, with me Windows denied the write access when a program is running.
Here's the question, is there a way to bypass the system lock?
Example program, even started as an administrator does not work. ( Regtest.bas )
Code: (Select All)
'====================Declarirung fr die Registrirung==========================================================================================
Declare Dynamic Library "kernel32"
FUNCTION GetVolumeInformationA& (lpRootPathName$, lpVolumeNameBuffer$, BYVAL nVolumeNameSize~&, _
lpVolumeSerialNumber~&, lpMaximumComponentLength~&, lpFileSystemFlags~&, lpFileSystemNameBuffer$, BYVAL nFileSystemNameSize&)
End Declare
Declare Library: Function GetDriveType& (d$): End Declare
Dim Shared DriveType As String, SERIALFOUND As String
Dim As _Float Regist
Dim As _Float FileSize
'========================Ende der Registrirung=================================================================================================
MyAppName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
'If MyAppName$ <> "Register-3.exe" Then System
'Open ".\Register-3.exe" For Input As #1
'FileSize = LOF(1)
'Close #1
'If FileSize = 592187 Then Else System
'===========================Code fr die Registrirung==========================================================================================
Test% = 0
SERIALSSHOW:
For q = 1 To 26: X = GetFileInfo(q): 'If SERIALFOUND <> "!!!-!!!" Then Print " "; Chr$(64 + q) + ": "; SERIALFOUND
If SERIALFOUND <> "!!!-!!!" And Test% = 0 Then
Temp$ = SERIALFOUND
Test% = 1
End If
Next q
'Print Temp$
'file$ = _OpenFileDialog$("Datei Öffnen", "", "*.EXE", "Programdatei", 0)
file$ = ".\Regtest.exe"
Open file$ For Binary As #1
FileSize = LOF(1)
t$ = "NR"
check$ = " "
Color 3, 5
'Print FileSize
Select Case UCase$(check$)
Case "VC" 'verified copy. All is good
Get #1, FileSize - 10, Regist
String1$ = _MK$(_Float, Regist)
String1$ = Left$(String1$, 9)
'Print String1$
'Print Temp$
If UCase$(String1$) = UCase$(Temp$) Then
Print "You have a paid copy of this software. All is good."
Else
Print " Illegaler Programm Aufruf !!!!!!!"
_Delay 5
Close #1
System
End If
Case "NR" 'already has a timestamp, is a limited time test version. Toss NAG Screen.
Print "This is a trial version of the program."
Registrierung$ = _InputBox$("Regtest Registrierung", "Geben sie bitte den Registrierungs Code ein:", "Demo")
If Registrierung$ = Chr$(36) + Chr$(82) + Chr$(101) + Chr$(103) + Chr$(105) + Chr$(115) + Chr$(116) + Chr$(101) + Chr$(114) + Chr$(64) Then '$Register@
Get #1, FileSize - 10, Regist
String1$ = _MK$(_Float, Regist)
Color 3, 6
String1$ = Left$(String1$, 9)
If UCase$(String1$) = UCase$(Temp$) Then
Print "Programm wurde manipuliert"
Else
Print "Schreibe VC in Datei"
Sleep 5
Temp$ = Temp$ + "VC"
Put #1, FileSize - 1, Temp$
Print "Programm wurde Registriert "
_NotifyPopup "Regtest", "Ihre Registrierung war Erfolgreich", "info" ' "info" , "warning" oder "error"
Close #1
_Delay .5
'Open file$ For Binary As #1
'FileSize = LOF(1)
'Get #1, FileSize - 10, Regist
'String1$ = _MK$(_Float, Regist)
'Color 3, 6
'String1$ = Left$(String1$, 9)
'Print "RegTest " + String1$
Sleep
Close #1
End If
Else
Print " Ihr Code ist Falsch "
_NotifyPopup "Regtest", "Ihre Registrierung ist Fehlgeschlagen", "warning"
End If
Case Else 'first run.
Print "Illegal copy of software! Terminating Now!"
Print " Schreibe NR in Datei"
Sleep 5
'Print check$
Put #1, FileSize + 1, t$
'Print t$
Sleep
Close #1
End
End Select
Close #1
'=======================================Code ende Registrirung ====================================================================
'==================================Funtionen fr die Registrirung =================================================
Function GetFileInfo (D)
SERIALFOUND = "!!!-!!!":
If DRIVEEXISTS(D) <> 1 Then GetFileInfo = 0: Exit Function
Dname$ = Chr$(D + 64) + ":\": Sname$ = Space$(260)
R = GetVolumeInformationA(Dname$ + Chr$(0), Vname$, 260, serial~&, empty1~&, empty2~&, Sname$, 260)
If R = 0 Then Exit Function
Sname$ = Left$(Hex$(serial~&), 4) + "-" + Right$(Hex$(serial~&), 4)
SERIALFOUND = "" + Sname$ + ""
GetFileInfo = -1
End Function
'---
Function DRIVEEXISTS (V)
DRIVEEXISTS = 0: varX$ = Chr$(V + 64) + ":\" + Chr$(0): VarX = GetDriveType(varX$): If VarX > 1 Then DRIVEEXISTS = 1
End Function
'===========================================Ende der Registrirung==========================
Would be helpful and not too onerous to have NEXT include the control variable to which it is attached? For example
For x = 1 to 50
For y = 2 to 75
.... code here..
NEXT y
NEXT x
Sometimes the control variable provides important info on data being manipulated in the loop and the manipulation can be complex and nested deeply so that the NEXT statements come on multiple pages of code.
For Temperature = 90 to 190
... code here...
For Windspeed = 20 to 150
>>> code here <<<
Next Windspeed
.... more code
Next Temperature
Also, I'm not sure if the Error Warning which for me pops up a lot, and invariably is telling me the Subscript on Line 10250 is out of range. Would it be possible to have a feature where pushing enter or some such key will take me directly to the offending line?
Is there a way to force controller _DEVICES to be cleared and re-detected?
For instance, when _DEVICES is first used in a running program the detected number of controllers will be returned. If one or more of the detected controllers is then disconnected the _DEVICE$ for the disconnected controllers will add "[DISCONNECTED]" to the string returned but still occupy a place in _DEVICES. If a user were to start plugging in random controllers after program startup the _DEVICES value will just keep growing with each new unique controller connected. The program listed below will show this in action. I would like to clear the _DEVICES list when a controller is listed as "[DISCONNECTED]" so _DEVICES can recount the actual number of controllers still plugged in if this is possible while a program is running. Any thoughts?
Code: (Select All)
DIM Devices AS INTEGER
DIM Fcount AS INTEGER
DIM d AS INTEGER
DIM DeviceName AS STRING
Devices = _DEVICES
Fcount = 0
DO
CLS
_LIMIT 30
Fcount = Fcount + 1
IF Fcount = 30 THEN ' check for new devices once per second
Fcount = 1
IF _DEVICES <> Devices THEN Devices = _DEVICES ' if number of devices changes get new count
END IF
PRINT
FOR d = 1 TO Devices ' print found devices
COLOR 14, 1
DeviceName = _DEVICE$(d)
IF INSTR(DeviceName, "[DISCONNECTED]") THEN COLOR 7, 0 ' change color if disconnected
PRINT " Found: "; _DEVICE$(d)
COLOR 7, 0
NEXT d
_DISPLAY
LOOP UNTIL _KEYDOWN(27) ' press ESC to exit
An example program for drawing lines "slower" for illustrative purposes. This was something someone asked about in a facebook group and I'm sharing the code here.
Code: (Select All)
'Example of Drawing lines slowly using qb64
Screen _NewImage(800, 500, 32)
Print "Slowly Drawing 4 lines"
For n = 1 To 700 Step 10
fatline 1, 100, n, 100, 3, _RGB32(200, 200, 200)
angle_line 1, 100, n, 3, 3, _RGB32(200, 100, 100)
angle_line 1, 100, n, 13, 3, _RGB32(100, 100, 200)
angle_line 1, 100, n, 33, 3, _RGB32(100, 200, 100)
_Delay 0.04
_Display 'eliminates very minor flicker, not strictly needed
Next n
Sub angle_line (x, y, Lnth, ang, thk, klr As _Unsigned Long)
'draw a line from x,y lnth units long (from center of line) at angle ang of radial thickness thk in color klr
ox = x: oy = y
nx = ox + Lnth * Cos(0.01745329 * ang)
ny = oy + Lnth * Sin(0.01745329 * ang)
fatline ox, oy, nx, ny, thk, klr
End Sub
Sub fcirc (CX As Long, CY As Long, R As Long, klr As _Unsigned Long)
'draw a filled circle with the quickest routine in qb64, not my development
Dim subRadius As Long, RadiusError As Long
Dim X As Long, Y As Long
subRadius = Abs(R)
RadiusError = -subRadius
X = subRadius
Y = 0
If subRadius = 0 Then PSet (CX, CY): Exit Sub
Line (CX - X, CY)-(CX + X, CY), klr, 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), klr, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), klr, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), klr, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), klr, BF
Wend
End Sub
Sub fatline (x0, y0, x1, y1, r, klr As _Unsigned Long)
'draw a line with dots with a radial thickness of r from x0,y0 to x1,y1 in color klr
If Abs(y1 - y0) < Abs(x1 - x0) Then
If x0 > x1 Then
lineLow x1, y1, x0, y0, r, klr
Else
lineLow x0, y0, x1, y1, r, klr
End If
Else
If y0 > y1 Then
lineHigh x1, y1, x0, y0, r, klr
Else
lineHigh x0, y0, x1, y1, r, klr
End If
End If
End Sub
Sub lineLow (x0, y0, x1, y1, r, klr As _Unsigned Long)
dx = x1 - x0
dy = y1 - y0
yi = 1
If dy < 0 Then
yi = -1
dy = -dy
End If
d = (dy + dy) - dx
y = y0
For x = x0 To x1
fcirc x, y, r, klr
If d > 0 Then
y = y + yi
d = d + ((dy - dx) + (dy - dx))
Else
d = d + dy + dy
End If
Next x
End Sub
Sub lineHigh (x0, y0, x1, y1, r, klr As _Unsigned Long)
dx = x1 - x0
dy = y1 - y0
xi = 1
If dx < 0 Then
xi = -1
dx = -dx
End If
D = (dx + dx) - dy
x = x0
For y = y0 To y1
fcirc x, y, r, klr
If D > 0 Then
x = x + xi
D = D + ((dx - dy) + (dx - dy))
Else
D = D + dx + dx
End If
Next y
End Sub
A track & field type running game for 2-4 players.
The faster you move the controller the faster your player goes
(kind of like the old arcade game Track & Field in a way).
Setup
Download the "footrace3-00.bas" file and run. The first time you run the game, choose the map controls option and save your mapping. I haven't tested it beyond my own PC (Windows 10), keyboard/mouse (standard wired USB ones), and a couple of different game controllers (see below), but it seems to work.
Game Controls
The game lets you map your own controls, and supports both game controller and keyboard input.
However it's much easier playing with joystick / gamepad controllers, where one joystick controlls each foot:
(Later I'll post instructions on building a pair of joysticks cheap!)
Screenshots
History
I first had this idea back in February 2003, and it went on to the backburner with the 10,000 other "bright ideas" to be toyed with or maybe finished or forgotten.
Well, thanks in no small part to QB64, it has finally been realized. Only took 19 years! You kids - let that be a lesson to you - sometimes perseverance pays off!!
I'm sure this could be done better, I am not what you would call a talented programmer. Also I am not really a gamer and am not too up on things, so maybe this concept has been done.
I just wanted to make something that would be fun for the family on a rainy day, that can be tinkered with, without having to be a rocket scientist.
I still want to build some crazy game controllers to make for a unique user experience. That could be part of the experience - each player brings their own customized contraption to control their player.
![[Image: footrace-game-controller-1.png]](https://i.ibb.co/WDtckLP/footrace-game-controller-1.png)
![[Image: footrace01.png]](https://i.ibb.co/WpFskdS/footrace01.png)
![[Image: footrace02.png]](https://i.ibb.co/xMtrjm4/footrace02.png)
![[Image: footrace03.png]](https://i.ibb.co/MMH8p2P/footrace03.png)
![[Image: footrace04.png]](https://i.ibb.co/frn5R0D/footrace04.png)
![[Image: footrace07.png]](https://i.ibb.co/TkDynbQ/footrace07.png)
![[Image: footrace08.png]](https://i.ibb.co/LN9qh0G/footrace08.png)
![[Image: footrace09.png]](https://i.ibb.co/p05WRPc/footrace09.png)
![[Image: footrace10.png]](https://i.ibb.co/phmnRN0/footrace10.png)
![[Image: footrace11.png]](https://i.ibb.co/X328my4/footrace11.png)
