feat: update

This commit is contained in:
SouthFox 2024-11-04 05:40:57 +08:00
parent b591bc3ea8
commit f36cdc10ef
3 changed files with 283 additions and 109 deletions

View file

@ -70,7 +70,12 @@ window.addEventListener("load", async () => {
setImageSmoothingEnabled: (ctx, enabled) => ctx.imageSmoothingEnabled = (enabled == 1) setImageSmoothingEnabled: (ctx, enabled) => ctx.imageSmoothingEnabled = (enabled == 1)
}, },
math: { 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();
}
} }
} }
}); });

377
game.scm
View file

@ -28,31 +28,10 @@
(hoot debug) (hoot debug)
(hoot hashtables) (hoot hashtables)
(srfi srfi-9) (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) (define (sxml->dom exp)
(match exp (match exp
;; The simple case: a string representing a text node. ;; The simple case: a string representing a text node.
@ -93,63 +72,6 @@
(children (add-children children))) (children (add-children children)))
elem)))) 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 <task>
(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 ;; Lib
(define (sub-string-list string-list start len func) (define (sub-string-list string-list start len func)
(define (sub-string-list-iter string-list start len func part) (define (sub-string-list-iter string-list start len func part)
@ -212,30 +134,257 @@
func) func)
(cdr update-list))))) (cdr update-list)))))
;; render ascii art ;; render
(define (template-ascii-art) (define *template* '())
(define (blod string) (define (wrap-template template)
`(b ,string)) `(div (@ (id "container"))
(define ink-script '( (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 ,@(gen-string-list (list (string-join ink-script "\n")) `(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 (@ (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 (gen-string-list (list (string-join map-script "\n"))
(gen-update-list (gen-update-list
(find-string-list-len (list (string-join ink-script "\n"))) 1 1 10 5) (find-string-list-len (list (string-join map-script "\n"))) 1 1 36 6)
blod))) blod)
(gen-update-list
(find-string-list-len (list (string-join map-script "\n"))) 29 10 3 3)
farm)))
;; Plant
(define-record-type <plant>
(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 ;; 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 *update-list* '())
(define dt (/ 1000.0 60.0))
(define dt 1000.0)
(define-record-type <timeout-function> (define-record-type <timeout-function>
(make-timeout-function interval countdown func) (make-timeout-function interval countdown func)
@ -244,20 +393,40 @@
(countdown timeout-function-countdown set-timeout-function-countdown!) (countdown timeout-function-countdown set-timeout-function-countdown!)
(func timeout-function-func)) (func timeout-function-func))
(define (plus-clicks) (define *cart-build?* #f)
(set! *clicks* (+ *clicks* 1))) (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) (define (update)
(for-each (lambda (i) (for-each (lambda (i)
(dprint "countdown" (timeout-function-countdown i))
(if (= (timeout-function-countdown i) 0) (if (= (timeout-function-countdown i) 0)
(begin (begin
((timeout-function-func i)) ((timeout-function-func i))
(set-timeout-function-countdown! i (timeout-function-interval 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)))) (set-timeout-function-countdown! i (- (timeout-function-countdown i) 1))))
*update-list*) *update-list*)
(timeout update-callback dt)) (timeout update-callback dt))

View file

@ -22,11 +22,11 @@
#:pure #:pure
#:use-module (scheme base) #:use-module (scheme base)
#:use-module (hoot ffi) #:use-module (hoot ffi)
#:export (random clamp)) #:export (random-int clamp))
(define-foreign random (define-foreign random-int
"math" "random" "math" "randomInt"
-> f64) i32 -> i32)
(define (clamp x min max) (define (clamp x min max)
(cond ((< x min) min) (cond ((< x min) min)