(import (chicken process-context)
        (chicken file)
        (chicken pathname)
        (chicken string)
        (chicken pretty-print)
        matchable
        mars parser)

(define INITIAL-INSTR (make-instr 'DAT 'F 'immediate 0 'immediate 0))

(define (file->prog file)
  (string->prog (with-input-from-file fname read)))

(define (run-all-challenges challenger-file other-files)
  (let ((challenger-prog (file->prog challenger-file))
        (challenger-name (prog-name challenger-prog))
        (other-progs (apply file->prog other-files)))
    (map 
     (lambda (other-prog)
       (let ((other-name (prog-name other-prog))
             (result (run-match challenger-prog other-prog)))
         (cond ((or (= (length result) 2)
                    (= (length result) 0))
                `((,challenger-name 1) (,other-name 1)))
               ((eq? (queue-name (car result)) challenger-name)
                `((,challenger-name 3) (,other-name 0)))
               (else
                `((,challenger-name 0) (,other-name 3))))))
     other-progs)))

(define (run-match . progs)
  (let* ((core (make-core CORE-SIZE INITIAL-INSTR))
         (queues (install-progs core (list challenger-prog other-prog))))
    (run-mars core queues)))

;;; Score keeping
;;

(define (load-specs dir)
  (with-input-from-file (make-pathname dir "specs") read))

(define (make-specs core-size match-length games-per-match hill-size)
  (list 'specs hill-size core-size match-length games-per-match))

(define (specs? specs)
  (and (pair? specs) (eq? (car specs) 'specs)))

(define (specs-hill-size specs) (list-ref specs 1))
(define (specs-core-size specs) (list-ref specs 2))
(define (specs-game-length specs) (list-ref specs 3))
(define (specs-games-per-match specs) (list-ref specs 4))

(define (init-hill-dir dir hill-size core-size game-length games-per-match)
  (if (or (not (directory-exists? dir)) (not (file-writable? dir)))
      (print "Directory " dir " doesn't exist or is not writable.")
      (if (not (null? (glob (make-pathname dir "*"))))
          (print "Directory " dir " exists but is non-empty.")
          (with-output-to-file (make-pathname dir "specs")
            (lambda ()
              (print ";; Hill specifications.")
              (print ";; ('specs hill-size core-size game-length games-per-match\n")
              (pp (make-specs core-size game-length games-per-match hill-size)))))))

;;;; Main ;;;;

;; Default values

(define default-core-size 8000)
(define default-game-length 80000)
(define default-games-per-match 1)
(define default-hill-size 10)



(define (print-usage)
  (let ((binary (pathname-file (car (argv)))))
    (print "King of the Hill Tournament Manager")
    (print "\nUsage:\t" binary " hill-directory challenger-file")
    (print "\t" binary " [-h|--help]")
    (print "\t" binary " [-i|--init] hill-directory [hill-size [core-size game-length games-per-match]]")
    (print "\nDefault values are as follows:\n"
           "\thill-size: " default-hill-size "\n"
           "\tcore-size: " default-core-size "\n"
           "\tgame-length: " default-game-length "\n"
           "\tgames-per-match: " default-games-per-match)))

(define (process-args args)
  (match args
    ((or () ((or "-h" "--help")))
     (print-usage))
    (((or "-i" "--init") dir hill-size core-size game-length games-per-match)
     (init-hill-dir dir hill-size core-size game-length games-per-match))
    (((or "-i" "--init") dir)
     (init-hill-dir dir
                    default-hill-size
                    default-core-size
                    default-game-length
                    default-games-per-match))
    (((or "-i" "--init") dir hill-size)
     (init-hill-dir dir
                    hill-size
                    default-core-size
                    default-game-length
                    default-games-per-match))
    ((hill-dir challenger-file)
     (print "Not implemented"))
    (else
     (print "Invalid arguments: " (apply conc else)))))

(define (main)
  (process-args (cdr (argv))))
  
(main)