tigersay/tigersay.tig

/* ##  Tigersay  ##

   Implementation of cowsay in the Tiger programming language.
   Does not come as a binary, nor with a Tiger compiler.
   Compilation is left as an exercise for the reader.

   ## License ##

   <jonjmaa@gmail.com> wrote this program. As long as you retain this notice you
   can do whatever you want with this stuff. If we meet some day, and you think
   this stuff is worth it, you can buy me a beer in return.

   - Jon Michael Aanes

*/

let
    /*************/
    /* Constants */

    var false := 0
    var true  := 1

    var INDENT   := "        "
    var MAXWIDTH := 40

    var VERSION  := "1.1.0 (02/12/2017)"

    /* The cow is unused, and taken directly from the cowsay program. */
    var COW := "\
\\\   ^__^                 \n\
\ \\  (oo)\\_______        \n\
\    (__)\\       )\\/\\   \n\
\        ||----w |         \n\
\        ||     ||"


    /* The tiger is taken from http://www.ascii-art.de/ascii/t/tiger.txt */
    var TIGER := "\
\\\                        __,,,,_                    \n\
\ \\        _ __..-;''`--/'/ /.',-`-.                 \n\
\  \\   (`/' ` |  \\ \\ \\\\ / / / / .-'/`,_              \n\
\     /'`\\ \\   |  \\ | \\| // // / -.,/_,'-,           \n\
\    /<7' ;  \\ \\  | ; ||/ /| | \\/    |`-/,/-.,_,/')  \n\
\   /  _.-, `,-\\,__|  _-| / \\ \\/|_/  |    '-/.;.\\'   \n\
\   `-`  f/ ;      / __/ \\__ `/ |__/ |               \n\
\        `-'      |  -| =|\\_  \\  |-' |               \n\
\              __/   /_..-' `  ),'  //               \n\
\             ((__.-'((___..-'' \\__.'                "

    var VERSION_STRING := concat("I am Tigersay, version ",concat(VERSION,"."))
    var HELP_STRING := concat("I am Tigersay, version ",concat(VERSION,". Fear my claws and dopy face. I was made by Jon Michael Aanes (aanes.xyz). I do not like command-line options. Instead, please feed me by pipe."))

    var ASLAN_QUOTE := "Laugh and fear not, creatures. Now that you are no longer dumb and witless, you need not always be grave. For jokes as well as justice come in with speech.        -- Aslan, The Chronicles of Narnia"

    /***********/
    /* Utility */

    /* I/O */

    function getinput () : string =
      let var l := "" /* Full output  */
          var c := "" /* Current char */
      in while true do
            ( c := getchar()
            ; if c = "" then  break     /* Hit EOF */
            ; l := concat(l, c) )
         ; l
      end

    /* Number / Maths */

    function min (a:int, b:int) : int =
      if a < b then a else b

    function max (a:int, b:int) : int =
      if a > b then a else b

    function modulo (num : int, mod : int) : int =
      ( while num >= mod do
              num := num - mod
      ; num )

    function exp (exponee : int, exponent : int) : int =
      if exponent = 0 then  1
                      else  exponee * exp(exponee, exponent - 1)

    function get_digit (num : int, digit : int) : int =
      modulo(num / exp(10, digit-1), 10)

    function log10 (num : int) : int =
      let var log10 := 1
      in while num > 9 do
           ( num := num/10
           ; log10 := log10 + 1 )
       ; log10
      end


    /* String manipulation */

    function concat3 (a:string, b:string, c:string) : string =
      concat(a, concat(b, c))

    function concat4 (a:string, b:string, c:string, d:string) : string =
      concat(a, concat(b, concat(c, d)))

    function indent_string (text : string, before : string, after:string) : string =
      let var out := before
          var char := ""
      in for i := 0 to size(text) - 1 do
           ( char := substring (text, i, 1)
           ; out := concat(out, if char <> "\n"
                                then char
                                else concat3(after, char, before)));
         concat(out, after)
      end

    function is_whitespace (char:string) : int =
      (char = "" | char = "\n" | char = " " | char = "\t")

    function substring_absolute (text:string, i1:int, i2:int) : string =
      /* Uses absolute coordinates to determine substring */
      if i2 < i1 then  ""
                 else  substring(text, i1, i2 - i1 + 1)

    function count_substring_occurances (text:string, char:string) : int =
      let var count := 0
          var charwidth := size(char)
      in for i := 0 to size(text) - charwidth do
           if substring(text, i, charwidth) = char then
               count := count + 1
       ; count
      end

    function strip (text:string) : string =
      let var start_i := -1
          var stop_i  := 0
          var char    := ""
      in for i := 0 to size(text) - 1 do
          ( char := substring(text, i, 1)
          ; if not(is_whitespace(char)) & start_i = -1 then
                start_i := i
          ; if not(is_whitespace(char)) then
                stop_i  := i )
        ; if start_i = -1
          then ""
          else substring_absolute(text, start_i, stop_i)
      end

    function repeat_string (str:string, rep:int) : string =
      let var out := ""
      in for i := 1 to rep do
            out := concat(out, str)
       ; out
      end

    function digit_to_s (n:int) :string =
      if 0 <= n & n <= 9
      then chr(48 + n)
      else "?"

    function int_to_s (num : int) : string =
      let var l := ""
      in for i := 1 to log10(num) do
           l := concat(digit_to_s(get_digit(num, i)), l)
       ; l
      end

    function length_of_longest_line (text:string) : int =
      let var longest := 0
          var current := 0
      in for i := 0 to size(text) - 1 do
           if substring(text, i, 1) = "\n"
           then ( longest := max(longest, current)
                ; current := 0)
           else current := current + 1
       ; max(longest, current)
      end


    /* Linked Lists */

    type stringll = { val: string, next: stringll }

    function ll_new () : stringll =
      stringll { val = "", next = nil }

    function ll_append (ll:stringll, str:string) =
      if ll.next = nil
      then  ll.next := stringll { val = str, next = nil }
      else  ll_append(ll.next, str)

    function ll_to_s (ll:stringll) : string =
      if ll <> nil
      then concat(ll.val, ll_to_s(ll.next))
      else ""

    function ll_length (ll:stringll) : int =
      if ll = nil
      then  0
      else  1 + ll_length(ll.next)

    /* String operations using linked lists */

    function split_words (text:string) : stringll =
      let var out := ll_new()
          var prev_word_start_i := 0
          var char := ""
      in for i := 0 to size(text) - 1 do
          ( char := substring(text, i, 1)
          ; if is_whitespace(char) & prev_word_start_i <> -1
            then ll_append(out, substring_absolute(text, prev_word_start_i, i - 1))
            else if not(is_whitespace(char)) & prev_word_start_i = -1
            then prev_word_start_i := i
          ; if is_whitespace(char) then  prev_word_start_i := -1
          )
        ; ll_append(out, substring_absolute(text, prev_word_start_i, size(text) - 1))
        ; out
      end

    function insert_whitespace_between_words (words : stringll, linewidth:int) : stringll =
      let function help (words:stringll, width:int) : stringll =
          if words = nil
          then  nil
          else
              if width + size(words.val) > linewidth
              then stringll { val = "\n", next = stringll { val = words.val, next = help(words.next, size(words.val)) } }
              else stringll { val = " ",  next = stringll { val = words.val, next = help(words.next, size(words.val) + width ) } }
      in help(words, 0)
      end

    function wrap_string (text:string, linewidth: int) : string =
      let var words := split_words(text)
          var splitstr := insert_whitespace_between_words(words, linewidth)
      in
        ll_to_s( if ll_length(splitstr) > 2
                 then splitstr.next.next.next
                 else splitstr )
      end

    /* Fun stuff */

    type map = { key: string, value: string, next: map }
    type string_option = { some: string }

    function map_lookup ( map : map, key : string ) : string_option =
      ( while map <> nil & key <> map.key do
            map := map.next
      ; if map = nil then  nil
                     else  string_option { some = map.value } )

    var REACTIONS :=
      map { key = "",        value = "Quiet type. Has the cat got your tongue?",    next =
      map { key = "aslan",   value = ASLAN_QUOTE,    next =
      map { key = "Aslan",   value = ASLAN_QUOTE,    next =
      map { key = "version", value = VERSION_STRING, next =
      map { key = "help",    value = HELP_STRING,    next =

      nil }}}}}

    function is_moo (input : string) : string_option =
      if size(input) <> 0
       & (substring(input, 0, 1) = "M" | substring(input, 0, 1) = "m")
       & count_substring_occurances(input, "o") = size(input) - 1 then
           string_option {
               some = concat( if "m" = substring(input, 0, 1) then "g" else "G"
                            , repeat_string("r", count_substring_occurances(input, "o"))) }
      else
         nil

    function get_reaction_or_text (input: string): string =
      let var maybe_string := map_lookup(REACTIONS, input)
          var maybe_moo    := is_moo(input)
      in if maybe_string <> nil
         then maybe_string.some
         else if maybe_moo <> nil
              then maybe_moo.some
              else input
      end

    /**************/
    /* Draw stuff */

    function draw_textbubble (text:string) =
      let
          var textwidth    := length_of_longest_line(text)
          var textheight   := count_substring_occurances(text, "\n") + 1
          var bubblewidth  := textwidth + 4
          var after_text   := concat3("\013\027[",int_to_s(bubblewidth-1),"C|")
      in print(concat3(" ", repeat_string("_", bubblewidth - 2), " \n"))
       ; print(concat(indent_string(text, "| ", after_text), "\n"))
       ; print(concat3(" ", repeat_string("-", bubblewidth - 2), " \n"))
      end

    function draw_tiger () = print(indent_string(TIGER, INDENT, ""))

    var text := get_reaction_or_text(strip(getinput()))
    var wrappedtext := wrap_string(text, MAXWIDTH)
in
    draw_textbubble(wrappedtext);
    draw_tiger();
    print("\n");
    flush()
end