Minimalistic module for work with colors in Win32-console

[alex]

#

# 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-blan")

(WIN32-CONSOLE:color-print WIN32-CONSOLE:LYEL WIN32-CONSOLE:BLA "bla" "-" "bla" "-" "blan")

(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-bla1n")

(cpr LGRE BLA "bla-bla-bla2n")

(cpr LRED LBLA "bla-bla-bla3n")

(cpr LCYA BLA  "bla" "-" "bla" "-" "bla4n")

(cpr LBLU CYA  "bla" "-" "bla" "-" "bla5n")

(cpr WHI  BLA "Press any key to continue...n")

(read-key)

[HPW]

Hi Alex,



nice modul. I tested it on WIN/XP.

I made some tweaks:

Code Select Expand


;------------ 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 Expand


#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-bla1n")
(cpr WIN32-CONSOLE:LGRE WIN32-CONSOLE:BLA  "bla-bla-bla2n")
(cpr WIN32-CONSOLE:LRED WIN32-CONSOLE:LBLA "bla-bla-bla3n")
(cpr WIN32-CONSOLE:LCYA WIN32-CONSOLE:BLA  "bla" "-" "bla" "-" "bla4n")
(cpr WIN32-CONSOLE:LBLU WIN32-CONSOLE:CYA  "bla" "-" "bla" "-" "bla5n")
(cpr WIN32-CONSOLE:WHI  WIN32-CONSOLE:BLA  "Press any key to continue...n")
(read-key)


[alex]

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 Expand


#
# 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 Expand


(load "w32cons.lsp")

#Simple :) programmer can use:      
(WIN32-CONSOLE:color-print WIN32-CONSOLE:LBLU WIN32-CONSOLE:BLA "bla-bla-blan")
(WIN32-CONSOLE:color-print WIN32-CONSOLE:LYEL WIN32-CONSOLE:BLA "bla" "-" "bla" "-" "blan")
(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-1n")
(cpr LWHI BLA "...n")
(cpr LYEL LBLU  "bla" "-" "bla" "-" "bla-222n")
(cpr WHI  BLA "Press any key to continue...n")
(read-key)

(exit)


Tested on Windows 98SE

[HPW]

Hi Alex,

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

OK, more lazy = even better!

;-)

[William James]

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

Code Select Expand

#
#  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))