; https://xn--rpa.cc/irl/term.html
(define-module (depre main)
  #:use-module (ice-9 textual-ports))

;; Code makes heavy use of functional code and parameters for state.
(define max-100 (lambda (x) (if (> x 100) 100 x)))
(define %depression (make-parameter 50 max-100))
(define %tiredness  (make-parameter 50 max-100))

(define (nth n lst)
  (if (> n (length lst))
    (error "Chosen element longer than provided list")
    (let loop ((lst lst)
               (n n))
    (if (= 1 n)
      (car lst)
      (loop (cdr lst) (- n 1))))))


;; Function combinations: they define the state transitions
(define (combine . functions)
  "Calls given functions in given order."
  (lambda ()
    (let loop ((fs functions))
      (when (not (null? fs))
        ((car fs))
        (loop (cdr fs))))))

;; Transition by chance, according to the state
;; Example:
;; - You are too tired for that, so you do this instead
;; - Or you actually do it
(define (f-or-tired f tired)
  (lambda ()
    (if (< (random 100) (%tiredness)) (f) (tired))))

(define (f-or-depressed f depressed)
  (lambda ()
    (if (< (random 100) (%depression)) (f) (depressed))))


;; State alteration functions for easy access
(define (tire)
  (lambda () (%tiredness  (+ (%tiredness) 5))))

(define (rest)
  (lambda () (%tiredness  (- (%tiredness) 5))))

(define (depress)
  (lambda () (%depression (+ (%depression) 5))))

(define (cheer-up)
  (lambda () (%depression (- (%depression) 5))))


;; Simple I/O
(define (answer message)
  (lambda ()
    (newline)
    (display message)
    (get-line (current-input-port))))

(define (bar percent)
  "A simple 12 character bar for life-like variable representation"
  (define len 22)
  (string-tabulate
    (lambda (x)
      (cond
        ((= x 0)                          #\[)
        ((= x (- len 1))                  #\])
        ((>= (/ percent (/ 100 len)) x)   #\=)
        (else                             #\space)))
    len))

(define (read-number)
  (string->number (get-line (current-input-port))))

;; Basic state representation and creation: A state is a function that knows
;; how to jump to other states through a menu.
(define* (state heading menu #:optional (hide-status #f))
  (lambda ()
    (when (not hide-status)
      (newline)
      (display "Depression:\t")
      (display (bar (%depression)))
      (newline)
      (display "Tiredness:\t")
      (display (bar (%tiredness))))
    (newline)
    (display heading)
    (newline)
    (map (lambda (opt num)
           (display (string-append "  " (number->string num) "- " (car opt)))
           (newline))
         menu (iota (length menu) 1))
    (display "You choose >  ")
    (let loop ((chosen (read-number)))
      (if (and (number? chosen) (<= chosen (length menu)))
        ((cdr (nth chosen menu)))
        (begin
          (display "Wrong answer. Try again >  ")
          (loop (read-number)))))))

;; States:

;; Some macro magic for indirection that enables recursion.
;; I don't really know how it works (yet!)
(define %states (make-hash-table))
(define-macro (register-state name f)
  `(hash-set! %states ,name ,f))
(define-macro (to-state name)
  `(lambda () ((hash-ref %states ,name))))

(register-state
  'beginning
  (state "This is the game beginning, as a test"
         (list (cons "Return to start"
                     (f-or-tired
                       (combine
                         (answer "Alright, you can do that.")
                         (rest)
                         (to-state 'start))
                       (combine
                         (answer "You are too tired for that")
                         (depress)
                         (to-state 'start)))))))

(register-state
  'start
  (state "Hi, game starts"
         (list (cons "Start game"
                     (combine
                       (answer "Let's start, then. You are getting tired.")
                       (tire)
                       (to-state 'beginning)))
               (cons "Quit game"
                     (answer "Good bye!")))
         #:hide-status))

((to-state 'start))