First try to split up PAINT into multiple functions, thus, allowing to
repaint only parts of the screen. However, this commit introduces some funny display bugs. ;-)
This commit is contained in:
eknauel
parent
599021b937
commit
2353335d5e
|
|
@ -12,13 +12,19 @@
|
|||
;;*************************************************************************
|
||||
;;State
|
||||
|
||||
;;The different windows
|
||||
;;------------------------
|
||||
(define bar1)
|
||||
(define bar2)
|
||||
(define bar3)
|
||||
(define command-win)
|
||||
(define result-win)
|
||||
(define-record-type app-window :app-window
|
||||
(make-app-window x y width height curses-win)
|
||||
app-window?
|
||||
(x app-window-x)
|
||||
(y app-window-y)
|
||||
(width app-window-width)
|
||||
(height app-window-height)
|
||||
(curses-win app-window-curses-win set-app-window-curses-win!))
|
||||
|
||||
(define bar-1 #f)
|
||||
(define bar-2 #f)
|
||||
(define command-window #f)
|
||||
(define result-window #f)
|
||||
|
||||
(define shortcuts '("F1:Exit"
|
||||
"F2:Repaint (after change of buffer size)"
|
||||
|
|
@ -224,26 +230,13 @@
|
|||
;;Actions
|
||||
|
||||
;;start the whole thing
|
||||
(define nuit
|
||||
(lambda ()
|
||||
(run)))
|
||||
(define (nuit)
|
||||
(run))
|
||||
|
||||
;;handle input
|
||||
(define run
|
||||
(lambda ()
|
||||
(begin
|
||||
(define (run)
|
||||
|
||||
;;initialisation
|
||||
(init-screen)
|
||||
(set! bar1 (newwin 0 0 0 0))
|
||||
(set! bar2 (newwin 0 0 0 0))
|
||||
(set! bar3 (newwin 0 0 0 0))
|
||||
(set! command-win (newwin 0 0 0 0))
|
||||
(set! result-win (newwin 0 0 0 0))
|
||||
|
||||
;;Handling Keyboard-interrupts
|
||||
;;If a keyboard-interrupt occurs it is stored in "active-keyboard-interrupt"
|
||||
(set-interrupt-handler interrupt/keyboard
|
||||
'(set-interrupt-handler interrupt/keyboard
|
||||
(lambda a
|
||||
(set! active-keyboard-interrupt a)))
|
||||
|
||||
|
|
@ -251,7 +244,6 @@
|
|||
(paint)
|
||||
(let loop ((ch (wait-for-input)))
|
||||
(cond
|
||||
|
||||
;;The result of pressing these keys is independent of which
|
||||
;;Buffer is active
|
||||
;;Finish
|
||||
|
|
@ -285,16 +277,15 @@
|
|||
;; forward in result history
|
||||
((= ch key-npage)
|
||||
(history-forward)
|
||||
(print-result-buffer result-win)
|
||||
(paint-result-window)
|
||||
(loop (wait-for-input)))
|
||||
|
||||
;; back in result history
|
||||
((= ch key-ppage)
|
||||
(history-back)
|
||||
(print-result-buffer result-win)
|
||||
(paint-result-window)
|
||||
(loop (wait-for-input)))
|
||||
|
||||
|
||||
;;if lower window is active a message is sent.
|
||||
(else
|
||||
(if c-x-pressed
|
||||
|
|
@ -378,29 +369,6 @@
|
|||
(endwin)
|
||||
(run))))
|
||||
|
||||
|
||||
|
||||
;;Ctrl+p -> History back
|
||||
; ((= ch 16)
|
||||
; (begin
|
||||
; (history-back)
|
||||
; (loop (paint))))
|
||||
|
||||
; ;;Ctrl+n -> History forward
|
||||
; ((= ch 14)
|
||||
; (begin
|
||||
; (history-forward)
|
||||
; (loop (paint))))
|
||||
|
||||
; ;;Ctrl+s -> get selection
|
||||
; ((= ch 19)
|
||||
; (let* ((message (make-selection-message active-command
|
||||
; current-result-object))
|
||||
; (marked-items (switch message)))
|
||||
; (begin
|
||||
; (add-string-to-command-buffer marked-items)
|
||||
; (loop (paint)))))
|
||||
|
||||
(else
|
||||
(begin
|
||||
(set! command-buffer (make-buffer text-command
|
||||
|
|
@ -435,53 +403,62 @@
|
|||
(set! command-cols num-cols)
|
||||
(set! can-write-command can-write)
|
||||
(set! command-history-pos history-pos)))
|
||||
(paint)
|
||||
(loop (wait-for-input)))))))))))))
|
||||
(paint-command-window-contents)
|
||||
(loop (wait-for-input)))))))))))
|
||||
|
||||
;;print and wait for input
|
||||
(define (paint)
|
||||
(define (window-init-curses-win! window)
|
||||
(set-app-window-curses-win!
|
||||
window
|
||||
(newwin (app-window-height window) (app-window-width window)
|
||||
(app-window-y window) (app-window-x window))))
|
||||
|
||||
(define (init-windows!)
|
||||
(init-screen)
|
||||
(let* ((bar1-y 1)
|
||||
(bar1-x 1)
|
||||
(bar1-h 2)
|
||||
(bar1-w (- (COLS) 2))
|
||||
(bar2-y (+ (round (/ (LINES) 3)) 2))
|
||||
(bar2-x 1)
|
||||
(bar2-h 3)
|
||||
(bar2-w (- (COLS) 2))
|
||||
(comwin-y 2)
|
||||
(comwin-x 1)
|
||||
(comwin-h (- bar2-y 2))
|
||||
(comwin-w (- (COLS) 2))
|
||||
(reswin-y (+ bar2-y 3))
|
||||
(reswin-x 1)
|
||||
(reswin-h (- (- (LINES) 6) comwin-h))
|
||||
(reswin-w (- (COLS) 2)))
|
||||
(set! bar-1
|
||||
(make-app-window 1 1
|
||||
(- (COLS) 2) 2
|
||||
#f))
|
||||
(set! bar-2
|
||||
(make-app-window 1 (+ (round (/ (LINES) 3)) 2)
|
||||
(- (COLS) 2) 3
|
||||
#f))
|
||||
(set! command-window
|
||||
(make-app-window 1 2
|
||||
(- (COLS) 2) (- (app-window-y bar-2) 2)
|
||||
#f))
|
||||
(set! result-window
|
||||
(make-app-window 1 (+ (app-window-y bar-2) 3)
|
||||
(- (COLS) 2)
|
||||
(- (- (LINES) 6) (app-window-height command-window))
|
||||
#f))
|
||||
(window-init-curses-win! bar-1)
|
||||
(window-init-curses-win! bar-2)
|
||||
(window-init-curses-win! command-window)
|
||||
(window-init-curses-win! result-window)
|
||||
(wclear (app-window-curses-win bar-1))
|
||||
(wclear (app-window-curses-win bar-2))
|
||||
(wclear (app-window-curses-win command-window))
|
||||
(wclear (app-window-curses-win result-window))
|
||||
(clear))
|
||||
|
||||
(wclear bar1)
|
||||
(wclear bar2)
|
||||
(wclear command-win)
|
||||
(wclear result-win)
|
||||
(clear)
|
||||
(define (paint-bar-1)
|
||||
(mvwaddstr (app-window-curses-win bar-1) 0 1 "SCSH-NUIT")
|
||||
(wrefresh (app-window-curses-win bar-1)))
|
||||
|
||||
(set! bar1 (newwin bar1-h bar1-w bar1-y bar1-x))
|
||||
(set! bar2 (newwin bar2-h bar2-w bar2-y bar2-x))
|
||||
(set! command-win (newwin comwin-h comwin-w comwin-y comwin-x))
|
||||
(set! result-win (newwin reswin-h reswin-w reswin-y reswin-x))
|
||||
(define (paint-bar-2)
|
||||
(box (app-window-curses-win bar-2) (ascii->char 0) (ascii->char 0))
|
||||
(print-active-command-win (app-window-curses-win bar-2)
|
||||
(app-window-width bar-2)))
|
||||
|
||||
;(box standard-screen (ascii->char 0) (ascii->char 0))
|
||||
;(refresh)
|
||||
(mvwaddstr bar1 0 1 "SCSH-NUIT")
|
||||
(wrefresh bar1)
|
||||
(define (paint-command-window)
|
||||
(box (app-window-curses-win command-window)
|
||||
(ascii->char 0) (ascii->char 0)))
|
||||
|
||||
(box bar2 (ascii->char 0) (ascii->char 0))
|
||||
(print-active-command-win bar2 bar2-w)
|
||||
|
||||
(box command-win (ascii->char 0) (ascii->char 0))
|
||||
(set! command-lines (- comwin-h 2))
|
||||
(set! command-cols (- comwin-w 3))
|
||||
|
||||
(set! command-buffer (make-buffer text-command
|
||||
(define (paint-command-window-contents)
|
||||
(set! command-lines (- (app-window-height command-window) 2))
|
||||
(set! command-cols (- (app-window-width command-window) 3))
|
||||
(set! command-buffer
|
||||
(make-buffer text-command
|
||||
pos-command
|
||||
pos-command-col
|
||||
pos-command-fin-ln
|
||||
|
|
@ -491,18 +468,34 @@
|
|||
command-cols
|
||||
can-write-command
|
||||
command-history-pos))
|
||||
(set! command-buffer
|
||||
(print-command-buffer (app-window-curses-win command-window)
|
||||
command-buffer))
|
||||
(wrefresh (app-window-curses-win command-window)))
|
||||
|
||||
(set! command-buffer (print-command-buffer command-win command-buffer))
|
||||
(define (paint-result-window)
|
||||
(wclear (app-window-curses-win result-window))
|
||||
(box (app-window-curses-win result-window)
|
||||
(ascii->char 0) (ascii->char 0))
|
||||
(set! result-lines (- (app-window-height result-window) 2))
|
||||
(set! result-cols (- (app-window-width result-window) 3))
|
||||
(print-result-buffer result-window)
|
||||
(wrefresh (app-window-curses-win result-window)))
|
||||
|
||||
(wrefresh command-win)
|
||||
(box result-win (ascii->char 0) (ascii->char 0))
|
||||
(set! result-lines (- reswin-h 2))
|
||||
(set! result-cols (- reswin-w 3))
|
||||
(print-result-buffer result-win)
|
||||
(wrefresh result-win)
|
||||
(define (paint)
|
||||
(init-windows!)
|
||||
(paint-bar-1)
|
||||
(paint-bar-2)
|
||||
(paint-command-window)
|
||||
(paint-command-window-contents)
|
||||
(paint-result-window)
|
||||
|
||||
(set! command-buffer (cur-right-pos command-win result-win comwin-h
|
||||
reswin-h command-buffer))
|
||||
(set! command-buffer
|
||||
(cur-right-pos (app-window-curses-win command-window)
|
||||
(app-window-curses-win result-window)
|
||||
(app-window-height command-window)
|
||||
(app-window-height result-window)
|
||||
command-buffer))
|
||||
|
||||
(let ((text (buffer-text command-buffer))
|
||||
(pos-line (buffer-pos-line command-buffer))
|
||||
|
|
@ -514,7 +507,6 @@
|
|||
(num-cols (buffer-num-cols command-buffer))
|
||||
(can-write (buffer-can-write command-buffer))
|
||||
(history-pos (buffer-history-pos command-buffer)))
|
||||
(begin
|
||||
(set! text-command text)
|
||||
(set! pos-command pos-line)
|
||||
(set! pos-command-col pos-col)
|
||||
|
|
@ -526,18 +518,11 @@
|
|||
(set! can-write-command can-write)
|
||||
(set! command-history-pos history-pos)))
|
||||
|
||||
;(refresh)
|
||||
; (wrefresh command-win)
|
||||
; (wrefresh result-win)
|
||||
; (wrefresh bar1)
|
||||
; (wrefresh bar2)
|
||||
))
|
||||
|
||||
(define (wait-for-input)
|
||||
(noecho)
|
||||
(keypad bar1 #t)
|
||||
(keypad (app-window-curses-win bar-1) #t)
|
||||
(set! active-keyboard-interrupt #f)
|
||||
(let ((ch (wgetch bar1)))
|
||||
(let ((ch (wgetch (app-window-curses-win bar-1))))
|
||||
(echo)
|
||||
ch))
|
||||
|
||||
|
|
@ -771,9 +756,9 @@
|
|||
|
||||
|
||||
;;print the lower window
|
||||
(define print-result-buffer
|
||||
(lambda (reswin)
|
||||
(let* ((print-message (make-print-message active-command
|
||||
(define (print-result-buffer result-window)
|
||||
(let* ((window (app-window-curses-win result-window))
|
||||
(print-message (make-print-message active-command
|
||||
current-result-object
|
||||
command-cols))
|
||||
(model (switch print-message))
|
||||
|
|
@ -782,7 +767,6 @@
|
|||
(pos-x (print-object-pos-x model))
|
||||
(highlighted-lns (print-object-highlighted-lines model))
|
||||
(marked-lns (print-object-marked-lines model)))
|
||||
(begin
|
||||
(set! text-result text)
|
||||
(set! pos-result pos-y)
|
||||
(set! pos-result-col pos-x)
|
||||
|
|
@ -814,22 +798,22 @@
|
|||
(if (and (member pos highlighted-lines)
|
||||
(= active-buffer 2))
|
||||
(begin
|
||||
(wattron reswin (A-REVERSE))
|
||||
(mvwaddstr reswin pos 1 line)
|
||||
(wattrset reswin (A-NORMAL))
|
||||
(wrefresh reswin)
|
||||
(wattron window (A-REVERSE))
|
||||
(mvwaddstr window pos 1 line)
|
||||
(wattrset window (A-NORMAL))
|
||||
(wrefresh window)
|
||||
(loop (+ pos 1)))
|
||||
(if (member pos marked-lines)
|
||||
(begin
|
||||
(wattron reswin (A-BOLD))
|
||||
(mvwaddstr reswin pos 1 line)
|
||||
(wattrset reswin (A-NORMAL))
|
||||
(wrefresh reswin)
|
||||
(wattron window (A-BOLD))
|
||||
(mvwaddstr window pos 1 line)
|
||||
(wattrset window (A-NORMAL))
|
||||
(wrefresh window)
|
||||
(loop (+ pos 1)))
|
||||
(begin
|
||||
(mvwaddstr reswin pos 1 line)
|
||||
(wrefresh reswin)
|
||||
(loop (+ pos 1))))))))))))))
|
||||
(mvwaddstr window pos 1 line)
|
||||
(wrefresh window)
|
||||
(loop (+ pos 1))))))))))))
|
||||
|
||||
;;visible lines
|
||||
(define get-right-result-lines
|
||||
|
|
@ -1176,6 +1160,3 @@
|
|||
str
|
||||
(loop (cdr lst)
|
||||
(string-append str " " (car lst)))))))
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue