asciiquarium 27 KB

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