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