From: plugd Date: Wed, 27 Nov 2019 08:54:18 +0000 (+0100) Subject: More fleshing out of KOTH. X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=d4f97cb3c89307474ca8eaa812b739af35c2b7f3;p=jars.git More fleshing out of KOTH. Need to spend a bit more than 5 min on this at some point soon! --- diff --git a/koth.scm b/koth.scm index b688f73..c14008d 100644 --- a/koth.scm +++ b/koth.scm @@ -6,12 +6,18 @@ matchable mars parser) +;;; Constants +;; + (define INITIAL-INSTR (make-instr 'DAT 'F 'immediate 0 'immediate 0)) +;;; Games and Matches +;; + (define (file->prog file) (string->prog (with-input-from-file fname read))) -(define (run-all-challenges challenger-file other-files) +(define (run-all-matches challenger-file other-files) (let ((challenger-prog (file->prog challenger-file)) (challenger-name (prog-name challenger-prog)) (other-progs (apply file->prog other-files))) @@ -28,14 +34,19 @@ `((,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))) +(define (run-match spec . progs) + (let loop ((remaining (spec-games-per-match spec))) + (let* ((core (make-core (spec-core-size spec) INITIAL-INSTR)) + (queues (install-progs core (list challenger-prog other-prog)))) + (run-mars core queues)) + (loop (- remaining 1)))) -;;; Score keeping +;;; Score keeping and specs ;; +(define (load-scores dir) + (with-input-from-file (make-pathname dir "scores") read)) + (define (load-specs dir) (with-input-from-file (make-pathname dir "specs") read)) @@ -59,7 +70,10 @@ (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))))))) + (pp (make-specs core-size game-length games-per-match hill-size)))) + (with-output-to-file (make-pathname dir "scores") + (lambda () + (pp '())))))) ;;;; Main ;;;;