From: plugd <plugd@thelambdalab.xyz>
Date: Fri, 8 May 2020 17:21:54 +0000 (+0200)
Subject: Cleaning up ranking system.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=8cf793c2dd22926c497996a5a64a53ce8ada0f21;p=jars.git

Cleaning up ranking system.
---

diff --git a/koth.scm b/koth.scm
index 61852c5..3ad5925 100644
--- a/koth.scm
+++ b/koth.scm
@@ -73,8 +73,8 @@
             (< (cadr a) (cadr b))))))
 
 (define (challenge hill-dir challenger-file)
-  (let* ((spec (load-spec hill-dir))
-         (scores (load-scores hill-dir))
+  (let* ((spec (hill-spec hill-dir))
+         (scores (hill-scores hill-dir))
          (challenger-prog (file->prog challenger-file))
          (hill-progs (map file->prog (hill-files hill-dir))))
     (if (member (prog-name challenger-prog) (map prog-name hill-progs))
@@ -84,39 +84,45 @@
                (rankings (scores->rankings new-scores)))
           (if (<= (length rankings) (spec-hill-size spec))
               (begin
-                (save-scores new-scores hill-dir)
+                (save-hill-scores-and-rankings new-scores rankings hill-dir)
                 (hill-add-file challenger-file (prog-name challenger-prog) hill-dir))
               (let ((loser (caar rankings)))
-                (save-scores (filter (lambda (score)
-                                       (not (or (equal? (car score) loser)
-                                                (equal? (cadr score) loser))))
-                                     new-scores)
-                             hill-dir)
+                (save-hill-scores-and-rankings (filter (lambda (score)
+                                                         (not (or (equal? (car score) loser)
+                                                                  (equal? (cadr score) loser))))
+                                                       new-scores)
+                                               (cdr rankings)
+                                               hill-dir)
                 (hill-remove loser hill-dir)))))))
   
 
 ;;; Hill initialization and specs
 ;;
 
-(define (load-scores dir)
+(define (hill-scores dir)
   (with-input-from-file (make-pathname dir "scores") read))
 
-(define (save-scores scores dir)
+(define (save-hill-scores-and-rankings scores rankings dir)
   (with-output-to-file (make-pathname dir "scores")
-    (lambda () (pretty-print scores))))
+    (lambda () (pretty-print scores)))
+  (with-output-to-file (make-pathname dir "rankings")
+    (lambda () (pretty-print rankings))))
 
-(define (load-spec dir)
+(define (hill-spec dir)
   (with-input-from-file (make-pathname dir "spec") read))
 
 (define (hill-files dir)
   (glob (make-pathname dir "*.red")))
 
 (define (hill-rankings dir)
-  (scores->rankings (load-scores dir)))
+  (with-input-from-file (make-pathname dir "rankings") read))
 
 (define (hill-add-file file name dir)
   (copy-file file (make-pathname dir (->string name) ".red")))
 
+(define (hill-remove-file name dir)
+  (delete-file (make-pathname dir name ".red")))
+
 (define (make-spec core-size match-length games-per-match hill-size)
   (list 'spec hill-size core-size match-length games-per-match))
 
@@ -140,8 +146,9 @@
                 (print ";; ('spec hill-size core-size game-length games-per-match\n")
                 (pp (make-spec core-size game-length games-per-match hill-size))))
             (with-output-to-file (make-pathname dir "scores")
-              (lambda ()
-                (pp '())))))))
+              (lambda () (pp '())))
+            (with-output-to-file (make-pathname dir "rankings")
+              (lambda () (pp '())))))))
 
 ;;;; Main ;;;;
 
@@ -149,7 +156,7 @@
 
 (define default-core-size 8000)
 (define default-game-length 80000)
-(define default-games-per-match 1)
+(define default-games-per-match 3)
 (define default-hill-size 10)
 
 (define (print-usage)
@@ -184,9 +191,14 @@
                     default-game-length
                     default-games-per-match))
     (((or "-r" "--rankings") dir)
-     (print "Warrior" "\t" "Score")
-     (print "-=-=-=-" "\t" "=-=-=")
-     (for-each (lambda (r) (print (car r) "\t" (cadr r))) (reverse (hill-rankings dir))))
+     (let ((rankings (reverse (hill-rankings dir))))
+       (if (null? rankings)
+           (print "No warriors on hill!")
+           (begin
+             (print rankings)
+             (print "Warrior" "\t" "Score")
+             (print "-=-=-=-" "\t" "=-=-=")
+             (for-each (lambda (r) (print (car r) "\t" (cadr r))) rankings)))))
     ((hill-dir challenger-file)
      (challenge hill-dir challenger-file))
     (else