/[corman-sdl]/corman-sdl/examples/bouncing-ball_7.lisp
ViewVC logotype

Contents of /corman-sdl/examples/bouncing-ball_7.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Fri Jul 2 09:25:31 2004 UTC (9 years, 9 months ago) by lcrook
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +6 -7 lines
*** empty log message ***
1 ;;; A bouncing ball example.
2 ;;; Blits rectangles of random size to random positions on the screen
3 ;;; Original work: "The Simple Direct Media Layer", Ernest S. Pazera
4 ;;; ( http://www.gamedev.net/reference/programming/features/sdl2/page5.asp)
5 ;;; Conversion by Luke J Crook, luke@balooga.com
6 ;;; 12 June, 2003
7 ;;; Version 0.1
8 ;;; Version 0.2, 04.04.06, supports transparency
9
10 (require :mp)
11 (require 'sdl)
12 (require 'sdl-util)
13 (in-package :win)
14
15 (defun bouncing-ball ()
16 (let (
17 (width 800) (height 600)
18 (video-flags (list sdl:SDL_SWSURFACE))
19 (pBitmap nil) (tempBitmap nil)
20 (rcDst (sdl:new-rect))
21 (dy 6) (dx 4)
22 (max-right 0) (max-height 0))
23
24 (sdl:with-init (sdl:SDL_INIT_VIDEO)
25 (unless (sdl:set-videomode width height :flags video-flags)
26 (sdl:fformat "FAILED: set-videomode, cannot set the video mode")
27 (return))
28
29 (setf tempBitmap (sdl:loadbmp "b-ball.bmp"))
30 (unless tempBitmap
31 (sdl:fformat "ERROR: Cannot find \"b-ball.bmp\" in directory ~A~%" (ccl:get-current-directory))
32 (return))
33
34 ;Now we make all black pixels transparent..
35 ;First, set the color black (0, 0, 0) to be the transparent pixel using SDL_SetColorKey
36 (sdl:set-colorkey tempBitmap 0 0 0 :accel t)
37 ;Now call (sdl:displayformat) in order to convert the surface
38 ;to native SDL format for fast blitting.
39 (setf pBitmap (sdl:displayformat tempBitmap))
40
41 (sdl:moveto-rectangle rcDst 0 0)
42
43 (setf
44 max-height (- height (sdl:surface-h pBitmap))
45 max-right (- width (sdl:surface-w pBitmap)))
46
47 (sdl:with-events
48 (:quit t)
49 (:keydown (state scancode key mod unicode)
50 (when (= key sdl:SDLK_ESCAPE)
51 (sdl:push-quitevent)))
52 (:idle
53 (sdl:fill-display :r 255 :g 255 :b 255)
54
55 (sdl:moveby-rectangle rcDst dx dy)
56 (when (or (<= (sdl:rectangle-x rcDst) 0) (>= (sdl:rectangle-x rcDst) max-right))
57 (setf dx (- dx)))
58 (when (or (<= (sdl:rectangle-y rcDst) 0) (>= (sdl:rectangle-y rcDst) max-height))
59 (setf dy (- dy)))
60
61 (sdl:blit-to-display pBitmap :template rcDst)
62 (sdl:Flip))))
63
64 (unless (sdl:init-success)
65 (sdl:fformat "ERROR: sdl:with-init FAILED to initialize"))))
66
67 ;;; Change the current directory to the path where the file "b-ball.bmp" is located.
68 ;;; e.g. use (ccl:get-current-directory)
69 ;;; (ccl:set-current-directory "F:/Documents and Settings/Crook/My Documents/dev/lisp/corman-SDL/current")
70 ;;; (ccl:set-current-directory "C:/Documents and Settings/00u4440/My Documents/dev/test")
71 ;;; (ccl:set-current-directory "C:/Documents and Settings/00u4440/My Documents/dev")
72 ;;; Run the example using...
73 ;;; (setf bball (mp:process-run-function "bouncing-ball" #'bouncing-ball))
74 ;;; (mp:proc)
75
76 ;;; Build the exe using...
77 ;;; (SAVE-APPLICATION "bouncing-ball.exe" 'bouncing-ball :static t)

  ViewVC Help
Powered by ViewVC 1.1.5