#include stdlib.tas

(verb go (syn "go"))
(verb examine (syn "examine" "x"))
(verb type (syn "type"))
(verb dig (syn "dig"))
(verb eat (syn "eat"))
(verb give (syn "give"))
(verb put (syn "put"))
(verb exit-term (syn "exit"))
(verb look (syn "look" "l"))
(verb invlook (syn "inventory" "inv" "i"))
(verb take (syn "take" "get" "pick up"))
(verb drop (syn "drop"))
(verb quit-game (syn "quit"))

(verb ls (syn "ls"))
(verb uncompress (syn "uncompress"))
(verb pwd (syn "pwd"))
(verb cd (syn "cd"))
(verb cat (syn "cat"))
(verb rlogin (syn "rlogin" "ssh"))

(cardinal north (syn "north" "n"))
(cardinal east (syn "east" "e"))
(cardinal south (syn "south" "s"))
(cardinal west (syn "west" "w"))
(cardinal up (syn "up" "u"))
(cardinal down (syn "down" "d"))
(cardinal in (syn "in" "inside"))
(cardinal out (syn "out" "outside"))
(cardinal northeast (syn "northeast" "ne"))
(cardinal northwest (syn "northwest" "nw"))
(cardinal southeast (syn "southeast" "se"))
(cardinal southwest (syn "southwest" "sw"))

(setg det-list (list "the" "a" "with" "into" "to" "at" "on" "in"))
(setg notgot "You haven't got it.")
(setg programs-list (list "ls" "ftp" "echo" "exit" "cd" "pwd" "rlogin" "ssh" "uncompress" "cat"))
(setg program-attrib "-rwxr-xr-x  1 toukmond restricted    10423 Jan 1 1970 ")
(setg file-attrib "-rwxr-xr-x  1 toukmond restricted        0 Jan 1 1970 ")
(setg toukmond-folder-attrib "drwxr-xr-x  3 toukmond restricted      512 Jan 1 1970 ")
(setg staff-folder-attrib "drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ")

(setg unknown-verb "I don't know that verb!")

(setg notgot "You haven't got it.")

(defun pickup (thing)
    (if (holds thing)
        (print "You already have it!")
        (prog
            (item-add thing inv)
            (item-remove thing)
            "Taken.")))

(defun take-list (l ex)
    (when l
        (setl ((obj (head l)))
            (if (and (getp obj can-take-all) (not (vm-contains obj ex)))
                (prog
                    (setg something-here true)
                    (setp obj taken true)
                    (when (describe obj)
                        (print (concat (describe obj) ": " (pickup obj)))))
                (when (is-open obj)
                    (take-list (getn obj "ID") ex)))
            (take-list (cdr l) ex))))

(item inv
    (if (get-items inv)
        (setl ((item-descs (getn inv)))
            (setl ((item-desc-not-all (list)))
                (vm-remove-item all item-descs item-desc-not-all)
                (if item-desc-not-all
                    (print (concat "You are carrying " (joining item-desc-not-all) "."))
                    (print "You are empty handed."))))
        (print "You are empty handed.")))

(defun drop (thing cond)
    (when cond
        (when (not (holds thing)) (print notgot))
        (when (holds thing)
            (print "Dropped.")
            (setg holdcount (sub holdcount 1))
            (item-remove thing inv)
            (item-add thing))))

(defun remove-all-items (l)
    (when l
        (item-remove (head l) inv)
        (remove-all-items (cdr l))))

(defun take (thing cond)
    (when cond
        (when (holds thing) (print "You already have it!"))
        (when (and (not (holds thing)) (gt holdcount 5))
            (print "Your hands are full."))
        (when (and (not (holds thing)) (lt holdcount 6))
            (item-add thing inv)
            (item-remove thing)
            (setg holdcount (add holdcount "1"))
            (print "Taken."))))

(ruleset cancarry (thing cond)
    (rule
        (verbs drop)
        (drop thing cond))
    (rule
        (verbs take)
        (take thing cond)))

(defun is-dark (where)
    (and (getp where dark)
        (not (or (holds lamp) (holds lamp where)))))

(defun status ()
    (print (getp current-location name))
    (describe current-location)
    (when (get-items current-location)
        //setting this local variable is a hack to ensure _lst created by getn is destroyed after use
        (setl ((item-descs (getn current-location)))
            (when item-descs
                (print "" (concat "You can see " (joining item-descs) "."))))))

(rule
    (verbs quit-game)
    (print "Goodbye!")
    (quit))

(rule
    (verbs look)
    (status))

(rule
    (verbs invlook)
    (describe inv))

(defun gotof (where)
    (if (is-dark where)
        (goto dark-place)
        (goto where))
    (status))

(item all
    (syn "all")
    (rule
        (verbs take)
        (setg something-here false)
        (take-list (getn current-location "ID") false)
        (if (not something-here)
            (print "There's nothing here you can take."))))

(item-add all inv)

(item lamp
    (init
        (seti filename "lamp.o"))
    (prog "a lamp")
    (syn "lamp" "light"))

(item-add lamp inv)

(item gamma
    (syn "gamma")
    (rule
        (verbs rlogin)
        (input "Password: " command
            (if (equals command "worms")
                (prog
                    (print "" "You begin to feel strange for a moment, and you lose your items." "You step back from the console." "")
                    (setg using-computer false)
                    (remove-all-items (getn inv "ID"))
                    (gotof receiving-room))
                (print "login incorrect")))))

(item-add gamma inv)

(rule
    (verbs dig)
    (if (holds shovel)
        (print "What do you want to dig?")
        (print "With what? Your bare hands?")))

(rule
    (verbs ls)
    (if using-computer
        (describe current-location)
        (print unknown-verb)))

(rule
    (verbs pwd)
    (if using-computer
        (print (getp current-location path))
        (print unknown-verb)))

(rule
    (verbs rlogin)
    (if using-computer
        (print "Usage: rlogin <hostname>")
        (print unknown-verb)))

(rule
    (verbs exit-term)
    (when using-computer
        (print "" "You step back from the console." "")
        (setg last-dir current-location)
        (goto -rooms-computer-room)
        (setg using-computer false)))

(setg logged-in false)

(defun print-prog-list (l)
    (when l
        (print (concat program-attrib (head l)))
        (print-prog-list (cdr l))))

(defun feed-bear ()
    (when (and (vm-contains bear (get-items -rooms-bear-hangout)) (equals current-location -rooms-bear-hangout))
        (print "The bear takes the food and runs away with it. He left something behind.")
        (item-remove bear -rooms-bear-hangout)
        (item-add brass-key -rooms-bear-hangout)
        (item-remove food -rooms-bear-hangout)
        (item-remove food inv)))

(gotof -rooms-dead-end)

(while true
    (parser))

(item brass-key
    (syn "key")
    (prog "shiny brass key")
    (init
        (seti filename "key.o"))
    (cancarry brass-key true))

(loc -rooms-dead-end
    (init
        (setloc name "Dead end")
        (setloc path "/rooms/dead-end")
        (setloc desc-1 "You are at a dead end of a dirt road.  The road goes to the east.  In the distance you can see that it will eventually fork off.")
        (setloc desc-2 "The trees here are very tall royal palms, and they are spaced equidistant from each other."))
    (if (not using-computer)
        (print (getp -rooms-dead-end desc-1) (getp -rooms-dead-end desc-2))
        (prog
            (print (concat staff-folder-attrib "."))
            (print (concat staff-folder-attrib ".."))
            (print-files staff-folder-attrib (get-items current-location))))
    (item dead-end-desc
        (syn "description")
        (init
            (seti filename "description"))
        (rule
            (verbs cat)
            (if (not using-computer) false
                (print (getp -rooms-dead-end desc-1)
                        (getp -rooms-dead-end desc-2)))))
    (item shovel
        (syn "shovel" "spade")
        (prog "a shovel")
        (init
            (seti filename "shovel.o"))
        (cancarry shovel true)
        (rule
            (verbs examine)
            (print "It is a normal shovel with a price tag attached that says $19.99.")))
    (exit (east) (rule (gotof -rooms-dirt-road))))

(loc -rooms-dirt-road
    (init
        (setloc name "E/W Dirt road")
        (setloc path "/rooms/dirt-road"))
    (print "You are on the continuation of a dirt road.  There are more trees on both sides of you.  The road continues to the east and west."
        "There is a large boulder here.")
    (item boulder
        (syn "boulder" "rock" "stone")
        (rule
            (verbs examine)
            (print "It is just a boulder.  It cannot be moved.")))
    (exit (west) (rule (gotof -rooms-dead-end)))
    (exit (east) (rule (gotof -rooms-fork))))

(loc -rooms-fork
    (init
        (setloc name "Fork"))
    (print "You are at a fork of two passages, one to the northeast, and one to the southeast.  The ground here seems very soft."
        "You can also go back west.")
    (item ground
        (syn "ground" "earth")
        (rule
            (verbs dig)
            (print "What do you want to dig with?"))
        (rule
            (verbs (dig shovel))
            (print "I think you found something.")
            (setp cpu-card found true)))
    (item cpu-card
        (syn "card" "cpu")
        (when (getp cpu-card found) "CPU card")
        (cancarry cpu-card true)
        (rule
            (verbs examine)
            (print "The CPU board has a VAX chip on it.  It seems to have 2 Megabytes of RAM onboard.")))
    (exit (west) (rule (gotof dirt-road)))
    (exit (northeast) (rule (gotof -rooms-ne-sw-road)))
    (exit (southeast) (rule (gotof -rooms-e-w-road))))

(loc -rooms-ne-sw-road
    (init
        (setloc name "NE/SW road"))
    (print "You are on a northeast/southwest road.")
    (exit (southwest) (rule (gotof -rooms-fork)))
    (exit (northeast) (rule (gotof -rooms-building-front))))

(loc -rooms-e-w-road
    (init
        (setloc name "SE/NW road"))
    (print "You are on a southeast/northwest road.")
    (item food
        (syn "food" "meat")
        (prog "some food")
        (cancarry food true)
        (rule
            (verbs examine)
            (print "It looks like some kind of meat.  Smells pretty bad."))
        (rule
            (verbs drop)
            (feed-bear))
        (rule
            (verbs eat)
            (if (not (holds food))
                (print notgot)
                (prog
                    (print "That tasted horrible.")
                    (item-remove food inv)))))
    (exit (southeast) (rule (gotof -rooms-bear-hangout)))
    (exit (northwest) (rule (gotof -rooms-fork))))

(loc -rooms-bear-hangout
    (init
        (setloc name "Bear hangout"))
    (print "You are standing at the end of a road.  A passage leads back to the northwest.")
    (when (vm-contains bear (get-items -rooms-bear-hangout)) (print "There is a ferocious bear here!"))
    (item bear
        (syn "bear" "beast" "animal")
        (rule
            (verbs examine)
            (print "It looks like a grizzly to me."))
        (rule
            (verbs (give food))
            (feed-bear)))
    (exit (northwest) (rule (gotof -rooms-e-w-road))))

(loc -rooms-building-front
    (init
        (setloc name "Building front"))
    (print "You are at the end of the road.  There is a building in front of you to the northeast, and the road leads back to the southwest.")
    (exit (southwest) (rule (gotof -rooms-ne-sw-road)))
    (exit (northeast) (rule
        (if (holds brass-key)
            (gotof -rooms-old-building-hallway)
            (print "You don't have a key that can open this door.")))))

(loc -rooms-old-building-hallway
    (init
        (setloc name "Old building hallway"))
    (print "You are in the hallway of an old building.  There are rooms to the east and west, and doors leading out to the north and south.")
    (exit (south) (rule (gotof -rooms-building-front)))
    (exit (west) (rule (gotof -rooms-computer-room)))
    (exit (east) (rule (gotof -rooms-mailroom))))

(loc -rooms-mailroom
    (init
        (setloc name "Mailroom"))
    (print "You are in a mailroom.  There are many bins where the mail is usually kept.  The exit is to the west.")
    (item bins
        (syn "bins" "bin")
        (rule
            (verbs examine)
            (print "All of the bins are empty.  Looking closely you can see that there"
                    "are names written at the bottom of each bin, but most of them are"
                    "faded away so that you cannot read them.  You can only make out three names:"
                    "Jeffrey Collier"
                    "Robert Toukmond"
                    "Thomas Stock")))
    (exit (west) (rule (gotof -rooms-old-building-hallway))))

(defun print-files (attrib l)
    (when l
        (setl ((filename (getp (head l) filename)))
            (when filename
                (print (concat attrib filename)))
            (print-files attrib (cdr l)))))

(defun cd (path-str)
    //first split it by '/'
    (setl ((dir-list (splitting "/" path-str)) (resolved-dir-list (list)))
        (if (not (head dir-list))
            (resolve-path-3-times (cdr dir-list) resolved-dir-list)
            (prog
                //(print (concat (getp current-location path) "/" path-str))
                (setl ((abs-path (splitting "/" (concat (getp current-location path) "/" path-str))))
                    (resolve-path-3-times (cdr abs-path) resolved-dir-list))))
        (concat "-" (join-path resolved-dir-list))))

(defun join-path (lst)
    (setl ((count (vm-count-list lst)))
        (if (equals 0 count)
            ""
            (if (equals 1 count)
                (head lst)
                (concat (head lst) "-" (join-path (cdr lst)))))))

(defun resolve-path-3-times (path new-path)
    (setl ((path1 (list)))
        (resolve-path path path1)
        (setl ((path2 (list)))
            (resolve-path path1 path2)
            (resolve-path path2 new-path))))

(defun resolve-path (path new-path)
    (when path
        (if (equals (head path) ".")
            (resolve-path (cdr path) new-path)
            (if (equals (head (cdr path)) "..")
                (resolve-path (cdr (cdr path)) new-path)
                (prog
                    (push (head path) new-path)
                    (resolve-path (cdr path) new-path))))))

(rule
    (verbs type)
    (if (not (equals current-location -rooms-computer-room))
        (print "There is nothing here on which you could type.")
        (if (not computer-working)
            (print "You type on the keyboard, but your characters do not even echo.")
            (prog
                (when (equals current-location -rooms-computer-room)
                    (if (not logged-in)
                       (prog
                            (print "" "" "" "UNIX System V, Release 2.2 (pokey)" "")
                            (input "login: " username
                                (input "password: " password
                                    (if (and (equals username "toukmond") (equals password "robert"))
                                        (prog
                                            (setg logged-in true)
                                            (setg last-dir -usr-toukmond)
                                            (print "" "Welcome to Unix" ""
                                                "Please clean up your directories.  The filesystem is getting full."
                                                "Our tcp/ip link to gamma is a little flaky, but seems to work."
                                                "The current version of ftp can only send files from your home"
                                                "directory, and deletes them after they are sent!  Be careful." ""
                                                "Note: Restricted bourne shell in use." ""))
                                        (print "login incorrect"))))))
                    (when logged-in
                        (setg using-computer true)
                        (setg current-location last-dir)))))))

(loc -usr-toukmond
    (init
        (setloc path "/usr/toukmond"))
    (print (concat toukmond-folder-attrib "."))
    (print (concat staff-folder-attrib ".."))
    (print-prog-list programs-list)
    (print-files file-attrib (get-items current-location))
    (print-files file-attrib (get-items inv))
    (item paper
       (init
            (seti filename "paper.o.Z"))))

(loc -usr
    (init
        (setloc path "/usr"))
    (print (concat staff-folder-attrib "."))
    (print (concat staff-folder-attrib ".."))
    (print-files toukmond-folder-attrib (get-items current-location))
    (item toukmond-obj
        (syn "toukmond")
        (init
            (seti filename "toukmond"))
        (rule
            (verbs cd)
            (goto home-dir))))

(loc -
    (init
        (setloc path ""))
    (print (concat staff-folder-attrib "."))
    (print (concat staff-folder-attrib ".."))
    (print-files staff-folder-attrib (get-items current-location))
    (item usr-obj
        (syn "usr")
        (init
            (seti filename "usr")))
    (item rooms-obj
        (syn "rooms")
        (init
            (seti filename "rooms"))))

(loc -rooms
    (init
        (setloc path "/rooms"))
    (print (concat staff-folder-attrib "."))
    (print (concat staff-folder-attrib ".."))
    (print-files staff-folder-attrib (get-items current-location))
    (item r1 (init (seti filename "computer-room")))
    (item r2 (init (seti filename "mailroom")))
    (item r3 (init (seti filename "old-building-hallway")))
    (item r4 (init (seti filename "building-front")))
    (item r5 (init (seti filename "nw-sw-road")))
    (item r6 (init (seti filename "bear-hangout")))
    (item r7 (init (seti filename "se-nw-road")))
    (item r8 (init (seti filename "fork")))
    (item r9 (init (seti filename "e-w-dirt-road")))
    (item r10 (init (seti filename "dead-end")))
    (item r11 (init (seti filename "hidden-area"))))

(loc -rooms-computer-room
    (init
        (setloc name "Computer room"))
    (print "You are in a computer room.  It seems like most of the equipment has"
            "been removed.  There is a VAX 11/780 in front of you, however, with"
            "one of the cabinets wide open.  A sign on the front of the machine"
            "says: This VAX is named 'pokey'.  To type on the console, use the"
            "'type' command.  The exit is to the east.")
    (if computer-working
        (print "The panel lights are flashing in a seemingly organized pattern.")
        (print "The panel lights are steady and motionless."))
    (item computer
        (syn "computer" "vax" "cabinet")
        (init
            (seti folder "home"))
        (rule
            (verbs (put cpu-card))
            (print "As you put the CPU board in the computer, it immediately springs to life."
                    "The lights start flashing, and the fans seem to startup.")
            (item-remove cpu-card inv)
            (setg computer-working true)))
    (exit (east) (rule (gotof -rooms-old-building-hallway))))

(loc receiving-room
    (init (setloc name "Receiving room"))
    (print "You are in a round, stone room with a door to the east." "There is a sign on the door which reads: 'receiving room'.")
    (exit (east) (rule (gotof northbound-hallway))))

(loc northbound-hallway
    (init (setloc name "Northbound hallway"))
    (print "You are at the south end of a hallway that leads to the north.  There are rooms to the east and west.")
    (exit (west) (rule (gotof receiving-room)))
    (exit (east) (rule (gotof sauna)))
    (exit (north) (rule (gotof north-south-hallway))))

(loc dark-place
    (print "It is pitch dark.  You are likely to be eaten by a grue.")
    (exit (north east south west northeast northwest southeast southwest)
        (rule
            (print "You trip over a grue and fall into a pit and break every bone in your body." "You are dead.")
            (quit))))

(loc sauna
    (init
        (setloc dark true)
        (setloc name "Sauna"))
    (print "You are in a sauna.  There is nothing in the room except for a dial on the wall.  A door leads out to west.")
    (exit (west) (rule (gotof northbound-hallway))))

(loc north-south-hallway
    (init
        (setloc dark true)
        (setloc name "End of N/S Hallway"))
    (print "You are at the end of a north/south hallway.  You can go back to the south, or off to a room to the east.")
    (exit (south) (rule (gotof northbound-hallway))))


(defun parser ()
    (input (if using-computer "$" ">") command
        //split the command into a list of words
        //assume first word is verb/command, second is (optional) noun/filename/remote host
        (setl ((words-with-dets (splitting " " command)))
            (if (not (equals 0 (count-list words-with-dets)))
                (setl ((is-command (vm-contains (head words-with-dets) programs-list)))
                    (if using-computer
                        (if is-command
                            (computer-parser words-with-dets)
                            (print (concat (head words-with-dets) ": not found.")))
                        (if is-command
                            (print unknown-verb)
                            (natural-parser words-with-dets))))))))

(defun computer-parser (words)
        (if (equals 1 (count-list words))
            (setl ((verb-id (verb-from-syn (head words))))
                (if (not verb-id)
                    (prog
                        (setg rule-applied true)
                        (print (concat (head words) ": not found.")))
                    (prog
                        (run-rule-for-verb verb-id (get-rules)))))
            (if (equals 2 (count-list words))
                (setl ((verb-id (verb-from-syn (head words))) (noun-id (noun-from-syn (head (cdr words)))))
                    (if (not verb-id)
                        (prog
                            (setg rule-applied true)
                            (print (concat (head words) ": not found.")))
                        (if (equals verb-id "cd")
                            (setl ((new-path (cd (head (cdr words)))))
                                (if (not (equals false (getp new-path path)))
                                    (goto new-path)
                                    (print "No such directory.")))
                            (if (not noun-id)
                                (prog
                                    (setg rule-applied true)
                                    (if (equals verb-id "rlogin")
                                        (print "No such host.")
                                        (print "File not found.")))
                                (prog
                                    (run-rule-for-verb verb-id (get-rules noun-id))))))))))

// to parse multi-word nouns,
// take a list of words
// such as 'big wooden box',
// then create a list of string:
// big wooden box
// big wooden
// big
// to do this, create a function that takes the original list of words and a number
// the number is initially equal to (count-list phrase) - i.e. 3
// it works by concatting, i.e.

(defun phrase-list (phrase n)
    //(print (concat "phrase-list " n))
    (if (gt n 1)
        (concat (head phrase) " " (phrase-list (cdr phrase) (sub n 1)))
        (head phrase)))

//so to build the list of phrases we'd have

(defun build-phrase-list (phrase n)
    (if (gt n 0)
        //(print (concat "build-phrase-list " n))
        (setl ((poss-noun-phrase (phrase-list phrase n)))
            //(print (concat "does '" poss-noun-phrase "' exist?"))
            (if (noun-from-syn poss-noun-phrase)
                (prog
                    //(print "yes")
                    poss-noun-phrase)
                (build-phrase-list phrase (sub n 1))))
        ""))

// or can we do it recursively?
//actually it should just return the longest possible noun phrase that is a valid thing

(defun natural-parser (words-with-dets)
    (setg rule-applied false)
    (setl ((words (list)) (nothing (list)))
        (if (gt (count-list words-with-dets) 1)
            (remove-items det-list words-with-dets words)
            (remove-items nothing words-with-dets words))
        (setl ((obj1 (build-phrase-list (list-nth-term words 1) (sub (count-list words) 1))) (id-lst (list)) (id2-lst (list)) (verb-id (verb-from-syn (head words))))
            (when obj1
                (nouns-from-syn obj1 id-lst)
                (when (gt (count-list id-lst) 1)
                    (setg rule-applied true)
                    (print (concat "Which " obj1 " do you mean?")))
                (when (not id-lst)
                    (setg rule-applied true)
                    (print (concat "I can't see any " obj1 " here.")))
                (setl ((phrase-count (count-list words)) (obj-count  (add (count-list (splitting " " obj1)) 1)))
                    (when (gt phrase-count obj-count)
                        (setl ((obj2 (build-phrase-list (list-nth-term words obj-count) (sub phrase-count obj-count))))
                            (when obj2
                                (nouns-from-syn obj2 id2-lst)
                                (when (gt (count-list id2-lst) 1)
                                    (setg rule-applied true)
                                    (print (concat "Which " obj2 " do you mean?")))
                                (when (not id-lst)
                                    (setg rule-applied true)
                                    (print (concat "I can't see any " obj2 " here."))))))))

            (when (not rule-applied)
                (if (equals 1 (count-list words))
                    (if (not verb-id)
                        (setl ((card-id (card-from-syn (head words))))
                            (if card-id
                                (if (exit-here card-id)
                                    (prog
                                        (setg move-count (add move-count 1))
                                        (setg rule-applied true)
                                        (exec-exit card-id))
                                    (prog
                                        (setg rule-applied true)
                                        (print "You can't go there.")))
                                (prog
                                    (setg rule-applied true)
                                    (print unknown-verb))))
                        (prog
                            (setg move-count (add move-count 1))
                            (run-rule-for-verb verb-id (get-rules))))
                    (if (not verb-id)
                        (prog
                            (setg rule-applied true)
                            (print unknown-verb))
                        (if (not id-lst)
                            (prog
                                (setg rule-applied true)
                                (print "I can't see that here."))
                            (if (not id2-lst)
                                (prog
                                    (setg move-count (add move-count 1))
                                    (run-rule-for-verb verb-id (get-rules (head id-lst))))
                                (prog
                                    (setg move-count (add move-count 1))
                                    (run-rule-for-verb verb-id (get-rules (head id-lst) (head id2-lst)))
                                    (if (not rule-applied) (run-rule-for-verb verb-id (get-rules (head id2-lst) (head id-lst))))))))))))
    (when (not rule-applied)
        (print "That didn't seem to work.")))