#
# 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)
Hi Alex,
nice modul. I tested it on WIN/XP.
I made some tweaks:
;------------ 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
#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)
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:
#
# 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:
(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
Hi Alex,
Quote
And I have understood, that You are not lazy enough... :)
OK, more lazy = even better!
;-)
Thanks for this, Alex. Here's my version.
# 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))