This repository has been archived by the owner on Aug 9, 2019. It is now read-only.
/
context.clj
110 lines (102 loc) · 4.65 KB
/
context.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
(ns L5.context
(:require [L5.slide :as slide])
(:import [java.awt Dimension]
[java.awt.event KeyListener KeyEvent ComponentListener]
[javax.swing JPanel JFrame]))
(defn map-set! [obj-map key val]
(dosync (ref-set (get obj-map key) val)))
(def default
{:width 640
:height 480
:padding {:top 20, :right 20, :bottom 20, :left 20}
:font-family "VL Gothic"
:font-size 20})
(defn dispatch-event [context keyCode]
(let [actions (get @(:actions context) keyCode)]
(when (not (empty? actions))
(doseq [act actions] (act)))))
(defn build-context [raw-context-params & slides]
(let [params (merge default raw-context-params)
context {:raw-context-params raw-context-params
:g (ref nil)
:frame (ref nil)
:slides (ref (or slides []))
:background-image (:background-image params)
:color (:color params)
:background-color (:background-color params)
:current (ref (or (:current params) 0))
:width (:width params)
:height (:height params)
:global-padding (or (:global-padding params) (:padding params))
:padding {:top 0, :right 0, :bottom 0, :left 0}
:font-size (:font-size params)
:font-family (:font-family params)
:actions (ref nil)}]
(dosync (ref-set (:actions context)
{ KeyEvent/VK_F5 [#(slide/toggle-fullscreen context)]
KeyEvent/VK_ESCAPE [#(slide/fullscreen-off context)]
KeyEvent/VK_BACK_SPACE [#(slide/prev-slide context)]
KeyEvent/VK_LEFT [#(slide/prev-slide context)]
KeyEvent/VK_ENTER [#(slide/next-slide context)]
KeyEvent/VK_SPACE [#(slide/next-slide context)]
KeyEvent/VK_RIGHT [#(slide/next-slide context)] }))
context))
(defn build-panel [context]
(let [zoom (ref 1.0)
x (ref 0)
y (ref 0)
panel
(proxy [JPanel KeyListener ComponentListener] []
(getPreferredSize []
(Dimension.
(* @zoom (:width context))
(* @zoom (:height context))))
(paintComponent [g]
(when (:g context)
(proxy-super paintComponent g)
(let [img (:background-image context)]
(when img
(let [scale-width (/ (.getWidth this) (.getWidth img))
scale-height (/ (.getHeight this) (.getHeight img))
scale (max scale-width scale-height)]
; TODO: refactoring
(.drawImage g img 0 0 (* scale (.getWidth img)) (* scale (.getHeight img)) nil))))
(.scale g @zoom @zoom)
(.translate g @x @y)
(map-set! context :g g)
(slide/current-slide context)))
(keyPressed [e] (dispatch-event context (.getKeyCode e)))
(keyReleased [e])
(keyTyped [e])
(componentResized [e]
(let [width (.getWidth this)
height (.getHeight this)
scale (min (double (/ width (:width context)))
(double (/ height (:height context))))
width-diff (- width (* scale (:width context)))
height-diff (- height (* scale (:height context)))]
(dosync
(ref-set zoom scale)
(ref-set x (/ width-diff 2 scale))
(ref-set y (/ height-diff 2 scale))))))]
(doto panel
(.setFocusable true)
(.setForeground (:color context))
(.setBackground (:background-color context))
(.addKeyListener panel)
(.addComponentListener panel))))
(defn build-frame [panel]
(doto (JFrame. "L5: Presentation with Clojure")
(.add panel)
(.pack)
(.setDefaultCloseOperation JFrame/EXIT_ON_CLOSE)))
(defn make-context [params]
(let [context (build-context params)
frame (-> context build-panel build-frame)]
(map-set! context :frame frame)
context))
(defn start [context]
(doto @(:frame context)
(.repaint)
(.setVisible true))
(slide/print-info context))