scsh-conservatory
/
commander-s
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

split result window into result-window and result-frame-window

This commit is contained in:
eknauel 2005-05-19 13:59:52 +00:00
parent 214a66021f
commit 1e8cb9369c
1 changed files with 68 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
scheme/nuit-engine.scm
View File

@ -29,9 +29,12 @@
(define bar-1 #f) (define bar-1 #f)
(define bar-2 #f) (define bar-2 #f)
(define command-frame-window #f) (define command-frame-window #f)
(define command-window #f) (define command-window #f)
(define result-window #f) (define result-window #f)
(define result-frame-window #f)
(define shortcuts '("F1:Exit" (define shortcuts '("F1:Exit"
"F2:Repaint (after change of buffer size)" "F2:Repaint (after change of buffer size)"
@ -278,16 +281,21 @@
(paint) (paint)
(loop (wait-for-input)))) (loop (wait-for-input))))
((= ch 35)
(error "Is this what you want?"))
;; forward in result history ;; forward in result history
((= ch key-npage) ((= ch key-npage)
(history-forward) (history-forward)
(paint-result-window) (paint-result-window)
(refresh-result-window)
(loop (wait-for-input))) (loop (wait-for-input)))
;; back in result history ;; back in result history
((= ch key-ppage) ((= ch key-ppage)
(history-back) (history-back)
(paint-result-window) (paint-result-window)
(refresh-result-window)
(loop (wait-for-input))) (loop (wait-for-input)))
;;if lower window is active a message is sent. ;;if lower window is active a message is sent.
@ -304,11 +312,12 @@
97))) 97)))
(focus-result-buffer!) (focus-result-buffer!)
(set! current-result-object (switch key-message)) (set! current-result-object (switch key-message))
(paint-result-window)) (paint-result-window)
(refresh-result-window))
(begin (begin
(focus-command-buffer!) (focus-command-buffer!)
(paint-command-window-contents) (paint-command-window-contents)
(set! command-buffer (move-cursor command-buffer)))) (move-cursor command-buffer)))
(set! c-x-pressed #f) (set! c-x-pressed #f)
(loop (wait-for-input))) (loop (wait-for-input)))
@ -358,6 +367,7 @@
ch))) ch)))
(set! current-result-object (switch key-message)) (set! current-result-object (switch key-message))
(paint-result-window) (paint-result-window)
(refresh-result-window)
(loop (wait-for-input))) (loop (wait-for-input)))
(cond (cond
@ -373,21 +383,21 @@
command-buffer command-buffer
(- (length (buffer-text command-buffer)) 1)) (- (length (buffer-text command-buffer)) 1))
(paint-result-window) (paint-result-window)
(refresh-result-window)
(paint-bar-2) (paint-bar-2)
(paint-command-window-contents) (paint-command-window-contents)
(set! command-buffer (move-cursor command-buffer)) (move-cursor command-buffer)
(refresh-command-window) (refresh-command-window)
(loop (wait-for-input)))) (loop (wait-for-input))))
(else (else
(set! command-buffer (input command-buffer ch)) (input command-buffer ch)
(debug-message "loop after input " command-buffer) ;(debug-message "loop after input " command-buffer)
(werase (app-window-curses-win command-window)) (werase (app-window-curses-win command-window))
(set! command-buffer (print-command-buffer (app-window-curses-win command-window)
(print-command-buffer (app-window-curses-win command-window) command-buffer)
command-buffer)) ;(debug-message "loop after print-command-buffer " command-buffer)
(debug-message "loop after print-command-buffer " command-buffer) (move-cursor command-buffer)
(set! command-buffer (move-cursor command-buffer))
(refresh-command-window) (refresh-command-window)
(loop (wait-for-input)))))))))) (loop (wait-for-input))))))))))
@ -397,6 +407,13 @@
(newwin (app-window-height window) (app-window-width window) (newwin (app-window-height window) (app-window-width window)
(app-window-y window) (app-window-x window)))) (app-window-y window) (app-window-x window))))
(define (make-inlying-app-window outer-window)
(make-app-window (+ (app-window-x outer-window) 1)
(+ (app-window-y outer-window) 1)
(- (app-window-width outer-window) 2)
(- (app-window-height outer-window) 2)
#f))
(define (init-windows!) (define (init-windows!)
(init-screen) (init-screen)
(set! bar-1 (set! bar-1
@ -411,32 +428,29 @@
(make-app-window 1 2 (make-app-window 1 2
(- (COLS) 2) (- (app-window-y bar-2) 2) (- (COLS) 2) (- (app-window-y bar-2) 2)
#f)) #f))
(set! command-window (set! command-window
(make-app-window (+ (app-window-x command-frame-window) 1) (make-inlying-app-window command-frame-window))
(+ (app-window-y command-frame-window) 1) (set! result-frame-window
(- (app-window-width command-frame-window) 2)
(- (app-window-height command-frame-window) 2)
#f))
(set! result-window
(make-app-window 1 (+ (app-window-y bar-2) 3) (make-app-window 1 (+ (app-window-y bar-2) 3)
(- (COLS) 2) (- (COLS) 2)
(- (- (LINES) 6) (app-window-height command-frame-window)) (- (- (LINES) 6) (app-window-height command-frame-window))
#f)) #f))
(window-init-curses-win! bar-1) (set! result-window
(window-init-curses-win! bar-2) (make-inlying-app-window result-frame-window))
(window-init-curses-win! command-frame-window)
(window-init-curses-win! command-window) (let ((all-windows (list bar-1 bar-2
(window-init-curses-win! result-window) command-frame-window command-window
(debug-message "init-windows!: bar-1 " bar-1 " bar-2 " bar-2 result-frame-window result-window)))
" command-frame-window " command-frame-window (for-each window-init-curses-win! all-windows)
" command-window " command-window
" result-window " result-window) (debug-message "init-windows!: bar-1 " bar-1 " bar-2 " bar-2
(wclear (app-window-curses-win bar-1)) " command-frame-window " command-frame-window
(wclear (app-window-curses-win bar-2)) " command-window " command-window
(wclear (app-window-curses-win command-window)) " result-frame-window " result-frame-window
(wclear (app-window-curses-win command-frame-window)) " result-window " result-window)
(wclear (app-window-curses-win result-window)) (for-each wclear
(clear)) (map app-window-curses-win all-windows))
(clear)))
(define (paint-bar-1) (define (paint-bar-1)
(mvwaddstr (app-window-curses-win bar-1) 0 1 "SCSH-NUIT") (mvwaddstr (app-window-curses-win bar-1) 0 1 "SCSH-NUIT")
@ -458,20 +472,26 @@
(set-buffer-num-cols! command-buffer (set-buffer-num-cols! command-buffer
(- (app-window-width command-window) 3)) (- (app-window-width command-window) 3))
(werase (app-window-curses-win command-window)) (werase (app-window-curses-win command-window))
(set! command-buffer (print-command-buffer (app-window-curses-win command-window)
(print-command-buffer (app-window-curses-win command-window) command-buffer))
command-buffer)))
(define (refresh-command-window) (define (refresh-command-window)
(wrefresh (app-window-curses-win command-window))) (wrefresh (app-window-curses-win command-window)))
(define (paint-result-frame-window)
(let ((win (app-window-curses-win result-frame-window)))
(wclear win)
(box win (ascii->char 0) (ascii->char 0))
;;; EK: wtf is going on here?
(set! result-lines (- (app-window-height result-window) 2))
(set! result-cols (- (app-window-width result-window) 3))
(wrefresh win)))
(define (paint-result-window) (define (paint-result-window)
(wclear (app-window-curses-win result-window)) (wclear (app-window-curses-win result-window))
(box (app-window-curses-win result-window) (print-result-buffer))
(ascii->char 0) (ascii->char 0))
(set! result-lines (- (app-window-height result-window) 2)) (define (refresh-result-window)
(set! result-cols (- (app-window-width result-window) 3))
(print-result-buffer result-window)
(wrefresh (app-window-curses-win result-window))) (wrefresh (app-window-curses-win result-window)))
(define (paint) (define (paint)
@ -480,9 +500,11 @@
(paint-bar-2) (paint-bar-2)
(paint-command-frame-window) (paint-command-frame-window)
(paint-command-window-contents) (paint-command-window-contents)
(paint-result-frame-window)
(paint-result-window) (paint-result-window)
(move-cursor command-buffer) (move-cursor command-buffer)
(refresh-command-window)) (refresh-command-window)
(refresh-result-window))
(define (wait-for-input) (define (wait-for-input)
(noecho) (noecho)
@ -701,7 +723,7 @@
(wrefresh win)))))) (wrefresh win))))))
;;print the lower window ;;print the lower window
(define (print-result-buffer result-window) (define (print-result-buffer)
(let* ((window (app-window-curses-win result-window)) (let* ((window (app-window-curses-win result-window))
(print-message (make-print-message active-command (print-message (make-print-message active-command
current-result-object current-result-object
@ -746,18 +768,18 @@
(wattron window (A-REVERSE)) (wattron window (A-REVERSE))
(mvwaddstr window pos 1 line) (mvwaddstr window pos 1 line)
(wattrset window (A-NORMAL)) (wattrset window (A-NORMAL))
(wrefresh window) ;(wrefresh window)
(loop (+ pos 1))) (loop (+ pos 1)))
(if (member pos marked-lines) (if (member pos marked-lines)
(begin (begin
(wattron window (A-BOLD)) (wattron window (A-BOLD))
(mvwaddstr window pos 1 line) (mvwaddstr window pos 1 line)
(wattrset window (A-NORMAL)) (wattrset window (A-NORMAL))
(wrefresh window) ;(wrefresh window)
(loop (+ pos 1))) (loop (+ pos 1)))
(begin (begin
(mvwaddstr window pos 1 line) (mvwaddstr window pos 1 line)
(wrefresh window) ;(wrefresh window)
(loop (+ pos 1)))))))))))) (loop (+ pos 1))))))))))))
;;visible lines ;;visible lines
@ -798,7 +820,6 @@
;;Cursor ;;Cursor
;;move cursor to the corrct position ;;move cursor to the corrct position
(define (move-cursor buffer) (define (move-cursor buffer)
(debug-message "move-cursor " buffer)
(if (focus-on-command-buffer?) (if (focus-on-command-buffer?)
(cursor-right-pos (app-window-curses-win command-window) (cursor-right-pos (app-window-curses-win command-window)
buffer) buffer)
@ -821,8 +842,7 @@
(buffer-pos-fin-ln command-buffer))) (buffer-pos-fin-ln command-buffer)))
(let ((posx (modulo (buffer-pos-col command-buffer) (let ((posx (modulo (buffer-pos-col command-buffer)
(buffer-num-cols command-buffer)))) (buffer-num-cols command-buffer))))
(set-buffer-pos-x! command-buffer posx)) (set-buffer-pos-x! command-buffer posx)))
(debug-message "compute-y-x " command-buffer))
(begin (begin
(if (>= pos-result result-lines) (if (>= pos-result result-lines)
(set! result-buffer-pos-y result-lines) (set! result-buffer-pos-y result-lines)