Welcome, Guest
You have to register before you can post on our site.

Username/Email:
  

Password
  





Search Forums

(Advanced Search)

Forum Statistics
» Members: 325
» Latest member: WillieTop
» Forum threads: 1,757
» Forum posts: 17,918

Full Statistics

Latest Threads
лучшие песни медляки слуш...
Forum: Petr
Last Post: WillieTop
Yesterday, 02:21 AM
» Replies: 0
» Views: 18
пинк слушать онлайн беспл...
Forum: SMcNeill
Last Post: WillieTop
Yesterday, 02:20 AM
» Replies: 0
» Views: 16
скачать музыку российскую...
Forum: madscijr
Last Post: WillieTop
Yesterday, 02:18 AM
» Replies: 0
» Views: 15
нежная музыка mp3 скачать
Forum: Keybone
Last Post: WillieTop
Yesterday, 02:17 AM
» Replies: 0
» Views: 14
лучшая песня слушать онла...
Forum: bplus
Last Post: WillieTop
Yesterday, 02:16 AM
» Replies: 0
» Views: 16
пикник слушать онлайн луч...
Forum: Spriggsy
Last Post: WillieTop
Yesterday, 02:15 AM
» Replies: 0
» Views: 16
какая сейчас популярная м...
Forum: RhoSigma
Last Post: WillieTop
Yesterday, 02:14 AM
» Replies: 0
» Views: 15
хит лета 2019 музыка на т...
Forum: Christmas Code
Last Post: WillieTop
Yesterday, 02:12 AM
» Replies: 0
» Views: 19
бесплатная музыка mp3 рег...
Forum: Works in Progress
Last Post: WillieTop
Yesterday, 02:11 AM
» Replies: 0
» Views: 15
лучшие хиты музыка 2018 2...
Forum: Utilities
Last Post: WillieTop
Yesterday, 02:10 AM
» Replies: 0
» Views: 16

 
  better error trapping?
Posted by: madscijr - 01-06-2023, 06:57 PM - Forum: General Discussion - Replies (15)

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?

Print this item

Question <solved> QB64 without its IDE GUI ?
Posted by: Fifi - 01-06-2023, 06:32 PM - Forum: General Discussion - Replies (28)

Hello all,

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.

Happy new year 2023.

Print this item

Lightbulb People in SCREEN 0
Posted by: mnrvovrfc - 01-06-2023, 02:29 PM - Forum: Programs - No Replies

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

Print this item

  The L-BASIC compiler
Posted by: luke - 01-06-2023, 01:16 PM - Forum: Works in Progress - Replies (20)

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.

Although all the source is available here on github and it's mostly written in QB64, it's rather complicated to build. If you'd like to try it, there's a prebuilt download-and-run version for 64 bit windows here: https://github.com/flukiluke/L-BASIC/rel...-x86_64.7z

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

Print this item

  BAM App Personalizer (a GUI to personalize BAM programs)
Posted by: CharlieJV - 01-06-2023, 03:48 AM - Forum: QBJS, BAM, and Other BASICs - No Replies

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.

Give it as spin:  https://basicanywheremachine.neocities.o...rsonalizer


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.



Attached Files Thumbnail(s)
   
Print this item

  Compare Images
Posted by: SMcNeill - 01-04-2023, 09:42 PM - Forum: SMcNeill - No Replies

Code: (Select All)
'int memcmp(const void *str1, const void *str2, size_t n)

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


result1 = CompareImages(0, image2)
result2 = CompareImages(0, image3)
result3 = CompareImages(image2, image3)

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.  Smile

Print this item

  sb Spiral of ChatGPT fixed by kay63 trans and mod b+
Posted by: bplus - 01-04-2023, 05:19 PM - Forum: Programs - No Replies

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.



Attached Files Thumbnail(s)
       
Print this item

  Thanks for the help.
Posted by: PhilOfPerth - 01-04-2023, 01:04 AM - Forum: General Discussion - Replies (5)

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. 

Print this item

Question Where is Pete?
Posted by: Kernelpanic - 01-03-2023, 06:59 PM - Forum: General Discussion - Replies (15)

I hope he did not shoot himself with his revolvers. . .  Confused

Print this item

  Three-dimensional array
Posted by: Kernelpanic - 01-03-2023, 06:39 PM - Forum: Programs - Replies (20)

Structure and representation of a three-dimensional array. What could one do with it? For example: day, month, total sales . . . Nice!  Tongue
Oh yes, wrong inputs are not caught yet.

Ebene = level,  Zeile = row,  Spalte = column

Code: (Select All)
'Dreidimensionales Feld mit graphischer Darstellung - 3. Jan. 2023

$Console:Only
Option _Explicit

Option Base 1
Dim As Integer dreiDimFeld(3, 4, 4)

'"dm" legt die Dimension(Ebenen) fest. Hier dreimal Bloecke a 16
'dz ist Anzahl Zeilen, ds ist Anzahl Spalten
Dim As Integer dm, dz, ds, dFeld
Dim As Integer ebene, zeile, spalte

Locate 2, 2

'Der Ablauf ist: 1te Ebene -> Durchlauf Zeile * Spalte
'dann folgt die naechste Ebene usw. so viele Ebenen
'wie vorhanden sind
dFeld = 1
For dm = 1 To 3
  For dz = 1 To 4
    'Nach jedem sechszehner Block Absatz
    'fuer naechsten Block. Csrlin+1 statt 2 -> schraege Anzeige
    Locate CsrLin + 1, CsrLin + 1
    For ds = 1 To 4
      dreiDimFeld(dm, dz, ds) = dFeld
      Print Using "## "; dreiDimFeld(dm, dz, ds),
      dFeld = dFeld + 1
    Next
  Next
  Print: Locate , 2
Next

Locate CsrLin + 2, 2

Input "Zeige Wert in Ebene : ", ebene
Locate CsrLin + 0, 2
Input "Zeige Wert in Zeile : ", zeile
Locate CsrLin + 0, 2
Input "Und in Spalte       : ", spalte

Locate CsrLin + 1, 2
Print Using "Wert in Ebene: # Zeile: # Spalte: # ist: ##"; ebene, zeile, spalte, dreiDimFeld(ebene, zeile, spalte)

End

Straight and oblique version.
[Image: Dreidimensionales-Feld2023.jpg]

Print this item