Added debugger.

[jars.git] / koth.scm

diff --git a/koth.scm b/koth.scm
index 45e4bb8..db68efa 100644 (file)
--- a/koth.scm
+++ b/koth.scm
@@ -48,7 +48,7 @@
 (define (score-game spec prog1 prog2)
   (let* ((core (make-core (spec-core-size spec)))
          (queues (install-progs core (list prog1 prog2)))
-         (result (run-mars core queues (spec-game-length spec))))
+         (result (run-mars core queues (spec-game-length spec) 2)))
     (cond 
           ((null? result) (error "Invalid game result."))
           ((= (length result) 1)
@@ -88,7 +88,7 @@
           (if (<= (length rankings) (spec-hill-size spec))
               (begin
                 (hill-save-scores-and-rankings hill-dir new-scores rankings)
-                (hill-add hill-dir challenger-file challenger-name)
+                (hill-add hill-dir challenger-file)
                 (hill-news-add hill-dir "Challenger '" challenger-name "' added to the hill."))
               (let ((loser-name (caar rankings)))
                 (hill-save-scores-and-rankings hill-dir
@@ -97,7 +97,7 @@
                                                                   (equal? (cadr score) loser-name))))
                                                        new-scores)
                                                (cdr rankings))
-                (hill-add hill-dir challenger-file challenger-name)
+                (hill-add hill-dir challenger-file)
                 (hill-remove hill-dir loser-name)
                 (if (equal? loser-name challenger-name)
                     (hill-news-add hill-dir
@@ -145,11 +145,19 @@
     (with-output-to-file (make-pathname dir "news")
       (lambda () (pretty-print new-news)))))
 
-(define (hill-add dir file name)
-  (copy-file file (make-pathname dir (->string name) ".red")))
+(define (hill-add dir file)
+  (let* ((prog (file->prog file))
+         (name (prog-name prog))
+         (author (prog-author prog))
+         (submitted (seconds->string)))
+    (copy-file file (make-pathname dir name ".red"))
+    (with-output-to-file (make-pathname dir name ".info")
+      (lambda ()
+        (pretty-print (list author submitted))))))
 
 (define (hill-remove dir name)
-  (delete-file (make-pathname dir name ".red")))
+  (delete-file (make-pathname dir name ".red"))
+  (delete-file (make-pathname dir name ".info")))
 
 (define (make-spec core-size match-length games-per-match hill-size)
   (list 'spec hill-size core-size match-length games-per-match))