;;; -*- lexical-binding: t; -*- ( defface wc-background-face ' (( t ( :background "#282c34" ))) "Background face" ) ( defface wc-flake-face ' (( t ( :inherit wc-background-face :foreground "white" ))) "Flake face." ) ( defvar wc-flake ?❄ "Flake char." ) ( defvar wc-background ?\s "Background char." ) ( defvar wc-speed 0.1 "Speed of flakes falling down." ) ( defvar wc--flake-alist nil "Column/row coordinates of flakes." ) ( defvar wc--width 0 "Available witdh." ) ( defvar wc--height 0 "Available height." ) ( defun wc--clear ( x y ) "Clear position X/Y." ( wc--draw x y wc-background 'wc-background-face )) ( defun wc--update-flake ( column ) "Update flake position for COLUMN." ( let (( item ( assq column wc--flake-alist ))) ;; clear old pos ( wc--clear ( car item ) ( cdr item )) ;; reset flake to start or advance ( setf ( cdr item ) ( if ( = ( cdr item ) wc--height ) 1 ( 1+ ( cdr item )))) ( wc--draw ( car item ) ( cdr item ) wc-flake 'wc-flake-face ))) ( defun wc--draw ( x y char face ) "Draw CHAR at position X/Y." ( goto-char ( + x ( * ( 1- y ) ( 1+ wc--width )))) ( when ( memq ( char-after ) ( list wc-flake wc-background )) ( delete-char 1 ) ( insert ( propertize ( char-to-string char ) 'face face )) ( goto-char ( point-min )))) ( defun wc--setup ( buffer ) "Setup BUFFER for `white-christmas' ." ( with-current-buffer buffer ( erase-buffer ) ( buffer-disable-undo ) ( setq wc--flake-alist nil ) ( setq cursor-type nil ) ( setq wc--width ( 1- ( window-body-width ))) ( setq wc--height ( window-body-height )) ( dotimes ( _i wc--height ) ( dotimes ( _j wc--width ) ( insert ( propertize ( char-to-string wc-background ) 'face 'wc-background-face ))) ( newline )) ( wc--insert-greeting ) ( current-buffer ))) ( defun wc--insert-greeting () ( let (( str "MERRY CHRISTMAS!" )) ( goto-line ( / wc--height 2 )) ( move-to-column ( - ( / wc--width 2 ) ( / ( length str ) 2 ))) ( delete-char ( length str )) ( insert ( propertize str 'face 'wc-flake-face )))) ( defun white-christmas () "Let it snow." ( interactive ) ( pop-to-buffer-same-window ( wc--setup ( get-buffer-create "*white-christmas*" ))) ( message "Press any key to quit." ) ( let ( col ) ( while ( not ( input-pending-p )) ( setq col ( 1+ ( random wc--width ))) ( unless ( assq col wc--flake-alist ) ( wc--draw col 1 wc-flake 'wc-flake-face ) ( push ( cons col 1 ) wc--flake-alist )) ( dolist ( c->r wc--flake-alist ) ( wc--update-flake ( car c->r ))) ( sit-for wc-speed )) ( discard-input )))