blob: d854757892b96d9196f5a096f0a6a32354c5d3b3 (
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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
|
(import scheme
(chicken base)
(chicken format)
(chicken process-context)
(chicken condition)
(chicken pretty-print)
(srfi 1)
(srfi 12)
miscmacros
(prefix sdl2 "sdl2:")
(prefix sdl2-ttf "ttf:")
(prefix sdl2-image "img:")
tilemap)
(define +color-depth+ 32)
(define +screen-width+ 600)
(define +screen-height+ 400)
(define *fullscreen?* #f)
(define +background-color+ (sdl2:make-color 0 0 0))
(define +software-mode?+ (member "--software" (command-line-arguments)))
(define +vsync?+ (member "--vsync" (command-line-arguments)))
(sdl2:set-main-ready!)
(sdl2:init! '(video joystick))
(ttf:init!)
(img:init! '(png))
(on-exit sdl2:quit!)
;; Install a custom exception handler that will call quit! and then
;; call the original exception handler. This ensures that quit! will
;; be called even if an unhandled exception reaches the top level.
(current-exception-handler
(let ((original-handler (current-exception-handler)))
(lambda (exception)
(sdl2:quit!)
(original-handler exception))))
(if (and +vsync?+ (not +software-mode?+)) ; vsync doesn't work with software rendering
(sdl2:set-hint! 'render-vsync "1"))
(define *window* (sdl2:create-window! "MacroKnight"
'centered 'centered
+screen-width+ +screen-height+
(if *fullscreen?* '(fullscreen) '())))
;; (define *renderer*
;; (with-handlers [(lambda (c)
;; (display "Failed to initialise renderer")
;; (sdl2:create-renderer! *window* -1
;; '(software)))]
;; (sdl2:create-renderer! *window* -1
;; (if +software-mode?+ '(software) '(accelerated)))))
(define *renderer* (sdl2:create-renderer! *window* -1 '(accelerated)))
(define *font* (ttf:open-font "DejaVuSans.ttf" 12))
(define *text-color* (sdl2:make-color 255 255 255))
(pp (sdl2:num-joysticks))
(define *joystick* (if (> (sdl2:num-joysticks) 0)
(sdl2:joystick-open! 0)
#f))
(define *level* (load-tilemap "assets/level-0.tmx"))
(define *level-tileset-texture* (sdl2:create-texture-from-surface *renderer* (tileset-image (tilemap-tileset *level*))))
(define (draw-tile target tileset tile-id row-num col-num)
(let ((tile (tileset-tile tileset tile-id)))
(sdl2:render-copy! *renderer* *level-tileset-texture*
(tile-rect tile)
(sdl2:make-rect (* col-num (tileset-tileheight tileset))
(* row-num (tileset-tilewidth tileset))
(tileset-tilewidth tileset)
(tileset-tileheight tileset)))))
(define (draw-tilemap-rows draw-fn rows row-num)
(unless (null? rows)
(for-each (lambda (tile-id col-num) (draw-fn tile-id row-num col-num))
(car rows)
(iota (length (car rows))))
(draw-tilemap-rows draw-fn (cdr rows) (+ row-num 1))))
(define (draw-tilemap target tilemap)
(let ((map-layer (layer-map (list-ref (tilemap-layers tilemap) 0)))
(tileset (tilemap-tileset tilemap)))
(draw-tilemap-rows
(lambda (tile-id row-num col-num) (draw-tile target tileset tile-id row-num col-num))
map-layer
0)))
(set! (sdl2:render-draw-color *renderer*) +background-color+)
(sdl2:render-clear! *renderer*)
(let/cc exit-main-loop!
(while #t
(set! (sdl2:render-draw-color *renderer*) +background-color+)
(sdl2:render-clear! *renderer*)
(sdl2:pump-events!)
(while (sdl2:has-events?)
(let ((event (sdl2:make-event)))
(sdl2:poll-event! event)
(pp event)
(when (and (sdl2:keyboard-event? event)
(eq? (sdl2:event-type event) 'key-down)
(eq? (sdl2:keyboard-event-sym event) 'escape))
(exit-main-loop!))))
(draw-tilemap *renderer* *level*)
(sdl2:render-present! *renderer*)
(sdl2:delay! 10)))
(sdl2:joystick-close *joystick*)
(format #t "Bye!\n")
|
