Mercurial > hg > indyvon
view src/indyvon/layers.clj @ 28:828795987d4c
Some ideas.
author | Mikhail Kryshen <mikhail@kryshen.net> |
---|---|
date | Mon, 05 Jul 2010 06:11:42 +0400 |
parents | 1237f7555029 |
children | 4cb70c5a6e0d |
line wrap: on
line source
;; ;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net> ;; ;; This file is part of Indyvon. ;; (ns indyvon.layers (:use indyvon.core) (:import (java.awt Cursor) (java.awt.font FontRenderContext TextLayout))) ;; Define as macro to avoid unnecessary calculation of inner and outer ;; sizes in the first case. (defmacro align-xy [inner outer align first center last] `(case ~align ~first 0 ~center (/ (- ~outer ~inner) 2) ~last (- ~outer ~inner))) (defmacro align-x [inner outer align] `(align-xy ~inner ~outer ~align :left :center :right)) (defmacro align-y [inner outer align] `(align-xy ~inner ~outer ~align :top :center :bottom)) (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! content c 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)])))))) (defn- re-split [re s] (seq (.split re s))) (defn- layout-text [lines font font-context] (map #(TextLayout. % font font-context) lines)) (defn- text-width [layouts] (reduce #(max %1 (.getAdvance %2)) 0 layouts)) (defn- text-height [layouts] (reduce #(+ %1 (.getAscent %2) (.getDescent %2) (.getLeading %2)) 0 layouts)) (defn text-layer "Creates a layer to display multiline text." ([text] (text-layer text :left :top)) ([text h-align v-align] (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)] (reify Layer (render! [l c g] (let [w (:width c) h (:height c) font (.getFont g) font-context (:font-context c) layouts (layout-text lines font font-context) y (align-y (text-height layouts) h v-align)] (loop [layouts layouts, y y] (when-first [layout layouts] (let [ascent (.getAscent layout) lh (+ ascent (.getDescent layout) (.getLeading layout)) x (align-x (.getAdvance layout) w h-align)] (.draw layout g x (+ y ascent)) (recur (next layouts) (+ y lh))))))) (size [l c] (let [layouts (layout-text lines (-> c :theme :font) (:font-context c)) width (text-width layouts) height (text-height layouts)] [width height])))))) (defn viewport "Creates scrollable viewport layer." ([content] (viewport content :left :top)) ([content h-align v-align] (let [x (ref 0) y (ref 0) fix-x (ref 0) fix-y (ref 0) last-width (ref 0) last-height (ref 0)] (reify Layer (render! [layer c g] (let [anchor (anchor content c h-align v-align) width (:width c) height (:height c)] (dosync (alter x + (align-x width @last-width h-align)) (alter y + (align-y height @last-height v-align)) (ref-set last-width width) (ref-set last-height height)) (draw! content c g (- 0 @x (anchor 0)) (- 0 @y (anchor 1))))) (size [layer c] (size content c)) MouseHandler (handle-mouse [layer c e] (case (:id e) :mouse-pressed (do (dosync (ref-set fix-x (:x-on-screen e)) (ref-set fix-y (:y-on-screen e))) (->> Cursor/MOVE_CURSOR Cursor. (.setCursor (:target c)))) :mouse-released (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor (:target c))) :mouse-dragged (do (dosync (alter x + (- @fix-x (:x-on-screen e))) (alter y + (- @fix-y (:y-on-screen e))) (ref-set fix-x (:x-on-screen e)) (ref-set fix-y (:y-on-screen e))) (update c)) nil))))))