[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/01: installer: Use lots of colors.
|
From: |
Danny Milosavljevic |
|
Subject: |
01/01: installer: Use lots of colors. |
|
Date: |
Sun, 9 Jul 2017 16:18:53 -0400 (EDT) |
dannym pushed a commit to branch wip-installer-2
in repository guix.
commit 83b3f596586173a1a844e5172f3c0a673ab17ad9
Author: Danny Milosavljevic <address@hidden>
Date: Sun Jul 9 22:10:34 2017 +0200
installer: Use lots of colors.
* gurses/colors.scm (colors): Add selected-menu-item, menu-item,
explanation,
form-field.
* gnu/system/installer/utils.scm (make-boxed-window): Set default background
to 'explanation.
* gurses/buttons.scm (draw-button): Draw shadow.
* gurses/form.scm (draw-field-space): Honor form-field color.
(redraw-field): Honor form-field color.
* gurses/menu.scm (menu-set-active-color!): Delete variable.
(<menu>): Remove active-color.
(make-menu): Don't pass active-color.
(menu-redraw): Honor menu-item color.
(menu-refresh): Honor menu-item and selected-menu-item colors.
---
gnu/system/installer/utils.scm | 1 +
gurses/buttons.scm | 33 ++++++++++++++++++---------------
gurses/colors.scm | 14 +++++++++-----
gurses/form.scm | 17 +++++++++--------
gurses/menu.scm | 16 +++++++++-------
5 files changed, 46 insertions(+), 35 deletions(-)
diff --git a/gnu/system/installer/utils.scm b/gnu/system/installer/utils.scm
index 27ba098..cb4ae55 100644
--- a/gnu/system/installer/utils.scm
+++ b/gnu/system/installer/utils.scm
@@ -291,6 +291,7 @@ pair whose car is the inner window and whose cdr is the
frame."
(let ((sw (derwin win (- (getmaxy win) ystart 1)
(- (getmaxx win) 2)
ystart 1 #:panel #t)))
+ (bkgdset! sw (color 1 (dim #\space)))
(boxed-window-decoration-refresh (cons sw win) title)
;(refresh* sw)
;; Return the inner and outer windows
diff --git a/gurses/buttons.scm b/gurses/buttons.scm
index 9dab545..a9ba2df 100644
--- a/gurses/buttons.scm
+++ b/gurses/buttons.scm
@@ -62,10 +62,11 @@
(list-ref (array-ref (buttons-array buttons) sel) 2))))
(define (draw-button b color)
- (select-color! b color)
- (box b 0 0)
- ;(refresh b)
- )
+ (select-color! b color)
+ (chgat b -1 A_BLINK 2 #:y 1 #:x 1)
+ (chgat b -1 A_BLINK 2 #:y 0 #:x (- (getmaxx b) 1))
+
+ )
(define (buttons-unselect-all buttons)
(let* ((arry (buttons-array buttons))
@@ -132,7 +133,7 @@
(let mk-label ((us #f)
(mark #f)
(output '())
- (input (string->list raw-label)))
+ (input (string->list (string-append " "
raw-label " "))))
(if (null? input)
(cons (reverse output) mark)
(let ((c (car input)))
@@ -150,18 +151,18 @@
(cdr input))))))
(label (car label.mark))
(mark (cdr label.mark))
- (width (+ (length label) 2))
+ (width (+ (length label) 1))
(w (derwin win 3 width 0
(round (- (* (1+ i) (/ (getmaxx win) (1+ n)))
(/ width 2))) #:panel #t)))
(keypad! w #t)
(buttons-set-bwindows! buttons (cons w (buttons-bwindows
buttons)))
- (box w 0 0)
- (addchstr w label #:y 1 #:x 1)
+ ;(box w 0 0)
+ ;(select-color! w 'button)
+ ;(addchstr w label #:y 0 #:x 0)
(loop (cdr bl) (1+ i) (acons mark (list w key label)
alist)))))))))
-
(define (buttons-key-matches-symbol? nav ch symbol)
(if (char? ch)
(or (eq? (buttons-fetch-by-key nav (char-downcase ch)) symbol)
@@ -216,12 +217,14 @@
(define (buttons-refresh buttons)
(let ((selected-index (buttons-selected buttons)))
(for-each (lambda (index button a)
- (draw-button button (if (= index selected-index)
- 'focused-button
- 'button))
- (match a
- ((ch win sym label)
- (addchstr button label #:y 1 #:x 1))))
+ (let ((color-s (if (= index selected-index)
+ 'focused-button
+ 'button)))
+ (draw-button button color-s)
+ (match a
+ ((ch win sym label)
+ (addchstr win (color (color-index-by-symbol color-s)
+ label) #:y 0 #:x 0)))))
(iota (length (buttons-bwindows buttons)))
(reverse (buttons-bwindows buttons))
(array->list (buttons-array buttons)))))
diff --git a/gurses/colors.scm b/gurses/colors.scm
index f578543..dc22a3e 100644
--- a/gurses/colors.scm
+++ b/gurses/colors.scm
@@ -3,12 +3,17 @@
#:use-module (ice-9 match))
(define colors
- (list (list 'normal COLOR_WHITE COLOR_BLACK)
- (list 'livery-title COLOR_MAGENTA COLOR_BLACK)
+ (list (list 'xxx COLOR_BLACK COLOR_WHITE)
+ (list 'livery-title COLOR_MAGENTA COLOR_WHITE)
(list 'strong COLOR_RED COLOR_BLACK)
(list 'button COLOR_BLACK COLOR_GREEN)
(list 'button-shadow COLOR_BLACK COLOR_BLACK)
- (list 'focused-button COLOR_CYAN COLOR_GREEN)))
+ (list 'focused-button COLOR_CYAN COLOR_GREEN)
+ (list 'normal COLOR_BLACK COLOR_WHITE)
+ (list 'selected-menu-item COLOR_GREEN COLOR_BLUE)
+ (list 'menu-item COLOR_BLACK COLOR_WHITE)
+ (list 'explanation COLOR_MAGENTA COLOR_WHITE)
+ (list 'form-field COLOR_BLUE COLOR_WHITE)))
(define-public (color-index-by-symbol color)
(let loop ((i 0) (p colors))
@@ -29,5 +34,4 @@
colors))
(define-public (select-color! win color)
-; (color-set! win (color-index-by-symbol color))
-1)
+ (color-set! win (color-index-by-symbol color)))
diff --git a/gurses/form.scm b/gurses/form.scm
index 9a6563e..2821f28 100644
--- a/gurses/form.scm
+++ b/gurses/form.scm
@@ -37,6 +37,7 @@
#:use-module (ncurses curses)
#:use-module (ncurses panel)
#:use-module (gurses menu)
+ #:use-module (gurses colors)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9))
@@ -79,22 +80,22 @@
(define (draw-field-space win field y x)
"Draws the template for FIELD at Y, X"
(addchstr win
- (make-list
- (if (list? (field-size field))
+ (make-list (if (list? (field-size field))
(fold (lambda (x prev) (max prev (string-length x))) 0
(field-size field))
(field-size field))
- (inverse #\space))
- #:y y
- #:x x))
+ (color (color-index-by-symbol 'form-field) (inverse #\space)))
+ #:y y
+ #:x x))
(define (redraw-field form field n)
"Redraw the FIELD in FORM"
(draw-field-space (form-window form) field n (form-tabpos form))
- (addchstr (form-window form) (inverse (field-value field))
- #:y n
- #:x (form-tabpos form)))
+ (addchstr (form-window form)
+ (color (color-index-by-symbol 'form-field) (inverse (field-value
field)))
+ #:y n
+ #:x (form-tabpos form)))
(define (form-set-value! form n str)
(cond
diff --git a/gurses/menu.scm b/gurses/menu.scm
index 4a54b26..f0e4005 100644
--- a/gurses/menu.scm
+++ b/gurses/menu.scm
@@ -31,7 +31,7 @@
#:export (menu-set-active!)
#:export (menu-set-items!)
#:export (menu-set-active-attr!)
- #:export (menu-set-active-color!)
+ ;#:export (menu-set-active-color!)
#:export (menu-top-item)
#:export (menu-get-current-item)
@@ -41,11 +41,12 @@
#:use-module (ncurses curses)
#:use-module (ncurses panel)
+ #:use-module (gurses colors)
#:use-module (srfi srfi-9)
#:use-module (ice-9 match))
(define-record-type <menu>
- (make-menu' current-item items top-item active active-attr active-color disp)
+ (make-menu' current-item items top-item active active-attr disp)
menu?
(current-item menu-current-item menu-set-current-item!)
(items menu-items menu-set-items!)
@@ -53,12 +54,11 @@
(disp menu-disp-proc)
(active menu-active menu-set-active!)
(active-attr menu-active-attr menu-set-active-attr!)
- (active-color menu-active-color menu-set-active-color!)
(window menu-window menu-set-window!))
(define* (make-menu items #:key (disp-proc (lambda (datum row)
(format #f "~a" datum))))
- (make-menu' 0 items 0 #t A_STANDOUT 0 disp-proc))
+ (make-menu' 0 items 0 #t A_STANDOUT disp-proc))
@@ -120,6 +120,7 @@
(define (menu-redraw menu)
(define win (menu-window menu))
(erase win)
+ (select-color! win 'menu-item)
(let populate ((row (menu-top-item menu))
(data (list-tail (menu-items menu) (menu-top-item menu) )))
(if (and
@@ -138,10 +139,11 @@
(define (menu-refresh menu)
(let ((win (menu-window menu))
- (colour (if (menu-active menu) (menu-active-color menu) 0))
+ (colour (color-index-by-symbol (if (menu-active menu)
+ 'selected-menu-item
+ 'menu-item)))
(attr (if (menu-active menu) (menu-active-attr menu) A_DIM)))
-
- (bkgd win (color 0 (normal #\space)))
+ (bkgd win (color (color-index-by-symbol 'normal) (normal #\space)))
(chgat win -1 attr colour
#:y (- (menu-current-item menu) (menu-top-item menu)) #:x 0)))