diff options
Diffstat (limited to 'depre/main.scm')
| -rw-r--r-- | depre/main.scm | 397 |
1 files changed, 0 insertions, 397 deletions
diff --git a/depre/main.scm b/depre/main.scm deleted file mode 100644 index 09f6418..0000000 --- a/depre/main.scm +++ /dev/null @@ -1,397 +0,0 @@ -; https://xn--rpa.cc/irl/term.html -(define-module (depre main) - #:use-module (ice-9 textual-ports)) - -;; Clean indentation from strings -(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)) |