See this blog entry for details. Feel free to play with image params -- size, etc.
package XAO::DO::Web::Piggy; use strict; use XAO::Utils; use XAO::Objects; use Math::Trig; use Image::Magick; use base XAO::Objects->load(objname => 'Web::Page'); ## Written 8/11/2000, hacked into XAO::Web 5/31/2006 ## Andrew Maltsev <am@ejelta.com> ############################################################################### sub display ($%) { my $self=shift; my $args=get_args(\@_); my $cgi=$self->cgi; my $x0=0; my $y0=int($cgi->param('size') || 250); $y0=250 if $y0<100 || $y0>1000; my $xc=$y0*1.6; my $yc=$y0*0.8; my $deltax=1; my $image=Image::Magick->new; $image->Set(size => ($xc*2).'x'.($yc*2)); $image->Set(colorspace => 'RGB'); $image->ReadImage('xc:white'); $image->Set(magick => 'png'); unless($cgi->param('noaxis')) { $image->Draw( primitive => 'line', points => sprintf('%u,%u %u,%u',$xc,0,$xc,$yc+$y0/2), stroke => '#f88', ); $image->Draw( primitive => 'line', points => sprintf('%u,%u %u,%u',0,$yc+$y0/2,$xc*2,$yc+$y0/2), stroke => '#f88', ); } my $gridstep=int($y0/20); for(my $xxx=0; $xxx<$xc; $xxx+=$gridstep) { for(my $yyy=0; $yyy<$yc*2; $yyy+=$gridstep) { $image->Set(sprintf('pixel[%u,%u]',$xc+$xxx,$yc+$y0/2-$yyy) => '#f88'); $image->Set(sprintf('pixel[%u,%u]',$xc-$xxx,$yc+$y0/2-$yyy) => '#f88'); $image->Set(sprintf('pixel[%u,%u]',$xc+$xxx,$yc+$y0/2+$yyy) => '#f88'); $image->Set(sprintf('pixel[%u,%u]',$xc-$xxx,$yc+$y0/2+$yyy) => '#f88'); } } my $sw=int($y0/150) || 1; my $draw_blot=sub { my ($x,$y)=@_; $image->Draw( primitive => 'circle', stroke => '#000', fill => '#000', points => sprintf('%u,%u %u,%u',$x,$y,$x+$sw,$y), ); }; my $draw_surface=sub { my ($x,$y)=@_; $y=$y-$y0/2; $draw_blot->($xc+$x,$yc+$y); $draw_blot->($xc-$x,$yc+$y); $draw_blot->($xc+$x,$yc-$y) if $x>$y0/5; $draw_blot->($xc-$x,$yc-$y) if $x>$y0/5; }; my @betas; my $x=$x0; my $y=$y0; my $halfpi=pi/2; while($y>$y0/2) { my $alpha=$halfpi-atan($x/$y); my $beta=-($halfpi-$alpha)/2; $betas[int($x)]=$beta; $draw_surface->($x,$y); $x+=$deltax; $y+=$deltax*sin($beta); } ## # Reality checks -- casting rays and checking where they end up # unless($cgi->param('norays')) { my $pget=sub { my ($x,$y)=@_; $x=$x+$xc; $y=$yc+$y0/2-$y; return undef if $x<=0 || $x>=$xc*2-1 || $y<=0 || $y>=$yc*2-1; my $pixel=$image->Get(sprintf('pixel[%u,%u]',$x,$y)); ### dprint "pget($x,$y)=$pixel"; return ($pixel =~ /^0,0,0/ ? 0 : 1); }; my $raycolor; my $pset=sub { my ($x,$y)=@_; $image->Set(sprintf('pixel[%u,%u]',$x+$xc,$yc+$y0/2-$y) => $raycolor); }; my $ray_check; $ray_check=sub { my ($x,$y,$angle,$level)=@_; $level=0 unless $level; $level<10 || return; #throw $self "display - too many reflections"; my $dx=cos($angle)/2; my $dy=sin($angle)/2; while($pget->($x,$y)==0) { $x+=$dx; $y+=$dy; } while(1) { my $index=$pget->($x,$y); return unless defined $index; last unless $index; $pset->($x,$y); $x+=$dx; $y+=$dy; } my $beta=$betas[int(abs($x))]; $beta=-$beta if $y < $y0/2; $beta=pi-$beta if $x<0; $angle=-$angle+2*$beta; ## print "beta=$beta angle=$angle\n"; $ray_check->($x,$y,$angle,$level+1); }; ## # Checking # $raycolor='#0c8'; $ray_check->($y0/20,$y0*0.02,deg2rad(50)); $ray_check->($y0/20,$y0*0.02,deg2rad(60)); $ray_check->($y0/20,$y0*0.02,deg2rad(70)); $raycolor='#08c'; $ray_check->($y0/20,$y0*0.12,deg2rad(50)); $ray_check->($y0/20,$y0*0.12,deg2rad(60)); $ray_check->($y0/20,$y0*0.12,deg2rad(70)); if($cgi->param('hzcheck')) { $raycolor='#880'; $ray_check->(-$y0*0.05,$y0*0.04,deg2rad(110)); $ray_check->(-$y0*0.05,$y0*0.04,deg2rad(120)); $ray_check->(-$y0*0.05,$y0*0.04,deg2rad(130)); $ray_check->(-$y0*0.05,$y0*0.04,deg2rad(140)); $ray_check->(-$y0*0.10,$y0*0.04,deg2rad(110)); $ray_check->(-$y0*0.10,$y0*0.04,deg2rad(120)); $ray_check->(-$y0*0.10,$y0*0.04,deg2rad(130)); $ray_check->(-$y0*0.10,$y0*0.04,deg2rad(140)); $ray_check->(-$y0*0.15,$y0*0.04,deg2rad(110)); $ray_check->(-$y0*0.15,$y0*0.04,deg2rad(120)); $ray_check->(-$y0*0.15,$y0*0.04,deg2rad(130)); $ray_check->(-$y0*0.15,$y0*0.04,deg2rad(140)); } } if($y0>=200) { my $lh=int($y0/13); my $yt=int($yc+$y0/2); my $pt=int($lh*0.7); foreach my $text (split(/\n/),<<EOT) { Surface calculation for an illusion of a small object appearing in the air above the opening between two mirrors ------------------------- Andrew Maltsev, Nov 8th, 2000 -- https://ejelta.com/am/piggy.html --------------------------- Test rays are actually cast and calculated dot by dot against the surface. Notice how green and cyan rays starting on the right cross again above the surface on the left. This is what creates the illusion. EOT $yt+=$lh; $image->Annotate( text => $text, antialias => 'true', x => 10, y => $yt, pointsize => $pt, fill => '#333', ); } } my $blob=$image->ImageToBlob; $self->object(objname => 'Web::Header')->display( type => 'image/png' ); $self->finaltextout($blob); } ############################################################################### 1;
<%Header title={"Holographic Piggy" Illusion Mirrors Calculator} STATIC_PAGE %> <%Styler text={'Andrew's "Holographic Piggy" Illusion Mirrors Calculator'} style='section-title'%> This is a realtime calculation of mirrors needed to produce a very cool 3D illusion of a small object floating above the opening -- works in any light and without any electronics/special equipment. Pure magic :) <P> <STRONG>See <A HREF="#">this blog entry</A> for details.</STRONG> Feel free to play with image params -- size, etc. <P> <IMG SRC="piggy.png?size=250" WIDTH="800" HEIGHT="400" STYLE="border: 1px solid #999; padding: 1em; margin: 1em 0; display: block"> <%Styler text={'Source Code'} style='section-title'%> The source is for <A HREF="/xao/">XAO::Web</A> (which powers this site), but you can easily change it to work from command line or what not.. <PRE CLASS="sourcecode" STYLE="font-size: 80%"> <%Page/h path='/bits/am/piggy/source-code' unparsed%> </PRE> <%Styler text={'This web page source'} style='section-title'%> I can't resist the temptation to put the web page source here as well: <PRE CLASS="sourcecode" STYLE="font-size: 80%"> <%Page/h path='/am/piggy.html' unparsed%> </PRE> <%Footer%> <!-- vim: ft=xaoweb -->