1#!/usr/local/bin/perl 2# 3############################################################################# 4# Asciiquarium - An aquarium animation in ASCII art 5# 6# This program displays an aquarium/sea animation using ASCII art. 7# It requires the module Term::Animation, which requires Curses. You 8# can get both modules from http://search.cpan.org. Asciiquarium will 9# only run on platforms with a curses library, so Windows is not supported. 10# 11# The current version of this program is available at: 12# 13# http://robobunny.com/projects/asciiquarium 14# 15############################################################################# 16# Author: 17# Kirk Baucom <kbaucom@schizoid.com> 18# 19# Contributors: 20# Joan Stark: http://www.geocities.com/SoHo/7373/ 21# most of the ASCII art 22# 23# License: 24# 25# Copyright (C) 2013 Kirk Baucom (kbaucom@schizoid.com) 26# 27# This program is free software; you can redistribute it and/or modify 28# it under the terms of the GNU General Public License as published by 29# the Free Software Foundation; either version 2 of the License, or 30# (at your option) any later version. 31# 32# This program is distributed in the hope that it will be useful, 33# but WITHOUT ANY WARRANTY; without even the implied warranty of 34# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 35# GNU General Public License for more details. 36# 37# You should have received a copy of the GNU General Public License along 38# with this program; if not, write to the Free Software Foundation, Inc., 39# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 40############################################################################# 41 42use Term::Animation 2.0; 43use Term::Animation::Entity; 44use Data::Dumper; 45use Curses; 46use strict; 47use warnings; 48 49my $version = "1.1"; 50 51my @random_objects = init_random_objects(); 52 53# the Z depth at which certain items occur 54my %depth = ( 55 # no gui yet 56 guiText => 0, 57 gui => 1, 58 59 # under water 60 shark => 2, 61 fish_start => 3, 62 fish_end => 20, 63 seaweed => 21, 64 castle => 22, 65 66 # waterline 67 water_line3 => 2, 68 water_gap3 => 3, 69 water_line2 => 4, 70 water_gap2 => 5, 71 water_line1 => 6, 72 water_gap1 => 7, 73 water_line0 => 8, 74 water_gap0 => 9, 75); 76 77main(); 78 79####################### MAIN ####################### 80 81sub main { 82 83 my $anim = Term::Animation->new(); 84 85 # set the wait time for getch 86 halfdelay(1); 87 #nodelay(1); 88 89 $anim->color(1); 90 91 my $start_time = time; 92 my $paused = 0; 93 while(1) { 94 95 add_environment($anim); 96 add_castle($anim); 97 add_all_seaweed($anim); 98 add_all_fish($anim); 99 random_object(undef, $anim); 100 101 $anim->redraw_screen(); 102 103 my $nexttime = 0; 104 105 while(1) { 106 my $in = getch(); 107 108 if ( $in eq 'q' ) { quit(); } # Exit 109 elsif( $in eq 'r' || $in eq KEY_RESIZE()) { last; } # Redraw (will recreate all objects) 110 elsif( $in eq 'p' ) { $paused = !$paused; } 111 112 $anim->animate() unless($paused); 113 } 114 $anim->update_term_size(); 115 $anim->remove_all_entities(); 116 117 } 118 119} 120 121sub add_environment { 122 my ($anim) = @_; 123 124 my @water_line_segment = ( 125 q{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}, 126 q{^^^^ ^^^ ^^^ ^^^ ^^^^ }, 127 q{^^^^ ^^^^ ^^^ ^^ }, 128 q{^^ ^^^^ ^^^ ^^^^^^ } 129 ); 130 131 # tile the segments so they stretch across the screen 132 my $segment_size = length($water_line_segment[0]); 133 my $segment_repeat = int($anim->width()/$segment_size) + 1; 134 foreach my $i (0..$#water_line_segment) { 135 $water_line_segment[$i] = $water_line_segment[$i]x$segment_repeat; 136 } 137 138 foreach my $i (0..$#water_line_segment) { 139 $anim->new_entity( 140 name => "water_seg_$i", 141 type => "waterline", 142 shape => $water_line_segment[$i], 143 position => [ 0, $i+5, $depth{'water_line' . $i} ], 144 default_color => 'cyan', 145 depth => 22, 146 physical => 1, 147 ); 148 } 149} 150 151sub add_castle { 152 my ($anim) = @_; 153 my $castle_image = q{ 154 T~~ 155 | 156 /^\ 157 / \ 158 _ _ _ / \ _ _ _ 159[ ]_[ ]_[ ]/ _ _ \[ ]_[ ]_[ ] 160|_=__-_ =_|_[ ]_[ ]_|_=-___-__| 161 | _- = | =_ = _ |= _= | 162 |= -[] |- = _ = |_-=_[] | 163 | =_ |= - ___ | =_ = | 164 |= []- |- /| |\ |=_ =[] | 165 |- =_ | =| | | | |- = - | 166 |_______|__|_|_|_|__|_______| 167}; 168 169 my $castle_mask = q{ 170 RR 171 172 yyy 173 y y 174 y y 175 y y 176 177 178 179 yyy 180 yy yy 181 y y y y 182 yyyyyyy 183}; 184 185 $anim->new_entity( 186 name => "castle", 187 shape => $castle_image, 188 color => $castle_mask, 189 position => [ $anim->width()-32, $anim->height()-13, $depth{'castle'} ], 190 default_color => 'BLACK', 191 ); 192} 193 194sub add_all_seaweed { 195 my ($anim) = @_; 196 # figure out how many seaweed to add by the width of the screen 197 my $seaweed_count = int($anim->width() / 15); 198 for (1..$seaweed_count) { 199 add_seaweed(undef, $anim); 200 } 201} 202 203sub add_seaweed { 204 my ($old_seaweed, $anim) = @_; 205 my @seaweed_image = ('',''); 206 my $height = int(rand(4)) + 3; 207 for my $i (1..$height) { 208 my $left_side = $i%2; 209 my $right_side = !$left_side; 210 $seaweed_image[$left_side] .= "(\n"; 211 $seaweed_image[$right_side] .= " )\n"; 212 } 213 my $x = int(rand($anim->width()-2)) + 1; 214 my $y = $anim->height() - $height; 215 my $anim_speed = rand(.05) + .25; 216 $anim->new_entity( 217 name => 'seaweed' . rand(1), 218 shape => \@seaweed_image, 219 position => [ $x, $y, $depth{'seaweed'} ], 220 callback_args => [ 0, 0, 0, $anim_speed ], 221 die_time => time() + int(rand(4*60)) + (8*60), # seaweed lives for 8 to 12 minutes 222 death_cb => \&add_seaweed, 223 default_color => 'green', 224 ); 225} 226 227# add an air bubble to a fish 228sub add_bubble { 229 my ($fish, $anim) = @_; 230 231 my $cb_args = $fish->callback_args(); 232 my @fish_size = $fish->size(); 233 my @fish_pos = $fish->position(); 234 my @bubble_pos = @fish_pos; 235 236 # moving right 237 if($cb_args->[0] > 0) { 238 $bubble_pos[0] += $fish_size[0]; 239 } 240 $bubble_pos[1] += int($fish_size[1] / 2); 241 # bubble always goes on top of the fish 242 $bubble_pos[2]--; 243 244 $anim->new_entity( 245 shape => [ '.', 'o', 'O', 'O', 'O' ], 246 type => 'bubble', 247 position => \@bubble_pos, 248 callback_args => [ 0, -1, 0, .1 ], 249 die_offscreen => 1, 250 physical => 1, 251 coll_handler => \&bubble_collision, 252 default_color => 'CYAN', 253 ); 254} 255 256sub bubble_collision { 257 my ($bubble, $anim) = @_; 258 my $collisions = $bubble->collisions(); 259 foreach my $col_obj (@{$collisions}) { 260 if($col_obj->type eq 'waterline') { 261 $bubble->kill(); 262 last; 263 } 264 } 265 266} 267 268sub add_all_fish { 269 my ($anim) = @_; 270 # figure out how many fish to add by the size of the screen, 271 # minus the stuff above the water 272 my $screen_size = ($anim->height() - 9) * $anim->width(); 273 my $fish_count = int($screen_size / 350); 274 for (1..$fish_count) { 275 add_fish(undef, $anim); 276 } 277} 278 279 280sub add_fish { 281 my ($old_fish, $anim) = @_; 282 my @fish_image = ( 283 284q{ 285 \ 286 ...\.., 287\ /' \ 288 >= ( ' > 289/ \ / / 290 `"'"'/'' 291}, 292q{ 293 2 294 1112111 2956 11 1 296 66 7 4 5 2976 1 3 1 298 11111311 299}, 300q{ 301 / 302 ,../... 303 / '\ / 304< ' ) =< 305 \ \ / \ 306 `'\'"'"' 307}, 308q{ 309 2 310 1112111 311 1 11 6 3125 4 7 66 313 1 3 1 6 314 11311111 315}, 316q{ 317 \ 318\ /--\ 319>= (o> 320/ \__/ 321 / 322}, 323q{ 324 2 3256 1111 32666 745 3276 1111 328 3 329}, 330q{ 331 / 332 /--\ / 333<o) =< 334 \__/ \ 335 \ 336}, 337q{ 338 2 339 1111 6 340547 66 341 1111 6 342 3 343}, 344q{ 345 \:. 346\;, ,;\\\\\,, 347 \\\\\;;:::::::o 348 ///;;::::::::< 349 /;` ``/////`` 350}, 351q{ 352 222 353666 1122211 354 6661111111114 355 66611111111115 356 666 113333311 357}, 358q{ 359 .:/ 360 ,,///;, ,;/ 361 o:::::::;;/// 362>::::::::;;\\\\\ 363 ''\\\\\\\\\'' ';\ 364}, 365q{ 366 222 367 1122211 666 368 4111111111666 36951111111111666 370 113333311 666 371}, 372q{ 373 __ 374><_'> 375 ' 376}, 377q{ 378 11 37961145 380 3 381}, 382q{ 383 __ 384<'_>< 385 ` 386}, 387q{ 388 11 38954116 390 3 391}, 392q{ 393 ..\, 394>=' ('> 395 '''/'' 396}, 397q{ 398 1121 399661 745 400 111311 401}, 402q{ 403 ,/.. 404<') `=< 405 ``\``` 406}, 407q{ 408 1211 409547 166 410 113111 411}, 412q{ 413 \ 414 / \ 415>=_('> 416 \_/ 417 / 418}, 419q{ 420 2 421 1 1 422661745 423 111 424 3 425}, 426q{ 427 / 428 / \ 429<')_=< 430 \_/ 431 \ 432}, 433q{ 434 2 435 1 1 436547166 437 111 438 3 439}, 440q{ 441 ,\ 442>=('> 443 '/ 444}, 445q{ 446 12 44766745 448 13 449}, 450q{ 451 /, 452<')=< 453 \` 454}, 455q{ 456 21 45754766 458 31 459}, 460q{ 461 __ 462\/ o\ 463/\__/ 464}, 465q{ 466 11 46761 41 46861111 469}, 470q{ 471 __ 472/o \/ 473\__/\ 474}, 475q{ 476 11 47714 16 47811116 479}, 480); 481 482 # 1: body 483 # 2: dorsal fin 484 # 3: flippers 485 # 4: eye 486 # 5: mouth 487 # 6: tailfin 488 # 7: gills 489 490 my @colors = ('c','C','r','R','y','Y','b','B','g','G','m','M'); 491 my $fish_num = int(rand($#fish_image/2)); 492 my $fish_index = $fish_num * 2; 493 my $speed = rand(2) + .25; 494 my $depth = int(rand($depth{'fish_end'} - $depth{'fish_start'})) + $depth{'fish_start'}; 495 my $color_mask = $fish_image[$fish_index+1]; 496 $color_mask =~ s/4/W/gm; 497 $color_mask = rand_color($color_mask); 498 499 if($fish_num % 2) { 500 $speed *= -1; 501 } 502 my $fish_object = Term::Animation::Entity->new( 503 type => 'fish', 504 shape => $fish_image[$fish_index], 505 auto_trans => 1, 506 color => $color_mask, 507 position => [ 0, 0, $depth ], 508 callback => \&fish_callback, 509 callback_args => [ $speed, 0, 0 ], 510 die_offscreen => 1, 511 death_cb => \&add_fish, 512 physical => 1, 513 coll_handler => \&fish_collision, 514 ); 515 516 my $max_height = 9; 517 my $min_height = $anim->height() - $fish_object->{'HEIGHT'}; 518 $fish_object->{'Y'} = int(rand($min_height - $max_height)) + $max_height; 519 if($fish_num % 2) { 520 $fish_object->{'X'} = $anim->width()-2; 521 } else { 522 $fish_object->{'X'} = 1 - $fish_object->{'WIDTH'}; 523 } 524 $anim->add_entity($fish_object); 525} 526 527sub fish_callback { 528 my ($fish, $anim) = @_; 529 if(int(rand(100)) > 97) { 530 add_bubble($fish, $anim); 531 } 532 return $fish->move_entity($anim); 533} 534 535sub fish_collision { 536 my ($fish, $anim) = @_; 537 my $collisions = $fish->collisions(); 538 foreach my $col_obj (@{$collisions}) { 539 if($col_obj->type eq 'teeth') { 540 add_splat($anim, $col_obj->position()); 541 $fish->kill(); 542 last; 543 } elsif($col_obj->type eq 'hook_point') { 544 retract($col_obj); 545 retract($fish); 546 # get the hook and line 547 my $hook = $anim->get_entities_of_type('fishhook')->[0]; 548 my $line = $anim->get_entities_of_type('fishline')->[0]; 549 retract($anim->entity($hook)); 550 retract($anim->entity($line)); 551 last; 552 } 553 } 554} 555 556sub add_splat { 557 my ($anim, $x, $y, $z) = @_; 558 my @splat_image = ( 559q# 560 561 . 562 *** 563 ' 564 565#, 566q# 567 568 ",*;` 569 "*,** 570 *"'~' 571 572#, 573q# 574 , , 575 " ","' 576 *" *'" 577 " ; . 578 579#, 580q# 581* ' , ' ` 582' ` * . ' 583 ' `' ",' 584* ' " * . 585" * ', ' 586#, 587); 588 589 $anim->new_entity( 590 shape => \@splat_image, 591 position => [ $x - 4, $y - 2, $z-2 ], 592 default_color => 'RED', 593 callback_args => [ 0, 0, 0, .25 ], 594 transparent => ' ', 595 die_frame => 15, 596 ); 597} 598 599sub add_shark { 600 my ($old_ent, $anim) = @_; 601 my @shark_image = ( 602q# 603 __ 604 ( `\ 605 ,??????????????????????????) `\ 606;' `.????????????????????????( `\__ 607 ; `.?????????????__..---'' `~~~~-._ 608 `. `.____...--'' (b `--._ 609 > _.-' .(( ._ ) 610 .`.-`--...__ .-' -.___.....-(|/|/|/|/' 611 ;.'?????????`. ...----`.___.',,,_______......---' 612 '???????????'-' 613#, 614q# 615 __ 616 /' ) 617 /' (??????????????????????????, 618 __/' )????????????????????????.' `; 619 _.-~~~~' ``---..__?????????????.' ; 620 _.--' b) ``--...____.' .' 621( _. )). `-._ < 622 `\|\|\|\|)-.....___.- `-. __...--'-.'. 623 `---......_______,,,`.___.'----... .'?????????`.; 624 `-`???????????` 625#, 626 ); 627 628 629 my @shark_mask = ( 630q# 631 632 633 634 635 636 cR 637 638 cWWWWWWWW 639 640 641#, 642q# 643 644 645 646 647 648 Rc 649 650 WWWWWWWWc 651 652 653#, 654 ); 655 656 my $dir = int(rand(2)); 657 my $x = -53; 658 my $y = int(rand($anim->height() - (10 + 9))) + 9; 659 my $teeth_x = -9; 660 my $teeth_y = $y + 7; 661 my $speed = 2; 662 if($dir) { 663 $speed *= -1; 664 $x = $anim->width()-2; 665 $teeth_x = $x + 9; 666 } 667 668 $anim->new_entity( 669 type => 'teeth', 670 shape => "*", 671 position => [ $teeth_x, $teeth_y, $depth{'shark'}+1 ], 672 depth => $depth{'fish_end'} - $depth{'fish_start'}, 673 callback_args => [ $speed, 0, 0 ], 674 physical => 1, 675 ); 676 677 $anim->new_entity( 678 type => "shark", 679 color => $shark_mask[$dir], 680 shape => $shark_image[$dir], 681 auto_trans => 1, 682 position => [ $x, $y, $depth{'shark'} ], 683 default_color => 'WHITE', 684 callback_args => [ $speed, 0, 0 ], 685 die_offscreen => 1, 686 death_cb => sub { group_death(@_, 'teeth') }, 687 default_color => 'CYAN', 688 ); 689 690} 691 692# when a shark dies, kill the "teeth" too, the associated 693# entity that does the actual collision 694sub group_death { 695 my ($entity, $anim, @bound_types) = @_; 696 foreach my $type (@bound_types) { 697 my $bound_entities = $anim->get_entities_of_type($type); 698 foreach my $obj (@{$bound_entities}) { 699 $anim->del_entity($obj); 700 } 701 } 702 random_object($entity, $anim); 703} 704 705# pull the fishhook, line and whatever got caught back 706# to the surface 707sub retract { 708 my ($entity) = @_; 709 $entity->physical(0); 710 if($entity->type eq 'fish') { 711 my @pos = $entity->position(); 712 $pos[2] = $depth{'water_gap2'}; 713 $entity->position( @pos ); 714 $entity->callback( \&fishhook_cb ); 715 } else { 716 $entity->callback_args( 'hooked' ); 717 } 718} 719 720# move the fishhook 721sub fishhook_cb { 722 my ($entity, $anim) = @_; 723 724 my @pos = $entity->position; 725 726 # this means we hooked something, reel it in 727 if(defined($entity->callback_args())) { 728 $pos[1]--; 729 730 # otherwise, just lower until we reach 1/4 from the bottom 731 } else { 732 if( ( $pos[1] + $entity->height) < $anim->height * .75) { 733 $pos[1]++; 734 } 735 } 736 737 return @pos; 738} 739 740sub add_fishhook { 741 my ($old_ent, $anim) = @_; 742 743 my $hook_image = 744q{ 745 o 746 || 747 || 748/ \ || 749 \__// 750 `--' 751}; 752 753 my $point_image = 754q{ 755. 756 757\ 758 759}; 760 my $line_image = "|\n"x50 . " \n"x6; 761 762 my $x = 10 + ( int(rand($anim->width() - 20)) ); 763 my $y = -4; 764 my $point_x = $x + 1; 765 my $point_y = $y + 2; 766 767 $anim->new_entity( 768 type => 'fishline', 769 shape => $line_image, 770 position => [ $x + 7, $y - 50, $depth{'water_line1'} ], 771 auto_trans => 1, 772 callback_args => undef, 773 callback => \&fishhook_cb, 774 ); 775 776 $anim->new_entity( 777 type => 'fishhook', 778 shape => $hook_image, 779 trans_char => ' ', 780 position => [ $x, $y, $depth{'water_line1'} ], 781 auto_trans => 1, 782 die_offscreen => 1, 783 death_cb => sub { group_death(@_, 'teeth', 'fishline') }, 784 default_color => 'GREEN', 785 callback_args => undef, 786 callback => \&fishhook_cb, 787 ); 788 789 $anim->new_entity( 790 type => 'hook_point', 791 shape => $point_image, 792 position => [ $point_x, $point_y, $depth{'shark'}+1 ], 793 depth => $depth{'fish_end'} - $depth{'fish_start'}, 794 callback_args => undef, 795 physical => 1, 796 default_color => 'GREEN', 797 callback => \&fishhook_cb, 798 799 ); 800} 801 802sub add_ship { 803 my ($old_ent, $anim) = @_; 804 805 my @ship_image = ( 806q{ 807 | | | 808 )_) )_) )_) 809 )___))___))___)\ 810 )____)____)_____)\\\ 811_____|____|____|____\\\\\__ 812\ / 813}, 814q{ 815 | | | 816 (_( (_( (_( 817 /(___((___((___( 818 //(_____(____(____( 819__///____|____|____|_____ 820 \ / 821}); 822 823 my @ship_mask = ( 824q{ 825 y y y 826 827 w 828 ww 829yyyyyyyyyyyyyyyyyyyywwwyy 830y y 831}, 832q{ 833 y y y 834 835 w 836 ww 837yywwwyyyyyyyyyyyyyyyyyyyy 838 y y 839}); 840 841 my $dir = int(rand(2)); 842 my $x = -24; 843 my $speed = 1; 844 if($dir) { 845 $speed *= -1; 846 $x = $anim->width()-2; 847 } 848 849 $anim->new_entity( 850 color => $ship_mask[$dir], 851 shape => $ship_image[$dir], 852 auto_trans => 1, 853 position => [ $x, 0, $depth{'water_gap1'} ], 854 default_color => 'WHITE', 855 callback_args => [ $speed, 0, 0 ], 856 die_offscreen => 1, 857 death_cb => \&random_object, 858 ); 859} 860 861sub add_whale { 862 my ($old_ent, $anim) = @_; 863 my @whale_image = ( 864q{ 865 .-----: 866 .' `. 867,????/ (o) \ 868\`._/ ,__) 869}, 870q{ 871 :-----. 872 .' `. 873 / (o) \????, 874(__, \_.'/ 875}); 876 my @whale_mask = ( 877q{ 878 C C 879 CCCCCCC 880 C C C 881 BBBBBBB 882 BB BB 883B B BWB B 884BBBBB BBBB 885}, 886q{ 887 C C 888 CCCCCCC 889 C C C 890 BBBBBBB 891 BB BB 892 B BWB B B 893BBBB BBBBB 894} 895); 896 897 my @water_spout = ( 898q{ 899 900 901 : 902},q{ 903 904 : 905 : 906},q{ 907 . . 908 -:- 909 : 910},q{ 911 . . 912 .-:-. 913 : 914},q{ 915 . . 916'.-:-.` 917' : ' 918},q{ 919 920 .- -. 921; : ; 922},q{ 923 924 925; ; 926}); 927 928 929 my $dir = int(rand(2)); 930 my $x; 931 my $speed = 1; 932 my $spout_align; 933 my @whale_anim; 934 my @whale_anim_mask; 935 936 if($dir) { 937 $spout_align = 1; 938 $speed *= -1; 939 $x = $anim->width()-2; 940 } else { 941 $spout_align = 11; 942 $x = -18; 943 } 944 945 # no water spout 946 for (1..5) { 947 push(@whale_anim, "\n\n\n" . $whale_image[$dir]); 948 push(@whale_anim_mask, $whale_mask[$dir]); 949 } 950 951 # animate water spout 952 foreach my $spout_frame (@water_spout) { 953 my $whale_frame = $whale_image[$dir]; 954 my $aligned_spout_frame; 955 $aligned_spout_frame = join("\n" . ' 'x$spout_align, split("\n", $spout_frame)); 956 $whale_frame = $aligned_spout_frame . $whale_image[$dir]; 957 push(@whale_anim, $whale_frame); 958 push(@whale_anim_mask, $whale_mask[$dir]); 959 } 960 961 $anim->new_entity( 962 color => \@whale_anim_mask, 963 shape => \@whale_anim, 964 auto_trans => 1, 965 position => [ $x, 0, $depth{'water_gap2'} ], 966 default_color => 'WHITE', 967 callback_args => [ $speed, 0, 0, 1 ], 968 die_offscreen => 1, 969 death_cb => \&random_object, 970 ); 971 972} 973 974sub add_monster { 975 my ($old_ent, $anim) = @_; 976 my @monster_image = ( 977 [ 978q{ 979 ____ 980 __??????????????????????????????????????????/ o \ 981 / \????????_?????????????????????_???????/ ____ > 982 _??????| __ |?????/ \????????_????????/ \????| | 983 | \?????| || |????| |?????/ \?????| |???| | 984},q{ 985 ____ 986 __?????????/ o \ 987 _?????????????????????_???????/ \?????/ ____ > 988 _???????/ \????????_????????/ \????| __ |???| | 989 | \?????| |?????/ \?????| |???| || |???| | 990},q{ 991 ____ 992 __????????????????????/ o \ 993 _??????????????????????_???????/ \????????_???????/ ____ > 994| \??????????_????????/ \????| __ |?????/ \????| | 995 \ \???????/ \?????| |???| || |????| |???| | 996},q{ 997 ____ 998 __???????????????????????????????/ o \ 999 _??????????_???????/ \????????_??????????????????/ ____ > 1000 | \???????/ \????| __ |?????/ \????????_??????| | 1001 \ \?????| |???| || |????| |?????/ \????| | 1002} 1003 ],[ 1004q{ 1005 ____ 1006 / o \??????????????????????????????????????????__ 1007< ____ \???????_?????????????????????_????????/ \ 1008 | |????/ \????????_????????/ \?????| __ |??????_ 1009 | |???| |?????/ \?????| |????| || |?????/ | 1010},q{ 1011 ____ 1012 / o \?????????__ 1013< ____ \?????/ \???????_?????????????????????_ 1014 | |???| __ |????/ \????????_????????/ \???????_ 1015 | |???| || |???| |?????/ \?????| |?????/ | 1016},q{ 1017 ____ 1018 / o \????????????????????__ 1019< ____ \???????_????????/ \???????_??????????????????????_ 1020 | |????/ \?????| __ |????/ \????????_??????????/ | 1021 | |???| |????| || |???| |?????/ \???????/ / 1022},q{ 1023 ____ 1024 / o \???????????????????????????????__ 1025< ____ \??????????????????_????????/ \???????_??????????_ 1026 | |??????_????????/ \?????| __ |????/ \???????/ | 1027 | |????/ \?????| |????| || |???| |?????/ / 1028} 1029 ]); 1030 1031 my @monster_mask = ( 1032q{ 1033 1034 W 1035 1036 1037 1038},q{ 1039 1040 W 1041 1042 1043 1044}); 1045 my $dir = int(rand(2)); 1046 my $x; 1047 my $speed = 2; 1048 if($dir) { 1049 $speed *= -1; 1050 $x = $anim->width()-2; 1051 } else { 1052 $x = -64 1053 } 1054 my @monster_anim_mask; 1055 for(1..4) { push(@monster_anim_mask, $monster_mask[$dir]); } 1056 1057 $anim->new_entity( 1058 shape => $monster_image[$dir], 1059 auto_trans => 1, 1060 color => \@monster_anim_mask, 1061 position => [ $x, 2, $depth{'water_gap2'} ], 1062 callback_args => [ $speed, 0, 0, .25 ], 1063 death_cb => \&random_object, 1064 die_offscreen => 1, 1065 default_color => 'GREEN', 1066 ); 1067} 1068 1069sub add_big_fish { 1070 my ($old_ent, $anim) = @_; 1071 1072 my @big_fish_image = ( 1073q{ 1074 ______ 1075`""-. `````-----.....__ 1076 `. . . `-. 1077 : . . `. 1078 , : . . _ : 1079: `. : (@) `._ 1080 `. `..' . =`-. .__) 1081 ; . = ~ : .-" 1082 .' .'`. . . =.-' `._ .' 1083: .' : . .' 1084 ' .' . . . .-' 1085 .'____....----''.'=.' 1086 "" .'.' 1087 ''"'` 1088},q{ 1089 ______ 1090 __.....-----''''' .-""' 1091 .-' . . .' 1092 .' . . : 1093 : _ . . : , 1094 _.' (@) : .' : 1095(__. .-'= . `..' .' 1096 "-. : ~ = . ; 1097 `. _.' `-.= . . .'`. `. 1098 `. . : `. : 1099 `-. . . . `. ` 1100 `.=`.``----....____`. 1101 `.`. "" 1102 '`"`` 1103}); 1104 1105 my @big_fish_mask = ( 1106q{ 1107 111111 110811111 11111111111111111 1109 11 2 2 111 1110 1 2 2 11 1111 1 1 2 2 1 1 11121 11 1 1W1 111 1113 11 1111 2 1111 1111 1114 1 2 1 1 1 111 1115 11 1111 2 2 1111 111 11 11161 11 1 2 11 1117 1 11 2 2 2 111 1118 111111111111111111111 1119 11 1111 1120 11111 1121},q{ 1122 111111 1123 11111111111111111 11111 1124 111 2 2 11 1125 11 2 2 1 1126 1 1 2 2 1 1 1127 111 1W1 1 11 1 11281111 1111 2 1111 11 1129 111 1 1 1 2 1 1130 11 111 1111 2 2 1111 11 1131 11 2 1 11 1 1132 111 2 2 2 11 1 1133 111111111111111111111 1134 1111 11 1135 11111 1136}); 1137 1138 1139 my $dir = int(rand(2)); 1140 my $x; 1141 my $speed = 3; 1142 if($dir) { 1143 $x = $anim->width()-1; 1144 $speed *= -1; 1145 } else { 1146 $x = -34; 1147 } 1148 my $max_height = 9; 1149 my $min_height = $anim->height() - 15; 1150 my $y = int(rand($min_height - $max_height)) + $max_height; 1151 my $color_mask = rand_color($big_fish_mask[$dir]); 1152 $anim->new_entity( 1153 shape => $big_fish_image[$dir], 1154 auto_trans => 1, 1155 color => $color_mask, 1156 position => [ $x, $y, $depth{'shark'} ], 1157 callback_args => [ $speed, 0, 0 ], 1158 death_cb => \&random_object, 1159 die_offscreen => 1, 1160 default_color => 'YELLOW', 1161 ); 1162 1163} 1164 1165sub add_ducks { 1166 my ($old_ent, $anim) = @_; 1167 my @duck_image = ( 1168 [ 1169q{ 1170 _??????????_??????????_ 1171,____(')=??,____(')=??,____(')< 1172 \~~= ')????\~~= ')????\~~= ') 1173},q{ 1174 _??????????_??????????_ 1175,____(')=??,____(')<??,____(')= 1176 \~~= ')????\~~= ')????\~~= ') 1177},q{ 1178 _??????????_??????????_ 1179,____(')<??,____(')=??,____(')= 1180 \~~= ')????\~~= ')????\~~= ') 1181} 1182 ],[ 1183q{ 1184 _??????????_??????????_ 1185>(')____,??=(')____,??=(')____, 1186 (` =~~/????(` =~~/????(` =~~/ 1187},q{ 1188 _??????????_??????????_ 1189=(')____,??>(')____,??=(')____, 1190 (` =~~/????(` =~~/????(` =~~/ 1191},q{ 1192 _??????????_??????????_ 1193=(')____,??=(')____,??>(')____, 1194 (` =~~/????(` =~~/????(` =~~/ 1195} 1196 ] 1197 ); 1198 1199 my @duck_mask = ( 1200q{ 1201 g g g 1202wwwwwgcgy wwwwwgcgy wwwwwgcgy 1203 wwww Ww wwww Ww wwww Ww 1204},q{ 1205 g g g 1206ygcgwwwww ygcgwwwww ygcgwwwww 1207 wW wwww wW wwww wW wwww 1208}); 1209 1210 my $dir = int(rand(2)); 1211 my $x; 1212 my $speed = 1; 1213 if($dir) { 1214 $speed *= -1; 1215 $x = $anim->width()-2; 1216 } else { 1217 $x = -30 1218 } 1219 1220 $anim->new_entity( 1221 shape => $duck_image[$dir], 1222 auto_trans => 1, 1223 color => $duck_mask[$dir], 1224 position => [ $x, 5, $depth{'water_gap3'} ], 1225 callback_args => [ $speed, 0, 0, .25 ], 1226 death_cb => \&random_object, 1227 die_offscreen => 1, 1228 default_color => 'WHITE', 1229 ); 1230} 1231 1232sub add_dolphins { 1233 my ($old_ent, $anim) = @_; 1234 my @dolphin_image = ( 1235 [ 1236q{ 1237 , 1238 __)\_ 1239(\_.-' a`-. 1240(/~~````(/~^^` 1241},q{ 1242 , 1243(\__ __)\_ 1244(/~.'' a`-. 1245 ````\)~^^` 1246} 1247 ],[ 1248q{ 1249 , 1250 _/(__ 1251.-'a `-._/) 1252'^^~\)''''~~\) 1253},q{ 1254 , 1255 _/(__ __/) 1256.-'a ``.~\) 1257'^^~(/'''' 1258} 1259 ] 1260 ); 1261 1262 1263 my @dolphin_mask = ( 1264q{ 1265 1266 1267 W 1268},q{ 1269 1270 1271 W 1272}); 1273 1274 1275 my $dir = int(rand(2)); 1276 1277 my $x; 1278 my $speed = 1; 1279 my $distance = 15; # how far apart the dolphins are 1280 1281 # right to left 1282 if($dir) { 1283 $speed *= -1; 1284 $distance *= -1; 1285 $x = $anim->width()-2; 1286 1287 # left to right 1288 } else { 1289 $x = -13 1290 } 1291 1292 my $up = [$speed,-.5,0,.5]; 1293 my $down = [$speed,.5,0,.5]; 1294 my $glide = [$speed,0,0,.5]; 1295 1296 my @path; 1297 1298 for(1..14) { push(@path, $up); } 1299 for(1..2) { push(@path, $glide); } 1300 for(1..14) { push(@path, $down); } 1301 for(1..6) { push(@path, $glide); } 1302 1303 my $dolphin3 = $anim->new_entity( 1304 shape => $dolphin_image[$dir], 1305 auto_trans => 1, 1306 color => $dolphin_mask[$dir], 1307 position => [ $x - ($distance * 2), 8, $depth{'water_gap3'} ], 1308 callback_args => [ 0, [@path] ], 1309 death_cb => \&random_object, 1310 die_offscreen => 0, 1311 default_color => 'blue', 1312 ); 1313 1314 my $dolphin2 = $anim->new_entity( 1315 shape => $dolphin_image[$dir], 1316 auto_trans => 1, 1317 color => $dolphin_mask[$dir], 1318 position => [ $x - $distance, 2, $depth{'water_gap3'} ], 1319 callback_args => [ 12, [@path] ], 1320 die_offscreen => 0, 1321 default_color => 'BLUE', 1322 ); 1323 1324 my $dolphin1 = $anim->new_entity( 1325 shape => $dolphin_image[$dir], 1326 auto_trans => 1, 1327 color => $dolphin_mask[$dir], 1328 position => [ $x, 5, $depth{'water_gap3'} ], 1329 callback_args => [ 24, [@path] ], 1330 # have the lead dolphin tell the others to die offscreen, since they start offscreen 1331 death_cb => sub{ $dolphin2->die_offscreen(1); $dolphin3->die_offscreen(1) }, 1332 die_offscreen => 1, 1333 default_color => 'CYAN', 1334 ); 1335 1336} 1337 1338sub add_swan { 1339 my ($old_ent, $anim) = @_; 1340 my @swan_image = ( 1341 [ 1342q{ 1343 ___ 1344,_ / _,\ 1345| \ \( \| 1346| \_ \\\ 1347(_ \_) \ 1348(\_ ` \ 1349 \ -=~ / 1350} 1351 ],[ 1352q{ 1353 ___ 1354/,_ \ _, 1355|/ )/ / | 1356 // _/ | 1357 / ( / _) 1358/ ` _/) 1359\ ~=- / 1360} 1361 ] 1362 ); 1363 1364 my @swan_mask = ( 1365q{ 1366 1367 g 1368 yy 1369},q{ 1370 1371 g 1372yy 1373}); 1374 1375 my $dir = int(rand(2)); 1376 my $x; 1377 my $speed = 1; 1378 if($dir) { 1379 $speed *= -1; 1380 $x = $anim->width()-2; 1381 } else { 1382 $x = -10 1383 } 1384 1385 $anim->new_entity( 1386 shape => $swan_image[$dir], 1387 auto_trans => 1, 1388 color => $swan_mask[$dir], 1389 position => [ $x, 1, $depth{'water_gap3'} ], 1390 callback_args => [ $speed, 0, 0, .25 ], 1391 death_cb => \&random_object, 1392 die_offscreen => 1, 1393 default_color => 'WHITE', 1394 ); 1395} 1396 1397sub init_random_objects { 1398 return ( 1399 \&add_ship, 1400 \&add_whale, 1401 \&add_monster, 1402 \&add_big_fish, 1403 \&add_shark, 1404 \&add_fishhook, 1405 \&add_swan, 1406 \&add_ducks, 1407 \&add_dolphins, 1408 ); 1409} 1410 1411# add one of the random objects to the screen 1412sub random_object { 1413 my ($dead_object, $anim) = @_; 1414 my $sub = int(rand(scalar(@random_objects))); 1415 $random_objects[$sub]->($dead_object, $anim); 1416} 1417 1418sub dprint { 1419 open(D, ">>", "debug"); 1420 print D @_, "\n"; 1421 close(D); 1422} 1423 1424sub sighandler { 1425 my ($sig) = @_; 1426 if($sig eq 'INT') { quit(); } 1427 elsif($sig eq 'WINCH') { 1428 # ignore SIGWINCH, only redraw when requested 1429 } 1430 else { quit("Exiting with SIG$sig"); } 1431} 1432 1433sub quit { 1434 my ($mesg) = @_; 1435 print STDERR $mesg, "\n" if(defined($mesg)); 1436 exit; 1437} 1438 1439 1440sub initialize { 1441 # this may be paranoid, but i don't want to leave 1442 # the user's terminal in a state that they might not 1443 # know how to fix if we die badly 1444 foreach my $sig (keys %SIG) { 1445 $SIG{$sig} = 'sighandler' unless(defined($SIG{$sig})); 1446 } 1447} 1448 1449 1450sub center { 1451 my ($width, $mesg) = @_; 1452 my $l = length($mesg); 1453 if($l < $width) { 1454 return ' 'x(int(($width - length($mesg))/2)) . $mesg; 1455 } 1456 elsif($l > $width) { 1457 return(substr($mesg, 0, ($width - ($l + 3))) . "..."); 1458 } 1459 else { 1460 return $mesg; 1461 } 1462} 1463 1464sub rand_color { 1465 my ($color_mask) = @_; 1466 my @colors = ('c','C','r','R','y','Y','b','B','g','G','m','M'); 1467 foreach my $i (1..9) { 1468 my $color = $colors[int(rand($#colors))]; 1469 $color_mask =~ s/$i/$color/gm; 1470 } 1471 return $color_mask; 1472} 1473