-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathgray.lisp
164 lines (135 loc) · 2.62 KB
/
gray.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
;;; -*- Mode:Lisp; Package:CLUEI; Syntax:COMMON-LISP; Base:10; Lowercase:T -*-
;;; Graying stipple patterns
;;;
;;; TEXAS INSTRUMENTS INCORPORATED
;;; P.O. BOX 149149
;;; AUSTIN, TEXAS 78714-9149
;;;
;;; Copyright (C)1987,1988,1989,1990 Texas Instruments Incorporated.
;;;
;;; Permission is granted to any individual or institution to use, copy, modify,
;;; and distribute this software, provided that this complete copyright and
;;; permission notice is maintained, intact, in all copies and supporting
;;; documentation.
;;;
;;; Texas Instruments Incorporated provides this software "as is" without
;;; express or implied warranty.
;;;
;;; Some common grays
;;; These are used to draw gray stipple patterns onto the screen.
;;; Grays with an "R" on the end have regular patterns (grid-like)
;;; Other grays (without the "R") have pixels offset to avoid the grid look.
(in-package :cluei)
(defvar *bitmap-images* nil "List of defined bitmap images")
(defmacro defimage (name &optional plist &body patterns)
(when (or (typep plist 'bit-vector)
(and (consp plist) (eq (car plist) 'quote) (typep (cadr plist) 'bit-vector)))
(push plist patterns)
(setq plist nil))
`(progn
(pushnew ',name *bitmap-images*)
(defparameter ,name (xlib:bitmap-image '(:name ,name ,@plist) ,@patterns))))
(defimage 100%gray
'#*1)
(defimage 93%gray
'#*01111111
'#*11111111
'#*11110111
'#*11111111)
(defimage 93%grayr
'#*0111
'#*1111
'#*1111
'#*1111)
(defimage 88%gray
'#*0111
'#*1111
'#*1101
'#*1111)
(defimage 88%grayr
'#*0111
'#*1111
'#*0111
'#*1111)
(defimage 75%gray
'#*0111
'#*1101
'#*0111
'#*1101)
(defimage 75%grayh
'#*0111
'#*1101
'#*1011
'#*1110)
(defimage 75%grayr
'#*0101
'#*1111
'#*0101
'#*1111)
(defimage 62%gray
'#*0111
'#*1010
'#*1101
'#*1010)
(defimage 62%grayr
'#*0111
'#*1010
'#*0111
'#*1010)
(defimage 66%gray
'#*011
'#*101
'#*110) ;; Very SLOW
(defimage 50%gray
'#*01
'#*10)
(defimage 50%grayr
'#*10
'#*10)
;; The rest are just reversals of the above
(defimage 33%gray
'#*100
'#*010
'#*001) ;; Very SLOW
(defimage 37%gray
'#*1000
'#*0101
'#*0010
'#*0101)
(defimage 37%grayr
'#*1000
'#*0101
'#*1000
'#*0101)
(defimage 25%gray
'#*1000
'#*0010
'#*1000
'#*0010)
(defimage 25%grayr
'#*1010
'#*0000
'#*1010
'#*0000)
(defimage 12%gray
'#*1000
'#*0000
'#*0010
'#*0000)
(defimage 12%grayr
'#*1000
'#*0000
'#*1000
'#*0000)
(defimage 6%gray
'#*10000000
'#*00000000
'#*00001000
'#*00000000)
(defimage 6%grayr
'#*1000
'#*0000
'#*0000
'#*0000)
(defimage 0%gray
'#*0)