Created
December 25, 2015 18:34
-
-
Save glider-gun/f93cb4471052cf6a0993 to your computer and use it in GitHub Desktop.
ncursesライブラリバインディングのcl-charmsを使って less コマンドのようなものを作ってみる
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/bin/sh | |
#|-*- mode:lisp -*-|# | |
#| | |
exec ros -Q -- $0 "$@" | |
|# | |
(ql:quickload :cl-charms :silent t) | |
(defun read-file (fname) | |
"return lines in fname" | |
(with-open-file (s fname) | |
(loop for l = (read-line s nil nil) | |
while l collect l))) | |
(defun char-width (c w) | |
(cond ((char-equal c #\tab) | |
(* (ceiling (1+ w) charms/ll:*tabsize*) charms/ll:*tabsize*)) | |
(t (+ w | |
(cffi:foreign-funcall "wcwidth" :int (char-code c) :int))))) | |
(defun string-width (str) | |
(loop for c across str | |
with width = 0 | |
do (setf width (char-width c width)) | |
finally (return width))) | |
(defun main (&rest argv) | |
(declare (ignorable argv)) | |
(let* | |
((fname (car argv)) | |
(lines (read-file fname)) | |
(minrow 0) | |
(mincol 0) | |
scr | |
pad | |
pad-width | |
pad-height) | |
;; initialize screen and pad | |
(setf scr (charms/ll:initscr) | |
pad-height (length lines) | |
pad-width (loop for l in lines | |
maximize (string-width l)) | |
pad (charms/ll:newpad pad-height pad-width)) | |
(charms/ll:cbreak) ; get key input immediately, | |
; but | |
(charms/ll:noecho) ; don't display key inputted from user | |
(charms/ll:keypad pad 1) ; accept special keys like arrow keys | |
(charms/ll:curs-set 0) ; don't show cursor | |
;; initialize pad contents | |
(loop for l in lines | |
for y from 0 | |
do (charms::check-status (charms/ll:mvwaddstr pad y 0 l))) | |
;; draw pad | |
(charms/ll:wclear scr) | |
(charms::check-status | |
(charms/ll:prefresh pad minrow mincol | |
0 0 | |
(1- charms/ll:*LINES*) (1- charms/ll:*COLS*))) | |
;; main loop | |
(loop named loop for k = (charms/ll:wgetch pad) | |
do (cond ((= k (char-code #\q)) | |
(return-from loop)) | |
((= k (char-code #\j)) | |
(incf minrow)) | |
((= k (char-code #\k)) | |
(decf minrow)) | |
((= k (char-code #\h)) | |
(decf mincol)) | |
((= k (char-code #\l)) | |
(incf mincol)) | |
((= k charms/ll:key_down) | |
(incf minrow)) | |
((= k charms/ll:key_up) | |
(decf minrow)) | |
((= k charms/ll:key_left) | |
(decf mincol)) | |
((= k charms/ll:key_right) | |
(incf mincol)) | |
(t | |
;; (format t "[~A ~C ~:C]~%" k (code-char k) (code-char k)) | |
;; (finish-output) | |
)) | |
do (charms/ll:wclear scr) | |
do (charms/ll:wrefresh scr) | |
do (charms/ll:prefresh pad minrow mincol | |
0 0 | |
(1- charms/ll:*LINES*) (1- charms/ll:*COLS*))) | |
(charms/ll:endwin))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment