small adjustments, many enhancements to rktplayer

playlist.rkt

@@ -5,6 +5,7 @@
          racket-sound
          "utils.rkt"
          racket-sprintf
+         "keystore.rkt"
          )
 
 (provide track%
@@ -12,6 +13,10 @@
          )
 
 (define the-displayln displayln)
+(define list-for-each for-each)
+(define list-length length)
+  
+(define next-track-id 0)
 
 (define track%
   (class object%
@@ -31,12 +36,19 @@
                              album
                              length)))
 
+    (define my-id (begin
+                    (set! next-track-id (+ next-track-id 1))
+                    (when (> next-track-id 10000000)
+                      (set! next-track-id 1))
+                    next-track-id))
+
     (define/public (get-file) file)
     (define/public (get-title) title)
     (define/public (get-artist) artist)
     (define/public (get-album) album)
     (define/public (get-number) number)
     (define/public (get-length) length)
+    (define/public (get-id) my-id)
 
     (define (read-tags)
       (let* ((f (if (path? file) (path->string file) file))
@@ -148,8 +160,12 @@
     (init-field
      [start-map #f]
      [max-tracks 100]
+     [name "Default"]
+     [id #f]
+     [settings #f]
      )
-    
+
+    (define store (new keystore% [filename "rktplayer.store"]))
     (define tracks '())
 
     (define (can-add? file)
@@ -183,16 +199,125 @@
           )
       )
 
+    ;(define/public (set-name! n)
+    ;  (set! name n))
+
+    ;(define/public (set-id! id*)
+    ;  (set! id id*))
+
+    ;(define/public (get-id)
+    ;  id)
+
+    ;(define/public (get-name)
+    ;  name)
+
+    (define/public (tabs)
+      (map (λ (k)
+             (if (string? k)
+                 (string->symbol k)
+                 k))
+           (send store get 'tabs '(tabkey-default)))
+      )
+    
+    (define/public (tab-count)
+      (list-length (tabs)))
+
+    (define/public (make-tab-key)
+      (string->symbol
+       (format "tabkey-~a-~a" (current-milliseconds) (random 10000))))
+
+    (define/public (get-tab-name idx)
+      (let* ((t (tabs))
+             (entry (list-ref t idx)))
+        (let ((v (send store get entry (list (format "Playlist-~a" idx) '()))))
+          (car v))))
+
+    (define/public (set-tab-name! idx name)
+      (let* ((t (tabs))
+             (entry (list-ref t idx))
+             (v (send store get entry (list (format "Playlist-~a" idx) '())))
+             )
+        (send store set! entry (list name (cadr v)))
+        )
+      )
+
+    (define/public (tab-id idx)
+      (let ((t (tabs)))
+        (list-ref t idx)))
+
+    (define/public (tab-index id)
+      (let ((t (tabs)))
+        (letrec ((f (λ (t idx)
+                      (if (null? t)
+                          #f
+                          (if (eq? (car t) id)
+                              idx
+                              (f (cdr t) (+ idx 1)))))))
+          (f t 0))))
+
+    (define/public (drop-tab! idx)
+      (let* ((t (tabs))
+             (entry (list-ref t idx))
+             )
+        (send store set! 'tabs (list-drop! t idx))
+        (send store drop! entry)
+        ))
+
+    (define/public (add-tab!)
+      (let* ((t (tabs))
+             (new-entry (send this make-tab-key)))
+        (send store set! 'tabs (append t (list new-entry)))
+        )
+      )
+
+    (define/public (save-tab!)
+      (let* ((entry id)
+             (idx (send this tab-index entry))
+             )
+        (displayln (format "entry id = ~a, ~a" entry idx))
+        (if (eq? idx #f)
+          (err-rktplayer "Cannot get tab for id ~a" entry)
+          (let ((value (list (send this get-tab-name idx)
+                             (map (λ (track)
+                                    (format "~a" (send track get-file)))
+                                  tracks))))
+            (send store set! entry value)
+            )
+          )
+        )
+      )
+
+    (define/public (load-tab idx)
+      (let* ((t (tabs))
+             (entry (list-ref t idx))
+             )
+        (displayln (format "loading ~a" entry))
+        (set! id entry)
+        (set! tracks '())
+        (let ((value (send store get entry (list "Default" '()))))
+          (set! name (car value))
+          (list-for-each (λ (file)
+                           (send this add-track file #f))
+                         (cadr value))
+          )
+        )
+      #t
+      )
+
     (define/public (read-tracks)
       (set! tracks '())
       (read-tracks-internal start-map)
+      (send this save-tab!)
       )
 
     (define/public (length)
       (list-len tracks))
 
-    (define/public (add-track file)
-      (add-track* file))
+    (define/public (add-track file . args)
+      (add-track* file)
+      (when (null? args)
+        (send this save-tab!))
+      )
 
     (define/public (track i)
       (list-ref tracks i))
@@ -244,9 +369,11 @@
           (mktable rows 'tracks formatter))))
 
     (super-new)
+    
     (begin
-      (when (eq? start-map #f)
-        (error "Initialize playlist% with a starting map"))
+      (if (eq? start-map #f)
+          (send this load-tab 0)
+          (set! id (send this tab-id id)))
       )
     )
   )