some sdl tests and database management system tutorial

db-dump

@@ -0,0 +1,2 @@
+
+((:TITLE "asdasdasd" :ARTIST "zzzzzzz" :RATING 3 :RIPPED T) (:TITLE "asdasd" :ARTIST "qweqwe" :RATING "3" :RIPPED "t") (:TITLE "asd" :ARTIST "qwe" :RATING 6 :RIPPED T) (:TITLE "roses" :ARTIST "batya" :RATING 7 :RIPPED T)) 

dbms.cl

@@ -0,0 +1,50 @@
+(defun hello () 
+  (format t "hello, wordl!"))
+
+
+
+(defun list_test () 
+  (getf (list :a 1 :b 2 :c 3) :a))
+
+(defvar *db* nil)
+
+(defun make-cd (title artist rating ripped)
+  (list :title title :artist artist :rating rating :ripped ripped))
+
+(defun add-record (cd)
+  (push cd *db*))
+
+(defun dump-db ()
+  (dolist (cd *db*)
+	(format t "~{~a:~9t~a~%~}~%" cd)))
+
+(defun prompt-read (prompt)
+  (format *query-io* "~a: " prompt)
+  (force-output *query-io*)
+  (read-line *query-io*))
+
+(defun prompt-for-cd ()
+  (make-cd
+	(prompt-read "Title")
+	(prompt-read "Artist")
+	(or (parse-integer (prompt-read "Rating") :junk-allowed t) 0)
+	(y-or-n-p "Ripped [y/n]: ")))
+
+(defun save-db (filename)
+  (with-open-file (out filename
+					   :direction :output
+					   :if-exists :supersede)
+	(with-standard-io-syntax
+	  (print *db* out))))
+
+(defun load-db (filename)
+  (with-open-file (in filename)
+	(with-standard-io-syntax
+	  (setf *db* (read in)))))
+
+(defun select-by-artist (artist)
+  (remove-if-not 
+	#'(lambda (cd) (equal (getf cd :artist) artist))
+	*db*))
+
+(format *query-io* "hello~%")

sdl-test.cl

@@ -0,0 +1,31 @@
+(ql:quickload "lispbuilder-sdl")
+
+(defparameter *rand-color* sdl:*white*)
+(defun test-sdl ()
+  (sdl:with-init ()
+	(sdl:window 500 500 :title-caption "sdl test")
+	(setf (sdl:frame-rate) 60)
+	
+	(sdl:with-events ()
+		(:quit-event () t)
+		(:key-down-event ()
+			(when (or 
+					(sdl:key-down-p :sdl-key-q)
+			  		(sdl:key-down-p :sdl-key-escape))
+				(sdl:push-quit-event)))
+		(:idle ()
+		
+			(when (sdl:mouse-left-p)
+		  		(setf *rand-color* (sdl:color :r (random 255) :g (random 255) :b (random 255))))
+
+			(sdl:clear-display sdl:*black*)
+
+			(sdl:draw-box 
+			  (sdl:rectangle-from-midpoint-* (sdl:mouse-x) (sdl:mouse-y) 20 20) 
+			  :color *rand-color*)
+			
+			(sdl:update-display)))))
+
+(sb-int:with-float-traps-masked 
+  (:invalid :inexact :overflow) 
+  (test-sdl))