newlispfanclub.alh.net

Posted: **Sun Jun 12, 2005 9:46 pm**

#
# Minimalistic module for work with colors in Win32-console
#
# Tested in Windows 2000
#

------------ file w32cons.lsp -----------------------
(context 'WIN32-CONSOLE)

(import "kernel32.DLL" "GetStdHandle")
(import "kernel32.DLL" "SetConsoleTextAttribute")
(constant 'STD_OUTPUT_HANDLE 0xfffffff5)

(setq cons-color-constans '(BLA BLU GRE CYA RED MAG YEL WHI LBLA LBLU LGRE LCYA LRED LMAG LYEL LWHI) )
(setq cons-color-values '(0x0 0x1 0x2 0x3 0x4 0x5 0x6 0x7 0x8 0x9 0xA 0xB 0xC 0xD 0xE 0xF ) )
(map (lambda (x y) (constant x y)) cons-color-constans cons-color-values)

(define (cons-output-handle)
(GetStdHandle STD_OUTPUT_HANDLE))

(define (cons-attr-set attr)
(SetConsoleTextAttribute (cons-output-handle) attr))

(define (color-print foreground background )
(cons-attr-set (| (<< background 4) foreground))
(dolist (x (args)) (print x)))
------------ end file w32cons.lsp -----------------------

#Example-1
#Simple :) programmer can use:
(load "w32cons.lsp")
(WIN32-CONSOLE:color-print WIN32-CONSOLE:LBLU WIN32-CONSOLE:BLA "bla-bla-bla\n")
(WIN32-CONSOLE:color-print WIN32-CONSOLE:LYEL WIN32-CONSOLE:BLA "bla" "-" "bla" "-" "bla\n")
(print "Press any key to continue...\n")
(read-key)

#Example-2
#Lazy :) programmer can use:
(load "w32cons.lsp")
(map (lambda (x y) (constant x y)) WIN32-CONSOLE:cons-color-constans WIN32-CONSOLE:cons-color-values)
(define (cpr) (eval (append '(WIN32-CONSOLE:color-print) (args))) )

(cpr LBLU LBLA "bla-bla-bla1\n")
(cpr LGRE BLA "bla-bla-bla2\n")
(cpr LRED LBLA "bla-bla-bla3\n")
(cpr LCYA BLA "bla" "-" "bla" "-" "bla4\n")
(cpr LBLU CYA "bla" "-" "bla" "-" "bla5\n")
(cpr WHI BLA "Press any key to continue...\n")
(read-key)

Posted: **Mon Jun 13, 2005 6:32 am**

Hi Alex,

nice modul. I tested it on WIN/XP.
I made some tweaks:

Code: Select all

;------------ file w32cons.lsp -----------------------
(context 'WIN32-CONSOLE)

(import "kernel32.DLL" "GetStdHandle")
(import "kernel32.DLL" "SetConsoleTextAttribute")
(constant 'STD_OUTPUT_HANDLE 0xfffffff5)

(setq cons-color-constans '(BLA BLU GRE CYA RED MAG YEL WHI LBLA LBLU LGRE LCYA LRED LMAG LYEL LWHI) )
(setq cons-color-values '(0x0 0x1 0x2 0x3 0x4 0x5 0x6 0x7 0x8 0x9 0xA 0xB 0xC 0xD 0xE 0xF ) )
(map (lambda (x y) (constant x y)) cons-color-constans cons-color-values)

(define (cons-output-handle)
(GetStdHandle STD_OUTPUT_HANDLE))

(define (cons-attr-set attr)
(SetConsoleTextAttribute (cons-output-handle) attr))

(define (color-print foreground background )
(cons-attr-set (| (<< background 4) foreground))
(dolist (x (args)) (print x)))
(context 'MAIN)
;------------ end file w32cons.lsp -----------------------

Note: Closing context

Code: Select all

#Example-2
#Lazy :) programmer can use:
(load "w32cons.lsp")
(define (cpr) (eval (append '(WIN32-CONSOLE:color-print) (args))))

(cpr WIN32-CONSOLE:LBLU WIN32-CONSOLE:LBLA "bla-bla-bla1\n")
(cpr WIN32-CONSOLE:LGRE WIN32-CONSOLE:BLA  "bla-bla-bla2\n")
(cpr WIN32-CONSOLE:LRED WIN32-CONSOLE:LBLA "bla-bla-bla3\n")
(cpr WIN32-CONSOLE:LCYA WIN32-CONSOLE:BLA  "bla" "-" "bla" "-" "bla4\n")
(cpr WIN32-CONSOLE:LBLU WIN32-CONSOLE:CYA  "bla" "-" "bla" "-" "bla5\n")
(cpr WIN32-CONSOLE:WHI  WIN32-CONSOLE:BLA  "Press any key to continue...\n")
(read-key)

Posted: **Thu Jun 16, 2005 4:34 pm**

Hi HPW! Thank You. I have understood my errors.
And I have understood, that You are not lazy enough... :)
So You can test next version.

Module w32cons.lsp:

Code: Select all

#
# Minimalistic module for work with colors in Win32-console
#

(context 'WIN32-CONSOLE)

(import "kernel32.DLL" "GetStdHandle")
(import "kernel32.DLL" "SetConsoleTextAttribute")

(constant 'STD_OUTPUT_HANDLE 0xfffffff5)

(setq cons-color-constans '("BLA" "BLU" "GRE" "CYA" "RED" "MAG" "YEL" "WHI" "LBLA" "LBLU" "LGRE" "LCYA" "LRED" "LMAG" "LYEL" "LWHI") )
(setq cons-color-values   '( 0x0   0x1   0x2   0x3   0x4   0x5   0x6   0x7   0x8    0x9    0xA    0xB    0xC    0xD    0xE    0xF ) )
(map (lambda (x y) (constant (sym x) y)) cons-color-constans cons-color-values)

(define (cons-output-handle) 
  (GetStdHandle STD_OUTPUT_HANDLE))

(define (cons-attr-set attr)
  (SetConsoleTextAttribute (cons-output-handle) attr))

(define (color-print foreground background )
  (cons-attr-set (| (<< background 4) foreground))
  (eval (cons 'print (args))))

(context 'MAIN)

Test code:

Code: Select all

(load "w32cons.lsp")

#Simple :) programmer can use:       
(WIN32-CONSOLE:color-print WIN32-CONSOLE:LBLU WIN32-CONSOLE:BLA "bla-bla-bla\n")
(WIN32-CONSOLE:color-print WIN32-CONSOLE:LYEL WIN32-CONSOLE:BLA "bla" "-" "bla" "-" "bla\n")
(print "Press any key to continue...\n")
(read-key)

#Lazy :) programmer can use:       
(map (lambda (x y) (constant (sym x) y)) WIN32-CONSOLE:cons-color-constans WIN32-CONSOLE:cons-color-values)
(define (cpr) (eval (cons 'WIN32-CONSOLE:color-print (args))))

(cpr LBLU LBLA "bla-bla-bla-1\n")
(cpr LWHI BLA "...\n")
(cpr LYEL LBLU  "bla" "-" "bla" "-" "bla-222\n")
(cpr WHI  BLA "Press any key to continue...\n")
(read-key)

(exit)

Tested on Windows 98SE

Posted: **Thu Jun 16, 2005 8:46 pm**

Hi Alex,

And I have understood, that You are not lazy enough... :)

OK, more lazy = even better!
;-)

Posted: **Sat Jun 10, 2006 6:06 am**

Thanks for this, Alex. Here's my version.

Code: Select all

#
#  module for work with colors in Win32-console
#

(context 'WIN32-CONSOLE)

(import "kernel32.DLL" "GetStdHandle")
(import "kernel32.DLL" "SetConsoleTextAttribute")

(constant 'STD_OUTPUT_HANDLE 0xfffffff5)

(setq colors (transpose   (list (map name
  '(BLA BLU GRE CYA RED MAG YEL WHI LBLA LBLU LGRE
    LCYA LRED LMAG LYEL LWHI))
  '(0x0 0x1 0x2 0x3 0x4 0x5 0x6 0x7 0x8 0x9 0xA 0xB
    0xC 0xD 0xE 0xF) )))

(define (cons-output-handle)
  (GetStdHandle STD_OUTPUT_HANDLE))

(define (cons-attr-set attr)
  (SetConsoleTextAttribute
    (cons-output-handle) attr))

; Make sure that 0 <= x <= 15.
(define (clamp x)
  (int (max 0 (min 15 x))))

; Arguments can be strings or integers.
; Default arguments:  7  0
(define (console-colors foreground background)
  (setq foreground (or foreground 7))
  (setq background (or background 0))
  (setq foreground (or (lookup foreground colors)
    (clamp foreground)))
  (setq background (or (lookup background colors)
    (clamp background)))
  (cons-attr-set (| (<< background 4) foreground)))

(context 'MAIN)

; Arguments can be symbols, strings, or integers.
; Examples: (console-colors 7 0)
;           (console-colors 'LYEL 'LBLA)
;           (console-colors "LMAG" "BLA")
(define (console-colors foreground background)
  (if (symbol? foreground)
    (setq foreground (name foreground)))
  (if (symbol? background)
    (setq background (name background)))
  (WIN32-CONSOLE:console-colors
    foreground background))


; test

;;  To test the clamping, we make the background
;;  color range from -1 to 16 instead of from
;;  0 to 15.
(for (back -1 16)
  (dotimes (fore 16)
    (console-colors fore back)    
    (print (format "%02d@%02d" fore back))))
(console-colors)
(print (dup " " 80))