| Welcome, Guest |
You have to register before you can post on our site.
|
|
|
| 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://qb64phoenix.com/forum/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?
|
|
|
|
Fancy font names |
|
Posted by: mnrvovrfc - 05-27-2023, 08:28 AM - Forum: Utilities
- Replies (8)
|
|
This is a program that interacts with the user, asking him/her what is the "fancy" font name, and then it shows a dialog indicating what is the QB64 code line to use to load that font. The QB64 code line is copied to the clipboard so it could be pasted right away into the QB64 IDE.
It requires a text file called "fancy-font-names.txt" in the same directory as the executable.
This program was tested on Linux (Manjaro MATE) but with the provided text file it should work on Windows. I have listed only the fonts actually installed by "winetricks corefonts" by Debian v11 "Bullseye". I added one more, for Lucida Console which is not installed for Wine.
It's easy to add more fonts to the text file. Each line should have two fields separated by semicolon. In the first field enter the font name you wish to use. The second field is the full path of the filename of the font. Note that Bold, Italic, Semicondensed etc. are on separate TTF files than the "Regular" version and will be called differently.
It should be easier than ever to pull a text-file directory listing on Windows. Use
Code: (Select All) dir /b/s C:\Windows\Fonts
the last time I checked. It has to be redirected to a text file, to then add the fancy names ending with semicolon at the front of each line. Tedious task, I know, but I did most of the work for you for the most common fonts.
The code is being shown here, but please download the ZIP attachment with this post.
Code: (Select All) 'by mnrvovrfc 27-May-2023
OPTION _EXPLICIT
$SCREENHIDE
TYPE twostring
fancy AS STRING * 64
apath AS STRING * 192
END TYPE
DIM infile$, oneline$, entry$, oldentry$
DIM AS LONG ff, sfl, i, u, lentry, choice
REDIM sf(1 TO 1) AS twostring
infile$ = "fancy-font-names.txt"
IF NOT _FILEEXISTS(infile$) THEN
_MESSAGEBOX "File not found", "I'm sorry, but the required file wasn't found." + CHR$(13) + infile$, "info"
SYSTEM
END IF
ff = FREEFILE
OPEN infile$ FOR INPUT AS ff
DO UNTIL EOF(ff)
LINE INPUT #ff, oneline$
u = INSTR(oneline$, ";")
IF u > 0 THEN
sfl = sfl + 1
REDIM _PRESERVE sf(1 TO sfl) AS twostring
sf(sfl).fancy = LEFT$(oneline$, u - 1)
sf(sfl).apath = MID$(oneline$, u + 1)
END IF
LOOP
CLOSE ff
entry$ = _INPUTBOX$("Fancy Font Names", "What is the fancy name of the font you'd like?", " ")
IF entry$ = "" THEN SYSTEM
oldentry$ = entry$
entry$ = LCASE$(entry$)
lentry = LEN(entry$)
choice = 0
oneline$ = ""
FOR i = 1 TO sfl
oneline$ = LEFT$(LCASE$(RTRIM$(sf(i).fancy)), lentry)
IF oneline$ = entry$ THEN choice = i: EXIT FOR
NEXT
IF choice THEN
_MESSAGEBOX "Fancy Font Names", "The QB64 statement to load" + CHR$(13) + oldentry$ + " is " + chr$(34) +_
"fonthandle = _LOADFONT(" + chr$(34) +rtrim$(sf(choice).apath) + chr$(34) + ", pointsize)" + chr$(13) +_
"Be sure to set the " + chr$(34) + "pointsize" + chr$(34) +"as an integer from 8 to 128." + chr$(13) +_
"The QB64 code line was copied to the clipboard.", "info"
_CLIPBOARD$ = "fonthandle = _LOADFONT(" + CHR$(34) + RTRIM$(sf(choice).apath) + CHR$(34) + ", pointsize)"
ELSE
_MESSAGEBOX "Font name not found", "I'm sorry, I was unable to find the filename for the fancy font you entered:" +_
CHR$(13) + oldentry$, "info"
END IF
SYSTEM
Note: I have discovered two misbehaviors that can't be termed bugs. The _INPUTBOX$ produces "password mode" whether or not the third parameter is included as the empty string. That's why in this code it's actually a space which could be annoying to some people. The second thing is that on Linux on my side, the result of _CLIPBOARD$ puts double-quotation marks around the entire string that is stored. This is OK for pasting to RHS of a string assignment in this programming language; otherwise it wasn't expected.
fancy-font-names.zip (Size: 1.48 KB / Downloads: 96)
![[Image: fancy-font-dialogs.png]](https://i.ibb.co/X4TDS5w/fancy-font-dialogs.png)
|
|
|
|
| Is this a problem with _RESIZE or expected behavior? |
|
Posted by: hanness - 05-27-2023, 03:02 AM - Forum: General Discussion
- Replies (7)
|
|
I have a program that is running in a console window. I use the _RESIZE function to detect when a user drags the resize handles on the program window to resize it. This works flawlessly for me. However, if I click on the "Maximize" button in the upper right of the program window, _RESIZE does not detect the fact that the program window changed size.
Is this a problem with the _RESIZE function or is there some other method of detecting the change in the window size when the maximize button is used?
EDIT: I should note that maximizing is NOT the same as running full screen. In maximized mode, you still have a title bar that run across the full width of the screen at the top, whereas full screen eliminates the title bar.
I have a way of handling full screen that works, it's simply the "maximize" button that is causing me fits.
|
|
|
|
| QBJS v0.7.0 - Release |
|
Posted by: dbox - 05-26-2023, 06:23 PM - Forum: QBJS, BAM, and Other BASICs
- Replies (19)
|
 |
Hi All,
The latest version of QBJS (0.7.0) is now available. Here are some highlights for this release:
IDE Enhancements
Numerous enhancements to the IDE have been incorporated into this release. The code, output and console panels can be resized by dragging the panel dividers. There are now keyboard shortcuts for running the current program (F5) and the export/share feature (F11). Users can now customize the look and feel of the IDE by choosing from one of four themes.
Custom Fonts and Printing
Support has been added to allow the use of custom fonts. The following keywords are now available in support of this feature: _Font, _LoadFont, and _FreeFont. The _PrintMode keyword is also now supported to allow text to be printed with transparent background. Numerous updates have been made to the Print method to format the output more closely to QBasic/QB64.
2D Graphics Library
This release includes a new graphics library which provides native support for common graphics methods (e.g. FillTriangle, RotoZoom, FillCircle, FillEllipse). There is also new functionality to allow more control over both new graphics functions and standard QBasic graphics methods (e.g. LineWidth, LineCap, Shadow). The full list of new methods can be found here:
https://github.com/boxgaming/qbjs/wiki/S...d-graphics.
Console Output Library
A new console output library has been added to allow logging messages and simple output to the console window in the IDE. The full list of new methods can be found here:
https://github.com/boxgaming/qbjs/wiki/S...ds#console.
File I/O Extension Library
This library provides the ability to upload and download files to and from the browser from within your application. The full documentation for the library can be found here:
https://github.com/boxgaming/qbjs/wiki/S...filesystem.
See the full release announcement for a complete list of fixes and enhancements.
Check it out online here: https://qbjs.org
|
|
|
|
|
