PERL   15

facer

Guest on 10th June 2022 01:22:21 PM

  1. #!/usr/bin/env perl
  2. use strict;
  3. $^W=1;
  4.  
  5. use ToyGL ':all';
  6. use ToyGL::GLUT ':all';
  7. use Math::Quaternion;
  8. use Math::Trig;
  9. use Imager;
  10.  
  11. my $orientation = new Math::Quaternion;
  12. my ($geomx,$geomy,$geomz) = (0,0,-5);
  13. my $nearclip = 0.1;
  14. my $mousescale = 0.01;
  15. my $zoomscale=0.02;
  16. my $midtranslates = 0; # 1 for middle button to translate, 0 for zoom.
  17.  
  18. my $wsize = 256; # Window size
  19.  
  20. my %buttonstate = (     GLUT_LEFT_BUTTON,0,
  21.                         GLUT_MIDDLE_BUTTON,0,
  22.                         GLUT_RIGHT_BUTTON,0);
  23.  
  24.  
  25.  
  26.  
  27. my ($clickx,$clicky)=(0,0); # Coordinates of last mouse click
  28. my ($screenx,$screeny) = ($wsize,$wsize);
  29. my $sphererad = $screeny*0.5; # Radius of trackball sphere
  30.  
  31. glutInit;
  32.  
  33. glutInitWindowSize($screenx,$screeny);
  34. glutInitWindowPosition($wsize,0);
  35. glutInitDisplayMode(GLUT_RGBA | GLUT_DOUBLE | GLUT_DEPTH);
  36.  
  37.  
  38.  
  39. my $window = glutCreateWindow("GLUT window");
  40. init_gl();
  41. glutDisplayFunc(\&displayfunc);
  42. glutReshapeFunc( \&reshapefunc);
  43. glutMouseFunc(\&mousefunc);
  44. glutMotionFunc(\&motionfunc);
  45.  
  46. glutMainLoop;
  47.        
  48. exit 0;
  49.  
  50. sub init_gl {
  51.  
  52.         glColorMaterial(GL_FRONT,GL_AMBIENT_AND_DIFFUSE);
  53.         glEnable(GL_COLOR_MATERIAL);
  54.  
  55.         glClearColor(0.0,0.0,0.0,0.0);
  56.  
  57.         glDisable(GL_LIGHTING);
  58.  
  59.         glDisable(GL_DEPTH_TEST);
  60.         glBlendFunc(GL_SRC_ALPHA,GL_ONE);
  61.         glEnable(GL_BLEND);
  62.  
  63.         glTexParameter(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_LINEAR);
  64.         glTexParameter(GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_LINEAR);
  65.         glTexEnv(GL_TEXTURE_ENV,GL_TEXTURE_ENV_MODE,GL_MODULATE);
  66.         glEnable(GL_TEXTURE_2D);
  67.         glFrontFace(GL_CCW);
  68.  
  69.         my $img = Imager->new;
  70.  
  71.         $img->open(
  72.                 file => 'star.png',
  73.                 type => 'png',
  74.         ) or die("Could not open image file");
  75.  
  76.         glTexImage2D(image=>$img);
  77.  
  78.  
  79. }
  80.  
  81. sub reshapefunc {
  82.         my ($w,$h) = @_;
  83.  
  84.         ($screenx,$screeny) = @_;
  85.         $sphererad = $screeny*0.5;
  86.  
  87.         print "Reshaped to $w x $h\n";
  88.         glViewport(0,0,$w,$h);
  89. }
  90.  
  91. sub displayfunc{
  92.  
  93.         glClear(GL_COLOR_BUFFER_BIT|GL_DEPTH_BUFFER_BIT);
  94.  
  95.         # Set up perspective projection
  96.         glMatrixMode(GL_PROJECTION);
  97.         glLoadIdentity();
  98.         gluPerspective(60.0,$screenx/$screeny,$nearclip,1024.0 );
  99.         glMatrixMode(GL_MODELVIEW);
  100.         glLoadIdentity();
  101.  
  102.         glTranslate($geomx,$geomy,$geomz);
  103.         my @m = $orientation->matrix4x4;
  104.         glMultMatrix(@m);
  105.  
  106.         my ($theta,$phi);
  107.         my $dtheta = pi/16;
  108.         my $dphi = 2*pi/12;
  109.         for ($theta=$dtheta;$theta<pi;$theta+=$dtheta) {
  110.                 for ($phi=0;$phi<2*pi;$phi+=$dphi) {
  111.                         my $r = 5.0;
  112.                         my $x = sin($theta)*cos($phi);
  113.                         my $y = sin($theta)*sin($phi);
  114.                         my $z = cos($theta);
  115.                         glColor(
  116.                                 0.5+0.5*abs($x),
  117.                                 0.5+0.5*abs($y),
  118.                                 0.5+0.5*abs($z));
  119.                         glPushMatrix;
  120.                                 glTranslate($r*$x,$r*$y,$r*$z);
  121.                                 draw_star();
  122.                         glPopMatrix;
  123.  
  124.                 }
  125.         }
  126.  
  127.  
  128.         glFlush();
  129.         glutSwapBuffers();
  130. }
  131.  
  132. sub postredisplay {
  133.         glutPostRedisplay();
  134. }
  135.  
  136. sub mousefunc {
  137.         my ($button,$state,$x,$y) = @_;
  138.  
  139.         ($clickx,$clicky) = ($x,$y);
  140.         $buttonstate{$button} = (GLUT_DOWN == $state) ? 1 : 0;
  141. }
  142.  
  143. sub motionfunc {
  144.         my ($x,$y) = @_;
  145.         my ($left,$mid,$right) =
  146.          @buttonstate{GLUT_LEFT_BUTTON, GLUT_MIDDLE_BUTTON, GLUT_RIGHT_BUTTON};
  147.  
  148.         if ($left) {
  149.                 mouserotatemotion($clickx,$clicky,$x,$y);
  150.                 ($clickx,$clicky) = ($x,$y);
  151.         } elsif ($mid) {
  152.                 if ($midtranslates) {
  153.                         mousetransmotion($clickx,$clicky,$x,$y);
  154.                 } else {
  155.                         mousezoommotion($y-$clicky);
  156.                 }
  157.                 ($clickx,$clicky) = ($x,$y);
  158.         } elsif ($right) {
  159.         }
  160.  
  161. }
  162.  
  163. sub mouserotatemotion {
  164.         my ($x0,$y0,$x1,$y1) = @_;
  165.  
  166.         my $s = $sphererad;
  167.         my $my = $x1-$x0;
  168.         my $mx = $y1-$y0;
  169.         my $m=sqrt($mx*$mx+$my*$my);
  170.  
  171.         my $theta;
  172.  
  173.         if (($m>0) && ($m<$s)) {
  174.                 $theta = $m/$s;
  175.  
  176.                 $mx /= $m;
  177.                 $my /= $m;
  178.  
  179.                 my $rotquat = Math::Quaternion::rotation($theta,$mx,$my,0.0);
  180.                 $orientation = $rotquat * $orientation;
  181.         }
  182.  
  183.         postredisplay;
  184. }
  185.  
  186. sub mousetransmotion {
  187.         my ($x0,$y0,$x1,$y1) = @_;
  188.  
  189.         $geomx += $mousescale * ($x1-$x0);
  190.         $geomy += $mousescale * ($y0-$y1);
  191.  
  192.         postredisplay;
  193. }
  194.  
  195. sub mousezoommotion {
  196.         my $dz = shift;
  197.         $geomz -= $zoomscale*$dz;
  198.         postredisplay;
  199. }
  200.  
  201.  
  202. {
  203.         my $lastidno = 0;
  204.         sub makeid {
  205.                 return $lastidno++;
  206.         }
  207. }
  208.  
  209. sub draw_star {
  210.  
  211.         my @polydata = (
  212.                 [ 0, 1],
  213.                 [ 1, 1],
  214.                 [ 1, 0],
  215.                 [ 0, 0],
  216.         );
  217.  
  218.         # Grab the modelview matrix into @m
  219.         my @m= glGet(GL_MODELVIEW_MATRIX);
  220.         # Set non-translational part to the identity matrix.
  221.         $m[0] = $m[5] = $m[10] = 1.0;
  222.         $m[1] = $m[2] = $m[4] = $m[6]
  223.         = $m[8] = $m[9] = 0.0;
  224.         # Load this as the new modelview matrix.
  225.         glLoadMatrix(@m);
  226.         # Draw a quad textured with the star.
  227.         glBegin(GL_QUADS);
  228.         for (0..3) {
  229.                 my @a = @{$polydata[$_]};
  230.                 glTexCoord(@a);
  231.                 glVertex(@a);
  232.         }
  233.         glEnd;
  234. }

Raw Paste

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