Custom colorschemes for the 'VIP' editor

vip-colors.l

# VIP colors
#
# INSTALL - add to '~/.pil/viprc'
#
# Creating a new colorscheme for 'VIP' is easy as 1, 2, 3!!


# 1) pick colors!
# https://stackoverflow.com/questions/4842424/list-of-ansi-color-escape-sequences


# 2) (re)Define constants

# Standard (Alex's) theme
(de ULINE . 4)
(de U-OFF . 24)
(de TSM . 0)
(de PAR . 0)
(de TXT . 0)
(de NUM . 0)
(de SYM . 0)
(de ERR . 31)
(de COM . 36)
(de RDM . 0)

#{
# jellybeans theme
(de ULINE . "92;4")     # ULINE - transient symbol underline
(de U-OFF . "92;24")    # U-OFF - transient symbol underline off
(de TSM . "92;24")      # TSM - transient symbol markup
(de PAR . "90;22")      # PAR - (super-)parens
(de TXT . "37;22")      # TXT - the text
(de NUM . "94;22")      # NUM - the numbers
(de SYM . "95;1")       # SYM - picolisp symbols (T, NIL, @, ^ for now)
(de ERR . 31)           # ERR - errors
(de COM . "36;22")      # COM - comments
(de RDM . "95;1")       # RDM - read macros '`' \ '~'
(de QOT . "1")          # QOT - single quote "'"
}#

#{
# ice theme (works well with redshift)
(de ULINE . "96;4;22")
(de U-OFF . "96;22;24")
(de TSM . "96;22;24")
(de PAR . "37;1;2")
(de TXT . "0;22")
(de NUM . "0;22")
(de SYM . "95;1;22")
(de COM . "36;1;2;3")
(de RDM . "37;22")
(de QOT . "0;22")
}#

#{
# simple night theme
(setq ULINE "37;4")
(setq U-OFF "37;22;24")
(setq TSM "37;22;24")
(setq PAR "90;1")
(setq TXT "37;22")
(setq NUM "37;22")
(setq SYM "37;22")
(setq ERR 31)
(setq COM "36")
(setq RDM "37;22")
(setq QOT "37;22")
}#

#{
# Aqua theme
(de TXT . "94;22")
(de PAR . "34;22")
(de TSM . "95;24")
(de ULINE . "95;4")
(de U-OFF . "95;24")
(de NUM . "94;2")
(de SYM . "95;1;2")
(de ERR . 31)
(de COM . "36;2;3")
(de RDM . "95;1")
}#

#{
# Retro theme
(de ULINE . "92;4")
(de U-OFF . "92;24")
(de TSM . "92;24")
(de PAR . "32;1")
(de TXT . "92;1")
(de COM . "36;3")
(de NUM . "92;1")
(de SYM . "92;1")
(de ERR . 31)
(de RDM . "92;1")
}#

# colorscheme with more hooks
(de addLine (Y L N)
   (cup (+ (: top) Y) 1)
   (clreol)
   (let Line (nth L (: winX))
      (for (I . C) Line
         (T (lt0 (dec 'N)))
         (let (Next (car (nth Line (+ I 1)))
               Prev (car (nth Line (- I 1))) )
            (cond
               ((: buffer flat))
               ((=T (val C))
                  (ifn (>= "^_" C "^A")
                     (attr NIL T)
                     (setq C (char (+ 64 (char C))))
                     (attr ERR T) ) )
               ((>= "^_" C "^A")
                  (setq C (char (+ 64 (char C))))
                  (attr ERR) )
               ((gt0 (val C))
                  (attr COM) )
               ((member C '("(" ")" "[" "]"))
                  (attr PAR) )
               ((= C "\"")
                  (attr TSM) )
               ((= C ".")
                  (if (format Next *Scl)
                     (attr NUM)
                     (attr TXT) ) )
               ((= C "-")
                  (if (format Next *Scl)
                     (attr NMB)
                     (attr TXT) ) )
               ((= C "'")
                  #(if (and (member Prev '(NIL "(" ")" "[" "]" " ")) (member Next '(NIL "(" ")" "[" "]" " ")))
                  (attr QOT) )
               ((member C '("`" "~"))
                  (if (and (member Prev '(NIL "(" ")" "[" "]" " ")) (member Next '(NIL "(" ")" "[" "]" " ")))
                     (attr RDM)
                     (attr RDM) ) )
               ((member C '("T" "@" "\^"))
                  (if (and (member Prev '(NIL "(" ")" "[" "]" " ")) (member Next '(NIL "(" ")" "[" "]" " ")))
                     (attr SYM)
                     (attr TXT) ) )
               ((member C (chop "NIL"))
                  (case C
                     ("N"
                        (if (and (member Prev '(NIL "(" ")" "[" "]" " ")) (= Next "I"))
                           (attr SYM)
                           (attr TXT) ) )
                     ("I"
                        (if (and (= Prev "N") (= Next "L"))
                           (attr SYM)
                           (attr TXT) ) )
                     ("L"
                        (if (and (= Prev "I") (member Next '(NIL "(" ")" "[" "]" " ")))
                           (attr SYM)
                           (attr TXT) ) ) ) )
               ((format C *Scl)
                  (if (or (format Prev *Scl) (= Prev "[") (= Prev "(") (= Prev " ") (= Prev "-") (= Prev "."))
                     (attr NUM)
                     (attr TXT) ) )
               (T (attr TXT)) )
            (prin C) ) ) )
   (attr) )