Mercurial > hg > indyvon
view src/kryshen/indyvon/layers.clj @ 37:d2fb660ca49f
Remove "opts" argument from Layer methods.
author | Mikhail Kryshen <mikhail@kryshen.net> |
---|---|
date | Fri, 09 Jul 2010 01:08:45 +0400 |
parents | 5413b188d112 |
children | 930c088e1367 |
line wrap: on
line source
;; ;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net> ;; ;; This file is part of Indyvon. ;; (ns kryshen.indyvon.layers (:use kryshen.indyvon.core) (:import (kryshen.indyvon.core Size Location) (java.awt Font 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] (let [w (:width *bounds*) h (:height *bounds*)] (.setColor *graphics* (:border-color *theme*)) (doseq [i (range 0 width)] (.drawRect *graphics* i i (- w 1 i i) (- h 1 i i))) (draw! content offset offset (- w offset offset) (- h offset offset)))) (size [l] (let [s (size content)] (Size. (+ (:width s) offset offset) (+ (:height s) offset offset)))))))) (defn- re-split [^java.util.regex.Pattern re s] (seq (.split re s))) (defn- layout-text [lines ^Font font ^FontRenderContext font-context] (map #(TextLayout. ^String % font font-context) lines)) (defn- text-width [layouts] (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts)) (defn- text-height [layouts] (reduce (fn [w ^TextLayout tl] (+ w (.getAscent tl) (.getDescent tl) (.getLeading tl))) 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! [layer] (let [w (:width *bounds*) h (:height *bounds*) font (.getFont *graphics*) layouts (layout-text lines font *font-context*) y (align-y (text-height layouts) h v-align)] (loop [layouts layouts, y y] (when-first [^TextLayout layout layouts] (let [ascent (.getAscent layout) lh (+ ascent (.getDescent layout) (.getLeading layout)) x (align-x (.getAdvance layout) w h-align)] (.draw layout *graphics* x (+ y ascent)) (recur (next layouts) (+ y lh))))))) (size [layer] (let [layouts (layout-text lines (:font *theme*) *font-context*) width (text-width layouts) height (text-height layouts)] (Size. 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] (with-handlers layer (let [anchor (anchor content h-align v-align) width (:width *bounds*) height (:height *bounds*)] (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 (- 0 @x (:x anchor)) (- 0 @y (:y anchor)))) (:mouse-pressed e (dosync (ref-set fix-x (:x-on-screen e)) (ref-set fix-y (:y-on-screen e))) (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*))) (:mouse-released e (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*))) (:mouse-dragged e (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*)))) (size [layer] (size content))))))