blob: b59c5c9ad90f38313cb039eccf69594917a6640c (
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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
; 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))))))
;; 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))))
;; 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:
;; 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.")
(to-state 'start))
(combine
(answer "You are too tired for that")
(to-state 'start)))))))
(register-state
'start
(state "Hi, game starts"
(list (cons "Start game"
(combine
(answer "Let's start, then.")
(to-state 'beginning)))
(cons "Quit game"
(answer "Good bye!")))
#:hide-status))
((to-state 'start))
|
