News:

Welcome to RetroCoders Community

Main Menu

Ever-Changing Mandala

Started by CharlieJV, Sep 27, 2022, 01:43 AM

Previous topic - Next topic

CharlieJV

A GW-BASIC program slightly tweaked with BAM syntax: _ALERT dialog with program instructions, and _NEWIMAGE applied to SCREEN .

Also changed the program to fit in 640 x 200 instead of 320 x 200, and to use 16 colors instead of 4.


johnno56

"I am seeing spots before my eyes!"

"Have you seen a Doctor?"

"No. Just spots!" (could not resist.. lol)

Hey Charlie,

One of the users on QB64pe has a "non-trig" circle fill if you are interested. I only mentioned it because you are using paint. Paint (flood fill) can be a little hungry when it come to memory usage. On small circles, like the ones you are using, paint will be fine, but for larger circles... on an older machine... could be a struggle. Believe it or not, this routine 'fills' a circle with filled rectangles... Who knew, right?

This is the subroutine by bplus

CX and CY (circle centre x and y)
R circle radius and
C circle colour

Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
    Dim Radius As Long, RadiusError As Long
    Dim X As Long, Y As Long
    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

As I said before, no trig. Should be able to adapt it for BAM? If not, pop it in your 'tool box', as it may came in handy down the track...

J
May your journey be free of incident.  Live long and prosper.

CharlieJV

Quote from: johnno56 on Sep 28, 2022, 04:43 AM"I am seeing spots before my eyes!"

"Have you seen a Doctor?"

"No. Just spots!" (could not resist.. lol)

Hey Charlie,

One of the users on QB64pe has a "non-trig" circle fill if you are interested. I only mentioned it because you are using paint. Paint (flood fill) can be a little hungry when it come to memory usage. On small circles, like the ones you are using, paint will be fine, but for larger circles... on an older machine... could be a struggle. Believe it or not, this routine 'fills' a circle with filled rectangles... Who knew, right?

This is the subroutine by bplus

CX and CY (circle centre x and y)
R circle radius and
C circle colour

Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
    Dim Radius As Long, RadiusError As Long
    Dim X As Long, Y As Long
    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

As I said before, no trig. Should be able to adapt it for BAM? If not, pop it in your 'tool box', as it may came in handy down the track...

J

That is another largely stock GW-BASIC program, one of many just to test BAM's compatibility.

Thanks for the pointer to that subroutine!

I'll put together a second version of the program.  It will be nice to have the two side by each for comparison and documentation about the performance of alternative versions of code.

CharlieJV

Quote from: CharlieJV on Sep 28, 2022, 12:32 PMBelieve it or not, this routine 'fills' a circle with filled rectangles... Who knew, right?


Ugh.  You just brought back bad memories of Calculus.  I had a devil of a time finally understanding how to get the area under a curve.  Volume of a sphere?  Forget about it.

CharlieJV

Quote from: johnno56 on Sep 28, 2022, 04:43 AM"I am seeing spots before my eyes!"

"Have you seen a Doctor?"

"No. Just spots!" (could not resist.. lol)

Hey Charlie,

One of the users on QB64pe has a "non-trig" circle fill if you are interested. I only mentioned it because you are using paint. Paint (flood fill) can be a little hungry when it come to memory usage. On small circles, like the ones you are using, paint will be fine, but for larger circles... on an older machine... could be a struggle. Believe it or not, this routine 'fills' a circle with filled rectangles... Who knew, right?

This is the subroutine by bplus

CX and CY (circle centre x and y)
R circle radius and
C circle colour

Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
    Dim Radius As Long, RadiusError As Long
    Dim X As Long, Y As Long
    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

As I said before, no trig. Should be able to adapt it for BAM? If not, pop it in your 'tool box', as it may came in handy down the track...

J

Before attempting this ...

Somebody else commented that their CPU was going full tilt and the fan kicking in something silly.

So I did a small change to see how big of a difference it makes.  Seems to be making a significant difference using SLEEP instead of a loop to delay drawing.

Do you notice a difference between the versions?

Version two, to compare with the previous version, both of them existing on the hosting site:


johnno56

The differences? With my hearing, as bad as it is, I did not detect any increase in fan speed or temperature. But there was a difference in CPU usage. The first version used 3% and the second version used 2% of one of the 4 CPU's. For me, the performance, was pretty much the same.

It would be interesting to see if the non-floodfill routine has any effect.

Speaking of the routine... When drawing, the X and Y coordinates, only increment by 1. This means that only a line command is required. The BF is not needed. Tested this on RCBasic and Naalaa and the line command works fine... Might shave a few micro-seconds off the runtime... lol

Time to checkout BAM a bit more... Fascinating...
May your journey be free of incident.  Live long and prosper.

johnno56

Here is a quick test. I do not know how to add the usual BAM links.

1 rem
2 rem  Non Floodfill (paint) test #1
3 rem
10 screen _newimage(640, 640, 9)
20 cls
30 CX = 320
40 CY = 320
50 R = 300
60 C = 1
70 gosub 1000
80 sleep 3
90 end
997 rem
998 rem Non Trig or floodfill routine
999 rem
1000 Dim Radius
1010 Dim RadiusError
1020 Dim X
1030 Dim Y
1040 Radius = Abs(R)
1050 RadiusError = -Radius
1060 X = Radius
1070 Y = 0
1080 If Radius = 0 Then PSet (CX, CY), C: return
1090 line (CX - X, CY)-(CX + X, CY), C
1100 While X > Y
1110 RadiusError = RadiusError + Y * 2 + 1
1120 If RadiusError >= 0 Then If X <> Y + 1 Then line(CX - Y, CY - X)-(CX + Y, CY - X),C: line(CX - Y, CY + X)-(CX + Y, CY + X),C:X = X - 1:RadiusError = RadiusError - X * 2
1130 Y = Y + 1
1140 line(CX - X, CY - Y)-(CX + X, CY - Y),C
1150 line(CX - X, CY + Y)-(CX + X, CY + Y),C
1160 Wend
1170 return

It is not perfect but it will demonstrate how quickly it can produce a large filled circle without paint or trig...

Ok. It looks like a huge egg... but still...

J
May your journey be free of incident.  Live long and prosper.

CharlieJV

Quote from: johnno56 on Sep 28, 2022, 07:49 PMIt would be interesting to see if the non-floodfill routine has any effect.

If not tonight, then definitely by Monday.

Aside, if you want to play with stock wwwBASIC, find it here.

And stock TiddlyWiki here.

CharlieJV

Quote from: johnno56 on Sep 28, 2022, 08:25 PMHere is a quick test. I do not know how to add the usual BAM links.

1 rem
2 rem  Non Floodfill (paint) test #1
3 rem
10 screen _newimage(640, 640, 9)
20 cls
30 CX = 320
40 CY = 320
50 R = 300
60 C = 1
70 gosub 1000
80 sleep 3
90 end
997 rem
998 rem Non Trig or floodfill routine
999 rem
1000 Dim Radius
1010 Dim RadiusError
1020 Dim X
1030 Dim Y
1040 Radius = Abs(R)
1050 RadiusError = -Radius
1060 X = Radius
1070 Y = 0
1080 If Radius = 0 Then PSet (CX, CY), C: return
1090 line (CX - X, CY)-(CX + X, CY), C
1100 While X > Y
1110 RadiusError = RadiusError + Y * 2 + 1
1120 If RadiusError >= 0 Then If X <> Y + 1 Then line(CX - Y, CY - X)-(CX + Y, CY - X),C: line(CX - Y, CY + X)-(CX + Y, CY + X),C:X = X - 1:RadiusError = RadiusError - X * 2
1130 Y = Y + 1
1140 line(CX - X, CY - Y)-(CX + X, CY - Y),C
1150 line(CX - X, CY + Y)-(CX + X, CY + Y),C
1160 Wend
1170 return

It is not perfect but it will demonstrate how quickly it can produce a large filled circle without paint or trig...

Ok. It looks like a huge egg... but still...

J

How crazy is this, eh?

Your code takes all of EndTimer - StartTimer = 0.048

Your code cut short to draw with CIRCLE and CIRCLE's Fill parameter: 0.2045

That is some difference. 

johnno56

Amazed me when I saw it for the first time...
The example is to a 600x600 pixel disc. I wonder how long it would take to draw the two colour discs of 10x10
 and 9x9 pixels? (draw the 'circle' colour first then the 'fill' colour of 1 pixel radius smaller)
Looks like some fun times ahead...
May your journey be free of incident.  Live long and prosper.

CharlieJV

Quote from: johnno56 on Sep 28, 2022, 09:14 PMAmazed me when I saw it for the first time...
The example is to a 600x600 pixel disc. I wonder how long it would take to draw the two colour discs of 10x10
 and 9x9 pixels? (draw the 'circle' colour first then the 'fill' colour of 1 pixel radius smaller)
Looks like some fun times ahead...

Funny what comes to mind as I'm dealing with shampoo in my eyes while grabbing a shower ...

Using rectangles to create circles makes total sense to me.

But wouldn't it only really work when in a screen mode that has 1 to 1 aspect ratio?

I'm thinking what slows down a CIRCLE statement is drawing a correct circle regardless of aspect ratio.

So there's some serious math going on to draw the circle correctly?

Drawing a circular-ish shape with rectangles would be obviously faster because it isn't giving a hoot about aspect ratio.

I think.  Something like that.  I have to do some digging.

johnno56

I think the machine has to calculate (trig) and store PiR2 (area of a disc) pixels. Where as a line only needs to store two points? (4 if a box)... That is my opinion. I am not a math wiz... lol.

Started to convert mandala with mixed results... yeah... those discs are 'egg shaped' as well... Yet in other Basic's the routine produces a circle... who knew... more tweaks...
May your journey be free of incident.  Live long and prosper.

CharlieJV

Quote from: johnno56 on Sep 28, 2022, 09:33 PMI think the machine has to calculate (trig) and store PiR2 (area of a disc) pixels. Where as a line only needs to store two points? (4 if a box)... That is my opinion. I am not a math wiz... lol.

Started to convert mandala with mixed results... yeah... those discs are 'egg shaped' as well... Yet in other Basic's the routine produces a circle... who knew... more tweaks...

Just to confirm my thinking.

<$list variable="thisScreen" filter="[range[0,2]] [range[7,21]]">
screen _newimage(200,200,<<thisScreen>>)
locate 1,1 : print "screen mode: " + <<thisScreen>>
circle (100,100), 75
_delay 2
</$list>

(At the moment, BAM doesn't allow variables in the SCREEN statement.  So I setup the program with a bit of TiddlyWiki meta-programming / macros to generate all of the BASIC statements at runtime.  See attached screenshot.)


For each screen mode, the circles are proper circles regardless of screen aspect.

So it would make sense that the circle command is slowed down by screen aspect ratio math.

Going back to your program, change screen 9 to screen 12, and the circle is proper because of the 1 to 1 screen ratio.

Now the trick to use triangles for circles is excellent when sticking to a screen ratio of 1 and not trying to maintain any kind of compatibility with any older BASIC.

I think, but reserve the potential of rethinking after a few sleeps ...







johnno56

Here is the first conversion.

Changing to screen 12 got rid of the EGGadurated images... (could not resist)

1 REM ** Ever-Changing Mandala **
2 ' BASED ON: GW-BASIC Made Easy, Chapter 12. File: GWME1211.BAS
100 REM ** Setup **
'✏ 110 was SCREEN 1: COLOR 0, 1: CLS : KEY OFF
110 SCREEN _newimage(640,200,12)
120 RANDOMIZE TIMER: DEFINT A-Z
130 REM ** Draw mandala until ESC key is pressed **
140 _alert("Press the escape key to pause the program.\n\nWhen the program is paused, press the escape key again to end the program, or press any other key to resume the program.")
150 WHILE INKEY$ <> CHR$(27)
160 ' Assign random values to variables
170 radius2 = INT(8 * RND) + 3
180 OneKolor = INT(15 * RND) + 1
185 if int(3*rnd) <> 0 then TwoKolor = INT(16 * RND) else TwoKolor = 0
190 DelH = INT(310 * RND) + 10 'Horizontal offset
200 DelV = INT(95 * RND) + 10 'Vertical offset
210 ' Draw and paint circles
220 CX = 320 + DelH: CY = 100 + DelV: R = radius2: C = OneKolor: gosub 1000
230 CX = 320 + DelH: CY = 100 + DelV: R = radius2 - 1: C = TwoKolor: gosub 1000
240 CX = 320 - DelH: CY = 100 + DelV: R = radius2: C = OneKolor: gosub 1000
250 CX = 320 - DelH: CY = 100 + DelV: R = radius2 - 1: C = TwoKolor: gosub 1000
260 CX = 320 - DelH: CY = 100 - DelV: R = radius2: C = OneKolor: gosub 1000
270 CX = 320 - DelH: CY = 100 - DelV: R = radius2 - 1: C = TwoKolor: gosub 1000
280 CX = 320 + DelH: CY = 100 - DelV: R = radius2: C = OneKolor: gosub 1000
290 CX = 320 + DelH: CY = 100 - DelV: R = radius2 - 1: C = TwoKolor: gosub 1000
300 delay! = .125: start! = TIMER
310 WHILE TIMER < start! + delay!: WEND 'Pause
320 WEND

330 REM ** Check to see if more or quit **
340 ky$ = INPUT$(1): IF ky$ <> CHR$(27) THEN 150 'More or quit
350 END

997 rem
998 rem Non Trig or floodfill routine
999 rem
1000 Dim Radius
1010 Dim RadiusError
1020 Dim X
1030 Dim Y
1040 Radius = Abs(R)
1050 RadiusError = -Radius
1060 X = Radius
1070 Y = 0
1080 If Radius = 0 Then PSet (CX, CY), C: return
1090 line (CX - X, CY)-(CX + X, CY), C
1100 While X > Y
1110 RadiusError = RadiusError + Y * 2 + 1
1120 If RadiusError >= 0 Then If X <> Y + 1 Then line(CX - Y, CY - X)-(CX + Y, CY - X),C: line(CX - Y, CY + X)-(CX + Y, CY + X),C:X = X - 1:RadiusError = RadiusError - X * 2
1130 Y = Y + 1
1140 line(CX - X, CY - Y)-(CX + X, CY - Y),C
1150 line(CX - X, CY + Y)-(CX + X, CY + Y),C
1160 Wend
1170 return


Just for a giggle... REM the start of line number 310
May your journey be free of incident.  Live long and prosper.

CharlieJV

Quote from: johnno56 on Sep 28, 2022, 10:59 PMHere is the first conversion.

I'm enjoying all of this something silly.  Thanks !