summaryrefslogtreecommitdiff
path: root/depre/main.scm
blob: 81bdb0321c8e67c50120aee0177cdebb872aacb3 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
; https://xn--rpa.cc/irl/term.html
(define-module (depre main))

;; 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))))))

;; Simple I/O
(define (answer message)
  (lambda ()
    (display message)
    (newline)))

(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))


;; 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)))
      (if (and (number? chosen) (<= chosen (length menu)))
        ((cdr (nth chosen menu)))
        (begin
          (display "Wrong answer. Try again >  ")
          (loop (read)))))))

;; States:
(define start
  (state "Hi, game starts"
         (list (cons "Start game"
                     (combine
                       (answer "Let's start, then.")
                       (state "heading"
                              (list (cons "hola"  (lambda () (display "HOLA")))
                                    (cons "adios" (lambda () (display "adios")))))))
               (cons "Quit game"
                     (answer "Good bye!")))
         #:hide-status))

(start)