1151 行
38 KiB
Scheme
実行ファイル
1151 行
38 KiB
Scheme
実行ファイル
#!/usr/bin/env -S guile -e main -s
|
|
coding: utf-8
|
|
!#
|
|
|
|
(use-modules
|
|
(ice-9 exceptions)
|
|
(ice-9 match)
|
|
(ice-9 format)
|
|
(juniority database)
|
|
(juniority util)
|
|
(ncurses curses)
|
|
(ncurses form)
|
|
(ncurses menu)
|
|
(sqlite3)
|
|
(srfi srfi-1)
|
|
(srfi srfi-9)
|
|
(srfi srfi-43)
|
|
)
|
|
|
|
(define-record-type <interactive-state>
|
|
(make-interactive-state view
|
|
history
|
|
shutdown
|
|
legend-win
|
|
info-win
|
|
display-win
|
|
in-menu
|
|
in-form)
|
|
interactive-state?
|
|
(view interactive-state-view
|
|
set-interactive-state-view!)
|
|
(history interactive-state-history
|
|
set-interactive-state-history!)
|
|
(shutdown interactive-state-shutdown
|
|
set-interactive-state-shutdown!)
|
|
(legend-win interactive-state-legend-win)
|
|
(info-win interactive-state-info-win)
|
|
(display-win interactive-state-display-win)
|
|
(in-menu interactive-state-in-menu
|
|
set-interactive-state-in-menu!)
|
|
(in-form interactive-state-in-form
|
|
set-interactive-state-in-form!)
|
|
)
|
|
|
|
(define (main args)
|
|
(match args
|
|
((bin "help" . rest) (display-help bin))
|
|
((bin "-h" . rest) (display-help bin))
|
|
((bin "--help" . rest) (display-help bin))
|
|
((bin db-path) (main-tui db-path))
|
|
((bin . _) (display-help bin))))
|
|
(define (display-help bin)
|
|
(format #t "Usage:
|
|
Interactive mode: ~a path/to/db.sqlite3
|
|
|
|
For more details, wait for this help text to be improved.
|
|
" bin))
|
|
|
|
(define (main-tui db-path)
|
|
(let ((db (open-db db-path))
|
|
(window #nil)
|
|
(interactive-state #nil)
|
|
)
|
|
(set! window (initscr))
|
|
(cbreak!)
|
|
(noecho!)
|
|
(keypad! window #t)
|
|
|
|
(let* ((num-cols (cols))
|
|
(num-lines (lines))
|
|
|
|
(legend-height (max *legend-min-height*
|
|
(ceiling (/ num-lines 2))))
|
|
(legend-width (max *legend-min-width*
|
|
(floor (/ num-cols 4))))
|
|
(legend-win (newwin legend-height legend-width 0 0))
|
|
|
|
(info-height (- num-lines legend-height))
|
|
(info-width legend-width)
|
|
(info-win (newwin info-height info-width legend-height 0))
|
|
|
|
(display-height num-lines)
|
|
(display-width (- num-cols legend-width))
|
|
(display-win (newwin display-height display-width 0 legend-width)))
|
|
(set! interactive-state (make-interactive-state #nil (list) #f legend-win info-win display-win #f #f)))
|
|
|
|
(migrate-db db)
|
|
(sqlite-exec db "PRAGMA case_sensitive_like = false")
|
|
|
|
(goto-top-view! db interactive-state)
|
|
(render-view window interactive-state)
|
|
|
|
(let loop ((typed-char (getch window)))
|
|
(begin
|
|
(handle-keystroke db window interactive-state typed-char)
|
|
(render-view window interactive-state)
|
|
(unless (interactive-state-shutdown interactive-state)
|
|
(loop (getch window)))))
|
|
|
|
(endwin)
|
|
(sqlite-close db)))
|
|
(define *legend-min-height* 12)
|
|
(define *legend-min-width* 20)
|
|
|
|
(define (handle-keystroke db win state ch)
|
|
(match (interactive-state-view state)
|
|
(('top _ _ _ _ _)
|
|
(match ch
|
|
(#\f (goto-find-view! db state 'idols))
|
|
(#\g (goto-find-view! db state 'volumes))
|
|
(#\i (goto-idols-view! db state))
|
|
(#\v (goto-volumes-view! db state))
|
|
(#\s (goto-studios-view! db state))
|
|
;; (#\t (goto-tags-view! db state))
|
|
(#\q (set-interactive-state-shutdown! state #t))
|
|
(other (render-key-press state other))))
|
|
|
|
(('idols #f _)
|
|
(match ch
|
|
(#\esc (goto-top-view! db state))
|
|
(other (render-key-press state other))))
|
|
(('idols menu _)
|
|
(update-menu! menu ch)
|
|
(match ch
|
|
(#\newline
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #f)
|
|
(goto-idol-detail-view! db state (item-name (current-item menu))))
|
|
(#\esc
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #f)
|
|
(goto-top-view! db state))
|
|
(other (render-key-press state other))))
|
|
(('idol #f _ idol _ _)
|
|
(match ch
|
|
(#\esc
|
|
(if (history? state)
|
|
(history-pop! db state)
|
|
(goto-idols-view! db state)))
|
|
(#\i
|
|
(history-delete! state)
|
|
(goto-idols-view! db state))
|
|
(#\t
|
|
(history-delete! state)
|
|
(goto-top-view! db state))
|
|
(#\`
|
|
(param-query-one db rate-idol-stmt
|
|
#nil
|
|
(vector-ref idol 0))
|
|
(goto-idol-detail-view! db state (vector-ref idol 3)))
|
|
((? char?digit? rating)
|
|
(param-query-one db rate-idol-stmt
|
|
(digit->number rating)
|
|
(vector-ref idol 0))
|
|
(goto-idol-detail-view! db state (vector-ref idol 3)))
|
|
(other (render-key-press state other))
|
|
))
|
|
(('idol menu _ idol _ _)
|
|
(update-menu! menu ch)
|
|
(match ch
|
|
(#\newline
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #f)
|
|
(history-push! state (list goto-idol-detail-view!
|
|
(vector-ref idol 3)))
|
|
(goto-volume-detail-view!
|
|
db
|
|
state
|
|
(item-name (current-item menu))))
|
|
(#\esc
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #f)
|
|
(if (history? state)
|
|
(history-pop! db state)
|
|
(goto-idols-view! db state)))
|
|
(#\i
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #f)
|
|
(history-delete! state)
|
|
(goto-idols-view! db state))
|
|
(#\t
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #f)
|
|
(history-delete! state)
|
|
(goto-top-view! db state))
|
|
(#\`
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #t)
|
|
(param-query-one db rate-idol-stmt
|
|
#nil
|
|
(vector-ref idol 0))
|
|
(goto-idol-detail-view! db state (vector-ref idol 3)))
|
|
((? char?digit? rating)
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #t)
|
|
(param-query-one db rate-idol-stmt
|
|
(digit->number rating)
|
|
(vector-ref idol 0))
|
|
(goto-idol-detail-view! db state (vector-ref idol 3)))
|
|
(other (render-key-press state other))
|
|
))
|
|
|
|
(('volumes #f _)
|
|
(match ch
|
|
(#\esc (goto-top-view! db state))
|
|
(other (render-key-press state other))))
|
|
(('volumes menu _)
|
|
(update-menu! menu ch)
|
|
(match ch
|
|
(#\newline
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #f)
|
|
(goto-volume-detail-view! db state (item-name (current-item menu))))
|
|
(#\esc
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #f)
|
|
(goto-top-view! db state))
|
|
(other (render-key-press state other))))
|
|
(('volume #f _ volume _ _)
|
|
(match ch
|
|
(#\esc
|
|
(if (history? state)
|
|
(history-pop! db state)
|
|
(goto-volumes-view! db state)))
|
|
(#\v (goto-volumes-view! db state))
|
|
(#\t
|
|
(history-delete! state)
|
|
(goto-top-view! db state))
|
|
(#\`
|
|
(param-query-one db rate-volume-stmt
|
|
#nil
|
|
(vector-ref volume 0))
|
|
(goto-volume-detail-view! db state (vector-ref volume 1)))
|
|
((? char?digit? rating)
|
|
(param-query-one db rate-volume-stmt
|
|
(digit->number rating)
|
|
(vector-ref volume 0))
|
|
(goto-volume-detail-view! db state (vector-ref volume 1)))
|
|
(other (render-key-press state other))))
|
|
(('volume menu _ volume _ _)
|
|
(update-menu! menu ch)
|
|
(match ch
|
|
(#\newline
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #f)
|
|
(history-push! state (list goto-volume-detail-view!
|
|
(vector-ref volume 1)))
|
|
(goto-idol-detail-view!
|
|
db
|
|
state
|
|
(item-name (current-item menu))))
|
|
(#\esc
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #f)
|
|
(if (history? state)
|
|
(history-pop! db state)
|
|
(goto-volumes-view! db state)))
|
|
(#\v
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #f)
|
|
(goto-volumes-view! db state))
|
|
(#\t
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #f)
|
|
(history-delete! state)
|
|
(goto-top-view! db state))
|
|
(#\`
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #t)
|
|
(param-query-one db rate-volume-stmt
|
|
#nil
|
|
(vector-ref volume 0))
|
|
(goto-volume-detail-view! db state (vector-ref volume 1)))
|
|
((? char?digit? rating)
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #t)
|
|
(param-query-one db rate-volume-stmt
|
|
(digit->number rating)
|
|
(vector-ref volume 0))
|
|
(goto-volume-detail-view! db state (vector-ref volume 1)))
|
|
(other (render-key-press state other))
|
|
))
|
|
|
|
(('studios #f _)
|
|
(match ch
|
|
(#\esc (goto-top-view! db state))
|
|
(other (render-key-press state other))))
|
|
(('studios menu _)
|
|
(update-menu! menu ch)
|
|
(match ch
|
|
(#\newline
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #f)
|
|
(goto-studio-detail-view! db state (item-name (current-item menu))))
|
|
(#\esc
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #f)
|
|
(goto-top-view! db state))
|
|
(other (render-key-press state other))))
|
|
(('studio #f _ studio _ _)
|
|
(match ch
|
|
(#\esc
|
|
(if (history? state)
|
|
(history-pop! db state)
|
|
(goto-studios-view! db state)))
|
|
(#\s (goto-studios-view! db state))
|
|
(#\t
|
|
(history-delete! state)
|
|
(goto-top-view! db state))
|
|
(other (render-key-press state other))))
|
|
(('studio menu _ studio _ _)
|
|
(update-menu! menu ch)
|
|
(match ch
|
|
(#\newline
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #f)
|
|
(history-push! state (list goto-studio-detail-view!
|
|
(vector-ref studio 1)))
|
|
(goto-volume-detail-view!
|
|
db
|
|
state
|
|
(item-name (current-item menu))))
|
|
(#\esc
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #f)
|
|
(if (history? state)
|
|
(history-pop! db state)
|
|
(goto-studios-view! db state)))
|
|
(#\s
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #f)
|
|
(goto-studios-view! db state))
|
|
(#\t
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #f)
|
|
(history-delete! state)
|
|
(goto-top-view! db state))
|
|
(#\`
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #t)
|
|
(param-query-one db rate-studio-stmt
|
|
#nil
|
|
(vector-ref studio 0))
|
|
(goto-studio-detail-view! db state (vector-ref studio 1)))
|
|
((? char?digit? rating)
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #t)
|
|
(param-query-one db rate-studio-stmt
|
|
(digit->number rating)
|
|
(vector-ref studio 0))
|
|
(goto-studio-detail-view! db state (vector-ref studio 1)))
|
|
(other (render-key-press state other))))
|
|
|
|
(('find kind _ form form-fields)
|
|
(match ch
|
|
(#\esc
|
|
(unpost-form form)
|
|
(set-interactive-state-in-form! state #f)
|
|
(goto-top-view! db state))
|
|
(#\newline
|
|
(form-driver form REQ_LAST_FIELD) ;; quirk
|
|
(unpost-form form)
|
|
(set-interactive-state-in-form! state #f)
|
|
(goto-find-results-view!
|
|
db
|
|
state
|
|
kind
|
|
(strip-trailing-whitespace (field-buffer (first form-fields) 0))))
|
|
(other (update-form! form ch))))
|
|
|
|
(('find-results #f _ ...)
|
|
(match ch
|
|
(#\esc (goto-top-view! db state))
|
|
(other (render-key-press state other))))
|
|
(('find-results menu _ kind _)
|
|
(update-menu! menu ch)
|
|
(match ch
|
|
(#\newline
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #f)
|
|
(match kind
|
|
('idols
|
|
(goto-idol-detail-view! db state
|
|
(item-name (current-item menu))))
|
|
('volumes
|
|
(goto-volume-detail-view! db state
|
|
(item-name (current-item menu))))))
|
|
(#\esc
|
|
(unpost-menu menu)
|
|
(set-interactive-state-in-menu! state #f)
|
|
(goto-top-view! db state))
|
|
(other (render-key-press state other))))
|
|
|
|
(_
|
|
(endwin)
|
|
(exit 128))
|
|
))
|
|
|
|
(define (update-form! form ch)
|
|
(match ch
|
|
(258 ;; KEY_DOWN
|
|
(form-driver form REQ_NEXT_FIELD)
|
|
(form-driver form REQ_END_LINE))
|
|
(259 ;; KEY_UP
|
|
(form-driver form REQ_PREV_FIELD)
|
|
(form-driver form REQ_END_LINE))
|
|
(260 ;; KEY_LEFT
|
|
(form-driver form REQ_PREV_CHAR))
|
|
(261 ;; KEY_RIGHT
|
|
(form-driver form REQ_NEXT_CHAR))
|
|
(262 ;; KEY_HOME
|
|
(form-driver form REQ_BEG_FIELD))
|
|
(263 ;; KEY_BACKSPACE
|
|
(form-driver form REQ_DEL_PREV))
|
|
(330 ;; KEY_DC (delete)
|
|
(form-driver form REQ_DEL_CHAR))
|
|
(360 ;; KEY_END
|
|
(form-driver form REQ_END_FIELD))
|
|
(other
|
|
(form-driver form other))))
|
|
(define (update-menu! menu ch)
|
|
(match ch
|
|
(258 ;; KEY_DOWN
|
|
(menu-driver menu REQ_DOWN_ITEM))
|
|
(259 ;; KEY_UP
|
|
(menu-driver menu REQ_UP_ITEM))
|
|
(338 ;; KEY_NPAGE
|
|
(menu-driver menu REQ_SCR_DPAGE))
|
|
(339 ;; KEY_PPAGE
|
|
(menu-driver menu REQ_SCR_UPAGE))
|
|
(262 ;; KEY_HOME
|
|
(menu-driver menu REQ_FIRST_ITEM))
|
|
(360 ;; KEY_END
|
|
(menu-driver menu REQ_LAST_ITEM))
|
|
(other (noop))))
|
|
|
|
(define (history? state)
|
|
(not (null? (interactive-state-history state))))
|
|
(define (history-delete! state)
|
|
(set-interactive-state-history! state (list)))
|
|
(define (history-push! state expr)
|
|
(set-interactive-state-history!
|
|
state
|
|
(cons expr (interactive-state-history state))))
|
|
(define (history-pop! db state)
|
|
(let* ((history (interactive-state-history state))
|
|
(expr (car history))
|
|
(expr-fn (car expr))
|
|
(expr-args (cdr expr))
|
|
(new-history (cdr history)))
|
|
|
|
(set-interactive-state-history! state new-history)
|
|
(apply expr-fn (cons* db state expr-args))))
|
|
|
|
(define (goto-top-view! db state)
|
|
(set-interactive-state-view!
|
|
state
|
|
(list
|
|
'top
|
|
(vector-ref (param-query-one db count-idols-stmt) 0)
|
|
(vector-ref (param-query-one db count-notes-stmt) 0)
|
|
(vector-ref (param-query-one db count-studios-stmt) 0)
|
|
(vector-ref (param-query-one db count-tags-stmt) 0)
|
|
(vector-ref (param-query-one db count-volumes-stmt) 0)
|
|
)))
|
|
|
|
(define (goto-find-view! db state kind)
|
|
(set-interactive-state-view! state (list 'find
|
|
kind
|
|
#t
|
|
#f
|
|
#f)))
|
|
|
|
(define* (goto-find-results-view! db state search-kind search-string)
|
|
(let* ((result-items
|
|
(match search-kind
|
|
('idols
|
|
(param-query-map
|
|
db
|
|
(lambda (idx result)
|
|
(new-item
|
|
(vector-ref result 0)
|
|
(idol-desc result)))
|
|
search-idols-stmt
|
|
search-string
|
|
search-string))
|
|
('volumes
|
|
(param-query-map
|
|
db
|
|
(lambda (idx result)
|
|
(new-item
|
|
(vector-ref result 0)
|
|
(volume-desc result)))
|
|
search-volumes-stmt
|
|
search-string
|
|
search-string))))
|
|
(result-menu (if (null? result-items)
|
|
#f
|
|
(new-menu result-items))))
|
|
|
|
(set-interactive-state-view! state (list 'find-results
|
|
result-menu
|
|
#t
|
|
search-kind
|
|
search-string))))
|
|
|
|
(define (goto-idols-view! db state)
|
|
(let* ((idol-items (param-query-map
|
|
db
|
|
(lambda (idx idol) (new-item (vector-ref idol 0)
|
|
(idol-desc idol)))
|
|
select-all-idols-stmt))
|
|
(idol-menu (if (null? idol-items)
|
|
#f
|
|
(new-menu idol-items))))
|
|
|
|
(set-interactive-state-view! state (list 'idols idol-menu #t))))
|
|
|
|
(define* (goto-idol-detail-view! db state idol-name)
|
|
(let* ((idol-row (param-query-one db select-idol-stmt idol-name))
|
|
(idol-id (vector-ref idol-row 0))
|
|
(tags (param-query-all db select-idol-tags-stmt idol-id))
|
|
(volumes (param-query-map
|
|
db
|
|
(lambda (count volume) (new-item (vector-ref volume 0)
|
|
(volume-desc volume)))
|
|
select-idol-volumes-stmt
|
|
idol-id))
|
|
(notes (param-query-all db select-idol-notes-stmt idol-id))
|
|
(volumes-menu (if (null? volumes)
|
|
#f
|
|
(new-menu volumes))))
|
|
|
|
(set-interactive-state-view! state (list 'idol
|
|
volumes-menu
|
|
#t
|
|
idol-row
|
|
tags
|
|
notes))))
|
|
|
|
(define (goto-studios-view! db state)
|
|
(let* ((studio-items (param-query-map
|
|
db
|
|
(lambda (idx studio) (new-item (vector-ref studio 0)
|
|
(studio-desc studio)))
|
|
select-all-studios-stmt))
|
|
(studio-menu (if (null? studio-items)
|
|
#f
|
|
(new-menu studio-items))))
|
|
|
|
(set-interactive-state-view! state (list 'studios studio-menu #t))))
|
|
|
|
(define (goto-studio-detail-view! db state callsign)
|
|
(let* ((studio-row (param-query-one db select-studio-stmt callsign))
|
|
(studio-id (vector-ref studio-row 0))
|
|
(tags (param-query-all db select-studio-tags-stmt studio-id))
|
|
(notes (param-query-all db select-studio-notes-stmt studio-id))
|
|
(volumes (param-query-map
|
|
db
|
|
(lambda (idx volume) (new-item (vector-ref volume 0)
|
|
(volume-desc volume)))
|
|
select-studio-volumes-stmt
|
|
studio-id))
|
|
(volumes-menu (if (null? volumes)
|
|
#f
|
|
(new-menu volumes))))
|
|
|
|
(set-interactive-state-view! state (list 'studio
|
|
volumes-menu
|
|
#t
|
|
studio-row
|
|
tags
|
|
notes))))
|
|
|
|
(define (goto-volumes-view! db state)
|
|
(let* ((volume-items (param-query-map
|
|
db
|
|
(lambda (idx volume) (new-item (vector-ref volume 0)
|
|
(volume-desc volume)))
|
|
select-all-volumes-stmt))
|
|
(volume-menu (if (null? volume-items)
|
|
#f
|
|
(new-menu volume-items))))
|
|
(set-interactive-state-view! state (list 'volumes volume-menu #t))))
|
|
|
|
|
|
(define (goto-volume-detail-view! db state identifier)
|
|
(let* ((volume-row (param-query-one db select-volume-stmt identifier))
|
|
(volume-id (vector-ref volume-row 0))
|
|
(tags (param-query-all db select-volume-tags-stmt volume-id))
|
|
(idols (param-query-map
|
|
db
|
|
(lambda (count idol) (new-item (vector-ref idol 0)
|
|
(idol-desc idol)))
|
|
select-volume-idols-stmt
|
|
volume-id))
|
|
(notes (param-query-all db select-volume-notes-stmt volume-id))
|
|
(idols-menu (if (null? idols)
|
|
#f
|
|
(new-menu idols))))
|
|
|
|
(set-interactive-state-view! state (list 'volume
|
|
idols-menu
|
|
#t
|
|
volume-row
|
|
tags
|
|
notes))))
|
|
|
|
(define (render-view win state)
|
|
(let ((legend-win (interactive-state-legend-win state))
|
|
(info-win (interactive-state-info-win state))
|
|
(display-win (interactive-state-display-win state))
|
|
)
|
|
(unless (or (interactive-state-in-menu state)
|
|
(interactive-state-in-form state))
|
|
(erase legend-win)
|
|
(erase info-win)
|
|
(erase display-win)
|
|
|
|
(box legend-win (acs-vline) (acs-hline))
|
|
(box info-win (acs-vline) (acs-hline))
|
|
(box display-win (acs-vline) (acs-hline)))
|
|
|
|
(match (interactive-state-view state)
|
|
(('top . args)
|
|
(apply top-view (cons state args)))
|
|
|
|
(('idol menu #f _ ...) (noop))
|
|
(('idol menu #t idol tags notes)
|
|
(idol-detail-view state menu idol tags notes))
|
|
(('idols _ #f) (noop))
|
|
(('idols #f #t)
|
|
(render-legend state (list '(" ESC " "Back")))
|
|
(render-info state (list (list "No idols!"))))
|
|
(('idols menu #t)
|
|
(menu-view
|
|
state
|
|
"Idols"
|
|
menu
|
|
(lambda () (mark-view-rendered! state))))
|
|
|
|
(('volume _ #f _ ...) (noop))
|
|
(('volume menu #t volume tags notes)
|
|
(volume-detail-view state menu volume tags notes))
|
|
(('volumes _ #f) (noop))
|
|
(('volumes #f #t)
|
|
(render-legend state (list '(" ESC " "Back")))
|
|
(render-info state (list (list "No volumes!"))))
|
|
(('volumes menu #t)
|
|
(menu-view
|
|
state
|
|
"Volumes"
|
|
menu
|
|
(lambda () (mark-view-rendered! state))))
|
|
|
|
(('studio menu #f _ ...) (noop))
|
|
(('studio menu #t studio tags notes)
|
|
(studio-detail-view state menu studio tags notes))
|
|
(('studios _ #f) (noop))
|
|
(('studios #f #t)
|
|
(render-legend state (list '(" ESC " "Back")))
|
|
(render-info state (list (list "No studios!"))))
|
|
(('studios menu #t)
|
|
(menu-view
|
|
state
|
|
"Studios"
|
|
menu
|
|
(lambda () (mark-view-rendered! state))))
|
|
|
|
(('find _ #f _ _) (noop))
|
|
(('find kind #t #f #f)
|
|
(form-view
|
|
state
|
|
(string-append
|
|
"Search "
|
|
(match kind
|
|
('idols "Idols")
|
|
('volumes "Volumes")))
|
|
'("Search")
|
|
(lambda (form form-fields)
|
|
(mark-view-rendered! state)
|
|
(list-set! (interactive-state-view state) 3 form)
|
|
(list-set! (interactive-state-view state) 4 form-fields)
|
|
)))
|
|
|
|
(('find-results _ #f _ ...) (noop))
|
|
(('find-results #f #t _ ...)
|
|
(render-legend state (list '(" ESC " "Back")))
|
|
(render-info state (list (list "No results!"))))
|
|
(('find-results menu #t kind query)
|
|
(menu-view
|
|
state
|
|
(string-append
|
|
(match kind
|
|
('idols "Idols: ")
|
|
('volumes "Volumes: "))
|
|
query)
|
|
menu
|
|
(lambda () (mark-view-rendered! state))))
|
|
|
|
('tags
|
|
(endwin)
|
|
(exit 9)) ;; TODO
|
|
)
|
|
|
|
(refresh win)
|
|
(refresh legend-win)
|
|
(refresh info-win)
|
|
(refresh display-win)
|
|
))
|
|
|
|
(define (mark-view-rendered! state)
|
|
(list-set! (interactive-state-view state) 2 #f))
|
|
(define (mark-view-not-rendered! state)
|
|
(list-set! (interactive-state-view state) 2 #t))
|
|
|
|
(define (top-view state ct-idol ct-note ct-studio ct-tag ct-vol)
|
|
(let ((legend-win (interactive-state-legend-win state))
|
|
(info-win (interactive-state-info-win state))
|
|
(display-win (interactive-state-display-win state))
|
|
|
|
(line-length (length splash-lines))
|
|
(line-width (string-length (first splash-lines)))
|
|
(draw (lambda (w y) (lambda (x ch) (addch w (bold ch) #:y y #:x x))))
|
|
)
|
|
|
|
(render-legend
|
|
state
|
|
(list '(#\F "Search Idols")
|
|
'(#\G "Search Volumes")
|
|
#f
|
|
'(#\I "Idols")
|
|
'(#\V "Volumes")
|
|
'(#\S "Studios")
|
|
;; '(#\T "Tags")
|
|
#f
|
|
'(#\Q "Quit")
|
|
))
|
|
|
|
(render-info
|
|
state
|
|
(list (list "~a volumes" ct-vol)
|
|
(list "~a idols" ct-idol)
|
|
(list "~a studios" ct-studio)
|
|
(list "~a tags" ct-tag)
|
|
(list "~a notes" ct-note)
|
|
))
|
|
|
|
(for-each
|
|
(lambda (y line)
|
|
(for-each (draw display-win y) (iota line-width 8) (string->list line))
|
|
(noop))
|
|
(iota line-length 8)
|
|
splash-lines)
|
|
))
|
|
|
|
(define (find-results-view state)
|
|
(noop)
|
|
)
|
|
|
|
(define (idol-detail-view state menu idol tags notes)
|
|
(let* ((legend-win (interactive-state-legend-win state))
|
|
(info-win (interactive-state-info-win state))
|
|
(display-win (interactive-state-display-win state))
|
|
(display-minx (getbegx display-win))
|
|
(display-maxx (getmaxx display-win))
|
|
(display-width (- display-maxx display-minx))
|
|
|
|
(raw-rating (vector-ref idol 2))
|
|
(raw-dob (vector-ref idol 1))
|
|
(rating (if raw-rating
|
|
(format #f "~7d" raw-rating)
|
|
"Unrated"))
|
|
(dob (if raw-dob raw-dob "Unknown"))
|
|
|
|
(title (vector-ref idol 3))
|
|
(row 3)
|
|
(col 2)
|
|
)
|
|
|
|
(addstr display-win (format #f "Born: ~a" dob) #:y row #:x col)
|
|
(set! row (+ 1 row))
|
|
(addstr display-win (format #f "Rating: ~a" rating) #:y row #:x col)
|
|
(set! row (+ 2 row))
|
|
(addstr display-win "Tags:" #:y row #:x col)
|
|
|
|
(let ((line ""))
|
|
(for-each
|
|
(lambda (tag-row)
|
|
(let ((tag-name (vector-ref tag-row 0)))
|
|
(if (< (- display-width 2 col)
|
|
(+ (string-length line) 1 (string-length tag-name)))
|
|
(begin
|
|
(set! row (+ 1 row))
|
|
(addstr display-win line #:y row #:x col)
|
|
(set! line ""))
|
|
(set! line (string-append/shared line " " tag-name)))
|
|
))
|
|
tags)
|
|
|
|
(set! row (+ 1 row))
|
|
(addstr display-win line #:y row #:x col))
|
|
|
|
(set! row (+ 2 row))
|
|
(addstr display-win "Volumes:" #:y row #:x col)
|
|
(set! row (+ 1 row))
|
|
(if menu
|
|
(menu-view
|
|
state
|
|
title
|
|
menu
|
|
(lambda () (mark-view-rendered! state))
|
|
#:my row
|
|
#:addl-legend '((" I " "Idols")
|
|
(" T " "Top")
|
|
))
|
|
(let* ((display-maxx (getmaxx display-win))
|
|
(display-width (- display-maxx display-minx 4))
|
|
(display-center (floor (/ display-maxx 2))))
|
|
|
|
(render-legend state (list '(" ESC " "Back")))
|
|
(addstr display-win title #:y 0 #:x display-center)))
|
|
))
|
|
|
|
(define (studio-detail-view state menu studio tags notes)
|
|
(let* ((legend-win (interactive-state-legend-win state))
|
|
(info-win (interactive-state-info-win state))
|
|
(display-win (interactive-state-display-win state))
|
|
(display-minx (getbegx display-win))
|
|
(display-maxx (getmaxx display-win))
|
|
(display-width (- display-maxx display-minx))
|
|
|
|
(raw-rating (vector-ref studio 3))
|
|
(rating (if raw-rating
|
|
(format #f "~7d" raw-rating)
|
|
"Unrated"))
|
|
|
|
(title (vector-ref studio 1))
|
|
(row 3)
|
|
(col 2)
|
|
)
|
|
|
|
(addstr display-win (format #f "Rating: ~a" rating) #:y row #:x col)
|
|
(set! row (+ 2 row))
|
|
(addstr display-win "Tags:" #:y row #:x col)
|
|
|
|
(let ((line ""))
|
|
(for-each
|
|
(lambda (tag-row)
|
|
(let ((tag-name (vector-ref tag-row 0)))
|
|
(if (< (- display-width 2 col)
|
|
(+ (string-length line) 1 (string-length tag-name)))
|
|
(begin
|
|
(set! row (+ 1 row))
|
|
(addstr display-win line #:y row #:x col)
|
|
(set! line ""))
|
|
(set! line (string-append/shared line " " tag-name)))
|
|
))
|
|
tags)
|
|
|
|
(set! row (+ 1 row))
|
|
(addstr display-win line #:y row #:x col))
|
|
|
|
(set! row (+ 2 row))
|
|
(addstr display-win "Volumes:" #:y row #:x col)
|
|
(set! row (+ 1 row))
|
|
(if menu
|
|
(menu-view
|
|
state
|
|
title
|
|
menu
|
|
(lambda () (mark-view-rendered! state))
|
|
#:my row
|
|
#:addl-legend '((" S " "Studios")
|
|
(" T " "Top")
|
|
))
|
|
(let* ((display-maxx (getmaxx display-win))
|
|
(display-width (- display-maxx display-minx 4))
|
|
(display-center (floor (/ display-maxx 2))))
|
|
|
|
(render-legend state (list '(" ESC " "Back")))
|
|
(addstr display-win title #:y 0 #:x display-center)))))
|
|
|
|
(define (volume-detail-view state menu volume tags notes)
|
|
(let* ((legend-win (interactive-state-legend-win state))
|
|
(info-win (interactive-state-info-win state))
|
|
(display-win (interactive-state-display-win state))
|
|
(display-minx (getbegx display-win))
|
|
(display-maxx (getmaxx display-win))
|
|
(display-width (- display-maxx display-minx))
|
|
|
|
(raw-rating (vector-ref volume 3))
|
|
(raw-published (vector-ref volume 4))
|
|
(rating (if raw-rating
|
|
(format #f "~7d" raw-rating)
|
|
"Unrated"))
|
|
(published (if raw-published raw-published "Unknown"))
|
|
|
|
(title (vector-ref volume 1))
|
|
(row 3)
|
|
(col 2)
|
|
)
|
|
|
|
(addstr display-win (format #f "Published: ~a" published) #:y row #:x col)
|
|
(set! row (+ 1 row))
|
|
(addstr display-win (format #f "Rating: ~a" rating) #:y row #:x col)
|
|
(set! row (+ 2 row))
|
|
(addstr display-win "Tags:" #:y row #:x col)
|
|
|
|
(let ((line ""))
|
|
(for-each
|
|
(lambda (tag-row)
|
|
(let ((tag-name (vector-ref tag-row 0)))
|
|
(if (< (- display-width 2 col)
|
|
(+ (string-length line) 1 (string-length tag-name)))
|
|
(begin
|
|
(set! row (+ 1 row))
|
|
(addstr display-win line #:y row #:x col)
|
|
(set! line ""))
|
|
(noop))
|
|
(set! line (string-append/shared line " " tag-name))
|
|
))
|
|
tags)
|
|
|
|
(set! row (+ 1 row))
|
|
(addstr display-win line #:y row #:x col))
|
|
|
|
(set! row (+ 2 row))
|
|
(addstr display-win "Idols:" #:y row #:x col)
|
|
(set! row (+ 1 row))
|
|
(if menu
|
|
(menu-view
|
|
state
|
|
title
|
|
menu
|
|
(lambda () (mark-view-rendered! state))
|
|
#:my row
|
|
#:addl-legend '((" T " "Top"))
|
|
)
|
|
(let* ((display-maxx (getmaxx display-win))
|
|
(display-width (- display-maxx display-minx 4))
|
|
(display-center (floor (/ display-maxx 2))))
|
|
|
|
(render-legend state (list '(" ESC " "Back")))
|
|
(addstr display-win title #:y 0 #:x display-center)))
|
|
))
|
|
|
|
(define* (menu-view state title menu after-post-hook
|
|
#:key
|
|
mh ;menu-height
|
|
my ;menu-y
|
|
(addl-legend (list)))
|
|
(let* ((legend-win (interactive-state-legend-win state))
|
|
(info-win (interactive-state-info-win state))
|
|
(display-win (interactive-state-display-win state))
|
|
(display-maxy (getmaxy display-win))
|
|
(display-minx (getbegx display-win))
|
|
(display-maxx (getmaxx display-win))
|
|
(display-width (- display-maxx display-minx 4))
|
|
(display-center (floor (/ display-maxx 2)))
|
|
)
|
|
|
|
(render-legend state (cons* '(" ESC " "Back")
|
|
'("ENTER" "Details")
|
|
'("ARROW" "Select")
|
|
addl-legend))
|
|
|
|
(addstr display-win title #:y 0 #:x display-center)
|
|
(set-menu-win! menu display-win)
|
|
(let* ((menu-width display-width)
|
|
(menu-x 3)
|
|
(menu-y (or my 3))
|
|
(menu-height (or mh (- display-maxy menu-y)))
|
|
)
|
|
(set-menu-sub! menu (derwin display-win
|
|
menu-height
|
|
menu-width
|
|
menu-y
|
|
menu-x)))
|
|
(post-menu menu)
|
|
(after-post-hook)
|
|
(set-interactive-state-in-menu! state #t)
|
|
))
|
|
|
|
(define* (form-view state title form-labels callback
|
|
#:key (addl-legend (list)))
|
|
(let* ((legend-win (interactive-state-legend-win state))
|
|
(info-win (interactive-state-info-win state))
|
|
(display-win (interactive-state-display-win state))
|
|
(display-maxy (getmaxy display-win))
|
|
(display-minx (getbegx display-win))
|
|
(display-maxx (getmaxx display-win))
|
|
(display-width (- display-maxx display-minx 4))
|
|
(display-center (floor (/ display-maxx 2)))
|
|
|
|
(label-width (apply max (map string-length form-labels)))
|
|
(field-width (- display-width 2 label-width 5))
|
|
(field-starty (+ 3 label-width))
|
|
|
|
(row 0)
|
|
(col 2)
|
|
(form-fields #nil)
|
|
(form #nil)
|
|
)
|
|
|
|
(render-legend state (cons* '(" ESC " "Cancel")
|
|
'("ARROW" "Move cursor")
|
|
'("ENTER" "Done")
|
|
addl-legend))
|
|
|
|
(addstr display-win title #:y 0 #:x display-center)
|
|
|
|
(set! form-fields
|
|
(map
|
|
(lambda (label)
|
|
(let ((field
|
|
(new-field 1 field-width row field-starty 0 0)))
|
|
(set! row (+ 2 row))
|
|
(set-field-back! field A_UNDERLINE)
|
|
(field-opts-off! field O_AUTOSKIP)
|
|
field))
|
|
form-labels))
|
|
(set! form (new-form form-fields))
|
|
(set-form-win! form display-win)
|
|
(set-form-sub! form (derwin display-win
|
|
(+ 1 (* 2 (length form-labels)))
|
|
(- display-width 2)
|
|
3
|
|
1))
|
|
(post-form form)
|
|
|
|
(set! row 3)
|
|
(for-each
|
|
(lambda (label)
|
|
(addstr display-win (string-append label ": ")
|
|
#:y row #:x col)
|
|
(set! row (+ 2 row)))
|
|
form-labels)
|
|
|
|
(callback form form-fields)
|
|
(set-interactive-state-in-form! state #t)
|
|
))
|
|
|
|
(define (render-legend state items)
|
|
(let ((legend-win (interactive-state-legend-win state))
|
|
(items-length (length items)))
|
|
|
|
(for-each
|
|
(lambda (item line-idx)
|
|
(match item
|
|
((char title) (addstr legend-win
|
|
(format #f "[~a] ~a" char title)
|
|
#:y line-idx
|
|
#:x 1))
|
|
(#f (noop))))
|
|
items
|
|
(iota items-length 1))))
|
|
|
|
(define (render-info state items)
|
|
(let ((info-win (interactive-state-info-win state))
|
|
(items-length (length items)))
|
|
|
|
(for-each
|
|
(lambda (item line-idx)
|
|
(match item
|
|
((_ . _) (addstr info-win
|
|
(apply format (cons #f item))
|
|
#:y line-idx
|
|
#:x 1))
|
|
(#f (noop))))
|
|
items
|
|
(iota items-length 1))))
|
|
|
|
(define (render-key-press state ch)
|
|
(let* ((info-win (interactive-state-info-win state))
|
|
(info-maxy (getmaxy info-win))
|
|
(better-ch (if (eqv? ch #\newline) "NL" ch))
|
|
)
|
|
|
|
(addstr info-win
|
|
(format #f "Key pressed: ~a " better-ch)
|
|
#:y (- info-maxy 2) #:x 2)
|
|
))
|
|
|
|
(define (idol-desc idol-row)
|
|
(let* ((raw-rating (vector-ref idol-row 2))
|
|
(raw-dob (vector-ref idol-row 1))
|
|
(rating (if raw-rating
|
|
(format #f "~7d" raw-rating)
|
|
"Unrated"))
|
|
(dob (if raw-dob raw-dob "Unknown")))
|
|
|
|
(format #f "Rating: ~a Born: ~a"
|
|
rating
|
|
dob)))
|
|
|
|
(define (studio-desc studio-row)
|
|
(let* ((raw-rating (vector-ref studio-row 2))
|
|
(rating (if raw-rating
|
|
(format #f "~7d" raw-rating)
|
|
"Unrated"))
|
|
(raw-name (vector-ref studio-row 1))
|
|
(name (if raw-name
|
|
(format #f "Full name: ~a" raw-name)
|
|
"")))
|
|
|
|
(format #f "Rating: ~a ~a"
|
|
rating
|
|
name)))
|
|
|
|
(define (volume-desc volume-row)
|
|
(let* ((raw-rating (vector-ref volume-row 2))
|
|
(raw-pub (vector-ref volume-row 1))
|
|
(rating (if raw-rating
|
|
(format #f "~7d" raw-rating)
|
|
"Unrated"))
|
|
(pub (if raw-pub raw-pub "Unknown")))
|
|
|
|
(format #f "Rating: ~a Published: ~a"
|
|
rating
|
|
pub)))
|
|
|
|
(define splash-lines
|
|
(list
|
|
" ority nio un or io junio nior uniority "
|
|
" ity ior ni rit or nio uniority niorityjun"
|
|
" tyj ori io ityj ri ior uni yju ior juni"
|
|
" yju rit or tyjun it ori ni un ori nio"
|
|
" jun ity ri yju io ty rit io ni rit nior"
|
|
" uni tyj it jun ri yj ity or io ityjuniori"
|
|
" nio yju ty uni tyju tyj ri or tyjunior "
|
|
" yj ior jun yj nio jun yju it ri yju or "
|
|
" ju ori unio yju ior ni jun tyj rit jun it "
|
|
" uniorit iorityju ori io uni juniorit uni yj "
|
|
" iorit ityj rit or unior iori nio un"
|
|
" "
|
|
" iorit niorityjun ori io"
|
|
" A gravure organizer. rit iorityjuni rit or"
|
|
" Powered by ncurses and sqlite. ity yju ity ri"
|
|
" Written in GNU Guile. tyj jun yju ri "
|
|
" yju uni uni ri "
|
|
" Other tools: jun nio iori "
|
|
" - juniority-import uni ior rit "
|
|
" - juniority-lookup nio ori ity "
|
|
" ior rit tyj "
|
|
" ori ity yju "
|
|
" ority tyj jun "
|
|
" "
|
|
" v0.1.0 pre-alpha "
|
|
))
|