foss-mmo/game.scm

94 lines
2.9 KiB
Scheme
Raw Normal View History

2024-05-17 13:08:43 -04:00
;;; Copyright (C) 2024 David Thompson <dave@spritely.institute>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; Commentary:
;;;
;;; Example game showing off several common game programming things.
;;;
;;; Code:
(use-modules (dom canvas)
(dom document)
(dom element)
(dom event)
(dom image)
(dom media)
(dom window)
(hoot ffi)
(hoot hashtables)
(ice-9 match)
(math)
(math rect)
(math vector))
(define game-width 320.0)
(define game-height 240.0)
(define tile-width 16.0)
(define tile-height 16.0)
(define image:tiles (make-image "assets/images/cirkoban.png"))
2024-05-17 13:08:43 -04:00
(define dt (/ 1000.0 60.0)) ; aim for updating at 60Hz
(define (update)
#t
2024-05-17 13:08:43 -04:00
(timeout update-callback dt))
(define update-callback (procedure->external update))
;; Rendering
(define number->string*
(let ((cache (make-eq-hashtable))) ; assuming fixnums only
(lambda (x)
(or (hashtable-ref cache x)
(let ((str (number->string x)))
(hashtable-set! cache x str)
str)))))
(define (draw prev-time)
(set-fill-color! context "#140c1c")
(fill-rect context 0.0 0.0 game-width game-height)
(set-fill-color! context "#ffffff")
(set-font! context "bold 24px monospace")
(set-text-align! context "left")
(fill-text context "HELLO" 16.0 36.0)
(draw-image context image:tiles
0.0 0.0 tile-width tile-height
100.0 100.0 tile-width tile-height)
2024-05-17 13:08:43 -04:00
(request-animation-frame draw-callback))
(define draw-callback (procedure->external draw))
;; Input
(define key:left "ArrowLeft")
(define key:right "ArrowRight")
(define key:confirm "Enter")
(define (on-key-down event)
(let ((key (keyboard-event-code event)))
(pk 'key-down key)))
2024-05-17 13:08:43 -04:00
(define (on-key-up event)
(let ((key (keyboard-event-code event)))
(pk 'key-up key)))
2024-05-17 13:08:43 -04:00
;; Canvas and event loop setup
(define canvas (get-element-by-id "canvas"))
(define context (get-context canvas "2d"))
(set-element-width! canvas (inexact->exact game-width))
(set-element-height! canvas (inexact->exact game-height))
2024-05-17 13:08:43 -04:00
(add-event-listener! (current-document) "keydown"
(procedure->external on-key-down))
(add-event-listener! (current-document) "keyup"
(procedure->external on-key-up))
(request-animation-frame draw-callback)
(timeout update-callback dt)