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

Username/Email:
  

Password
  





Search Forums

(Advanced Search)

Forum Statistics
» Members: 308
» Latest member: Donaldvem
» Forum threads: 1,741
» Forum posts: 17,901

Full Statistics

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,034
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

 
Music Testing Impulse Tracker music file PCM creation and playback
Posted by: mnrvovrfc - 09-04-2022, 10:40 PM - Forum: Programs - No Replies

A silly program to test Impulse Tracker module playback, and PCM data creation from it on QB64 Phoenix Edition v3.1:

Code: (Select All)
option _explicit
dim afile$, soundf as long
$IF 64BIT THEN
dim as _integer64 soundbg, soundsz, c
$ELSE
dim as long soundbg, soundsz, c
$END IF
dim b as _mem, bb as _byte, h as _byte
dim sacr$(1 to 10)

randomize (timer mod 16)

afile$ = "retro_expirement.it"
print "Please wait, loading song:"
print afile$
soundf = _sndopen(afile$)
if soundf = -1 then print "Failed to open tracker music.": end
b = _memsound(soundf, 1)
soundbg = ConvertOffset(b.OFFSET)
soundsz = ConvertOffset(b.OFFSET + b.SIZE)
soundsz = soundsz - soundbg
c = 0
h = 1
sacr$(h) = space$(3998)
_sndplay soundf

do while c < soundsz
    bb = _memget(b, b.OFFSET + c, _byte)
    if bb < 32 then bb = 95
    mid$(sacr$(h), p, 1) = chr$(bb)
    p = p + 1
    if p > 3998 then
        p = 1
        h = h + 1
        if h > 10 then exit do
        sacr$(h) = space$(3998)
    end if
    c = c + 1
loop

do
    _limit 10
    locate 1, 1
    print sacr$(int(rnd * 10 + 1));
    if not _sndplaying(soundf) then exit do
loop until _keydown(27)
_sndstop soundf
_sndclose soundf
system

FUNCTION ConvertOffset&& (value AS _OFFSET)
$CHECKING:OFF
DIM m AS _MEM 'Define a memblock
m = _MEM(value) 'Point it to use value
$IF 64BIT THEN
    dim i64ret as _integer64
    'On 64 bit OSes, an OFFSET is 8 bytes in size.  We can put it directly into an Integer64
    _MEMGET m, m.OFFSET, i64ret 'Get the contents of the memblock and put the values there directly into ConvertOffset&&
    ConvertOffset&& = i64ret
$ELSE
    dim temp&
    'However, on 32 bit OSes, an OFFSET is only 4 bytes.  We need to put it into a LONG variable first
    _MEMGET m, m.OFFSET, temp& 'Like this
    ConvertOffset&& = temp& 'And then assign that long value to ConvertOffset&&
$END IF
_MEMFREE m 'Free the memblock
$CHECKING:ON
END FUNCTION

Download the Impulse Tracker music file from here:

https://modarchive.org/module.php?189056

Press [ESC] to quit the program.

Create executable and copy the IT file you downloaded into the same folder. I'm sorry about hardwiring the value of "afile$". This should work with any module format, the problem is that the longer the song file is, the longer "_SNDOPEN" takes to load it into RAM. Now this could apply to music tracker modules despite their usually being much smaller than MP3 and WAV and formats like that.

Print this item

  Is your computer watching you?
Posted by: James D Jarvis - 09-04-2022, 05:10 AM - Forum: Programs - Replies (7)

Is your computer watching you?

Code: (Select All)
'Your Computer is watching you
'
Screen _NewImage(640, 360, 32)
Randomize Timer
_FullScreen
_Title "The Computer Is Your Friend"
Dim Shared skintonemid As _Unsigned Long
Dim Shared skintonehigh As _Unsigned Long
Dim Shared skintonelow As _Unsigned Long
Dim pk&
pk& = _NewImage(4, 4, 32)
Dim Shared irismid As _Unsigned Long
Dim Shared irishigh As _Unsigned Long
Dim Shared irislow As _Unsigned Long
Dim Shared irisfleck As _Unsigned Long
Dim Shared eyewhite As _Unsigned Long
Do
    Cls
    ex = _Width / 2
    ey = _Height / 2
    sred& = 50 + Rnd * 175
    sgreen& = 50 + Rnd * 175
    sblue& = 50 + Rnd * 175
    skintonehigh = _RGB32(sred&, sgreen&, sblue&)
    skintonemid = _RGB32(sred& * .8, sgreen& * .9, sblue& * .95)
    skintonelow = _RGB32(sred& * .6, sgreen& * .7, sblue& * .6)
    Select Case Int(1 + Rnd * 16)
        Case 1
            ired& = 40
            igreen& = 130
            iblue& = 20
        Case 2, 3
            ired& = 50
            igreen& = 70
            iblue& = 240
        Case 4, 5, 6
            ired& = 150
            igreen& = 200
            iblue& = 220

        Case 7, 8, 9, 10
            ired& = 100
            igreen& = 80
            iblue& = 60
        Case 11, 12, 13
            ired& = 200
            igreen& = 200
            iblue& = 140
        Case 14, 15
            ired& = 170
            igreen& = 180
            iblue& = 150
        Case 16
            ired& = 200
            igreen& = 200
            iblue& = 23
    End Select
    irishigh = _RGB32(ired&, igreen&, iblue&)
    irismid = _RGB32(ired& * .8, igreen& * .8, iblue& * .8)
    irislow = _RGB32(ired& * .6, igreen& * .6, iblue& * .6)
    irisfleck = _RGB32(ired& * .6 + Rnd * ired& * .2, igreen * .6 + Rnd * igreen& * .2, iblue * .6 + Rnd * iblue& * .2)


    Line (0, 0)-(_Width, _Height), _RGB32(sred& * .9, sgreen& * .9, sblue& * .9), BF
    irad = _Width * .15 + Rnd * 6
    prad = _Width * .04 + Rnd * (irad * .2)
    eyewhite = _RGB32(255 - Rnd * 4, 255 - Rnd * 4, 255 - Rnd * 4)

    Circle (ex, ey), irad * 2.5, _RGB32(sred& * .67, sgreen& * .67, sblue& * .67), , , .8
    Paint (ex, ey), _RGB32(sred& * .67, sgreen& * .67, sblue& * .67), _RGB32(sred& * .67, sgreen& * .67, sblue& * .67)

    Line (0, 0)-(_Width, ey), _RGB32(sred& * .9, sgreen& * .9, sblue& * .9), BF

    Circle (ex, ey), irad * 2.5, skintonemid, , , .7
    Paint (ex, ey), skintonemid, skintonemid
    For ir = irad * 1.2 To irad * 2.5 Step (4 + Rnd * 6)
        Circle (ex, ey), ir, skintonehigh, .1, 3.0, 0.7
    Next ir

    For ir = irad * 2.5 To irad * 1.4 Step -(4 + Rnd * 6)
        Circle (ex, ey), ir, skintonelow, 3.2, 0, 0.7
    Next ir

    Line (ex - irad * 2.5, ey)-(ex - irad * .165, ey - irad + 2), eyewhite
    Line -(ex + irad * .165, ey - irad + 2), eyewhite
    Line -(ex + irad * 2.5, ey), eyewhite
    Line (ex - irad * 2.5, ey)-(ex - irad * .165, ey + irad - 2), eyewhite
    Line -(ex + irad * .165, ey + irad - 2), eyewhite
    Line -(ex + irad * 2.5, ey), eyewhite
    Paint (ex, ey), eyewhite, eyewhite
    circleBF ex, ey, irad, irislow
    polyT ex + 2, ey - 2, irad * .9, irismid, Int(8 + Rnd * 20)
    circleBF ex + 4, ey - 4, irad * .75, irishigh
    polyT ex, ey, prad * ((105 + Rnd * 20) / 100), irislow, Int(8 + Rnd * 20)
    circleBF ex, ey, prad, _RGB32(Int(Rnd * 9), Int(Rnd * 2), Int(Rnd * 4))

    For deg = 0 To 360 Step (1 + Rnd * 6)
        x2 = irad * .9 * Sin(0.01745329 * deg)
        y2 = irad * .9 * Cos(0.01745329 * deg)
        Line (ex, ey)-(ex + x2, ey + y2), irislow
    Next deg

    circleBF ex + prad, ey - prad, (irad * .6) - prad * .5, _RGB32(255, 255, 255, 40)
    circleBF ex, ey, prad, _RGB32(Int(Rnd * 9), Int(Rnd * 2), Int(Rnd * 4))


    Do
        _Limit 20
        ask$ = InKey$
    Loop Until ask$ <> ""

Loop Until ask$ = Chr$(27)




Sub circleBF (cx As Long, cy As Long, r As Long, klr As _Unsigned Long)
    rsqrd = r * r
    y = -r
    While y <= r
        x = Sqr(rsqrd - y * y)
        Line (cx - x, cy + y)-(cx + x, cy + y), klr, BF
        y = y + 1
    Wend
End Sub
Sub polyT (cx As Long, cy As Long, r As Long, klr As _Unsigned Long, deg As Long)
    setklr klr
    d = 0
    x = r * Sin(0)
    y = r * Cos(0)
    While d < 360
        d = d + deg
        x2 = r * Sin(0.01745329 * d)
        y2 = r * Cos(0.01745329 * d)
        _MapTriangle (0, 2)-(2, 2)-(2, 0), pk& To(cx, cy)-(cx + x, cy + y)-(cx + x2, cy + y2)
        x = x2
        y = y2
    Wend
End Sub
Sub setklr (klr As _Unsigned Long)
    _Dest pk&
    Line (0, 0)-(2, 2), klr, BF
    _Dest 0
End Sub
Sub fatline (x0, y0, x1, y1, r, klr As _Unsigned Long)
    If Abs(y1 - y0) < Abs(x1 - x0) Then
        If x0 > x1 Then
            fatlineLow x1, y1, x0, y0, r, klr

        Else
            fatlineLow x0, y0, x1, y1, r, klr
        End If
    Else
        If y0 > y1 Then
            fatlineHigh x1, y1, x0, y0, r, klr
        Else
            fatlineHigh x0, y0, x1, y1, r, klr
        End If
    End If
End Sub
Sub fatlineLow (x0, y0, x1, y1, r, klr As _Unsigned Long)
    dx = x1 - x0
    dy = y1 - y0
    yi = 1
    If dy < 0 Then
        yi = -1
        dy = -dy
    End If
    'D = (2 * dy) - dx
    d = (dy + dy) - dx
    y = y0
    For x = x0 To x1
        circleBF x, y, r, klr
        If d > 0 Then
            y = y + yi
            ' D = D + (2 * (dy - dx))
            d = d + ((dy - dx) + (dy - dx))
        Else
            ' D = D + 2 * dy
            d = d + dy + dy
        End If
    Next x
End Sub
Sub fatlineHigh (x0, y0, x1, y1, r, klr As _Unsigned Long)
    dx = x1 - x0
    dy = y1 - y0
    xi = 1
    If dx < 0 Then
        xi = -1
        dx = -dx
    End If
    ' D = (2 * dx) - dy
    D = (dx + dx) - dy
    x = x0
    For y = y0 To y1
        circleBF x, y, r, klr
        If D > 0 Then
            x = x + xi
            ' D = D + (2 * (dx - dy))
            D = D + ((dx - dy) + (dx - dy))
        Else
            ' D = D + 2 * dx
            D = D + dx + dx
        End If
    Next y
End Sub

Print this item

  Big Symmetrical Tree
Posted by: SierraKen - 09-04-2022, 03:28 AM - Forum: Programs - Replies (3)

Well, not exactly symmetrical, but close. So I call it: A Big Tree.


[Image: A-Big-Tree-app.jpg]



Code: (Select All)
'Big Tree by SierraKen - September 3, 2022.
'Feel free to use this in any code.
'The screen cannot have _RGB32(255, 125, 127) or _RGB32(255, 127, 127) because they use that for points as a plot value.
Screen _NewImage(1000, 600, 32)
_Title "A Big Tree"
start:
_Limit 20
Cls
'sky
blue = 75
For y = 0 To 500
    blue = blue + .5
    Line (0, y)-(1000, y), _RGB32(0, 0, blue)
Next y
blue = 0
'Ground
green = 75
For y = 501 To 600
    green = green + 2
    Line (0, y)-(1000, y), _RGB32(0, green, 0)
Next y
green = 0
Line (499, 500)-(501, 480), _RGB32(255, 127, 127), BF
PSet (500, 480), _RGB32(255, 125, 127)
limbsy = 490
size = 115
seconds = 12
seconds2 = 48
For stories = 1 To 6
    size = size - 1.5
    For yy = 0 To 600
        For xx = 0 To 1000
            If Point(xx, yy) = _RGB32(255, 125, 127) Then
                seconds = seconds - .25
                seconds2 = seconds2 + .25
                limbsx = xx
                limbsy = yy
                s = (60 - seconds) * 6 + 180
                x = Int(Sin(s / 180 * 3.141592) * size) + limbsx
                y = Int(Cos(s / 180 * 3.141592) * size) + limbsy
                Line (limbsx + b, limbsy)-(x + b, y), _RGB32(255, 127, 127)
                PSet (x, y), _RGB32(255, 125, 127)
                s = (60 - seconds2) * 6 + 180
                x = Int(Sin(s / 180 * 3.141592) * size) + limbsx
                y = Int(Cos(s / 180 * 3.141592) * size) + limbsy
                Line (limbsx, limbsy)-(x, y), _RGB32(255, 127, 127)
                PSet (x, y), _RGB32(255, 125, 127)
            End If
        Next xx
    Next yy
Next stories
For leaves = 1 To 60000
    leafx = Rnd * 1000
    leafy = Rnd * 480
    If Point(leafx, leafy) = _RGB32(255, 127, 127) Then
        For sz = .25 To 4 Step .25
            Circle (leafx, leafy + 4), sz, _RGB32(0, 255, 0), , , 2.5
        Next sz
    End If
Next leaves

Do:
    _Limit 20
    a$ = InKey$
    If a$ = Chr$(27) Then End
Loop

Print this item

  Phoenix Edition v3.1 released!
Posted by: SMcNeill - 09-04-2022, 02:46 AM - Forum: Announcements - Replies (36)

An update that I'm happy to announce, with lots of changes for people to enjoy -- version 3.1 has been released!

Quote:https://github.com/QB64-Phoenix-Edition/...tag/v3.1.0 See GitHub link for full release notes. 

Enhancements
 - New audio backend using miniaudio
- Miniaudio and a few other libraries have replaced the OpenAL-based audio backend that was previously used. - This fixes licensing concerns with using OpenAL, which was LGPL licensed. - Newly supported formats include flac, mod, s3m, xm, it, rad
. - Image backend enhancements - Support for pcx images was added.
 - _LOADIMAGE was improved to support loading 256-color images.
 - Add _ROR & _ROL support. 

Bug Fixes
  - Use -no-pie on Linux, fixes running compiled executables from file browsers
  - Remove DPI Awareness on Windows, QB64 executables will properly scale based on the OS setting 


Full Changelog: https://github.com/QB64-Phoenix-Edition/...0...v3.1.0

So what's this mean for you guys, as our users?  

For starters, the image library was more or less replaced completely.  We now offer support for both PCX images and 256 color images with _LOADIMAGE.  Even more importantly, as far as most of you guys are concerned, I'm certain:  We now load images much faster than previously!  "How much faster", you ask?  That depends on the image type in particular, but I imagine nearly every type should see somewhere between a 20% - 50% reduction in load times.

We offer more image formats, and we load them faster than ever!  What's not to love about that??

On top of this change, the sound libraries were replaced and redone.  We no longer link to the evil library which required a LGPL License when in use.  You can now use sound and enjoy a more more lenient license.  (Read the license file for a fell breakdown and detail of everything, please.)  We've also expanded formats which we support with our sound library, and we should have corrected the issue with stereo sound only coming from a single monochannel speaker.

Linux users should no longer have the issues of QB64 programs not running if they click on them in the file explorer.

Windows users should no longer have issues with windows not scaling to match DPI Awareness settings on high resolution screens.

Everyone should now be able to enjoy the new _ROR and _ROL, which are used for bit rotation right and left.  (Rotate Right = RoR, Rotate Left = RoL).

Download can be grabbed from here: Release v3.1.0 · QB64-Phoenix-Edition/QB64pe (github.com)

Print this item

  Nonsense Forest
Posted by: James D Jarvis - 09-03-2022, 09:22 PM - Forum: Programs - Replies (5)

I got inspired by other folks tree programs  and decided to spend part of my birthday making one to share.
Mostly new code aside from a few subs I may or may not have shared in the past.

Code: (Select All)
'nonsense_forest
'it's my birthday so I made some fun colorful code to share
'
'$dynamic

Screen _NewImage(1000, 600, 32)
_Title "Nonsense Forest - Press any key for another forest - Esc to end"
Randomize Timer
Dim Shared rootx, trunkl, twidth
Dim bx(0, 0) As Integer, by(0, 0) As Integer, bwid(0) As Integer, blen(0) As Integer
Do
    _Limit 20
    Cls
    skyr = 200 - Rnd * (20): skyg = 220 - Rnd * 20: skyb = 255 - Rnd * 20
    For y = 0 To _Height * .65
        Line (0, y)-(_Width, y), _RGB32(skyr, skyg, skyb)
        skyr = skyr - .5: skyg = skyg - .25: skyb = skyb - .12
    Next y
    grr = 20 + Rnd * 10: grg = 20 + Rnd * 10: grb = 20 + Rnd * 20
    For y = _Height * .648 To _Height

        Line (0, y)-(_Width, y), _RGB32(grr, grg, grb)
        grr = grr - .5: grg = grg + 1: grb = grb + .2

    Next y

    rootx = 0
    rooty = _Height * .67

     trees = Int(12 + Rnd * 36)
    'trees = 3
    For treecount = 1 To trees
        branch = Int(2 + Rnd * 8)
        ' Do
        ' _Limit 20
        ' Input "branch stages ? (2 to 12) ", branch

        'Loop Until branch > 1 And branch < 13
        ReDim bx(branch, 2 ^ branch) As Integer
        ReDim by(branch, 2 ^ branch) As Integer
        ReDim bwid(branch)
        ReDim blen(branch)
        rootx = rootx + 12 + (Rnd * 24) * 10
        If rootx > _Width * .9 Then
            rootx = _Width * .1 + Rnd * 10
            rooty = rooty + _Height * .1 + Rnd * 24
        End If
        rooty = rooty + Rnd * 5 - Rnd * 5

        twid = Int((8 + Rnd * 10) / 2)
        trunk = _Height / (branch + 10)
        bx(1, 1) = rootx
        by(1, 1) = rooty - trunk
        bwid(1) = twid
        blen(1) = trunk

        klr = _RGB32(50 + Rnd * 200, 100 + Rnd * 150, 100 + Rnd * 150)
        bumpyline rootx, rooty, bx(1, 1), by(1, 1), bwid(1), klr
        For n = 2 To branch
            bwid(n) = bwid(n - 1) * .75
            If bwid(n) < 0.5 Then bwid(n) = 0.5
            blen(n) = blen(n - 1) / 2 + Rnd * (blen(n - 1) * .75)
            If blen(n) < trunk * .2 Then blen(n) = trunk
            For b = 1 To 2 ^ (n - 1)

                x1 = bx(n - 1, (b + 1) \ 2)
                y1 = by(n - 1, (b + 1) \ 2)
                If b Mod 2 = 0 Then
                    x2 = x1 + blen(n - 1) / 2 + Rnd * blen(n)
                Else
                    x2 = x1 - blen(n - 1) / 2 - Rnd * blen(n)
                End If
                y2 = y1 - (blen(n) / 2 + Rnd * blen(n))
                bx(n, b) = x2
                by(n, b) = y2
                If b > 1 Then
                    If bx(n, b) = bx(n, b - 1) And by(n, b) = by(n, b - 1) Then
                        If bx(n, b) > rootx Then
                            bx(n, b) = bx(n, b) + blen(n - 1) / 4 + Rnd * blen(n - 1)
                            by(n, b) = by(n, b) + blen(n - 1) / 4 + Rnd * blen(n - 1)
                        Else
                            bx(n, b) = bx(n, b) - blen(n - 1) / 4 + Rnd * blen(n - 1)
                            by(n, b) = by(n, b) + blen(n - 1) / 4 + Rnd * blen(n - 1)

                        End If
                    End If
                End If

            Next b
        Next n
        fr = Int(1 + Rnd * 200): fg = Int(1 + Rnd * 200): fb = Int(1 + Rnd * 200)
        x1 = bx(branch, 1): x2 = bx(branch, 2 ^ branch)
        'Print x1, x2
        y1 = by(branch, 2): y2 = by(branch, 2 ^ branch)
        avX = (x1 + x2) / 2: avy = (y1 + y2) / 2

        ' For t = 1 To branch * 3
        'polyT avX, avy, Int(10 + Rnd * 50), _RGB32(fr + Int(Rnd * 12), fg + Int(Rnd * 12), fb + Int(Rnd * 12)), Int(31 + Rnd * 140)
        ' Next t

        jagmuch = Int(Rnd * 5)
        jagx = Int(3 + Rnd * 10)
        jagy = Int(3 + Rnd * 10)

        For n = 1 To branch - 1
            For b = 1 To 2 ^ (n - 1)
                If n = branch - 1 Then
                    polyT bx(n + 1, b * 2 - 1), by(n + 1, b * 2 - 1), bwid(n) * 10 + Rnd * (bwid(n) * 5), _RGB32(fr + Rnd * 30, fg + Rnd * 30, fb + Rnd * 30), Int(11 + Rnd * 140)
                    polyT bx(n + 1, b * 2), by(n + 1, b * 2), bwid(n) * 10 + Rnd * (bwid(n) * 5), _RGB32(fr + Rnd * 30, fg + Rnd * 30, fb + Rnd * 30), Int(11 + Rnd * 140)

                End If

                If jagmuch < 2 Then

                    bumpyline bx(n, b), by(n, b), bx(n + 1, b * 2 - 1), by(n + 1, b * 2 - 1), bwid(n), klr
                    bumpyline bx(n, b), by(n, b), bx(n + 1, b * 2), by(n + 1, b * 2), bwid(n), klr
                Else
                    jx = bx(n, b)
                    jy = by(n, b)
                    For j = 2 To jagmuch
                        jx2 = jx + Int(Rnd * jagx) - Int(Rnd * jagx)
                        jy2 = jy + Int(Rnd * jagy) / 2 - Int(Rnd * jagy)
                        bumpyline jx, jy, jx2, jy2, bwid(n), klr
                        jy = jy2
                        jx = jx2
                    Next j
                    bumpyline jx, jy, bx(n + 1, b * 2 - 1), by(n + 1, b * 2 - 1), bwid(n), klr

                    jx = bx(n, b)
                    jy = by(n, b)
                    For j = 2 To jagmuch
                        jx2 = jx + Int(Rnd * jagx) - Int(Rnd * jagx)
                        jy2 = jy + Int(Rnd * jagy) / 2 - Int(Rnd * jagy)
                        bumpyline jx, jy, jx2, jy2, bwid(n), klr
                        jy = jy2
                        jx = jx2
                    Next j
                    bumpyline jx, jy, bx(n + 1, b * 2), by(n + 1, b * 2), bwid(n), klr



                End If


                If n = branch - 1 Then
                    cxa = bx(n + 1, b * 2 - 1)
                    cya = by(n + 1, b * 2 - 1)

                    cxb = bx(n + 1, b * 2)
                    cyb = by(n + 1, b * 2)
                    tuftlim = Int(12 + Rnd * 12)
                    For tufts = 3 To tuftlim
                        cx = cxa + Rnd * (bwid(n) * 8) - Rnd * (bwid(n) * 8)
                        cy = cya + Rnd * (bwid(n) * 8) - Rnd * (bwid(n) * 8)
                        rf = fr + Int(Rnd * 30): gf = fg + Int(Rnd * 30): bf = fb + Int(Rnd * 30)
                        If cx > bx(n + 1, b) Then
                            rf = rf + 10
                            gf = gf + 20
                            bf = bf + 10
                        End If
                        r = 12 + Rnd * (bwid(n) * 5)
                        ' circleBF cx, cy, r, _RGB32(rf, gf, bf)
                        polyT cx, cy, r, _RGB32(rf, gf, bf), Int(31 + Rnd * 140)
                    Next
                    For tufts = 3 To tuftlim
                        cx = cxb + Rnd * (bwid(n) * 8) - Rnd * (bwid(n) * 8)
                        cy = cyb + Rnd * (bwid(n) * 8) - Rnd * (bwid(n) * 8)
                        rf = fr + Int(Rnd * 30): gf = fg + Int(Rnd * 30): bf = fb + Int(Rnd * 30)
                        If cx > bx(n + 1, b) Then
                            rf = rf + 10
                            gf = gf + 20
                            bf = bf + 10
                        End If
                        r = 12 + Rnd * (bwid(n) * 5)
                        'circleBF cx, cy, r, _RGB32(rf, gf, bf)
                        polyT cx, cy, r, _RGB32(rf, gf, bf), Int(31 + Rnd * 140)
                    Next


                End If
            Next b


        Next n
    Next treecount
    Do
        _Limit 20
        ask$ = InKey$
    Loop Until ask$ <> ""
Loop Until ask$ = Chr$(27)


Sub bumpyline (x0, y0, x1, y1, r, klr As _Unsigned Long)
    If Abs(y1 - y0) < Abs(x1 - x0) Then
        If x0 > x1 Then
            bumpylineLow x1, y1, x0, y0, r, klr

        Else
            bumpylineLow x0, y0, x1, y1, r, klr
        End If
    Else
        If y0 > y1 Then
            bumpylineHigh x1, y1, x0, y0, r, klr
        Else
            bumpylineHigh x0, y0, x1, y1, r, klr
        End If
    End If
End Sub
Sub bumpylineLow (x0, y0, x1, y1, r, klr As _Unsigned Long)
    dx = x1 - x0
    dy = y1 - y0
    yi = 1
    If dy < 0 Then
        yi = -1
        dy = -dy
    End If
    'D = (2 * dy) - dx
    d = (dy + dy) - dx
    y = y0
    For x = x0 To x1
        nr = r + (1 * Rnd * (r / 2)) - (1 * Rnd(r / 2))
        circleBF x, y, nr, klr

        If d > 0 Then
            y = y + yi
            ' D = D + (2 * (dy - dx))
            d = d + ((dy - dx) + (dy - dx))
        Else
            ' D = D + 2 * dy
            d = d + dy + dy
        End If
    Next x
End Sub
Sub bumpylineHigh (x0, y0, x1, y1, r, klr As _Unsigned Long)
    dx = x1 - x0
    dy = y1 - y0
    xi = 1
    If dx < 0 Then
        xi = -1
        dx = -dx
    End If
    ' D = (2 * dx) - dy
    D = (dx + dx) - dy
    x = x0
    For y = y0 To y1
        nr = r + (1 * Rnd * (r / 2)) - (1 * Rnd(r / 2))
        circleBF x, y, nr, klr

        If D > 0 Then
            x = x + xi
            ' D = D + (2 * (dx - dy))
            D = D + ((dx - dy) + (dx - dy))
        Else
            ' D = D + 2 * dx
            D = D + dx + dx
        End If
    Next y
End Sub
Sub circleBF (cx As Long, cy As Long, r As Long, klr As _Unsigned Long)
    rsqrd = r * r
    y = -r
    While y <= r
        x = Sqr(rsqrd - y * y)
        Line (cx - x, cy + y)-(cx + x, cy + y), klr, BF
        y = y + 1
    Wend
End Sub

Sub polyT (cx As Long, cy As Long, r As Long, klr As _Unsigned Long, deg As Long)
    setklr klr
    d = 0
    x = r * Sin(0)
    y = r * Cos(0)
    While d < 360
        d = d + deg
        x2 = r * Sin(0.01745329 * d)
        y2 = r * Cos(0.01745329 * d)
        _MapTriangle (0, 2)-(2, 2)-(2, 0), pk& To(cx, cy)-(cx + x, cy + y)-(cx + x2, cy + y2)
        x = x2
        y = y2
    Wend
End Sub
Sub setklr (klr As Long)
    _Dest pk&
    Line (0, 0)-(2, 2), klr, BF
    _Dest 0
End Sub

Print this item

  Space Lander
Posted by: james2464 - 09-03-2022, 01:22 AM - Forum: Works in Progress - Replies (22)

Exploring moving/controlling an object etc...very fun project

No collisions yet, no sound.   Control with w, a, d keys 

Cheers

Code: (Select All)
'Lander
'james2464
'Sept 2 2022


Dim scx, scy As Integer


'screen size
scx = 1100 '    640 min --- 1600 max  made for 1100
scy = 600 '    480 min --- 700 max    made for 600

Screen _NewImage(scx, scy, 32)

Randomize Timer

Const PI = 3.141592654#




Dim c0(100) As Long

c0(0) = _RGB(0, 0, 0)
c0(1) = _RGB(255, 255, 255, 60)
c0(2) = _RGB(255, 0, 0)
c0(3) = _RGB(150, 150, 255)
c0(4) = _RGB(0, 200, 50)
c0(5) = _RGB(100, 100, 100)
c0(6) = _RGB(50, 50, 50)
c0(7) = _RGB(255, 50, 50)
c0(8) = _RGB(125, 125, 200)
c0(9) = _RGB(0, 125, 255)
c0(10) = _RGB(255, 200, 125)
c0(11) = _RGB(20, 20, 20)

c0(30) = _RGBA32(255, 255, 150, 160) 'ship exhaust
c0(31) = _RGBA32(255, 255, 150, 80) 'ship exhaust
c0(32) = _RGBA32(255, 255, 150, 40) 'ship exhaust
c0(33) = _RGBA32(255, 255, 150, 20) 'ship exhaust
c0(34) = _RGBA32(255, 220, 0, 200) 'ship exhaust
c0(35) = _RGBA32(255, 220, 0, 100) 'ship exhaust
c0(36) = _RGBA32(255, 220, 0, 70) 'ship exhaust
c0(37) = _RGBA32(255, 220, 0, 40) 'ship exhaust
c0(38) = _RGBA32(255, 220, 0, 10) 'ship exhaust
c0(39) = _RGBA32(255, 220, 0, 0) 'ship exhaust


Dim xx, yy
xx = scx / 2
yy = scy / 2

Type BB
    live As Integer
    x As Single
    y As Single
    xv As Single
    yv As Single
    age As Integer
    rad As Integer
    spd As Single
    colour As Integer
End Type

Dim bnb(900) As BB



Cls
'lower random landscape
j = 0
jj = 0
k = 170
Do
    j = j + 1
    jj = jj + 1
    If jj > 8 Then
        r = Int(Rnd * 5) - 2
        jj = 0
    End If
    k = k + r
    If k > 220 Then
        k = k - r
    End If
    If k < 120 Then
        k = k - r
    End If
    Line (j, scy - k)-(j, scy), c0(6)
Loop Until j >= scx

'upper random landscape
j = 0
jj = 0
k = scy / 6
Do
    j = j + 1
    jj = jj + 1
    If jj > 8 Then
        r = Int(Rnd * 5) - 2
        jj = 0
    End If
    k = k + r
    If k > (scy / 5) Then
        k = k - r
    End If
    If k < scy / 9 Then
        k = k - r
    End If
    Line (j, 0)-(j, k), c0(6)
Loop Until j >= scx



'===== ground
Line (0, scy - 20)-(scx, scy), c0(5), BF

'===== right wall
Line (scx - 40, 0)-(scx, scy - 20), c0(5), BF

'===== left wall
Line (0, 0)-(40, scy - 20), c0(5), BF

'===== pad 1
Line (100, yy)-(200, scy - 80), c0(0), BF
Line (100, scy - 80)-(200, scy - 78), c0(4), BF

'===== pad 2
Line (280, yy)-(355, scy - 50), c0(0), BF
Line (280, scy - 50)-(355, scy - 48), c0(4), BF

'===== pad 3
Line (380 + (scx - 480) / 6, yy)-(430 + (scx - 480) / 6, scy - 90), c0(0), BF
Line (380 + (scx - 480) / 6, scy - 90)-(430 + (scx - 480) / 6, scy - 88), c0(4), BF

'===== pad 4
Line (scx - 120, yy)-(scx - 160, scy - 50), c0(0), BF
Line (scx - 120, scy - 50)-(scx - 160, scy - 48), c0(4), BF


'Sleep



'===== parameters
flow = 1
dv = .033 '              time delay value
pt = 2 '                point size aka circle size
fan = 30 ' fountain fan size
cc1 = 1 '              colour 1
cc2 = 4 '              colour 2
ls = 4 ' launch speed
Dim blive, maxb As Integer

blive = 1
maxb = 1
flip = 0

stx = scx - 140
sty = scy - 70

bnb(1).live = 1
bnb(1).colour = 3

bnb(1).x = stx
bnb(1).y = sty

j = 1

'======== main loop
Do

    flag = 0
    Do



        'update screen

        'erase ship
        cc = 0
        Line (bnb(j).x - 16, bnb(j).y - 15)-(bnb(j).x + 16, bnb(j).y + 19), c0(cc), BF



        'find what's changed before drawing ship again

        'what colour pixels are beneath the ship?
        'if not black, then it has touched down or collided
        c0(99) = Point(bnb(j).x, bnb(j).y + 20)
        If c0(99) <> c0(0) Then
            ccflag = 1 'contact
        Else
            ccflag = 0 'no contact
        End If

        gravityadd = .03
        bnb(j).yv = bnb(j).yv + gravityadd




        If ccflag = 0 Then 'if ship is flying


            '===============  player input
            If _KeyDown(119) Then
                bnb(j).yv = bnb(j).yv - .2
                fire = 1
            End If
            If bnb(j).yv > 10 Then bnb(j).yv = 10
            If bnb(j).yv < -10 Then bnb(j).yv = -10

            If _KeyDown(97) Then
                bnb(j).xv = bnb(j).xv - .1
                fire = 2
            End If
            If bnb(j).xv < -5 Then bnb(j).xv = -5


            If _KeyDown(100) Then
                bnb(j).xv = bnb(j).xv + .1
                fire = 3
            End If
            If bnb(j).xv > 5 Then bnb(j).xv = 5


            cc = 3 'normal ship colour
            'if ship is not landed anywhere
            bnb(j).x = bnb(j).x + bnb(j).xv
            bnb(j).y = bnb(j).y + bnb(j).yv
            If bnb(j).x < 50 Then bnb(j).x = 50
            If bnb(j).x > scx - 50 Then bnb(j).x = scx - 50
            If bnb(j).y < 10 Then bnb(j).y = 10
            If bnb(j).y > scy - 30 Then bnb(j).y = scy - 30

            'ship
            Line (bnb(j).x - 3, bnb(j).y - 15)-(bnb(j).x + 3, bnb(j).y - 14), c0(cc), BF
            Line (bnb(j).x - 5, bnb(j).y - 13)-(bnb(j).x + 5, bnb(j).y - 11), c0(cc), BF
            Line (bnb(j).x - 6, bnb(j).y - 10)-(bnb(j).x + 6, bnb(j).y + 4), c0(cc), BF
            Line (bnb(j).x - 6, bnb(j).y - 12)-(bnb(j).x - 16, bnb(j).y + 19), c0(cc)
            Line (bnb(j).x + 6, bnb(j).y - 12)-(bnb(j).x + 16, bnb(j).y + 19), c0(cc)
            Line (bnb(j).x - 16, bnb(j).y + 19)-(bnb(j).x - 6, bnb(j).y + 4), c0(cc)
            Line (bnb(j).x + 16, bnb(j).y + 19)-(bnb(j).x + 6, bnb(j).y + 4), c0(cc)
            Line (bnb(j).x - 1, bnb(j).y + 5)-(bnb(j).x + 1, bnb(j).y + 5), c0(cc) 'engine
            Line (bnb(j).x - 2, bnb(j).y + 6)-(bnb(j).x + 2, bnb(j).y + 6), c0(cc) 'engine
            Line (bnb(j).x - 3, bnb(j).y + 7)-(bnb(j).x + 3, bnb(j).y + 7), c0(cc) 'engine
            'ship exhaust
            If fire = 1 Then
                cc = 30
                Line (bnb(j).x - 2, bnb(j).y + 8)-(bnb(j).x + 2, bnb(j).y + 9), c0(30), BF
                Line (bnb(j).x - 2, bnb(j).y + 10)-(bnb(j).x + 2, bnb(j).y + 10), c0(31), BF
                Line (bnb(j).x - 2, bnb(j).y + 11)-(bnb(j).x + 2, bnb(j).y + 12), c0(32), BF
                Line (bnb(j).x - 2, bnb(j).y + 13)-(bnb(j).x + 2, bnb(j).y + 15), c0(33), BF
                'PSet (bnb(j).x, bnb(j).y + 16), c0(33)
            ElseIf fire = 2 Then
                cc = 31
                Line (bnb(j).x + 7, bnb(j).y - 5)-(bnb(j).x + 12, bnb(j).y - 4), c0(cc), BF
            ElseIf fire = 3 Then
                cc = 31
                Line (bnb(j).x - 7, bnb(j).y - 5)-(bnb(j).x - 12, bnb(j).y - 4), c0(cc), BF
            End If
            fire = 0



        Else 'ship is touching down
            '===============  player input
            If _KeyDown(119) Then
                bnb(j).yv = bnb(j).yv - .2
                fire = 1
            End If
            If bnb(j).yv > 10 Then bnb(j).yv = 10
            If bnb(j).yv < -10 Then bnb(j).yv = -10

            'If _KeyDown(97) Then bnb(j).xv = bnb(j).xv - .1
            'If _KeyDown(100) Then bnb(j).xv = bnb(j).xv + .1
            'If bnb(j).xv > 5 Then bnb(j).xv = 5
            'If bnb(j).xv < -5 Then bnb(j).xv = -5

            cc = 3 'ship landed alt colour
            'if ship is landed
            bnb(j).xv = bnb(j).xv * .6 'cancel out most of existing x velocity
            If bnb(j).yv > 0 Then bnb(j).yv = 0 'cancel y velocity if heading down

            bnb(j).x = bnb(j).x + bnb(j).xv
            bnb(j).y = bnb(j).y + bnb(j).yv 'since y velocity can only be upward, go for it
            If bnb(j).x < 50 Then bnb(j).x = 50
            If bnb(j).x > scx - 50 Then bnb(j).x = scx - 50
            If bnb(j).y < 10 Then bnb(j).y = 10
            If bnb(j).y > scy - 30 Then bnb(j).y = scy - 30

            'ship
            Line (bnb(j).x - 3, bnb(j).y - 15)-(bnb(j).x + 3, bnb(j).y - 14), c0(cc), BF
            Line (bnb(j).x - 5, bnb(j).y - 13)-(bnb(j).x + 5, bnb(j).y - 11), c0(cc), BF
            Line (bnb(j).x - 6, bnb(j).y - 10)-(bnb(j).x + 6, bnb(j).y + 4), c0(cc), BF
            Line (bnb(j).x - 6, bnb(j).y - 12)-(bnb(j).x - 16, bnb(j).y + 19), c0(cc)
            Line (bnb(j).x + 6, bnb(j).y - 12)-(bnb(j).x + 16, bnb(j).y + 19), c0(cc)
            Line (bnb(j).x - 16, bnb(j).y + 19)-(bnb(j).x - 6, bnb(j).y + 4), c0(cc)
            Line (bnb(j).x + 16, bnb(j).y + 19)-(bnb(j).x + 6, bnb(j).y + 4), c0(cc)
            Line (bnb(j).x - 1, bnb(j).y + 5)-(bnb(j).x + 1, bnb(j).y + 5), c0(cc) 'engine
            Line (bnb(j).x - 2, bnb(j).y + 6)-(bnb(j).x + 2, bnb(j).y + 6), c0(cc) 'engine
            Line (bnb(j).x - 3, bnb(j).y + 7)-(bnb(j).x + 3, bnb(j).y + 7), c0(cc) 'engine


            'ship exhaust
            If fire = 1 Then
                cc = 30
                Line (bnb(j).x - 2, bnb(j).y + 8)-(bnb(j).x + 2, bnb(j).y + 9), c0(30), BF
                Line (bnb(j).x - 2, bnb(j).y + 10)-(bnb(j).x + 2, bnb(j).y + 10), c0(31), BF
                Line (bnb(j).x - 2, bnb(j).y + 11)-(bnb(j).x + 2, bnb(j).y + 12), c0(32), BF
                Line (bnb(j).x - 2, bnb(j).y + 13)-(bnb(j).x + 2, bnb(j).y + 15), c0(33), BF
                'PSet (bnb(j).x, bnb(j).y + 16), c0(33)
            End If
            fire = 0

        End If


        blink = blink + 1
        If blink < 25 Then
            bk = 0
        End If
        If blink > 24 Then
            bk = 2
        End If
        If blink > 50 Then blink = 0

        If ccflag = 0 Then
            Line (bnb(j).x - 1, bnb(j).y - 10)-(bnb(j).x + 1, bnb(j).y - 8), c0(bk), BF
        Else
            Line (bnb(j).x - 1, bnb(j).y - 10)-(bnb(j).x + 1, bnb(j).y - 8), c0(4), BF
        End If

        _Delay dv
    Loop Until flag = 1



Loop


End

Print this item

  a TON of source code and projects archived from PlanetSourceCode.com
Posted by: madscijr - 09-02-2022, 10:41 PM - Forum: General Discussion - Replies (25)

Remember Planetsourcecode.com and all the VB4,5,6 projects there? 

Well, someone backed up a good chunk of it, and put it on github, categorized, and with the original program descriptions / screenshots / ZIP files / etc. 

This will take days / weeks / months to go through, but I am seeing some really neat stuff there. 

The classic VB stuff alone will provide plenty of ideas for future QB64 projects, algorithms, etc., so I just wanted to post the URL for anyone interested. 

Index: https://github.com/Planet-Source-Code/PSCIndex

By Category: https://github.com/Planet-Source-Code/PS...ByCategory

  1. Submissions by Worlds
  2. Submissions by Categories
  3. Submissions by Authors
  4. All Time Best Code/Article/Tutorial Hall of Fame
  5. All Submissions (with Search)

By language ("worlds"):

World (# Categories) (# Submissions)
Visual Basic (27) (15222)
C / C++ (25) (415)
ASP / VbScript (24) (326)
Java (26) (271)
.Net (C#, VB.net) (21) (226)
PHP (19) (144)
Delphi (14) (51)

Enjoy and have a great weekend...

Print this item

  Tree Maker
Posted by: SierraKen - 09-02-2022, 06:32 PM - Forum: Programs - Replies (4)

I know B+ has made a better one awhile back, but I've wanted to make one of these myself for years and FINALLY did it!!
It doesn't add leaves but it makes the trunk and random branches. And the land line. 
It finally came to me this morning to just use PSET color plot points and to loop it and at every loop it also scans to find those PSET color plot points. 
It's very simple if you take a look at the code and play around with it. Smile 
In the comments I added the PSET color not to use anywhere else on the screen for your own programs since that's where it needs those points. In the code I put where you can play around with other numbers on 2 lines. 

Press the Space Bar to make another random tree. 
The funny thing is, I was trying to do this yesterday but ended up making the Tesla Coil instead. Big Grin 


[Image: Tree-Maker-by-Sierra-Ken.jpg]



Code: (Select All)
'Tree Maker by SierraKen - September 2, 2022.
'Feel free to use this in any code.
'The screen cannot have _RGB32(255, 125, 127) because it uses that PSET point as a plot value.
Screen _NewImage(800, 600, 32)
_Title "Tree Maker - Press Space Bar for another tree - Esc to end"
start:
_Limit 20
Cls
Line (0, 500)-(800, 500), _RGB32(127, 255, 127)
Line (397, 500)-(403, 480), _RGB32(255, 127, 127), BF
PSet (400, 480), _RGB32(255, 125, 127)
limbsy = 490
size = 60
For stories = 1 To 5 '<<<<<<< Experiment with this number.
    size = size - 3 '<<<<<<< Experiment with this number.
    For yy = 0 To 600
        For xx = 0 To 800
            If Point(xx, yy) = _RGB32(255, 125, 127) Then
                limbsx = xx
                limbsy = yy
                seconds = (Rnd * 8) + 5
                s = (60 - seconds) * 6 + 180
                x = Int(Sin(s / 180 * 3.141592) * size) + limbsx
                y = Int(Cos(s / 180 * 3.141592) * size) + limbsy
                For b = 2 To -2 Step -.1
                    Line (limbsx + b, limbsy)-(x + b, y), _RGB32(255, 127, 127)
                    Line (limbsx + b, limbsy)-(x + b, y), _RGB32(255, 127, 127)
                Next b
                PSet (x, y), _RGB32(255, 125, 127)
                seconds = (Rnd * 9) + 47
                s = (60 - seconds) * 6 + 180
                x = Int(Sin(s / 180 * 3.141592) * size) + limbsx
                y = Int(Cos(s / 180 * 3.141592) * size) + limbsy
                For b = 2 To -2 Step -.1
                    Line (limbsx + b, limbsy)-(x + b, y), _RGB32(255, 127, 127)
                    Line (limbsx + b, limbsy)-(x + b, y), _RGB32(255, 127, 127)
                Next b
                PSet (x, y), _RGB32(255, 125, 127)
            End If
        Next xx
    Next yy
Next stories
Do:
    _Limit 20
    a$ = InKey$
    If a$ = " " Then GoTo start:
    If a$ = Chr$(27) Then End
Loop

Print this item

  Call a video from QB64
Posted by: Kernelpanic - 09-02-2022, 05:06 PM - Forum: General Discussion - Replies (3)

Actually, no new routine for calling a video has to be worked into QB64, it can also be done that way. 
One can call a program for playing videos created in Visual Basic with "Run" from QB64. In the example, programs and video are in the same directory, but this is not necessary.

Let's see if you can also call up a player directly. Would be even easier.  Rolleyes

Code: (Select All)
'VisualBasic Videoprogramm aufrufen - 2. Sept. 2022

Print
Print "Ruft ein VisualBasic Programm zum Abspielen von Videos auf."
Print
Print "Weiter mit beliebiger Taste . . ."
Do
Loop While InKey$ = ""

'Aufruf des VB-Programms
Run "Video-abspielen.exe"

End

[Image: Video-aus-QB64-2022-09-02.jpg]

Print this item

  "Well I don't give a damn about my bad reputation."
Posted by: TDarcos - 09-02-2022, 04:44 PM - Forum: General Discussion - Replies (16)

"Well I don't give a damn about my bad reputation."

- Joan Jett, Bad Reputation



Basic has gotten a bad reputation, some of it deserved, some of it "sneering" by people who use "real" programming languages. Or they don't know, or don't realize, the Basic languages of today "are not your father's Basic." Let's look at some of the criticisms people have of basic.

  • Requires line numbers. Basic hasn't "required" line numbers for over 30 years. Most of the "world-class" compilers (and interpreters) support line numbers if needed, but labels may be used. It is entirely possible to write functional Basic programs without needing line numbers or labels.
  • Only allows short (1 or 2 character variable names). This restriction hasn't been present in Basic for over 40 years. And variables can include the underline _ as a separator.
  • Variables have to be identified by a type symbol, e.g. % for integer, $ for string, etc. This is done as a convenience, so variables can be "defined" when used, and the compiler will know what the variable is used for. It is also provided for backward compatibility. You can declare a variable as a certain type before use, (e.g. DEFINE MyName AS STRING), declare certain variables beginning with certain letters have a default data type, and can even require all variables be declared before use.
  • Requires declaring assignments by using "LET" as a prefix. Developments in scanning eliminated that requirement back in the 1970s. The LET keyword is kept strictly for backward compatibility.
  • Produces "spaghetti code." When programs were written on an "ad hoc" or "seat of the pants" methods, yes, you got programs that jumped all over the place, and had no consistency. But this was true of any language that lacked good control structures, had line labels, and no means other than  GOTO and IF statements to choose code paths. This includes C, Fortran and Cobol. It is possible, even when all Basic had for program control and branching were GOTO, GOSUB, and IF x THEN GOTO, to write structured or cohesive programs that were more-or-less consistent in using structure in code.
  • Weak or inadequate control structures. Basic has all the control structures supported by other high-level languages, including: WHILE, CASE, FOR, IF statement block, procedures (SUB) and functions.
  • Lacks support for structures or records. The TYPE statement allows creation of a structured record. Fields in a structure can be accessed using the standard variable.field notation.
  • You can't access external routines written in other languages. External routines can be called, and any of the common calling conventions may be used.
  • No database support. Since external routines can be accessed, any database system that provides a shared library for database access can be used.
  • Only supports short (<256 byte) strings. Basic supports virtually unlimited length of strings. I wrote a short (<10 line) program to double the length of a string on each iteration of a loop. After 26 iterations, I had concatenated a string that was over 130 million characters long. Not that you're likely to need to work with strings that long, it is trivially easy to handle 1K or 100K strings in a Basic program.
  • No dynamic memory. Basic supports pointers, creation of dynamically allocated structures (records) using the NEW keyword. Basic supports dynamic arrays that can be shrunk or expanded.
  • Is trivially easy to learn. This is a criticism? You can go online and find videos on YouTube to teach C++ in 10 hours. The fact that Basic can be picked up by a person not familiar with programming even faster than this does not mean the language is a "toy." Basic can and has been used to develop professional applications. It just happens to have a gentler learning curve than other programming languages is a strength, not a weakness. It also creates an advantage, in that once you learn one programming language, it's easier to pick up others. Basic's ease of use may make it appear to be less capable than other languages, but it is usable by professionals to actually accomplish real work.
  • Can't be used for GUI applications or anything other than for text applications. Some versions of Basic support Windows forms. One supports the WXWidgets GUI framework. Others support Windows WIN32 API, or other GUI frameworks. Most Basics support line drawing and other graphical image drawing functions.
In short, many people have misconceptions of Basic, based on reasons that are either flatly incorrect, or were fixed decades ago.

Print this item