(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-record-discloser :app-window (lambda (rec) `(app-window (x ,(app-window-x rec)) (y ,(app-window-y rec)) (w ,(app-window-width rec)) (h ,(app-window-height rec))))) (define *bar-1* #f) (define (bar-1) *bar-1*) (define *active-command-window* #f) (define (active-command-window) *active-command-window*) (define *command-frame-window* #f) (define (command-frame-window) *command-frame-window*) (define *command-window* #f) (define (command-window) *command-window*) (define *result-window* #f) (define (result-window) *result-window*) (define *result-frame-window* #f) (define (result-frame-window) *result-frame-window*) (define *command-buffer* (make-buffer '("Welcome to the Commander S!" "") 2 2 2 1 1 0 0 #t 1)) (define (command-buffer) *command-buffer*) (define *result-buffer* (make-result-buffer 0 0 0 0 #f #f ; set in INIT-WINDOWS '() '())) (define (result-buffer) *result-buffer*) (define *focus-buffer* 'command-buffer) (define (focus-on-command-buffer?) (eq? *focus-buffer* 'command-buffer)) (define (focus-command-buffer!) (set! *focus-buffer* 'command-buffer)) (define (focus-on-result-buffer?) (eq? *focus-buffer* 'result-buffer)) (define (focus-result-buffer!) (set! *focus-buffer* 'result-buffer)) (define *untouched-tty* #f) (define (save-initial-tty-info! port) (set! *untouched-tty* (copy-tty-info (tty-info port)))) (define (restore-initial-tty-info! port) (set-tty-info/now port *untouched-tty*)) (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 (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!) (set! *bar-1* (make-app-window 1 1 (- (COLS) 2) 2 #f)) (debug-message '*bar-1* *bar-1*) (set! *active-command-window* (make-app-window 1 (+ (round (/ (LINES) 3)) 2) (- (COLS) 2) 3 #f)) (debug-message '*active-command-window* *active-command-window*) (set! *command-frame-window* (make-app-window 1 2 (- (COLS) 2) (- (app-window-y (active-command-window)) 2) #f)) (debug-message '*command-frame-window* *command-frame-window*) (set! *command-window* (make-inlying-app-window (command-frame-window))) (debug-message '*command-window* *command-window*) (set! *result-frame-window* (make-app-window 1 (+ (app-window-y (active-command-window)) 3) (- (COLS) 2) (- (- (LINES) 6) (app-window-height (command-frame-window))) #f)) (debug-message '*result-frame-window* *result-frame-window*) (set! *result-window* (make-inlying-app-window (result-frame-window))) (debug-message '*result-window* *result-window*) (let ((all-windows (list (bar-1) (active-command-window) (command-frame-window) (command-window) (result-frame-window) (result-window)))) (for-each window-init-curses-win! all-windows) (set-result-buffer-num-lines! *result-buffer* (- (app-window-height (result-window)) 2)) (set-result-buffer-num-cols! *result-buffer* (- (app-window-width (result-window)) 1)) (for-each wclear (map app-window-curses-win all-windows)))) ;; result-buffer-object-change-channel (define result-buffer-changed-channel (make-channel)) (define result-buffer-changes-subscribers (make-channel)) (define (signal-result-buffer-object-change) (let ((ack-channel (make-channel))) (debug-message "signal-result-buffer-object-change") (send result-buffer-changed-channel ack-channel) (receive ack-channel))) (define (spawn-result-buffer-surveillant) (spawn (lambda () (let lp () (select (wrap (receive-rv result-buffer-changes-subscribers) (lambda (answer-channel) (debug-message "result-buffer-surveillant 1") (sync (wrap (receive-rv result-buffer-changed-channel) (lambda (ack-channel) (send answer-channel ack-channel)))) (lp))) (wrap (receive-rv result-buffer-changed-channel) (lambda (ack-channel) (send ack-channel 'no-one-is-interested) (debug-message "result-buffer-surveillant 2") (lp)))))))) (define (result-buffer-other-object-has-focus-rv) (let ((answer-channel (make-channel))) (send result-buffer-changes-subscribers answer-channel) (receive-rv answer-channel))) (spawn-result-buffer-surveillant)