I am working on a project that requires keypad entry.
The problem is that QB64 does not trap them!?
Here is my code:
Code: (Select All)
Rem Keypad-5 = 76
Rem Shift-Keypad-5 = 53
Rem Ctrl-Keypad-5 = 143
Do
X$ = InKey$
If Len(X$) Then
If X$ = Chr$(27) Then End
If Len(X$) = 2 Then
X = Asc(Right$(X$, 1))
Select Case X
Case 76
Print "keypad-5"
Case 53
Print "shift-keypad-5"
Case 143
Print "ctrl-keypad-5"
End Select
End If
End If
Loop
End
With http/s capability coming, QB64PE is getting a major feature set.
With that out of the way, I was thinking that another big feature for an upcoming release would be try/catch functionality. Even basic "on error resume next", like in classic VB/VBA, would be an improvement, or full try/catch like every other modern language.
Thoughts?
First of all receive my best wishes for this new year 2023.
Some time ago, I had seen somewhere (I think here) a topic with the title "QB64 without GUI" as project.
Can anyone direct me to this topic?
Moreover, is the QB64PE code sufficiently well documented to quickly and easily remove all the code necessary for the IDE, leaving only the translation in C++, the compilation part and the error messages (and maybe the line numbers concerned) as return in the event of a compilation error?
The goal of such an operation being to produce the smallest possible executable for an embedded system.
The first target would be on a framework of Linux system but I guess that could also be used on OS/X and maybe Windows on tiny computer such as the Pi platform.
Thanks in advance for any suggestions on this subject.
This is a silly program that could make a good screensaver LOL. I wrote something like this for one of my Tandy1000's many years back with QuickBASIC. Technology has gone such that it's amazing this program could run many times as fast on 64-bit, while being more bloated than a 16-bit program, and with single-core CPU barely capable of multimedia.
Code: (Select All)
''by mnrvovrfc 06-Jan-2023
OPTION _EXPLICIT
CONST NUMPEOPLE = 80
'fields:
'x, y = position of "person"
'xd, yd = direction is changed when the "person" reaches an edge of the screen
'c = color
'h = open or filled face
'k = count
'l = length of fixed path taken by the "person"
TYPE peoplette
AS INTEGER x, y, xd, yd, c, k, l, h
END TYPE
DIM p(1 TO NUMPEOPLE) AS peoplette
DIM AS INTEGER i, j, k, kl, u, v, x, y, ox, oy, wd, ht, kc
DIM a$, found AS _BYTE
RANDOMIZE TIMER
'no two "persons" may have the same path but could look alike LOL
'kc = to repeat one direction a "person" takes up to four times
'kl = the number of times the "person" could change direction
DIM check$(1 TO NUMPEOPLE)
FOR i = 1 TO NUMPEOPLE
kl = INT(RND * 10 + 5)
kc = INT(RND * 4 + 1)
k = kl
a$ = ""
DO WHILE k > 0
DO
x = INT(RND * 3) - 1
y = INT(RND * 3) - 1
LOOP WHILE x = 0 AND y = 0
a$ = a$ + repeat$(STR$(x) + STR$(y), kc)
k = k - 1
LOOP
IF i > 1 THEN
found = 0
FOR j = 1 TO i - 1
IF a$ = check$(j) THEN found = 1: EXIT FOR
NEXT
IF found THEN _CONTINUE
END IF
check$(i) = a$
p(i).l = kl
p(i).k = 0
p(i).c = INT(RND * 14 + 1)
p(i).h = INT(RND * 2 + 1)
p(i).xd = 1
p(i).yd = 1
NEXT
'spread the people all over the screen
wd = _WIDTH
ht = _HEIGHT
u = wd * ht
u = u \ NUMPEOPLE
v = u \ 2
FOR i = 1 TO NUMPEOPLE
p(i).x = (v MOD 80) + 1
p(i).y = (v \ 80) + 1
v = v + u
NEXT
'main loop
DO
'change the following line to taste, to make it run faster
_LIMIT 10
FOR i = 1 TO NUMPEOPLE
p(i).k = p(i).k + 1
IF p(i).k > p(i).l THEN p(i).k = 1
ox = p(i).x
oy = p(i).y
p(i).x = p(i).x + VAL(MID$(check$(i), p(i).k * 4 - 3, 2)) * p(i).xd
p(i).y = p(i).y + VAL(MID$(check$(i), p(i).k * 4 - 1, 2)) * p(i).yd
'"persons" aren't allowed to go off the screen nor run into each other
IF p(i).x < 1 OR p(i).x > wd OR p(i).y < 1 OR p(i).y > ht THEN
IF p(i).x < 1 OR p(i).x > wd THEN
p(i).xd = p(i).xd * (-1)
ELSE
p(i).yd = p(i).yd * (-1)
END IF
p(i).x = ox: p(i).y = oy
ELSEIF SCREEN(p(i).y, p(i).x) <> 32 THEN
p(i).x = ox: p(i).y = oy
END IF
NEXT
CLS
FOR i = 1 TO NUMPEOPLE
LOCATE p(i).y, p(i).x
COLOR p(i).c
PRINT CHR$(p(i).h);
NEXT
_DISPLAY
'press [ESC] to leave program
LOOP UNTIL _KEYDOWN(27)
SYSTEM
FUNCTION repeat$ (astr AS STRING, numtimes AS INTEGER)
DIM sret AS STRING, i AS INTEGER
IF numtimes < 2 THEN repeat$ = astr: EXIT FUNCTION
FOR i = 1 TO numtimes
sret = sret + astr
NEXT
repeat$ = sret
END FUNCTION
For some time now I have been working on a BASIC compiler which I've called L-BASIC. In many ways it's still rather primitive and in early stages, but it's reached the point where it can compile simple programs to executable format so I thought I'd make a thread for it.
You'll need to run it from a command prompt: "lbasic.exe test.bas" to compile test.bas, then run "test.exe" assuming you got no errors.
Some notes and warnings:
- Very poor support for most commands. All programs are console programs, you have a primitive PRINT but no input.
- DO, WHILE, IF, ELSE, FOR should work. ELSEIF, SELECT and EXIT don't.
- No GOTO or GOSUB, but SUB and FUNCTION can create subs/functions, and you can call them. Recursion works.
- Data types are INTEGER, LONG, INTEGER64 (no underscore), SINGLE, DOUBLE, QUAD, STRING. No _UNSIGNED. The usual suffixes %, & etc. are available.
- Basic string support: concatenation (a$ + b$), LEFT$, RIGHT$, MID$, CHR$
- All numeric operators are available and should work with proper precedence. This includes bitwise (AND, OR, XOR, NOT, IMP, EQV), relational (<, >, <=, >=, =, <>), arithmetic (+, -, *, /, \, MOD, ^).
Some programs that work:
Code: (Select All)
'Recursive factorial
'Functions can come before the main program
function fact(n)
if n = 1 then fact = 1 else fact = n * fact(n-1)
end function
for i = 1 to 10 step 2
print "fact("; i; ") = "; fact(i)
next i
Code: (Select All)
text$ = "hello" + " " + "world"
for i = 1 to len(text) 'Notice you can leave off the $ on text
print left(text, i) 'And the $ is optional on left too
next i
This first "personalizer" is for the Auto Biaxial Symmetry Graphing program I created recently.
It allows changing various settings and seeing the results on the fly.
If you find something you really like, you can export that personalized program (and the BASIC interpreter) to a small HTML file, which you can deploy/share as you like for running when you want.
I rather like this easy way to let a non-programmer (or a programmer who wants to quickly try different settings) adjust some things to their liking without needing to mess with code.
Declare CustomType Library
Function memcmp% (ByVal s1%&, Byval s2%&, Byval n As _Offset)
End Declare
Randomize Timer
Screen _NewImage(1280, 720, 32)
'let's make this an unique and pretty image!
For i = 1 To 100
Line (Rnd * _Width, Rnd * _Height)-(Rnd * width, Rnd * _Height), &HFF000000 + Rnd * &HFFFFFF, BF
Next
image2 = _CopyImage(0) 'identical copies for testing
image3 = _CopyImage(0) 'identical copy... BUT
_Dest image3
PSet (Rnd * _Width, Rnd * _Height), &HFF000000 + Rnd * &HFFFFFF 'We've just tweaked it so that there's no way in hell it's the same as the other two now!
_Dest 0 'image3 is EXACTLY one pixel different from the other two. Can we detect that?
image4 = _CopyImage(0) 'an identical copy once again, because 0 will change once we print the resul
Print "Current Screen and Image 1 Compare: "; result1
Print "Current Screen and Image 2 Compare: "; result2
Print "Image1 and Image 2 Compare : "; result3
Print
Print "Press <ANY KEY> for a speed test!"
Sleep
t# = Timer
Limit = 1000
For i = 1 To Limit
result = CompareImages(image2, image3)
result = CompareImages(image2, image4)
Next
Print
Print Using "####.####### seconds to do"; Timer - t#;
Print Limit * 2; "comparisons."
Function CompareImages (handle1 As Long, handle2 As Long)
Static m(1) As _MEM
m(0) = _MemImage(handle1): m(1) = _MemImage(handle2)
If m(0).SIZE <> m(1).SIZE Then Exit Function 'not identical
If m(0).ELEMENTSIZE <> m(1).ELEMENTSIZE Then Exit Function 'not identical
If memcmp(m(0).OFFSET, m(1).OFFSET, m(0).SIZE) = 0 Then x = -1 Else x = 0
CompareImages = x
End Function
Copied from deep inside another topic and shared here for ease of search and reference.
Interesting development at Syntax Bomb today starting with some code from ChatGPT that kay63 got working in sb and I translated and fixed ever better in QB64:
Code: (Select All)
_Title "sb spiral of chatGPT - fixed by kay63 trans and mod by me, b+ 2023-01-04"
Const xmax = 600, ymax = 600
Dim Shared pi
pi = _Pi
Dim clr As _Unsigned Long
Screen _NewImage(xmax, ymax, 32)
' Set the starting position and radius of the spiral
x = ymax / 2 - .5 * ymax / pi
y = ymax / 2 - .5 * ymax / pi
r = 1
' Set the angle increment for each loop iteration
angle_inc = 5
' Set the maximum radius of the spiral
max_r = ymax / 2
' Set the maximum number of loops
max_loops = ymax
' Set the spiral rotation direction
direction = 1
' Draw the spiral
For i = 1 To max_loops
' Set the color for this loop iteration
'Color i Mod 14
' Draw the spiral segment
Select Case i Mod 3
Case 0: clr = _RGB32(0, 255 * (i / 600), 128 - (i * 127 / 600))
Case 1: clr = _RGB32(0, 100 * i / 600 + 55, 100 * i / 600 + 55)
Case 2: clr = _RGB32(0, 255 * (i / 600), 128 - (i * 127 / 600))
End Select
arc x, y, r, angle_inc * i / 180 * pi, angle_inc * (i + 30) / 180 * pi, clr
' Increase the radius for the next loop iteration
r = r + direction
cnt = cnt + 1
' Check if the radius has reached the maximum
If r > max_r Then
' Reverse the growing of the spiral
direction = -direction
' Reset the radius
r = max_r
End If
' move the spiral:
x = x + 1 / pi
y = y + 1 / pi
_Limit 60
Next
Sleep
Sub arc (x, y, r, raStart, raStop, c As _Unsigned Long) ' this does not check raStart and raStop like arcC does
Dim al, a
'x, y origin, r = radius, c = color
'raStart is first angle clockwise from due East = 0 degrees
' arc will start drawing there and clockwise until raStop angle reached
If raStop < raStart Then
arc x, y, r, raStart, _Pi(2), c
arc x, y, r, 0, raStop, c
Else
' modified to easier way suggested by Steve
'Why was the line method not good? I forgot.
al = _Pi * r * r * (raStop - raStart) / _Pi(2)
For a = raStart To raStop Step 1 / al
PSet (x + r * Cos(a), y + r * Sin(a)), c
Next
End If
End Sub
EDIT: fixed some errors in coloring which surprisingly didn't really change outcome? No it's better now without a bunch of black lines.
In these early days of a new year, I’d like to say thanks to those who’ve helped me and many others with coding problems. People like Steve, and Bplus, and others, with much greater knowledge and skills than I have, give freely of their time to help other “QBphiles” overcome problems. Their help is given with great patience, and with respect for the sometimes “bumpy” code we write, recognizing that although we may peel an egg with a surgical laser, a sharp blow with the back of a spoon can sometimes be sufficient.
Other coders sometimes recognize a problem as being similar to one they have had and solved, and provide helpful advice based on this. This spirit of co-operation and generosity makes me confident that QB64PE will survive and thrive for a long time to come.
Wishing you all a happy, prosperous and productive new year.
