feat: update
This commit is contained in:
parent
b591bc3ea8
commit
f36cdc10ef
3 changed files with 283 additions and 109 deletions
7
game.js
7
game.js
|
|
@ -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
377
game.scm
|
|
@ -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 (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)
|
(define (blod string)
|
||||||
`(b ,string))
|
`(b (@ (click ,(lambda (event)
|
||||||
(define ink-script '(
|
(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"))
|
`(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))
|
||||||
|
|
|
||||||
|
|
@ -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)
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue