Обработка PNG-изображений на Common Lisp

Для своего текущего приложения я использую интерфейс, который откровенно содрал отсюда, при чём, необходимые для таких красивых панелек png-файлы взял как есть (но несколько изменил способ их использования в html-разметке). Всё получается относительно неплохо, но мне захотелось посмотреть как будет выглядеть это приложение в других цветовых схемах.

А вот с этим проблема, поскольку украденный мной набор png-файлов сделан только в чёрном исполнении. Сам я в дизайне полный ноль, всякими Gimp-ами владею очень слабо и вообще, как создаются подобные изображения понятия не имею: я пробовал создать такое просто кодом с помощью градиентов, закруглений и т.п., но так хорошо никак не получается.

И я решил просто по-пиксельно заменить все цвета оригинальных изображений на новые, которые будут вычисляться на основе базового цвета. В оригинальных файлах основным цветом является rgb(30, 30, 30), но для создания эффекта тени используется переход данного цвета в чёрный. Функция translate-color вычисляет новый цвет на основе базового и опирается на rgb(30, 30, 30) как на основу старого изображения:

(defun translate-color (orig base-color)
  (iter (for i in orig)
        (for j in base-color)
        (collect (min (max (+ i j -30) 0)
                      255))))

Для создания png-файлов есть известное и хорошее решение - ZPNG, а вот библиотеки для разбора png-файлов я не знал и кажется такая библиотека не освещалось широко где-либо, по крайней мере, я не видел. Однако, быстрый поиск в гугл сразу показал мне библиотеку png-read. Я опробовал её на нескольких примерах и кажется она "просто работает". Таким образом, я смог записать такой код по изменению цвета нужных мне изображений:

(defun make-other-png (orig dest base-color)
  (let* ((orig-png (png-read:read-png-file orig))
         (orig-image (png-read:image-data orig-png))
         (png (make-instance 'zpng:png
                             :color-type :truecolor-alpha
                             :width (png-read:width orig-png)
                             :height (png-read:height orig-png)))
         (image (zpng:data-array png)))
    (iter (for w from 0 below (png-read:width orig-png))
          (iter (for h from 0 below (png-read:height orig-png))
                (iter (for c in (translate-color (list (aref orig-image w h 0)
                                                       (aref orig-image w h 1)
                                                       (aref orig-image w h 2))
                                                 base-color))
                      (for i from 0)
                      (setf (aref image h w i) c))
                (setf (aref image h w 3)
                      (aref orig-image w h 3))))
    (zpng:write-png png dest)))

Функция make-other-png принимает путь к оригинальному файлу, путь для сохранения нового изображения и цвет, который должен являться базовым для нового изображения.

Опробовал данный код и остался очень доволен результатом. Вот что получается в результате вызова

(make-other-png "win_LB.png" "out.png" '(0 192 0))

Слева оригинальное изображение, а с права получившееся в результате преобразования.

P.S. Ebuild для png-read я добавил в свой форк gentoo-lisp-overlay.

Переделал свой форк cl-pdf

Форк cl-pdf я сделал довольно давно и тогда я ещё плохо ориентировался как в CL, так и в git, в итоге форк был оформлен очень топорно, без истории изменений. Сейчас дошли руки полностью его переделать используя git svn, так что в него попала полная история изменения. Все свои изменения также внёс одно за другим. Так что стало намного лучше и можно теперь нормально синхронизироваться с основным репозиторием, если там вдруг будут изменения, а они там бывают, хоть и реже чем раз в год.

От оригинальной версии мой форк отличается следующим:

• Почищен разный мусор, типа каких-то левых патчей для поддержки CMUCL, различных вариаций на тему zlib и т.п., которые предлагалось как-то загружать руками
• Для сжатия используется salza2 и только она.
• Поддерживается загрузка и использования ttf шрифтов с помощью zpb-ttf
• У функций draw-centered-text, draw-left-text и draw-right-text имеется дополнительный опциональный параметр max-height (параметр max-width уже был в оригинальной версии)
• Добавлена функция append-child-ouline, а также экспортируется функция outline-root

Вообще надо немного привести в порядок код для генерации PDF, который я использую на работе, а также код для генерации PDF-версии PCL, который используется на lisper.ru и в соответствии с этим также внести ряд небольших изменений.

Плюс, есть желание выкинуть из cl-pdf код для парсинга PNG-файлов и использовать для этого библиотеку png-read (которую я обнаружил на днях) и сделать возможным использование PNG-изображений с прозрачностью (сейчас мне приходиться насильственно добавлять к таким изображениям фон).

Мой форк: http://github.com/archimag/cl-pdf

Необычное использование restas-directory-publisher

Модуль restas-directory-publisher по начальной задумке предназначался для простой публикации директорий, содержащих статические файлы. Но в последнее время я использовал его сразу несколькими способами, которые я никак не ожидал в момент разработки и которые показались мне довольно любопытными. Так что решил немного об этом рассказать.

Сейчас у меня возникла необходимость показывать на странице пользователю диалог, в котором о мог бы выбрать файл, находящийся на файловой системе сервера. Немного погуглив нашёл несколько решений и примеров для jquery, которые показались мне просто ужасными и я решил, что сделать собственное решение будет значительно проще и быстрее. Как оказалось, делается оно почти тривиально.

Полученное мною решение состоит из трёх частей: шаблон cl-closure-template для генерации контента на стороне клиента, несколько строк кода на JavaScript для управления и серверная часть, которая возвращает информацию о файловой системе.

Модуль restas-directory-publisher умеет собирать информацию о файловой системе, но по умолчанию возвращаёт её в формате html, а мне для данной задачи нужно в формате JSON. Исправить этот недостаток можно так:

(defun encode-json (obj)
  (flet ((encode-json-list (list stream)
           (if (keywordp (car list))
               (json:encode-json-plist list stream)
               (json::encode-json-list-guessing-encoder list stream))))
    (let ((json::*json-list-encoder-fn* #'encode-json-list))
      (json:encode-json-to-string obj))))

(restas:mount-submodule -file-system- (#:restas.directory-publisher)
  (restas.directory-publisher:*baseurl* '("api"))
  (restas.directory-publisher:*directory* #P"/")
  (restas.directory-publisher:*autoindex* t)
  (restas.directory-publisher:*autoindex-template* #'encode-json))

Здесь производится настройка подключения субмодуля и с переменной restas.directory-publisher:*autoindex-template*, используемой для генерации контента, связывается функция #'encode-json (реализацию данной функции я уже приводил ранее).

Шаблон для генерации разметки:

{template directoryBrowse}
    <table summary="Directory Listing" cellpadding="0" cellspacing="0">
        <thead>
            <tr>
                <th class="n">Name</th>
                <th class="m">Last Modified</th>
                <th class="s">Size</th>
                <th class="t">Type</th></tr>
        </thead>

        <tbody>
            {if $parent}
                <tr>
                    <td class="n">
                        <span class="directory" href="{$parent}">Parent Directory</span>
                    </td>
                    <td class="m"> </td>
                    <td class="s">-  </td>
                    <td class="t">Directory</td>
                </tr>
            {/if}

            {foreach $path in $paths}
                <tr>
                    <td class="n">
                        <span class="{$path.type == 'Directory' ? 'directory' : 'file'}" href="{$path.href}">
                            {$path.name}
                        </span>
                        {nil}
                        {if $path.type == 'Directory'}/{/if}
                    </td>
                    <td class="m">{$path.lastModified}</td>
                    <td class="s">{$path.size ? $path.size : '-  ' |noAutoescape}</td>
                    <td class="t">{$path.type}</td>
                </tr>
            {/foreach}
        </tbody>
    </table>
{/template} 

Я лишь немного модифицировал шаблон, используемый в restas-directory-publisher

Управлящий код на JavaScript совсем прост:

$(document).ready( function () { browse("/api/"); } );

function browse (url) {
    function directoryClick (evt) {
        browse($(evt.currentTarget).attr("href"));
    }

    function fileClick (evt) {
        $("h1").html(decodeURI($(evt.currentTarget).attr("href")));
    }

    function handler (data) {
        $("#content").html(restas.jsBrowser.view.directoryBrowse(data));
        $("#content .directory").click(directoryClick);
        $("#content .file").click(fileClick);
    }

    $.getJSON(url, handler);
}

Я организовал этот код в виде отдельного законченного примера jsBrowser, который включил в состав restas-directory-publisher, посмотреть исходный код можно здесь

cl-mssql и FreeTDS-0.82

Обновил у себя FreeTDS до версии 0.82 и обнаружил проблемы с кодировками. Я использую cl-mssql для взаимодействия с 1С, данные там лежат в кодировке cp1251, а у меня в системе используется utf-8. Версия FreeTDS-0.62 кажется вообще никак не учитывала кодировки, поэтому в cl-mssql есть параметр соединения :external-format, который использовался для настройки переменной cffi:*default-foreign-encoding* - я устанавливал его в :cp1251 и спокойно работал. Версия FreeTDS-0.82 уже относится к этому не так просто и, вероятно, самостоятельно занимается перекодированием строк (а может как-то по другому взаимодействует с сервером, я не спец в этом вопросе). Теперь приходиться настраивать кодировку в /etc/freetds.conf:

[global]
    client charset = utf8

Кодировка, указанная в /etc/freetds.conf, должна совпадать с кодировкой, которая указывается в mssql:connect (по-умолчанию - :utf-8).

cl-popen

Переименовал свою либу iolib.process в cl-popen и несколько изменил интерфейс. Использовать для создания и взаимодействия с дочерними потоками через стандартные потоки ввода/вывода можно, например, так:

(popen:with-popen2 ("cat | grep good" conveyer pin pout)
  (write-line "Java is bad" pin)
  (write-line "Python is bad" pin)
  (write-line "Common Lisp is good" pin)
  (write-line "imho" pin)
  (close pin)
  (read-line pout))

Поскольку стал использовать эту либу по работе, то добавил ebuild в свой оверлей.

Предупреждение

Сегодня ночью ожидается недоступность lisper.ru в связи с техническими работа в датацентре.

Регистрация на lisper.ru и спам

При регистрации на lisper.ru отсылается письмо со ссылкой на продолжение регистрации. Это письмо стабильно в gmail попадает в спам. Прошу помощи у компетентных людей в чём причины и как это победить.

cl-uglify-js

Совершенно случайно (автор форкнул мой форк cl-pdf, а я пошёл посмотреть кто такой) обнаружил cl-uglify-js - библиотеку (Common Lisp) для "сжатия" кода на JavaScript. Я вообще давно уже мечтал о подобной либе для CL, ибо тянуть в проект на CL что-нибудь типа Google Closure Compiler совсем не хочется. Теперь же всё получается просто. Я протестировал эту библиотеку на своём основном проекте, в частности, на коде который генерирует cl-closure-template и обнаружил, что проект всё ещё работает (никаких изменений не выявленно), а код превратился в жуткое нечитабельное сжатое месиво - именно то, что нужно.

Вообще, ситуация с разработкой высоко-интерактивных веб-приложений на Common Lisp начинает казаться мне всё более и более симпатичной.

Кстати, cl-uglify-js является портом UglifyJS - аналогичной библиотеки для Node.js того же автора, которая на github имеет более 300 подписчиков, что внушает серьёзный оптимизм. Забавно, что в UglifyJS для разбора JavaScript используется порт parse-js - вот такая вот тесная интеграция JavaScript и Common Lisp.

Ценителям поэзии

Есть в рунете замечательный сайт - www.stihi.ru, на котором помимо графоманов довольно много и интересных, хороших авторов. Если какой-то автор вам особенно понравился, то все его стихи выкачать и аккуратно сложить по папочкам (в соответствии с классификацией автора) можно с помощью такого кода на Common Lisp:

(defun load-poem (url dir &key verbose)
  (html:with-parse-html (page url :encoding "cp1251")
    (let* ((index (xpath:find-single-node page "/html/body/index"))
           (title (xpath:find-string index "h1")))
    (when verbose
      (format t "Load ~A (~A)~%" url title))
    (with-open-file (out (make-pathname :directory (pathname-directory dir)
                                        :name title
                                        :type "txt")
                         :direction :output :if-exists :supersede)
      (iter (for br in (xpath:find-list index "div[@class='text']/br"))
            (write-line (string-trim #(#\Newline)
                                     (xtree:text-content (xtree:prev-sibling br)))
                        out))))))
                 
(defun load-all-poems (url target &key verbose (recursive t))
  (ensure-directories-exist target)
  (html:with-parse-html (page url :encoding "cp1251")
    (iter (for node in (xpath:find-list page "//ul/li/a"))
          (load-poem (puri:merge-uris (puri:parse-uri (xtree:attribute-value node "href"))
                                      url)
                     target
                     :verbose verbose))
    (when recursive
      (iter (for node in (xpath:find-list page "//div[@id='bookheader']/a"))
            (let ((title (xtree:text-content node)))
              (when verbose
                (format t "~%Load book ~A~%" title))
              (load-from-stihiru (puri:merge-uris (puri:parse-uri (xtree:attribute-value node "href"))
                                                  url)
                                 (merge-pathnames (make-pathname :directory (list :relative title))
                                                  target)
                                 :recursive nil
                                 :verbose verbose))))))

Выделение содержательной части из html-страниц весьма тривиально и реализуется за счёт использования языка запросов XPath. Теперь скачать, например, все стихи моей жены можно таким вызовом:

(load-all-poems #U"http://www.stihi.ru/avtor/mari_mishon"
                #P"/var/kubart/poems/"

При написании данного кода я обнаружил, что libxml2 не может правильно определить кодировку страниц стихиры, так что пришлось несколько доработать cl-libxml2, добавив возможность явно указывать кодировку html-страниц.

RESTAS и Quicklisp

Стала возможна лёгкая установка RESTAS (а также restas-directory-publisher) с помощью Quicklisp.