home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / discus_admin_1357211388 / source / webtags2.pl < prev   
Text File  |  2009-11-06  |  4KB  |  97 lines
  1. # FILE: webtags2.pl
  2. # DESCRIPTION: Special definitions for Discus formatting tags
  3. #-------------------------------------------------------------------------------
  4. # DISCUS COPYRIGHT NOTICE
  5. #
  6. # Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
  7. # The use of Discus is governed by the Discus License Agreement which is
  8. # available from the Discus WWW site at:
  9. #    http://www.discusware.com/discus/license
  10. #
  11. # Pursuant to the Discus License Agreement, this copyright notice may not be
  12. # removed or altered in any way.
  13. #-------------------------------------------------------------------------------
  14.  
  15. use strict;
  16. use vars qw($GLOBAL_OPTIONS $PARAMS $DCONF);
  17.  
  18. ### ////////////////////////////////////////////////////////////////////////////
  19. ### DEMONSTRATION OF HOW TO WRITE FUNCTIONS
  20. ### ////////////////////////////////////////////////////////////////////////////
  21.  
  22. ###
  23. ### pig_latin
  24. ###
  25. ### Takes incoming text and roughly translates it to Pig Latin.
  26. ###
  27.  
  28. sub pig_latin {
  29.     my ($text_in) = @_;                                # This subroutine takes one argument
  30.     my $text_out = "";                                # Initialize output string
  31.     while ($text_in =~ /(^|[\s>,\.:;])([a-zA-Z]+)([\s\.,<!\?:;!]|$)/) { # Iterate over all words while avoiding HTML codes
  32.         my ($before, $space, $word, $space2, $after) = ($`, $1, $2, $3, $');    # Save matches
  33.         $text_out .= join("", $before, $space);        # Avoid converting these to pig latin
  34.         if ($word =~ /^([a-z])$/i) {                # Single-letter word
  35.             $text_out .= join("", $word, "ay");        # Just add -ay
  36.         } elsif ($word =~ /^[AEIOUY]/i) {            # Word starting with vowel
  37.             $text_out .= join("", $word, "ay");        # Just add -ay to word
  38.         } elsif ($word =~ /^([a-z])/) {                # Non-capitalized word
  39.             $text_out .= join("", $', join("", $1, "ay"));    # Pig latin for consonant
  40.         } elsif ($word =~ /^([A-Z])/) {                # Capitalized word
  41.             $text_out .= join("", "\u$'", join("", "\l$1", "ay"));    # Pig latin for capitalized consonant
  42.         } else {                                    # Other catch-all
  43.             $text_out .= $word;
  44.         }
  45.         $text_out .= $space2;
  46.         $text_in = $after;                            # Loops ahead
  47.     }
  48.     $text_out .= $text_in;                            # Add remaining text at end
  49.     return $text_out;                                # Return converted pig latin string
  50. }
  51.  
  52. ###
  53. ### word_find
  54. ###
  55. ### An example of how to interface to a Perl module.  You need the Games::WordFind
  56. ### module in order to use this tag (you can find this module, and others, at your
  57. ### CPAN mirror; for this module: http://www.cpan.org/modules/by-module/Games/)
  58. ###
  59.  
  60. sub word_find {
  61.     my @list = split(/,/, $_[0]);                                # Word list from input
  62.     @list = map { s/[^a-z]//gi; tr/a-z/A-Z/; trim($_) } @list;    # Clean up the list
  63.     @list = grep { /\S/ } @list;                                # Remove empty words
  64.     
  65.     # From the documentation of Games::WordFind, in "eval" in case you don't have
  66.     # the module installed
  67.     
  68.     my $puz_html = eval "
  69.         use Games::WordFind;
  70.         my \$puz = Games::WordFind->new({cols=>10, intersect=>1});
  71.         \$puz->create_puzzle(\@list);
  72.         \$puz->get_html({solution => 0, wrapper => 0});
  73.     ";
  74.     
  75.     # Some conversions to make posts more suitable for being within messages
  76.     # rather than on a page by themselves
  77.     
  78.     $puz_html =~ s%<font size=\+5>%%gi;
  79.     $puz_html =~ s&<hr width="50%">&<hr width="50%" align=center>&gi;
  80.     $puz_html =~ s%<H1 align=center>(.*?)</H1>%<h3 align=center>$1</h3>%gi;
  81.     
  82.     # And, add the missing </center> tag
  83.     
  84.     $puz_html .= "</center>";
  85.     
  86.     # Return wordsearch
  87.     
  88.     return $puz_html;
  89. }
  90.  
  91. ### ////////////////////////////////////////////////////////////////////////////
  92. ### PUT YOUR OWN SUBROUTINES HERE
  93. ### ////////////////////////////////////////////////////////////////////////////
  94.  
  95.  
  96. 1;
  97.