Browse Source

implement viewing posts (only at top level lol)

main
haskal 1 month ago
parent
commit
1bf9edf368
3 changed files with 59 additions and 6 deletions
  1. +30
    -5
      framework.rkt
  2. +1
    -0
      fs.rkt
  3. +28
    -1
      tui.rkt

+ 30
- 5
framework.rkt View File

@@ -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
- 0
fs.rkt View File

@@ -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*


+ 28
- 1
tui.rkt View File

@@ -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…
Cancel
Save