この記事は、Lisp Advent Calendar 2019 の 16 日目の記事です。

この記事の要旨

Hy での GUI プログラミング入門として、Python の標準ライブラリに含まれている GUI ライブラリの tkinter を使用したジェネラティブアートを実装します。

こんな感じの三角関数を使った図形描画で、キー入力によってパラメータを変更できる仕様です。

対象読者

Hy で GUI プログラミングをしてみたい人

環境構築

著者の環境は下記になります。

Windows 10
Python 3.7.2 (64bit)

仮想環境の構築とモジュールのインストール

GUI ライブラリの tkinter は Python 標準ライブラリのため、仮想環境にインストールするサードパーティー製モジュールは Hy のみです。
Hy は、12/10 時点での最新版をインストールしました（ https://github.com/hylang/hy/tree/39c150d8299d9ff8f47bb78415e22a9fe976d7e5 ）。

cd %USERPROFILE$\.virtualenvs
py -3 -m venv venv_hy_geometric_pattern
cd venv_hy_geometric_pattern
Scripts\activate.bat
pip install --upgrade pip
pip install git+https://github.com/hylang/hy.git
deactivate

仕様

tk.Tk() インスタンスとして作成したウインドウの中に Canvas を作成し、そこに図形を描画します。
アニメーションをさせるために、およそ 60 fps で Canvas を再描画します。
ある時刻の点の座標は、下記の式で求めます。$\theta$ を $\mathrm{d} \theta$ ずつ変化させてその時間での点の配列を作成します。

\left\{ \begin{array}{}
x(\theta , t) = x_{\mathrm{center}} + r \cos \theta + a \cos (\phi \left( t \right) + c \theta) \\

y(\theta , t) = y_{\mathrm{center}} + r \sin \theta + a \sin (\phi \left( t \right) + c \theta)
\end{array} \right.

0 \leq \theta < 2 \pi \\
0 \leq \phi < 2 \pi \\
0 \leq c < 2 \pi \\
0 < r + a < \min(x_{\mathrm{center}}, y_{\mathrm{center}}) \\

$\left( x_{\mathrm{center}}, y_{\mathrm{center}} \right)$ は Canvas の中央の座標です。
$\phi$ は時間によって $0 \leq \phi < 2 \pi$ をループするようにします。

キー入力で上記の $r, a, c$ と $\theta$ の刻み幅 $\mathrm{d} \theta$ を変更できるようにします。
キーの割り当ては下表の通りです。
また、q キーでウインドウを閉じて終了するようにも設定します。

変数	減少キー	増加キー
$r$	z	a
$a$	x	s
$c$	c	d
$\mathrm{d} \theta$	v	f

パッケージの構成

hy ディレクトリが PYTHONPATH に追加されているものとします。
__init__.hy の中身は空で、gui.hy に機能を実装していきます。
geometric_pattern.bat から geometric_pattern.gui を呼び出して実行します。

hy ─┬─ geometric_pattern ─┬─ __init__.hy
    │                     │
    │                     └─ gui.hy
    │
    └─ geometric_pattern.bat

実装

gui.hy

(import [math [sin cos radians]])
(import sys)
(import [tkinter :as tk])

; キャンバスサイズ
(setv *width* 800)
(setv *height* 600)


(defclass GeometricPattern []
  (setv *d-theta-max* 20)
  (setv *deg* 360)
  (setv *d-phi* 1)

  (defn --init-- [self &optional [center-x 0] [center-y 0]]
    "パラメータを初期化し、点のリストを取得する"
    (setv (. self center-x) center-x)
    (setv (. self center-y) center-y)

    (setv (. self r)
          (int (-> 0.8
                   (* (min (. self center-x) (. self center-y)))
                   (/ 3))))
    (setv (. self a)
          (int (-> 0.8
                   (* 2 (min (. self center-x) (. self center-y)))
                   (/ 3))))
    (setv (. self phi) 0)
    (setv (. self c) 104)

    ;; theta を変動させるときの刻み幅
    (setv (. self d-theta) 1)

    ((. self fetch-points)))

  (defn dec-r [self event]
    "rを減少する"
    (setv (. self r) (dec (. self r)))
    (if (< (. self r) 1)
        (setv (. self r) 1)))

  (defn inc-r [self event]
    "rを増加する。Canvas の短辺からはみ出さないように上限を指定している"
    (if (< (+ (. self r) (. self a))
           (min (. self center-x) (. self center-y)))
        (setv (. self r) (inc (. self r)))))

  (defn dec-a [self event]
    "aを減少する"
    (setv (. self a) (dec (. self a)))
    (if (< (. self a) 1)
        (setv (. self a) 1)))

  (defn inc-a [self event]
    "aを増加する。Canvas の短辺からはみ出さないように上限を指定している"
    (if (< (+ (. self r) (. self a))
           (min (. self center-x) (. self center-y)))
        (setv (. self a) (inc (. self a)))))

  (defn dec-d-theta [self event]
    (setv (. self d-theta) (dec (. self d-theta)))
    (if (< (. self d-theta) 1)
        (setv (. self d-theta) 1)))

  (defn inc-d-theta [self event]
    (setv (. self d-theta) (inc (. self d-theta)))
    (if (> (. self d-theta) (. GeometricPattern *d-theta-max*))
        (setv (. self d-theta) (. GeometricPattern *d-theta-max*))))

  (defn dec-c [self event]
    (setv (. self c) (dec (. self c)))
    (if (< (. self c) 0)
        (setv (. self c) (% (. self c) (. GeometricPattern *deg*)))))

  (defn inc-c [self event]
    (setv (. self c) (inc (. self c)))
    (if (>= (. self c) (. GeometricPattern *deg*))
        (setv (. self c) (% (. self c) (. GeometricPattern *deg*)))))

  (defn inc-phi [self]
    (setv (. self phi) (inc (. self phi)))
    (setv (. self phi) (% (. self phi) (. GeometricPattern *deg*))))

  (defn fetch-points [self]
    "点の座標を取得する"
    (setv (. self points)
          (lfor theta (range 0 (. GeometricPattern *deg*) (. self d-theta))
                (, (+ (+ (. self center-x) (* (. self r) (cos (radians theta))))
                      (* (. self a) (cos (radians (+ (. self phi) (* (. self c) theta))))))
                   (+ (+ (. self center-y) (* (. self r) (sin (radians theta))))
                      (* (. self a) (sin (radians (+ (. self phi) (* (. self c) theta)))))))))

    ;; パスを閉じるために最初の点をリストの最後に追加する
    ((. self points append) (. self points [0]))))


(defclass Simulator []
  (setv *ms* 16)

  (defn --init-- [self width height]
    (setv (. self width) width)
    (setv (. self height) height)

    ;; ウインドウとキャンバスの初期化
    (setv (. self window) ((. tk Tk)))
    ((. self window title) :string "Sample Trig Function on Tkinter")
    ((. self window resizable) :width False :height False)
    (setv (. self canvas)
          ((. tk Canvas) (. self window)
                         :width (. self width)
                         :height (. self height)))

    (setv (. self center-x) (/ width 2))
    (setv (. self center-y) (/ height 2))

    ;; 表示する文字の座標
    (setv (. self quit-x) 20)
    (setv (. self quit-y) 30)
    (setv (. self r-x) (- width 20))
    (setv (. self r-y) (- height 120))
    (setv (. self a-x) (- width 20))
    (setv (. self a-y) (- height 90))
    (setv (. self c-x) (- width 20))
    (setv (. self c-y) (- height 60))
    (setv (. self d-theta-x) (- width 20))
    (setv (. self d-theta-y) (- height 30))

    (setv (. self gp) (GeometricPattern (. self center-x) (. self center-y)))

    ;; 背景色（黒）でキャンバスを塗りつぶす
    ((. self canvas create-rectangle) 0
                                      0
                                      (. self width)
                                      (. self height)
                                      :fill "black")
    ((. self draw))
    ((. self canvas pack))

    ;; キーバインドの設定
    ((. self window bind) "<KeyPress-q>" (. self quit))
    ((. self window bind) "<KeyPress-z>" (. self gp dec-r))
    ((. self window bind) "<KeyPress-a>" (. self gp inc-r))
    ((. self window bind) "<KeyPress-x>" (. self gp dec-a))
    ((. self window bind) "<KeyPress-s>" (. self gp inc-a))
    ((. self window bind) "<KeyPress-c>" (. self gp dec-c))
    ((. self window bind) "<KeyPress-d>" (. self gp inc-c))
    ((. self window bind) "<KeyPress-v>" (. self gp dec-d-theta))
    ((. self window bind) "<KeyPress-f>" (. self gp inc-d-theta)))

  (defn quit [self event]
    ((. self window destroy)))

  (defn draw [self]

    ;; 図形の描画
    ((. self canvas create-line) (. self gp points) :fill "white" :tag "sample")

    ;; 文字の描画
    ((. self canvas create-text) (. self quit-x)
                                 (. self quit-y)
                                 :text "Quit: q"
                                 :tag "sample"
                                 :font (, "Arial" 12)
                                 :fill "white"
                                 :anchor (. tk W))
    ((. self canvas create-text) (. self r-x)
                                 (. self r-y)
                                 :text ((. "r: Z < {0:03d} > A" format) (. self gp r))
                                 :tag "sample"
                                 :font (, "Arial" 12)
                                 :fill "white"
                                 :anchor (. tk E))
    ((. self canvas create-text) (. self a-x)
                                 (. self a-y)
                                 :text ((. "a: X < {0:03d} > S" format) (. self gp a))
                                 :tag "sample"
                                 :font (, "Arial" 12)
                                 :fill "white"
                                 :anchor (. tk E))
    ((. self canvas create-text) (. self c-x)
                                 (. self c-y)
                                 :text ((. "c: C < {0:03d} > D" format) (. self gp c))
                                 :tag "sample"
                                 :font (, "Arial" 12)
                                 :fill "white"
                                 :anchor (. tk E))
    ((. self canvas create-text) (. self d-theta-x)
                                 (. self d-theta-y)
                                 :text ((. "d-theta: V < {0:03d} > F" format) (. self gp d-theta))
                                 :tag "sample"
                                 :font (, "Arial" 12)
                                 :fill "white"
                                 :anchor (. tk E)))

  (defn delete [self]
    "sampleタグをつけた要素を削除する"
    ((. self canvas delete) "sample"))

  (defn loop [self]
    ;; 一つ前の画面をクリア
    ((. self delete))

    ;; 新しい状態を取得して描画
    ((. self gp inc-phi))
    ((. self gp fetch-points))
    ((. self draw))

    ;; 約16ms後にloopを実行
    ((. self window after) (. Simulator *ms*) (. self loop))))


(defn main []
  (setv simulator (Simulator *width* *height*))
  ((. simulator loop))
  ((. simulator window mainloop))
  0)


(when (= --name-- "__main__")
      ((. sys exit) (main)))

上記 geometric_pattern.gui モジュールを呼び出して実行するためのバッチファイルを作成します。
仮想環境を activate し、hy コマンドと hy モジュールにパスが通った状態にします。
そして、hy コマンドを使って geometric_pattern.gui モジュールを実行します。
-m オプションを付けると、パッケージ内のモジュールをドット区切り表記で指定できます。

geometric_pattern.bat

@ECHO OFF
SETLOCAL

SET THISDIR=%~dp0
SET PYTHONPATH=%THISDIR%;%PYTHONPATH%
SET ACTIVATE=%USERPROFILE%\.virtualenvs\venv_hy_geometric_pattern\Scripts\activate.bat

CALL %ACTIVATE%
hy -m geometric_pattern.gui
SET STATUS=%ERRORLEVEL%
CALL deactivate

IF %STATUS%==0 (
  ECHO Done.
  PAUSE
  EXIT /b 0
) ELSE (
  ECHO Error.
  PAUSE
  EXIT /b 1
)