aboutsummaryrefslogtreecommitdiff
path: root/demo/scaling.scm
blob: 982817a825a2d0c64df50435f4a9fc7515c02c15 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
(import scheme
        (chicken base)
        (prefix sdl2 "sdl2:")
        (prefix sdl2-ttf "ttf:")
        downstroke-engine
        downstroke-world
        downstroke-entity
        downstroke-input
        downstroke-renderer
        downstroke-assets)

;; Logical resolution: 320×240, displayed at 640×480 via scale: 2

(define +width+  320)
(define +height+ 240)
(define +box-size+ 16)
(define +speed+    2)

(define *game*
  (make-game
    title: "Demo: Scaling (2×)"
    width: +width+ height: +height+
    scale: 2

    create: (lambda (game)
      (game-scene-set! game
        (make-scene
          entities: (list (list #:type    'box
                                #:x       (/ +width+ 2)
                                #:y       (/ +height+ 2)
                                #:width   +box-size+
                                #:height  +box-size+
                                #:vx 0 #:vy 0
                                #:color   '(255 200 0)))
          tilemap:         #f
          camera:          (make-camera x: 0 y: 0)
          tileset-texture: #f
          camera-target:   #f
          background:      '(30 30 50)
          engine-update:   'none)))

    update: (lambda (game dt)
      (let* ((input (game-input game))
             (scene (game-scene game))
             (box   (car (scene-entities scene)))
             (vx (cond ((input-held? input 'left)  (- +speed+))
                       ((input-held? input 'right)    +speed+)
                       (else 0)))
             (vy (cond ((input-held? input 'up)    (- +speed+))
                       ((input-held? input 'down)     +speed+)
                       (else 0)))
             (nx (max 0 (min (- +width+ +box-size+)
                             (+ (entity-ref box #:x 0) vx))))
             (ny (max 0 (min (- +height+ +box-size+)
                             (+ (entity-ref box #:y 0) vy))))
             (box (entity-set (entity-set box #:x nx) #:y ny)))
        (game-scene-set! game
          (update-scene scene entities: (list box)))))

    render: (lambda (game)
      (let* ((renderer (game-renderer game))
             (scene    (game-scene game))
             (box      (car (scene-entities scene)))
             (bx (inexact->exact (floor (entity-ref box #:x 0))))
             (by (inexact->exact (floor (entity-ref box #:y 0)))))
        ;; Draw the colored box
        (set! (sdl2:render-draw-color renderer) (sdl2:make-color 255 200 0))
        (sdl2:render-fill-rect! renderer
          (sdl2:make-rect bx by +box-size+ +box-size+))
        ;; Draw a border around the logical viewport
        (set! (sdl2:render-draw-color renderer) (sdl2:make-color 100 100 100))
        (sdl2:render-draw-rect! renderer
          (sdl2:make-rect 0 0 +width+ +height+))
        ;; Draw crosshair at center
        (set! (sdl2:render-draw-color renderer) (sdl2:make-color 60 60 80))
        (sdl2:render-draw-line! renderer (/ +width+ 2) 0 (/ +width+ 2) +height+)
        (sdl2:render-draw-line! renderer 0 (/ +height+ 2) +width+ (/ +height+ 2))))))

(game-run! *game*)