Now have warrior info files in hill dir.
authorplugd <plugd@thelambdalab.xyz>
Wed, 13 May 2020 07:03:19 +0000 (09:03 +0200)
committerplugd <plugd@thelambdalab.xyz>
Wed, 13 May 2020 07:03:19 +0000 (09:03 +0200)
koth.scm

index 45e4bb8..d25dcd1 100644 (file)
--- a/koth.scm
+++ b/koth.scm
@@ -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
     (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))