luv

Workshop wiki

terminal-film-browser.lisp

mcclim/terminal-film-browser.lisp

system luvcraft/mcclim · 38 definitions · on GitHub

A McCLIM file browser presented directly on a focused terminal wall.

in-package#:mcluv
defparameter*terminal-film-extensions*'
"mp4""m4v""mov""mkv""webm""avi""mpg""mpeg""ts"
"File suffixes offered as playable films by the wall browser."
defconstant+terminal-film-browser-header-height+70

Where the first row starts. The painter and the hit-test both measure from here, so a row is always where the click says it is.

The same stone the communicator is cased in. Two things mounted on the same wall that behave alike should look alike, and a light surround gives the faceplate's own reflection somewhere to land instead of blowing out across a dark screen.

defparameter*film-browser-bezel-ink*
make-rgb-color0.550.510.43
defparameter*film-browser-bezel-light*
make-rgb-color0.730.690.59
defparameter*film-browser-bezel-dark*
make-rgb-color0.260.240.20
defparameter*film-browser-screen-ink*
make-rgb-color0.0750.0750.075
defparameter*film-browser-row-ink*
make-rgb-color0.1250.1250.125
defparameter*film-browser-text-ink*
make-rgb-color0.920.930.94
defparameter*film-browser-muted-ink*
make-rgb-color0.500.530.57
defstructterminal-film-entrypathnamekindlabel
sizenil
defunterminal-film-size
pathname

pathname's length in bytes, or NIL if it will not say.

ignore-errors
with-open-file
streampathname:element-type'
unsigned-byte8
file-lengthstream
defunterminal-film-size-label
size
cond
nullsize
""
<size1048576
formatnil"~D KB"
roundsize1024
<size1073741824
formatnil"~,1F MB"
/size1048576.0
t
formatnil"~,1F GB"
/size1073741824.0
defparameter*terminal-film-entry-marks*'
:directory."▸"
:film."▶"
:previous."↑"
:next."↓"

A mark per row kind. It replaces the bracketed word the label used to carry: the shape says what the row is, and the name gets the whole line.

defunterminal-film-pathname-p
pathname
member
string-downcase
or
pathname-typepathname
""
*terminal-film-extensions*:test#'string=
defunterminal-film-directory-name
pathname
let*
parts
pathname-directorypathname
name
car
lastparts
if
stringpname
name
namestringpathname
defunterminal-film-browser-entries
directory

Return parent, directory, and playable-film entries inside directory.

let*
directory
uiop:ensure-directory-pathnamedirectory
parent
uiop:pathname-parent-directory-pathnamedirectory
directories
sort
copy-list
uiop:subdirectoriesdirectory
#'string-lessp:key#'namestring
films
sort
remove-if-not#'terminal-film-pathname-p
uiop:directory-filesdirectory
#'string-lessp:key#'file-namestring
append
unless
equaldirectoryparent
list
make-terminal-film-entry:pathnameparent:kind:directory:label".."
mapcar
lambda
pathname
make-terminal-film-entry:pathnamepathname:kind:directory:label
formatnil"~A/"
directories
mapcar
lambda
pathname
make-terminal-film-entry:pathnamepathname:kind:film:label
file-namestringpathname
:size
films
defclassterminal-film-browser-pane
application-pane
define-application-frameterminal-film-browser
display:initarg:display:readerterminal-film-browser-display
directory:initarg:directory:accessorterminal-film-browser-directory
entries:initformnil:accessorterminal-film-browser-frame-entries
visible-entries:initformnil:accessorterminal-film-browser-visible-entries
offset:initform0:accessorterminal-film-browser-offset
message:initform"Choose a directory or film.":accessorterminal-film-browser-message
:menu-barnil
:panes
:layouts
defunterminal-film-browser-page
let*
entries
terminal-film-browser-frame-entriesframe
offset
terminal-film-browser-offsetframe
previous-p
pluspoffset
available
more-p
>
lengthentries
+offsetavailable
content-count
-available
ifmore-p10
append
whenprevious-p
list
make-terminal-film-entry:kind:previous:label"previous page"
subseqentriesoffset
min
lengthentries
+offsetcontent-count
whenmore-p
list
make-terminal-film-entry:kind:next:label"next page"
defunterminal-film-entry-color
entry

The mark's colour. A row is dark and the ink is what carries the kind: twelve saturated bars fight each other and the filename loses.

ecase
terminal-film-entry-kindentry
:directory
make-rgb-color0.440.680.92
:film
make-rgb-color0.780.560.95
:previous:next
make-rgb-color0.550.580.62
defmethodhandle-repaint
declare
ignoreregion
let*
frame
pane-framepane
entries
terminal-film-browser-visible-entriesframe
all
terminal-film-browser-frame-entriesframe
medium
sheet-mediumpane
with-bounding-rectangle*
lefttoprightbottom
pane

The same chassis the communicator wears, because they are the same wall showing two different things.

draw-rectangle*panelefttoprightbottom:ink*film-browser-bezel-ink*
draw-rectangle*pane
+left3
+top3
-right3
-bottom3
:fillednil:line-thickness3:ink*film-browser-bezel-light*
draw-rectangle*pane
+left6
+top6
-right6
-bottom6
:fillednil:line-thickness2:ink*film-browser-bezel-dark*
draw-analytic-rounded-rectangle*medium
+left12
+top12
-right12
-bottom12
:radius6:ink*film-browser-screen-ink*

Header

draw-text*pane"Films"
+left24
+top30
:align-y:center:text-size19:ink*film-browser-text-ink*
draw-text*pane
terminal-film-browser-path-label
terminal-film-browser-directoryframe
+left24
+top52
:align-y:center:text-size12:ink*film-browser-muted-ink*
draw-text*pane
formatnil"~D item~:P"
-right24
+top30
:align-x:right:align-y:center:text-size12:ink*film-browser-muted-ink*
draw-line*pane
+left18
+top64
-right18
+top64
:ink
make-rgb-color0.160.170.19
loopforentryinentriesforindexfrom0forrow-top=forrow-bottom=do
when
oddpindex
draw-analytic-rounded-rectangle*medium
+left16
row-top
-right16
row-bottom:radius4:ink*film-browser-row-ink*
draw-text*pane
or
cdr
assoc
terminal-film-entry-kindentry
*terminal-film-entry-marks*
"·"
+left30
/
+row-toprow-bottom
2.0
:align-x:center:align-y:center:text-size14:ink
draw-text*pane
terminal-film-entry-labelentry
+left48
/
+row-toprow-bottom
2.0
:align-y:center:text-size13:ink*film-browser-text-ink*
alexandria:when-let
size
terminal-film-entry-sizeentry
draw-text*pane
-right30
/
+row-toprow-bottom
2.0
:align-x:right:align-y:center:text-size11:ink*film-browser-muted-ink*

Footer

draw-line*pane
+left18
-bottom40
-right18
-bottom40
:ink
make-rgb-color0.160.170.19
draw-text*pane
terminal-film-browser-messageframe
+left24
-bottom25
:align-y:center:text-size12:ink*film-browser-muted-ink*
defunrepaint-terminal-film-browser
let
mirror
sheet-direct-mirror
frame-top-level-sheetframe
check-typemirrorluv-gpu-mirror
frame
defunrefresh-terminal-film-browser
frame&key
reset-offset-pnil

Refresh frame's bounded directory snapshot without opening any files.

whenreset-offset-p
setf
terminal-film-browser-offsetframe
0
handler-case
setf
terminal-film-browser-frame-entriesframe
terminal-film-browser-entries
terminal-film-browser-directoryframe
terminal-film-browser-messageframe
"Choose a directory or film."
error
condition
setf
terminal-film-browser-frame-entriesframe
nil
terminal-film-browser-messageframe
formatnil"Cannot read this directory: ~A"condition
setf
terminal-film-browser-visible-entriesframe
defunchoose-terminal-film-browser-entry
frameentry

Enter entry's directory, change page, or play its film on the wall.

whenentry
ecase
terminal-film-entry-kindentry
:previous
setf
terminal-film-browser-offsetframe
max0
-
terminal-film-browser-offsetframe
:directory
setf
terminal-film-browser-directoryframe
uiop:ensure-directory-pathname
terminal-film-entry-pathnameentry
:film
handler-case
progn
luvcraft:play-terminal-display-film
terminal-film-browser-displayframe
terminal-film-entry-pathnameentry
setf
terminal-film-browser-messageframe
formatnil"Playing ~A"
file-namestring
terminal-film-entry-pathnameentry
error
condition
setf
terminal-film-browser-messageframe
formatnil"Could not play film: ~A"condition
defunterminal-film-browser-entry-at
frametexture-y
let
when
<=0index
nthindex
terminal-film-browser-visible-entriesframe
defclassterminal-film-browser-overlay
display:initarg:display:readerterminal-film-browser-overlay-display
defundisplace-terminal-mode-overlay
displaywanted-type

Return display's mode child if it is already wanted-type, else drop it.

Every mode installs a different child and only one can be mounted, so changing mode has to take the previous one down. It is released rather than merely forgotten: the child being replaced may own a thread or a socket, and a Telegram console left running behind a film is a connection nobody closes.

let
overlay
luvcraft:terminal-display-mode-overlaydisplay
cond
nulloverlay
nil
typepoverlaywanted-type
overlay
t
setf
luvcraft:terminal-display-mode-overlaydisplay
nil
nil
luv:zdefmethod
luvcraft:encode-luvcraft-overlay:zone:film-browser/encode
sessionpasssurface-texture
"Draw the browser's semantic command stream directly on its wall."
declare
ignorepass
place-widget-overlay-on-surfaceoverlay
terminal-film-browser-overlay-displayoverlay
session
let
viewport-size
luv:canvas-extent
luvcraft::luvcraft-session-contextsession
prepare-direct-widget-overlayoverlaysessionsurface-texture
world-device-clip-stateoverlaysession
firstviewport-size
secondviewport-size
overlay
defmethodluvcraft:handle-luvcraft-overlay-event
declare
ignoresessioncanvas
alexandria:when-let
uv
luvcraft-widget-texture-coordinateoverlay
luv:canvas-pointer-event-xevent
luv:canvas-pointer-event-yevent
when
and
eq:left
luv:canvas-pointer-event-buttonevent
t
defunopen-terminal-film-browser
display

Make one embedded McCLIM browser owned by display's authored wall.

let*
session
luvcraft::terminal-display-sessiondisplay
port
find-port:server-path'
:luv-gpu
manager
or
first
climi::frame-managersport
make-instance'luv-frame-manager:portport
frame
let
*embedded-mirror-target*
luvcraft:luvcraft-session-canvassession
*embedded-mirror-context*
luvcraft::luvcraft-session-contextsession
*embedded-mirror-device*
luvcraft::luvcraft-session-devicesession
make-application-frame'terminal-film-browser:frame-managermanager:enablet:displaydisplay:directory
user-homedir-pathname
setf
frame-pretty-nameframe
"terminal wall film browser"
let*
mirror
sheet-direct-mirror
frame-top-level-sheetframe
overlay
make-instance'terminal-film-browser-overlay:sessionsession:frameframe:mirrormirror:displaydisplay:height-scale0.0
place-widget-overlay-on-surfaceoverlaydisplaysession
setf
mirror-compositormirror
overlay
luvcraft:terminal-display-mode-overlaydisplay
overlay
overlay
defmethodluvcraft:change-terminal-display-mode:after
declare
ignoresessionmode

A detached display still has useful logical mode behavior (and is how the core geometry is tested), but it has no canvas on which to mount a browser overlay.

when
luvcraft::terminal-display-sessiondisplay