is-you/game.scm

79 lines
2.1 KiB
Scheme
Raw Normal View History

2024-05-19 17:34:25 +02:00
(import (scheme base)
(scheme inexact)
(hoot ffi)
2024-05-20 16:37:08 +02:00
(hoot debug)
2024-05-19 17:34:25 +02:00
(dom canvas)
(dom document)
(dom element)
(dom event)
(dom image)
(dom media)
2024-05-20 16:37:08 +02:00
(dom window)
(console))
2024-05-19 17:34:25 +02:00
(define game-width 640.0)
(define game-height 480.0)
(define canvas (get-element-by-id "canvas"))
(define context (get-context canvas "2d"))
2024-05-20 17:05:28 +02:00
(define *element-x* (/ game-width 2.0))
2024-05-19 17:34:25 +02:00
;; Draw
(define (draw prev-time)
2024-05-20 17:05:28 +02:00
(clear-rect context 0.0 0.0 game-width game-height)
2024-05-19 17:34:25 +02:00
(set-fill-color! context "#140c1c")
(set-text-align! context "center")
(set-font! context "bold 24px monospace")
2024-05-20 17:05:28 +02:00
(fill-text context "Hello, World! :)" *element-x* (/ game-height 2.0))
2024-05-19 17:34:25 +02:00
(request-animation-frame draw-callback))
(define draw-callback (procedure->external draw))
(set-element-width! canvas (exact game-width))
(set-element-height! canvas (exact game-height))
(request-animation-frame draw-callback)
2024-05-20 16:37:08 +02:00
(dprint "game-height" game-height)
(console-log canvas)
2024-05-20 17:05:28 +02:00
;; Input
(define key:left "ArrowLeft")
(define key:right "ArrowRight")
(define (on-key-down event)
(let ((key (keyboard-event-code event)))
(cond
((string=? key key:left)
(dprint "key:" key)
(set! *element-x* (- *element-x* 10)))
((string=? key key:right)
(dprint "key:" key)
(set! *element-x* (+ *element-x* 10))))))
(add-event-listener! (current-document) "keydown"
(procedure->external on-key-down))
2024-05-26 04:40:54 +02:00
(define-record-type <gelement-type>
(make-gelement-type interact? image)
gelement-type?
(interact? gelement-interact?)
(image gelement-type-iamge))
(define-record-type <gelement>
(make-gelement type content)
gelement?
(type gelement-type)
(content gelement-content set-gelement-content!))
(define wall (make-gelement (make-gelement-type #f "wall") #nil))
(define apple (make-gelement (make-gelement-type #t "apple") #nil))
(define ppp (vector (vector apple wall wall apple wall)
(vector wall wall wall wall wall)
(vector apple wall wall wall wall)
(vector wall wall wall wall wall)
(vector wall wall wall wall wall)))