diff options
Diffstat (limited to 'wake-up.scm')
| -rw-r--r-- | wake-up.scm | 398 |
1 files changed, 398 insertions, 0 deletions
diff --git a/wake-up.scm b/wake-up.scm new file mode 100644 index 0000000..4eb38ad --- /dev/null +++ b/wake-up.scm @@ -0,0 +1,398 @@ +; https://xn--rpa.cc/irl/term.html +(define-module (depre main) + #:use-module (ice-9 textual-ports)) + +;; Clean indentation from strings +(eval-when (expand load eval) + (read-enable 'hungry-eol-escapes)) + +;; Random seed +(set! *random-state* (random-state-from-platform)) + +;; 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 40 max-100)) +(define *tiredness* (make-parameter 40 max-100)) +(define *day* (make-parameter 1)) + +;; Show days passed on exit +(sigaction SIGINT + (lambda (sig) + (newline) + (display "---------------------------") + (newline) + (display "Exiting game.") + (newline) + (display (string-append "Days played: " (number->string (*day*)))) + (newline) + (newline) + (display "This game tries to show the internal dialog of a \ + depressed person that is alone at home, working as a \ + freelance, on a phd or any job that allows to work on \ + an independent way.\n\ + Somehow, it tries to express the life of those who \ + suffer in silence, alone in their caves. Hopefully, \ + this game made you empathize with them. \n\ + If you feel identified by what it is shown here, it \ + might be time to review your internal dialog and treat \ + yourself better. You deserve to be loved.\n") + (newline) + (display "Thanks for playing.") + (newline) + (exit))) + +(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 +;; NOTE: The functions try with 120 to leave some chance to randomness even if +;; you are tired or depressed to the limit +(define (f-or-tired f tired) + (lambda () + (if (< (random 120) (*tiredness*)) (f) (tired)))) + +(define (f-or-depressed f depressed) + (lambda () + (if (< (random 120) (*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)))) + +(define (tire+) + (lambda () (*tiredness* (+ (*tiredness*) 8)))) + +(define (rest+) + (lambda () (*tiredness* (- (*tiredness*) 8)))) + +(define (depress+) + (lambda () (*depression* (+ (*depression*) 8)))) + +(define (cheer-up+) + (lambda () (*depression* (- (*depression*) 8)))) + +(define (next-day) + (lambda () (*day* (+ 1 (*day*))))) + +;; 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 (day-banner) + (lambda () + (newline) + (display "---------------------------") + (newline) + (display (string-append "Day " (number->string (*day*)))) + (newline))) + +(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 + 'start + (state "Hi, game starts" + (list + (cons "Start game" + (combine + (answer "Let's start, then. Press [ENTER] to continue. \ + Press [Ctrl-C] and then [ENTER] to finish.") + (to-state 'wake-up))) + (cons "Quit game" + (answer "Good bye!"))) + #:hide-status)) + +(register-state + 'wake-up + (state "Good morning. It's time to wake up, what do you want to do?" + (list + (cons "Wake up and start your day." + (f-or-tired + (combine + (answer "You just woke up, had your shower, had some \ + breakfast and now you are ready for \ + anything.") + (cheer-up+) + (tire) + (to-state 'morning-1)) + (combine + (answer "You are too tired for waking up now. You \ + stay at bed instead and your day starts in \ + mid morning.") + (depress) + (rest) + (to-state 'morning-2)))) + + (cons "Stay in bed" + (combine + (answer "You rest for a little bit more, but you feel \ + bad because you have a hard time waking up \ + like a normal person.") + (depress) + (rest) + (to-state 'morning-2)))))) + +(register-state + 'morning-1 + (state "It's early in the morning. You have time to do whatever you want \ + right now. What do you want to do?" + (list + (cons "Work." + (f-or-tired + (combine + (answer "You worked for a couple of hours.") + (tire) + (to-state 'morning-2)) + (combine + (answer "You are too tired to work. You do nothing for a \ + couple of hours and you feel for wasting your time.") + (depress+) + (to-state 'morning-2)))) + + (cons "Relax." + (combine + (answer "You do nothing for a couple of hours and feel guilty \ + because you didn't work") + (depress) + (rest) + (to-state 'morning-2)))))) + +(register-state + 'morning-2 + (state "It's late in the morning. You still have some time before having \ + lunch. What do you want to do?" + (list + (cons "Work." + (f-or-depressed + (f-or-tired + (combine + (answer "You worked for a couple of hours.") + (tire) + (cheer-up) + (to-state 'lunch)) + (combine + (answer "You are too tired to work. You do nothing for a \ + couple of hours and you feel for wasting your time.") + (depress+) + (to-state 'lunch))) + (combine + (answer "It's almost time to have lunch... Maybe it's better \ + just to leave work for later.") + (depress) + (to-state 'lunch)))) + + (cons "Relax." + (combine + (answer "You do nothing for a couple of hours and feel guilty \ + because you didn't work") + (depress) + (rest+) + (to-state 'lunch)))))) + + +(register-state + 'lunch + (state "You have something for lunch. What do you want to do now?" + (list + (cons "Work." + (f-or-depressed + (f-or-tired + (combine + (answer "You worked for a couple of hours.") + (tire) + (to-state 'evening)) + (combine + (answer "You are too tired to work. You do nothing for a \ + couple of hours and you feel for wasting your time.") + (depress+) + (to-state 'evening))) + (combine + (answer "Work? What for? It's meaningless. Just let your life \ + pass while asking yourself why you are doing nothing.") + (depress) + (to-state 'evening)))) + + (cons "Relax." + (f-or-depressed + (combine + (answer "You do nothing for a couple of hours and feel guilty \ + because you didn't work") + (depress+) + (rest) + (to-state 'evening)) + (combine + (answer "You can't just relax. You are worthless if you don't \ + work.\ + You overwork and spend the whole afternoon working in \ + bad conditions.") + (tire+) + (to-state 'dinner))))))) + +(register-state + 'evening + (state "You still have some time until dinner. What do you want to do" + (list + (cons "Work" + (f-or-depressed + (combine + (answer "You work. It's late so it's really tiring and you have \ + a hard time concentrating.") + (tire+) + (to-state 'dinner)) + (combine + (answer "You work because what else you could do? There's \ + nothing else in your life.\ + You work in bad conditions and you skip dinner because \ + you are obsessed with your job.") + (depress) + (tire+) + (day-banner) + (to-state 'wake-up)))) + (cons "Relax at home." + (f-or-depressed + (combine + (answer "You relax at home. You stayed at home the whole day.") + (depress+) + (to-state 'dinner)) + (combine + (answer "You are bored, you play around with work related stuff \ + until it's time to have dinner.") + (tire) + (to-state 'dinner)))) + (cons "Go outside." + (f-or-depressed + (combine + (answer "You go outside for a walk.") + (cheer-up+) + (cheer-up) + (to-state 'dinner)) + (combine + (answer "It's already dark outside. You don't feel like going \ + outside. You wait doing nothing until dinner time.") + (depress) + (to-state 'dinner))))))) + +(register-state + 'dinner + (state "Time for dinner. What do you want to do afterwards?" + (list + (cons "Work" + (f-or-tired + (combine + (answer "You work for some time and then go to bed.") + (cheer-up) + (tire) + (next-day) + (day-banner) + (to-state 'wake-up)) + + (combine + (answer "You are too tired to work. You watch some TV and \ + feel bad about it.") + (depress) + (rest) + (next-day) + (day-banner) + (to-state 'wake-up)))) + (cons "Relax" + (f-or-depressed + (combine + (answer "You manage to relax watching a film. And go to bed \ + afterwards.") + (day-banner) + (to-state 'wake-up)) + (combine + (answer "You didn't work enough during the day and you want \ + to relax. You shouldn't. \ + You work until it's late and then go to bed.") + (tire+) + (depress) + (next-day) + (lambda () + (newline) + (display (string-append "Days " (number->string (*day*)))) + (newline)) + (to-state 'wake-up))))))) + +((to-state 'start)) |