From f36cdc10efb08ecf428ea1a56c94b46edd04e296 Mon Sep 17 00:00:00 2001 From: SouthFox Date: Mon, 4 Nov 2024 05:40:57 +0800 Subject: [PATCH] feat: update --- game.js | 7 +- game.scm | 377 ++++++++++++++++++++++++++++++++++------------- modules/math.scm | 8 +- 3 files changed, 283 insertions(+), 109 deletions(-) diff --git a/game.js b/game.js index 1ed01c8..d6140f2 100644 --- a/game.js +++ b/game.js @@ -70,7 +70,12 @@ window.addEventListener("load", async () => { setImageSmoothingEnabled: (ctx, enabled) => ctx.imageSmoothingEnabled = (enabled == 1) }, math: { - random: () => Math.random() + randomInt: (max) => { + const minCeiled = Math.ceil(0); + const maxFloored = Math.floor(max); + return Math.floor(Math.random() * (maxFloored - minCeiled + 1) + minCeiled); + // return Math.random(); + } } } }); diff --git a/game.scm b/game.scm index 133bacd..48fccb7 100644 --- a/game.scm +++ b/game.scm @@ -28,31 +28,10 @@ (hoot debug) (hoot hashtables) (srfi srfi-9) - (ice-9 match)) + (ice-9 match) + (math)) -(define *template* '()) -(define (wrap-template template) - `(div (@ (id "container")) - (button (@ (click ,(lambda (event) - (set! *template* template-click) - (render)))) - "Click") - (button (@ (click ,(lambda (event) - (set! *template* template-task) - (render)))) - "Task") - (button (@ (click ,(lambda (event) - (set! *template* template-ascii-art) - (render)))) - "Ascii art") - (div (@ (id "application")) ,(template)))) - -(define (render) - (let ((old (get-element-by-id "container"))) - (unless (external-null? old) (remove! old)) - (append-child! (document-body) (sxml->dom (wrap-template *template*))))) - (define (sxml->dom exp) (match exp ;; The simple case: a string representing a text node. @@ -93,63 +72,6 @@ (children (add-children children))) elem)))) -;; Click -(define *clicks* 0) -(define (template-click) - `(div - (p ,(number->string *clicks*) " clicks") - (button (@ (click ,(lambda (event) - (set! *clicks* (+ *clicks* 1)) - (render)))) - "Click me!"))) - -;; Task -(define-record-type - (make-task name done?) - task? - (name task-name) - (done? task-done? set-task-done!)) - -(define *tasks* '()) -(define (add-task! task) - (set! *tasks* (cons task *tasks*))) -(define (remove-task! task) - (set! *tasks* (delq task *tasks*))) - -(define (template-task) - (define (task-template task) - `(li (input (@ (type "checkbox") - (change ,(lambda (event) - (let* ((checkbox (event-target event)) - (checked? (element-checked? checkbox))) - (set-task-done! task checked?) - (render)))) - (checked ,(task-done? task)))) - (span (@ (style "padding: 0 1em 0 1em;")) - ,(if (task-done? task) - `(s ,(task-name task)) - (task-name task))) - (a (@ (href "#") - (click ,(lambda (event) - (remove-task! task) - (render)))) - "remove"))) - `(div - (h2 "Tasks") - ;; Tasks are stored in reverse order. - (ul ,@(map task-template (reverse *tasks*))) - (input (@ (id "new-task") - (placeholder "Write more task"))) - ;; Add new task on click - (button (@ (click ,(lambda (event) - (let* ((input (get-element-by-id "new-task")) - (name (element-value input))) - (unless (string=? name "") - (add-task! (make-task name #f)) - (set-element-value! input "") - (render)))))) - "Add task"))) - ;; Lib (define (sub-string-list string-list start len func) (define (sub-string-list-iter string-list start len func part) @@ -212,30 +134,257 @@ func) (cdr update-list))))) -;; render ascii art -(define (template-ascii-art) +;; render +(define *template* '()) +(define (wrap-template template) + `(div (@ (id "container")) + (div + (span ,(number->string *wood*) " wood ") + (span ,(number->string *stone*) " stone ") + (span ,(number->string *seed*) " seed ")) + (button (@ (click ,(lambda (event) + (set! *template* template-map) + (render)))) + "Map") + (div (@ (id "application")) ,(template)))) + +(define (render) + (let ((old (get-element-by-id "container"))) + (unless (external-null? old) (remove! old)) + (append-child! (document-body) (sxml->dom (wrap-template *template*))))) + +;; woods +(define *gather* #f) +(define (template-woods) + (define wood-script '( + " 888888888/' 888888888/' " + " 88\\*888;*/88 888888888/' 88\\*888;*/88 " + "888'\\*88|/8888 88\\*888;*/88 888'\\*88|/8888" + "8888{888}88_/8 888'\\*88|/8888 8888{888}88_/8 " + "88\\88\\. /_'88 8888{888}88_/8 88\\88\\. /_'88 " + " \\_} { 88\\88\\. /_'88 \\_} { " + " { } \\_} { { } " + " } { { } } { " + " { } } { o { } " + "_o__//..\\\\____O______{ }______|_____//..\\\\_ " + " //..\\\\ " + )) + `(pre ,(string-append (string-join wood-script "\n") "\n") + ,(if *gather* + `(button (@ (click ,(lambda (event) + (set! *gather* #f) + (render)))) + "Stop gather") + `(button (@ (click ,(lambda (event) + (set! *gather* #t) + (render)))) + "Start gather")))) + +;; Map +(define (template-map) (define (blod string) - `(b ,string)) - (define ink-script '( - "(\\ " - "\\'\\ " - " \\'\\ __________ " - " / '| ()_________) " - " \\ '/ \\ ~~~~~~~~ \\ " - " \\ \\ ~~~~~~ \\ " - " ==). \\__________\\ " - " (__) ()__________) " + `(b (@ (click ,(lambda (event) + (set! *template* template-woods) + (render))) + (style "cursor: pointer;") + (title "Woods")) + ,string )) + (define (farm string) + `(b (@ (click ,(lambda (event) + (set! *template* template-farm) + (render))) + (style "cursor: pointer;") + (title "Farm")) + ,string )) + (define map-script '( + "______________________________________" + "| 88 88 88 88 |" + "|8888 88 8888 8888 88888 |" + "| || 8888 || || || |" + "| || 88 88 88 |" + "| 8888 8888 88888 88888 |" + "| || || || || |" + "| |" + "| |" + "| |" + "| _ |" + "| /%\\ |" + "| | | |" + "| |" + ":____________________________________:" )) - `(pre ,@(gen-string-list (list (string-join ink-script "\n")) - (gen-update-list - (find-string-list-len (list (string-join ink-script "\n"))) 1 1 10 5) - blod))) + `(pre ,@(gen-string-list (gen-string-list (list (string-join map-script "\n")) + (gen-update-list + (find-string-list-len (list (string-join map-script "\n"))) 1 1 36 6) + blod) + (gen-update-list + (find-string-list-len (list (string-join map-script "\n"))) 29 10 3 3) + farm))) + +;; Plant +(define-record-type + (make-plant name time watering?) + plant? + (name plant-name) + (time plant-time set-plant-time!) + (watering? plant-watering? set-plant-watering!)) + +(define *plants* '()) +(define (add-plant! plant) + (set! *plants* (cons plant *plants*))) +(define (remove-plant! plant) + (set! *plants* (delq plant *plants*))) + +(define (template-plant) + (define (plant-template plant) + `(li + (span (@ (style "padding: 0 1em 0 1em;")) + ,(string-append (plant-name plant) " "(number->string (plant-time plant)))) + ,(if (plant-watering? plant) + `(span "") + (if *well-build?* + `(a (@ (href "#") + (click ,(lambda (event) + (set-plant-time! plant (ceiling (/ (plant-time plant) 2))) + (set-plant-watering! plant #t) + (render)))) "watering ") + `(span ""))) + (a (@ (href "#") + (click ,(lambda (event) + (remove-plant! plant) + (render)))) + ,(if (= 0 (plant-time plant)) + "gather " + "remove ")))) + (define (plant) + (list-ref '("๐Ÿ†" "๐Ÿฅ”" "๐Ÿฅ•" "๐ŸŒฝ" "๐ŸŒถ๏ธ" "๐Ÿซ‘" "๐Ÿฅ’" "๐Ÿฅฌ" "๐Ÿฅฆ" "๐Ÿง„" "๐Ÿง…" "๐Ÿฅœ" "๐Ÿซ˜" "๐ŸŒฐ" "๐Ÿซš" "๐Ÿซ›" "๐Ÿ„โ€" + "๐ŸŽƒ" "๐ŸŽƒ" "๐ŸŽƒ" "๐ŸŽƒ" "๐ŸŽƒ" "๐ŸŽƒ" "๐ŸŽƒ" "๐ŸŽƒ" "๐ŸŽƒ" "๐ŸŽƒ" "๐ŸŽƒ" "๐ŸŽƒ" "๐ŸŽƒ" "๐ŸŽƒ" "๐ŸŽƒ" "๐ŸŽƒ" "๐ŸŽƒ" ) (random-int 34))) + `(div + (h2 "Fields") + (ul ,@(map plant-template (reverse *plants*))) + ,(if *fields-clean?* + `(button (@ (click ,(lambda (event) + (when (> *seed* 0) + (set! *seed* (- *seed* 1)) + (add-plant! (make-plant (plant) (+ 300 (random-int 300)) #f)) + (render))))) + "Plant") + `(button (@ (click ,(lambda (event) + (when (and (> *wood* 30) (> *stone* 10)) + (set! *wood* (- *wood* 30)) + (set! *stone* (- *wood* 10)) + (set! *seed* (+ *seed* 7)) + (set! *fields-clean?* #t) + (render))))) + "Clear the fields (wood x30 stone x10)") + ))) + +(define *workshop-clean?* #f) +(define *cart-build?* #f) +(define *reaping-hook-build?* #f) +(define *well-build?* #f) +(define (template-workshop) + `(div + (h2 "Workshop") + ,(if *workshop-clean?* + `(ul + (li + ,(if *cart-build?* + `(span "Cart") + `(button (@ (click ,(lambda (event) + (when (> *wood* 100) + (set! *wood* (- *wood* 100)) + (set! *cart-build?* #t) + (render))))) + "Cart (wood x100)"))) + (li + ,(if *reaping-hook-build?* + `(span "Reaping hook") + `(button (@ (click ,(lambda (event) + (when (and (> *wood* 20) (> *stone* 20)) + (set! *wood* (- *wood* 20)) + (set! *stone* (- *stone* 20)) + (set! *reaping-hook-build?* #t) + (render))))) + "Reaping hook (wood x20 stone x20)"))) + (li + ,(if *well-build?* + `(span "Well") + `(button (@ (click ,(lambda (event) + (when (and (> *wood* 50) (> *stone* 200)) + (set! *wood* (- *wood* 50)) + (set! *stone* (- *stone* 200)) + (set! *well-build?* #t) + (render))))) + "Well (wood x50 stone x200)")))) + `(button (@ (click ,(lambda (event) + (when (and (> *wood* 200) (> *stone* 50)) + (set! *wood* (- *wood* 200)) + (set! *stone* (- *stone* 50)) + (set! *workshop-clean?* #t) + (render))))) + "Clear the workshop (wood x200 stone x50)")))) + +;; Farm +(define (template-farm) + (define (blod string) + `(b (@ (click ,(lambda (event) + (set! *template* template-woods) + (render))) + (style "cursor: pointer;") + (title "Woods")) + ,string )) + (define map-script '( + " __ " + " ,-_ (` ). " + " |-_'-, ( ). " + " |-_'-' _( '`. " + " _ |-_'/ .=(`( . )" + " /;-,_ |-_' ( (.__.:-`-_.' " + " /-.-;,-,___|' `( ) ) " + " /;-;-;-;_;_/|\\_ _ _ _ _ ` __.:' ) " + " x_( __`|_P_|`-;-;-;,| `--' " + " |\\ \\ _|| `-;-;-' " + " | \\` -_|. '-' " + " | / /-_| ` " + " |/ ,'-_| \\ " + " /____|'-_|___\\ " + " _..,____]__|_\\-_'|_[___,.._ " + " ' ``'--,..,. " + " " + " :--:---:---:---:---:---:--: " + " | #.|%& #.|%& #.|%& #.|%& | " + " | #.|%& #.|%& #.|%& #.|%& | " + " | #.|%& #.|%& #.|%& #.|%& | _ " + " | #.|%& #.|%& #.|%& #.|%& | (O) " + " | #.|%& #.|%& #.|%& #.|%& | ยจ " + " | #.|%& #.|%& #.|%& #.|%& | " + " | #.|%& #.|%& #.|%& #.|%& | " + " | #.|%& #.|%& #.|%& #.|%& | " + " | #.|%& #.|%& #.|%& #.|%& | " + " :--:---:---:---:---:---:--: " + )) + `(pre ,(string-append (string-join map-script "\n") "\n") + ,(template-plant) + ,(template-workshop))) + ;; Main -(set! *template* template-task) +(set! *template* template-map) + +(define *wood* 0) +(define *stone* 0) +(define *seed* 0) +(define *fields-clean?* #f) +(define (template-main) + `(div + (span ,(number->string *wood*) " wood ") + (span ,(number->string *stone*) " stone ") + (span ,(number->string *seed*) " seed "))) (define *update-list* '()) -(define dt (/ 1000.0 60.0)) + +(define dt 1000.0) (define-record-type (make-timeout-function interval countdown func) @@ -244,20 +393,40 @@ (countdown timeout-function-countdown set-timeout-function-countdown!) (func timeout-function-func)) -(define (plus-clicks) - (set! *clicks* (+ *clicks* 1))) +(define *cart-build?* #f) +(define *reaping-hook-build* #f) +(define (plus-res) + (if *gather* + (begin + (if *cart-build?* + (set! *wood* (+ *wood* 12)) + (set! *wood* (+ *wood* 5))) + (if *cart-build?* + (set! *stone* (+ *stone* 7)) + (set! *stone* (+ *stone* 3))) + (if *reaping-hook-build?* + (when (> 30 (random-int 100)) + (set! *seed* (+ *seed* 1))) + (when (> 5 (random-int 100)) + (set! *seed* (+ *seed* 1))))))) -(set! *update-list* (append *update-list* (list (make-timeout-function 60 60 plus-clicks)))) +(define (update-plant-time) + (for-each (lambda (i) + (unless (= (plant-time i) 0) + (set-plant-time! i (- (plant-time i) 1)) + (render))) + *plants*)) + +(set! *update-list* (append *update-list* (list (make-timeout-function 1 1 plus-res)))) +(set! *update-list* (append *update-list* (list (make-timeout-function 1 1 update-plant-time)))) (define (update) (for-each (lambda (i) - (dprint "countdown" (timeout-function-countdown i)) (if (= (timeout-function-countdown i) 0) (begin ((timeout-function-func i)) (set-timeout-function-countdown! i (timeout-function-interval i)) - (if (equal? *template* template-click) - (render))) + (render)) (set-timeout-function-countdown! i (- (timeout-function-countdown i) 1)))) *update-list*) (timeout update-callback dt)) diff --git a/modules/math.scm b/modules/math.scm index d1f6529..1eb2f88 100644 --- a/modules/math.scm +++ b/modules/math.scm @@ -22,11 +22,11 @@ #:pure #:use-module (scheme base) #:use-module (hoot ffi) - #:export (random clamp)) + #:export (random-int clamp)) -(define-foreign random - "math" "random" - -> f64) +(define-foreign random-int + "math" "randomInt" + i32 -> i32) (define (clamp x min max) (cond ((< x min) min)