tigersay/tigersay.tig

/*
# Tigersay #

![Once upon a time, there were a programming language named Tiger, and nobody used it. Then some stupid student though 'lets write a clone of cowsay'. And that is how I was born](./example.png)

An implementation of the classic Perl program [cowsay](https://en.wikipedia.org/wiki/Cowsay) in the Tiger programming language from the [Modern Compiler Implementation in ML/C/Java](https://www.cs.princeton.edu/~appel/modern/ml/) books. Does not come as a binary, nor with a Tiger compiler. Compilation is left as an exercise for the reader.

Written in November 2017, mostly for the kicks, but also for testing
my group's Tiger-compiler.

The framework we're using does not allow us to parse commandline-arguments, so the only way to interact with `tigersay` is to pipe into the compiled program. For example `echo "Grrrrr" | tigersay`. For the same reasons it does not support alternative faces.
*/

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