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