1
2(PUT '|PALETTE;dark;C$;1| '|SPADreplace| '(XLAM (|c|) (CONS 1 |c|)))
3
4(SDEFUN |PALETTE;dark;C$;1| ((|c| |Color|) ($ $)) (CONS 1 |c|))
5
6(PUT '|PALETTE;dim;C$;2| '|SPADreplace| '(XLAM (|c|) (CONS 2 |c|)))
7
8(SDEFUN |PALETTE;dim;C$;2| ((|c| |Color|) ($ $)) (CONS 2 |c|))
9
10(PUT '|PALETTE;bright;C$;3| '|SPADreplace| '(XLAM (|c|) (CONS 3 |c|)))
11
12(SDEFUN |PALETTE;bright;C$;3| ((|c| |Color|) ($ $)) (CONS 3 |c|))
13
14(PUT '|PALETTE;pastel;C$;4| '|SPADreplace| '(XLAM (|c|) (CONS 4 |c|)))
15
16(SDEFUN |PALETTE;pastel;C$;4| ((|c| |Color|) ($ $)) (CONS 4 |c|))
17
18(PUT '|PALETTE;light;C$;5| '|SPADreplace| '(XLAM (|c|) (CONS 5 |c|)))
19
20(SDEFUN |PALETTE;light;C$;5| ((|c| |Color|) ($ $)) (CONS 5 |c|))
21
22(PUT '|PALETTE;hue;$C;6| '|SPADreplace| 'QCDR)
23
24(SDEFUN |PALETTE;hue;$C;6| ((|p| $) ($ |Color|)) (QCDR |p|))
25
26(PUT '|PALETTE;shade;$I;7| '|SPADreplace| 'QCAR)
27
28(SDEFUN |PALETTE;shade;$I;7| ((|p| $) ($ |Integer|)) (QCAR |p|))
29
30(SDEFUN |PALETTE;coerce;C$;8| ((|c| |Color|) ($ $))
31        (SPADCALL |c| (QREFELT $ 10)))
32
33(SDEFUN |PALETTE;coerce;$Of;9| ((|p| $) ($ |OutputForm|))
34        (SPADCALL
35         (LIST (SPADCALL "[" (QREFELT $ 19))
36               (SPADCALL (QCDR |p|) (QREFELT $ 20))
37               (SPADCALL "] from the " (QREFELT $ 19))
38               (SPADCALL
39                (SPADCALL (LIST "Dark" "Dim" "Bright" "Pastel" "Light")
40                          (QCAR |p|) (QREFELT $ 22))
41                (QREFELT $ 19))
42               (SPADCALL " palette" (QREFELT $ 19)))
43         (QREFELT $ 24)))
44
45(DECLAIM (NOTINLINE |Palette;|))
46
47(DEFUN |Palette| ()
48  (SPROG NIL
49         (PROG (#1=#:G413)
50           (RETURN
51            (COND
52             ((LETT #1# (HGET |$ConstructorCache| '|Palette|))
53              (|CDRwithIncrement| (CDAR #1#)))
54             ('T
55              (UNWIND-PROTECT
56                  (PROG1
57                      (CDDAR
58                       (HPUT |$ConstructorCache| '|Palette|
59                             (LIST (CONS NIL (CONS 1 (|Palette;|))))))
60                    (LETT #1# T))
61                (COND ((NOT #1#) (HREM |$ConstructorCache| '|Palette|))))))))))
62
63(DEFUN |Palette;| ()
64  (SPROG ((|dv$| NIL) ($ NIL) (|pv$| NIL))
65         (PROGN
66          (LETT |dv$| '(|Palette|))
67          (LETT $ (GETREFV 29))
68          (QSETREFV $ 0 |dv$|)
69          (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL)))
70          (|haddProp| |$ConstructorCache| '|Palette| NIL (CONS 1 $))
71          (|stuffDomainSlots| $)
72          (SETF |pv$| (QREFELT $ 3))
73          (QSETREFV $ 6
74                    (|Record| (|:| |shadeField| (|Integer|))
75                              (|:| |hueField| (|Color|))))
76          $)))
77
78(MAKEPROP '|Palette| '|infovec|
79          (LIST
80           '#(NIL NIL NIL NIL NIL NIL '|Rep| (|Color|) |PALETTE;dark;C$;1|
81              |PALETTE;dim;C$;2| |PALETTE;bright;C$;3| |PALETTE;pastel;C$;4|
82              |PALETTE;light;C$;5| |PALETTE;hue;$C;6| (|Integer|)
83              |PALETTE;shade;$I;7| |PALETTE;coerce;C$;8| (|String|)
84              (|OutputForm|) (0 . |message|) (5 . |coerce|) (|List| 17)
85              (10 . |elt|) (|List| $) (16 . |hconcat|) |PALETTE;coerce;$Of;9|
86              (|HashState|) (|SingleInteger|) (|Boolean|))
87           '#(~= 21 |shade| 27 |pastel| 32 |light| 37 |latex| 42 |hue| 47
88              |hashUpdate!| 52 |hash| 58 |dim| 63 |dark| 68 |coerce| 73
89              |bright| 83 = 88)
90           'NIL
91           (CONS (|makeByteWordVec2| 1 '(0 0 0))
92                 (CONS '#(|SetCategory&| |BasicType&| NIL)
93                       (CONS
94                        '#((|SetCategory|) (|BasicType|) (|CoercibleTo| 18))
95                        (|makeByteWordVec2| 28
96                                            '(1 18 0 17 19 1 7 18 0 20 2 21 17
97                                              0 14 22 1 18 0 23 24 2 0 28 0 0 1
98                                              1 0 14 0 15 1 0 0 7 11 1 0 0 7 12
99                                              1 0 17 0 1 1 0 7 0 13 2 0 26 26 0
100                                              1 1 0 27 0 1 1 0 0 7 9 1 0 0 7 8
101                                              1 0 0 7 16 1 0 18 0 25 1 0 0 7 10
102                                              2 0 28 0 0 1)))))
103           '|lookupComplete|))
104
105(MAKEPROP '|Palette| 'NILADIC T)
106