четверг, 25 ноября 2010 г.

Обработка 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.

среда, 24 ноября 2010 г.

Переделал свой форк 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-изображений с прозрачностью (сейчас мне приходиться насильственно добавлять к таким изображениям фон).

четверг, 18 ноября 2010 г.

Необычное использование 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, посмотреть исходный код можно здесь

вторник, 16 ноября 2010 г.

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).

понедельник, 15 ноября 2010 г.

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 в свой оверлей.

воскресенье, 14 ноября 2010 г.

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

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

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

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

среда, 10 ноября 2010 г.

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.

вторник, 9 ноября 2010 г.

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

Есть в рунете замечательный сайт - 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-страниц.

понедельник, 8 ноября 2010 г.

RESTAS и Quicklisp

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