;;;
;;; This file if part of riverguile, the scheme powered scripting layer for
;;; the river Wayland desktop.
;;;
;;; Copyright (C) 2024 Leon Henrik Plickat <leonhenrik.plickat@stud.uni-goettingen.de>
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License version 3 as published by the Free Software Foundation.
;;;
;;; This library 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
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this library; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

;; This module provides helper macros and procedures for riverguile and will not
;; be useful in any other context. The contents of this module are documented
;; in the riverguile.1 manual page.

(define-module (riverguile)
   #:export (R
             R:input
             R:map
             R:keyboard-group))

(define (stringify x)
  (cond ((string? x) x)
        ((number? x) (number->string x))
        ((symbol? x) (symbol->string x))))

(define-syntax R
  (syntax-rules ()
    ((R arg ...)
     (apply riverctl
            (map stringify `(arg ...))))))

(define-syntax R:map
  (syntax-rules ()
    ((R:map mode (mod key cmd ...) ...)
     (for-each (lambda (args)
                 (apply riverctl
                        (map stringify
                             (append `(map mode) args))))
               `((mod key cmd ...) ...)))))

(define-syntax R:input
  (syntax-rules ()
    ((R:input name (val var ...) ...)
     (for-each (lambda (args)
                 (apply riverctl
                        (map stringify
                             (append `(input name) args))))
               `((val var ...) ...)))))

(define-syntax R:keyboard-group
  (syntax-rules ()
    ((R:keyboard-group name . devices)
     (let ((N (stringify 'name))
           (D (map stringify 'devices)))
       (riverctl "keyboard-group-create" N)
       (for-each (lambda (d)
                   (riverctl "keyboard-group-add" N d))
                 D)))))