implement viewing posts (only at top level lol)
This commit is contained in:
parent
36a48ab937
commit
1bf9edf368
|
@ -1,11 +1,12 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
(require racket/async-channel racket/class racket/format racket/function racket/list racket/match
|
(require racket/async-channel racket/class racket/format racket/function racket/list racket/match
|
||||||
|
racket/string
|
||||||
ansi lux raart)
|
ansi lux raart)
|
||||||
|
|
||||||
(provide activity% run-application
|
(provide activity% run-application
|
||||||
(struct-out app-event) fire-event
|
(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
|
;; internal synthetic event queue
|
||||||
(struct app-event [from tag data] #:transparent)
|
(struct app-event [from tag data] #:transparent)
|
||||||
|
@ -220,11 +221,35 @@
|
||||||
(define new-h (if (eq? h 'any) (raart-h rendered) h))
|
(define new-h (if (eq? h 'any) (raart-h rendered) h))
|
||||||
(matte new-w new-h rendered))))
|
(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%
|
(define table%
|
||||||
(class component%
|
(class component%
|
||||||
(init-field headers)
|
(init-field headers)
|
||||||
(init-field cells)
|
(init-field cells)
|
||||||
(init-field [flex-col 0])
|
(init-field [flex-col 0])
|
||||||
|
(inherit-field parent)
|
||||||
(super-new)
|
(super-new)
|
||||||
|
|
||||||
(define selected-row 0)
|
(define selected-row 0)
|
||||||
|
@ -267,13 +292,13 @@
|
||||||
(match e
|
(match e
|
||||||
[(or "<up>" "k")
|
[(or "<up>" "k")
|
||||||
(set! selected-row (max 0 (sub1 selected-row)))
|
(set! selected-row (max 0 (sub1 selected-row)))
|
||||||
(when (is-a? (get-field parent this) scroll-pane%)
|
(when (is-a? parent scroll-pane%)
|
||||||
(send (get-field parent this) focus-to (+ 0 (* 2 selected-row))))
|
(send parent focus-to (+ 0 (* 2 selected-row))))
|
||||||
#t]
|
#t]
|
||||||
[(or "<down>" "j")
|
[(or "<down>" "j")
|
||||||
(set! selected-row (min (sub1 (length cells)) (add1 selected-row)))
|
(set! selected-row (min (sub1 (length cells)) (add1 selected-row)))
|
||||||
(when (is-a? (get-field parent this) scroll-pane%)
|
(when (is-a? parent scroll-pane%)
|
||||||
(send (get-field parent this) focus-to (+ 5 (* 2 selected-row))))
|
(send parent focus-to (+ 5 (* 2 selected-row))))
|
||||||
#t]
|
#t]
|
||||||
["C-M" (fire-event this 'selection selected-row) #t]
|
["C-M" (fire-event this 'selection selected-row) #t]
|
||||||
[_ #f]))))
|
[_ #f]))))
|
||||||
|
|
1
fs.rkt
1
fs.rkt
|
@ -5,6 +5,7 @@
|
||||||
ffi/unsafe)
|
ffi/unsafe)
|
||||||
(provide (struct-out user) (struct-out post)
|
(provide (struct-out user) (struct-out post)
|
||||||
list-users get-posts dfs-modtime sorted-level
|
list-users get-posts dfs-modtime sorted-level
|
||||||
|
hash-ref*
|
||||||
*post-index*)
|
*post-index*)
|
||||||
|
|
||||||
(define *pub-path*
|
(define *pub-path*
|
||||||
|
|
29
tui.rkt
29
tui.rkt
|
@ -7,6 +7,29 @@
|
||||||
(define (timestamp->string ts)
|
(define (timestamp->string ts)
|
||||||
(date->string (seconds->date ts #t) #t))
|
(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%
|
(define meowbb-post-list%
|
||||||
(class activity%
|
(class activity%
|
||||||
(init-field posts)
|
(init-field posts)
|
||||||
|
@ -29,13 +52,17 @@
|
||||||
[body (new table%
|
[body (new table%
|
||||||
[headers '("title" "author" "updated")]
|
[headers '("title" "author" "updated")]
|
||||||
[cells entries])])]
|
[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])
|
(super-new [root root])
|
||||||
|
|
||||||
(define/override (on-event e)
|
(define/override (on-event e)
|
||||||
(match e
|
(match e
|
||||||
["q" 'quit]
|
["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]))))
|
[_ 'continue]))))
|
||||||
|
|
||||||
(define meowbb-forum-list%
|
(define meowbb-forum-list%
|
||||||
|
|
Loading…
Reference in New Issue