| 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,033
|
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 1,261
|
ColorPicker - Function th...
Forum: Dav
Last Post: Dav
08-31-2023, 11:04 PM
» Replies: 3
» Views: 315
|
Goals(1) = New Tile()
Forum: Works in Progress
Last Post: RhoSigma
08-31-2023, 09:45 PM
» Replies: 3
» Views: 127
|
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 3,589
|
Updating The Single Most ...
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:13 PM
» Replies: 7
» Views: 254
|
QBJS Image Question
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 05:49 PM
» Replies: 5
» Views: 155
|
|
|
| QB64 Game Tutorial Updated |
|
Posted by: TerryRitchie - 04-19-2023, 01:36 AM - Forum: Learning Resources and Archives
- Replies (5)
|
 |
The game tutorial at www.qb64tutorial.com has been updated.
- STICK and STRIG added to Lesson 7: Gathering Input
- New lesson - Lesson 21: Advanced Controller Input
These updates are all about game controllers. I've had more than few people over the past year ask for a tutorial on using game pads and joysticks.
If you have time check it out and let me know if you find any issues I need to resolve.
Terry
|
|
|
| GUI Shutdown or Restart (Linux) |
|
Posted by: Keybone - 04-17-2023, 10:05 PM - Forum: Programs
- Replies (4)
|
 |
This is a small program to shutdown or restart a linux computer.
It is not perfect but it is a sufficient demo to show off the GUI toolkit im workin on.
Be careful, on linux this will actually shutdown your computer. Windows it wont unless you change the SHELL statement.
Code: (Select All) Option _Explicit
_Title "kbde-shutdown"
Type Position
X As Integer
Y As Integer
End Type
Type Size
X As _Unsigned Integer
Y As _Unsigned Integer
End Type
Type Label
Text As String
Position As Position
Handle As _Unsigned Long
End Type
Dim Shared labelQuantity As _Unsigned Integer
ReDim Shared Label(labelQuantity) As Label
Type radiobuttonStatus
Clicked As _Byte
Checked As _Byte
End Type
Type Radiobutton
Position As Position
Size As Size
Status As radiobuttonStatus
Handle As _Unsigned Long
End Type
Dim Shared radiobuttonQuantity As _Unsigned Integer
ReDim Shared Radiobutton(radiobuttonQuantity) As Radiobutton
Type checkboxStatus
Clicked As _Byte
Checked As _Byte
End Type
Type Checkbox
Position As Position
Size As Size
Status As checkboxStatus
Handle As _Unsigned Long
End Type
Dim Shared checkboxQuantity As _Unsigned Integer
ReDim Shared Checkbox(checkboxQuantity) As Checkbox
Type buttonStatus
Clicked As _Bit
Enabled As _Bit
End Type
Type Button
Text As String
Position As Position
Size As Size
Status As buttonStatus
Handle As _Unsigned Long
End Type
Dim Shared buttonQuantity As _Unsigned Integer
ReDim Shared Button(buttonQuantity) As Button
Type Cursor
Position As Position
Button As Integer
End Type
Dim Shared Cursor As Cursor
Screen _NewImage(480, 200, 32)
Dim Shared textColor As _Unsigned Long: textColor = _RGBA32(255, 255, 255, 255)
Dim Shared highlightColor As _Unsigned Long: highlightColor = _RGBA32(223, 223, 223, 255)
Dim Shared faceColor As _Unsigned Long: faceColor = _RGBA32(191, 191, 191, 255)
Dim Shared shadowColor As _Unsigned Long: shadowColor = _RGBA32(127, 127, 127, 255)
Dim Shared whiteColor As _Unsigned Long: whiteColor = _RGBA32(255, 255, 255, 255)
Dim Shared blackColor As _Unsigned Long: blackColor = _RGBA32(0, 0, 0, 255)
Dim Shared backgroundColor As _Unsigned Long: backgroundColor = _RGBA32(0, 255, 0, 255)
Dim Shared Label0 As _Unsigned Integer
Dim Shared Question As String: Question = "Are you sure you want to?:"
Label0 = addLabel
Label0 = initLabel(Label0, (_Width - _PrintWidth(Question)) / 2, 25, Question)
Label0 = drawLabel(Label0)
Dim Shared Label1 As _Unsigned Integer
Label1 = addLabel
Label1 = initLabel(Label1, 50, 75, "Shutdown Your Computer")
Label1 = drawLabel(Label1)
Dim Shared Label2 As _Unsigned Integer
Label2 = addLabel
Label2 = initLabel(Label2, 50, 100, "Restart Your Computer")
Label2 = drawLabel(Label2)
Dim Shared Label3 As _Unsigned Integer
Label3 = addLabel
Label3 = initLabel(Label3, 300, 100, "Timed Execution")
Label3 = drawLabel(Label3)
Dim Shared Radiobutton1 As _Unsigned Integer
Radiobutton1 = addRadiobutton
Radiobutton1 = initRadiobutton(Radiobutton1, 240, 75, 16, 16)
Radiobutton(Radiobutton1).Status.Checked = -1
Radiobutton1 = drawRadiobutton(Radiobutton1)
Dim Shared Radiobutton2 As _Unsigned Integer
Radiobutton2 = addRadiobutton
Radiobutton2 = initRadiobutton(Radiobutton2, 240, 100, 16, 16)
Radiobutton2 = drawRadiobutton(Radiobutton2)
Dim Shared Checkbox1 As _Unsigned Integer
Checkbox1 = addCheckbox
Checkbox1 = initCheckbox(Checkbox1, 435, 100, 16, 16)
Checkbox1 = drawCheckbox(Checkbox1)
Dim Shared Button1 As _Unsigned Integer
Button1 = addButton
Button1 = initButton(Button1, "OK", ((_Width - ((75 * 2) + 20)) / 2), (_Height - 48), 75, 23)
Button1 = drawButton(Button1)
Dim Shared Button2 As _Unsigned Integer
Button2 = addButton
Button2 = initButton(Button2, "Cancel", (((_Width - ((75 * 2) + 20)) / 2) + 95), (_Height - 48), 75, 23)
Button2 = drawButton(Button2)
Dim I As _Unsigned Integer, J As _Unsigned Integer, A As _Unsigned Integer
Dim Timed As _Unsigned Integer: Timed = 0
Do
Line (0, 0)-(_Width, _Height), faceColor, BF
For I = 1 To labelQuantity
_PutImage (Label(I).Position.X, Label(I).Position.Y), Label(I).Handle
Next I
For I = 1 To radiobuttonQuantity
_PutImage (Radiobutton(I).Position.X, Radiobutton(I).Position.Y), Radiobutton(I).Handle
Next I
For I = 1 To checkboxQuantity
_PutImage (Checkbox(I).Position.X, Checkbox(I).Position.Y), Checkbox(I).Handle
Next I
For I = 1 To buttonQuantity
_PutImage (Button(I).Position.X, Button(I).Position.Y), Button(I).Handle
Next I
Check
For I = 1 To radiobuttonQuantity
If Cursor.Position.X >= Radiobutton(I).Position.X And Cursor.Position.X <= Radiobutton(I).Position.X + Radiobutton(I).Size.X Then
If Cursor.Position.Y >= Radiobutton(I).Position.Y And Cursor.Position.Y <= Radiobutton(I).Position.Y + Radiobutton(I).Size.Y Then
If Cursor.Button Then
For J = 1 To radiobuttonQuantity
Radiobutton(J).Status.Checked = 0
A = drawRadiobutton(J)
Next J
Radiobutton(I).Status.Checked = -1
A = drawRadiobutton(I)
End If
End If
End If
Next I
For I = 1 To checkboxQuantity
If Cursor.Position.X >= Checkbox(I).Position.X And Cursor.Position.X <= Checkbox(I).Position.X + Checkbox(I).Size.X Then
If Cursor.Position.Y >= Checkbox(I).Position.Y And Cursor.Position.Y <= Checkbox(I).Position.Y + Checkbox(I).Size.Y Then
If Cursor.Button Then
If Checkbox(I).Status.Checked = 0 Then
Checkbox(I).Status.Checked = -1
Else
Checkbox(I).Status.Checked = 0
End If
A = drawCheckbox(I)
_Delay 0.2
End If
End If
End If
Next I
For I = 1 To buttonQuantity
If Cursor.Position.X >= Button(I).Position.X And Cursor.Position.X <= Button(I).Position.X + Button(I).Size.X Then
If Cursor.Position.Y >= Button(I).Position.Y And Cursor.Position.Y <= Button(I).Position.Y + Button(I).Size.Y Then
If Cursor.Button Then
Select Case I
Case Button1
If Checkbox(Checkbox1).Status.Checked = -1 Then
Input "Amount of time to wait? ", Timed
End If
If Radiobutton(Radiobutton1).Status.Checked = -1 Then
Shell _DontWait "shutdown -h " + LTrim$(RTrim$(Str$(Timed)))
System
ElseIf Radiobutton(Radiobutton2).Status.Checked = -1 Then
Shell _DontWait "shutdown -r " + LTrim$(RTrim$(Str$(Timed)))
System
End If
Case Button2
System
End Select
End If
End If
End If
Next I
_Display
Loop
Function addLabel~%
labelQuantity = labelQuantity + 1
ReDim _Preserve Label(labelQuantity) As Label
addLabel = labelQuantity
End Function
Function initLabel~% (inID As _Unsigned Integer, inPositionX As Integer, inPositionY As Integer, inText As String)
Dim sX As Integer
Dim sY As Integer
Label(inID).Position.X = inPositionX
Label(inID).Position.Y = inPositionY
inText = LTrim$(RTrim$(inText))
Label(inID).Text = inText
sX = (_PrintWidth(Label(inID).Text) + 2)
sY = (_FontHeight + 2)
Label(inID).Handle = _NewImage(sX, sY, 32)
initLabel = inID
End Function
Function drawLabel~% (inID As _Unsigned Integer)
_Dest Label(inID).Handle
Line (0, 0)-(_Width, _Height), faceColor, BF
_PrintMode _KeepBackground
_PrintString (2, 1), Label(inID).Text
_Dest 0
drawLabel = inID
End Function
Function addRadiobutton~%
radiobuttonQuantity = radiobuttonQuantity + 1
ReDim _Preserve Radiobutton(radiobuttonQuantity) As Radiobutton
addRadiobutton = radiobuttonQuantity
End Function
Function initRadiobutton~% (inID As _Unsigned Integer, inPositionX As Integer, inPositionY As Integer, inSizeX As _Unsigned Integer, inSizeY As _Unsigned Integer)
Radiobutton(inID).Position.X = inPositionX
Radiobutton(inID).Position.Y = inPositionY
Radiobutton(inID).Size.X = inSizeX
Radiobutton(inID).Size.Y = inSizeY
Radiobutton(inID).Handle = _NewImage(Radiobutton(inID).Size.X, Radiobutton(inID).Size.Y, 32)
initRadiobutton = inID
End Function
Function drawRadiobutton~% (inID As _Unsigned Integer)
Dim centeredX As Integer, centeredY As Integer
_Dest Radiobutton(inID).Handle
Circle ((Radiobutton(inID).Size.X / 2) + 1 - 1, (Radiobutton(inID).Size.Y / 2) + 1 - 1), (Radiobutton(inID).Size.X / 2), highlightColor
Circle ((Radiobutton(inID).Size.X / 2) - 1, (Radiobutton(inID).Size.Y / 2) - 1), (Radiobutton(inID).Size.X / 2), shadowColor
Paint (_Width / 2, _Height / 2), whiteColor, shadowColor
Dim Mark As String
If Radiobutton(inID).Status.Checked Then
Color blackColor
Mark = "*"
End If
centeredX = (_Width - _PrintWidth(Mark)) / 2
centeredY = (_Height - _FontHeight) / 2
_PrintMode _KeepBackground
_PrintString (centeredX, centeredY), Mark
_Dest 0
drawRadiobutton = inID
End Function
Function toggleRadiobutton~% (inID As _Unsigned Integer)
Dim I As _Unsigned Integer
For I = 1 To radiobuttonQuantity
Radiobutton(I).Status.Checked = 0
Next I
Radiobutton(inID).Status.Checked = -1
toggleRadiobutton = inID
End Function
Function addCheckbox~%
checkboxQuantity = checkboxQuantity + 1
ReDim _Preserve Checkbox(checkboxQuantity) As Checkbox
addCheckbox = checkboxQuantity
End Function
Function initCheckbox~% (inID As _Unsigned Integer, inPositionX As Integer, inPositionY As Integer, inSizeX As _Unsigned Integer, inSizeY As _Unsigned Integer)
Checkbox(inID).Position.X = inPositionX
Checkbox(inID).Position.Y = inPositionY
Checkbox(inID).Size.X = inSizeX
Checkbox(inID).Size.Y = inSizeY
Checkbox(inID).Handle = _NewImage(Checkbox(inID).Size.X, Checkbox(inID).Size.Y, 32)
initCheckbox = inID
End Function
Function drawCheckbox~% (inID As _Unsigned Integer)
Dim centeredX As Integer, centeredY As Integer
_Dest Checkbox(inID).Handle
Line (0, 0)-(_Width - 1, _Height - 1), highlightColor, BF
Line (0, 0)-(_Width - 2, _Height - 2), shadowColor, BF
Line (1, 1)-(_Width - 2, _Height - 2), highlightColor, BF
Line (1, 1)-(_Width - 3, _Height - 3), shadowColor, BF
Line (2, 2)-(_Width - 3, _Height - 3), whiteColor, BF
Dim Mark As String
If Checkbox(inID).Status.Checked Then
Mark = "*"
Else
Mark = " "
End If
centeredX = (_Width - _PrintWidth(Mark)) / 2
centeredY = (_Height - _FontHeight) / 2
_PrintMode _KeepBackground
Color blackColor
_PrintString (centeredX, centeredY), Mark
_Dest 0
drawCheckbox = inID
End Function
Function addButton~%
buttonQuantity = buttonQuantity + 1
ReDim _Preserve Button(buttonQuantity) As Button
addButton = buttonQuantity
End Function
Function initButton~% (inID As _Unsigned Integer, inText As String, inPositionX As Integer, inPositionY As Integer, inSizeX As _Unsigned Integer, inSizeY As _Unsigned Integer)
Button(inID).Text = inText
Button(inID).Position.X = inPositionX
Button(inID).Position.Y = inPositionY
Button(inID).Size.X = inSizeX
Button(inID).Size.Y = inSizeY
Button(inID).Handle = _NewImage(Button(inID).Size.X, Button(inID).Size.Y, 32)
initButton = inID
End Function
Function drawButton~% (inID As _Unsigned Integer)
Dim centeredX As Integer, centeredY As Integer
_Dest Button(inID).Handle
_PrintMode _KeepBackground
Line (0, 0)-(_Width - 1, _Height - 1), backgroundColor, BF
Line (1, 0)-(_Width - 2, _Height - 1), blackColor, BF
Line (0, 1)-(_Width - 1, _Height - 2), blackColor, BF
Line (2, 2)-(_Width - 3, _Height - 3), shadowColor, BF
Line (2, 2)-(_Width - 4, _Height - 4), highlightColor, BF
Line (3, 3)-(_Width - 4, _Height - 4), shadowColor, BF
Line (3, 3)-(_Width - 5, _Height - 5), highlightColor, BF
Line (4, 4)-(_Width - 5, _Height - 5), faceColor, BF
centeredX = (_Width - _PrintWidth(Button(inID).Text)) / 2
centeredY = (_Height - _FontHeight) / 2
Color textColor, faceColor
_PrintString (centeredX, centeredY), Button(inID).Text
_Dest 0
drawButton = inID
End Function
Sub Check
While _MouseInput
Wend
Cursor.Position.X = _MouseX
Cursor.Position.Y = _MouseY
Cursor.Button = _MouseButton(1)
End Sub
![[Image: final.png]](https://i.ibb.co/6R50Rsd/final.png)
|
|
|
|
| Is _WHEEL not working? |
|
Posted by: TerryRitchie - 04-17-2023, 05:36 PM - Forum: Help Me!
- Replies (13)
|
|
In the wiki under _WHEEL the following example code is given. If I'm understanding this correctly when you issue the command:
ignore = _MOUSEMOVEMENTX
this is supposed to put the mouse into a relative movement mode allowing _WHEEL(1) and _WHEEL(2) to read the mouse x,y movements. However, no matter what I try I can't seem to get this working? Any suggestions? I went back as far as version 0.8.2 and it doesn't work there either.
Code: (Select All) ignore = _MOUSEMOVEMENTX 'dummy call to put mouse into relative movement mode
PRINT "Move your mouse and/or your mouse wheel (ESC to exit)"
d = _DEVICES ' always read number of devices to enable device input
DO: _LIMIT 30 'main loop
DO WHILE _DEVICEINPUT(2) 'loop only runs during a device 2 mouse event
PRINT _WHEEL(1), _WHEEL(2), _WHEEL(3)
LOOP
LOOP UNTIL INKEY$ = CHR$(27)
|
|
|
|
| 100 prisoners' problem |
|
Posted by: TempodiBasic - 04-15-2023, 10:44 AM - Forum: Programs
- Replies (9)
|
|
Hi
here a mathematical issue showed by a problem.
I have taken from Rosetta Code the issue and the solutions posted in different program language.
There is also a solution posted using QB64. Here the link QB64 100 prisoners
Quote:The Problem- 100 prisoners are individually numbered 1 to 100
- A room having a cupboard of 100 opaque drawers numbered 1 to 100, that cannot be seen from outside.
- Cards numbered 1 to 100 are placed randomly, one to a drawer, and the drawers all closed; at the start.
- Prisoners start outside the room
- They can decide some strategy before any enter the room.
- Prisoners enter the room one by one, can open a drawer, inspect the card number in the drawer, then close the drawer.
- A prisoner can open no more than 50 drawers.
- A prisoner tries to find his own number.
- A prisoner finding his own number is then held apart from the others.
- If all 100 prisoners find their own numbers then they will all be pardoned. If any don't then all sentences stand.
Quote:The task
- Simulate several thousand instances of the game where the prisoners randomly open drawers
- Simulate several thousand instances of the game where the prisoners use the optimal strategy mentioned in the Wikipedia article, of:
- First opening the drawer whose outside number is his prisoner number.
- If the card within has his number then he succeeds otherwise he opens the drawer with the same number as that of the revealed card. (until he opens his maximum).
Show and compare the computed probabilities of success for the two strategies, here, on this page.
The solution posted on that site has for founding the mathematical CHAIN knowledge, if i can use no professional words in a group of randomly creating set of values (index/key and its internal value) linked using the internal value to call the next item of the set, it happens that chains (subgroup of the original set) born naturally.
The code from Rosetta Code in QB64
Code: (Select All) Const Found = -1, Searching = 0, Status = 1, Tries = 2
Const Attempt = 1, Victories = 2, RandomW = 1, ChainW = 2
Randomize Timer
Dim Shared Prisoners(1 To 100, Status To Tries) As Integer, Drawers(1 To 100) As Integer, Results(1 To 2, 1 To 2) As Integer
Print "100 prisoners"
Print "Random way to search..."
For a = 1 To 10000
Init
Results(RandomW, Attempt) = Results(RandomW, Attempt) + 1
RandomWay
If verify% Then Results(RandomW, Victories) = Results(RandomW, Victories) + 1
Next
Print: Print "Chain way to search..."
For a = 1 To 10000
Init
Results(ChainW, Attempt) = Results(ChainW, Attempt) + 1
ChainWay
If verify% Then Results(ChainW, Victories) = Results(ChainW, Victories) + 1
Next
Print: Print "RandomWay Results: "
Print " Attempts "; Results(RandomW, Attempt); " "; "Victories "; Results(RandomW, Victories); " Ratio:"; Results(RandomW, Victories); "/"; Results(RandomW, Attempt)
Print: Print "ChainWay Results:"
Print " Attempts "; Results(ChainW, Attempt); " "; "Victories "; Results(ChainW, Victories); " Ratio:"; Results(ChainW, Victories); "/"; Results(ChainW, Attempt)
End
Function verify%
Dim In As Integer
Print "veryfing "
verify = 0
For In = 1 To 100
If Prisoners(In, Status) = Searching Then Exit For
Next
If In = 101 Then verify% = Found
End Function
Sub ChainWay
Dim In As Integer, ChainChoice As Integer
Print "Chain search"
For In = 1 To 100
ChainChoice = In
Do
Prisoners(In, Tries) = Prisoners(In, Tries) + 1
If Drawers(ChainChoice) = In Then Prisoners(In, Status) = Found: Exit Do
ChainChoice = Drawers(ChainChoice)
Loop Until Prisoners(In, Tries) = 50
Next In
End Sub
Sub RandomWay
Dim In As Integer, RndChoice As Integer
Print "Random search"
For In = 1 To 100
Do
Prisoners(In, Tries) = Prisoners(In, Tries) + 1
If Drawers(Int(Rnd * 100) + 1) = In Then Prisoners(In, Status) = Found: Exit Do
Loop Until Prisoners(In, Tries) = 50
Next
Print "Executed "
End Sub
Sub Init
Dim I As Integer, I2 As Integer
Print "initialization"
For I = 1 To 100
Prisoners(I, Status) = Searching
Prisoners(I, Tries) = Searching
Do
Drawers(I) = Int(Rnd * 100) + 1
For I2 = 1 To I
If Drawers(I2) = Drawers(I) Then Exit For
Next
If I2 = I Then Exit Do
Loop
Next I
Print "Done "
End Sub
and its output
![[Image: immagine-2023-04-15-123315412.png]](https://i.ibb.co/6Wr769g/immagine-2023-04-15-123315412.png)
Bplus code
Code: (Select All) _Title "100 Prisoners Problem" ' b+ 2022-07-17
Randomize Timer
Dim slots(1 To 100) As Long
For i = 1 To 100
slots(i) = i
Next
Do
freed = 0: executions = 0
Do
GoSub shuffle
For p = 1 To 100 ' prisoner number
count = 1: test = p: madeit = -1
While count <= 50
If slots(test) = p Then Exit While Else test = slots(test)
count = count + 1
If count > 50 Then madeit = 0: Exit For
Wend
Next
If madeit Then freed = freed + 1 Else executions = executions + 1
Loop Until (freed + executions) = 100000
Print "Freed"; freed
Print "Exceutions"; executions
Print
Print "Press any for another run of 100,000... "
Sleep
Cls
Loop Until _KeyDown(27)
End
shuffle:
For i = 100 To 2 Step -1
Swap slots(Int(Rnd * i) + 1), slots(i)
Next
Return
' I saw this last night and just have to check out the solution in code!
' https://www.youtube.com/watch?v=iSNsgj1OCLA
' So 100 prisoners go into a room one at a time and have 50 chances to draw their number from mailbox slots
' they must return the numbers in same box they checked.
' If all the prisoners find their number they go free else they are all executed. Whew!
' But there is a strategy that if used gives them around a 31% chance of being set free!
' A 31% Change of being set free, how can this be!?
' Here is the startegy, go into the room and pull the number from slot that matches your number.
' From that number go to the number found in the box, contimue in this manner until you find your
' number or you've drawn from 50 slots. If you hit 50 then everyone is doomed might as well start
' another run on the experiment.
' If we run this strategy 100000 times will we get around 31,000 Set Frees and 69,000 Executions?
' Let's see...
' Wow! as predicted
and its output
![[Image: immagine-2023-04-15-124335135.png]](https://i.ibb.co/L1CwcsW/immagine-2023-04-15-124335135.png)
References:
Youtube chain method for 100 prisoners
Chain strategy 100 prisoners (the same used by Bplus)
Probability chain rule
wikipedia page 100 prisoners
math stackexchange page 100 prisoners solution
---------------------------------------------------------------------------------
welcome some other implementations of chain method.
|
|
|
|
| QBJS deforming torus |
|
Posted by: vince - 04-14-2023, 02:01 AM - Forum: QBJS, BAM, and Other BASICs
- Replies (4)
|
 |
inside out torus
run it in QBJS
Code: (Select All) r = 50
rr = 100
pi = 3.141593
SCREEN _NEWIMAGE(640, 480, 32), , 1, 0
dim t
'SCREEN , , 0, 0
DO
cls
'PCOPY 1, 0
t = t + .1
FOR u = 0 TO 7 STEP .05
FOR v = 0 TO 7 STEP .1
h = 100 * SIN(t)
x = (100 + 50 * COS(u)) * COS(v) + h
rr = 100 * COS(t)
cc = (pi / 2) * SIN(t)
ss = SIN(v) * COS(t) + SIN(t)
y = (rr + r * COS(u + cc)) * ss
rr = 100 * SIN(t)
cc = (pi / 2) * COS(t)
ss = SIN(v) * SIN(t) + COS(t)
z = (rr + r * COS(u + cc)) * ss
PSET (x + 0.707 * z + 320, y + 0.707 * z + 240), _RGB(255, 0, z * 10)
NEXT
NEXT
'SLEEP
_LIMIT 10
_DISPLAY
LOOP
|
|
|
|
| When to free an image? |
|
Posted by: James D Jarvis - 04-13-2023, 02:54 PM - Forum: General Discussion
- Replies (5)
|
|
When is it a good idea to use _freeimage to clean up an image from memory?
The obvious answer is of course... when you are done with it.
But is it necessary at programs end to clean up the image handles if they were declared in the main program or only in subroutines?
Code: (Select All) dim shared image1 as long
dim shared image2 as long
screen _newimage (640,400,32)
_fullscreen
image1= _LoadImage("Data\im_1.png")
_putimage (0,0)-(639,399),image1
LOADTWO
_putimage (0,0)-(339,3199),image2
'should either of these two lines be used (without being commented out)
'_freeimgae image1
'_freeimage image2
end
sub loadtwo
image1= _LoadImage("Data\im_2.png")
end sub
|
|
|
|
|
![[Image: nthprime.png]](https://i.ibb.co/Y3jSgvQ/nthprime.png)
