cgit.sxemacs.org Git - packages/blob - xemacs-packages/xlib/lisp/xlib-hello.el

   1 ;;; xlib-hello.el --- Hello world example using new xlib.
   2
   3 ;; Copyright (C) 2003-2005 by XWEM Org.
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.ai.mit.edu>
   6 ;; Modified: Zajcev Evgeny <zevlg@yandex.ru>
   7 ;; Keywords: xlib
   8 ;; X-CVS: $Id: xlib-hello.el,v 1.8 2005-04-04 19:55:28 lg Exp $
   9
  10 ;; This file is part of XWEM.
  11
  12 ;; XWEM is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; XWEM is distributed in the hope that it will be useful, but WITHOUT
  18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  19 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  20 ;; License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  25 ;; 02111-1307, USA.
  26
  27 ;;; Synched up with: Not in FSF
  28
  29 ;;; Commentary:
  30
  31 ;; This program very close to first hello program that Eric Ludlam
  32 ;; wrote at least arcs, text and lines drawing did not changed, only
  33 ;; buttons added.
  34
  35 ;; Many hard codes, do not use as real example, this hello world
  36 ;; application needed only to show that xlib works, not as
  37 ;; recommendation how to write applications that uses xlib.
  38
  39 ;;; Code:
  40 \f
  41 (require 'xlib-xpm)
  42
  43 (defconst XH-event-mask
  44   (Xmask-or XM-Exposure XM-StructureNotify XM-KeyPress XM-KeyRelease
  45             XM-ButtonPress XM-ButtonRelease))
  46
  47 (defvar XH-gc-1 nil)
  48 (defvar XH-gc-2 nil)
  49 (defvar XH-win nil)
  50
  51 (defvar XH-buttons nil "List of buttons.")
  52 (defvar XH-close-buttons nil "List of buttons to dismiss.")
  53
  54 (defun XX-Hello (dname)
  55   (interactive "sDisplay: ")
  56
  57   (let ((xdpy (XOpenDisplay dname)))
  58     (if (not (X-Dpy-p xdpy))
  59         (message "Can't open display '%s'" dname)
  60
  61       (setf (X-Dpy-log-buffer xdpy) "Xlog")
  62       (let ((w (XCreateWindow xdpy nil 20 20 100 100 4 nil nil nil
  63                               (make-X-Attr :override-redirect t
  64                                            :background-pixel (XWhitePixel xdpy)
  65                                            :border-pixel (XBlackPixel xdpy)
  66                                            :event-mask XH-event-mask)))
  67             (cmap (XDefaultColormap xdpy))
  68             (co (make-X-Color :dpy xdpy)))
  69         (if (not (X-Win-p w))
  70             (progn
  71               (message "Can't create window.")
  72               (XBell xdpy 100))
  73
  74           (XAllocNamedColor xdpy cmap "Red" co)
  75           (setq XH-gc-1 (XCreateGC xdpy w (make-X-Gc :dpy xdpy
  76                                                      :id (X-Dpy-get-id xdpy)
  77                                                      :foreground co
  78                                                      :background (XWhitePixel xdpy)
  79                                                      :line-style X-LineSolid
  80                                                      :line-width 1)))
  81           (XAllocNamedColor xdpy cmap "Green" co)
  82           (setq XH-gc-2 (XCreateGC xdpy w (make-X-Gc :dpy xdpy
  83                                                      :id (X-Dpy-get-id xdpy)
  84                                                      :foreground co
  85                                                      :background (XWhitePixel xdpy)
  86                                                      :line-style X-LineDoubleDash
  87                                                      :line-width 2)))
  88
  89           ;; Setup events handling
  90           (X-Win-EventHandler-add w 'XH-events-handler)
  91
  92           (XMapWindow xdpy w)
  93           (setq XH-win w))))))
  94
  95 (defun XH-button-press (xdpy win xev)
  96   "Button press event."
  97   (let ((x (X-Event-xbutton-event-x xev))
  98         (y (X-Event-xbutton-event-y xev)))
  99     (cond ((and (>= x 20)
 100                 (<= x (+ 20 (X-Image-width (nth 1 XH-buttons))))
 101                 (>= y 20)
 102                 (<= y (+ 20 (X-Image-height (nth 1 XH-buttons)))))
 103            (XH-show-button xdpy win 20 20 1)
 104            (message "Hellow world!"))
 105
 106           ((and (>= x 20)
 107                 (<= x (+ 20 (X-Image-width (nth 1 XH-close-buttons))))
 108                 (>= y 60)
 109                 (<= y (+ 60 (X-Image-height (nth 1 XH-close-buttons)))))
 110
 111            (XH-show-close-button xdpy win 20 60 1)
 112            (message "XH: Exiting  ..")
 113            (XSelectInput xdpy win 0)
 114            (XDestroyWindow xdpy win))
 115           )
 116     ))
 117
 118 (defun XH-button-release (xdpy win xev)
 119   "Button release event."
 120   (XH-show-button xdpy win 20 20 0))
 121
 122 (defun XH-expose (xdpy w xev)
 123   "Expose."
 124   (XDrawLine xdpy w XH-gc-2 5 5 100 50)
 125   (XDrawPoint xdpy w XH-gc-1 20 5)
 126   (XFillRectangle xdpy w XH-gc-2 2 38 38 15)
 127   (XDrawRectangle xdpy w XH-gc-1 2 38 38 15)
 128   (XDrawString xdpy w XH-gc-1 5 50 "HELLO!")
 129   (XDrawSegments xdpy w XH-gc-2 (list (cons '(100 . 0) '(50 . 10))
 130                                       (cons '(100 . 100) '(50 . 90))))
 131   (XDrawArc xdpy w XH-gc-1 50 50 20 20 0 360)
 132   (XFillArc xdpy w XH-gc-2 55 55 10 10 0 360)
 133
 134   ;; Show 'Press me' button
 135   (XH-show-button xdpy w 20 20 0)
 136
 137   ;; Show 'Dismiss' button
 138   (XH-show-close-button xdpy w 20 60 0)
 139   )
 140
 141 (defun XH-events-handler (xdpy w xev)
 142   "X hello events dispatcher."
 143   (X-Event-CASE xev
 144     (:X-Expose
 145      (message "XH got Exposure event ..")
 146      (XH-expose xdpy w xev))
 147
 148     (:X-KeyPress
 149      (message "XH got KeyPress event .."))
 150
 151     (:X-KeyRelease
 152      (message "XH got KeyRelease event .."))
 153
 154     (:X-ButtonPress
 155      (message "XH got ButtonPress event ..")
 156      (XH-button-press xdpy w xev))
 157
 158     (:X-ButtonRelease
 159      (message "XH got ButtonRelease event ..")
 160      (XH-button-release xdpy w xev))
 161
 162     (:X-DestroyNotify
 163      (XCloseDisplay xdpy)
 164      (setq XH-win nil
 165            XH-buttons nil
 166            XH-close-buttons nil))
 167
 168     (t (message "XH Got event: %d" (X-Event-type xev)))))
 169
 170 (defun XH-show-button (dpy win x y &optional state)
 171   "Show 'Press Me' button."
 172   (unless XH-buttons
 173     ;; Fill
 174     (require 'xpm-button)
 175     (let ((buts (xpm-button-create "Press Me" 2 "green4" "#a0d0a0")))
 176       (setq XH-buttons
 177             (mapcar (lambda (but)
 178                       (X:xpm-img-from-data dpy (aref but 2)))
 179                     buts))))
 180
 181   (unless state
 182     (setq state 0))
 183
 184   (XImagePut dpy (XDefaultGC dpy) win x y (nth state XH-buttons)))
 185
 186 (defun XH-show-close-button (dpy win x y &optional state)
 187   "Show 'Dismiss' button."
 188   (unless XH-close-buttons
 189     (require 'xpm-button)
 190     (let ((buts (xpm-button-create "Dismiss" 4 "Red4" "gray80")))
 191       (setq XH-close-buttons
 192             (mapcar (lambda (but)
 193                       (X:xpm-img-from-data dpy (aref but 2)))
 194                     buts))))
 195
 196   (unless state
 197     (setq state 0))
 198
 199   (XImagePut dpy (XDefaultGC dpy) win x y (nth state XH-close-buttons)))
 200
 201 \f
 202 (provide 'xlib-hello)
 203
 204 ;;; xlib-hello.el ends here