#!/usr/local/bin/clisp -ansi -q -Kfull (in-package :common-lisp-user) (defun report-the-error (err string-stream) (let ((log-path (format nil "/tmp/ansi-test.~D.errors" #+(and clisp linux) (LINUX:|getpid|) #-(and clisp linux) "nopid"))) (with-open-file (log log-path :direction :output :if-exists :supersede :if-does-not-exist :create) (format log "~A GOT AN ERROR: ~A~2%" (or *load-pathname* "ansi-test") err) (princ (GET-OUTPUT-STREAM-STRING string-stream) log)) (format *error-output* "~A: ~A~% See ~A~%" (or *load-pathname* "ansi-test") err log-path) (finish-output *error-output*) (ext:quit 1))) (defmacro without-output (&body body) `(prog1 (values) (with-output-to-string (net) (handler-case (let ((*standard-output* net) (*error-output* net) (*trace-output* net)) ,@body) (error (err) (report-the-error err net)))))) (format t "~CcLoading...~%" (code-char 27)) (without-output (load (make-pathname :name ".clisprc" :type "lisp" :defaults (user-homedir-pathname)))) (without-output (package:load-package "COM.INFORMATIMAGO.COMMON-LISP.UTILITY") (shadow '(handling-errors ed)) (use-package "COM.INFORMATIMAGO.COMMON-LISP.UTILITY") (package:load-package "COM.INFORMATIMAGO.COMMON-LISP.ECMA048")) (defpackage "E48" (:use)) (in-package "E48") (common-lisp-user::without-output (COM.INFORMATIMAGO.COMMON-LISP.ECMA048:generate-all-functions :verbose common-lisp:nil :compile common-lisp:t :export common-lisp:t :8-bit common-lisp:nil :print common-lisp:t :result-type 'common-lisp:string)) (common-lisp:in-package "COMMON-LISP-USER") (defenum sgr-codes " 0 normal (reset) 1 bold or increased intensity 2 faint, decreased intensity or second colour 3 italicized 4 singly underlined 5 slowly blinking (less then 150 per minute) 6 rapidly blinking (150 per minute or more) 7 negative image 8 concealed characters 9 crossed-out (characters still legible but marked as to be deleted) 10 primary (default) font 11 first alternative font 12 second alternative font 13 third alternative font 14 fourth alternative font 15 fifth alternative font 16 sixth alternative font 17 seventh alternative font 18 eighth alternative font 19 ninth alternative font 20 Fraktur (Gothic) 21 doubly underlined 22 normal colour or normal intensity (neither bold nor faint) 23 not italicized, not fraktur 24 not underlined (neither singly nor doubly) 25 steady (not blinking) 26 (reserved for proportional spacing as specified in CCITT Recommendation T.61) 27 positive image 28 revealed characters 29 not crossed out 30 black display 31 red display 32 green display 33 yellow display 34 blue display 35 magenta display 36 cyan display 37 white display 38 (reserved for future standardization; intended for setting character foreground colour as specified in ISO 8613-6 [CCITT Recommendation T.416]) 39 default display colour (implementation-defined) 40 black background 41 red background 42 green background 43 yellow background 44 blue background 45 magenta background 46 cyan background 47 white background 48 (reserved for future standardization; intended for setting character background colour as specified in ISO 8613-6 [CCITT Recommendation T.416]) 49 default background colour (implementation-defined) 50 (reserved for cancelling the effect of the rendering aspect established by parameter value 26) 51 framed 52 encircled 53 overlined 54 not framed, not encircled 55 not overlined 56 (reserved for future standardization) 57 (reserved for future standardization) 58 (reserved for future standardization) 59 (reserved for future standardization) 60 ideogram underline or right side line 61 ideogram double underline or double line on the right side 62 ideogram overline or left side line 63 ideogram double overline or double line on the left side 64 ideogram stress marking 65 cancels the effect of the rendition aspects established by parameter values 60 to 64. " normal bold faint italic underline slow-blink fast-blink invert hidden crossed-out primary-font first-font second-font third-font fourth-font fifth-font sixth-font seventh-font eighth-font ninth-font gothic double-underline no-bold no-italic no-underline no-blink reserved-1 no-invert no-hidden no-crossed-out black-foreground red-foreground green-foreground yellow-foreground blue-foreground magenta-foreground cyan-foreground white-foreground reseved-2 default-foreground black-background red-background green-background yellow-background blue-background magenta-background cyan-background white-background reserved-3 default-background reserved-4 framed encircled overlined not-framed not-verlined reserved-5 reserved-6 reserved-7 reserved-8 ideogram-underline ideogram-double-underline ideogram-overline ideogram-double-overline ideogram-stress ideogram-cancel ) (defconstant blink slow-blink) (e48:ris) (let ((y 0) (x 0) bb ff) (flet ((label (col) (format nil "~8a" (subseq (string (sgr-codes-label col)) 0 (position (character "-") (string (sgr-codes-label col))))))) (dolist (b (list WHITE-background CYAN-background MAGENTA-background YELLOW-background BLUE-background GREEN-background RED-background BLACK-background)) (setf bb (label b)) (dolist (f (list WHITE-foreground CYAN-foreground MAGENTA-foreground YELLOW-foreground BLUE-foreground GREEN-foreground RED-foreground BLACK-foreground)) (setf ff (label f)) (e48:cup y x) (incf y) (when (= y 16) (setf y 0 x (+ x 20))) (e48:sgr b) (e48:sgr f) (format t "~A on ~A " ff bb) (e48:sgr normal))))) (let ((y 16) (x 0) jin jbl jun jbo) (flet ((label (mode) (format nil "~8a" (subseq (string (sgr-codes-label mode)) 0 (min (length (string (sgr-codes-label mode))) 8))))) (dolist (in (list no-invert invert)) (setf jin (label in)) (dolist (bl (list no-blink blink)) (setf jbl (label bl)) (dolist (un (list no-underline underline)) (setf jun (label un)) (dolist (bo (list no-bold bold)) (setf jbo (label bo)) (e48:cup y x) (incf y) (e48:sgr in) (e48:sgr bl) (e48:sgr un) (e48:sgr bo) (format t " ~A ~A ~A ~A " jin jbl jun jbo) (e48:sgr normal)))) (setf y 16 x 40)))) (finish-output) ;;;; ansi-test.lisp -- -- ;;;;