# HG changeset patch # User Arne Babenhauserheide # Date 1676134573 -3600 # Sat Feb 11 17:56:13 2023 +0100 # Node ID 1ddee4ff40ef1f22db851d31108b442db711635c # Parent f95c55ad65f50db346154cf7be160e01435e71e8 implement textfiles-to-game.w, a simpler structure to create interactive stories more easily. diff --git a/dryads-wake.w b/dryads-wake.w --- a/dryads-wake.w +++ b/dryads-wake.w @@ -157,7 +157,7 @@ ,(first-encounter state) -define : read-line +ndefine : read-line sanitize-string let loop : : chars '() define char : read-char diff --git a/tests-textfile-input/welcome b/tests-textfile-input/welcome new file mode 100644 --- /dev/null +++ b/tests-textfile-input/welcome @@ -0,0 +1,13 @@ +Robert +Arne + +Robert +It would be nice to be able to turn stories into playable websites + +Arne +I hope this works for you! + +Read again? +welcome +Exit? +exit diff --git a/textfiles-to-game-footer.w b/textfiles-to-game-footer.w new file mode 100644 --- /dev/null +++ b/textfiles-to-game-footer.w @@ -0,0 +1,71 @@ +;; are we running as webserver? +define running-as-webserver #f + +define : exit state + Print + You reached the end of the story + that is already written. + Please come back with our next release. + + +define : help args + format : current-output-port + . "~a [-i] [--help | --version | --test | --server [host]]\n" + first args + +define %this-module : current-module +define : test scene + define state : game-state-init! + ;; analyze the plot + define : module->filename mod + string-append + string-join : map symbol->string : module-name mod + . "/" + . ".w" + pretty-print + analyze : list : module->filename %this-module + set-speed-extremely-fast! + when scene + (eval (string->symbol scene) %this-module ) state + +define : final-action? args + ;; abuse revealed-count for speed scaling + set-speed-normal! + if {(length args) > 1} + cond + : equal? "--help" : second args + help args + . #t + : equal? "--version" : second args + format : current-output-port + . "~a\n" version + . #t + : equal? "--test" : second args + test : if {(length args) > 2} (third args) #f + . #t + : member (second args) '("--servertest" "--server") + set! running-as-webserver #t + as-webserver + λ : + welcome : game-state-init! + Print + "" + Reload this website to play again. + ;; to set your own static site instead of websocket.static-response add + ;; . #:static-response "" + . #t + : equal? "--scene" : second args + apply + module-ref %this-module + string->symbol : third args + list : game-state-init! + . #t + else #f + . #f + + +define : main args + when : not : final-action? args + welcome : game-state-init! + +;; for emacs (progn (defun test-this-file () (interactive) (save-current-buffer) (async-shell-command (concat (buffer-file-name (current-buffer)) " --test"))) (local-set-key (kbd "") 'test-this-file)(defun analyze-plot () (interactive) (save-current-buffer) (async-shell-command (concat "./analyze-plot.w " (buffer-file-name (current-buffer))))) (local-set-key (kbd "") 'analyze-plot)) diff --git a/textfiles-to-game-header.w b/textfiles-to-game-header.w new file mode 100644 --- /dev/null +++ b/textfiles-to-game-header.w @@ -0,0 +1,36 @@ +#!/usr/bin/env bash +# -*- wisp -*- +# ensure that (language wisp) is pre-compiled +if ! guile -L $(dirname $(realpath "$0")) -C $(dirname $(realpath "$0")) --language=wisp -c '' 2>/dev/null; then + guile -L $(dirname $(realpath "$0")) -C $(dirname $(realpath "$0")) -c '(import (language wisp spec))' >/dev/null 2>&1 +fi +# run textfiles-game as module to ensure it is used pre-compiled +if [[ "$1" == "--server" ]]; then + exec -a "$0" guile -L $(dirname $(realpath "$0")) -C $(dirname $(realpath "$0")) --language=wisp -x .w -e '(textfiles-game)' -c '' "${@}" +else + exec -a "$0" guile -L $(dirname $(realpath "$0")) -C $(dirname $(realpath "$0")) --language=wisp -x .w -e '(textfiles-game)' -c '' "${@}" # 2>/dev/null +fi +; !# + +;; no declarative modules because we change bindings. +eval-when (expand) : false-if-exception : user-modules-declarative? #f + +define-module : textfiles-game + . #:export : main + . #:declarative? #f + +import + only (srfi srfi-19) current-date date->string string->date date->time-utc time-utc->date + . make-time time-utc time-duration add-duration current-time + only (srfi srfi-9) define-record-type + only (srfi srfi-11) let-values + only (ice-9 pretty-print) pretty-print + only (ice-9 format) format + only (srfi srfi-1) first second third alist-cons assoc lset<= lset-intersection lset-difference remove drop + only (ice-9 ftw) scandir + doctests + enter + only (d6) roll check + only (names) first-names last-names + only (game-helpers) game-state game-state-scene game-state-scene-set! game-state-init! game-state-key game-state-key-set! game-state-key-equal? game-state-things game-state-things-contains? game-state-things-add-one! game-state-things-remove-one! game-state-id game-state-id-set! game-state-name game-state-name-set! name->id define-scene profile-ability-score describe-ability-score make-profile state-profile state-profile-key-set! score->description increase-ability-probabilistic challenge save-state load-state game-states uniquify-id game-state-outcomes-contains? game-state-outcomes-add! game-state-outcomes-remove! define-outcome state-profile-wounds-add! state-profile-wounds-cure! as-webserver make-secret game-state-secret game-state-secret-set! sanitize-string + only (analyze-plot) analyze diff --git a/textfiles-to-game.w b/textfiles-to-game.w new file mode 100755 --- /dev/null +++ b/textfiles-to-game.w @@ -0,0 +1,248 @@ +#!/usr/bin/env bash +# -*- wisp -*- +# This is a parser for a simplified format to enable basic usage of enter.w for more people. +# Just write multiple files in one folder, each starting with one line per person to enter, +# then an empty line, then blocks starting with the person and then lines of text. +# In the last block have alternating lines with question and the next filename to switch to. +# Switching to the filename exit ends the game. +# Example: +# --- welcome +# Robert +# Arne +# +# Robert +# It would be nice to be able to turn stories into playable websites +# +# Arne +# I hope this works for you! +# +# Read again? +# welcome +# Exit? +# exit + +# ensure that (language wisp) is pre-compiled +if ! guile -L $(dirname $(realpath "$0")) -C $(dirname $(realpath "$0")) --language=wisp -c '' 2>/dev/null; then + guile -L $(dirname $(realpath "$0")) -C $(dirname $(realpath "$0")) -c '(import (language wisp spec))' >/dev/null 2>&1 +fi +# run textfiles-to-game as module to ensure it is used pre-compiled +if [[ "$1" == "--server" ]]; then + exec -a "$0" guile -L $(dirname $(realpath "$0")) -C $(dirname $(realpath "$0")) --language=wisp -x .w -e '(textfiles-to-game)' -c '' "${@}" +else + exec -a "$0" guile -L $(dirname $(realpath "$0")) -C $(dirname $(realpath "$0")) --language=wisp -x .w -e '(textfiles-to-game)' -c '' "${@}" # 2>/dev/null +fi +; !# + +;; no declarative modules because we change bindings. +eval-when (expand) : false-if-exception : user-modules-declarative? #f + +define-module : textfiles-to-game + . #:export : main + . #:declarative? #f + +import : only (srfi :1) first second remove drop + only (srfi srfi-9) define-record-type + ice-9 ftw + ice-9 match + only (ice-9 rdelim) read-delimited + doctests + only (ice-9 optargs) define* + only (ice-9 rdelim) read-line + only (srfi :26) cut + +define* : map-over-lines/port fun port #:key (terminator eof-object?) + define terminator? + if : or (procedure? terminator) (macro? terminator) + . terminator + cut equal? terminator <> + let loop : (lines '()) (line (read-line port)) + if : or (terminator? line) (eof-object? line) + begin + reverse! lines + loop + cons : fun line + . lines + read-line port + +define just-files + ;; Remove the `stat' object the `file-system-tree' provides + ;; for each file in the tree. + match-lambda + : name stat ; flat file + . name + : name stat children ... ; directory + map just-files children + else '() + +define : list-files folder + ## + tests + test-equal '("tests-textfile-input/welcome") + list-files "tests-textfile-input" + map : λ(c) : string-join (list folder c) file-name-separator-string + remove list? : just-files : file-system-tree folder + +define-record-type + make-scenefile enter content choose + . scenefile? + enter scenefile-enter + content scenefile-content + choose scenefile-choose + + +define : parse-file filename + ## + tests + test-equal + make-scenefile + ' "Robert" "Arne" + ' + "Robert" "It would be nice to be able to turn stories into playable websites" + "Arne" "I hope this works for you!" + ' "Read again?" "welcome" "Exit?" "exit" + parse-file "tests-textfile-input/welcome" + define port : open-input-file filename + define enter + map-over-lines/port identity port #:terminator "" + define choices #f + define content + let loop : (blocks '()) + define block : map-over-lines/port identity port #:terminator "" + cond + : and (null? block) (null? blocks) + ' + : null? block + set! choices : car blocks + reverse! : cdr blocks + else : loop : cons block blocks + if choices ; good file + make-scenefile enter content choices + . #f + +define : format-enter people + ## + tests + test-equal " Enter + Robert + Arne +" + format-enter + ' "Robert" "Arne" + format #f " Enter\n~a\n" + string-join + map : λ(name) : string-append " " name + . people + . "\n" + +define : format-one-paragraph paragraph + ## + tests + test-equal " Robert + It would be nice to be able to turn stories into playable websites. + I mean it. +" + format-one-paragraph + list "Robert" + . "It would be nice to be able to turn stories into playable websites." + . "I mean it." + define person : car paragraph + define lines : cdr paragraph + format #f " ~a\n~a\n" person + string-join + map : λ(line) : string-append " " line + . lines + . "\n" + +define : format-choose questions-and-answers + ## + tests + test-equal " Choose + : Read again? + ,(welcome state) + : Exit? + ,(exit state) +" + format-choose + ' "Read again?" "welcome" "Exit?" "exit" + when : not : zero? : modulo (length questions-and-answers) 2 + error "The lines of questions and answers must be a multiple of two, but the length is ~a" : length questions-and-answers + format #f " Choose\n~a\n" + let loop : (lines '()) (qa questions-and-answers) + if : null? qa + string-join (reverse lines) "\n" + let + : question : format #f " : ~a" : first qa + answer : format #f " ,(~a state)" : second qa + loop : cons answer : cons question lines + drop qa 2 + + +define : format-scene scenename scenefile + ## + tests + test-equal "define-scene : welcome state + Enter + Robert + Arne + + Robert + It would be nice to be able to turn stories into playable websites + + Arne + I hope this works for you! + + Choose + : Read again? + ,(welcome state) + : Exit? + ,(exit state) +" + format-scene "welcome" + parse-file "tests-textfile-input/welcome" + define c + format #f "define-scene : ~a state\n~a\n~a\n~a" + . scenename + format-enter : scenefile-enter scenefile + string-join : map format-one-paragraph : scenefile-content scenefile + . "\n" + format-choose : scenefile-choose scenefile + + +define : convert folder + define header : read-delimited "" : open-input-file "textfiles-to-game-header.w" + define footer : read-delimited "" : open-input-file "textfiles-to-game-footer.w" + define filenames + list-files folder + define contents + map parse-file filenames + define scenenames + map basename filenames + string-join + append : list header + map format-scene scenenames contents + list footer + . "\n\n" + + +define : help args + format #t "~a \n\nthis writes into a file named textfiles-game.w" : car args + +define %this-module : current-module +define : test args + doctests-testmod %this-module + + +define : main args + cond + : null? : cdr args + help args + : member "--help" args + help args + : member "--test" args + test args + else + with-output-to-port : open-output-file "textfiles-game.w" + λ () : display : convert : second args + chmod "textfiles-game.w" #o700 + +;; for emacs (progn (defun test-this-file () (interactive) (save-current-buffer) (async-shell-command (concat (buffer-file-name (current-buffer)) " --test"))) (local-set-key (kbd "") 'test-this-file)(defun analyze-plot () (interactive) (save-current-buffer) (async-shell-command (concat "./analyze-plot.w textfiles-game.w"))) (local-set-key (kbd "") 'analyze-plot))