syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

WIP

This commit is contained in:
Tony Garnock-Jones 2016-09-12 15:56:21 -04:00
parent 723d3f4046
commit 6a8c26b364
1 changed files with 21 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
racket/syndicate-ide/wm.rkt
View File

@ -284,9 +284,10 @@
(define-values (_last-pos entries-rev) (define-values (_last-pos entries-rev)
(for/fold [(pos (if vertical? top left)) (entries-rev '())] (for/fold [(pos (if vertical? top left)) (entries-rev '())]
[(entry candidates) (item items) (actual-size actual-sizes)] [(entry candidates) (item items) (actual-size actual-sizes)]
(define npos (+ pos actual-size))
(define rpos (round pos)) (define rpos (round pos))
(define size (- (round (+ pos actual-size)) rpos)) (define size (- (round npos) rpos))
(values (+ pos actual-size) (values npos
(cons (if vertical? (cons (if vertical?
(tbox-layout item (layout-option-info entry) rpos left width size) (tbox-layout item (layout-option-info entry) rpos left width size)
(tbox-layout item (layout-option-info entry) top rpos size height)) (tbox-layout item (layout-option-info entry) top rpos size height))
@ -355,14 +356,16 @@
(struct pretty-print-tbox (value mode) #:transparent (struct pretty-print-tbox (value mode) #:transparent
#:methods gen:tbox #:methods gen:tbox
[(define (tbox-layout-options t sw sh) [(define (tbox-layout-options t sw sh)
(define width-guess (sizing-ideal sw)) (let loop ((width-guess (sizing-ideal sw)))
(define height-guess (length (pretty-print-tbox-lines t (floor width-guess)))) (define height-guess (length (pretty-print-tbox-lines t (floor width-guess))))
(list (layout-option #f sw (sizing-adjust-ideal sh height-guess)))) (if (> height-guess (sizing-ideal sh))
(loop (if (< width-guess 10) 10 (* width-guess 9/8)))
(list (layout-option #f (sizing width-guess 0 width-guess) sh)))))
(define (tbox-render! t tty lo) (define (tbox-render! t tty lo)
(tty-goto tty (layout-top lo) (layout-left lo)) (for [(line (pretty-print-tbox-lines t (floor (layout-width lo))))
(for [(line (pretty-print-tbox-lines t (floor (layout-width lo))))] (row (in-range (layout-top lo) (+ (layout-top lo) (layout-height lo))))]
(tty-display tty line) (tty-goto tty row (layout-left lo))
(tty-goto tty (+ (tty-cursor-row tty) 1) (layout-left lo))))]) (tty-display tty line)))])
(define (pretty-print-tbox-contents t width) (define (pretty-print-tbox-contents t width)
(pretty-format (pretty-print-tbox-value t) (pretty-format (pretty-print-tbox-value t)
@ -458,8 +461,7 @@
(sizing h 0 h))) (sizing h 0 h)))
(define lo (tbox-layout widget (layout-option-info (car layouts)) 0 0 w h)) (define lo (tbox-layout widget (layout-option-info (car layouts)) 0 0 w h))
(tbox-render! widget tty lo)) (tbox-render! widget tty lo))
'write) 'write))
(vfil))
)) ))
(display (string-append (ansi:set-mode ansi:x11-focus-event-mode) (display (string-append (ansi:set-mode ansi:x11-focus-event-mode)
@ -477,9 +479,12 @@
(terminal-output tty)) (terminal-output tty))
(flush-output (terminal-output tty)))) (flush-output (terminal-output tty))))
(tbox-render-toplevel! toplevel-widget tty) (define (reset-and-rerender)
(tty-goto tty 0 0) (tty-reset tty)
(tbox-render-toplevel! toplevel-widget tty)
(tty-goto tty 0 0))
(reset-and-rerender)
(let loop () (let loop ()
(tty-flush tty) (tty-flush tty)
(tbox-render-toplevel! toplevel-widget tty) (tbox-render-toplevel! toplevel-widget tty)
@ -488,6 +493,9 @@
(lambda (k) (lambda (k)
(match k (match k
[(key #\q (== (set))) (void)] [(key #\q (== (set))) (void)]
[(key #\L (== (set 'control)))
(reset-and-rerender)
(loop)]
[_ [_
(tty-clear-to-eol tty) (tty-clear-to-eol tty)
(tty-display tty (format "~v" k)) (tty-display tty (format "~v" k))