Skip to content

Instantly share code, notes, and snippets.

@valvallow
Created June 17, 2013 15:32
Show Gist options
  • Save valvallow/5797824 to your computer and use it in GitHub Desktop.
Save valvallow/5797824 to your computer and use it in GitHub Desktop.
marquee in the shell
#!/usr/local/bin/gosh
(use gauche.parseopt)
(use gauche.process)
(use srfi-1)
(use srfi-13)
(define (usage cmd)
(print "usage: " cmd " [option] ... input")
(print " options:")
(print " h|help print this help")
(print " a|alternate move from side to side") ; not implemented
(print " s|scrollamount milliseconds of scrolling speed (default: 100)")
(print " r|reverse move to right")
(exit))
(define (get-tput-val . args)
(process-output->string `(tput ,@args)))
(define (tput . args)
(run-process `(tput ,@args)))
(define (return-to-top)
(tput 'cup 0 0))
(define (sleep-milliseconds n)
(sys-nanosleep (* n 1000000)))
(define (with-full-screen thunk)
(dynamic-wind
(^ _ (tput 'civis)(tput 'clear))
thunk
(^ _ (tput 'cnorm))))
(define (fill-list ls len var)
(if (<= len (length ls))
ls
(append ls (list-tabulate (- len (length ls)) (^ _ var)))))
(define (string-pad-both/index str len index reverse?)
(if reverse?
(string-pad-right (string-pad str (- len index)) len)
(string-pad (string-pad-right str (- len index)) len)))
(define (make-marquee-printer messages reverse? alternate?)
(let* ((cols (x->integer (get-tput-val 'cols)))
(lines (x->integer (get-tput-val 'lines)))
(msg-max-width (apply max (map string-length messages)))
(msg-width (max cols msg-max-width))
(messages (take messages (min lines (length messages)))))
(let1 i 0
(^ _ (let* ((pudder (cut string-pad-both/index <>
msg-width (- msg-width i) reverse?))
(padded (map pudder messages))
(cutter (cut string-take <>
(if (< cols msg-width)
cols
msg-width)))
(cutted (map cutter padded))
(msg (apply string-append
(intersperse (string #\newline) cutted))))
(print msg)
(if (< i (+ msg-width msg-max-width))
(inc! i)
(set! i 0)))))))
(define (main args)
(let-args (cdr args)
((help "h|help" => (cut usage (car args)))
(alternate "a|alternate")
(scrollamount "s|scrollamount=i" 100)
(reverse "r|reverse")
(else (opt . _)
(print "Unknown option : " opt)
(usage (car args)))
. rest)
(set-signal-handler! SIGINT (^ _ (exit)))
(let1 messages (if (null? rest)
(port->string-list (current-input-port))
(call-with-input-string (car rest) port->string-list))
(with-full-screen
(^ _ (let1 murquee (make-marquee-printer messages reverse alternate)
(while #t
(return-to-top)
(murquee)
(flush)
(sleep-milliseconds scrollamount))))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment