1
0
Fork 0
tinmop/src/notify-window.lisp

114 lines
4.4 KiB
Common Lisp
Raw Normal View History

2020-09-06 11:32:08 +02:00
;; tinmop: an humble gemini and pleroma client
2020-05-08 15:45:43 +02:00
;; Copyright (C) 2020 cage
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program.
;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
(in-package :notify-window)
(define-constant +notify-win-background-color+ '(:yellow :blue)
:test #'equalp)
;; (define-constant +notify-win-background+ (make-instance 'complex-char
;; :simple-char #\Space
;; :color-pair +notify-win-background-color+
;; :attributes nil)
;; :test #'complex-char=)
2020-05-08 15:45:43 +02:00
(defclass notify-window (wrapper-window)
((life
:initform 10.0
:initarg :life
:accessor life)
(pending
:initform 0
:initarg :pending
:accessor pending)))
(defun notify-window-p (thing)
(typep thing 'notify-window))
(defun notification-terminated-p (notification-window)
(< (life notification-window) 0.0))
(defun notification-alive-p (notification-window)
(not (notification-terminated-p notification-window)))
2020-05-08 15:45:43 +02:00
(defmethod refresh-config :after ((object notify-window))
(refresh-config-colors object swconf:+key-notify-window+))
(defmethod calculate ((object notify-window) dt)
(with-accessors ((life life)) object
(when (notification-terminated-p object)
2020-05-08 15:45:43 +02:00
(let ((remove-win-event (make-instance 'program-events:remove-notify-user-event
:priority program-events:+maximum-event-priority+
:payload object)))
2020-05-08 15:45:43 +02:00
(win-close object)
(program-events:push-event remove-win-event)))
(decf (life object) dt)))
(defmethod draw ((object notify-window))
(declare (ignore object)))
(defgeneric draw-pending (object))
(defmethod draw-pending ((object notify-window))
(with-accessors ((pending pending)) object
(when (and (> pending 0)
(notification-alive-p object))
2020-05-08 15:45:43 +02:00
(print-text object
(format nil (n_ "~a pending"
"~a pending"
pending)
pending)
2
(1- (win-height object))))))
(defun force-error-colors (window)
(with-croatoan-window (croatoan-window window)
(setf (background croatoan-window)
(tui:make-win-background :red))
2020-05-08 15:45:43 +02:00
(setf (bgcolor croatoan-window) :red)
(setf (fgcolor croatoan-window) :yellow))
window)
(defun make-notification-window (message life &key (pending 0) (hidep nil) (notify-error nil))
(let* ((low-level-window (make-croatoan-window :border t))
2020-05-08 15:45:43 +02:00
(high-level-window (make-instance 'notify-window
:life life
:pending pending
:croatoan-window low-level-window)))
(refresh-config high-level-window)
(when notify-error
(force-error-colors high-level-window))
(multiple-value-bind (x y w)
(swconf:config-notify-window-geometry)
(let ((win-w (main-window:parse-subwin-w w))
(win-h (truncate (* 1/8 (win-height *main-window*))))
(win-x (main-window:parse-subwin-w x))
(win-y (main-window:parse-subwin-h y)))
(win-resize high-level-window win-w win-h)
;; add-flush-left-text will expand window's height if needed
(add-flush-left-text high-level-window
message 0
:has-border-p t
:attributes (attribute-bold))
(win-raise-to-top high-level-window)
(win-move high-level-window win-x win-y)
(win-box high-level-window)
(when hidep
(win-hide high-level-window))
(mtree:add-child specials:*main-window* high-level-window)
high-level-window))))