implement viewing posts (only at top level lol)
This commit is contained in:
parent
36a48ab937
commit
1bf9edf368
|
@ -1,11 +1,12 @@
|
|||
#lang racket/base
|
||||
|
||||
(require racket/async-channel racket/class racket/format racket/function racket/list racket/match
|
||||
racket/string
|
||||
ansi lux raart)
|
||||
|
||||
(provide activity% run-application
|
||||
(struct-out app-event) fire-event
|
||||
component% header/footer% scroll-pane% label% table%)
|
||||
component% header/footer% scroll-pane% label% table% text-pane%)
|
||||
|
||||
;; internal synthetic event queue
|
||||
(struct app-event [from tag data] #:transparent)
|
||||
|
@ -220,11 +221,35 @@
|
|||
(define new-h (if (eq? h 'any) (raart-h rendered) h))
|
||||
(matte new-w new-h rendered))))
|
||||
|
||||
;; a wrapped text pane
|
||||
;; some day we'll support formatting lol
|
||||
(define text-pane%
|
||||
(class component%
|
||||
(init content)
|
||||
(super-new)
|
||||
|
||||
(define processed-content
|
||||
(regexp-split #px"\r?\n" (regexp-replace* #px"\t" content " ")))
|
||||
|
||||
;; expects concrete w
|
||||
(define/override (draw size)
|
||||
(match-define (cons w h) size)
|
||||
(define paras (map (λ (c) (para w c)) processed-content))
|
||||
(define max-width
|
||||
(for/fold ([max-width 0]) ([p (in-list paras)])
|
||||
(max max-width (raart-w p))))
|
||||
(define rendered-content
|
||||
(vappend* (map (λ (p) (matte-at max-width (raart-h p) 0 0 p)) paras)))
|
||||
(match h
|
||||
['any rendered-content]
|
||||
[_ (crop 0 w 0 h rendered-content)]))))
|
||||
|
||||
(define table%
|
||||
(class component%
|
||||
(init-field headers)
|
||||
(init-field cells)
|
||||
(init-field [flex-col 0])
|
||||
(inherit-field parent)
|
||||
(super-new)
|
||||
|
||||
(define selected-row 0)
|
||||
|
@ -267,13 +292,13 @@
|
|||
(match e
|
||||
[(or "<up>" "k")
|
||||
(set! selected-row (max 0 (sub1 selected-row)))
|
||||
(when (is-a? (get-field parent this) scroll-pane%)
|
||||
(send (get-field parent this) focus-to (+ 0 (* 2 selected-row))))
|
||||
(when (is-a? parent scroll-pane%)
|
||||
(send parent focus-to (+ 0 (* 2 selected-row))))
|
||||
#t]
|
||||
[(or "<down>" "j")
|
||||
(set! selected-row (min (sub1 (length cells)) (add1 selected-row)))
|
||||
(when (is-a? (get-field parent this) scroll-pane%)
|
||||
(send (get-field parent this) focus-to (+ 5 (* 2 selected-row))))
|
||||
(when (is-a? parent scroll-pane%)
|
||||
(send parent focus-to (+ 5 (* 2 selected-row))))
|
||||
#t]
|
||||
["C-M" (fire-event this 'selection selected-row) #t]
|
||||
[_ #f]))))
|
||||
|
|
1
fs.rkt
1
fs.rkt
|
@ -5,6 +5,7 @@
|
|||
ffi/unsafe)
|
||||
(provide (struct-out user) (struct-out post)
|
||||
list-users get-posts dfs-modtime sorted-level
|
||||
hash-ref*
|
||||
*post-index*)
|
||||
|
||||
(define *pub-path*
|
||||
|
|
29
tui.rkt
29
tui.rkt
|
@ -7,6 +7,29 @@
|
|||
(define (timestamp->string ts)
|
||||
(date->string (seconds->date ts #t) #t))
|
||||
|
||||
(define meowbb-post-view%
|
||||
(class activity%
|
||||
(init-field posts)
|
||||
(init-field modtimes)
|
||||
(init-field path)
|
||||
|
||||
(define post (first (hash-ref (hash-ref* posts path) *post-index*)))
|
||||
|
||||
(define root
|
||||
(new header/footer%
|
||||
[header (new label% [label-text (format "meowbb : ~a"
|
||||
(cons (post-forum post) (post-path post)))])]
|
||||
[body (new scroll-pane%
|
||||
[body (new text-pane% [content (post-content post)])])]
|
||||
[footer (new label% [label-text "[JK] scroll | [Q] back"])]))
|
||||
|
||||
(super-new [root root])
|
||||
|
||||
(define/override (on-event e)
|
||||
(match e
|
||||
["q" 'quit]
|
||||
[_ 'continue]))))
|
||||
|
||||
(define meowbb-post-list%
|
||||
(class activity%
|
||||
(init-field posts)
|
||||
|
@ -29,13 +52,17 @@
|
|||
[body (new table%
|
||||
[headers '("title" "author" "updated")]
|
||||
[cells entries])])]
|
||||
[footer (new label% [label-text "[JK] navigate | [ENTER] select | [Q] quit"])]))
|
||||
[footer (new label% [label-text "[JK] navigate | [ENTER] select | [Q] back"])]))
|
||||
|
||||
(super-new [root root])
|
||||
|
||||
(define/override (on-event e)
|
||||
(match e
|
||||
["q" 'quit]
|
||||
[(app-event _ 'selection row)
|
||||
(define post (first (hash-ref (list-ref sorted row) *post-index*)))
|
||||
(new meowbb-post-view% [posts posts] [modtimes modtimes]
|
||||
[path (cons forum (post-path post))])]
|
||||
[_ 'continue]))))
|
||||
|
||||
(define meowbb-forum-list%
|
||||
|
|
Loading…
Reference in New Issue