some sdl tests and database management system tutorial
This commit is contained in:
parent
35357bc3c8
commit
8aa76e3a80
3 changed files with 83 additions and 0 deletions
2
db-dump
Normal file
2
db-dump
Normal file
|
@ -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))
|
50
dbms.cl
Normal file
50
dbms.cl
Normal file
|
@ -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~%")
|
31
sdl-test.cl
Normal file
31
sdl-test.cl
Normal file
|
@ -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))
|
Loading…
Add table
Reference in a new issue