http://qs1969.pair.com?node_id=596923

Approximately 2.5 years ago, I posted JAPH attempt using Term::ANSIScreen, my first attempt at a JAPH-like program. A few days ago, I decided to take a second look at it, to see what I could do. Here it is, for your enjoyment. (The behavior is the same as described with the previous posting.) Comments welcome (but since golfing is not my specialty, please don't kill(TERM, me)...)

#!/usr/bin/perl -w use strict; use Term::ANSIScreen; $| = 1; my $delay = 0.1; my $width = 75; my $charwidth = 9; my $looptimes = 10; my %lpos = ( ' ' => [ 4, 12, 17, 24 ], a => [ 5, 19 ], c => [20], e => [ 10, 14, 22 ], h => [ 9, 18 ], J => [0], k => [21], l => [16], n => [6], o => [7], p => [13], r => [ 11, 15, 23 ], s => [2], t => [ 3, 8 ], u => [1], ); my (%letters); my (@characterline); while ( my $line = <DATA> ) { my @parts = ( $line =~ m/(.{5})/g ); foreach my $s (@parts) { my @pieces = ( substr( $s, 0, 1 ), hex( substr( $s, 1, 2 ) ), hex( substr( $s, 3, 2 ) ) ); my $res = resolve( $pieces[2] ); $letters{ $pieces[0] }[ $pieces[1] ] = $res; } } { my (@s); { foreach my $k ( keys(%lpos) ) { foreach my $i ( @{ $lpos{$k} } ) { $s[$i] = $k; } } } my (@characterblock); foreach my $y ( 0 .. 8 ) { foreach my $x ( 0 .. ( scalar(@s) * $charwidth ) ) { $characterblock[$y][$x] = ' '; } } my $x = 0; foreach my $l (@s) { foreach my $i ( 0 .. $#{ $letters{$l} } ) { $characterblock[ $letters{$l}[$i]{y} ] [ $x + $letters{$l}[$i]{x} ] = $l; } $x += $charwidth; } foreach my $y ( 0 .. 8 ) { $characterline[$y] = join( '', @{ $characterblock[$y] } ); } } my $console = Term::ANSIScreen->new; { $console->Cls(); foreach my $i ( 0 .. ( $looptimes - 1 ) ) { foreach my $x ( 0 .. length( $characterline[0] ) ) { $console->Cursor( 1, 1 ); foreach my $y ( 0 .. 8 ) { print substr( $characterline[$y] x 2, $x, $width ), "\n"; } select undef, undef, undef, $delay; } } } sub obscure { my ($coor_ref) = @_; my $digit = $coor_ref->{y} * 8 + $coor_ref->{x}; return $digit; } sub resolve { my ($digit) = @_; my %coor = ( x => ( $digit % 8 ), y => int( $digit / 8 ) ); return \%coor; } __DATA__ 0000 0101 0202 0303 0404 0505 0606 0708 0809 090a 0a0b 0b0c 0c0d 0d0e 0e10 0f11 1012 1113 1214 1315 1416 1518 1619 171a 181b 191c 1a1d 1b1e 1c20 1d21 1e22 1f23 2024 2125 2226 2328 2429 252a 262b 272c 282d 292e 2a30 2b31 2c32 2d33 2e34 2f35 3036 3138 3239 333a 343b 353c 363d 373eJ0002J0103J0204J0305 J0406J050cJ060dJ0714J0815J091cJ0a1dJ0b24J0c25J0d29J0e2aJ0f2c J102dJ1132J1233J1334a0011a0112a0213a0314a0415a051da061ea0728 a0829a092da0a2ea0b21a0c22a0d23a0e25a0f26a1031a1132a1233a1335 a1436c0012c0113c0214c0332c0433c0534c0618c0719c0820c0921c0a28 c0b29e0011e0112e0213e0314e0418e0519e061ce071de0820e0921e0a22 e0b23e0c24e0d25e0e28e0f29e1031e1132e1233e1334e1435h0000h0101 h0208h0309h0410h0511h0618h0719h081ah091bh0a1ch0b20h0c21h0d24 h0e25h0f28h1029h112ch122dh1330h1431h1534h1635k0000k0101k0208 k0309k0420k0521k0622k0723k0824k0910k0a11k0b14k0c15k0d18k0e19 k0f1bk101ck1128k1229k132bk142ck1530k1631k1734k1835l0009l010a l0211l0312l0419l051al0621l0722l0829l092al0a00l0b01l0c02l0d03 l0e32l0f33l1034n0018n011an021bn031cn041dn0520n0621n0725n0826 n0928n0a29n0b2dn0c2en0d30n0e31n0f35n1036o0012o0113o0214o0332 o0433o0534o0618o0719o081do091eo0a20o0b21o0c25o0d26o0e28o0f29 o102do112ep0010p0111p0213p0314p0415p0528p0629p072bp082cp092d p0a18p0b19p0c1ap0d1ep0e20p0f21p1022p1126p1230p1331p1438p1539 r0010r0112r0213r0314r0415r0518r0619r071dr081er0920r0a21r0b28 r0c29r0d30r0e31s0010s0111s0212s0313s0414s0520s0621s0722s0823 s0924s0a30s0b31s0c32s0d33s0e34s0f18s1019s112cs122dt0012t0113 t0222t0323t042at052bt0618t0719t081at091bt0a1ct0b1dt0c33t0d34 t0e35u0018u0119u021cu031du0420u0521u0624u0725u0828u0929u0a2c u0b2du0c31u0d32u0e33u0f35

Update 2007-01-27: Noticed that I could remove a line dealing with the results of the resolve function.

Update 2007-01-27: Removed reference to Data::Dumper, that was used while playing with the code earlier.