Polymorphically isolate quil.

This commit is contained in:
Robert C. Martin 2022-01-21 15:58:46 -06:00
parent 25b645849d
commit 0ce8dae44e
4 changed files with 91 additions and 51 deletions

View File

@ -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]
}
)))

View File

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

View File

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

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