port playvid to common lisp

scripts/playvid.rkt

@@ -1,23 +0,0 @@
-#!/usr/bin/env racket
-#lang racket
-
-;; Plays a random file in CWD using mpv, unless one is provided as CLI arg.
-;; Asks to delete the file after viewing it.
-
-(require racket/gui/base)
-
-(current-print void)
-
-(define file
-  ;; default to random file
-  (command-line #:args ([f
-                         (let ([dir (filter file-exists? (directory-list))])
-                           (path->string (list-ref dir (random (length dir)))))])
-                f))
-
-(printf "playing: ~a\n" file)
-(system* (find-executable-path "mpv") file)
-
-(when (eq? (message-box "Delete Video?" (format "Delete this video?\n\n~a" file) #f '(yes-no)) 'yes)
-  (printf "deleting `~a`\n" file)
-  (delete-file file))

scripts/playvid.ros

@@ -0,0 +1,27 @@
+#!/usr/bin/env -S ros -Q --
+#|-*- mode:lisp -*-|#
+(progn ;;init forms
+  (ros:ensure-asdf)
+  #+quicklisp(ql:quickload '(uiop trivial-raw-io) :silent t))
+
+(defpackage :playvid
+  (:use :cl))
+(in-package :playvid)
+
+(defun main (&rest argv)
+  (let* ((vidfile (or (car argv)
+                      (let ((dir (uiop:directory-files ".")))
+                        (nth (random (length dir) (make-random-state t)) dir))))
+         (basename (pathname-name vidfile)))
+    (format t "playing video: ~a~%" basename)
+    (uiop:run-program (list "mpv" (file-namestring vidfile))
+                      :input :interactive
+                      :error-output :interactive
+                      :output :interactive)
+    (format t "delete `~a`? [Y/n] " basename)
+    (force-output)
+    (let ((input (char-upcase (trivial-raw-io:read-char))))
+      (format t "~a~%" input)
+      (when (char-equal #\Y input)
+        (format t "deleting file `~a`~%" basename)
+        (delete-file vidfile)))))

scripts/swank-repl.ros

@@ -1,14 +0,0 @@
-#!/usr/bin/env -S ros -Q --
-#|-*- mode:lisp -*-|#
-(progn
-  (ros:ensure-asdf)
-  (ql:quickload '(:swank :mondo) :silent t))
-
-(defpackage :swank-mondo-repl
-  (:use :cl))
-(in-package :swank-mondo-repl)
-
-(defun main (&rest argv)
-  (declare (ignorable argv))
-  (let ((port (swank:create-server :dont-close t)))
-    (mondo:main nil :port port)))

setup/commands/install-scripts.rkt

@@ -12,7 +12,7 @@
     (build-path (output-bin-path) "bin" bin))
   ;; Symlink interpreted scripts
   (mklink "scripts/map-touch-display.rkt" (bin-path "map-touch-display"))
-  (mklink "scripts/playvid.rkt" (bin-path "playvid"))
+  (mklink "scripts/playvid.ros" (bin-path "playvid"))
   (mklink "scripts/start-joshuto.sh" (bin-path "start-joshuto"))
   (mklink "scripts/startriver.sh" (bin-path "startriver"))
   (mklink "scripts/swank-repl.ros" (bin-path "swank-repl"))