Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on February 26, 2022, 02:39:54 pm

Title: Ray Trace a translation from SpecBAS
Post by: bplus on February 26, 2022, 02:39:54 pm
by Paul Dunn here was the original SpecBAS code:
Code: [Select]
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]
  1. _Title "RayTrace" 'b+ trans from JB to QB64 2022-02-26
  2. Const scrw = 1024, scrh = 680
  3. Screen _NewImage(scrw, scrh, 32)
  4. _ScreenMove 150, 40
  5. Read spheres
  6. Dim c(spheres, 3), r(spheres), q(spheres), cl(4) As _Unsigned Long
  7. w = scrw / 2
  8. h = scrh / 2
  9. s = 0
  10. cl(1) = _RGB32(120, 65, 45) ' shaddow
  11. cl(2) = _RGB32(0, 0, 100)
  12. cl(3) = _RGB32(255, 255, 0)
  13. cl(4) = _RGB32(0, 0, 200)
  14. For k = 1 To spheres
  15.     Read a, b, c, d
  16.     c(k, 1) = a
  17.     c(k, 2) = b
  18.     c(k, 3) = c
  19.     r = d
  20.     r(k) = r
  21.     q(k) = r * r
  23.  
  24. For i = 1 To scrh
  25.     For j = 0 To scrw - 1
  26.         x = 0.3: y = -0.5: z = 0: ba = 3
  27.         dx = j - w: dy = h - i: dz = (scrh / 480) * 600
  28.         dd = dx * dx + dy * dy + dz * dz
  29.         recursion:
  30.         n = (y >= 0 Or dy <= 0) '* -1   <<< Makes $1000 for knowing where to tap the hammer
  31.         If n = 0 Then s = (y / dy) * -1
  32.         For k = 1 To spheres
  33.             px = c(k, 1) - x: py = c(k, 2) - y: pz = c(k, 3) - z
  34.             pp = px * px + py * py + pz * pz
  35.             sc = px * dx + py * dy + pz * dz
  36.             If sc <= 0 Then GoTo donek
  37.             bb = sc * sc / dd
  38.             aa = q(k) - pp + bb
  39.             If aa <= 0 Then GoTo donek
  40.             sc = (Sqr(bb) - Sqr(aa)) / Sqr(dd)
  41.             If sc < s Or n < 0 Then n = k: s = sc
  42.             donek:
  43.         Next k
  44.         If n < 0 Then
  45.             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))
  46.             GoTo donej
  47.         End If
  48.         dx = dx * s: dy = dy * s: dz = dz * s: dd = dd * s * s
  49.         x = x + dx: y = y + dy: z = z + dz
  50.         If n <> 0 Then
  51.             nx = x - c(n, 1): ny = y - c(n, 2): nz = z - c(n, 3)
  52.             nn = nx * nx + ny * ny + nz * nz
  53.             l = 2 * (dx * nx + dy * ny + dz * nz) / nn
  54.             dx = dx - nx * l: dy = dy - ny * l: dz = dz - nz * l
  55.             GoTo recursion
  56.         End If
  57.         For k = 1 To spheres
  58.             u = c(k, 1) - x
  59.             v = c(k, 3) - z
  60.             If u * u + v * v <= q(k) Then ba = 1: Exit For
  61.         Next k
  62.         If (x - Int(x) > .5) = (z - Int(z) > .5) Then
  63.             PSet (j, scrh - i), cl(ba)
  64.         Else
  65.             PSet (j, scrh - i), cl(ba + 1)
  66.         End If
  67.         donej:
  68.     Next j
  71.  
  73. Data -0.3,-0.8,3,0.6
  74. Data 0.9,-1.4,3.5,0.35
  75. Data 0.7,-0.45,2.5,0.4
  76. Data -0.5,-0.3,1.5,0.15
  77. Data 1.0,-0.2,1.5,0.1
  78. Data -0.1,-0.2,1.25,0.2
  79.  
  80.  

 
Title: Re: Ray Trace a translation from SpecBAS
Post by: Pete 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]
  1. _TITLE "RayTrace" 'b+ trans from JB to QB64 2022-02-26
  2. CONST scrw = 1024, scrh = 680
  3. SCREEN _NEWIMAGE(scrw, scrh, 32)
  4. _SCREENMOVE 150, 40
  5. READ spheres
  6. DIM c(spheres, 3), r(spheres), q(spheres), cl(4) AS _UNSIGNED LONG
  7. w = scrw / 2
  8. h = scrh / 2
  9. s = 0
  10. cl(1) = _RGB32(120, 65, 45) ' shaddow
  11. cl(2) = _RGB32(0, 0, 100)
  12. cl(3) = _RGB32(255, 255, 0)
  13. cl(4) = _RGB32(0, 0, 200)
  14. FOR k = 1 TO spheres
  15.     READ a, b, c, d
  16.     c(k, 1) = a
  17.     c(k, 2) = b
  18.     c(k, 3) = c
  19.     r = d
  20.     r(k) = r
  21.     q(k) = r * r
  23.  
  24. FOR i = 1 TO scrh
  25.     FOR j = 0 TO scrw - 1
  26.         x = 0.3: y = -0.5: z = 0: ba = 3
  27.         dx = j - w: dy = h - i: dz = (scrh / 480) * 600
  28.         dd = dx * dx + dy * dy + dz * dz
  29.         DO
  30.             n = (y >= 0 OR dy <= 0) '* -1   <<< Makes $1000 for knowing where to tap the hammer
  31.             IF n = 0 THEN s = (y / dy) * -1
  32.             FOR k = 1 TO spheres
  33.                 px = c(k, 1) - x: py = c(k, 2) - y: pz = c(k, 3) - z
  34.                 pp = px * px + py * py + pz * pz
  35.                 sc = px * dx + py * dy + pz * dz
  36.                 IF sc > 0 THEN
  37.                     bb = sc * sc / dd
  38.                     aa = q(k) - pp + bb
  39.                     IF aa > 0 THEN
  40.                         sc = (SQR(bb) - SQR(aa)) / SQR(dd)
  41.                         IF sc < s OR n < 0 THEN n = k: s = sc
  42.                     END IF
  43.                 END IF
  44.             NEXT k
  45.             IF n < 0 THEN
  46.                 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))
  47.                 EXIT DO
  48.             ELSE
  49.                 dx = dx * s: dy = dy * s: dz = dz * s: dd = dd * s * s
  50.                 x = x + dx: y = y + dy: z = z + dz
  51.                 IF n <> 0 THEN
  52.                     nx = x - c(n, 1): ny = y - c(n, 2): nz = z - c(n, 3)
  53.                     nn = nx * nx + ny * ny + nz * nz
  54.                     l = 2 * (dx * nx + dy * ny + dz * nz) / nn
  55.                     dx = dx - nx * l: dy = dy - ny * l: dz = dz - nz * l
  56.                 ELSE
  57.                     FOR k = 1 TO spheres
  58.                         u = c(k, 1) - x
  59.                         v = c(k, 3) - z
  60.                         IF u * u + v * v <= q(k) THEN ba = 1: EXIT FOR
  61.                     NEXT k
  62.                     IF (x - INT(x) > .5) = (z - INT(z) > .5) THEN
  63.                         PSET (j, scrh - i), cl(ba)
  64.                     ELSE
  65.                         PSET (j, scrh - i), cl(ba + 1)
  66.                     END IF
  67.                     EXIT DO
  68.                 END IF
  69.             END IF
  70.         LOOP
  71.     NEXT j
  74.  
  76. DATA -0.3,-0.8,3,0.6
  77. DATA 0.9,-1.4,3.5,0.35
  78. DATA 0.7,-0.45,2.5,0.4
  79. DATA -0.5,-0.3,1.5,0.15
  80. DATA 1.0,-0.2,1.5,0.1
  81. DATA -0.1,-0.2,1.25,0.2
  82.  

Looks cool though. Thanks for the heavy lifting!

Pete
Title: Re: Ray Trace a translation from SpecBAS
Post by: SierraKen 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 (https://qb64forum.alephc.xyz/index.php?topic=4547.0)
Title: Re: Ray Trace a translation from SpecBAS
Post by: Phlashlite on February 27, 2022, 04:19:38 am
AWESOME!
Title: Re: Ray Trace a translation from SpecBAS
Post by: FellippeHeitor on February 27, 2022, 07:35:53 am
It's mind-blowing. I can't wrap my head around it. Real cool.
Title: Re: Ray Trace a translation from SpecBAS
Post by: OldMoses 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.
Title: Re: Ray Trace a translation from SpecBAS
Post by: 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
Title: Re: Ray Trace a translation from SpecBAS
Post by: bplus 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
Title: Re: Ray Trace a translation from SpecBAS
Post by: bplus 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 ;-))
Title: Re: Ray Trace a translation from SpecBAS
Post by: bplus on February 27, 2022, 01:44:26 pm
Update tsh73 had breakthrough with the coloring "Rainbow" part, now the thumbnail matches original SpecBas image.
  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Translation later when I have time to study it.
Title: Re: Ray Trace a translation from SpecBAS
Post by: MasterGy 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 !!!!
Title: Re: Ray Trace a translation from SpecBAS
Post by: MasterGy on February 27, 2022, 02:48:16 pm
It would be interesting if you could speed up and create a simple animation!
Title: Re: Ray Trace a translation from SpecBAS
Post by: MasterGy 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]
  1. _TITLE "RayTrace" 'b+ trans from JB to QB64 2022-02-26
  2. scrw = 400
  4.  
  5.  
  6. SCREEN _NEWIMAGE(scrw, scrh, 32)
  8. READ spheres
  9. DIM c(spheres, 3), r(spheres), q(spheres), cl(4) AS _UNSIGNED LONG
  10. w = scrw / 2
  11. h = scrh / 4
  12. s = 0
  13. cl(1) = _RGB32(120, 65, 45) ' shaddow
  14. cl(2) = _RGB32(0, 0, 100)
  15. cl(3) = _RGB32(255, 255, 0)
  16. cl(4) = _RGB32(0, 0, 200)
  17. FOR k = 1 TO spheres
  18.     READ a, b, c, d
  19.     c(k, 1) = a
  20.     c(k, 2) = b
  21.     c(k, 3) = c
  22.     r = d
  23.     r(k) = r
  24.     q(k) = r * r
  26.  
  27. start_x = 0.3: start_y = -0.2: start_z = -3: start_x = c(1, 1)
  28. dz_temp = (scrh / 480) * 600
  29.  
  31.  
  32.     ang2 = ang2 + .1: rad = 1
  33.     c(2, 1) = c(1, 1) + SIN(ang2) * rad
  34.     c(2, 3) = c(1, 3) + COS(ang2) * rad
  35.  
  36.  
  37.     start_x = start_x + (_KEYDOWN(ASC("a")) - _KEYDOWN(ASC("d"))) * .1
  38.     start_z = start_z + (_KEYDOWN(ASC("s")) - _KEYDOWN(ASC("w"))) * .1
  39.     start_y = start_y + (_KEYDOWN(ASC("+")) - _KEYDOWN(ASC("-"))) * .02
  40.  
  41.  
  42.  
  43.  
  44.     FOR i = 1 TO scrh STEP 1
  45.         FOR j = 0 TO scrw - 1
  46.             x = start_x: y = start_y: z = start_z: ba = 3
  47.             dx = j - w: dy = h - i: dz = dz_temp
  48.             dd = dx * dx + dy * dy + dz * dz
  49.             DO
  50.                 n = (y >= 0 OR dy <= 0) '* -1   <<< Makes $1000 for knowing where to tap the hammer
  51.                 IF n = 0 THEN s = (y / dy) * -1
  52.                 dd_temp = 1 / SQR(dd)
  53.                 FOR k = 1 TO spheres
  54.                     px = c(k, 1) - x: py = c(k, 2) - y: pz = c(k, 3) - z
  55.                     pp = px * px + py * py + pz * pz
  56.                     sc = px * dx + py * dy + pz * dz
  57.                     IF sc > 0 THEN
  58.                         bb = sc * sc / dd
  59.                         aa = q(k) - pp + bb
  60.                         IF aa > 0 THEN
  61.                             sc = (SQR(bb) - SQR(aa)) * dd_temp
  62.                             IF sc < s OR n < 0 THEN n = k: s = sc
  63.                         END IF
  64.                     END IF
  65.                 NEXT k
  66.                 IF n < 0 THEN
  67.                     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))
  68.                     EXIT DO
  69.                 ELSE
  70.                     dx = dx * s: dy = dy * s: dz = dz * s: dd = dd * s * s
  71.                     x = x + dx: y = y + dy: z = z + dz
  72.                     IF n <> 0 THEN
  73.                         nx = x - c(n, 1): ny = y - c(n, 2): nz = z - c(n, 3)
  74.                         nn = nx * nx + ny * ny + nz * nz
  75.                         l = 2 * (dx * nx + dy * ny + dz * nz) / nn
  76.                         dx = dx - nx * l: dy = dy - ny * l: dz = dz - nz * l
  77.                     ELSE
  78.                         FOR k = 1 TO spheres
  79.                             u = c(k, 1) - x
  80.                             v = c(k, 3) - z
  81.                             IF u * u + v * v <= q(k) THEN ba = 1: EXIT FOR
  82.                         NEXT k
  83.                         IF (x - INT(x) > .5) = (z - INT(z) > .5) THEN 'x,y pepita size
  84.                             PSET (j, scrh - i), cl(ba)
  85.                         ELSE
  86.                             PSET (j, scrh - i), cl(ba + 1)
  87.                         END IF
  88.                         EXIT DO
  89.                     END IF
  90.                 END IF
  91.             LOOP
  92.         NEXT j
  93.     NEXT i
  94.     _DISPLAY: CLS
  97.  
  99.  
  100. DATA -0.3,-0.8,3,0.6
  101. DATA 0.9,-1.4,3.5,0.35
  102.  
  103. DATA 0.7,-0.45,2.5,0.4
  104. DATA -0.5,-0.3,1.5,0.15
  105. DATA 1.0,-0.2,1.5,0.1
  106. DATA -0.1,-0.2,1.25,0.2
  107.  
Title: Re: Ray Trace a translation from SpecBAS
Post by: bplus 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
Title: Re: Ray Trace a translation from SpecBAS
Post by: MasterGy on February 27, 2022, 04:52:40 pm
so you think that ? :)

Code: QB64: [Select]
  1. _TITLE "RayTrace" 'b+ trans from JB to QB64 2022-02-26
  2. scrw = 400
  4.  
  5.  
  6. SCREEN _NEWIMAGE(scrw, scrh, 32)
  8. READ spheres
  9. DIM c(spheres, 9), r(spheres), q(spheres), cl(4) AS _UNSIGNED LONG
  10. w = scrw / 2
  11. h = scrh / 4
  12. s = 0
  13. cl(1) = _RGB32(120, 65, 45) ' shaddow
  14. cl(2) = _RGB32(0, 0, 100)
  15. cl(3) = _RGB32(255, 255, 0)
  16. cl(4) = _RGB32(0, 0, 200)
  18. FOR k = 1 TO spheres
  19.     READ a, b, c, d
  20.     c(k, 1) = a
  21.     c(k, 2) = -(d + .3 + 2 * RND(1))
  22.     c(k, 3) = c
  23.     c(k, 4) = .1
  24.     r = d
  25.     r(k) = r
  26.     q(k) = r * r
  28.  
  29. start_x = 0.3: start_y = -0.2: start_z = -3: start_x = c(1, 1)
  30. dz_temp = (scrh / 480) * 600
  31.  
  33.     'bouncing
  34.     FOR k = 1 TO spheres
  35.         c(k, 4) = c(k, 4) + .01
  36.         ck = c(k, 2) + c(k, 4)
  37.         IF -ck < r(k) THEN c(k, 4) = -.2: ck = -r(k)
  38.         c(k, 2) = ck
  39.     NEXT k
  40.  
  41.     start_x = start_x + (_KEYDOWN(ASC("a")) - _KEYDOWN(ASC("d"))) * .1
  42.     start_z = start_z + (_KEYDOWN(ASC("s")) - _KEYDOWN(ASC("w"))) * .1
  43.     start_y = start_y + (_KEYDOWN(ASC("+")) - _KEYDOWN(ASC("-"))) * .02
  44.  
  45.  
  46.  
  47.  
  48.     FOR i = 1 TO scrh STEP 1
  49.         FOR j = 0 TO scrw - 1
  50.             x = start_x: y = start_y: z = start_z: ba = 3
  51.             dx = j - w: dy = h - i: dz = dz_temp
  52.             dd = dx * dx + dy * dy + dz * dz
  53.             DO
  54.                 n = (y >= 0 OR dy <= 0) '* -1   <<< Makes $1000 for knowing where to tap the hammer
  55.                 IF n = 0 THEN s = (y / dy) * -1
  56.                 dd_temp = 1 / SQR(dd)
  57.                 FOR k = 1 TO spheres
  58.                     px = c(k, 1) - x: py = c(k, 2) - y: pz = c(k, 3) - z
  59.                     pp = px * px + py * py + pz * pz
  60.                     sc = px * dx + py * dy + pz * dz
  61.                     IF sc > 0 THEN
  62.                         bb = sc * sc / dd
  63.                         aa = q(k) - pp + bb
  64.                         IF aa > 0 THEN
  65.                             sc = (SQR(bb) - SQR(aa)) * dd_temp
  66.                             IF sc < s OR n < 0 THEN n = k: s = sc
  67.                         END IF
  68.                     END IF
  69.                 NEXT k
  70.                 IF n < 0 THEN
  71.                     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))
  72.                     EXIT DO
  73.                 ELSE
  74.                     dx = dx * s: dy = dy * s: dz = dz * s: dd = dd * s * s
  75.                     x = x + dx: y = y + dy: z = z + dz
  76.                     IF n <> 0 THEN
  77.                         nx = x - c(n, 1): ny = y - c(n, 2): nz = z - c(n, 3)
  78.                         nn = nx * nx + ny * ny + nz * nz
  79.                         l = 2 * (dx * nx + dy * ny + dz * nz) / nn
  80.                         dx = dx - nx * l: dy = dy - ny * l: dz = dz - nz * l
  81.                     ELSE
  82.                         FOR k = 1 TO spheres
  83.                             u = c(k, 1) - x
  84.                             v = c(k, 3) - z
  85.                             IF u * u + v * v <= q(k) THEN ba = 1: EXIT FOR
  86.                         NEXT k
  87.                         IF (x - INT(x) > .5) = (z - INT(z) > .5) THEN 'x,y pepita size
  88.                             PSET (j, scrh - i), cl(ba)
  89.                         ELSE
  90.                             PSET (j, scrh - i), cl(ba + 1)
  91.                         END IF
  92.                         EXIT DO
  93.                     END IF
  94.                 END IF
  95.             LOOP
  96.         NEXT j
  97.     NEXT i
  98.     _DISPLAY: CLS
  101.  
  103.  
  104. DATA -0.3,-0.8,3,0.6
  105. DATA 0.9,-1.4,3.5,0.35
  106.  
  107. DATA 0.7,-0.45,2.5,0.4
  108. DATA -0.5,-0.3,1.5,0.25
  109. DATA 1.0,-0.2,1.5,0.2
  110. DATA -0.1,-0.2,1.25,0.2
  111.  
Title: Re: Ray Trace a translation from SpecBAS
Post by: bplus on February 27, 2022, 05:31:20 pm
OMG! LOL yeah pretty nice!
Title: Re: Ray Trace a translation from SpecBAS
Post by: MasterGy on February 27, 2022, 06:42:38 pm
he didn’t let me calm down to understand a few things.
It works. Walking in space. Look up, down, spin.
WASD + mouse.

Code: QB64: [Select]
  1. _TITLE "RayTrace" 'b+ trans from JB to QB64 2022-02-26
  2. scrw = 400
  4.  
  5.  
  6.  
  7.  
  8. SCREEN _NEWIMAGE(scrw, scrh, 32)
  10. READ spheres
  11. DIM c(spheres, 9), r(spheres), q(spheres), cl(4) AS _UNSIGNED LONG
  12. w = scrw / 2
  13. h = scrh / 4
  14. s = 0
  15. cl(1) = _RGB32(120, 65, 45) ' shaddow
  16. cl(2) = _RGB32(0, 0, 100)
  17. cl(3) = _RGB32(255, 255, 0)
  18. cl(4) = _RGB32(0, 0, 200)
  20. FOR k = 1 TO spheres
  21.     READ a, b, c, d
  22.     c(k, 5) = a
  23.     c(k, 2) = -(d + .3 + 2 * RND(1))
  24.     c(k, 6) = c
  25.     c(k, 4) = .1
  26.     r = d
  27.     r(k) = r
  28.     q(k) = r * r
  30.  
  31. me(1) = -0.2: me(2) = -3: me(0) = c(1, 1): me(3) = _PI
  32.  
  33.  
  35.  
  36.  
  37.     'bouncing
  38.     FOR k = 1 TO spheres
  39.         c(k, 4) = c(k, 4) + .01
  40.         ck = c(k, 2) + c(k, 4)
  41.         IF -ck < r(k) THEN c(k, 4) = -.2: ck = -r(k)
  42.         c(k, 2) = ck
  43.     NEXT k
  44.  
  45.     'control
  46.     mousex = 0: mousey = 0: WHILE _MOUSEINPUT: mousex = mousex + _MOUSEMOVEMENTX: mousey = mousey + _MOUSEMOVEMENTY: WEND
  47.     me(3) = me(3) + mousex * .01
  48.     h = h + mousey * .5
  49.     k_a = _KEYDOWN(ASC("a")): k_d = _KEYDOWN(ASC("d")): k_w = _KEYDOWN(ASC("w")): k_s = _KEYDOWN(ASC("s"))
  50.     go_ang = -(k_a * 90 + k_d * -90 + k_s * 180 - 180) * (_PI / 180) - me(3)
  51.     go = (k_a + k_d + k_w + k_s = -1) * .2
  52.     me(0) = me(0) + SIN(go_ang) * go
  53.     me(2) = me(2) - COS(go_ang) * go
  54.     me(1) = me(1) + (_KEYDOWN(ASC("+")) - _KEYDOWN(ASC("-"))) * .02
  55.  
  56.     'spheres rotating
  57.     FOR k = 1 TO spheres
  58.         c(k, 1) = c(k, 5) - me(0)
  59.         c(k, 3) = c(k, 6) - me(2)
  60.         rotate_2d c(k, 1), c(k, 3), me(3)
  61.         c(k, 1) = c(k, 1) + me(0)
  62.         c(k, 3) = c(k, 3) + me(2)
  63.     NEXT k
  64.  
  65.  
  66.     FOR i = 1 TO scrh STEP 1
  67.         FOR j = 0 TO scrw - 1
  68.             x = me(0): y = me(1): z = me(2): ba = 3
  69.             dx = j - w: dy = h - i: dz = scrw
  70.             dd = dx * dx + dy * dy + dz * dz
  71.             neverend_cycle_agent = 0
  72.             DO: neverend_cycle_agent = neverend_cycle_agent + 1: IF neverend_cycle_agent > 2000 THEN EXIT DO
  73.                 n = (y >= 0 OR dy <= 0) '* -1   <<< Makes $1000 for knowing where to tap the hammer
  74.                 IF n = 0 THEN s = (y / dy) * -1
  75.                 dd_temp = 1 / SQR(dd)
  76.                 FOR k = 1 TO spheres
  77.                     px = c(k, 1) - x: py = c(k, 2) - y: pz = c(k, 3) - z
  78.                     pp = px * px + py * py + pz * pz
  79.                     sc = px * dx + py * dy + pz * dz
  80.                     IF sc > 0 THEN
  81.                         bb = sc * sc / dd
  82.                         aa = q(k) - pp + bb
  83.                         IF aa > 0 THEN
  84.                             sc = (SQR(bb) - SQR(aa)) * dd_temp
  85.                             IF sc < s OR n < 0 THEN n = k: s = sc
  86.                         END IF
  87.                     END IF
  88.                 NEXT k
  89.                 IF n < 0 THEN
  90.                     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))
  91.                     EXIT DO
  92.                 ELSE
  93.                     dx = dx * s: dy = dy * s: dz = dz * s: dd = dd * s * s
  94.                     x = x + dx: y = y + dy: z = z + dz
  95.                     IF n <> 0 THEN
  96.                         nx = x - c(n, 1): ny = y - c(n, 2): nz = z - c(n, 3)
  97.                         nn = nx * nx + ny * ny + nz * nz
  98.                         l = 2 * (dx * nx + dy * ny + dz * nz) / nn
  99.                         dx = dx - nx * l: dy = dy - ny * l: dz = dz - nz * l
  100.                     ELSE
  101.                         FOR k = 1 TO spheres
  102.                             u = c(k, 1) - x
  103.                             v = c(k, 3) - z
  104.                             IF u * u + v * v <= q(k) THEN ba = 1: EXIT FOR
  105.                         NEXT k
  106.  
  107.                         x2 = x - me(0): z2 = z - me(2): rotate_2d x2, z2, -me(3): x2 = x2 + me(0): z2 = z2 + me(2) 'field rotating
  108.  
  109.                         IF (x2 - INT(x2) > .5) = (z2 - INT(z2) > .5) THEN 'x,y pepita size
  110.                             PSET (j, scrh - i), cl(ba)
  111.                         ELSE
  112.                             PSET (j, scrh - i), cl(ba + 1)
  113.                         END IF
  114.                         EXIT DO
  115.                     END IF
  116.                 END IF
  117.             LOOP
  118.         NEXT j
  119.     NEXT i
  120.     _DISPLAY: CLS
  123.  
  125.  
  126. DATA -0.3,-0.8,3,0.6
  127. DATA 0.9,-1.4,3.5,0.35
  128.  
  129. DATA 0.7,-0.45,2.5,0.4
  130. DATA -0.5,-0.3,1.5,0.25
  131. DATA 1.0,-0.2,1.5,0.2
  132. DATA -0.1,-0.2,1.25,0.2
  133.  
  134.  
  135. SUB rotate_2d (x, y, ang): x1 = -(x * COS(ang) - y * SIN(ang)): y1 = -(x * SIN(ang) + y * COS(ang)): x = x1: y = y1: END SUB
  136.  
  137.  
Title: Re: Ray Trace a translation from SpecBAS
Post by: MasterGy on February 28, 2022, 08:51:49 am
I tried something else. If we calculate an image as soil, it still works very well. If we expose the dog to the ground, the dog cannot be recognized on the ground because we are close to the ground and cannot see it at the same time. But if we approach the spheres, the dog can be recognized in the sphere due to the reflection! We can raise the "SCRW" high, it makes a very nice picture, it will only be difficult to navigate because it will be very slow.

Do you see the dog in the sphere?
  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Ray Trace a translation from SpecBAS
Post by: CharlieJV on March 01, 2022, 01:53:28 pm
Nothing as wickedly wild as what Master Gy has done.

It is still a bunch of fun mindlessly playing with colors.

  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Title: Re: Ray Trace a translation from SpecBAS
Post by: bplus on March 01, 2022, 04:00:35 pm
You guys are doing great things with this, bravo!
Title: Re: Ray Trace a translation from SpecBAS
Post by: bplus on March 02, 2022, 07:00:02 pm
Ah! I have tsh73 translation with the Rainbow Sub solved. Now the colors are as they were from the original code ie the sky is no long flat blue PLUS I added some Mods that move the balls and Move your mouse for surprise! (Well not now I guess).

Code: QB64: [Select]
  1. 'https://retrobasic.allbasic.info/index.php?topic=721.0
  2. 'converting to JB. Tsh73 Feb 2022
  3. 'converting to QB64 b+ 2022-03-02 and Mods >>>>   moving balls, move your mouse!
  4. _Title "Move your mouse!"
  5. Const scrw = 320, scrh = 200
  6. Screen _NewImage(scrw, scrh, 32)
  7.  
  9. qb(0) = &HFF000000
  10. qb(1) = &HFF000088
  11. qb(2) = &HFF008800
  12. qb(3) = &HFF008888
  13. qb(4) = &HFF880000
  14. qb(5) = &HFF880088
  15. qb(6) = &HFF888800
  16. qb(7) = &HFFCCCCCC
  17. qb(8) = &HFF888888
  18. qb(9) = &HFF0000FF
  19. qb(10) = &HFF00FF00
  20. qb(11) = &HFF00FFFF
  21. qb(12) = &HFFFF0000
  22. qb(13) = &HFFFF00FF
  23. qb(14) = &HFFFFFF00
  24. qb(15) = &HFFFFFFFF
  25.  
  27.  
  28. For i = 0 To 15: pal(i) = qb(i): Next
  29. ' pal 16,255,255,255:
  30. pal(16) = &HFFFFFFFF
  31. ' pal 32,0,192,255:
  32. pal(32) = &HFF00CCFF
  33. ' pal 255,0,0,192:
  34. pal(255) = &HFF0000CC
  35. ' rainbow 16 to 32:
  36. rainbow 16, 32
  37. ' rainbow 32 to 255
  38. rainbow 32, 255
  39.  
  40. Read spheres
  41. Dim c(spheres, 3), r(spheres), q(spheres), cl(4), d(spheres, 3)
  42. w = scrw / 2: h = scrh / 2: s = 0
  43. cl(1) = 6: cl(2) = 1
  44. cl(3) = cl(1) + 8: cl(4) = cl(2) + 8
  45. For k = 1 To spheres
  46.     Read c1, c2, c3, r
  47.     c(k, 1) = c1: c(k, 2) = c2: c(k, 3) = c3
  48.     d(k, 1) = .01 * (Rnd - .5): d(k, 2) = .01 * (Rnd - .5): d(k, 3) = .01 * (Rnd - .5)
  49.     r(k) = r: q(k) = r * r
  51.  
  53. Data -0.3,-0.8,3,0.6
  54.  
  55. Data 0.9,-1.4,3.5,0.35
  56. Data 0.7,-0.45,2.5,0.4
  57. Data -0.5,-0.3,1.5,0.15
  58. Data 1.0,-0.2,1.5,0.1
  59. Data -0.1,-0.2,1.25,0.2
  60.  
  62.     lc = lc + 1
  63.     If lc = 50 Then toggle = 1 - toggle: lc = 0
  64.     For k = 1 To spheres
  65.         If toggle Then
  66.             c(k, 1) = c(k, 1) + d(k, 1): c(k, 2) = c(k, 2) + d(k, 2): c(k, 3) = c(k, 3) + d(k, 3)
  67.         Else
  68.             c(k, 1) = c(k, 1) - d(k, 1): c(k, 2) = c(k, 2) - d(k, 2): c(k, 3) = c(k, 3) - d(k, 3)
  69.         End If
  70.     Next
  72.     c(spheres, 1) = -2.5 * (.4 - _MouseX / _Width): c(spheres, 2) = -2. * (.75 * _Height - _MouseY) / _Height: c(spheres, 3) = 2
  73.     For i = 1 To scrh
  74.         For j = 0 To scrw - 1
  75.  
  76.             x = 0.3: y = -0.5: z = 0: ba = 3
  77.             dx = j - w: dy = h - i: dz = (scrh / 480) * 600
  78.             dd = dx * dx + dy * dy + dz * dz
  79.             recurs:
  80.             b1 = (y >= 0): b2 = (dy <= 0)
  81.             b3 = -(b1 Or b2)
  82.             n = n - b3
  83.             n = 0 - -(y >= 0 Or dy <= 0)
  84.  
  85.             If n = 0 Then s = 0 - y / dy
  86.             For k = 1 To spheres
  87.                 px = c(k, 1) - x: py = c(k, 2) - y: pz = c(k, 3) - z
  88.                 pp = px * px + py * py + pz * pz
  89.                 sc = px * dx + py * dy + pz * dz
  90.                 If sc <= 0 Then GoTo continueK
  91.                 bb = sc * sc / dd
  92.                 aa = q(k) - pp + bb
  93.                 If aa <= 0 Then GoTo continueK
  94.                 sc = (Sqr(bb) - Sqr(aa)) / Sqr(dd)
  95.                 If sc < s Or n < 0 Then n = k: s = sc
  96.                 continueK:
  97.             Next k
  98.  
  99.             If n < 0 Then
  100.                 'plot ink 16+(dy*dy/dd)*240;j,scrh-i
  101.                 c = Int(16 + (dy * dy / dd) * 240)
  102.                 '#gr "color ";c;" ";c;" ";c
  103.                 If lastCol <> c Then 'prevent extra color switching - JB speed-up
  104.                     Color pal(c)
  105.                     lastCol = c
  106.                 End If
  107.                 PSet (j, scrh - i)
  108.                 GoTo continueJ
  109.             End If
  110.             dx = dx * s: dy = dy * s: dz = dz * s: dd = dd * s * s
  111.             x = x + dx: y = y + dy: z = z + dz
  112.             If n <> 0 Then
  113.                 nx = x - c(n, 1): ny = y - c(n, 2): nz = z - c(n, 3)
  114.                 nn = nx * nx + ny * ny + nz * nz
  115.                 l = 2 * (dx * nx + dy * ny + dz * nz) / nn
  116.                 dx = dx - nx * l: dy = dy - ny * l: dz = dz - nz * l
  117.                 GoTo recurs 'really only GOTO
  118.             End If
  119.             For k = 1 To spheres
  120.                 u = c(k, 1) - x
  121.                 v = c(k, 3) - z
  122.                 If u * u + v * v <= q(k) Then
  123.                     ba = 1
  124.                     Exit For
  125.                 End If
  126.             Next k
  127.             If (x - Int(x) > .5) = (z - Int(z) > .5) Then
  128.                 'needs "int to lower" vs "int to 0"
  129.                 'If (x - (Int(x) - (x <> Int(x)) * (x < 0)) > .5) = (z - (Int(z) - (z <> Int(z)) * (z < 0)) > .5) Then
  130.                 'If (x Mod 1 + (x < 0) > .5) = (z Mod 1 + (z < 0) > .5) Then
  131.                 ik = cl(ba)
  132.             Else
  133.                 ik = cl(ba + 1)
  134.             End If
  135.             'plot ink ik;j,scrh-i
  136.             '#gr "color ";ik;" ";ik;" ";ik
  137.             If lastCol <> ik Then 'prevent extra color switching
  138.                 Color pal(ik)
  139.                 lastCol = ik
  140.             End If
  141.             PSet (j, scrh - i)
  142.             continueJ:
  143.         Next j
  144.     Next i
  145.     _Display
  147.  
  148. Sub rainbow (startIdx, stopIdx)
  149.     r0 = _Red32(pal(startIdx))
  150.     r1 = _Red32(pal(stopIdx))
  151.     g0 = _Green32(pal(startIdx))
  152.     g1 = _Green32(pal(stopIdx))
  153.     b0 = _Blue32(pal(startIdx))
  154.     b1 = _Blue32(pal(stopIdx))
  155.     For i = startIdx + 1 To stopIdx - 1
  156.         a = 1 - (stopIdx - i) / (stopIdx - startIdx) 'startIdx..stopIdx -> 0..1
  157.         R = Int(r0 * (1 - a) + r1 * a)
  158.         G = Int(g0 * (1 - a) + g1 * a)
  159.         B = Int(b0 * (1 - a) + b1 * a)
  160.         pal(i) = _RGB32(R, G, B)
  161.     Next
  163.  
  164.  

Colors as they should be:
  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Text Only | Text with Attachments