├── run.sh ├── .DS_Store ├── image ├── bg.png ├── BOMB.png ├── CHOOSE.png ├── chess0.png ├── chess1.png ├── chess2.png ├── chess3.png ├── chess4.png ├── chess5.png ├── chess6.png ├── BT_CLOSE.png ├── BT_START.png ├── TIME_BACK.png ├── TIME_NUMBER.png ├── TIME_THUMB.png ├── chess4.png.bak └── GAME_SCORE_NUMBER.png ├── sound ├── test.wav ├── S_bomb.ogg ├── V_ready.ogg ├── music.mp3 ├── music.ogg ├── phaser.wav ├── A_combo1.ogg ├── A_combo2.ogg ├── A_combo3.ogg ├── A_combo4.ogg ├── A_combo5.ogg ├── bgm_game.ogg ├── UI_scoreinc.ogg └── V_timeover.ogg ├── README.md ├── run.lisp ├── package.lisp ├── Makefile ├── init.lisp ├── make.lisp ├── LICENSE └── game.lisp /run.sh: -------------------------------------------------------------------------------- 1 | ./linker --disable-debugger --non-interactive 2 | 3 | -------------------------------------------------------------------------------- /.DS_Store: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/.DS_Store -------------------------------------------------------------------------------- /image/bg.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/image/bg.png -------------------------------------------------------------------------------- /image/BOMB.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/image/BOMB.png -------------------------------------------------------------------------------- /sound/test.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/sound/test.wav -------------------------------------------------------------------------------- /image/CHOOSE.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/image/CHOOSE.png -------------------------------------------------------------------------------- /image/chess0.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/image/chess0.png -------------------------------------------------------------------------------- /image/chess1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/image/chess1.png -------------------------------------------------------------------------------- /image/chess2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/image/chess2.png -------------------------------------------------------------------------------- /image/chess3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/image/chess3.png -------------------------------------------------------------------------------- /image/chess4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/image/chess4.png -------------------------------------------------------------------------------- /image/chess5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/image/chess5.png -------------------------------------------------------------------------------- /image/chess6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/image/chess6.png -------------------------------------------------------------------------------- /sound/S_bomb.ogg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/sound/S_bomb.ogg -------------------------------------------------------------------------------- /sound/V_ready.ogg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/sound/V_ready.ogg -------------------------------------------------------------------------------- /sound/music.mp3: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/sound/music.mp3 -------------------------------------------------------------------------------- /sound/music.ogg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/sound/music.ogg -------------------------------------------------------------------------------- /sound/phaser.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/sound/phaser.wav -------------------------------------------------------------------------------- /image/BT_CLOSE.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/image/BT_CLOSE.png -------------------------------------------------------------------------------- /image/BT_START.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/image/BT_START.png -------------------------------------------------------------------------------- /image/TIME_BACK.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/image/TIME_BACK.png -------------------------------------------------------------------------------- /sound/A_combo1.ogg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/sound/A_combo1.ogg -------------------------------------------------------------------------------- /sound/A_combo2.ogg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/sound/A_combo2.ogg -------------------------------------------------------------------------------- /sound/A_combo3.ogg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/sound/A_combo3.ogg -------------------------------------------------------------------------------- /sound/A_combo4.ogg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/sound/A_combo4.ogg -------------------------------------------------------------------------------- /sound/A_combo5.ogg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/sound/A_combo5.ogg -------------------------------------------------------------------------------- /sound/bgm_game.ogg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/sound/bgm_game.ogg -------------------------------------------------------------------------------- /image/TIME_NUMBER.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/image/TIME_NUMBER.png -------------------------------------------------------------------------------- /image/TIME_THUMB.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/image/TIME_THUMB.png -------------------------------------------------------------------------------- /image/chess4.png.bak: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/image/chess4.png.bak -------------------------------------------------------------------------------- /sound/UI_scoreinc.ogg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/sound/UI_scoreinc.ogg -------------------------------------------------------------------------------- /sound/V_timeover.ogg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/sound/V_timeover.ogg -------------------------------------------------------------------------------- /image/GAME_SCORE_NUMBER.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/clear/master/image/GAME_SCORE_NUMBER.png -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | clear 2 | ===== 3 | 消除游戏 4 | 5 | common lisp写的游戏 6 | by evilbinary rootntsd@gmail.com 7 | 8 | ###运行方式如下 9 | make 10 | ./run.sh 11 | -------------------------------------------------------------------------------- /run.lisp: -------------------------------------------------------------------------------- 1 | (load "init.lisp") 2 | (load "./game.lisp") 3 | #+sbcl (sb-int:with-float-traps-masked (:invalid) (my-game:linker)) 4 | #+ecl (my-game:linker) 5 | #+clisp (my-game:linker) 6 | #+ccl (my-game:linker) 7 | (quit) -------------------------------------------------------------------------------- /package.lisp: -------------------------------------------------------------------------------- 1 | (in-package :my-game) 2 | (defpackage #:my-game 3 | (:nickname #:my-game) 4 | (:use #:cl #:cffi #:lispbuilder-sdl #:lispbuilder-sdl-mixer #:lispbuilder-sdl-image #:lispbuilder-sdl-ttf) 5 | (:export main *default-name*)) 6 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | CL=sbcl 2 | ECL=ecl 3 | TARGET=./linker 4 | 5 | all: $(TARGET) 6 | 7 | $(TARGET):game.lisp init.lisp make.lisp 8 | $(CL) --load make.lisp 9 | run:$(TARGET) 10 | $(TARGET) 11 | test:init.lisp game.lisp run.lisp 12 | $(CL) --load run.lisp 13 | ecl:init.lisp game.lisp run.lisp 14 | $(ECL) -load make.lisp 15 | test1:init.lisp game.lisp run.lisp 16 | $(ECL) -load run.lisp 17 | clean: 18 | rm -rf $(TARGET) *.o *.fasl 19 | -------------------------------------------------------------------------------- /init.lisp: -------------------------------------------------------------------------------- 1 | (ql:quickload '(:asdf :cffi)) 2 | (pushnew #P"/opt/local/lib/" cffi:*foreign-library-directories* 3 | :test #'equal) 4 | ;install for mac port sdl-framwork version :) 5 | #+darwin (pushnew #P"/opt/local/Library/Frameworks/" cffi:*darwin-framework-directories* 6 | :test #'equal) 7 | #+darwin (pushnew #P"/System/Library/Frameworks/" cffi:*darwin-framework-directories* 8 | :test #'equal) 9 | (ql:quickload 10 | '( :lispbuilder-sdl :lispbuilder-sdl-mixer :lispbuilder-sdl-ttf 11 | :lispbuilder-sdl-image )) 12 | ;(ql:quickload "lispbuilder-sdl") 13 | ;(ql:quickload "lispbuilder-sdl-mixer") 14 | ;(ql:quickload "lispbuilder-sdl-image") 15 | (load "./game.lisp") 16 | ;(sb-int:with-float-traps-masked (:invalid) (my-game:linker)) 17 | -------------------------------------------------------------------------------- /make.lisp: -------------------------------------------------------------------------------- 1 | ;(compile-file "init.lisp") 2 | (load "init.lisp") 3 | (let ((filename #+windows "linker.exe" 4 | (or #+darwin "linker" 5 | #+unix "linker" 6 | #+linux "linker")) 7 | (main #'my-game:linker)) 8 | #+clisp (saveinitmem filename :init-function main :executable t :norc t) 9 | #+sbcl (save-lisp-and-die filename :toplevel main :executable t) 10 | #+clozure (save-application filename :toplevel-function main :prepend-kernel t) 11 | #+ecl (c:build-program filename :lisp-files (list (compile-file "init.lisp" :system-p t) (compile-file "game.lisp" :system-p t) ) :epilogue-code '(main) )) 12 | (quit) 13 | ;sbcl – (sb-ext:save-lisp-and-die filename :executable t) 14 | ;clisp – (ext:saveinitmem filename :save-executable t) 15 | ;OpenMCL – (require "COCOA-APPLICATION") 16 | ;ECL – (c:build-program ...) 17 | ;Allegro – (generate-executable ...) 18 | ;LispWorks – (deliver ...) 19 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014, evilbinary 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | * Redistributions in binary form must reproduce the above copyright notice, 11 | this list of conditions and the following disclaimer in the documentation 12 | and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 15 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 16 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 17 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 18 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 19 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 20 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 21 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 22 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 23 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /game.lisp: -------------------------------------------------------------------------------- 1 | ;;game by evilbinary 2 | ;;rootntsd@gmail.com 3 | ;;create date:2014-05-01 4 | 5 | 6 | (defpackage #:my-game 7 | (:use #:cl :cl-user) 8 | (:nicknames #:clear) 9 | (:export #:linker)) 10 | (in-package my-game) 11 | 12 | 13 | (defvar *path* *default-pathname-defaults*) 14 | (defvar *image-path* (merge-pathnames "image/" *path*)) 15 | ;(print *image-path*) 16 | (defvar *music-path* (merge-pathnames "sound/" *path*)) 17 | (defvar *audio-path* (merge-pathnames "sound/" *path*)) 18 | (defvar *bomb-image* nil) 19 | (defvar *bombpath* '()) 20 | 21 | ;(defvar *image-path* (sdl:load-directory)) 22 | (defvar *begin-x* 20) 23 | (defvar *begin-y* 80) 24 | (defvar *number-col* 6) 25 | (defvar *number-row* 6) 26 | 27 | (defvar *frequency* 44100) 28 | (defvar *output-chunksize* 2048) 29 | (defvar *output-channels* 2) 30 | (defvar *sample-format* SDL-CFFI::AUDIO-S16LSB) 31 | 32 | (defun main() (linker)) 33 | 34 | ;;检查重复个数y 35 | (defun compress (x) 36 | (if (consp x) 37 | (compr (car x) 1 (cdr x)) 38 | x)) 39 | 40 | (defun compr (elt n lst) 41 | (if (null lst) 42 | (list (n-elts elt n)) 43 | (let ((next (car lst))) 44 | (if (eql next elt) 45 | (compr elt (+ n 1) (cdr lst)) 46 | (cons (n-elts elt n) 47 | (compr next 1 (cdr lst))))))) 48 | 49 | (defun n-elts (elt n) 50 | (if (> n 1) 51 | (list n elt) 52 | elt)) 53 | 54 | ;;解压重复 55 | (defun uncompress (lst) 56 | (if (null lst) 57 | nil 58 | (let ((elt (car lst)) 59 | (rest (uncompress (cdr lst)))) 60 | (if (consp elt) 61 | (append (apply #'list-of elt) 62 | rest) 63 | (cons elt rest))))) 64 | 65 | (defun uncompress1 (lst) 66 | (if (null lst) 67 | nil 68 | (let ((elt (car lst)) 69 | (rest (uncompress (cdr lst)))) 70 | (if (consp elt) 71 | (append (apply #'list-of elt) 72 | rest) 73 | (cons elt rest))))) 74 | 75 | (defun list-of (n elt) 76 | (if (zerop n) 77 | nil 78 | (cons elt (list-of (- n 1) elt)))) 79 | 80 | (defun check-swapable (ax ay bx by) 81 | (and (<= bx (+ ax 1)) (>= bx (- ax 1)) ;;交换只能隔壁 82 | (<= by (+ ay 1)) (>= by (- ay 1)))) 83 | 84 | (defun check-bound (ax ay bx by) 85 | (and (<= ax *number-col*) 86 | (<= bx *number-col*) 87 | (<= ay *number-row*) 88 | (<= by *number-row*) 89 | (>= ax 0) 90 | (>= ay 0) 91 | (>= bx 0) 92 | (>= by 0) ;;>0 控制 93 | )) 94 | 95 | ;;todo clear 1 metho 96 | (defun clear1 (list) 97 | (dolist (l list) 98 | (compress l))) 99 | (defmacro ll (&rest l) 100 | `(list ,@l)) 101 | ;;清除一行 102 | (defun clear-line(list) 103 | (let ((e0 (car list)) 104 | (count 0) 105 | (i 0) 106 | (tmp '(0)) 107 | (result '())) 108 | (do ((i 1 (incf i))) 109 | ((> i (length list)) result) 110 | (progn 111 | ;;(format t "cmp n[~a]:~a,~a~%" i (nth i list) e0) 112 | (if (eq (nth i list) e0) 113 | (progn 114 | (setf tmp (append tmp (list i))) 115 | ;;(format t "tmp:~a i:~a~%" tmp i) 116 | (incf count) 117 | (if (>= count 2) 118 | ;;(format t "count:~a e:~a~%" count e0) 119 | nil)) 120 | (progn 121 | ;;(setf tmp (append tmp (list i))) 122 | ;;(format t "tmp1:~a~%" tmp) 123 | (when (> count 1) 124 | (setf result (append result tmp ))) 125 | (setf tmp (list i)) 126 | (setf e0 (nth i list)) 127 | (setf count 0))) 128 | ;;(format t "i:~a e0:~a n[~a]:~a~%" i e0 i (nth i list)) 129 | )) 130 | (return-from clear-line result))) 131 | 132 | (defun nth-col(list n) 133 | "获第n列" 134 | (let ((tmp nil)) 135 | (dolist (x list) 136 | ;(print x) 137 | ;(format t "~a~%" (nth n x)) 138 | (setf tmp (append tmp (list (nth n x)))) 139 | ) 140 | (return-from nth-col tmp))) 141 | 142 | 143 | (defun draw-image (image x y) 144 | (format t "draw-image ~a ~a " x y) 145 | (let ((pos (sdl:point :x (+ *begin-x* (* x 48)) 146 | :y (+ *begin-y* (* y 48))))) 147 | (format t "==pos:~a" pos) 148 | (sdl:draw-surface-at image pos))) 149 | 150 | (defun copy-mat (mat) 151 | (let ((ret '())) 152 | (dolist (l mat) 153 | (setf ret (append (list (copy-list l))))) 154 | (return-from copy-mat ret))) 155 | 156 | (defun draw-diff (a b) 157 | (format t "diff ~a #####~% ~a~%" a b) 158 | (setf *bombpath* '()) 159 | (loop for x in a 160 | for y in b 161 | for i from 0 162 | do 163 | (loop for xa in x 164 | for xb in y 165 | for j from 0 166 | ;(format t "####~a ~a~%" xa xb) 167 | if (not (= xa xb)) 168 | do 169 | ; (format t "~a ~a~%" xa xb) 170 | ;(draw-image *bomb-image* i j) 171 | (setf *bombpath* (append *bombpath* (list (cons i j )) )) 172 | ; (format t "*bombpath*:~a" *bombpath*) 173 | ;(sleep 1) 174 | ) 175 | ) 176 | (format t "*bombpath*====~a" *bombpath*) 177 | ;;(sleep 1) 178 | ) 179 | (defun draw-bomb () 180 | ;(format t "*bombpath*~a~%" *bombpath*) 181 | (if *bombpath* 182 | (loop for pos in *bombpath* 183 | do 184 | (return-from nil) 185 | ;;(format t "pos~a ~a ~a~%" pos (car pos) (cdr pos)) 186 | ;;(draw-image *bomb-image* (car pos) (cdr pos)) 187 | ))) 188 | 189 | (defun draw-imags(images mat) 190 | (loop for m in mat 191 | for i from 0 192 | do (loop for e in m 193 | for j from 0 194 | for (y x) = (multiple-value-list (values i j)) 195 | for position = (sdl:point :x (+ *begin-x* (* x 48)) 196 | :y (+ *begin-y* (* y 48))) 197 | do (let ((val nil)) 198 | (setf val (mat-elt mat i j)) 199 | ;(format t "val:~a (~a,~a) i:~a j:~a~%" val x y i j) 200 | (if (not (eq val nil)) 201 | (sdl:draw-surface-at (nth val (remove nil images)) position)) 202 | 203 | 204 | )))) 205 | 206 | (defun clear(mat) 207 | ;;(format t "l:~a~%" list) 208 | (let ((row nil) 209 | (col nil) 210 | (i 0)) 211 | (dolist (l1 (car mat)) 212 | (setf col (append col (list (clear-line (nth-col mat i))))) 213 | (incf i)) 214 | (dolist (l mat) 215 | (setf row (append row (list (clear-line l)))) 216 | ;(format t " clear-line:~a~%" (clear-line l)) 217 | ) 218 | ;(format t " row:~a col:~a~%" row col) 219 | (setf i 0) 220 | ;;set row zero 221 | (dolist (r row) 222 | (set-zero r (nth i mat)) 223 | (incf i)) 224 | ;;set col zero 225 | (setf i 0) 226 | (dolist (c col) 227 | (dolist (ce c) 228 | (mat-set mat ce i 0) 229 | ;(setf (mat-elt list i ce) 0) 230 | ;(format t "i:~a ce:~a v:~a~%" i ce (mat-elt list i ce)) 231 | ) 232 | (incf i)) 233 | (return-from clear (list row col)))) 234 | (defun set-zero(pos list) 235 | (dolist (x pos) 236 | (setf (nth x list) 0))) 237 | 238 | (defmacro mat-elt (mat row col) 239 | `(nth ,col (nth ,row ,mat))) 240 | (defmacro mat-set (mat row col val) 241 | `(setf (mat-elt ,mat ,row ,col) ,val)) 242 | #+darwin (defun mat-set (mat row col val) 243 | (setf (mat-elt mat row col) val)) 244 | 245 | (defun mat-get (mat row col) 246 | (values (mat-elt mat row col)) 247 | ) 248 | (defun column@ (mat at) 249 | (mapcar #'(lambda (r) (nth at r)) mat)) 250 | (defun mat-rotate (mat) 251 | (apply #'mapcar (lambda (&rest r) r) mat)) 252 | (defmacro != (&rest l) 253 | `(not (= ,@l))) 254 | (defun mat-print(mat) 255 | (dolist (l mat) 256 | (format t "~a~%" l))) 257 | 258 | (defun test-clear() 259 | (let ((a nil)) 260 | (setf a (list (list 1 2 2 2 5 5) '(1 2 5 5 5 2) '(1 1 1 4 5 1) '(1 3 4 5 6 6))) 261 | (setf a (list (list 1 2 3 4 4 4 1) (list 2 3 4 2 2 1 2) (list 3 4 5 3 4 5 2) (list 4 5 6 5 6 2 3) (list 5 4 3 6 1 1 4) (list 6 5 4 2 2 3 1) (list 3 4 5 3 4 5 3) (list 3 4 5 3 4 5 1) (list 3 4 5 3 4 5 1))) 262 | ;(format t "nth0:~a" (nth 0 a)) 263 | (format t "befor:~%") 264 | (mat-print a) 265 | (clear a) 266 | (format t "after:~%") 267 | (mat-print a) 268 | (format t "down:~%") 269 | (mat-print a) 270 | (format t "down-af:~%") 271 | (mat-print (down a)))) 272 | 273 | (defun down-line (list) 274 | (let ((zero ()) 275 | (vals ())) 276 | (dolist (l list) 277 | (if (eq l 0) 278 | ;;(format t "~a~%" (adjoin l zero)) 279 | (setf zero (append zero (list l))) 280 | ;(format t "~a~%" (append vals l)); 281 | (setf vals (append vals (list l))) 282 | )) 283 | ;(format t "zero:~a vals:~a append:~a~%" zero vals (append zero vals)) 284 | ;(setf vals (append zero vals)) 285 | (return-from down-line (append zero vals)))) 286 | 287 | (defun down (mat) 288 | ; (mat-print mat) 289 | ;(mat-rotate mat) 290 | (setf mat (mat-rotate mat)) 291 | ;(mat-print mat) 292 | (let ((mt nil)) 293 | (dolist (m mat) 294 | (setf mt (append mt (list (down-line m)))) 295 | ;(format t "down:~a~%" (down-line m)) 296 | ) 297 | (return-from down (mat-rotate mt)))) 298 | 299 | (defun sample-finished-action () 300 | (sdl-mixer:register-sample-finished 301 | (lambda (channel) 302 | (declare (ignore channel)) 303 | nil))) 304 | 305 | (defun music-finished-action () 306 | (sdl-mixer:register-music-finished 307 | (lambda ()))) 308 | 309 | ; play music 310 | (defun play-music(music music-status) 311 | (if (sdl-mixer:music-playing-p) 312 | (progn 313 | (sdl-mixer:pause-Music) 314 | (setf music-status (format nil "Music \"~A\": Paused..." 1))) 315 | (if (sdl-mixer:music-paused-p) 316 | (progn 317 | (sdl-mixer:resume-Music) 318 | (setf music-status (format nil "Music \"~A\": Resumed..." 1))) 319 | (progn 320 | (sdl-mixer:play-music music) 321 | (setf music-status (format nil "Music \"~A\": Playing..." 1)))))) 322 | 323 | 324 | ;(defparameter array-status nil) 325 | (defun linker () 326 | (let ((sample nil) 327 | ;(status "") 328 | (array-status nil) 329 | (images nil) 330 | (image-bg nil) 331 | (down-x nil) 332 | (down-y nil) 333 | (music-bg nil) 334 | (status nil) 335 | (music-status nil) 336 | (mixer-opened nil) 337 | ) 338 | ;; Init value 339 | (setf array-status (list '(1 2 3 4 4 4 1) '(2 3 4 2 2 1 2) '(3 4 5 3 4 5 2) '(4 5 6 5 6 2 3) '(5 4 3 6 1 1 4) '(6 5 4 2 2 3 1) '(3 4 5 3 4 5 3) '(3 4 5 3 4 5 1) '(3 4 5 3 4 5 1))) 340 | (setf array-status (list (list 1 2 3 2 4 4 1) (list 2 3 4 2 2 1 2) (list 3 4 5 3 4 5 2) (list 4 5 6 5 6 2 3) (list 5 4 3 6 1 1 4) (list 6 5 4 2 2 3 1) (list 6 5 4 2 2 3 1) )) 341 | (mat-print array-status) 342 | ;(clear array-status) 343 | (print "init sdl") 344 | ;; Initialize SDL 345 | (sdl:with-init () 346 | (print "init window") 347 | (sdl:window 460 480 :title-caption "clear") 348 | ;(sdl:window 600 600 ) 349 | (print "init frame") 350 | (setf (sdl:frame-rate) 30) 351 | (setf status "100") 352 | (print "init font") 353 | (sdl:initialise-default-font) 354 | (print "init image") 355 | (sdl-image:init-image :jpg :png :tif) 356 | 357 | (let ((images-name (list "chess0.png" "chess1.png" "chess2.png" "chess3.png" "chess4.png" "chess5.png" "chess6.png" )) 358 | (images-1 nil)) 359 | (print "load images") 360 | ;(sdl-image:load-image (merge-pathnames "chess0.png" *image-path*) :color-key-at #(90 90 )) 361 | (dolist (name images-name) 362 | (format t "path:~a~%" (merge-pathnames name *image-path*)) 363 | (setf images (append images (list (sdl-image:load-image (merge-pathnames name *image-path*) :color-key-at #(90 90)))))) 364 | 365 | (print "load background image") 366 | ;load backgroud image 367 | (setf image-bg (sdl-image:load-image (merge-pathnames "bg.png" *image-path*) :color-key-at #(0 0) ))) 368 | (setf *bomb-image* (sdl-image:load-image (merge-pathnames "bomb.png" *image-path*) :color-key-at #(0 0) )) 369 | 370 | (print "mixer init") 371 | (sdl-mixer:init-mixer :wav :ogg :mp3) 372 | (print "load bg music") 373 | ;;load bg music 374 | ;;(setf mixer-opened (sdl-mixer:OPEN-AUDIO :enable-callbacks nil)) 375 | (setf mixer-opened (sdl-mixer:open-audio :frequency *frequency* 376 | :chunksize *output-chunksize* 377 | ;; :enable-callbacks t 378 | :format *sample-format* 379 | :channels *output-channels*)) 380 | (print "open success") 381 | (when mixer-opened 382 | (setf status "Opened Audio Mixer.") 383 | (setf music-bg (sdl-mixer:load-music (sdl:create-path "music.mp3" *audio-path*))) 384 | (setf sample (sdl-mixer:load-sample (sdl:create-path "phaser.wav" *audio-path*))) 385 | ;; Seems in win32, that these callbacks are only really supported by Lispworks. 386 | (music-finished-action) 387 | (sample-finished-action) 388 | (sdl-mixer:allocate-channels 16) 389 | (play-music music-bg music-status) 390 | (sdl-mixer:play-sample sample) 391 | (format t "music-status:~a~%" music-status) 392 | ;(setf music-bg (sdl-mixer:load-music (sdl:create-path "bgm_game.ogg" *audio-path*))) 393 | ;(format t "music:~a~%" music-bg) 394 | ;(sdl-mixer:play-music music-bg) 395 | ) 396 | 397 | (draw-image *bomb-image* 0 0) 398 | (sdl:update-display) 399 | 400 | (sdl:with-events () 401 | (:quit-event () t) 402 | (:video-expose-event () 403 | (sdl:update-display)) 404 | (:key-down-event () 405 | (when (sdl:key-down-p :SDL-KEY-ESCAPE) 406 | (sdl:push-quit-event)) 407 | (when (sdl:key-down-p :SDL-KEY-R) 408 | (format t "reset~%") 409 | (mat-set array-status 0 0 (+ 1 (random 5))) 410 | (setf array-status (list '(1 2 3 4 2 4 1) '(2 3 4 2 2 1 2) '(3 4 5 3 4 5 2) '(4 5 6 5 6 2 3) '(5 4 3 6 1 1 4) '(6 5 4 2 2 3 1) '(3 4 5 3 4 5 3) '(3 4 5 3 4 5 2) )) 411 | (mat-print array-status)) 412 | (when (sdl:key-down-p :SDL-KEY-SPACE) 413 | (when (sdl:audio-opened-p) 414 | (sdl:play-audio sample) 415 | (print (list sample)) 416 | (list sample) 417 | (sdl:draw-string-solid "test" (sdl:point) :color sdl:*red*))) 418 | ;;press m key for test 419 | (when (sdl:key-down-p :SDL-KEY-M) 420 | 421 | (play-music music-bg music-status) 422 | ;(sdl-mixer:play-sample sample) 423 | ;(sdl-mixer:play-music music-bg) 424 | ) 425 | ;;press p key 426 | (when (sdl:key-down-p :SDL-KEY-P) 427 | (format t "clear befor~%") 428 | (mat-print (clear array-status)) 429 | 430 | (format t "p press~%") 431 | (setf array-status (down array-status)) 432 | (mat-print (down array-status)) 433 | (format t " after down~%") 434 | (mat-print array-status))) 435 | ;(:mouse-motion-event (:state state :x x :y y :x-rel x-rel :y-rel y-rel) 436 | ; (format t "state:~a x:~a y:~a x-rel:~a y-rel:~a~%" state x y x-rel y-rel)) 437 | (:mouse-button-down-event (:button button :state state :x x :y y) 438 | (when (= button 1) 439 | (format t "down button:~a state:~a x:~a y:~a~%" button state x y) 440 | (setf down-x x) 441 | (setf down-y y)) 442 | ) 443 | (:mouse-button-up-event (:button button :state state :x x :y y) 444 | (if (= button 1) 445 | (progn 446 | (format t "up button:~a state:~a x:~a y:~a~%" button state x y) 447 | (format t "down-x:~a down-y:~a~%" down-x down-y) 448 | (let ((swap-a-x nil) 449 | (swap-a-y nil) 450 | (swap-b-x nil) 451 | (swap-b-y nil) 452 | (swap-a-value nil) 453 | (swap-b-value nil)) 454 | (setf swap-a-x (floor (/ (- down-x *begin-x*) 48))) 455 | (setf swap-a-y (floor (/ (- down-y *begin-y*) 48))) 456 | (setf swap-b-x (floor (/ (- x *begin-x*) 48))) 457 | (setf swap-b-y (floor (/ (- y *begin-y*) 48))) 458 | (format t "swapa:(~a,~a) (~a,~a)~%" swap-a-x swap-a-y swap-b-x swap-b-y) 459 | (format t "check-bound:~a~%" (check-bound swap-a-x swap-a-y swap-b-x swap-b-y)) 460 | (when (and (check-swapable swap-a-x swap-a-y swap-b-x swap-b-y) 461 | (check-bound swap-a-x swap-a-y swap-b-x swap-b-y)) 462 | (setf swap-a-value (mat-get array-status swap-a-y swap-a-x)) 463 | (setf swap-b-value (mat-get array-status swap-b-y swap-b-x)) 464 | (format t "va:~a vb:~a~%" swap-a-value swap-b-value) 465 | (if (or swap-a-value swap-b-value (!= swap-a-x swap-b-x) (!= swap-a-y swap-b-y)) 466 | (progn 467 | (mat-set array-status swap-a-y swap-a-x swap-b-value) 468 | (mat-set array-status swap-b-y swap-b-x swap-a-value) 469 | (format t "set:(~a,~a)=~a set:(~a,~a)=~a~%" swap-a-x swap-a-y swap-a-value swap-b-x swap-b-y swap-b-value))))) 470 | (let ((old-array-status (copy-mat array-status))) 471 | (format t "copy-mat ~a~%" old-array-status) 472 | (mat-print (clear array-status)) 473 | (format t "arry-mat ~a~%" array-status) 474 | (format t "copy-mat ~a~%" old-array-status) 475 | (draw-diff old-array-status array-status) 476 | (format t "p press~%") 477 | (setf array-status (down array-status))) 478 | 479 | )) 480 | ) 481 | 482 | 483 | (:idle () 484 | (sdl:clear-display sdl:*black*) 485 | (sdl:draw-surface-at image-bg (sdl:point :x 0 :y 0)) 486 | ( draw-imags images array-status) 487 | (draw-bomb ) 488 | ;;(format t "~%") 489 | (when (sdl:audio-opened-p) 490 | (if (sdl:audio-playing-p) 491 | (setf status (format nil "Number of audio samples playing: ~d" 492 | (sdl:audio-playing-p))) 493 | (setf status "Audio complete. Press SPACE to restart."))) 494 | (sdl:draw-filled-circle (sdl:point :x (random 200) :y (random 10)) 495 | (random 40) 496 | :color (sdl:any-color-but-this sdl:*black*) 497 | :surface sdl:*default-display*) 498 | (sdl:draw-string-solid status (sdl:point) :color sdl:*white*) 499 | 500 | ;(sdl:draw-string-solid-* status 1 1 :surface sdl:*default-display* :color sdl:*white*) 501 | ;(sdl:draw-string-solid-* music-status 1 11 :surface sdl:*default-display* :color sdl:*white*) 502 | ;(sdl:draw-string-solid-* (format nil "Samples playing: ~A..." (sdl-mixer:sample-playing-p nil)) 503 | ; 1 21 :surface sdl:*default-display* :color sdl:*white*) 504 | ; (sdl:dyraw-string-solid-* " Toggle Music. Play Samples." 1 40 :surface sdl:*default-display* :color sdl:*white*) 505 | (sdl:update-display) 506 | ))))) 507 | --------------------------------------------------------------------------------