/[cl-cairo2]/xlib.lisp
ViewVC logotype

Diff of /xlib.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 13 by tpapp, Wed Aug 22 16:13:14 2007 UTC revision 15 by tpapp, Thu Dec 20 13:05:07 2007 UTC
# Line 387  the power value." Line 387  the power value."
387    (first-event :int)    (first-event :int)
388    (first-error :int))    (first-error :int))
389    
390    ;; image manipulation
391    
392    (cffi:defcstruct XImage
393            (width :int)
394            (height :int)
395            (xoffset :int)
396            (format :int)
397            (data :pointer)
398            (byte-order :int)
399            (bitmap-unit :int)
400            (bitmap-bit-order :int)
401            (bitmap-pad :int)
402            (depth :int)
403            (bytes-per-line :int)
404            (bits-per-pixel :int)
405            (red-mask :unsigned-long)
406            (green-mask :unsigned-long)
407            (blue-mask :unsigned-long)
408            (obdata :pointer)
409            ;; funcs
410            (create-image :pointer)
411            (destroy-image :pointer)
412            (get-pixel :pointer)
413            (put-pixel :pointer)
414            (sub-image :pointer)
415            (add-pixel :pointer))
416    
417    (defcfun ("XInitImage" xinitimage) :int
418      (ximage :pointer))
419    
420    (defcfun ("XPutImage" xputimage) :int
421      (display display)
422      (drawable drawable)
423      (graphics-context graphics-context)
424      (ximage :pointer)
425      (src-x :int)
426      (src-y :int)
427      (dest-x :int)
428      (dest-y :int)
429      (width :unsigned-int)
430      (height :unsigned-int))
431    
432  ;; call xinitthreads  ;; call xinitthreads
433    
434  (xinitthreads)  (xinitthreads)
435    
436    
437    ;; various higher level functions
438    
439    (defun set-window-size-hints (display window
440                                  min-window-width max-window-width
441                                  min-window-height max-window-height)
442      ;; set size hints on window (most window managers will respect this)
443      (let ((hints (xallocsizehints)))
444        (with-foreign-slots ((flags x y min-width min-height
445                                    max-width max-height)
446                             hints
447                             xsizehints)
448          ;; we only set the first four values because old WM's might
449          ;; get confused if we don't, they should be ignored
450          (setf flags (logior pminsize pmaxsize)
451                x 0
452                y 0
453                ;; we don't need to set the following, but some WMs go
454                ;; crazy if we don't
455                (foreign-slot-value hints 'xsizehints 'width) max-window-width
456                (foreign-slot-value hints 'xsizehints 'height) max-window-height
457                ;; set desired min/max width/height
458                min-width min-window-width
459                max-width max-window-width
460                min-height min-window-height
461                max-height max-window-height)
462          (xsetwmnormalhints display window hints)
463          (xfree hints))))
464    
465    (defun create-window (display parent width height class visual background-pixel
466                          event-mask &optional (backing-store t))
467      "Create an x11 window, placed at 0 0, with the given attributes.
468    For internal use in the cl-cairo2 package."
469      ;; call xcreatewindow with attributes
470      (with-foreign-object (attributes 'xsetwindowattributes)
471        (setf (foreign-slot-value attributes 'xsetwindowattributes 'event-mask)
472              event-mask
473              (foreign-slot-value attributes 'xsetwindowattributes 'background-pixel)
474              background-pixel
475              (foreign-slot-value attributes 'xsetwindowattributes 'backing-store)
476              (if backing-store 1 0))
477        (xcreatewindow display parent 0 0 width height
478                       0                    ; zero border width
479                       0                    ; depth - copy from parent
480                       (ecase class
481                         (copyfromparent 0)
482                         (inputoutput 1)
483                         (inputonly 2))     ; class
484                       visual
485                       (if (eq class 'inputonly)
486                           cweventmask
487                           (logior cwbackpixel cwbackingstore cweventmask))
488                       attributes)))

Legend:
Removed from v.13  
changed lines
  Added in v.15

  ViewVC Help
Powered by ViewVC 1.1.5