| 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,032
|
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 1,261
|
ColorPicker - Function th...
Forum: Dav
Last Post: Dav
08-31-2023, 11:04 PM
» Replies: 3
» Views: 315
|
Goals(1) = New Tile()
Forum: Works in Progress
Last Post: RhoSigma
08-31-2023, 09:45 PM
» Replies: 3
» Views: 127
|
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 3,589
|
Updating The Single Most ...
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:13 PM
» Replies: 7
» Views: 254
|
QBJS Image Question
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 05:49 PM
» Replies: 5
» Views: 155
|
|
|
| BAM thingies in the works |
|
Posted by: CharlieJV - 06-03-2023, 03:36 AM - Forum: QBJS, BAM, and Other BASICs
- Replies (19)
|
 |
Currently in the works (click here for details; click here to try the test version of BASIC Anywhere Machine)
- Documentation: setup the architectural components for syntax diagrams, and start using/testing syntax diagrams with the statements/functions/operators below
- Enhanced debugging: added generic code issue notification and viewing mechanism, and specific catching missing definitions for SUB and FUNCTION declarations
- Added UrlQueryString$ function
- Added UrlKey$ function
- Added IFF function
- Added MIN and MAX functions
- Added BIN$ keyword (alternative name for already existing _BIN$ function)
- Added DAY$ function
- Added DIV keyword (alternative for the already existing "\", i.e. integer division, operator)
- Added FRAC function
- Added BETWEEN function
- Added CHOOSE function
- Enhanced compatibility of DEFtype statements
- Enhanced compatibility of _BIN$, HEX$, OCT$ functions
- Enhanced compatibility of SLEEP statement
- Enhanced compatibility of INSTR function
- Enhanced compatibility of RANDOMIZE function
- Enhanced compatibility of INTEGER data type
- Fixed the WIDTH statement: fixed a little glitch and documented behaviour
- Added the HEIGHT statement (WIDTH specifying the number of text columns, why not be able to specify the number of rows?)
- Added PUTSTRING statement
- Added SCROLL statement
|
|
|
| On Exit question |
|
Posted by: NasaCow - 06-02-2023, 03:50 AM - Forum: Help Me!
- Replies (52)
|
 |
I am trying to control exiting to prevent work from getting loss and adding some basic code related to EXIT is having my program crash out with Error 10 - Duplicate definition (The error points to the label ShutDown). I tried to step through it to see how the program flows exactly but with no success. Is running the timer all the time to check a bad idea for complex programs? Getting it to work with a simple loop seems to be no problem, inserting into Grade Keeper seems to be breaking something...
Quote:'Disabling the default exit routinue
ExitFlag = EXIT
ON TIMER(1) GOSUB ShutDown
TIMER ON
...
ShutDown:
ExitFlag = EXIT
IF ExitFlag THEN SYSTEM
RETURN
|
|
|
|
| Comb Sort versus Quick Sort |
|
Posted by: bplus - 05-30-2023, 07:06 PM - Forum: Utilities
- Replies (13)
|
 |
I thought johnno had a contender for QSort when I ran 1 Million Numbers on QB64, it beat my Strings Quick Sort test times, BUT! When I compare the exact same String arrays QSort clearly wins every time! 
Here is my test code, both take the string array to sort as a parameter and QSort needs a high and low index, because it calls itself recursively:
Code: (Select All) Option _Explicit
_Title "Comb Sort vrs Quick Sort" ' b+ 2023-05-30
Randomize Timer ' so we have a different array each time we compare
DefLng A-Z
Const nItems = 1000000
Dim sa$(1 To nItems) ' setup a string array sa$() to sort
Dim copy$(1 To nItems) ' make a copy of sa$() to compare another sort to
Dim As Long i, j ' indexes to array for building and displaying the arrays
Dim As Long r ' a random posw integer = 2 to 6
Dim t##, qtime##, ctime##
Dim b$ ' building string
For i = 1 To nItems ' make a random list to sort
b$ = ""
r = (Rnd * 5) \ 1 + 2
For j = 0 To r
b$ = b$ + Mid$("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789.?", (Rnd * 64) \ 1 + 1, 1)
Next
sa$(i) = b$
copy$(i) = b$
Print b$,
Next
Print
Print "Press any to Quick Sort"
Sleep
Cls
t## = Timer(.001)
QuickSort 1, nItems, sa$()
qtime## = Timer(.001) - t##
For i = 1 To 10
Print sa$(i),
Next
Print: Print
For i = nItems - 9 To nItems
Print sa$(i),
Next
Print: Print
Print " Quick Sort time:"; qtime##
Print
Print " Press any to Comb Sort with array copy, zzz..."
Print
Print
Sleep
t## = Timer(.001)
CombSort copy$()
ctime## = Timer(.001) - t##
For i = 1 To 10
Print copy$(i),
Next
Print: Print
For i = nItems - 9 To nItems
Print copy$(i),
Next
Print: Print
Print " Comb Sort time:"; ctime##
Print
If ctime## < qtime## Then Print " Comb winds!" Else Print " QSort wins again!"
Sub QuickSort (start As Long, finish As Long, arr$())
Dim Hi As Long, Lo As Long, Middle$
Hi = finish: Lo = start
Middle$ = arr$((Lo + Hi) / 2) 'find middle of arr$
Do
Do While arr$(Lo) < Middle$: Lo = Lo + 1: Loop
Do While arr$(Hi) > Middle$: Hi = Hi - 1: Loop
If Lo <= Hi Then
Swap arr$(Lo), arr$(Hi)
Lo = Lo + 1: Hi = Hi - 1
End If
Loop Until Lo > Hi
If Hi > start Then Call QuickSort(start, Hi, arr$())
If Lo < finish Then Call QuickSort(Lo, finish, arr$())
End Sub
' trans from johnno ref: https://rcbasic.freeforums.net/thread/779/sort-algorithms
Sub CombSort (arr$())
Dim As Long itemCount, start, fini, swaps, gap, i
start = LBound(arr$)
itemCount = UBound(arr$) - start + 1
fini = start + itemCount - 1
gap = itemCount
While gap > 1 Or swaps <> 0
gap = Int(gap / 1.25)
If gap < 1 Then gap = 1
swaps = 0
For i = start To itemCount - gap
If arr$(i) > arr$(i + gap) Then
Swap arr$(i), arr$(i + gap)
swaps = 1
End If
Next
Wend
End Sub
|
|
|
|
| A distorted image |
|
Posted by: Petr - 05-29-2023, 10:10 PM - Forum: Programs
- Replies (2)
|
 |
This is just an example of how you can deform images using maptriangle 2D. On line 10, just overwrite the image name with a valid name for your image. Then after launch just move with the mouse.
Code: (Select All) 'image deform demo by Petr
$NoPrefix
Screen NewImage(1024, 768, 32)
DOWN = Height * .7
UP = Height * .3
Gstep = 3 '1 is smoothest cut, best output but "low" speed
ASize = Fix(Width / Gstep)
image& = LoadImage("img.jpg", 32)
v& = _NewImage(1024, 768, 32) 'set image to the same width and height as screen to handle v&
PutImage , image&, v&
FreeImage image&
Dim As Integer XX(ASize), YY(ASize), YY2(ASize)
Do
While MouseInput
Wend
Cls
i = 0
XSTEPL = Gstep * Pi / 2 / MouseX ' program use for deformations SINUS so is image width and height recalculated to radians here
XSTEPR = Gstep * Pi / 2 / (Width - MouseX)
YP = (-Height / 2 + MouseY)
For XD = 1 To MouseX Step Gstep
X = XD
Y = DOWN + Sin(XP) * YP
Y2 = UP + Sin(XP) * -YP
XP = XP + XSTEPL
XX(i) = X
YY(i) = Y
YY2(i) = Y2
i = i + 1
Next
For XD = MouseX To Width - 1 Step Gstep
X = XD
Y = DOWN + Sin(XP) * YP
Y2 = UP + Sin(XP) * -YP
XP = XP + XSTEPR
XX(i) = X
YY(i) = Y
YY2(i) = Y2
i = i + 1
Next
i = i - 1
XP = 0
For MPT = 0 To i - 1
XS = MPT * Gstep 'step in x in 2d
XS2 = (MPT + 1) * Gstep
ScrX = XX(MPT)
ScrX2 = XX(MPT + 1)
ScrY2 = YY(MPT)
ScrY = YY2(MPT + 1)
MapTriangle (XS, 0)-(XS2, 0)-(XS, 768), v& To(ScrX, ScrY)-(ScrX2, ScrY)-(ScrX, ScrY2), 0
MapTriangle (XS2, 0)-(XS, 768)-(XS2, 768), v& To(ScrX2, ScrY)-(ScrX, ScrY2)-(ScrX2, ScrY2), 0
Next
Display
Limit 120
Loop
|
|
|
|
Teach me fast |
|
Posted by: mnrvovrfc - 05-29-2023, 03:03 AM - Forum: General Discussion
- No Replies
|
 |
bplus gave me an idea with a thread going on in his sub-forum:
https://staging.qb64phoenix.com/showthread.php?tid=1693
I'm too lame to create a topic on "Keyword of the Day" like Pete or Steve could, so it will have to be constrained to this topic. These are a few tips for people just getting started with QB64.
If there are still any doubts about using keywords, statements, variables etc. in this programming language, there is always the QB64 Wiki or Terry Ritchie's tutorials within easy reach.
Anyway, the first topic within topic here is CHR$(). The synopsis is:
Code: (Select All) onechar$ = CHR$(bytenum)
onechar$ = return value = a one-byte string
bytenum = first parameter = a number from zero to 255.
Note "bytenum" has to be an _UNSIGNED _BYTE. Trying to go less than zero or higher than 255 creates an "Illegal function call" runtime error message. Do not use ordinary _BYTE variable as first parameter to this function, even if you don't intend with your programming calculations with going over 127. Suddenly the value could wrap around and you would be stung for it, and it could be difficult to debug. To be absolutely safe, declare a variable AS INTEGER to use as the parameter of CHR$().
This function is very necessary to produce the double-quotation mark, which is CHR$(34).
It is also very necessary for creating a few control codes such as the "newline" characters. On Windows it's CHR$(13) + CHR$(10) which is two bytes. On Linux it's only CHR$(10), and on MacOS it's only CHR$(13).
There is much more. The "bytenum" is an ASCII code which could be looked up inside the QB64 IDE: Tools menu --> ASCII chart (first option).
Some people would like CHR$() to return more than one byte. "Freebasic could do it!" Well this is not Freebasic, and therefore it will require a workaround. It has been said that a function like "printf()" in C is needed for this but it's impractical in QB64 at this time. Therefore I have provided a function that is a compromise.
There are two caveats. The parameter must be provided as a string list in which the ASCII codes have to be separated by semicolons. If you prefer to change the delimeter to comma then the two lines with INSTR() have to be changed. This function purposely blocks CHR$(0) for safety reasons. If you feel you need that, such as for re-creating a WAV file header, you could make edits toward "v = 0". Whatever value in the list this function cannot pick up as an integer, it tries to convert to hexadecimal.
Code: (Select All) FUNCTION chrs$ (acode$)
DIM a$, b$, v AS _UNSIGNED _BYTE
DIM AS LONG z1, z2
IF acode$ = "" THEN
chrs$ = ""
ELSE
a$ = ""
z1 = 1
z2 = INSTR(acode$, ";")
DO
IF z2 = 0 THEN
b$ = MID$(acode$, z1)
ELSE
b$ = MID$(acode$, z1, z2 - z1)
END IF
v = VAL(b$)
IF v = 0 THEN v = VAL("&H" + b$)
IF v > 0 THEN a$ = a$ + CHR$(v)
IF z2 > 0 THEN
z1 = z2 + 1
z2 = INSTR(z1, acode$, ";")
ELSE
EXIT DO
END IF
LOOP
chrs$ = a$
END IF
END FUNCTION
Examples:
Code: (Select All) PRINT chrs$("72;101;108;108;111;33")
'produces "Hello!" (without double-quotation marks)
PRINT chrs$("222;219;219;219;219;221")
'produces a thick bar on QB64 screenie. Don't recommend printing this on a Linux terminal which is not Unicode ready.
PRINT chrs$("32;ba")
PRINT chrs$("cd;ca;b9")
'produces a two-line picture of an interesting double-line pipe, on QB64 screenie.
|
|
|
|
| basic saves the day |
|
Posted by: James D Jarvis - 05-28-2023, 04:21 PM - Forum: General Discussion
- Replies (5)
|
 |
My son is programming in an implementation of smalltalk and is working on a game where he has to keep track of world space and camera space and wanted to do a simple angle based system a shooter fires at a target and he hasn't studied trigonometry yet. Dad to the rescue! He was mixing up World space and camera space variables but that was fairly easy to spot. I showed him the proper formulas for calculating the difference in coordinates along angles but it wasn't working right for him so I showed him how it worked in QB64. It still wasn't working right for him and it took almost 2 hours of troubleshooting before I realized...doh.. "even though the internal logic of your programming language uses degrees it automatically converts to radians when doing trigonometry" . Luckily I had my little program to show the centuries old math is right. It was just a matter of figuring out which way his programming language thought 0 degrees was and figuring out the lag between object creation and when the angle between two objects was actually reported.
Being able to demonstrate the math in basic thanks to QB64 was the winner.
|
|
|
|
| Recursion Limit |
|
Posted by: bplus - 05-28-2023, 02:04 PM - Forum: General Discussion
- Replies (10)
|
|
Ewh! disappointing that QB64pe dies in mid 18,000's BaCon and FreeBasic do way better...
https://rosettacode.org/wiki/Find_limit_...sion#BASIC
Here is code I checked with, maybe there is better?
Code: (Select All) howRecursive 1
Sub howRecursive (i As _Integer64)
If i < 0 Then Print "_Integer64 turned negative.": End
Print i
_Delay .000000000005
howRecursive i + 1
End Sub
Maybe with manual stack?
|
|
|
|
|
