(define (match-before-cur? str) (let ((len (string-length str))) (and (> (car (get-coord)) len) (term-match-string? str (map - (get-coord) (list len 0)))))) (define (at-question?) (and (char=? (square-char (get-coord)) #\space) ; nethack clears the line, right? (or (term-match-string? "(For instructions type a ?)" '(1 1)) (and (term-match-string? "Call " '(1 1)) (match-before-cur? ": ")) (match-before-cur? " [yn] (n) ") (match-before-cur? " [ynq] (n) ") (match-before-cur? " [ynaq] (y) ") ; more prompt types? ))) ; parse (n of n) ; makes me wish I still had perl :( (define (menu-page/page) (let* ((c (get-coord)) (x (car c)) (y (cadr c))) (call/cc (lambda (ret) (letrec ((next-char (lambda () (if (= x 1) (ret #f) (begin (set! x (- x 1)) (square-char (list x y)))))) (read-num (lambda () (let ((c (next-char))) (if (not (char-numeric? c)) (begin (set! x (+ x 1)) 0) (+ (char->number c) (* 10 (read-num))))))) (match-string (lambda (str) (string-every (lambda (c) (char=? c (next-char))) (string-reverse str))))) (and-let* (((match-string ") ")) (total (read-num)) ((> total 1)) ((match-string " of ")) (current (read-num)) ((> current 0)) ((match-string "("))) (list current total))))))) (define (at-menu?) (or (match-before-cur? "(end) ") (menu-page/page))) (define (at-last-page?) (let ((x (menu-page/page))) (and x (apply = x)))) (define (read-messages) (define (join ls) (string-join (map (lambda (s) (string-trim-right s #\space)) ls))) (split-messages (if (not (at-more?)) (string-trim-right (get-row-plaintext 1) #\space) (let ((x (car (get-coord))) (y (cadr (get-coord)))) (join (append (map get-row-plaintext (iota (- y 1) 1 1)) (list (get-row-plaintext y 1 (- x 9))))))))) (define (split-messages str) (define (punc? i) (memv (string-ref str i) '(#\. #\! #\?))) (define (c=? i c) (char=? (string-ref str i) c)) (let ((len (string-length str))) (let loop ((ls '()) (start 0) (i 0) (spaces #f)) (cond ((= i len) (reverse (cons (substring str start i) ls))) ((not spaces) (loop ls start (+ i 1) (and (punc? i) 0))) ((and (zero? spaces) (c=? i #\") (not (c=? (- i 1) #\"))) (loop ls start (+ i 1) 0)) ((and (= spaces 1) (c=? i #\space)) (loop (cons (substring str start (- i 1)) ls) (+ i 1) (+ i 1) #f)) (else (loop ls start (+ i 1) (and (c=? i #\space) (+ spaces 1)))))))) (define (at-more?) (match-before-cur? "--More--")) (define (inventory-item? str) (and (> (string-length str) 5) (char-alphabetic? (string-ref str 0)) (char=? (string-ref str 1) #\space) (char=? (string-ref str 2) #\-) (char=? (string-ref str 3) #\space))) (define (split-inventory-item str) (list (string-ref str 0) (string-drop str 4))) (define (chop-punct str) (or (string-drop-suffix "." str) (string-drop-suffix "!" str)))