From: plugd Date: Fri, 8 May 2020 08:26:06 +0000 (+0200) Subject: Parser, runner and visualiser now work with string prog names. X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=5df4e85a21e1577f0589e5ca2907157ec4e4e392;p=jars.git Parser, runner and visualiser now work with string prog names. --- diff --git a/parser.scm b/parser.scm index 427d398..7bc3f90 100644 --- a/parser.scm +++ b/parser.scm @@ -17,7 +17,7 @@ (period-irx (irregex "^\\.")) (redcode-irx (irregex "^;redcode\n")) (name-start-irx (irregex "^;[ \t]*name ")) - (name-irx (irregex "^[a-zA-Z0-9]+")) + (name-irx (irregex "^[^\n]*")) (author-start-irx (irregex "^;[ \t]*author ")) (author-irx (irregex "^[^\n]*")) (comment-irx (irregex "^(;[^\n]*)?\n")) @@ -92,7 +92,7 @@ (instruction-line))) (define (name-line) (if (accept-token name-start-irx) - (cons 'name (string->symbol (accept-token name-irx #t))) + (cons 'name (string-trim (accept-token name-irx #t))) #f)) (define (author-line) (if (accept-token author-start-irx) diff --git a/run-mars.scm b/run-mars.scm index 1d04af8..30b9e5c 100644 --- a/run-mars.scm +++ b/run-mars.scm @@ -12,11 +12,13 @@ (colors-left colors)) (if (null? progs-left) entries - (let ((this-prog (car progs-left)) - (this-col (car colors-left))) - (loop (cons (cons (prog-name this-prog) this-col) entries) - (cdr progs-left) - (cdr colors-left)))))) + (if (null? colors-left) + (error "Not enough colours in colour map!") + (let ((this-prog (car progs-left)) + (this-col (car colors-left))) + (loop (cons (cons (prog-name this-prog) this-col) entries) + (cdr progs-left) + (cdr colors-left))))))) (define (mars-runner files iters core-size visualization) (print "Iters: " iters ", core size: " core-size) diff --git a/visualizer.scm b/visualizer.scm index 3a914e2..6733b3e 100644 --- a/visualizer.scm +++ b/visualizer.scm @@ -26,8 +26,8 @@ (unless (null? remaining-palette) (let ((name (caar remaining-palette)) (col (cdar remaining-palette))) - (wish% "label .fb.l" name " -text " name " -fg " col) - (wish% "pack .fb.l" name " -side left")) + (wish% "label .fb.l" col " -text \"" name "\" -fg " col) + (wish% "pack .fb.l" col " -side left")) (loop (cdr remaining-palette)))) (wish% "frame .fc -relief sunken -borderwidth 2") (wish% "pack .fc -side bottom")