- (if (memq (prog-name challenger-prog) (map prog-name hill-progs))
- (print "Challenger already on hill!")
- (let ((new-scores (append (score-challenger-matches spec challenger-prog hill-progs)
- scores)))
- (save-scores new-scores hill-dir)
- (hill-add-file challenger-file (prog-name challenger-prog) hill-dir)))))
+ (hill-news-add hill-dir "Challenger '" challenger-name "' accepted for battle.")
+ (if (member challenger-name (map prog-name hill-progs))
+ (hill-news-add hill-dir "Challenge aborted: challenger already on hill!")
+ (let* ((new-scores (append (score-challenger-matches spec challenger-prog hill-progs)
+ scores))
+ (rankings (scores->rankings new-scores)))
+ (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-news-add hill-dir "Challenger '" challenger-name "' added to the hill."))
+ (let ((loser-name (caar rankings)))
+ (hill-save-scores-and-rankings hill-dir
+ (filter (lambda (score)
+ (not (or (equal? (car score) loser-name)
+ (equal? (cadr score) loser-name))))
+ new-scores)
+ (cdr rankings))
+ (hill-add hill-dir challenger-file challenger-name)
+ (hill-remove hill-dir loser-name)
+ (if (equal? loser-name challenger-name)
+ (hill-news-add hill-dir
+ "Challenger '" challenger-name
+ "' failed to best any warrior on the hill.")
+ (begin
+ (hill-news-add hill-dir
+ "Challenger '" challenger-name
+ "' defeated at least one warrior on the hill.")
+ (hill-news-add hill-dir
+ "Warrior '" loser-name
+ "' has been pushed off the hill!")))))))))