album2.lisp

#|
exec sbcl --noinform --load $0 --end-toplevel-options "$@"
|#
#|
trida: time
sloty: min, sec
metody: set, get
 
trida: track
sloty: name, length
metody: set, get, print
 
trida: album
sloty: artist, title, track
metody: set, get ke vsemu
+ album-length
+ track-count (map car)
+ print album
 
|#

TIME

(defclass time-spec () (
  (minute :type (integer 0))
  (second :type (integer 0 59))
  ))

get

(defmethod t-min ((self time-spec)) ;vrati hodnotu slotu
  (slot-value self 'minute))
(defmethod t-sec ((self time-spec))
  (slot-value self 'second))

kontrola je value nezaporny integer?

(defmethod set-min ((self time-spec) value)
  (unless (typep value '(integer 0)) (error "minuty: cele nezaporne cislo!"))
  (setf (slot-value self 'minute) value)
  self)

je value integer 0-59?

(defmethod set-sec ((self time-spec) value)
  (unless (typep value '(integer 0 59)) (error "sekundy 0-59!"))
  (setf (slot-value self 'second) value)
  self)
 
(defmethod time-in-seconds ((self time-spec))
 ;(+ (* (slot-value self 'minute) 60) (slot-value self 'sec)));pouzit gettery!!!
  (+ (* (t-min self) 60) (t-sec self)))

je value integer? (modulo floor a multi/values)

(defmethod set-time-in-seconds ((self time-spec) value)
  (unless (typep value '(integer 0)) (error "sekundy zaporne!"))
  (multiple-value-bind (minute second) (floor value 60)
    (set-sec (set-min self minute) second)))

helper vytvori instanci a nastavi sloty minut a sekund

(defun make-time (minute second)
  (set-sec (set-min (make-instance 'time-spec) minute) second))
 
#|
(defmethod set-time ((self time) x y)
  (if (>= y 59)
      (error "minuta musi mit do 59 sekund!")
    (setf (slot-value time 'minute) x
          (slot-value time 'second) y))
  self)
(defun make-time (x y)
  (set-time (make-instance 'time) x y))
|#

TRACK

(defclass track ()
  ((length :initform (make-instance 'time-spec))
   (name :initform "")))
 
(defmethod len ((self track))
  (slot-value self 'lenght))
(defmethod name ((self track))
  (slot-value self 'name))
 
(defmethod set-name ((self track) value)
  (unless (typep value 'string) ;TOTO funguje? Jo: (typep "abc" 'string) ;=> T
    (error "nazev neni spravne! jo vim ze musi byt retezec!"))
  (setf (slot-value self 'name) value)
  self) ;tady chybel taky self
 
(defmethod set-len ((self track) value)
  (unless (typep value 'time-spec) (error "delka track neni time-spec!"))
  (setf (slot-value self 'length) value)
  self)
 
(defmethod print-track ((self track))
  (format t "~%Name:~s" (name self))
  (format t "~%Time:~s: ~s" (t-min (len self)) (t-sec (len self))))

objekt tridy track OPRAVIT!!! misto slot-value pouzit set-name a set-len !!!

#|
(defun make-track (name len)
  (let ((track (make-instance 'track)))
    (setf (slot-value track 'name) self)
    (setf (slot-value track 'len))
    self))
|#
(defun make-track (name len)
  (set-len (set-name (make-instance 'track) name) len))

ALBUM

(defclass album ()
  ((name :initform "")
   (artist :initform "")
   (tracks :initform nil)))
 
 ;!!! POKUD to jde, jmenuje se getter stejne jako slot!!!
 ;(defmethod album-name ((self album))
 (defmethod name ((self album))
  (slot-value self 'name))
 ;(defmethod album-author ((self album))
(defmethod artist ((self album))
  (slot-value self 'artist))
 ;(defmethod album-tracks ((self album))
(defmethod tracks ((self album))
  (slot-value self 'tracks))
 
 
 ;!!! settery se jmenuji jako slot + set- prefix!!!
(defmethod set-name ((self album) value)
  (unless (typep value 'string)
    (error "nazev alba musi byt retezec!"))
  (setf (slot-value self 'name) value)
  self)
 
 ;(defmethod set-artist ((self artist) value)
(defmethod set-artist ((self album) value)
 ;(unless (typep artist 'string)
  (unless (typep value 'string)
    (error "a zase a zase a zase nazev autora musi byt retezec!"))
  (setf (slot-value self 'artist) value)
  self)
(defmethod set-tracks ((self album) value)
  (unless (every (lambda (e)
                   (typep e 'track)) value)
    (error "neni seznam tracku!"))
  (setf (slot-value self 'tracks) (copy-list value)) ;Hmm, copy-list!!!
  self)
 
(defmethod album-length ((self album))
  (labels ((iter (tracks)
             (if (eq tracks '()) 0
               (+ (t-sec (time-in-seconds (car tracks))) (iter (cdr tracks))))))
    (iter (slot-value self 'tracks))))
 
(defmethod tracks-count ((self album))
  (length (slot-value self 'tracks)))
 
 
(defmethod print-album ((self album))
  ;TODO (album-length self) ; delka alba
  (format t "Name: ~s Author: ~s" (name self) (artist self))
  (format t "~%Number of tracks: ~s~%" (tracks-count self))
  ;(dolist pres tracks)
  self)

helper:

(defun make-album (name artist tracks)
  (set-tracks (set-artist (set-name (make-instance 'album) name) artist) tracks))
 
 (print-album (make-album "White album" "The Beatles"
                          (list (make-track "Back in the U.S.S.R." (make-time 2 43))
                                (make-track "Dear Prudence"        (make-time 3 56)))))
#|
 |#
YPP2/album/album2.lisp.txt · Last modified: 2014/10/23 23:33 (external edit)
CC Attribution-Noncommercial-Share Alike 4.0 International
www.chimeric.de Valid CSS Driven by DokuWiki do yourself a favour and use a real browser - get firefox!! Recent changes RSS feed Valid XHTML 1.0