basics.scm 8.28 KB
Newer Older
John Croisant's avatar
John Croisant committed
1 2 3
;; The contents of this demo file are made available under the CC0 1.0
;; Universal Public Domain Dedication. See LICENSE-CC0.txt or visit
;; http://creativecommons.org/publicdomain/zero/1.0/
4 5


John Croisant's avatar
John Croisant committed
6
;;; This is a demo program showing some basic SDL functionality.
7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
;;;
;;; This program demonstrates the following concepts:
;;;
;;; - Initializing SDL
;;; - Creating and configuring a window
;;; - Using a record type to manage game scene objects
;;; - Creating surfaces, rects, and colors
;;; - Filling a surface with a color
;;; - Blitting one surface onto another
;;; - Updating the window surface
;;; - A basic event loop that responds to user input.
;;;
;;; Controls:
;;;
;;; - Mouse click / drag: Move Smiley 1.
;;; - Arrow keys: Move Smiley 2.
;;; - Space: Randomize Smiley colors.
;;; - V: Toggle verbose printing of events to console.
;;; - Escape, Q, or close button: Quit
26

27

28 29 30 31 32 33 34 35 36 37 38
(cond-expand
  (chicken-4
   (use (prefix sdl2 sdl2:)
        miscmacros))
  (chicken-5
   (import (chicken condition)
           (chicken format)
           (rename (chicken random)
                   (pseudo-random-integer random))
           (prefix sdl2 sdl2:)
           miscmacros)))
39 40 41


;;; Initialize the parts of SDL that we need.
42
(sdl2:set-main-ready!)
John Croisant's avatar
John Croisant committed
43
(sdl2:init! '(video events joystick))
44

45 46 47 48 49 50 51 52 53 54 55 56
;; Automatically call sdl2:quit! when program exits normally.
(on-exit sdl2:quit!)

;; Call sdl2:quit! and then call the original exception handler if an
;; unhandled exception reaches the top level.
(current-exception-handler
 (let ((original-handler (current-exception-handler)))
   (lambda (exception)
     (sdl2:quit!)
     (original-handler exception))))


57 58 59
(printf "Compiled with SDL version ~A~N" (sdl2:compiled-version))
(printf "Running with SDL version ~A~N" (sdl2:current-version))
(printf "Using sdl2 egg version ~A~N" (sdl2:egg-version))
60 61 62



63
;;; Create a new window.
64
(define window
John Croisant's avatar
John Croisant committed
65
  (sdl2:create-window!
66 67 68 69
   "SDL Basics"                         ; title
   'centered  100                       ; x, y
   800  600                             ; w, h
   '(shown resizable)))                 ; flags
John Croisant's avatar
John Croisant committed
70

71 72
;;; Restrict the window from being made too small or too big, for no
;;; reason except to demonstrate this feature.
John Croisant's avatar
John Croisant committed
73 74
(set! (sdl2:window-maximum-size window) '(1024 768))
(set! (sdl2:window-minimum-size window) '(200 200))
75

John Croisant's avatar
John Croisant committed
76
(printf "Window position: ~A, size: ~A, max size: ~A, min size: ~A~N"
John Croisant's avatar
John Croisant committed
77 78 79 80
        (receive (sdl2:window-position window))
        (receive (sdl2:window-size window))
        (receive (sdl2:window-maximum-size window))
        (receive (sdl2:window-minimum-size window)))
John Croisant's avatar
John Croisant committed
81

82 83


84 85 86 87 88 89 90 91 92 93 94
;;; A record type for an object that has a surface and x/y coordinates
;;; representing the object's center.
(define-record-type obj
  (make-obj surface x y)
  obj?
  (surface obj-surface (setter obj-surface))
  (x       obj-x       (setter obj-x))
  (y       obj-y       (setter obj-y)))

;; Create rect the same size as obj's surface, centered on its x/y.
(define (obj-rect obj)
John Croisant's avatar
John Croisant committed
95 96 97
  (let ((w (sdl2:surface-w (obj-surface obj)))
        (h (sdl2:surface-h (obj-surface obj))))
    (sdl2:make-rect (- (obj-x obj) (/ w 2))
98 99 100 101 102 103
                   (- (obj-y obj) (/ h 2))
                   w
                   h)))

;;; Blit the obj's surface to the destination surface. The obj will be
;;; drawn centered on its x and y coordinates.
104
(define (draw-obj! obj dest)
John Croisant's avatar
John Croisant committed
105
  (sdl2:blit-surface! (obj-surface obj) #f dest (obj-rect obj)))
106 107 108 109 110



(define (make-random-color)
  ;; 50 is the minimum so that the color doesn't get too dark.
John Croisant's avatar
John Croisant committed
111
  (sdl2:make-color (+ 50 (random 175))
112 113 114 115 116 117
                  (+ 50 (random 175))
                  (+ 50 (random 175))
                  255))

;;; Make a new surface with a smiley face of the given color.
(define (make-smile-surf main-color)
John Croisant's avatar
John Croisant committed
118 119
  (let ((dest   (sdl2:make-surface 100 100 32))
        (shadow (sdl2:make-color 0 0 0 120)))
120
    ;; Draw the partially transparent black shadow
John Croisant's avatar
John Croisant committed
121
    (sdl2:fill-rect! dest (sdl2:make-rect 10 10 90 90) shadow)
122
    ;; Draw the head (using the main color)
John Croisant's avatar
John Croisant committed
123
    (sdl2:fill-rect! dest (sdl2:make-rect  0  0 90 90) main-color)
124 125
    ;; "Cut out" the eyes and mouth. Filling with a transparent color
    ;; replaces the alpha, it does not blend with the old color.
John Croisant's avatar
John Croisant committed
126 127 128 129 130 131
    (sdl2:fill-rects! dest
                     (list (sdl2:make-rect 25 20 10 20)
                           (sdl2:make-rect 55 20 10 20)
                           (sdl2:make-rect 15 50 10 10)
                           (sdl2:make-rect 25 60 40 10)
                           (sdl2:make-rect 65 50 10 10))
132
                     shadow)
133
    ;; Enable RLE for faster blitting.
John Croisant's avatar
John Croisant committed
134
    (sdl2:surface-rle-set! dest #t)
135 136 137
    dest))

;; Replace the object's surface with a new random color smiley face.
138
(define (randomize-smiley! obj)
139
  ;; Free the old surface. This is not strictly necessary, because
John Croisant's avatar
John Croisant committed
140
  ;; surfaces created with sdl2:make-surface are automatically garbage
141
  ;; collected. But freeing it immediately helps minimize garbage.
John Croisant's avatar
John Croisant committed
142
  (sdl2:free-surface! (obj-surface obj))
143 144 145 146 147 148 149 150 151 152 153 154 155 156 157

  ;; Now create and set the new surface.
  (set! (obj-surface obj) (make-smile-surf (make-random-color))))



;;; Create a couple smileys!
(define smiley1 (make-obj (make-smile-surf (make-random-color)) 300 300))
(define smiley2 (make-obj (make-smile-surf (make-random-color)) 500 300))



;;; Draw (or redraw) the entire scene. It would be more efficient to
;;; only redraw the parts of the scene that have changed, but since
;;; this is just a demo program we don't want to get too complex.
158
(define (draw-scene!)
John Croisant's avatar
John Croisant committed
159
  (let ((window-surf (sdl2:window-surface window)))
160
    ;; Clear the whole screen using a blue background color
John Croisant's avatar
John Croisant committed
161
    (sdl2:fill-rect! window-surf #f (sdl2:make-color 0 80 160))
162
    ;; Draw the smileys
163 164
    (draw-obj! smiley2 window-surf)
    (draw-obj! smiley1 window-surf)
165
    ;; Refresh the screen
John Croisant's avatar
John Croisant committed
166
    (sdl2:update-window-surface! window)))
167 168 169 170 171 172 173 174 175 176 177



;;; Simple event loop. It just repeats over and over (until the
;;; variable done is set to #t), getting a single event from SDL and
;;; then performing some actions depending on what kind of event it
;;; is. In a real program, your event loop would probably be more
;;; complex and better structured than this simple example.
(let ((done #f)
      (verbose? #f))
  (while (not done)
John Croisant's avatar
John Croisant committed
178
    (let ((ev (sdl2:wait-event!)))
179

180 181 182
      (when verbose?
        (print ev))

John Croisant's avatar
John Croisant committed
183
      (case (sdl2:event-type ev)
184
        ;; Window exposed, resized, etc.
185
        ((window)
186
         (draw-scene!))
187

188
        ;; User requested app quit (e.g. clicked the close button).
189
        ((quit)
190
         (set! done #t))
191

192
        ;; Joystick added (plugged in)
193 194
        ((joy-device-added)
         ;; Open the joystick so we start receiving events for it.
John Croisant's avatar
John Croisant committed
195
         (sdl2:joystick-open! (sdl2:joy-device-event-which ev)))
196

197 198 199
        ;; Mouse button pressed
        ((mouse-button-down)
         ;; Move smiley1 to the mouse position.
John Croisant's avatar
John Croisant committed
200 201
         (set! (obj-x smiley1) (sdl2:mouse-button-event-x ev))
         (set! (obj-y smiley1) (sdl2:mouse-button-event-y ev))
202
         (draw-scene!))
203 204 205 206 207

        ;; Mouse cursor moved
        ((mouse-motion)
         ;; If any button is being held, move smiley1 to the cursor.
         ;; This way it seems like you are dragging it around.
John Croisant's avatar
John Croisant committed
208 209 210
         (when (not (null? (sdl2:mouse-motion-event-state ev)))
           (set! (obj-x smiley1) (sdl2:mouse-motion-event-x ev))
           (set! (obj-y smiley1) (sdl2:mouse-motion-event-y ev))
211
           (draw-scene!)))
212

213
        ;; Keyboard key pressed.
214
        ((key-down)
John Croisant's avatar
John Croisant committed
215
         (case (sdl2:keyboard-event-sym ev)
216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231
           ;; Escape or Q quits the program
           ((escape q)
            (set! done #t))

           ;; V toggles verbose printing of events
           ((v)
            (if verbose?
                (begin
                  (print "Verbose OFF (events will not be printed)")
                  (set! verbose? #f))
                (begin
                  (print "Verbose ON (events will be printed)")
                  (set! verbose? #t))))

           ;; Space bar randomizes smiley colors
           ((space)
232 233 234
            (randomize-smiley! smiley1)
            (randomize-smiley! smiley2)
            (draw-scene!))
235 236 237 238

           ;; Arrow keys control smiley2
           ((left)
            (dec! (obj-x smiley2) 20)
239
            (draw-scene!))
240 241
           ((right)
            (inc! (obj-x smiley2) 20)
242
            (draw-scene!))
243 244
           ((up)
            (dec! (obj-y smiley2) 20)
245
            (draw-scene!))
246 247
           ((down)
            (inc! (obj-y smiley2) 20)
248
            (draw-scene!))))))))