diff --git a/command_parser.rkt b/command_parser.rkt new file mode 100644 index 0000000..69951ff --- /dev/null +++ b/command_parser.rkt @@ -0,0 +1,35 @@ +#lang racket + +;; guard procedure for the command type +(define/contract (valid? identifier argument-strings name) + (-> string? (or/c string? (listof string?)) (or/c string? symbol?) (values string? (listof string?))) + (values identifier (list argument-strings))) + +;; command type +(struct command (identifier)) + +(struct add-resources command (resources)) +(struct remove-command command (resources)) +(struct add-commands command (commands)) +(struct chdir command (directory)) +(struct modify command (command-name new-content)) + +(struct commands (add-resources + remove-command + add-commands + chdir + modify)) + +;; parses a command to be sent to the player thread +(define (parse-command cmd) + (match cmd + [(? string?) + (match (regexp-split #px"\\s" cmd) + [(list-rest "cmds" xs) (add-commands "cmds" xs)] + [(list-rest "add" xs) (add-resources "add" (list (string-join xs "")))] + [(list-rest "chdir" xs) (chdir "chdir" xs)] + [(list-rest "remove" xs) (remove-command "rem" xs)] + [_ (command #f)])] + [_ (command #f)])) + +(provide (all-defined-out)) \ No newline at end of file diff --git a/lazyplay.rkt b/lazyplay.rkt index 75e0101..1fe43da 100755 --- a/lazyplay.rkt +++ b/lazyplay.rkt @@ -1,15 +1,11 @@ #! /usr/bin/env racket #lang racket -;; New features -;; Better filetype handling -;; Ability to skip forward and backwards in the playlist - - (require racket/system) (require racket/pretty) (require "helpers.rkt") (require "config_parser.rkt") (require "playlist_server.rkt") +(require "command_parser.rkt") (define args (vector->list (current-command-line-arguments))) @@ -67,73 +63,61 @@ args))) list))) ; convert the 4 return values into a list -;; gets all of the available data from the mailbox -(define (parse-new-data new-data next) - (match new-data - [#f #f] - [ht - (letrec ([inner (λ (acc) - (match (next) - [#f acc] - [new-hash - (match (hash-ref new-hash 'arguments) - ; the case that there is no arguments... - [#f (hash-set! acc 'new-files (append (hash-ref acc 'new-files) (hash-ref new-hash 'new-files))) - (inner acc)] - ; if there are arguments... - [_ (hash-set! acc 'arguments (hash-ref new-hash 'arguments)) - (inner acc)])]))]) - (inner ht))])) - -(define (get-args message args) - (cond ((false? message) args) - (else message))) +;; function to check if a file should be removed from the playlist +(define playlist-remove? + (λ (a b) + (regexp-match? (regexp (format "^~a$" a)) b))) + +(define (play-react previous-files played args cmd next) + (define (continue-playing new-prev args res) + (play-react (append new-prev args res) + played args + (parse-command (next)) + next)) + + (let ([inner (λ (new-previous) + (match cmd + [(add-resources s resources) (update! resources) + (continue-playing new-previous args resources)] + + [(add-commands s commands) (continue-playing new-previous commands '())] + + [(remove-command s resources) (remove* resources previous-files playlist-remove?) + (continue-playing new-previous args resources)] + + [(chdir s directory) + (current-directory (car directory)) + (update! (play-list)) + (play (play-list) played args)] + + [(modify s name new-content) s] + + [_ (play new-previous played args)]))]) + (match previous-files ; check if there are previous files + ['() (inner '())] + [_ (inner (cdr previous-files))]))) (define (play fnames played args) (cond ((null? fnames) (let* ([new-data (thread-receive)]) - (match (list (hash-ref new-data 'new-dir) - (hash-ref new-data 'new-files) - (hash-ref new-data 'arguments)) - [(list #f a #f) - (update! a) - (play a played player-args)] - [(list a (list) #f) (current-directory a) - (update! (play-list)) - (play (play-list) played player-args)] - [a (display a)]))) - + (play-react fnames played args new-data thread-try-receive))) (else - (let* ((results (play-files fnames args))) ; get the pid and the 3 i/o ports + (let* ([results (play-files fnames args)]) ; get the pid and the 3 i/o ports (subprocess-wait (first results)) ; block until a new file is started - (close-output-port (third results))) + (close-output-port (third results))) + (let* ([new-dir-files (new-files played (play-list))] - [new-data (parse-new-data (thread-try-receive) thread-try-receive)]) ; get new list of files + [new-data (thread-try-receive)]) ; get new command information + (update! new-dir-files) (match new-data [#f (play (append (cdr fnames) new-dir-files) - (update played (map (compose reverse ((curry list) #f)) new-dir-files)) + played args)] - [_ (let ([newfs (append new-dir-files (hash-ref new-data 'new-files))]) - (play - (append (cdr fnames) newfs) ; append new files to the tail of the list of old files - (update! newfs) ; update the set of played files - (get-args (hash-ref new-data 'arguments) args)))]))))) ; check for new arguments from controller - -;; returns a hash with the commands for the player thread -(define (parsed-hash args newdir newfiles) - (let ([result (make-hash)]) - (hash-set! result 'arguments args) - (hash-set! result 'new-dir newdir) - (hash-set! result 'new-files newfiles) - result)) - -;; parses a command to be sent to the player thread -(define (parse-command cmd) - (match (regexp-split #px"\\s" cmd) - [(list-rest "cmds" xs) (parsed-hash xs #f '())] - [(list-rest "add" xs) (parsed-hash #f #f (list (string-join xs "")))] - [(list-rest "chdir" xs) (parsed-hash #f (string-join xs "") '())] - [_ (parsed-hash #f #f '())])) + [_ (play-react (append (cdr fnames ) new-dir-files) + played + args + new-data + thread-try-receive)]))))) (define (controller player-thread) (cond @@ -147,8 +131,6 @@ (thread-send player-thread (parse-command input)) (controller player-thread))))) - - (define player-thread (thread (lambda () (play (play-list) played player-args)))) diff --git a/playlist_server.rkt b/playlist_server.rkt index a7b2000..86e3ee2 100644 --- a/playlist_server.rkt +++ b/playlist_server.rkt @@ -4,6 +4,7 @@ (require web-server/templates) (require web-server/dispatch) (require "links.rkt") +(require "command_parser.rkt") (require xml) (define (make-server player-thread parse-command) @@ -42,8 +43,7 @@ (let ([name (hash-ref (list->hash (url-query (request-uri req))) 'name)]) - (display name) - (thread-send player-thread (parse-command (format "add ~a" name))) + (thread-send player-thread (add-resources "add" (list name))) (response/xexpr (string->xexpr (include-template "./sent.html"))))) ;; Lists all the available categories @@ -62,6 +62,7 @@ lazyplay-dispatch #:servlet-regexp #px"" #:launch-browser? #f + #:banner? #f #:port 8080)) (provide make-server) \ No newline at end of file