Author Topic: Mars rotation only with using MEM  (Read 633 times)

Offline Petr

  • I am instructed.
Mars rotation only with using MEM
« on: June 19, 2018, 05:35:23 PM »
The source code shows, among other things, how to get a full circle - another option instead of Fcirc

Code: [Select]

SCREEN _NEWIMAGE(800, 600, 32) '                                                                                            my screen
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
mar& = _LOADIMAGE("mars.png", 32) '                                                                                         load Mars picture
mars& = _NEWIMAGE(800, 600, 32) '                                                                                           create new screen wit the same resolution as my screen
_PUTIMAGE , mar&, mars& '                                                                                                   insert AND RESIZE Mars picture, so now use the same resolution as My screen,
_FREEIMAGE mar& '                                                                                                           this is important because of the same offset shift in memory. This row delete original Mars picture from memory



DO
    P_Circle 400, 300, 99, mars&, _DEST 'radius can not be > 299 or memory region error occur.
    _DISPLAY
    _LIMIT 15
LOOP

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
    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)
    SHARED Shift
    Shift = Shift + 15 '                                                                       image shift. The same as X = X + 15 if you use Pset(x+shift,y)
    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
    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.
    DD = 0
    FOR y& = CY& - R& TO CY& + R& '                                                            draw only in valid quad - for axis Y, from Center Y - Radius to Center Y + Radius
        FOR x& = CX& - R& TO CX& + R& '                                                        the same condition for X axis
            xy& = ((x& - CX&) ^ 2) + ((y& - CY&) ^ 2) '
            IF R& ^ 2 >= xy& THEN '                                                            if point is on valid position in circle CX, CY, R, then
                PreS = s.OFFSET + in&(x& + Shift, y&) '                                        first calculate new offset for mars& screen (but not use it)
                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
                _MEMGET s, PreS, clr& '                                                        read one pixel color info in RGBA32
                SELECT CASE ABS(xy& - R& ^ 2) '                                                select radius from end
                    CASE IS < 2000: v = 10
                    CASE 4000 TO 2000: v = 30
                    CASE 6000 TO 4000: v = 20
                    CASE 8000 TO 6000: v = 10
                END SELECT
                IF xy& - R& ^ 2 < 8000 THEN
                    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
                END IF
                _MEMPUT d, d.OFFSET + in&(x&, y&), clr& '                                      draw it to myscreen (write this pixel to this block DEST, it is my screen)
            END IF
    NEXT x&, y&
    _MEMFREE d '                                                                                delete memory pointer to my screen from memory
    _MEMFREE s '                                                                                delete memory pointer to mars& screen from memory
END SUB

FUNCTION in& (x AS LONG, y AS LONG)
    in& = 4 * ((800 * y&) + x&) '                                                              calculate on screen positon as offset:
END FUNCTION

'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.
'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.

« Last Edit: June 20, 2018, 05:32:34 PM by Petr »

Offline johnno56

  • Live long and prosper.
Re: Mars rotation only with using MEM
« Reply #1 on: June 19, 2018, 07:00:25 PM »
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
Logic is the beginning of wisdom.

Re: Mars rotation only with using MEM
« Reply #2 on: June 19, 2018, 09:06:03 PM »
Man! got to love the speed this thing loads.
B = B + ...
QB64 x 64 v1.2 2018 0228/86 git b30af92
QB64 v1.2 20180228/86 git 6fde149
QB64 v1.2 [dev build]_d84bb00

Offline Ashish

  • The joy of coding is endless.
Re: Mars rotation only with using MEM
« Reply #3 on: June 20, 2018, 01:14:05 PM »
Great work Petr! Can you comment out the code about how is it doing that?
if (Me.success) {Me.improve()} else {Me.tryAgain()}


aKFrameWork - http://bit.ly/aKFrameWork
Menu System - http://bit.ly/guiMenuBar
p5.js in QB64 - http://bit.ly/p5jsbas

@KingOfCoders

Offline Petr

  • I am instructed.
Re: Mars rotation only with using MEM
« Reply #4 on: June 20, 2018, 05:31:40 PM »
Hi Ashish. Yes, i upgrade previous post. Here is alternative for Fcirc - easyest without MEM

Code: [Select]
SCREEN _NEWIMAGE(640, 480, 256)
CLS , 14

P_Circle2 320, 240, 199, 1, 15 'X, Y, radius, color 1, color 2

SUB P_Circle2 (CX AS LONG, CY AS LONG, R AS LONG, ClrIn AS LONG, ClrOut AS LONG)
    FOR y& = CY& - R& TO CY& + R&
        FOR x& = CX& - R& TO CX& + R&
            xy& = ((x& - CX&) ^ 2) + ((y& - CY&) ^ 2)
            IF R& ^ 2 >= xy& THEN
                SELECT CASE ABS(xy& - R& ^ 2)
                    CASE IS <= 2 * _PI * R&: clr& = ClrIn
                    CASE ELSE: clr& = ClrOut
                END SELECT
                PSET (x&, y&), clr&
            END IF
    NEXT x&, y&
END SUB

and faster alternative with MEM:

Code: [Select]
SCREEN _NEWIMAGE(640, 480, 256)
CLS , 14

P_Circle3 320, 240, 199, 1, 15 'X, Y, radius, color 1, color 2                   
SUB P_Circle3 (CX AS LONG, CY AS LONG, R AS LONG, ClrIn AS LONG, ClrOut AS LONG)
    DIM m AS _MEM, Test AS _OFFSET
    m = _MEMIMAGE(_DEST)
    W = _WIDTH(_DEST)
    H = _HEIGHT(_DEST)
    Dpth = _PIXELSIZE(_DEST)
    FOR y& = CY& - R& TO CY& + R&
        FOR x& = CX& - R& TO CX& + R&
            xy& = ((x& - CX&) ^ 2) + ((y& - CY&) ^ 2)
            IF R& ^ 2 >= xy& THEN
                SELECT CASE ABS(xy& - R& ^ 2)
                    CASE IS <= 2 * _PI * R&: clr& = ClrIn
                    CASE ELSE: clr& = ClrOut
                END SELECT
                Test = m.OFFSET + ((y& * W) + x&) * Dpth
                IF Test > m.OFFSET + ((W * H) * Dpth) OR Test < m.OFFSET THEN EXIT SUB
                _MEMPUT m, Test, clr&
            END IF
    NEXT x&, y&
    _MEMFREE m
END SUB
« Last Edit: June 20, 2018, 06:58:44 PM by Petr »

Offline Ashish

  • The joy of coding is endless.
Re: Mars rotation only with using MEM
« Reply #5 on: June 21, 2018, 10:34:54 AM »
Thanks Petr!
if (Me.success) {Me.improve()} else {Me.tryAgain()}


aKFrameWork - http://bit.ly/aKFrameWork
Menu System - http://bit.ly/guiMenuBar
p5.js in QB64 - http://bit.ly/p5jsbas

@KingOfCoders

Online FellippeHeitor

  • QB64 Developer
  • LET IT = BE
    • QB64.org
Re: Mars rotation only with using MEM
« Reply #6 on: June 21, 2018, 01:40:29 PM »
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: [Select]
SCREEN _NEWIMAGE(640, 480, 32)

green~& = _RGB32(0, 0, 255)
blue~& = _RGB32(0, 0, 255)

PRINT "Vince's filled circle routine, drawing 1000 circles"
t1 = TIMER
FOR i = 1 TO 1000
    vinceCircleFill 320, 240, 199, green~& 'X, Y, radius, color 1, color 2
NEXT
t2 = TIMER
PRINT "Done! Time elapsed: "; t2 - t1

PRINT "Petr's filled circle routine, drawing 1000 circles"
t1 = TIMER
FOR i = 1 TO 1000
    PetrCircle2 320, 240, 199, blue~&, blue~& 'X, Y, radius, color 1, color 2
NEXT
t2 = TIMER
PRINT "Done! Time elapsed: "; t2 - t1


SUB PetrCircle2 (CX AS LONG, CY AS LONG, R AS LONG, ClrIn AS LONG, ClrOut AS LONG)
    FOR y& = CY& - R& TO CY& + R&
        FOR x& = CX& - R& TO CX& + R&
            xy& = ((x& - CX&) ^ 2) + ((y& - CY&) ^ 2)
            IF R& ^ 2 >= xy& THEN
                SELECT CASE ABS(xy& - R& ^ 2)
                    CASE IS <= 2 * _PI * R&: clr& = ClrIn
                    CASE ELSE: clr& = ClrOut
                END SELECT
                PSET (x&, y&), clr&
            END IF
    NEXT x&, y&
END SUB

SUB vinceCircleFill (x AS LONG, y AS LONG, R AS LONG, C AS _UNSIGNED LONG)
    x0 = R
    y0 = 0
    e = 0
    DO WHILE y0 < x0
        IF e <= 0 THEN
            y0 = y0 + 1
            LINE (x - x0, y + y0)-(x + x0, y + y0), C, BF
            LINE (x - x0, y - y0)-(x + x0, y - y0), C, BF
            e = e + 2 * y0
        ELSE
            LINE (x - y0, y - x0)-(x + y0, y - x0), C, BF
            LINE (x - y0, y + x0)-(x + y0, y + x0), C, BF
            x0 = x0 - 1
            e = e - 2 * x0
        END IF
    LOOP
    LINE (x - R, y)-(x + R, y), C, BF
END SUB


Online FellippeHeitor

  • QB64 Developer
  • LET IT = BE
    • QB64.org
Re: Mars rotation only with using MEM
« Reply #7 on: June 21, 2018, 01:42:32 PM »
BTW, Vince's is the one we use for p5js.bas.

Online FellippeHeitor

  • QB64 Developer
  • LET IT = BE
    • QB64.org
Re: Mars rotation only with using MEM
« Reply #8 on: June 21, 2018, 01:51:51 PM »
BTW, Here's the three routines doing 10000 circles:

Code: [Select]
SCREEN _NEWIMAGE(640, 480, 32)

red~& = _RGB32(255, 0, 0)
green~& = _RGB32(0, 0, 255)
blue~& = _RGB32(0, 0, 255)

PRINT "Vince's filled circle routine, drawing 10000 circles"
t1 = TIMER
FOR i = 1 TO 10000
    vinceCircleFill 320, 240, 199, green~& 'X, Y, radius, color
NEXT
t2 = TIMER
PRINT "Done! Time elapsed: "; t2 - t1

PRINT "Steve's filled circle routine, drawing 10000 circles"
t1 = TIMER
FOR i = 1 TO 10000
    steveCircleFill 320, 240, 199, red~& 'X, Y, radius, color
NEXT
t2 = TIMER
PRINT "Done! Time elapsed: "; t2 - t1

PRINT "Petr's filled circle routine, drawing 10000 circles"
t1 = TIMER
FOR i = 1 TO 10000
    PetrCircle2 320, 240, 199, blue~&, blue~& 'X, Y, radius, color 1, color 2
NEXT
t2 = TIMER
PRINT "Done! Time elapsed: "; t2 - t1


SUB PetrCircle2 (CX AS LONG, CY AS LONG, R AS LONG, ClrIn AS LONG, ClrOut AS LONG)
    FOR y& = CY& - R& TO CY& + R&
        FOR x& = CX& - R& TO CX& + R&
            xy& = ((x& - CX&) ^ 2) + ((y& - CY&) ^ 2)
            IF R& ^ 2 >= xy& THEN
                SELECT CASE ABS(xy& - R& ^ 2)
                    CASE IS <= 2 * _PI * R&: clr& = ClrIn
                    CASE ELSE: clr& = ClrOut
                END SELECT
                PSET (x&, y&), clr&
            END IF
    NEXT x&, y&
END SUB

SUB vinceCircleFill (x AS LONG, y AS LONG, R AS LONG, C AS _UNSIGNED LONG)
    x0 = R
    y0 = 0
    e = 0
    DO WHILE y0 < x0
        IF e <= 0 THEN
            y0 = y0 + 1
            LINE (x - x0, y + y0)-(x + x0, y + y0), C, BF
            LINE (x - x0, y - y0)-(x + x0, y - y0), C, BF
            e = e + 2 * y0
        ELSE
            LINE (x - y0, y - x0)-(x + y0, y - x0), C, BF
            LINE (x - y0, y + x0)-(x + y0, y + x0), C, BF
            x0 = x0 - 1
            e = e - 2 * x0
        END IF
    LOOP
    LINE (x - R, y)-(x + R, y), C, BF
END SUB

SUB steveCircleFill (CX AS LONG, CY AS LONG, R AS LONG, C AS _UNSIGNED LONG)
    'This sub from here: http://www.qb64.net/forum/index.php?topic=1848.msg17254#msg17254
    DIM Radius AS LONG
    DIM RadiusError AS LONG
    DIM X AS LONG
    DIM Y AS LONG

    Radius = ABS(R)
    RadiusError = -Radius
    X = Radius
    Y = 0

    IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB

    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    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

Offline Petr

  • I am instructed.
Re: Mars rotation only with using MEM
« Reply #9 on: June 21, 2018, 02:28:15 PM »
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.

Offline Petr

  • I am instructed.
Re: Mars rotation only with using MEM
« Reply #10 on: June 21, 2018, 03:29:57 PM »
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: [Select]

DIM SHARED m AS _MEM
J& = _NEWIMAGE(800, 600, 32)
m = _MEMIMAGE(J&)
SCREEN J&

T = TIMER

FOR test = 1 TO 10000
    vinceCircleFill 400, 300, 200, _RGB32(0, 255, 0)
NEXT test

PRINT TIMER - T

SUB vinceCircleFill (x AS LONG, y AS LONG, R AS LONG, C AS _UNSIGNED LONG)
    x0 = R
    y0 = 0
    e = 0
    DO WHILE y0 < x0
        IF e <= 0 THEN
            y0 = y0 + 1
            MEM_LINE x - x0, y + y0, x + x0, y + y0, C
            MEM_LINE x - x0, y - y0, x + x0, y - y0, C
            e = e + 2 * y0
        ELSE
            MEM_LINE x - y0, y - x0, x + y0, y - x0, C
            MEM_LINE x - y0, y + x0, x + y0, y + x0, C
            x0 = x0 - 1
            e = e - 2 * x0
        END IF
    LOOP
    MEM_LINE x - R, y, x + R, y, C
END SUB

SUB MEM_LINE (x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, clr AS LONG)
    DEFLNG A-Z
    dX = x2 - x1
    dY = y2 - y1
    IF dX > dY OR dX = dY THEN
        x = x1: y = y1
        DO WHILE x <> x2
            x = x + 1
            y = y + (dY / dX)
            _MEMPUT m, m.OFFSET + IN&(x, y), clr&
        LOOP
    END IF
    IF dY > dX THEN
        x = x1: y = y1
        DO WHILE y <> y2
            x = x + (dX / dY)
            y = y + 1
            _MEMPUT m, m.OFFSET + IN&(x, y), clr&
        LOOP
    END IF
    IF x1 = x2 THEN
        FOR d = y1 TO y2
            _MEMPUT m, m.OFFSET + IN&(x1, d), clr&
        NEXT d
    END IF
    IF y1 = y2 THEN
        FOR d = x1 TO x2
            _MEMPUT m, m.OFFSET + IN&(d, y1), clr&
        NEXT d
    END IF
END SUB

FUNCTION IN& (x AS INTEGER, y AS INTEGER)
    IN& = (_WIDTH * y + x) * 4
END FUNCTION


Offline Petr

  • I am instructed.
Re: Mars rotation only with using MEM
« Reply #11 on: June 21, 2018, 04:35:32 PM »
So, this code return 10.000 circles in 0.7 seconds. Its neverest sub which write now.

Code: [Select]
SCREEN _NEWIMAGE(640, 480, 32)
J& = _SCREENIMAGE
I& = _COPYIMAGE(J&, 33) '                                                             use hardware acceleration
_FREEIMAGE J&
T = TIMER
FOR x = 1 TO 10000
    Rectangle 320, 240, 45, 199, I& 'X axis, Y axis, Vertex number, Radius, Texture&
NEXT
PRINT TIMER - T
END



SUB Rectangle (X AS INTEGER, Y AS INTEGER, N AS INTEGER, Radius AS INTEGER, Source AS LONG)
    bod = 628 / N
    FOR g! = 0 TO 6.48 STEP 0.01
        IF h MOD bod = 0 THEN
            IF oldx = 0 THEN oldx = X: oldy = Y
            _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)
            oldx = X + SIN(g!) * Radius: oldy = Y + COS(g!) * Radius
        END IF
        h = h + 1
    NEXT g!
END SUB


Re: Mars rotation only with using MEM
« Reply #12 on: June 23, 2018, 11:59:52 PM »
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: [Select]
defint a-z
screen _newimage(640,480,32)

circle (320,240),50,_rgb(255,0,0),,,1
color _rgba(0,255,0,100)
stevecf 320,240,50

circle (320,350),50,_rgb(255,0,0),,,1
circlef 320,350,50,_rgba(0,255,0,100)


'vince's circle fill
sub circlef (x, y, r, c as long)
x0 = r
y0 = 0
e = -r
do while y0 < x0
if e <= 0 then
y0 = y0 + 1
line (x-x0, y+y0)-(x+x0, y+y0), c, bf
line (x-x0, y-y0)-(x+x0, y-y0), c, bf
e = e + 2*y0
else
line (x-y0, y-x0)-(x+y0, y-x0), c, bf
line (x-y0, y+x0)-(x+y0, y+x0), c, bf
x0 = x0 - 1
e = e - 2*x0
end if
loop
line (x-r,y)-(x+r,y),c,bf
end sub

'Steve McNeil's  copied from his forum   note: Radius is too common a name ;-)
SUB stevecf (CX AS LONG, CY AS LONG, R AS LONG)
    DIM subRadius AS LONG, RadiusError AS LONG
    DIM X AS LONG, Y AS LONG

    subRadius = ABS(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB

    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on. ;-)
    LINE (CX - X, CY)-(CX + X, CY), , 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), , BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
    WEND
END SUB

Re: Mars rotation only with using MEM
« Reply #13 on: June 24, 2018, 12:34:52 AM »
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.

Re: Mars rotation only with using MEM
« Reply #14 on: June 24, 2018, 10:42:07 AM »
Wait... Vince, yours is faster and better than Steve's?

Wow I've got to check it out! Thanks
B = B + ...
QB64 x 64 v1.2 2018 0228/86 git b30af92
QB64 v1.2 20180228/86 git 6fde149
QB64 v1.2 [dev build]_d84bb00