Can this be sped up?   The code below calculates the first 45 anti-primes in ~6.3 seconds on my W11 PC. 
Definition of anti-primes: A natural number that has more divisors (factors, not just prime factors) than any number less that it. For example, 6 has 4 factors, including 1 and itself, and this is more than 1,2,3 or 5 which have only the minimum of 2 factors and 4 which has 3 factors.

'Anti-Primes: Calculate first 45 anti-primes

'date of code: 06 JUL 2023

'Space Ghost (modified QBasic 4.5 from Rosetta Code)



'HOUSEKEEPING -----------------------------------

$CONSOLE:ONLY

OPTION _EXPLICIT

CLS



'VARIABLE DECLARATIONS  -------------------------

DIM t AS DOUBLE

DIM tmp AS STRING

DIM AS INTEGER MaxAntiPrime, AntiPrimeCount

DIM AS LONG MaxDivisors, Divisors, n



'MAIN BLOCK  ------------------------------------

t = TIMER(0.001)



MaxAntiPrime = 45

n = 0

MaxDivisors = 0

AntiPrimeCount = 0



PRINT "The first 45 anti-primes are:"

PRINT



WHILE AntiPrimeCount < MaxAntiPrime

    n = n + 1

    Divisors = DivisorCount(n)

    IF Divisors > MaxDivisors THEN

        PRINT n;

        MaxDivisors = Divisors

        AntiPrimeCount = AntiPrimeCount + 1

    END IF

WEND



PRINT: PRINT

tmp = "Execution Time in secs:##.###"

PRINT USING tmp; TIMER(0.001) - t



END



'FUNCTIONS AND SUBROUTINES ----------------------

FUNCTION DivisorCount (v)

    DIM AS LONG total, count, n, p

    total = 1

    n = v

    WHILE n MOD 2 = 0

        total = total + 1

        n = n \ 2

    WEND

    p = 3

    WHILE (p * p) <= n

        count = 1

        WHILE n MOD p = 0

            count = count + 1

            n = n \ p

        WEND

        p = p + 2

        total = total * count

    WEND

    IF n > 1 THEN total = total * 2

    DivisorCount = total

END FUNCTION



'END OF PROGRAM  --------------------------------

Can somebody help me figure out the code to get a sprite to follow an ellipse? I've tried various methods with SIN() but can't quite pull it off, I am trying to recreate the effect in the attached gif

This is another program that would only display graphic silliness. Don't expected colored, fractal stuff; a program such as this might have been attempted with QuickBASIC or Turbo Pascal, trying to burn those weak single-core CPU's to a crisp. Many pictures are just an useless line at the top or at the side of the screen. Others are just near-diagonal lines. Others are "steps" as if trying to plot binary or something else. But there are a few good ones here.

The program tries to plot a function with 500 points of Cartesian coordinates taking part in a polar scheme. If the function is not plottable, it's skipped. The "Illegal function call" had to be trapped for it. The functions were fabricated from another QB64 program I wrote. Don't spend too much time looking at them or it will cause some loss of sanity!

Press [ESC] to quit, or on Linux leave it for long enough and then it seg-faults, I don't know why. (shrugs)

At the terminal command line it's possible to follow the executable file's name with an integer from 1 to 5000, to start from the function indicated by the huge "SELECT CASE... END SELECT" block. This has nothing to do with random numbers. It was already taken care of by my "extreme function maker" LOL.

That is the first parameter. There is a second parameter which is a float-type factor. The default is to just plot a circle with X,Y for 500 points. The circle is always created by this program with a "radius" of 2. The factor in this program can only cause the effect of an open shape. In other words, the chosen factor by the user cannot be smaller than the default value of 1.3888.

The actual program is too big to post into this forum, so I'm posting only a portion of it. Otherwise you will have to download the attachment.

'by mnrvovrfc 06-Jun-2023

option _explicit

dim v(1 to 500) as double

dim as double n, x, y, z, mult, factdiv, smaller, largger

dim as integer i, j, cn

dim redu$



if command$(1) = "" then

    cn = 1

else

    cn = val(command$(1))

    if cn = 0 then

        cn = 1

    elseif cn < 1 or cn > 5000 then

        cn = 1

    end if

end if

if command$(2) = "" then

    mult = 1.3888

else

    mult = val(command$(1))

    if mult < 1.3888 or mult > 5.0 then

        mult = 1.3888

    end if

end if



screen _newimage(1000, 500, 12)



for i = cn to 5000

on error goto 100

for z = 1 to 500

x = 2 * cos(_d2r(z / mult))

y = 2 * sin(_d2r(z / mult))

select case i

    case 1

        n = Z10B46#(x, y, z)

    case 2

        n = Z10B48#(x, y, z)

    case 3

        n = Z10B4A#(x, y, z)

    case 4

        n = Z10B4C#(x, y, z)

    case 5

        n = Z10B4E#(x, y, z)

    case 6

        n = Z10B50#(x, y, z)

    case 7

        n = Z10B52#(x, y, z)

    case 8

        n = Z10B54#(x, y, z)

    case 9

        n = Z10B56#(x, y, z)

    case 10

        n = Z10B58#(x, y, z)

'   :

'   :

    case 4990

        n = Z13240#(x, y, z)

    case 4991

        n = Z13242#(x, y, z)

    case 4992

        n = Z13244#(x, y, z)

    case 4993

        n = Z13246#(x, y, z)

    case 4994

        n = Z13248#(x, y, z)

    case 4995

        n = Z1324A#(x, y, z)

    case 4996

        n = Z1324C#(x, y, z)

    case 4997

        n = Z1324E#(x, y, z)

    case 4998

        n = Z13250#(x, y, z)

    case 4999

        n = Z13252#(x, y, z)

    case 5000

        n = Z13254#(x, y, z)

end select

endoflongcase:

v(z) = n

next



on error goto 0



smaller = 0

largger = 0

for z = 1 to 500

    if v(z) < smaller then smaller = v(z)

    if v(z) > largger then largger = v(z)

next



if int(smaller * 1e+6) = 0 and int(largger * 1e+6) = 0 then

    cls

    _continue

end if



redu$ = ""

if abs(smaller) > abs(largger) then factdiv = abs(smaller) else factdiv = abs(largger)

do while factdiv > 1e+6

    redu$ = "*"

    smaller = smaller / 100

    largger = largger / 100

    if abs(smaller) > abs(largger) then factdiv = abs(smaller) else factdiv = abs(largger)

loop



_title _trim$(str$(i)) + ": " + redu$ + "Smaller =" + str$(smaller) + "| " + redu$ + "Larger =" + str$(largger)

window screen(smaller, 1)-(largger, 500)



doscreen:

pset(v(1), 1), 15

for z = 2 to 500

    line -(v(z), z), 15

next



for j = 1 to 30

    _delay 0.1

    if _keydown(27) then exit for

next



cls

if _keydown(27) then exit for

next

system



100 n = 0

resume endoflongcase

'   :

'   :

'then what follows are the functions to plot graphs with.

https://basicanywheremachine-news.blogsp...s-and.html

This is a fireworks program I've been working on for some time; finally polished it up today in honor of the 4th. Very open to feedback!

Hi to all 

I am trying to make a basic calendar program, in order to show my future calendar events.
I would like to READ my Google Calendar and show events on screen (only read, it is not necessary to write new events), and I have no idea on how to make it.

Do you know if it is possible with QB64PE ?

Thank you very much!!!  

Hi,
Years ago when I wrote assembler in GWBASIC or QuickBASIC there was INT &H21 to see how much free space you have left on the disk.
See also https://ftp.zx.net.nz/pub/archive/ftp.mi...46/980.HTM
Is there such a thing for QB64-PE with modern PC's like Windows 7 and up??

In C something like this? https://learn.microsoft.com/en-us/dotnet...ew=net-7.0

After some thought (always bad for me), Either this will become a QB64pe enhancement or I Don't Get It.

I use drop files a lot since implemented a couple releases ago (v1.3).  It's easy to use and setup.  A couple of commands and your program can take a list of files dropped on a window.  I want to take to the next level.

Drop them on the desktop icon link.!  And process them.  This a hidden feature (or not well known) in Microsoft windows.  I read through the program doc's again.  Not clear if it is already implemented.

Let the fun begin....

Code optimized for QB64PE which we came up with several years back as a community.  I thought I'd share it here, in case anyone ever needed it or wanted to make use of it again in the future.

Screen _NewImage(800, 600, 32)



Dim TransRed As _Unsigned Long

Dim TransGreen As _Unsigned Long

Dim TransBlue As _Unsigned Long

TransRed = _RGBA(255, 0, 0, 128)

TransGreen = _RGBA(0, 255, 0, 128)

TransBlue = _RGBA(0, 0, 255, 128)



Call CircleFill(100, 100, 75, TransRed)

Call CircleFill(120, 120, 75, TransBlue)



Call EllipseFill(550, 100, 150, 75, TransBlue)

Call EllipseFill(570, 120, 150, 75, TransGreen)



Call EllipseTilt(200, 400, 150, 75, 0, TransGreen)

Call EllipseTilt(220, 420, 150, 75, 3.14 / 4, TransRed)



Call EllipseTiltFill(0, 550, 400, 150, 75, 3.14 / 6, TransRed)

Call EllipseTiltFill(0, 570, 420, 150, 75, 3.14 / 4, TransGreen)



End



Sub CircleFill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)

    ' CX = center x coordinate

    ' CY = center y coordinate

    '  R = radius

    '  C = fill color

    Dim Radius As Integer, RadiusError As Integer

    Dim X As Integer, Y As Integer

    Radius = Abs(R)

    RadiusError = -Radius

    X = Radius

    Y = 0

    If Radius = 0 Then PSet (CX, CY), C: Exit Sub

    Line (CX - X, CY)-(CX + X, CY), C, BF

    While X > Y

        RadiusError = RadiusError + Y * 2 + 1

        If RadiusError >= 0 Then

            If X <> Y + 1 Then

                Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF

                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF

            End If

            X = X - 1

            RadiusError = RadiusError - X * 2

        End If

        Y = Y + 1

        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF

        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF

    Wend

End Sub



Sub EllipseFill (CX As Integer, CY As Integer, a As Integer, b As Integer, C As _Unsigned Long)

    ' CX = center x coordinate

    ' CY = center y coordinate

    '  a = semimajor axis

    '  b = semiminor axis

    '  C = fill color

    If a = 0 Or b = 0 Then Exit Sub

    Dim h2 As _Integer64

    Dim w2 As _Integer64

    Dim h2w2 As _Integer64

    Dim x As Integer

    Dim y As Integer

    w2 = a * a

    h2 = b * b

    h2w2 = h2 * w2

    Line (CX - a, CY)-(CX + a, CY), C, BF

    Do While y < b

        y = y + 1

        x = Sqr((h2w2 - y * y * w2) \ h2)

        Line (CX - x, CY + y)-(CX + x, CY + y), C, BF

        Line (CX - x, CY - y)-(CX + x, CY - y), C, BF

    Loop

End Sub



Sub EllipseTilt (CX, CY, a, b, ang, C As _Unsigned Long)

    '  CX = center x coordinate

    '  CY = center y coordinate

    '  a = semimajor axis

    '  b = semiminor axis

    ' ang = clockwise orientation of semimajor axis in radians (0 default)

    '  C = fill color

    For k = 0 To 6.283185307179586 + .025 Step .025

        i = a * Cos(k) * Cos(ang) + b * Sin(k) * Sin(ang)

        j = -a * Cos(k) * Sin(ang) + b * Sin(k) * Cos(ang)

        i = i + CX

        j = -j + CY

        If k <> 0 Then

            Line -(i, j), C

        Else

            PSet (i, j), C

        End If

    Next

End Sub



Sub EllipseTiltFill (destHandle&, CX, CY, a, b, ang, C As _Unsigned Long)

    '  destHandle& = destination handle

    '  CX = center x coordinate

    '  CY = center y coordinate

    '  a = semimajor axis

    '  b = semiminor axis

    ' ang = clockwise orientation of semimajor axis in radians (0 default)

    '  C = fill color

    Dim max As Integer, mx2 As Integer, i As Integer, j As Integer

    Dim prc As _Unsigned Long

    Dim D As Integer, S As Integer

    D = _Dest: S = _Source

    prc = _RGB32(255, 255, 255, 255)

    If a > b Then max = a + 1 Else max = b + 1

    mx2 = max + max

    tef& = _NewImage(mx2, mx2)

    _Dest tef&

    _Source tef&

    For k = 0 To 6.283185307179586 + .025 Step .025

        i = max + a * Cos(k) * Cos(ang) + b * Sin(k) * Sin(ang)

        j = max + a * Cos(k) * Sin(ang) - b * Sin(k) * Cos(ang)

        If k <> 0 Then

            Line (lasti, lastj)-(i, j), prc

        Else

            PSet (i, j), prc

        End If

        lasti = i: lastj = j

    Next

    Dim xleft(mx2) As Integer, xright(mx2) As Integer, x As Integer, y As Integer

    For y = 0 To mx2

        x = 0

        While Point(x, y) <> prc And x < mx2

            x = x + 1

        Wend

        xleft(y) = x

        While Point(x, y) = prc And x < mx2

            x = x + 1

        Wend

        While Point(x, y) <> prc And x < mx2

            x = x + 1

        Wend

        If x = mx2 Then xright(y) = xleft(y) Else xright(y) = x

    Next

    _Dest destHandle&

    For y = 0 To mx2

        If xleft(y) <> mx2 Then Line (xleft(y) + CX - max, y + CY - max)-(xright(y) + CX - max, y + CY - max), C, BF

    Next

    _Dest D: _Dest S

    _FreeImage tef&

End Sub

https://basicanywheremachine-news.blogsp...fixed.html