Mars rotation only with using MEM

[Petr]

The source code shows, among other things, how to get a full circle - another option instead of Fcirc

Code: QB64: [Select]

1.  
2. SCREEN _NEWIMAGE(800, 600, 32) '                                                                                            my screen
3. DIM SHARED mars AS LONG, d AS _MEM, S AS _MEM '                                                                             Mars as long is shared for accessible it in sub P_Circle, d and S are memory images
4. mar& = _LOADIMAGE("mars.png", 32) '                                                                                         load Mars picture
5. mars& = _NEWIMAGE(800, 600, 32) '                                                                                           create new screen wit the same resolution as my screen
6. _PUTIMAGE , mar&, mars& '                                                                                                   insert AND RESIZE Mars picture, so now use the same resolution as My screen,
7. _FREEIMAGE mar& '                                                                                                           this is important because of the same offset shift in memory. This row delete original Mars picture from memory
8.  
9.  
10.  
11. DO
12.     P_Circle 400, 300, 99, mars&, _DEST 'radius can not be > 299 or memory region error occur.
13.     _DISPLAY
14.     _LIMIT 15
15. LOOP
16.  
17. SUB P_Circle (CX AS LONG, CY AS LONG, R AS LONG, source AS LONG, dest AS LONG) '               CX = center X, CY = center Y, R = radius, Source - in this case mars&, Dest - in this case My screen, also _DEST
18.     DIM d AS _MEM, s AS _MEM, clr AS LONG, Smax AS _OFFSET, PreS AS _OFFSET '                  d is for dest(My screen) memory image, S is for mars& memory image, Clr is for pixel color in RGB32 format, Smax is maximum Offset value for S and Pres is as pre - s (before is offset used, for test if is in valid range)
19.     SHARED Shift
20.     Shift = Shift + 15 '                                                                       image shift. The same as X = X + 15 if you use Pset(x+shift,y)
21.     d = _MEMIMAGE(dest&): s = _MEMIMAGE(source&) '                                             create from d pointer to memory area, to begin My screen and from s pointer to memory area to begin mars& screen
22.     Smax = s.OFFSET + (_WIDTH(mars&) * _HEIGHT(mars&) * 4) - 1 '                               calculate LAST valid offset for memory area with mars&. Its 32 bit (4 byte) screen, so * 4. For 256 color screen it is 8 bit (1 byte), so * 1. - 1, because is none offset zero.
23.     DD = 0
24.     FOR y& = CY& - R& TO CY& + R& '                                                            draw only in valid quad - for axis Y, from Center Y - Radius to Center Y + Radius
25.         FOR x& = CX& - R& TO CX& + R& '                                                        the same condition for X axis
26.             xy& = ((x& - CX&) ^ 2) + ((y& - CY&) ^ 2) '
27.             IF R& ^ 2 >= xy& THEN '                                                            if point is on valid position in circle CX, CY, R, then
28.                 PreS = s.OFFSET + in&(x& + Shift, y&) '                                        first calculate new offset for mars& screen (but not use it)
29.                 IF PreS < s.OFFSET OR PreS > Smax THEN PreS = s.OFFSET '                       if calculated offset is out of range, skip to memory block contains mars& image begin
30.                 _MEMGET s, PreS, clr& '                                                        read one pixel color info in RGBA32
31.                 SELECT CASE ABS(xy& - R& ^ 2) '                                                select radius from end
32.                     CASE IS < 2000: v = 10
33.                     CASE 4000 TO 2000: v = 30
34.                     CASE 6000 TO 4000: v = 20
35.                     CASE 8000 TO 6000: v = 10
36.                 END SELECT
37.                 IF xy& - R& ^ 2 < 8000 THEN
38.                     clr& = _RGB32(_RED32(clr&) + v, _GREEN32(clr&) - v, _BLUE32(clr&) - v) '   set different this one pixel read on line 29 in this radius with selected color
39.                 END IF
40.                 _MEMPUT d, d.OFFSET + in&(x&, y&), clr& '                                      draw it to myscreen (write this pixel to this block DEST, it is my screen)
41.             END IF
42.     NEXT x&, y&
43.     _MEMFREE d '                                                                                delete memory pointer to my screen from memory
44.     _MEMFREE s '                                                                                delete memory pointer to mars& screen from memory
45. END SUB
46.  
47. FUNCTION in& (x AS LONG, y AS LONG)
48.     in& = 4 * ((800 * y&) + x&) '                                                              calculate on screen positon as offset:
49. END FUNCTION
50.  
51. 'if you draw point to X = 130 and Y = 100 on screen 320 x 200, then this memory offset is: Your pointer.offset (start value which give you MEM) + width (320) * 100 + 130, also 32130 + begin for 256 colors.
52. 'if you use _MEMPUT yourMEM, yourMEM.offset + 321, it is the same as PSET (2,1) on screen 320 x 200, 256 colors. But for 32 bit it is yourMEM.offset + 4 * 321, beacuse 32 bit use LONG 4 byte values.
53.  
54.  

[johnno56]

Very cool indeed. Modifying 'shift' to a lower number would 'slow' the rotation and changing it to a negative number would reverse the rotation... Cool

Great job!

J

[bplus]

Man! got to love the speed this thing loads.

[Ashish]

Great work Petr! Can you comment out the code about how is it doing that?

[Petr]

Hi Ashish. Yes, i upgrade previous post. Here is alternative for Fcirc - easyest without MEM

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(640, 480, 256)
2. CLS , 14
3.  
4. P_Circle2 320, 240, 199, 1, 15 'X, Y, radius, color 1, color 2
5.  
6. SUB P_Circle2 (CX AS LONG, CY AS LONG, R AS LONG, ClrIn AS LONG, ClrOut AS LONG)
7.     FOR y& = CY& - R& TO CY& + R&
8.         FOR x& = CX& - R& TO CX& + R&
9.             xy& = ((x& - CX&) ^ 2) + ((y& - CY&) ^ 2)
10.             IF R& ^ 2 >= xy& THEN
11.                 SELECT CASE ABS(xy& - R& ^ 2)
12.                     CASE IS <= 2 * _PI * R&: clr& = ClrIn
13.                     CASE ELSE: clr& = ClrOut
14.                 END SELECT
15.                 PSET (x&, y&), clr&
16.             END IF
17.     NEXT x&, y&
18. END SUB
19.  

and faster alternative with MEM:

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(640, 480, 256)
2. CLS , 14
3.  
4. P_Circle3 320, 240, 199, 1, 15 'X, Y, radius, color 1, color 2                  
5. SUB P_Circle3 (CX AS LONG, CY AS LONG, R AS LONG, ClrIn AS LONG, ClrOut AS LONG)
6.     DIM m AS _MEM, Test AS _OFFSET
7.     m = _MEMIMAGE(_DEST)
8.     W = _WIDTH(_DEST)
9.     H = _HEIGHT(_DEST)
10.     Dpth = _PIXELSIZE(_DEST)
11.     FOR y& = CY& - R& TO CY& + R&
12.         FOR x& = CX& - R& TO CX& + R&
13.             xy& = ((x& - CX&) ^ 2) + ((y& - CY&) ^ 2)
14.             IF R& ^ 2 >= xy& THEN
15.                 SELECT CASE ABS(xy& - R& ^ 2)
16.                     CASE IS <= 2 * _PI * R&: clr& = ClrIn
17.                     CASE ELSE: clr& = ClrOut
18.                 END SELECT
19.                 Test = m.OFFSET + ((y& * W) + x&) * Dpth
20.                 IF Test > m.OFFSET + ((W * H) * Dpth) OR Test < m.OFFSET THEN EXIT SUB
21.                 _MEMPUT m, Test, clr&
22.             END IF
23.     NEXT x&, y&
24.     _MEMFREE m
25. END SUB
26.  

[Ashish]

Thanks Petr!

[FellippeHeitor]

Hi Petr. There's Steve's traditional circle fill sub and there's Vince's, which you may not have seen yet. Yours must become a bit faster to stack against it:

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(640, 480, 32)
2.  
3. green~& = _RGB32(0, 0, 255)
4. blue~& = _RGB32(0, 0, 255)
5.  
6. PRINT "Vince's filled circle routine, drawing 1000 circles"
7. t1 = TIMER
8. FOR i = 1 TO 1000
9.     vinceCircleFill 320, 240, 199, green~& 'X, Y, radius, color 1, color 2
10. NEXT
11. t2 = TIMER
12. PRINT "Done! Time elapsed: "; t2 - t1
13.  
14. PRINT "Petr's filled circle routine, drawing 1000 circles"
15. t1 = TIMER
16. FOR i = 1 TO 1000
17.     PetrCircle2 320, 240, 199, blue~&, blue~& 'X, Y, radius, color 1, color 2
18. NEXT
19. t2 = TIMER
20. PRINT "Done! Time elapsed: "; t2 - t1
21.  
22.  
23. SUB PetrCircle2 (CX AS LONG, CY AS LONG, R AS LONG, ClrIn AS LONG, ClrOut AS LONG)
24.     FOR y& = CY& - R& TO CY& + R&
25.         FOR x& = CX& - R& TO CX& + R&
26.             xy& = ((x& - CX&) ^ 2) + ((y& - CY&) ^ 2)
27.             IF R& ^ 2 >= xy& THEN
28.                 SELECT CASE ABS(xy& - R& ^ 2)
29.                     CASE IS <= 2 * _PI * R&: clr& = ClrIn
30.                     CASE ELSE: clr& = ClrOut
31.                 END SELECT
32.                 PSET (x&, y&), clr&
33.             END IF
34.     NEXT x&, y&
35. END SUB
36.  
37. SUB vinceCircleFill (x AS LONG, y AS LONG, R AS LONG, C AS _UNSIGNED LONG)
38.     x0 = R
39.     y0 = 0
40.     e = 0
41.     DO WHILE y0 < x0
42.         IF e <= 0 THEN
43.             y0 = y0 + 1
44.             LINE (x - x0, y + y0)-(x + x0, y + y0), C, BF
45.             LINE (x - x0, y - y0)-(x + x0, y - y0), C, BF
46.             e = e + 2 * y0
47.         ELSE
48.             LINE (x - y0, y - x0)-(x + y0, y - x0), C, BF
49.             LINE (x - y0, y + x0)-(x + y0, y + x0), C, BF
50.             x0 = x0 - 1
51.             e = e - 2 * x0
52.         END IF
53.     LOOP
54.     LINE (x - R, y)-(x + R, y), C, BF
55. END SUB
56.  
57.  

[FellippeHeitor]

BTW, Vince's is the one we use for p5js.bas.

[FellippeHeitor]

BTW, Here's the three routines doing 10000 circles:

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(640, 480, 32)
2.  
3. red~& = _RGB32(255, 0, 0)
4. green~& = _RGB32(0, 0, 255)
5. blue~& = _RGB32(0, 0, 255)
6.  
7. PRINT "Vince's filled circle routine, drawing 10000 circles"
8. t1 = TIMER
9. FOR i = 1 TO 10000
10.     vinceCircleFill 320, 240, 199, green~& 'X, Y, radius, color
11. NEXT
12. t2 = TIMER
13. PRINT "Done! Time elapsed: "; t2 - t1
14.  
15. PRINT "Steve's filled circle routine, drawing 10000 circles"
16. t1 = TIMER
17. FOR i = 1 TO 10000
18.     steveCircleFill 320, 240, 199, red~& 'X, Y, radius, color
19. NEXT
20. t2 = TIMER
21. PRINT "Done! Time elapsed: "; t2 - t1
22.  
23. PRINT "Petr's filled circle routine, drawing 10000 circles"
24. t1 = TIMER
25. FOR i = 1 TO 10000
26.     PetrCircle2 320, 240, 199, blue~&, blue~& 'X, Y, radius, color 1, color 2
27. NEXT
28. t2 = TIMER
29. PRINT "Done! Time elapsed: "; t2 - t1
30.  
31.  
32. SUB PetrCircle2 (CX AS LONG, CY AS LONG, R AS LONG, ClrIn AS LONG, ClrOut AS LONG)
33.     FOR y& = CY& - R& TO CY& + R&
34.         FOR x& = CX& - R& TO CX& + R&
35.             xy& = ((x& - CX&) ^ 2) + ((y& - CY&) ^ 2)
36.             IF R& ^ 2 >= xy& THEN
37.                 SELECT CASE ABS(xy& - R& ^ 2)
38.                     CASE IS <= 2 * _PI * R&: clr& = ClrIn
39.                     CASE ELSE: clr& = ClrOut
40.                 END SELECT
41.                 PSET (x&, y&), clr&
42.             END IF
43.     NEXT x&, y&
44. END SUB
45.  
46. SUB vinceCircleFill (x AS LONG, y AS LONG, R AS LONG, C AS _UNSIGNED LONG)
47.     x0 = R
48.     y0 = 0
49.     e = 0
50.     DO WHILE y0 < x0
51.         IF e <= 0 THEN
52.             y0 = y0 + 1
53.             LINE (x - x0, y + y0)-(x + x0, y + y0), C, BF
54.             LINE (x - x0, y - y0)-(x + x0, y - y0), C, BF
55.             e = e + 2 * y0
56.         ELSE
57.             LINE (x - y0, y - x0)-(x + y0, y - x0), C, BF
58.             LINE (x - y0, y + x0)-(x + y0, y + x0), C, BF
59.             x0 = x0 - 1
60.             e = e - 2 * x0
61.         END IF
62.     LOOP
63.     LINE (x - R, y)-(x + R, y), C, BF
64. END SUB
65.  
66. SUB steveCircleFill (CX AS LONG, CY AS LONG, R AS LONG, C AS _UNSIGNED LONG)
67.     'This sub from here: http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=1848.msg17254#msg17254
68.     DIM Radius AS LONG
69.     DIM RadiusError AS LONG
70.     DIM X AS LONG
71.     DIM Y AS LONG
72.  
73.     Radius = ABS(R)
74.     RadiusError = -Radius
75.     X = Radius
76.     Y = 0
77.  
78.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
79.  
80.     ' Draw the middle span here so we don't draw it twice in the main loop,
81.     ' which would be a problem with blending turned on.
82.     LINE (CX - X, CY)-(CX + X, CY), C, BF
83.  
84.     WHILE X > Y
85.  
86.         RadiusError = RadiusError + Y * 2 + 1
87.  
88.         IF RadiusError >= 0 THEN
89.  
90.             IF X <> Y + 1 THEN
91.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
92.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
93.             END IF
94.  
95.             X = X - 1
96.             RadiusError = RadiusError - X * 2
97.  
98.         END IF
99.  
100.         Y = Y + 1
101.  
102.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
103.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
104.  
105.     WEND
106.  
107. END SUB
108.  

[Petr]

I not test speed. The laziness of my program is totally terrible. Well, I'm still learning. Hats down before the authors of both much faster programs. The error is in my concept. It requires a deep reflection.

[Petr]

Fellippe, when you started with comparing time, which is very beneficial to all, I give this code here. I made the analogy of the LINE command via MEMPUT. Even though I expected great speed, but  the result is to cry. It's a terrible lemur lazy. Could you tell me what I was doing here bad again? Thank you.

Code: QB64: [Select]

1.  
2. DIM SHARED m AS _MEM
3. J& = _NEWIMAGE(800, 600, 32)
4. m = _MEMIMAGE(J&)
5. SCREEN J&
6.  
7. T = TIMER
8.  
9. FOR test = 1 TO 10000
10.     vinceCircleFill 400, 300, 200, _RGB32(0, 255, 0)
11. NEXT test
12.  
13. PRINT TIMER - T
14.  
15. SUB vinceCircleFill (x AS LONG, y AS LONG, R AS LONG, C AS _UNSIGNED LONG)
16.     x0 = R
17.     y0 = 0
18.     e = 0
19.     DO WHILE y0 < x0
20.         IF e <= 0 THEN
21.             y0 = y0 + 1
22.             MEM_LINE x - x0, y + y0, x + x0, y + y0, C
23.             MEM_LINE x - x0, y - y0, x + x0, y - y0, C
24.             e = e + 2 * y0
25.         ELSE
26.             MEM_LINE x - y0, y - x0, x + y0, y - x0, C
27.             MEM_LINE x - y0, y + x0, x + y0, y + x0, C
28.             x0 = x0 - 1
29.             e = e - 2 * x0
30.         END IF
31.     LOOP
32.     MEM_LINE x - R, y, x + R, y, C
33. END SUB
34.  
35. SUB MEM_LINE (x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, clr AS LONG)
36.     DEFLNG A-Z
37.     dX = x2 - x1
38.     dY = y2 - y1
39.     IF dX > dY OR dX = dY THEN
40.         x = x1: y = y1
41.         DO WHILE x <> x2
42.             x = x + 1
43.             y = y + (dY / dX)
44.             _MEMPUT m, m.OFFSET + IN&(x, y), clr&
45.         LOOP
46.     END IF
47.     IF dY > dX THEN
48.         x = x1: y = y1
49.         DO WHILE y <> y2
50.             x = x + (dX / dY)
51.             y = y + 1
52.             _MEMPUT m, m.OFFSET + IN&(x, y), clr&
53.         LOOP
54.     END IF
55.     IF x1 = x2 THEN
56.         FOR d = y1 TO y2
57.             _MEMPUT m, m.OFFSET + IN&(x1, d), clr&
58.         NEXT d
59.     END IF
60.     IF y1 = y2 THEN
61.         FOR d = x1 TO x2
62.             _MEMPUT m, m.OFFSET + IN&(d, y1), clr&
63.         NEXT d
64.     END IF
65. END SUB
66.  
67. FUNCTION IN& (x AS INTEGER, y AS INTEGER)
68.     IN& = (_WIDTH * y + x) * 4
69. END FUNCTION
70.  
71.  

[Petr]

So, this code return 10.000 circles in 0.7 seconds. Its neverest sub which write now.

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(640, 480, 32)
2. J& = _SCREENIMAGE
3. I& = _COPYIMAGE(J&, 33) '                                                             use hardware acceleration
4. _FREEIMAGE J&
5. T = TIMER
6. FOR x = 1 TO 10000
7.     Rectangle 320, 240, 45, 199, I& 'X axis, Y axis, Vertex number, Radius, Texture&
8. NEXT
9. PRINT TIMER - T
10. END
11.  
12.  
13.  
14. SUB Rectangle (X AS INTEGER, Y AS INTEGER, N AS INTEGER, Radius AS INTEGER, Source AS LONG)
15.     bod = 628 / N
16.     FOR g! = 0 TO 6.48 STEP 0.01
17.         IF h MOD bod = 0 THEN
18.             IF oldx = 0 THEN oldx = X: oldy = Y
19.             _MAPTRIANGLE (oldx, oldy)-(X + SIN(g!) * Radius, Y + COS(g!) * Radius)-(X, Y), Source& TO(oldx, oldy)-(X + SIN(g!) * Radius, Y + COS(g!) * Radius)-(X, Y)
20.             oldx = X + SIN(g!) * Radius: oldy = Y + COS(g!) * Radius
21.         END IF
22.         h = h + 1
23.     NEXT g!
24. END SUB
25.  
26.  

[_vince]

I'm no steve but I've noticed that both mine and steve's seem a little off of QB64's CIRCLE, mine is slightly larger while steve's is slightly smaller.  Also, steve's is slightly asymmetrical. It's barely noticeable but worth investigating.

Code: QB64: [Select]

1. defint a-z
2. screen _newimage(640,480,32)
3.  
4. circle (320,240),50,_rgb(255,0,0),,,1
5. color _rgba(0,255,0,100)
6. stevecf 320,240,50
7.  
8. circle (320,350),50,_rgb(255,0,0),,,1
9. circlef 320,350,50,_rgba(0,255,0,100)
10.  
11.  
12. 'vince's circle fill
13. sub circlef (x, y, r, c as long)
14.         x0 = r
15.         y0 = 0
16.         e = -r
17.         do while y0 < x0
18.                 if e <= 0 then
19.                         y0 = y0 + 1
20.                         line (x-x0, y+y0)-(x+x0, y+y0), c, bf
21.                         line (x-x0, y-y0)-(x+x0, y-y0), c, bf
22.                         e = e + 2*y0
23.                 else
24.                         line (x-y0, y-x0)-(x+y0, y-x0), c, bf
25.                         line (x-y0, y+x0)-(x+y0, y+x0), c, bf
26.                         x0 = x0 - 1
27.                         e = e - 2*x0
28.                 end if
29.         loop
30.         line (x-r,y)-(x+r,y),c,bf
31. end sub
32.  
33. 'Steve McNeil's  copied from his forum   note: Radius is too common a name ;-)
34. SUB stevecf (CX AS LONG, CY AS LONG, R AS LONG)
35.     DIM subRadius AS LONG, RadiusError AS LONG
36.     DIM X AS LONG, Y AS LONG
37.  
38.     subRadius = ABS(R)
39.     RadiusError = -subRadius
40.     X = subRadius
41.     Y = 0
42.  
43.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
44.  
45.     ' Draw the middle span here so we don't draw it twice in the main loop,
46.     ' which would be a problem with blending turned on. ;-)
47.     LINE (CX - X, CY)-(CX + X, CY), , BF
48.  
49.     WHILE X > Y
50.         RadiusError = RadiusError + Y * 2 + 1
51.         IF RadiusError >= 0 THEN
52.             IF X <> Y + 1 THEN
53.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
54.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
55.             END IF
56.             X = X - 1
57.             RadiusError = RadiusError - X * 2
58.         END IF
59.         Y = Y + 1
60.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
61.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
62.     WEND
63. END SUB
64.  

[_vince]

If anyone cares to do the math on it, here's a close up. Steve's on the left.

The circle is perhaps the simplest example of perfection.  Something being perfectly round does not exist in reality but it is, as an abstract concept, something we can easily conceive.  Steve introduces slight asymmetry in his own conception of the circle within the realm of QB64 to remind us of the nature of truth and reality.

[bplus]

Wait... Vince, yours is faster and better than Steve's?

Wow I've got to check it out! Thanks