Mercurial > hg > indyvon
view src/indyvon/core.clj @ 14:0a2fafca72d8
Border layer decorator.
Font render context.
Manual identation for reify and proxy.
author | Mikhail Kryshen <mikhail@kryshen.net> |
---|---|
date | Tue, 15 Jun 2010 04:35:57 +0400 |
parents | c6009a144727 |
children | 87bd822aa815 |
line wrap: on
line source
;; ;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net> ;; ;; This file is part of Indyvon. ;; (ns indyvon.core (:import (java.awt Color Font))) (defprotocol Layer (render! [this context graphics]) (size [this context]) (anchor [this context])) (defrecord Theme [fore-color back-color border-color font]) (defn default-theme [] (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12))) (defrecord LayerContext [layer parent x y width height update-fn dispatcher font-context theme]) (defn default-context [] (LayerContext. nil nil 0 0 0 0 nil nil nil (default-theme))) (defn- spec-map ([specs] (spec-map {} specs)) ([mm specs] (if-let [form (first specs)] (recur (conj mm [(first form) (next form)]) (next specs)) mm))) (defn- merge-specs [s1 s2] (for [spec (spec-map (spec-map s1) s2)] (cons (first spec) (second spec)))) (defmacro reify-layer [& specs] `(reify Layer ~@(merge-specs '((size [_ _] [0 0]) (anchor [_ _] [0 0])) specs))) (defn- make-graphics [graphics x y w h clip] (if clip (.create graphics x y w h) (doto (.create graphics) (.translate x y)))) (defn- apply-theme [graphics theme] (doto graphics (.setColor (:fore-color theme)) (.setFont (:font theme)))) (defn draw! "Render layer in a new graphics context." ([context layer graphics] (draw! context layer graphics 0 0 (:width context) (:height context))) ([context layer graphics x y] (draw! context layer graphics x y true)) ([context layer graphics x y clip] (let [s (size layer context)] (draw! context layer graphics x y (s 0) (s 1) clip))) ([context layer graphics x y w h] (draw! context layer graphics x y w h true)) ([context layer graphics x y w h clip] (let [graphics (make-graphics graphics x y w h clip)] (try (render! layer (assoc context :layer layer :parent context :x (+ (:x context) x) :y (+ (:y context) y) :width w :height h) graphics) (finally (.dispose graphics)))))) (defmacro decorate-layer [layer & specs] `(let [layer# ~layer] (reify Layer ~@(merge-specs `((~'render! [l# c# g#] (draw! c# layer# g#)) (~'size [l# c#] (size layer# c#)) (~'anchor [l# c#] (anchor layer# c#))) specs)))) ;; ;; Layer implementations. ;; (defn border-layer "Decorate layer with a border." ([content] (border-layer content 1)) ([content width] (border-layer content width 0)) ([content width gap] (let [offset (+ width gap)] (reify-layer (render! [l c g] (let [w (:width c) h (:height c)] (.setColor g (-> c :theme :border-color)) (doseq [i (range 0 width)] (.drawRect g i i (- w 1 i i) (- h 1 i i))) (draw! c content g offset offset (- w offset offset) (- h offset offset)))) (size [l c] (let [s (size content c)] [(+ (s 0) offset offset) (+ (s 1) offset offset)])) (anchor [l c] (let [a (anchor content c)] [(+ (a 0) offset) (+ (a 1) offset)])))))) ;; (defn text-layer ;; ([text] ;; (text :left :top)) ;; ([text h-align v-align] ;; (let [newline #"\\r\\n|\\n|\\r|\\u0085|\\u2028|\\u2029"] ;; (reify-layer))))