Author Topic: Ray Trace a translation from SpecBAS (Read 8547 times)

bplus · « **on:** February 26, 2022, 02:39:54 pm »

by Paul Dunn here was the original SpecBAS code:

10 PAPER 0: INK 15: CLS:
 palette 16,255,255,255:
 palette 32,0,192,255:
 palette 255,0,0,192:
 rainbow 16 to 32:
 rainbow 32 to 255
20 read spheres:t=msecs:
 DIM c(spheres,3),r(spheres),q(spheres),cl(4):
 w=scrw/2,h=scrh/2,s=0:
 cl(1)=6,cl(2)=1,
 cl(3)=cl(1)+8,cl(4)=cl(2)+8
30 FOR k=1 TO spheres:
    READ c(k,1),c(k,2),c(k,3),r:
    r(k)=r,q(k)=r*r:
 NEXT k
40 data 6:
 DATA -0.3,-0.8,3,0.6
50 DATA 0.9,-1.4,3.5,0.35:
 data 0.7,-0.45,2.5,0.4:
 data -0.5,-0.3,1.5,0.15:
 DATA 1.0,-0.2,1.5,0.1:
 DATA -0.1,-0.2,1.25,0.2
60 FOR i=1 TO scrh:
    FOR j=0 TO scrw-1
70       x=0.3,y=-0.5,z=0,ba=3:
       dx=j-w,dy=h-i,dz=(scrh/480)*600,
       dd=dx*dx+dy*dy+dz*dz
80       n=-(y>=0 OR dy<=0):
       IF n=0 THEN
          s=-y/dy
90       FOR k=1 TO spheres:
          px=c(k,1)-x,py=c(k,2)-y,pz=c(k,3)-z,
          pp=px*px+py*py+pz*pz,
          sc=px*dx+py*dy+pz*dz:
          IF sc<=0 THEN
             GO TO 120
100          bb=sc*sc/dd,
          aa=q(k)-pp+bb:
          IF aa<=0 THEN
             GO TO 120
110          sc=(SQR bb-SQR aa)/SQR dd:
          IF sc<s OR n<0 THEN
             n=k,s=sc
120       NEXT k
130       IF n<0 THEN
          plot ink 16+(dy*dy/dd)*240;j,scrh-i:
          go to 200
140       dx=dx*s,dy=dy*s,dz=dz*s,dd=dd*s*s,
       x+=dx,y+=dy,z+=dz:
       IF n<>0 THEN
           nx=x-c(n,1),ny=y-c(n,2),nz=z-c(n,3),
          nn=nx*nx+ny*ny+nz*nz,
          l=2*(dx*nx+dy*ny+dz*nz)/nn,
          dx=dx-nx*l,dy=dy-ny*l,dz=dz-nz*l:
          GO TO 80
160       FOR k=1 TO spheres:
          u=c(k,1)-x,
          v=c(k,3)-z:
          IF u*u+v*v<=q(k) THEN
             ba=1:
             go to 180
170       NEXT k
180       IF (x-INT x>.5)=(z-INT z>.5) THEN
          ik=cl(ba)
       else
          ik=cl(ba+1)
190       plot ink ik;j,scrh-i       
200    NEXT j:
 NEXT i
210 print at 0,0;transparent 1;ink 0;"Time: ";(msecs-t)/1000;" secs":
 pause 0:

Thanks to Rod at Just Basic for getting ball rolling for JB version, pretty easy from there to QB64

Code: QB64: [Select]

_Title "RayTrace" 'b+ trans from JB to QB64 2022-02-26
Const scrw = 1024, scrh = 680
Screen _NewImage(scrw, scrh, 32)
_ScreenMove 150, 40
Read spheres
Dim c(spheres, 3), r(spheres), q(spheres), cl(4) As _Unsigned Long
w = scrw / 2
h = scrh / 2
s = 0
cl(1) = _RGB32(120, 65, 45) ' shaddow
cl(2) = _RGB32(0, 0, 100)
cl(3) = _RGB32(255, 255, 0)
cl(4) = _RGB32(0, 0, 200)
For k = 1 To spheres
    Read a, b, c, d
    c(k, 1) = a
    c(k, 2) = b
    c(k, 3) = c
    r = d
    r(k) = r
    q(k) = r * r
Next k
 
For i = 1 To scrh
    For j = 0 To scrw - 1
        x = 0.3: y = -0.5: z = 0: ba = 3
        dx = j - w: dy = h - i: dz = (scrh / 480) * 600
        dd = dx * dx + dy * dy + dz * dz
        recursion:
        n = (y >= 0 Or dy <= 0) '* -1   <<< Makes $1000 for knowing where to tap the hammer
        If n = 0 Then s = (y / dy) * -1
        For k = 1 To spheres
            px = c(k, 1) - x: py = c(k, 2) - y: pz = c(k, 3) - z
            pp = px * px + py * py + pz * pz
            sc = px * dx + py * dy + pz * dz
            If sc <= 0 Then GoTo donek
            bb = sc * sc / dd
            aa = q(k) - pp + bb
            If aa <= 0 Then GoTo donek
            sc = (Sqr(bb) - Sqr(aa)) / Sqr(dd)
            If sc < s Or n < 0 Then n = k: s = sc
            donek:
        Next k
        If n < 0 Then
            PSet (j, scrh - i), _RGB32(128 * (scrh - i) / scrh + 128 * (dy * dy / dd), 128 * (scrh - i) / scrh + 128 * (dy * dy / dd), 200 + 55 * (dy * dy / dd))
            GoTo donej
        End If
        dx = dx * s: dy = dy * s: dz = dz * s: dd = dd * s * s
        x = x + dx: y = y + dy: z = z + dz
        If n <> 0 Then
            nx = x - c(n, 1): ny = y - c(n, 2): nz = z - c(n, 3)
            nn = nx * nx + ny * ny + nz * nz
            l = 2 * (dx * nx + dy * ny + dz * nz) / nn
            dx = dx - nx * l: dy = dy - ny * l: dz = dz - nz * l
            GoTo recursion
        End If
        For k = 1 To spheres
            u = c(k, 1) - x
            v = c(k, 3) - z
            If u * u + v * v <= q(k) Then ba = 1: Exit For
        Next k
        If (x - Int(x) > .5) = (z - Int(z) > .5) Then
            PSet (j, scrh - i), cl(ba)
        Else
            PSet (j, scrh - i), cl(ba + 1)
        End If
        donej:
    Next j
Next i
Sleep
 
Data 6
Data -0.3,-0.8,3,0.6
Data 0.9,-1.4,3.5,0.35
Data 0.7,-0.45,2.5,0.4
Data -0.5,-0.3,1.5,0.15
Data 1.0,-0.2,1.5,0.1
Data -0.1,-0.2,1.25,0.2
 
 

Pete · « **Reply #1 on:** February 26, 2022, 03:19:44 pm »

Oh balls!

or... Oh balls, there's a bunch of GOTO statements in the translation. Hmmm, let's see. How about...

Code: QB64: [Select]

_TITLE "RayTrace" 'b+ trans from JB to QB64 2022-02-26
CONST scrw = 1024, scrh = 680
SCREEN _NEWIMAGE(scrw, scrh, 32)
_SCREENMOVE 150, 40
READ spheres
DIM c(spheres, 3), r(spheres), q(spheres), cl(4) AS _UNSIGNED LONG
w = scrw / 2
h = scrh / 2
s = 0
cl(1) = _RGB32(120, 65, 45) ' shaddow
cl(2) = _RGB32(0, 0, 100)
cl(3) = _RGB32(255, 255, 0)
cl(4) = _RGB32(0, 0, 200)
FOR k = 1 TO spheres
    READ a, b, c, d
    c(k, 1) = a
    c(k, 2) = b
    c(k, 3) = c
    r = d
    r(k) = r
    q(k) = r * r
NEXT k
 
FOR i = 1 TO scrh
    FOR j = 0 TO scrw - 1
        x = 0.3: y = -0.5: z = 0: ba = 3
        dx = j - w: dy = h - i: dz = (scrh / 480) * 600
        dd = dx * dx + dy * dy + dz * dz
        DO
            n = (y >= 0 OR dy <= 0) '* -1   <<< Makes $1000 for knowing where to tap the hammer
            IF n = 0 THEN s = (y / dy) * -1
            FOR k = 1 TO spheres
                px = c(k, 1) - x: py = c(k, 2) - y: pz = c(k, 3) - z
                pp = px * px + py * py + pz * pz
                sc = px * dx + py * dy + pz * dz
                IF sc > 0 THEN
                    bb = sc * sc / dd
                    aa = q(k) - pp + bb
                    IF aa > 0 THEN
                        sc = (SQR(bb) - SQR(aa)) / SQR(dd)
                        IF sc < s OR n < 0 THEN n = k: s = sc
                    END IF
                END IF
            NEXT k
            IF n < 0 THEN
                PSET (j, scrh - i), _RGB32(128 * (scrh - i) / scrh + 128 * (dy * dy / dd), 128 * (scrh - i) / scrh + 128 * (dy * dy / dd), 200 + 55 * (dy * dy / dd))
                EXIT DO
            ELSE
                dx = dx * s: dy = dy * s: dz = dz * s: dd = dd * s * s
                x = x + dx: y = y + dy: z = z + dz
                IF n <> 0 THEN
                    nx = x - c(n, 1): ny = y - c(n, 2): nz = z - c(n, 3)
                    nn = nx * nx + ny * ny + nz * nz
                    l = 2 * (dx * nx + dy * ny + dz * nz) / nn
                    dx = dx - nx * l: dy = dy - ny * l: dz = dz - nz * l
                ELSE
                    FOR k = 1 TO spheres
                        u = c(k, 1) - x
                        v = c(k, 3) - z
                        IF u * u + v * v <= q(k) THEN ba = 1: EXIT FOR
                    NEXT k
                    IF (x - INT(x) > .5) = (z - INT(z) > .5) THEN
                        PSET (j, scrh - i), cl(ba)
                    ELSE
                        PSET (j, scrh - i), cl(ba + 1)
                    END IF
                    EXIT DO
                END IF
            END IF
        LOOP
    NEXT j
NEXT i
SLEEP
 
DATA 6
DATA -0.3,-0.8,3,0.6
DATA 0.9,-1.4,3.5,0.35
DATA 0.7,-0.45,2.5,0.4
DATA -0.5,-0.3,1.5,0.15
DATA 1.0,-0.2,1.5,0.1
DATA -0.1,-0.2,1.25,0.2
 

Looks cool though. Thanks for the heavy lifting!

Pete

SierraKen · « **Reply #2 on:** February 26, 2022, 05:43:41 pm »

Awesome stuff guys! You got me thinking of a rotating Earth globe, so I found B+'s and saved that one too. :D

Here is the link to that: https://qb64forum.alephc.xyz/index.php?topic=4547.0

Phlashlite · « **Reply #3 on:** February 27, 2022, 04:19:38 am »

AWESOME!

FellippeHeitor · « **Reply #4 on:** February 27, 2022, 07:35:53 am »

It's mind-blowing. I can't wrap my head around it. Real cool.

OldMoses · « **Reply #5 on:** February 27, 2022, 08:12:34 am »

I "sort of" recognize certain equations in this, from using a simple, single ray algorithm to check for line of sight occlusions in a 3D environment. Of course rendering these sorts of light and reflective views is what it's really good for. It's stuff that I wish I understood better.

It's amazing how much this is doing, for such a small amount of code. Nicely done.

Dav · « **Reply #6 on:** February 27, 2022, 10:05:18 am »

Very nice code. I don’t understand it, but it is amazing. I wonder if it’s possible to modify it to render several pages in advance, with the spheres moving a little, them play back the pages like an animation.

- Dav

bplus · « **Reply #7 on:** February 27, 2022, 11:56:17 am »

Yeah, Paul Dunn is like Master Gy both genius and both hard as heck to follow ;-))

Also they both prefer to write code horizontally : allot : tersely: for module length blocks : or at least sub length : )
(I am sure the code I showed from original SpecBAS was edited for public consumption who like me tend to prefer vertical script.)

@Pete is better without GoTo's

bplus · « **Reply #8 on:** February 27, 2022, 12:13:12 pm »

Quote from: Dav on February 27, 2022, 10:05:18 am

Very nice code. I don’t understand it, but it is amazing. I wonder if it’s possible to modify it to render several pages in advance, with the spheres moving a little, them play back the pages like an animation.

- Dav

Dang! Dave that's an idea but can't be pre-drawn because when they move the reflections will be different but an awesome idea! QB64 might be able to render fast enough, guess we will have to check ;-))

bplus · « **Reply #9 on:** February 27, 2022, 01:44:26 pm »

Update tsh73 had breakthrough with the coloring "Rainbow" part, now the thumbnail matches original SpecBas image.

Translation later when I have time to study it.

MasterGy · « **Reply #10 on:** February 27, 2022, 02:46:43 pm »

This is huge! I don’t understand how it works, but it’s unbelievable that there are a few lines throughout. Fantastic! Congratulations !!!!

MasterGy · « **Reply #11 on:** February 27, 2022, 02:48:16 pm »

It would be interesting if you could speed up and create a simple animation!

MasterGy · « **Reply #12 on:** February 27, 2022, 03:28:47 pm »

I added. WASD can be used to move forward, backward, left, right, and "-" and "+" keys are used for height.

One sphere circles around the other.
This makes the animation easy to understand.
I still don't understand how it works.
Congratulations to the creator!

Code: QB64: [Select]

_TITLE "RayTrace" 'b+ trans from JB to QB64 2022-02-26
scrw = 400
scrh = scrw / _DESKTOPWIDTH * _DESKTOPHEIGHT
 
 
SCREEN _NEWIMAGE(scrw, scrh, 32)
_SCREENMOVE _MIDDLE
READ spheres
DIM c(spheres, 3), r(spheres), q(spheres), cl(4) AS _UNSIGNED LONG
w = scrw / 2
h = scrh / 4
s = 0
cl(1) = _RGB32(120, 65, 45) ' shaddow
cl(2) = _RGB32(0, 0, 100)
cl(3) = _RGB32(255, 255, 0)
cl(4) = _RGB32(0, 0, 200)
FOR k = 1 TO spheres
    READ a, b, c, d
    c(k, 1) = a
    c(k, 2) = b
    c(k, 3) = c
    r = d
    r(k) = r
    q(k) = r * r
NEXT k
 
start_x = 0.3: start_y = -0.2: start_z = -3: start_x = c(1, 1)
dz_temp = (scrh / 480) * 600
 
DO
 
    ang2 = ang2 + .1: rad = 1
    c(2, 1) = c(1, 1) + SIN(ang2) * rad
    c(2, 3) = c(1, 3) + COS(ang2) * rad
 
 
    start_x = start_x + (_KEYDOWN(ASC("a")) - _KEYDOWN(ASC("d"))) * .1
    start_z = start_z + (_KEYDOWN(ASC("s")) - _KEYDOWN(ASC("w"))) * .1
    start_y = start_y + (_KEYDOWN(ASC("+")) - _KEYDOWN(ASC("-"))) * .02
 
 
 
 
    FOR i = 1 TO scrh STEP 1
        FOR j = 0 TO scrw - 1
            x = start_x: y = start_y: z = start_z: ba = 3
            dx = j - w: dy = h - i: dz = dz_temp
            dd = dx * dx + dy * dy + dz * dz
            DO
                n = (y >= 0 OR dy <= 0) '* -1   <<< Makes $1000 for knowing where to tap the hammer
                IF n = 0 THEN s = (y / dy) * -1
                dd_temp = 1 / SQR(dd)
                FOR k = 1 TO spheres
                    px = c(k, 1) - x: py = c(k, 2) - y: pz = c(k, 3) - z
                    pp = px * px + py * py + pz * pz
                    sc = px * dx + py * dy + pz * dz
                    IF sc > 0 THEN
                        bb = sc * sc / dd
                        aa = q(k) - pp + bb
                        IF aa > 0 THEN
                            sc = (SQR(bb) - SQR(aa)) * dd_temp
                            IF sc < s OR n < 0 THEN n = k: s = sc
                        END IF
                    END IF
                NEXT k
                IF n < 0 THEN
                    PSET (j, scrh - i), _RGB32(128 * (scrh - i) / scrh + 128 * (dy * dy / dd), 128 * (scrh - i) / scrh + 128 * (dy * dy / dd), 200 + 55 * (dy * dy / dd))
                    EXIT DO
                ELSE
                    dx = dx * s: dy = dy * s: dz = dz * s: dd = dd * s * s
                    x = x + dx: y = y + dy: z = z + dz
                    IF n <> 0 THEN
                        nx = x - c(n, 1): ny = y - c(n, 2): nz = z - c(n, 3)
                        nn = nx * nx + ny * ny + nz * nz
                        l = 2 * (dx * nx + dy * ny + dz * nz) / nn
                        dx = dx - nx * l: dy = dy - ny * l: dz = dz - nz * l
                    ELSE
                        FOR k = 1 TO spheres
                            u = c(k, 1) - x
                            v = c(k, 3) - z
                            IF u * u + v * v <= q(k) THEN ba = 1: EXIT FOR
                        NEXT k
                        IF (x - INT(x) > .5) = (z - INT(z) > .5) THEN 'x,y pepita size
                            PSET (j, scrh - i), cl(ba)
                        ELSE
                            PSET (j, scrh - i), cl(ba + 1)
                        END IF
                        EXIT DO
                    END IF
                END IF
            LOOP
        NEXT j
    NEXT i
    _DISPLAY: CLS
LOOP
SLEEP
 
DATA 4
 
DATA -0.3,-0.8,3,0.6
DATA 0.9,-1.4,3.5,0.35
 
DATA 0.7,-0.45,2.5,0.4
DATA -0.5,-0.3,1.5,0.15
DATA 1.0,-0.2,1.5,0.1
DATA -0.1,-0.2,1.25,0.2
 

bplus · « **Reply #13 on:** February 27, 2022, 04:12:22 pm »

Well dang! @MasterGy you understood good enough I'd say, nice! Wow!

Now make the spheres bounce around like inside a box, LOL

MasterGy · « **Reply #14 on:** February 27, 2022, 04:52:40 pm »

so you think that ? :)

Code: QB64: [Select]

_TITLE "RayTrace" 'b+ trans from JB to QB64 2022-02-26
scrw = 400
scrh = scrw / _DESKTOPWIDTH * _DESKTOPHEIGHT
 
 
SCREEN _NEWIMAGE(scrw, scrh, 32)
_SCREENMOVE _MIDDLE
READ spheres
DIM c(spheres, 9), r(spheres), q(spheres), cl(4) AS _UNSIGNED LONG
w = scrw / 2
h = scrh / 4
s = 0
cl(1) = _RGB32(120, 65, 45) ' shaddow
cl(2) = _RGB32(0, 0, 100)
cl(3) = _RGB32(255, 255, 0)
cl(4) = _RGB32(0, 0, 200)
RANDOMIZE TIMER
FOR k = 1 TO spheres
    READ a, b, c, d
    c(k, 1) = a
    c(k, 2) = -(d + .3 + 2 * RND(1))
    c(k, 3) = c
    c(k, 4) = .1
    r = d
    r(k) = r
    q(k) = r * r
NEXT k
 
start_x = 0.3: start_y = -0.2: start_z = -3: start_x = c(1, 1)
dz_temp = (scrh / 480) * 600
 
DO
    'bouncing
    FOR k = 1 TO spheres
        c(k, 4) = c(k, 4) + .01
        ck = c(k, 2) + c(k, 4)
        IF -ck < r(k) THEN c(k, 4) = -.2: ck = -r(k)
        c(k, 2) = ck
    NEXT k
 
    start_x = start_x + (_KEYDOWN(ASC("a")) - _KEYDOWN(ASC("d"))) * .1
    start_z = start_z + (_KEYDOWN(ASC("s")) - _KEYDOWN(ASC("w"))) * .1
    start_y = start_y + (_KEYDOWN(ASC("+")) - _KEYDOWN(ASC("-"))) * .02
 
 
 
 
    FOR i = 1 TO scrh STEP 1
        FOR j = 0 TO scrw - 1
            x = start_x: y = start_y: z = start_z: ba = 3
            dx = j - w: dy = h - i: dz = dz_temp
            dd = dx * dx + dy * dy + dz * dz
            DO
                n = (y >= 0 OR dy <= 0) '* -1   <<< Makes $1000 for knowing where to tap the hammer
                IF n = 0 THEN s = (y / dy) * -1
                dd_temp = 1 / SQR(dd)
                FOR k = 1 TO spheres
                    px = c(k, 1) - x: py = c(k, 2) - y: pz = c(k, 3) - z
                    pp = px * px + py * py + pz * pz
                    sc = px * dx + py * dy + pz * dz
                    IF sc > 0 THEN
                        bb = sc * sc / dd
                        aa = q(k) - pp + bb
                        IF aa > 0 THEN
                            sc = (SQR(bb) - SQR(aa)) * dd_temp
                            IF sc < s OR n < 0 THEN n = k: s = sc
                        END IF
                    END IF
                NEXT k
                IF n < 0 THEN
                    PSET (j, scrh - i), _RGB32(128 * (scrh - i) / scrh + 128 * (dy * dy / dd), 128 * (scrh - i) / scrh + 128 * (dy * dy / dd), 200 + 55 * (dy * dy / dd))
                    EXIT DO
                ELSE
                    dx = dx * s: dy = dy * s: dz = dz * s: dd = dd * s * s
                    x = x + dx: y = y + dy: z = z + dz
                    IF n <> 0 THEN
                        nx = x - c(n, 1): ny = y - c(n, 2): nz = z - c(n, 3)
                        nn = nx * nx + ny * ny + nz * nz
                        l = 2 * (dx * nx + dy * ny + dz * nz) / nn
                        dx = dx - nx * l: dy = dy - ny * l: dz = dz - nz * l
                    ELSE
                        FOR k = 1 TO spheres
                            u = c(k, 1) - x
                            v = c(k, 3) - z
                            IF u * u + v * v <= q(k) THEN ba = 1: EXIT FOR
                        NEXT k
                        IF (x - INT(x) > .5) = (z - INT(z) > .5) THEN 'x,y pepita size
                            PSET (j, scrh - i), cl(ba)
                        ELSE
                            PSET (j, scrh - i), cl(ba + 1)
                        END IF
                        EXIT DO
                    END IF
                END IF
            LOOP
        NEXT j
    NEXT i
    _DISPLAY: CLS
LOOP
SLEEP
 
DATA 4
 
DATA -0.3,-0.8,3,0.6
DATA 0.9,-1.4,3.5,0.35
 
DATA 0.7,-0.45,2.5,0.4
DATA -0.5,-0.3,1.5,0.25
DATA 1.0,-0.2,1.5,0.2
DATA -0.1,-0.2,1.25,0.2
 

News:

Author Topic: Ray Trace a translation from SpecBAS (Read 8547 times)

bplus

Ray Trace a translation from SpecBAS

Pete

Re: Ray Trace a translation from SpecBAS

SierraKen

Re: Ray Trace a translation from SpecBAS

Phlashlite

Re: Ray Trace a translation from SpecBAS

FellippeHeitor

Re: Ray Trace a translation from SpecBAS

OldMoses

Re: Ray Trace a translation from SpecBAS

Dav

Re: Ray Trace a translation from SpecBAS

bplus

Re: Ray Trace a translation from SpecBAS

bplus

Re: Ray Trace a translation from SpecBAS

bplus

Re: Ray Trace a translation from SpecBAS

MasterGy

Re: Ray Trace a translation from SpecBAS

MasterGy

Re: Ray Trace a translation from SpecBAS

MasterGy

Re: Ray Trace a translation from SpecBAS

bplus

Re: Ray Trace a translation from SpecBAS

MasterGy

Re: Ray Trace a translation from SpecBAS