mirror of
https://github.com/unclebob/more-speech.git
synced 2024-09-30 02:21:02 +00:00
Polymorphically isolate quil.
This commit is contained in:
parent
25b645849d
commit
0ce8dae44e
@ -1,13 +1,13 @@
|
||||
(ns more-speech.ui.application
|
||||
(:require [quil.core :as q]
|
||||
[more-speech.ui.text :as text]
|
||||
(:require [more-speech.ui.text :as text]
|
||||
[more-speech.ui.widget :refer [widget
|
||||
draw-widget
|
||||
draw-child-widgets]]
|
||||
[more-speech.ui.article-window :refer [map->article-window
|
||||
draw-article-window]]
|
||||
[more-speech.ui.author-window :refer [map->author-window
|
||||
draw-author-window]]))
|
||||
draw-author-window]]
|
||||
[more-speech.ui.graphics :as g]))
|
||||
|
||||
(defrecord application [widgets]
|
||||
widget
|
||||
@ -15,8 +15,6 @@
|
||||
(update-widget [widget state])
|
||||
|
||||
(draw-widget [application state]
|
||||
;(draw-widget (:article-window application) state)
|
||||
;(draw-widget (:author-window application) state)
|
||||
(draw-child-widgets application state)
|
||||
)
|
||||
|
||||
@ -25,19 +23,21 @@
|
||||
)
|
||||
|
||||
(defn make-application [bold regular]
|
||||
(map->application
|
||||
{:articles []
|
||||
:nicknames {}
|
||||
(let [g (g/->quil-graphics)]
|
||||
(map->application
|
||||
{:graphics g
|
||||
:articles []
|
||||
:nicknames {}
|
||||
|
||||
:article-window (map->article-window
|
||||
{:x 50 :y 10 :w (text/pos-width 105) :h (- (q/screen-height) 100)
|
||||
:fonts {:bold bold :regular regular}
|
||||
})
|
||||
:article-window (map->article-window
|
||||
{:x 50 :y 10 :w (text/pos-width 105) :h (- (g/screen-height g) 100)
|
||||
:fonts {:bold bold :regular regular}
|
||||
})
|
||||
|
||||
:author-window (map->author-window
|
||||
{:x (+ 50 (text/pos-width 110)) :y 10
|
||||
:w (text/pos-width 30) :h (- (q/screen-height) 100)
|
||||
:fonts {:bold bold :regular regular}})
|
||||
:widgets [:article-window :author-window]
|
||||
}
|
||||
))
|
||||
:author-window (map->author-window
|
||||
{:x (+ 50 (text/pos-width 110)) :y 10
|
||||
:w (text/pos-width 30) :h (- (g/screen-height g) 100)
|
||||
:fonts {:bold bold :regular regular}})
|
||||
:widgets [:article-window :author-window]
|
||||
}
|
||||
)))
|
||||
|
@ -1,9 +1,9 @@
|
||||
(ns more-speech.ui.article-window
|
||||
(:require
|
||||
[quil.core :as q]
|
||||
[more-speech.ui.text :as text]
|
||||
[more-speech.article :as a]
|
||||
[more-speech.ui.widget :refer [widget]]))
|
||||
[more-speech.ui.widget :refer [widget]]
|
||||
[more-speech.ui.graphics :as g]))
|
||||
|
||||
(declare draw-article-window)
|
||||
|
||||
@ -17,26 +17,28 @@
|
||||
(mouse-down [widget state position])
|
||||
)
|
||||
|
||||
(defn draw-article [window cursor article]
|
||||
(q/text-align :left)
|
||||
(q/fill 0 0 0)
|
||||
(defn draw-article [g window cursor article]
|
||||
(g/text-align g [:left])
|
||||
(g/fill g [0 0 0])
|
||||
(text/render cursor window (a/markup-article article))
|
||||
)
|
||||
|
||||
(defn draw-articles [application {:keys [fonts] :as window}]
|
||||
(defn draw-articles [g application {:keys [fonts] :as window}]
|
||||
(loop [cursor (text/->cursor 0 (text/line-height) 5)
|
||||
articles (take 20 (:articles application))]
|
||||
(if (empty? articles)
|
||||
cursor
|
||||
(recur (draw-article window cursor (first articles))
|
||||
(recur (draw-article g window cursor (first articles))
|
||||
(rest articles)))))
|
||||
|
||||
(defn draw-article-window [application window]
|
||||
(q/with-translation
|
||||
[(:x window) (:y window)]
|
||||
(q/stroke 0 0 0)
|
||||
(q/stroke-weight 2)
|
||||
(q/fill 255 255 255)
|
||||
(q/rect 0 0 (:w window) (:h window))
|
||||
(draw-articles application window)
|
||||
))
|
||||
(let [g (:graphics application)]
|
||||
(g/with-translation
|
||||
g [(:x window) (:y window)]
|
||||
(fn [g]
|
||||
(g/stroke g [0 0 0])
|
||||
(g/stroke-weight g 2)
|
||||
(g/fill g [255 255 255])
|
||||
(g/rect g [0 0 (:w window) (:h window)])
|
||||
(draw-articles g application window))
|
||||
)))
|
||||
|
@ -1,10 +1,10 @@
|
||||
(ns more-speech.ui.author-window
|
||||
(:require
|
||||
[quil.core :as q]
|
||||
[clojure.string :as string]
|
||||
[more-speech.ui.widget :refer [widget]]
|
||||
[more-speech.ui.text :as text]
|
||||
[more-speech.article :as a]))
|
||||
[more-speech.article :as a]
|
||||
[more-speech.ui.graphics :as g]))
|
||||
|
||||
(declare draw-author-window)
|
||||
|
||||
@ -18,28 +18,28 @@
|
||||
(mouse-down [widget state position])
|
||||
)
|
||||
|
||||
(defn draw-author [window cursor author]
|
||||
(q/text-align :left)
|
||||
(q/fill 0 0 0)
|
||||
(defn draw-author [g window cursor author]
|
||||
(g/text-align g [:left])
|
||||
(g/text-color g [0 0 0])
|
||||
(text/render cursor window (a/markup-author author)))
|
||||
|
||||
(defn draw-authors [application window]
|
||||
(q/text-align :left)
|
||||
(q/fill 0 0 0)
|
||||
(defn draw-authors [g application window]
|
||||
(g/text-align g [:left])
|
||||
(g/text-color g [0 0 0])
|
||||
(loop [cursor (text/->cursor 0 (text/line-height) 5)
|
||||
authors (take-last 60 (sort-by #(string/lower-case (text/nil->blank (second %))) (:nicknames application)))]
|
||||
(if (empty? authors)
|
||||
cursor
|
||||
(recur (draw-author window cursor (first authors))
|
||||
(recur (draw-author g window cursor (first authors))
|
||||
(rest authors))))
|
||||
)
|
||||
|
||||
(defn draw-author-window [application window]
|
||||
(q/with-translation
|
||||
[(:x window) (:y window)]
|
||||
(q/stroke 0 0 0)
|
||||
(q/stroke-weight 2)
|
||||
(q/fill 255 255 255)
|
||||
(q/rect 0 0 (:w window) (:h window))
|
||||
(draw-authors application window)
|
||||
))
|
||||
(let [g (:graphics application)]
|
||||
(g/with-translation
|
||||
g [(:x window) (:y window)]
|
||||
(fn [g] (g/stroke g [0 0 0])
|
||||
(g/stroke-weight g 2)
|
||||
(g/fill g [255 255 255])
|
||||
(g/rect g [0 0 (:w window) (:h window)])
|
||||
(draw-authors g application window)))))
|
38
src/more_speech/ui/graphics.clj
Normal file
38
src/more_speech/ui/graphics.clj
Normal file
@ -0,0 +1,38 @@
|
||||
(ns more-speech.ui.graphics
|
||||
(:require
|
||||
[quil.core :as q]
|
||||
))
|
||||
|
||||
(defprotocol graphics
|
||||
(screen-height [graphics])
|
||||
(screen-width [graphics])
|
||||
(text-align [graphics alignment])
|
||||
(text-color [graphics color])
|
||||
(stroke [graphics color])
|
||||
(stroke-weight [graphics weight])
|
||||
(fill [graphics color])
|
||||
(rect [graphics rect])
|
||||
(with-translation [graphics translation f])
|
||||
)
|
||||
|
||||
(defrecord quil-graphics []
|
||||
graphics
|
||||
(screen-height [graphics]
|
||||
(q/screen-height))
|
||||
(screen-width [graphics]
|
||||
(q/screen-width))
|
||||
(text-align [graphics alignment]
|
||||
(apply q/text-align alignment))
|
||||
(text-color [graphics color]
|
||||
(apply q/fill color))
|
||||
(stroke [graphics color]
|
||||
(apply q/stroke color))
|
||||
(stroke-weight [graphics weight]
|
||||
(q/stroke-weight weight))
|
||||
(fill [graphics color]
|
||||
(apply q/fill color))
|
||||
(rect [graphics rect]
|
||||
(apply q/rect rect))
|
||||
(with-translation [graphics translation f]
|
||||
(q/with-translation translation (f graphics)))
|
||||
)
|
Loading…
Reference in New Issue
Block a user