304 lines
10 KiB
Plaintext
304 lines
10 KiB
Plaintext
/*
|
|
# Tigersay #
|
|
|
|
|
|
|
|
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
|
|
|