home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / hugs101.zip / hugs101sc.zip / hugsdist / demos / say.hs < prev    next >
Text File  |  1995-02-14  |  5KB  |  103 lines
  1. ------------------------------------------------------------------------------
  2. -- A simple banner program:                             Mark P Jones, 1992
  3. --
  4. -- Many years ago, I was helping out on a stand at a computer show.
  5. -- Or at least, I would have been if anyone had been interested in
  6. -- what we had on the stand.  So instead, I sat down to see if I
  7. -- could write a banner program -- something to print messages out
  8. -- in large letters.
  9. --
  10. -- The original program was in Basic, but here is a version in Hugs.
  11. -- The program itself is only two lines long and that is rather pleasing,
  12. -- but the raw data for the letters (and the function mapping characters
  13. -- to letters) take up rather more space.  I don't have that Basic version
  14. -- anymore.  I wonder whether the complete Hugs code is that much shorter?
  15. --
  16. -- One of the nice things about this program is that the main program is
  17. -- completely independent of the size of characters.  You could easily add
  18. -- a new font, perhaps with higher resolution (bigger letters), or even
  19. -- variable width characters, and the program would take it all in its
  20. -- stride.
  21. --
  22. -- If you have a wide screen (>80 cols), you might like to try evaluating:
  23. --
  24. --               (concat . map say . lines . say) "Hi"
  25. --
  26. -- and contemplating how easy it might have been to get my original
  27. -- Basic version to perform this trick...
  28. --
  29. -- Enjoy!
  30. ------------------------------------------------------------------------------
  31.  
  32. say   = ('\n':) . unlines . map join . transpose . map picChar
  33.         where join  = foldr1 (\xs ys -> xs ++ "  " ++ ys)
  34.  
  35. -- mapping characters to letters: --------------------------------------------
  36.  
  37. picChar c  | isUpper c  = alphas !! (ord c - ord 'A')
  38.            | isLower c  = alphas !! (ord c - ord 'a')
  39.            | isSpace c  = blank
  40.            | isDigit c  = digits !! (ord c - ord '0')
  41.            | c=='/'     = slant
  42.            | c=='\\'    = reverse slant
  43.            | otherwise  = head ([ letter | (c',letter) <- punct, c'==c ]
  44.                                 ++ [nothing])
  45.  
  46. -- letters data: -------------------------------------------------------------
  47.  
  48. blank  =  ["     ", "     ", "     ", "     ", "     "]
  49.  
  50. slant  =  ["    ",  "   ",   "  ",    " ",     ""     ]
  51.  
  52. nothing=  repeat ""
  53.  
  54. punct  =  [('.',  ["     ", "     ", "     ", "  .. ", "  .. "]),
  55.            ('?',  [" ??? ", "?   ?", "   ? ", "  ?  ", "  .  "]),
  56.            ('!',  ["  !  ", "  !  ", "  !  ", "  !  ", "  .  "]),
  57.            ('-',  ["     ", "     ", "-----", "     ", "     "]),
  58.            ('+',  ["  +  ", "  +  ", "+++++", "  +  ", "  +  "]),
  59.            (':',  ["     ", "  :: ", "     ", "  :: ", "     "]),
  60.            (';',  ["     ", "  ;; ", "     ", "  ;; ", " ;;  "])
  61.           ]
  62.  
  63. digits = [[" OOO ", "0  00", "0 0 0", "00  0", " 000 "],
  64.           ["  1  ", " 11  ", "  1  ", "  1  ", "11111"],
  65.           [" 222 ", "2   2", "   2 ", "  2  ", "22222"],
  66.           ["3333 ", "    3", " 333 ", "    3", "3333 "],
  67.           ["   4 ", "  44 ", " 4 4 ", "44444", "   4 "],
  68.           ["55555", "5    ", "5555 ", "    5", "5555 "],
  69.           ["   66", "  6  ", " 666 ", "6   6", " 666 "],
  70.           ["77777", "    7", "   7 ", "   7 ", "  7  "],
  71.           [" 888 ", "8   8", " 888 ", "8   8", " 888 "],
  72.           [" 999 ", "9   9", " 999 ", "  9  ", "99   "]]
  73.  
  74. alphas = [["  A  ", " A A ", "AAAAA", "A   A", "A   A"],
  75.           ["BBBB ", "B   B", "BBBB ", "B   B", "BBBB "],
  76.           [" CCCC", "C    ", "C    ", "C    ", " CCCC"],
  77.           ["DDDD ", "D   D", "D   D", "D   D", "DDDD "],
  78.           ["EEEEE", "E    ", "EEEEE", "E    ", "EEEEE"],
  79.           ["FFFFF", "F    ", "FFFF ", "F    ", "F    "],
  80.           [" GGGG", "G    ", "G  GG", "G   G", " GGG "],
  81.           ["H   H", "H   H", "HHHHH", "H   H", "H   H"],
  82.           ["IIIII", "  I  ", "  I  ", "  I  ", "IIIII"],
  83.           ["JJJJJ", "   J ", "   J ", "J  J ", " JJ  "],
  84.           ["K   K", "K  K ", "KKK  ", "K  K ", "K   K"],
  85.           ["L    ", "L    ", "L    ", "L    ", "LLLLL"],
  86.           ["M   M", "MM MM", "M M M", "M   M", "M   M"],
  87.           ["N   N", "NN  N", "N N N", "N  NN", "N   N"],
  88.           [" OOO ", "O   O", "O   O", "O   O", " OOO "],
  89.           ["PPPP ", "P   P", "PPPP ", "P    ", "P    "],
  90.           [" QQQ ", "Q   Q", "Q Q Q", "Q  Q ", " QQ Q"],
  91.           ["RRRR ", "R   R", "RRRR ", "R  R ", "R   R"],
  92.           [" SSSS", "S    ", " SSS ", "    S", "SSSS "],
  93.           ["TTTTT", "  T  ", "  T  ", "  T  ", "  T  "],
  94.           ["U   U", "U   U", "U   U", "U   U", " UUU "],
  95.           ["V   V", "V   V", "V   V", " V V ", "  V  "],
  96.           ["W   W", "W   W", "W   W", "W W W", " W W "],
  97.           ["X   X", " X X ", "  X  ", " X X ", "X   X"],
  98.           ["Y   Y", " Y Y ", "  Y  ", "  Y  ", "  Y  "],
  99.           ["ZZZZZ", "   Z ", "  Z  ", " Z   ", "ZZZZZ"]
  100.          ]
  101.  
  102. -- end of banner program -----------------------------------------------------
  103.