Proggies

[SierraKen]

Goldwave looks incredible! Reminds me of the time I made ocean waves.

[bplus]

I think we have to thank Johnno for that because he brought it to SmallBASIC from Basic256, I made it Gold or yellow to match the title and converted drawPoly's to triangle fills.

[bplus]

Here's a fun one from All4Baisc, Charlie's BAM translation:

Code: (Select All)

_Title "Bird Math - BAM translation to QB64" 'b+ 2022-06-22
' ref Charlie's post   http://basic4all.epizy.com/index.php?topic=159.0
' The trigonometric functions by Hamid Naderi Yeganeh from his original artwork (Parrot)
' https://www.huffpost.com/entry/mathematical-birds_b_8876904
' Missing parts of functions found at https://www.flerlagetwins.com/2018/04/parrot.html

Dim pi, k, k1, k2, a, b As Double
Screen _NewImage(751, 720, 32): _ScreenMove 250, 20
pi = 3.1415929: k1 = -10000: k2 = 10000: c~& = _RGB32(130, 0, 0)
Window (0, 0)-(6000, -5750)
Color , &HFF8888FF: Cls
For k = k1 To k2
    a = Int(((3 * k / 20000) + (Cos(37 * pi * k / 10000)) ^ 6 * Sin((k / 10000) ^ 7 * (3 * pi / 5)) + (9 / 7) * (Cos(37 * pi * k / 10000)) ^ 16 * (Cos(pi * k / 20000)) ^ 12 * Sin(pi * k / 10000)) * 1000)
    b = -1 * Int(((-5 / 4) * (Cos(37 * pi * k / 10000)) ^ 6 * Cos((k / 10000) ^ 7 * (3 * pi / 5)) * (1 + 3 * (Cos(pi * k / 20000) * Cos(3 * pi * k / 20000)) ^ 8) + (2 / 3) * (Cos(3 * pi * k / 200000) * Cos(9 * pi * k / 200000) * Cos(9 * pi * k / 100000)) ^ 12) * 1000)
    Circle (3000 - a, -1000 - b), 60, c~&
Next k
Sleep

   

[vince]

this is an incredible bird, bplus

[SierraKen]

Very cool looking! A lot of life forms are symmetrical in shape so if you have one side you can reverse it and get the other.

[bplus]

Oh dang! I need a DeskTop Minute Timer for my revamped laptop:

Code: (Select All)

_Title "Minutes Timer"
Screen _NewImage(300, 33, 32)
Color &HFFAAAADD
Input "Enter the minutes to alarm "; minutes##
start## = Timer
startT$ = Time$
Do
    Cls
    Locate 1, 1: Print startT$; "  Minute Timer Set:";
    Print Using "####.##"; minutes##;
    Locate 2, 1: Print Time$; "    Minutes so far:";
    Print Using "####.##"; MinutesPassed##(start##);
    If minutes## <= MinutesPassed##(start##) Then
        Beep
        _Title "Press any to stop beeping..."
        If Len(InKey$) Then System
    End If
    _Limit 10
Loop Until theCowsComeHome

Function MinutesPassed## (started##)
    If started## > Timer Then started## = started## - 86400 ' midnight problem fix
    MinutesPassed## = Int(100 * (Timer - started##) / 60) / 100
End Function

   

[bplus]

100 Prisoners Problem

'  I saw this last night and just have to check out the solution in code!

' https://www.youtube.com/watch?v=iSNsgj1OCLA

' So 100 prisoners go into a room one at a time and have 50 chances to draw their number from mailbox slots
' they must return the numbers in same box they checked.

' If all the prisoners find their number they go free else they are all executed. Whew!

' But there is a strategy that if used gives them around a 31% chance of being set free!

'      A 31% Change of being set free, how can this be!?

' Here is the startegy, go into the room and pull the number from slot that matches your number.
' From that number go to the number found in the box, contimue in this manner until you find your
' number or you've drawn from 50 slots. If you hit 50 then everyone is doomed might as well start
' another run on the experiment.

' If we run this strategy 100000 times will we get around 31,000 Set Frees and 69,000 Executions?

' Let's see...

' Wow! as predicted

' Let's see...

Code: (Select All)

_Title "100 Prisoners Problem"
Randomize Timer
Dim slots(1 To 100) As Long
For i = 1 To 100
    slots(i) = i
Next
Do
    freed = 0: executions = 0
    Do
        GoSub shuffle
        For p = 1 To 100 ' prisoner number
            count = 1: test = p: madeit = -1
            While count <= 50
                If slots(test) = p Then Exit While Else test = slots(test)
                count = count + 1
                If count > 50 Then madeit = 0: Exit For
            Wend
        Next
        If madeit Then freed = freed + 1 Else executions = executions + 1
    Loop Until (freed + executions) = 100000
    Print "Freed"; freed
    Print "Exceutions"; executions
    Print
    Print "Press any for another run of 100,000... "
    Sleep
    Cls
Loop Until _KeyDown(27)
End
shuffle:
For i = 100 To 2 Step -1
    Swap slots(Int(Rnd * i) + 1), slots(i)
Next
Return


'  I saw this last night and just have to check out the solution in code!
' https://www.youtube.com/watch?v=iSNsgj1OCLA

' So 100 prisoners go into a room one at a time and have 50 chances to draw their number from mailbox slots
' they must return the numbers in same box they checked.

' If all the prisoners find their number they go free else they are all executed. Whew!

' But there is a strategy that if used gives them around a 31% chance of being set free!

'       A 31% Change of being set free, how can this be!?

' Here is the startegy, go into the room and pull the number from slot that matches your number.
' From that number go to the number found in the box, contimue in this manner until you find your
' number or you've drawn from 50 slots. If you hit 50 then everyone is doomed might as well start
' another run on the experiment.

' If we run this strategy 100000 times will we get around 31,000 Set Frees and 69,000 Executions?

' Let's see...

' Wow! as predicted

[bplus]

All the way back to 2015 

Rotating Star Mouse Chaser

Code: (Select All)

Option _Explicit
_Title "Rotating Star Mouse Chaser" 'b+ 2022-07-19 trans from:
'Rotating Stars Mouse Chaser.bas for SmallBASIC 0.12.0 2015-11-09 MGA/B+
'code is based on code: mouse chaser by tsh73
'for the Just Basic contest, November 2008, I am 7 years later

Const nPoints = 20, xMax = 1280, yMax = 700, pi = _Pi
Screen _NewImage(xMax, yMax, 32)
_FullScreen
Dim Shared x(nPoints), y(nPoints), i, twist

Dim As Long mx, my
Dim As Single dx, dy, v, r, dxN, dyN

For i = 1 To nPoints
    x(i) = xMax
    y(i) = yMax 'set it offscreen
Next

While _KeyDown(27) = 0
    Cls
    twist = twist + .05
    While _MouseInput: Wend
    mx = _MouseX: my = _MouseY
    For i = 1 To nPoints
        If i = 1 Then 'first sees mouse
            dx = mx - x(i)
            dy = my - y(i)
            v = 4
        Else 'others see previous
            dx = x(i - 1) - x(i)
            dy = y(i - 1) - y(i)
            v = 0.6 * v + 0.2 * 3 * (2 - i / nPoints) 'use 0.8 v of previous, to pick up speed
        End If
        r = Sqr(dx ^ 2 + dy ^ 2)
        dxN = dx / r
        dyN = dy / r
        x(i) = x(i) + v * dxN
        y(i) = y(i) + v * dyN
        drawstar
    Next i
    _Display
    _Limit 60
Wend

Sub drawstar ()
    Dim sp, s, t, u, j, b, v, w
    sp = (nPoints + 1 - i) * 2 + 3 'star points when i is low, points are high
    s = 5 * (50 ^ (1 / nPoints)) ^ (nPoints + 1 - i)
    t = x(i) + s * Cos(0 + twist)
    u = y(i) + s * Sin(0 + twist)
    For j = 1 To sp
        b = b + Int(sp / 2) * 2 * pi / sp
        v = x(i) + s * Cos(b + twist)
        w = y(i) + s * Sin(b + twist)
        Line (t, u)-(v, w), _RGB32(255, 255, 100)
        t = v: u = w
    Next
End Sub

   

Shared at QBJS (maybe) https://qbjs.org/?code=T3B0aW9uIF9FeHBsa...OQCnVN1Ygo=

yes! dbox will be happy!

[vince]

Wow B+, very impressive mod (perhaps inspired by the shape maker polygon talk?) and how nice is it to just click and run in the browser

[dbox]

Looking good @bplus!