some sdl tests and database management system tutorial

This commit is contained in:
Gregory Tertyshny 2017-05-27 19:45:41 +03:00
parent 35357bc3c8
commit 8aa76e3a80
3 changed files with 83 additions and 0 deletions

2
db-dump Normal file
View 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
View 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
View 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))