BAM Sample Programs

[CharlieJV]

A "10PRINT" Variant, BAMified

   

[CharlieJV]

Oriental Paintbrush Sim, a port of a QBJS program by Vince.

Kind of a fun thing for some mindless and minimalist doodling :


   

[TDarcos]

Latest batch of programs: Added 2024-02

Your "Which weekday" program https://basicanywheremachine.neocities.o...ch_weekday has an error. Try the date 1-1-1800, which was a Wednesday. This program says it's Tuesday.

I have the same problem. I can never get any Zeller's congruence formulas to consistently produce correct results.

[SMcNeill]

Latest batch of programs: Added 2024-02

Your "Which weekday" program https://basicanywheremachine.neocities.o...ch_weekday has an error. Try the date 1-1-1800, which was a Wednesday. This program says it's Tuesday.

I have the same problem. I can never get any Zeller's congruence formulas to consistently produce correct results.

Code: (Select All)

Function GetWeekDay& (Day$) 'use MM/DD/YYYY format
    'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
    If CheckDayFormat(Day$) = 0 Then GetWeekDay = 0: Exit Function
    Dim As Long century, zerocentury, result
    Dim As Long MM, DD, YYYY
    MM = GetMonth(Day$): DD = GetDay(Day$): YYYY = GetYear(Day$)
    If MM < 3 Then MM = MM + 12: YYYY = YYYY - 1
    century = YYYY Mod 100
    zerocentury = YYYY \ 100
    result = (DD + Int(13 * (MM + 1) / 5) + century + Int(century / 4) + Int(zerocentury / 4) + 5 * zerocentury) Mod 7
    If result = 0 Then result = 7
    GetWeekDay& = result 'results are 1 to 7, from Sunday to Saturday
End Function

The above gives Wednesday as the proper result.  Use with the below for quick insertion of the weekday name:

Code: (Select All)

Function GetWeekDayName$ (Day$) 'use MM/DD/YYYY format
    Dim result As Long
    result = GetWeekDay(Day$)
    Select Case result
        Case 1: GetWeekDayName = "Sunday"
        Case 2: GetWeekDayName = "Monday"
        Case 3: GetWeekDayName = "Tuesday"
        Case 4: GetWeekDayName = "Wednesday"
        Case 5: GetWeekDayName = "Thursday"
        Case 6: GetWeekDayName = "Friday"
        Case 7: GetWeekDayName = "Saturday"
    End Select
End Function

[CharlieJV]

Latest batch of programs: Added 2024-02

Your "Which weekday" program https://basicanywheremachine.neocities.o...ch_weekday has an error. Try the date 1-1-1800, which was a Wednesday. This program says it's Tuesday.

I have the same problem. I can never get any Zeller's congruence formulas to consistently produce correct results.

Hey, thank-you much for catching that.

I replaced the algorithm with BASIC code from the "Doomsday rule" at Rosetta Code.

(You might have to refresh the page to get the old version out of your browser cache.)

Source code for the running program listed below the program.

---

Latest batch of programs: Added 2024-02

Your "Which weekday" program https://basicanywheremachine.neocities.o...ch_weekday has an error. Try the date 1-1-1800, which was a Wednesday. This program says it's Tuesday.

I have the same problem. I can never get any Zeller's congruence formulas to consistently produce correct results.

Code: (Select All)

Function GetWeekDay& (Day$) 'use MM/DD/YYYY format
    'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
    If CheckDayFormat(Day$) = 0 Then GetWeekDay = 0: Exit Function
    Dim As Long century, zerocentury, result
    Dim As Long MM, DD, YYYY
    MM = GetMonth(Day$): DD = GetDay(Day$): YYYY = GetYear(Day$)
    If MM < 3 Then MM = MM + 12: YYYY = YYYY - 1
    century = YYYY Mod 100
    zerocentury = YYYY \ 100
    result = (DD + Int(13 * (MM + 1) / 5) + century + Int(century / 4) + Int(zerocentury / 4) + 5 * zerocentury) Mod 7
    If result = 0 Then result = 7
    GetWeekDay& = result 'results are 1 to 7, from Sunday to Saturday
End Function

The above gives Wednesday as the proper result.  Use with the below for quick insertion of the weekday name:

Code: (Select All)

Function GetWeekDayName$ (Day$) 'use MM/DD/YYYY format
    Dim result As Long
    result = GetWeekDay(Day$)
    Select Case result
        Case 1: GetWeekDayName = "Sunday"
        Case 2: GetWeekDayName = "Monday"
        Case 3: GetWeekDayName = "Tuesday"
        Case 4: GetWeekDayName = "Wednesday"
        Case 5: GetWeekDayName = "Thursday"
        Case 6: GetWeekDayName = "Friday"
        Case 7: GetWeekDayName = "Saturday"
    End Select
End Function

Thanks, Steve.  I wound up nabbing some "Doomsday rule" code from Rosetta code.  That little proggie I had done was meant to demonstrate how we can take some old BASIC code and "BAMify" it.

[CharlieJV]

"PUT" Graphics Demo:  https://basicanywheremachine-news.blogsp...color.html

   

[CharlieJV]

Fractals in Focus : A classic BASIC program with some new twists

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


   

[CharlieJV]

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

   

[bplus]

Got port to qb64pe:

Code: (Select All)

_Title "Geometric Thingy, press any for next color set" ' b+ port Charlie's code to QB64pe 2025-02-08
' This program exported from BASIC Anywhere Machine (Version [5.2.3].[2024.09.09.00.00]) on 2025.02.08 at 07:06 (Coordinated Universal Time)
' This program by Charlie Veniot is inspired by a small programming challenge by ZXDunny.

Screen _NewImage(370, 370, 12)

Dim I%(10000)

Color 0, 15
Cls

For I = 0 To 30 Step 7
    Line (1 + I, 1 + I)-(62 - I, 62 - I), 0, B
    Line (62 + I, 1 + I)-(123 - I, 62 - I), 0, B
    Line (1 + I, 62 + I)-(62 - I, 123 - I), 0, B
    Line (62 + I, 62 + I)-(123 - I, 123 - I), 0, B
Next I

Line (62, 1)-(1, 62), 0
Line (62, 1)-(123, 62), 0
Line (1, 62)-(62, 123), 0
Line (62, 123)-(123, 62), 0

PaintLoop:

PCopy 0, 1

C1% = Int(Rnd * 14) + 1
C2% = Int(Rnd * 14) + 1

For I = 7 To 21 Step 14
    Paint (2 + I, 2 + I), C1%, 0
    Paint (63 + I, 61 - I), C1%, 0
    Paint (61 - I, 63 + I), C1%, 0
    Paint (122 - I, 122 - I), C1%, 0
Next I

For I = 0 To 32 Step 14
    Paint (61 - I, 61 - I), C2%, 0
    Paint (122 - I, 2 + I), C2%, 0
    Paint (2 + I, 122 - I), C2%, 0
    Paint (63 + I, 63 + I), C2%, 0
Next I

Get (1, 1)-(123, 123), I%()
Put (123, 1), I%(), PSet
Put (245, 1), I%(), PSet
Put (1, 123), I%(), PSet
Put (123, 123), I%(), PSet
Put (245, 123), I%(), PSet
Put (1, 245), I%(), PSet
Put (123, 245), I%(), PSet
Put (245, 245), I%(), PSet

'PCopy 0, 2
'PCopy 1, 0

'For Y = 0 To 369
'PCOPY (0, Y) - (369, Y), 2, 0
'SLEEP 0.003
'NEXT Y

Sleep

GoTo PaintLoop

Don't think I've ever used Get and Put before.

[CharlieJV]

Got port to qb64pe:

Code: (Select All)

...

Don't think I've ever used Get and Put before.

Yeah, I must get around to playing with the various PUT modes.