PERL   74

raytracer

Guest on 10th June 2022 01:32:17 PM

  1. #!/usr/bin/env perl
  2. use strict;
  3. use warnings;
  4. use Math::VectorReal;
  5. use Math::Trig;
  6. use Imager;
  7. use Imager::Fill;
  8. my $viewerPos = vector(0,-0.8,0);
  9. my $viewerForward = vector(0,0.2,1); # also view plane pos
  10. my $viewerUp = vector(0,1,0);
  11. my $viewerPlaneX = ($viewerForward x $viewerUp)->norm;
  12. my $viewerPlaneY = $viewerUp->norm;
  13.  
  14. my $floorUp = vector(0,1,0);
  15. my $floorX = vector(1,0,0);
  16. my $floorY = vector(0,0,1);
  17. my $floorPos = vector(0,-1,0);
  18.  
  19. my $spherePos = vector(0,0,2);
  20. my $sphereRad = 0.3;
  21.  
  22.  
  23. my $imgSize = 256;
  24.  
  25. my $img = new Imager(
  26.     xsize => $imgSize,
  27.     ysize => $imgSize,
  28. ) or die($!);
  29.  
  30.  
  31. my $rez = 1.0/$imgSize;
  32. my ($i,$j)=(0,0);
  33.  
  34. for (my $x=-0.5;$x<0.5;$x+=$rez) {
  35.     $j=$imgSize-1;
  36.     for (my $y=-0.5;$y<0.5;$y+=$rez) {
  37.         my $color = castRay($x,$y);
  38.  
  39.         my @pixel = map {
  40.             my $v=$_*255.0;
  41.             if ($v>255){$v=255;}
  42.             if ($v<0) { $v=0; }
  43.             $v;
  44.         } @$color;
  45.         $img->setpixel(x=>$i,y=>$j,color=>Imager::Color->new(@pixel));
  46.         $j--;
  47.     }
  48.     $i++;
  49. }
  50.  
  51. $img->write(file=>"ray.png") or die($!);
  52.  
  53.  
  54. exit 0;
  55.  
  56. sub castRay {
  57.     my ($x,$y) = @_;
  58.     my $r0 = $viewerPos;
  59.  
  60.     my $rayScreenIntersection =
  61.         $viewerPos + $viewerForward
  62.         + $x * $viewerPlaneX
  63.         + $y * $viewerPlaneY;
  64.  
  65.     my $dir = $rayScreenIntersection - $r0;
  66.  
  67.     return drawRay($r0,$dir,0);
  68.  
  69. }
  70.  
  71. sub drawRay {
  72.     my ($r0,$dir,$fromSphere) = @_;
  73.  
  74.     my $intersection = raySphereIntersection($r0,$dir);
  75.     if ( (!$fromSphere) && defined($intersection)) {
  76.         # We intersect the sphere.
  77.  
  78.         # Draw this segment.
  79.        
  80.  
  81.         my $dirOld = $dir->norm;
  82.         my $normal = ($intersection-$spherePos)->norm;
  83.  
  84.         my $cosTheta = $dirOld . $normal;
  85.  
  86.         my $dirNew = $dirOld - 2.0*$cosTheta * $normal;
  87.  
  88.         my $reflectedColor = drawRay($intersection,$dirNew,1);
  89.  
  90.         # Let's make it a bit reddish.
  91.  
  92.         my ($rr,$rg,$rb) = @$reflectedColor;
  93.  
  94.         $reflectedColor = [ $rr*1.2,$rg/1.2,$rb/1.2 ];
  95.  
  96.         return $reflectedColor;
  97.  
  98.  
  99.     } elsif (defined($intersection = rayFloorIntersection($r0,$dir))) {
  100.             # We hit the floor.
  101.  
  102.             my $floorVector = $intersection - $floorPos;
  103.             my $tileSize = 0.5;
  104.  
  105.             my $interX = int(($floorVector . $floorX)/$tileSize);
  106.             my $interY = int(($floorVector . $floorY)/$tileSize);
  107.  
  108.             # ($interX, $interY) give floor tile coordinates.
  109.  
  110.             my $xType = ($interX % 2 ) ;
  111.             my $yType = ($interY % 2 ) ;
  112.  
  113.             my $brightness = 5.0/($floorVector . $floorVector);
  114.             if ($brightness>1.0) { $brightness = 1.0; }
  115.             if ($brightness<0.0) { $brightness = 0.0; }
  116.             my $color;
  117.             if ($xType==$yType) {
  118.                 $color = [$brightness,$brightness,$brightness];
  119.             } else {
  120.                 $color = [$brightness,0,$brightness];
  121.             }
  122.  
  123.             return $color;
  124.     } else {
  125.             # Neither ray nor floor, therefore sky.
  126.  
  127.             my $cosTheta = ($dir . $floorUp) / ($dir->length * $floorUp->length);
  128.             $cosTheta *= 0.5;
  129.  
  130.             my @horizonColor = ( 1,0.0,0.0);
  131.             my @skyColor = ( 0.0,0.0,1.0 );
  132.  
  133.             my @color;
  134.             for (0..2) {
  135.                 push @color,$horizonColor[$_]*$cosTheta +
  136.                 (1.0-$cosTheta)*$skyColor[$_];
  137.             }
  138.  
  139.             return \@color;
  140.     }
  141.  
  142. }
  143.  
  144. sub rayFloorIntersection {
  145.     my ($r0,$dir) = @_;
  146.  
  147.     my $denom = $floorUp . $dir;
  148.     if ($denom == 0.0) { return ; } # line parallel to floor
  149.  
  150.     my $lambda = ( $floorUp . (  $floorPos - $r0 ) ) / $denom;
  151.  
  152.     if ($lambda>0.0) {
  153.         my $intersection = $r0 + $lambda*$dir;
  154.         return $intersection;
  155.     }
  156.  
  157.     return;
  158. }
  159.  
  160. sub raySphereIntersection {
  161.     my ($r0,$dir) = @_;
  162.  
  163.     my $a = $dir . $dir;
  164.     my $b = 2.0 * ($dir . ( $r0 - $spherePos ) );
  165.     my $c = (($r0 - $spherePos) . ($r0 - $spherePos)) - $sphereRad*$sphereRad;
  166.  
  167.     my $discriminant = $b*$b - 4.0*$a*$c;
  168.     if ($discriminant<0.0) {
  169.         return ;
  170.     } else {
  171.         my $root = sqrt($discriminant);
  172.         my $lambda0 = (-$b - $root)/(2.0*$a);
  173.         my $lambda1 = (-$b - $root)/(2.0*$a);
  174.  
  175.         my $lambda;
  176.         if ($lambda1<$lambda0) { $lambda=$lambda1; } else { $lambda=$lambda0; }
  177.  
  178.         my $intersection = $r0 + $lambda*$dir;
  179.         return $intersection;
  180.     }
  181. }

Raw Paste


Login or Register to edit or fork this paste. It's free.