ascii.zp

(module "ascii"
  (export
    (list "cowsay" cowsay)
    (list "standard-fish" standard-fish)
    (list "non-standard-fish" non-standard-fish)
    (list "smiley" smiley))

  (cow-interpolate-fill (lambda (l what)
    (if (< l 30)
        (cow-interpolate-fill (add1 l) (string:append what " "))
        what)))

  (cow-good-substring (lambda (what)
    (let ((l (sub1 (string:length what)))
          (x (string:last what)))
      (if (> (string:find what #\space) -1)
        (if (char=? x #\space)
          what
          (cow-good-substring (substring what 0 l)))
        what))))

  (cow-interpolate (lambda (what)
    (let* ((x (cow-good-substring (substring what 0 30)))
           (l (string:length what))
           (xl (string:length x)))
      (if (> l  30)
        (++ "|   " (cow-interpolate-fill xl x) "   |\n" (cow-interpolate (substring what xl l)))
        (++ "|   " (cow-interpolate-fill l what) "   |\n")))))

  (cowsay (lambda (what)
    (begin
      (display " ___________________________________\n")
      (display "/                                   \\\n")
      (display (cow-interpolate (string:substitute what "\n" " ")))
      (display "\\                                   /\n")
      (display " -----------------------------------\n")
      (display "     \\   ^__^\n")
      (display "      \\  (oo)\\_______\n")
      (display "         (__)\\       )\\/\\\n")
      (display "             ||----w |\n")
      (display "             ||     ||"))))

  (smiley (lambda ()
    (begin
      (display "    .-'\"\"\"\"\"'-.\n")
      (display "  .'           `.\n")
      (display " /   o      o    \\\n")
      (display ":                 :\n")
      (display "|                 |\n")
      (display ":   \\        /    :\n")
      (display " \\   `.____.'    /\n")
      (display "  `.           .'\n")
      (display "    `-._____.-'"))))

  (left-fish (lambda ()
    (begin
      (display " _J\"\"-.\n")
      (display "/o )   \\ ,';\n")
      (display "\\ ,'    ;  /\n")
      (display " \"-.__.'\"\\_;"))))

  (right-fish (lambda ()
    (begin
      (display "     .-\"\"L_\n")
      (display ";`, /   ( o\\\n")
      (display "\\  ;    `, \/\n")
      (display ";_/\"`.__.-\""))))

  (fish-bubbles (lambda ()
    (begin
      (display "              o O\n")
      (display "     .-\"\"L_ O  o\n")
      (display ";`, /   ( o\\  o\n")
      (display "\\  ;    `, \/\n")
      (display ";_/\"`.__.-\""))))

  (standard-fish (lambda direction
    (cond ((or (null? direction) (eq? (car direction) :left)) (left-fish))
          ((eq? (car direction) :right) (right-fish))
          ((eq? (car direction) :bubbles) (fish-bubbles))
          (else (display (list "Unrecognized option: " direction))))))

  (non-standard-fish (lambda ()
    "The goose was found on http://www.retrojunkie.com/asciiart/animals/ducks.htm"
    (begin
      (display "                        __\n")
      (display "                      /` ,\\__\n")
      (display "                     |    ).-'\n")
      (display "                    / .--'\n")
      (display "                   / /\n")
      (display "     ,      _.==''`  \\\n")
      (display "   .'(  _.='         |\n")
      (display "  {   ``  _.='       |\n")
      (display "   {    \\`     ;    /\n")
      (display "    `.   `'=..'  .='\n")
      (display "      `=._    .='\n")
      (display "   jgs  '-`\\\\`__\n")
      (display "            `-._{\n")))))