Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Text to animated pseudo-braille GIF

by diotalevi (Canon)
on Nov 08, 2005 at 00:01 UTC ( [id://506575]=CUFP: print w/replies, xml ) Need Help??

See my monkpic for an example.

The following script takes some simple text input and creates an animated GIF showing a sighted person's interpretation of how braille might be written if it were only meant for sighted people. I'm learning braille and I've found it easier to write down characters using lines instead of just dots. All I'm doing is connecting the dots so the actual dot pattern is apparent when I look at the drawn character. I wrote this program for fun and to see how to make animated gifs.

  • --file The filename to be written to
  • --text the text to write. Only lowercase characters and space are supported.
  • --delay 100ths of a second to pause between characters. The default is 25.
  • --X # of pixels wide. Default is 100.
  • --Y # of pixels tall. Default is 100.

Real braille numbers the dots on the left one through three and then on the right, four thorugh six. The dot numbers in this program don't match that - I used morris dancer positions instead. So don't bother trying to learn the numbers for the dot positions - they're wrong here.

use strict; use warnings; use GD 2; use vars qw( %CharMap $DELAY $X $Y ); use Getopt::Long; GetOptions( 'file=s' => \ my( $file ), 'text=s' => \ my( $text ), 'delay=i' => \ ( $DELAY = 25 ), 'X=i' => \ ( $X = 100 ), 'Y=i' => \ ( $Y = 100 ) ); defined $file and length $text and $DELAY > 0 and $X > 0 and $Y > 0 or die "Usage: $0 --file ... --text ... --delay ... --X ... --Y ...\ +n"; AnimatedGIF( $file, map RenderChar( Char( $_ ) ), split( //, $text ) ); exit; sub DELAY () { $DELAY } sub X () { $X } sub Y () { $Y } sub X1 () { int( $X * 1 / 3 ) } sub X2 () { int( $X * 2 / 3 ) } sub Y1 () { int( $Y * 1 / 4 ) } sub Y2 () { int( $Y * 2 / 4 ) } sub Y3 () { int( $Y * 3 / 4 ) } BEGIN { @CharMap{"a" .. "z", " "} = ( [[1]], [[qw[1 2]]], [[qw[1 3]]], [[qw[1 2 4]]], [[qw[1 4]]], [[qw[3 1 2]]], [[qw[1 2 4 3 1]]], [[qw[1 3 4]]], [[qw[2 3]]], [[qw[2 4 3]]], [[1],[5]], [[qw[1 3 5]]], [[qw[1 2]],[5]], [[qw[1 2 4 5]]], [[qw[1 4 5]]], [[qw[5 3 1 2]]], [[qw[3 4 2 1 4 5]]], [[qw[1 3 5]],[qw[3 4]]], [[qw[5 3 2]]], [[qw[5 3 4 2]]], [[1],[qw[5 6]]], [[qw[1 3 5 6]]], [[qw[2 4 6]],[qw[3 4]]], [[qw[1 2]],[qw[5 6]]], [[qw[1 2 4 6 5]]], [[qw[1 4 6 5]]], [] ); } sub Char { map $CharMap{$_}, @_ } sub AnimatedGIF { my $file = shift; open my $img, "> $file\0" or die "Couldn't open $file: $!"; binmode $img or die "Couldn't set binmode on $file: $!"; my $first = $_[0]; print $img $first->gifanimbegin( 1, 0 ) or die "Couldn't write to $file: $!"; print $img $first->gifanimadd( 0, 0, 0, DELAY ) or die "Couldn't write to $file: $!"; for ( 1 .. $#_ ) { my ( $this, $prev ) = @_[ $_, $_ - 1 ]; print $img $this->gifanimadd( 0, 0, 0, DELAY, 1, $prev ) or die "Couldn't write to $file: $!"; } print $img $first->gifanimend or die "Couldn't write to $file: $!"; close $img or die "Couldn't close and flush $file: $!"; return; } sub Position2XY { return map( +( $_ == 1 ? [ X1, Y1 ] : $_ == 2 ? [ X2, Y1 ] : $_ == 3 ? [ X1, Y2 ] : $_ == 4 ? [ X2, Y2 ] : $_ == 5 ? [ X1, Y3 ] : [ X2, Y3 ] ), @_ ); } sub RenderChar { my $im = GD::Image->new( X, Y ); my $brush = GD::Image->new( 7, 7 ); { my $white = $brush->colorAllocate( 255, 255, 255 ); my $black = $brush->colorAllocate( 0, 0, 0 ); $brush->transparent( $white ); $brush->arc( 4, 4, 7, 7, 0, 360, $black ); } $im->setBrush( $brush ); while ( @_ ) { for my $line ( @{shift()} ) { my @points = map Position2XY( $_ ), @$line; if ( 1 == @points ) { push( @points, [ $points[0][0] + 1, $points[0][1] ], [ $points[0][0] + 1, $points[0][1] + 1 ], [ $points[0][0], $points[0][1] + 1 ] ); } my $poly = GD::Polygon->new; $poly->addPt( @$_ ) for @points; $im->unclosedPolygon( $poly, gdBrushed ); } } return $im; }

Replies are listed 'Best First'.
Re: Text to animated pseudo-braille GIF
by zentara (Archbishop) on Nov 08, 2005 at 13:05 UTC
    I was watching "Close Encounters of the Third Kind" last night, and this reminds me of the movie's attempt to demonstrate how we might communicate with space aliens. Another use for Perl!

    I'm not really a human, but I play one on earth. flash japh

      Given that you're not really human (I read sigs....), how did you first communicate with us poor humans?

      emc

        how did you first communicate with us poor humans?

        Screaming and electro-shock. :-) My first words.....

        #!/usr/bin/perl use warnings; use strict; use Fcntl; require 'sys/soundcard.ph'; sysopen(SEQ_FH,'/dev/sequencer',O_WRONLY) or die $!; while(1){ for my $note (20,40,30,40,50){ send_midi_bytes(0xc0,123); #cool patch sound send_midi_bytes(0x90,$note,100); select(undef,undef,undef,1); } } sub send_midi_bytes { #print "@_\n"; my $device = 1; my $stuff = pack('C*', (map {&SEQ_MIDIPUTC(), $_, $device,0 } @_ ) ); my $bytes = syswrite(SEQ_FH, $stuff) or die $!; if (not $bytes) { die("Couldn't write to /dev/sequencer $!" ); } }

        I'm not really a human, but I play one on earth. flash japh
      For communicating with space aliens you need a MIDI module, I think. HTH.HAND.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://506575]
Approved by muba
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others examining the Monastery: (7)
As of 2024-03-29 08:29 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found