From 8aa76e3a804c8f86897be2d1985e0250adf9dc14 Mon Sep 17 00:00:00 2001 From: Gregory Tertyshny Date: Sat, 27 May 2017 19:45:41 +0300 Subject: [PATCH] some sdl tests and database management system tutorial --- db-dump | 2 ++ dbms.cl | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++ sdl-test.cl | 31 +++++++++++++++++++++++++++++++ 3 files changed, 83 insertions(+) create mode 100644 db-dump create mode 100644 dbms.cl create mode 100644 sdl-test.cl diff --git a/db-dump b/db-dump new file mode 100644 index 0000000..23e8b19 --- /dev/null +++ b/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)) \ No newline at end of file diff --git a/dbms.cl b/dbms.cl new file mode 100644 index 0000000..96df036 --- /dev/null +++ b/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~%") diff --git a/sdl-test.cl b/sdl-test.cl new file mode 100644 index 0000000..a635734 --- /dev/null +++ b/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))