

(defvar AJAXCEPLAY-BG-MODE 0)
(defvar AJAXCEPLAY-OSD-ONLY-MODE 1)
(defvar AJAXCEPLAY-FULL-MOVIE-MODE 2)
(defvar AJAXCEPLAY-FULL-PICTURE-MODE 3)
(defvar AJAXCEPLAY-PIP-MOVIE-MODE 4)
(defvar AJAXCEPLAY-PIP-PICTURE-MODE 5)
(defvar AJAXCEPLAY-PIP-EXVIDEO-MODE 6)
(defvar wing-key-hook-func #'ajaxceplay-fg-key)
(defvar wing-touchpad-hook-func #'default-touch-hook)
(defvar wing-touchpen-hook-func #'default-touch-hook)

(defun ajaxceplay-fg-key (key on-off)
(if (eq on-off 'key-release)
(progn
(if (eq (symbol-type key) nil)
(write-back-bytes 1 4 key)
(write-back-bytes 1 4 (symbol-value key)))
nil)
(progn
(write-back-bytes 0 4 (symbol-value key))
nil
)
))

(defun ajaxceplay-tpm-fg-key (key on-off)
(if (eq on-off 'key-release)
(progn
(write-back-bytes 1 4 (symbol-value key))
nil)
(progn
(case key
((TXK_VOLUP TXK_VOLDOWN TXK_MUTE TXK_OFFTIMER)
nil)
(otherwise
(write-back-bytes 0 4 (symbol-value key))
nil)))))

(defun ajaxceplay-sk-fg-key (key on-off)
(if (eq on-off 'key-release)
(progn
(if (eq (symbol-type key) nil)
(write-back-bytes 1 4 key)
(write-back-bytes 1 4 (symbol-value key)))
nil)
(progn
(case key
((TXK_POWER TXK_MUTE TXK_VOLUP TXK_VOLDOWN
TXK_NETFLIX
FXK_VOLUP FXK_VOLDOWN)
nil)
((TXK_CANCEL)
(write-back-bytes 0 4 (symbol-value key))
nil)
((TXK_LEFT TXK_RIGHT TXK_UP TXK_DOWN
TXK_ENTER TXK_RETURN)
(write-back-bytes 0 4 (symbol-value key))
t)
(otherwise
t)))))

(defun ajaxceplay-task-bar-fg-key (key on-off)
(if (eq on-off 'key-release)
(progn
(if (eq (symbol-type key) nil)
(write-back-bytes 1 4 key)
(write-back-bytes 1 4 (symbol-value key)))
nil)
(progn
(case key
((TXK_LEFT TXK_RIGHT TXK_UP TXK_DOWN
TXK_BLUE TXK_RED TXK_GREEN TXK_YELLOW
TXK_ENTER TXK_RETURN TXK_VTOOLS)
(write-back-bytes 0 4 (symbol-value key))
nil)
(otherwise
(write-back-bytes 0 4 (symbol-value key))
nil)))))

(defun ajaxceplay-uraepg-fg-key (key on-off)
(if (eq on-off 'key-release)
(progn
(if (eq (symbol-type key) nil)
(write-back-bytes 1 4 key)
(write-back-bytes 1 4 (symbol-value key)))
nil)
(progn
(write-back-bytes 0 4 (symbol-value key))
(case key
((TXK_USEFUL_FUNC TXK_NET_TD TXK_NET_BS TXK_NET_CS TXK_UP TXK_DOWN
TXK_LEFT TXK_RIGHT TXK_BLUE TXK_RED TXK_YELLOW TXK_GREEN TXK_INFO
TXK_RETURN TXK_ENTER TXK_CHG_LR TXK_R_SCREEN TXK_STOP TXK_SUBMENU)
t)
(otherwise nil)
)
)))

(defun ajaxceplay-zapping-multi-fg-key (key on-off)
(if (eq on-off 'key-release)
(progn
(if (eq (symbol-type key) nil)
(write-back-bytes 1 4 key)
(write-back-bytes 1 4 (symbol-value key)))
nil)
(progn
(write-back-bytes 0 4 (symbol-value key))
(case key
((TXK_USEFUL_FUNC TXK_UP TXK_DOWN
TXK_LEFT TXK_RIGHT TXK_BLUE TXK_RED TXK_YELLOW TXK_GREEN TXK_INFO
TXK_RETURN TXK_ENTER TXK_CHG_LR TXK_R_SCREEN TXK_STOP TXK_SUBMENU)
t)
(otherwise nil)
)
)))

(defun ajaxceplay-uraepg-hikari-fg-key (key on-off)
(if (eq on-off 'key-release)
(progn
(if (eq (symbol-type key) nil)
(write-back-bytes 1 4 key)
(write-back-bytes 1 4 (symbol-value key)))
nil)
(progn
(write-back-bytes 0 4 (symbol-value key))
(case key
((TXK_USEFUL_FUNC TXK_UP TXK_DOWN
TXK_LEFT TXK_RIGHT TXK_BLUE TXK_RED TXK_YELLOW TXK_GREEN TXK_RECALL
TXK_RETURN TXK_ENTER TXK_CHG_LR TXK_R_SCREEN TXK_STOP TXK_SUBMENU)
t)
(otherwise nil)
)
)))

(defun ajaxceplay-luxury-rolling-fg-key (key on-off)
(if (eq on-off 'key-release)
(progn
(if (eq (symbol-type key) nil)
(write-back-bytes 1 4 key)
(write-back-bytes 1 4 (symbol-value key)))
nil)
(progn
(write-back-bytes 0 4 (symbol-value key))
(case key
((TXK_USEFUL_FUNC TXK_NET_TD TXK_NET_BS TXK_NET_CS TXK_UP TXK_DOWN
TXK_LEFT TXK_RIGHT TXK_BLUE TXK_RED TXK_YELLOW TXK_GREEN TXK_RECALL
TXK_RETURN TXK_ENTER TXK_CHG_LR TXK_R_SCREEN TXK_STOP TXK_SUBMENU)
t)
(otherwise nil)
)
)))

(defun wing-set-emanual-id (onoff id)
(if onoff
(set-force-emanual-id dsp-ajaxceplay 1 id)
(set-force-emanual-id dsp-ajaxceplay 0 id)))

(defun wing-set-key-hook (l-type)
(case l-type
((0)
(setf wing-key-hook-func #'ajaxceplay-fg-key))
((1)
(setf wing-key-hook-func #'ajaxceplay-sk-fg-key))
((2)
(setf wing-key-hook-func #'ajaxceplay-tpm-fg-key))
((3)
(setf wing-key-hook-func #'ajaxceplay-task-bar-fg-key))
((4)
(setf wing-key-hook-func #'ajaxceplay-uraepg-fg-key))
((5)
(setf wing-key-hook-func #'ajaxceplay-uraepg-hikari-fg-key))
((6)
(setf wing-key-hook-func #'ajaxceplay-luxury-rolling-fg-key)
(wing-set-touchpad-hook 1)
)
((7)
(setf wing-key-hook-func #'ajaxceplay-zapping-multi-fg-key))
(otherwise
(setf wing-key-hook-func #'ajaxceplay-fg-key))
)
(set-frame-key-hook 'dsp-ajaxceplay wing-key-hook-func)

)

(defun wing-set-task-bar-hook (l-type)
(wing-set-key-hook 3))

(defun ajaxceplay-set-bg-mode ()
(set-screen-mode AJAXCEPLAY-BG-MODE)
(unmap-frame 'dsp-ajaxceplay))

(defun ajaxceplay-set-fg-mode ()
(set-screen-mode AJAXCEPLAY-BG-MODE)
(map-frame 'dsp-ajaxceplay))

(defun set-screen-mode (val)
)

(defun ajaxceplay-ontop (f)
nil
)
(defun ajaxceplay-offtop (f)
nil
)

(defun dsp-ajaxceplay-set-kbd (key on-off)
(let* ((l-key (m-default-kbd2rem-key key)))
(when l-key
(setf key l-key)
(funcall wing-key-hook-func key on-off))))

(defun my-touch-hook (type x y)
(let* ((fp_x (first (get-free-point-xy)))
(fp_y (second (get-free-point-xy))))
(if (eq type 'touch-press)
(write-back-bytes 2 16 x y fp_x fp_y))
(if (eq type 'touch-release)
(write-back-bytes 3 16 x y fp_x fp_y))
(if (eq type 'touch-move)
(write-back-bytes 4 16 x y fp_x fp_y))
(if (eq type 'touch-button-press)
(write-back-bytes 5 16 x y fp_x fp_y))
(if (eq type 'touch-button-release)
(write-back-bytes 6 16 x y fp_x fp_y))
(if (eq type 'touch-motion)
(write-back-bytes 7 16 x y fp_x fp_y))
(if (eq type 'touch-gesture-flick)
(write-back-bytes 8 16 x y fp_x fp_y))
(if (eq type 'touch-gesture-tap)
(write-back-bytes 9 16 x y fp_x fp_y))
(if (eq type 'touch-gesture-wheel)
(write-back-bytes 10 16 x y fp_x fp_y))
(if (eq type 'touch-button-changed)
(write-back-bytes 11 16 x y 0 0))
)
t
)

(defun my-touchpen-hook (type x y devid)
(let* ((fp_x (first (get-free-point-xy)))
(fp_y (second (get-free-point-xy))))
(if (eq type 'touch-press)
(write-back-bytes 12 20 x y fp_x fp_y devid))
(if (eq type 'touch-release)
(write-back-bytes 13 20 x y fp_x fp_y devid))
(if (eq type 'touch-move)
(write-back-bytes 14 20 x y fp_x fp_y devid))
)
t
)

(defun default-touch-hook (type x y)
nil)

(defun wing-set-touchpad-hook (l-type)
(case l-type
((0)
(setf wing-touchpad-hook-func #'default-touch-hook))
((1)
(setf wing-touchpad-hook-func #'my-touch-hook))
((2)
(setf wing-touchpad-hook-func nil))
(otherwise
(setf wing-touchpad-hook-func #'default-touch-hook)))
(set-frame-touchpad-hook 'dsp-ajaxceplay wing-touchpad-hook-func))

(defun wing-set-touchpen-hook (l-type)
(case l-type
((0)
(setf wing-touchpen-hook-func #'default-touch-hook))
((1)
(setf wing-touchpen-hook-func #'my-touchpen-hook))
((2)
(setf wing-touchpen-hook-func nil))
(otherwise
(setf wing-touchpen-hook-func #'default-touch-hook)))
(set-frame-touchpen-hook 'dsp-ajaxceplay wing-touchpen-hook-func))

(defun wing-make-frame (prio)
(register-frame2 'dsp-ajaxceplay
"/usr/local/glisp/wing/dsp-wing.lsp"
LOCAL_OSD
prio
#'ajaxceplay-ontop
#'ajaxceplay-offtop
#'ajaxceplay-fg-key
nil
nil)

(load "/usr/local/glisp/server/m-frame-common.lsp")
(set-frame-keyboard-hook 'dsp-ajaxceplay #'dsp-ajaxceplay-set-kbd)
(set-frame-draw-signal 'dsp-ajaxceplay DSIG_BIP_FRAME_TYPE_IGNOR)
(set-frame-independent-on-off-top 'dsp-ajaxceplay t)
)
