Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Working on LIST-VIDEO-MODES. CFArrayRefs don't work yet.

  • Loading branch information...
commit 1171c3446c6fcf43bb7f292f8c4397ef06c25424 1 parent 2fa089a
@jtza8 jtza8 authored committed
View
3  glop.asd
@@ -26,7 +26,8 @@
(:module "osx"
:serial t
:components ((:file "package")
- (:file "bridge")
+ (:file "core-foundation")
+ (:file "quartz")
(:file "glop-osx")))
#+(or win32 windows)
(:module "win32"
View
26 src/osx/bridge.lisp
@@ -25,6 +25,9 @@
(refresh :double)
(depth :int)
(mode :pointer))
+(defcfun ("loadDisplayModeInfo" load-display-mode-info) :void
+ (info display-mode-info)
+ (mode :pointer))
(defcfun ("getDisplayModeInfoArray" get-display-mode-info-array) :pointer
(size :pointer))
(defcfun ("makeAutoreleasePool" make-autorelease-pool) :pointer)
@@ -40,19 +43,22 @@
(unwind-protect (progn ,@body)
(release-pool ,pool-var)))))
+(defun convert-to-video-mode (display-mode-info)
+ (with-foreign-slots ((width height refresh depth mode)
+ display-mode-info
+ display-mode-info)
+ (glop::make-osx-video-mode
+ :width width
+ :height height
+ :rate refresh
+ :depth depth
+ :mode mode)))
+
(defun list-video-modes ()
(with-foreign-object (array-size :long)
(let ((modes (get-display-mode-info-array array-size)))
(unwind-protect
(loop for i below (mem-ref array-size :long)
- collect (with-foreign-slots
- ((width height refresh depth mode)
- (mem-aref modes 'display-mode-info i)
- display-mode-info)
- (glop::make-osx-video-mode
- :width width
- :height height
- :rate refresh
- :depth depth
- :mode mode)))
+ collect (convert-to-video-mode
+ (mem-aref modes 'display-mode-info i)))
(foreign-free modes)))))
View
2  src/osx/bridge/Makefile
@@ -1,3 +1,5 @@
+CFLAGS=-Wall
+
all: bridge.dylib
bridge.dylib: bridge.o
View
BIN  src/osx/bridge/bridge.dylib
Binary file not shown
View
21 src/osx/bridge/bridge.m
@@ -31,16 +31,26 @@ int displayModeGetDepth (CGDisplayModeRef ref)
return -1;
}
-void setDisplayInfo (const void *value, void *context)
+void loadDisplayModeInfo(DisplayModeInfo *info, CGDisplayModeRef mode)
{
- DisplayModeInfo *info
- = (DisplayModeInfo *)((Iterator *)context)->pointer;
- CGDisplayModeRef mode = (CGDisplayModeRef)value;
info->width = CGDisplayModeGetWidth(mode);
info->height = CGDisplayModeGetHeight(mode);
info->refresh = CGDisplayModeGetRefreshRate(mode);
info->depth = displayModeGetDepth(mode);
info->mode = mode;
+}
+
+DisplayModeInfo getCurrentDisplayMode()
+{
+ DisplayModeInfo info;
+ loadDisplayModeInfo(&info, CGDisplayCopyDisplayMode(CGMainDisplayID()));
+ return info;
+}
+
+void getDisplayModeInfoArraySetter (const void *value, void *context)
+{
+ loadDisplayModeInfo((DisplayModeInfo *)((Iterator *)context)->pointer,
+ (CGDisplayModeRef)value);
((Iterator *)context)->pointer += sizeof(DisplayModeInfo);
}
@@ -52,7 +62,7 @@ void setDisplayInfo (const void *value, void *context)
DisplayModeInfo *array = malloc(sizeof(DisplayModeInfo) * *size);
context.pointer = array;
CFArrayApplyFunction(modeArray, (CFRange){0, *size},
- setDisplayInfo, &context);
+ getDisplayModeInfoArraySetter, &context);
return array;
}
@@ -81,4 +91,5 @@ void initNSApp ()
defer:NO] autorelease];
[window setBackgroundColor:[NSColor blueColor]];
[window makeKeyAndOrderFront:NSApp];
+ return window;
}
View
74 src/osx/core-foundation.lisp
@@ -0,0 +1,74 @@
+(in-package #:glop-core-foundation)
+
+(define-foreign-library application-services
+ (t (:framework "CoreFoundation")))
+(use-foreign-library application-services)
+
+; Enums:
+(defcenum string-builtin-encodings
+ (:mac-roman 0)
+ (:windows-latin-1 #x0500)
+ (:iso-latin-1 #x0201)
+ (:next-step-latin #x0b01)
+ (:ascii #x0600)
+ (:unicode #x0100)
+ (:utf-8 #x08000100)
+ (:non-lossy-ascii #x0bff)
+ (:utf-16 #x0100)
+ (:utf-16-be #x10000100)
+ (:utf-16-le #x14000100)
+ (:utf-32 #x0c000100)
+ (:utf-32-be #x18000100)
+ (:utf-32-le #x1c000100))
+
+; Types:
+(defctype index :int64)
+(defcstruct range
+ (location index)
+ (length index))
+
+; Strings:
+(defcfun ("CFStringGetLength" string-length) index
+ (the-string :pointer))
+(defcfun ("CFStringGetCString" string-c-string) :boolean
+ (the-string :pointer)
+ (buffer :pointer)
+ (buffer-length index)
+ (encoding string-builtin-encodings))
+
+; Arrays:
+(defcfun ("CFArrayGetCount" array-count) index
+ (the-array :pointer))
+(defcfun ("CFArrayGetValueAtIndex" array-value-at-index) :pointer
+ (the-array :pointer)
+ (index index))
+(defcfun ("CFArrayGetFirstIndexOfValue" array-first-index-of-value) index
+ (the-array :pointer)
+ (range range)
+ (value :pointer))
+(defcfun ("CFArrayGetValues" array-values) :void
+ (the-array :pointer)
+ (range range)
+ (values :pointer))
+
+(defun string-lisp-string (cf-string)
+ (let ((buffer-length (1+ (string-length cf-string))))
+ (with-foreign-object (buffer :string buffer-length)
+ (string-c-string cf-string buffer buffer-length :iso-latin-1)
+ (foreign-string-to-lisp buffer))))
+
+; There's a problem with CFArrayRefs that causes the following to fail:
+(defun lisp-array-values (cf-array)
+ (let ((buffer-length (array-count cf-array)))
+ (with-foreign-object (buffer :pointer buffer-length)
+ (with-foreign-object (range 'range)
+ (with-foreign-slots ((location length) range range)
+ (setf location 0
+ length buffer-length))
+ (array-values cf-array range buffer)
+ (loop with lisp-array = (make-array buffer-length
+ :element-type
+ (type-of (null-pointer)))
+ for i below buffer-length
+ do (setf (aref lisp-array i) (mem-aref buffer :pointer i))
+ finally (return lisp-array))))))
View
19 src/osx/glop-osx.lisp
@@ -1,4 +1,21 @@
(in-package #:glop)
+(defun display-to-video-mode (mode)
+ (make-osx-video-mode
+ :width (glop-quartz:mode-width mode)
+ :height (glop-quartz:mode-height mode)
+ :rate (glop-quartz:mode-rate mode)
+ :depth (length (glop-quartz:mode-pixel-encoding mode))
+ :mode mode))
+
+(defmethod current-video-mode ()
+ (display-to-video-mode
+ (glop-quartz:copy-display-mode (glop-quartz:main-display-id))))
+
(defmethod list-video-modes ()
- (glop-osx::list-video-modes))
+ (let ((display-modes (glop-quartz:copy-all-display-modes
+ (glop-quartz:main-display-id) (cffi:null-pointer))))
+ ;; (map 'list #'display-to-video-mode
+ ;; (glop-cf:lisp-array-values display-modes))
+ (glop-cf:lisp-array-values display-modes)
+ ))
View
22 src/osx/package.lisp
@@ -1,3 +1,19 @@
-(defpackage #:glop-osx
- (:use :cl :cffi)
- (:export))
+(defpackage #:glop-core-foundation
+ (:use #:cl #:cffi)
+ (:nicknames #:glop-cf)
+ (:export #:string-length
+ #:string-c-string
+ #:string-lisp-string
+ #:array-count
+ #:array-values
+ #:lisp-array-values))
+
+(defpackage #:glop-quartz
+ (:use :cl :cffi :glop-cf)
+ (:export #:main-display-id
+ #:copy-display-mode
+ #:copy-all-display-modes
+ #:mode-width
+ #:mode-height
+ #:mode-rate
+ #:mode-pixel-encoding))
View
24 src/osx/quartz.lisp
@@ -0,0 +1,24 @@
+(in-package #:glop-quartz)
+
+(define-foreign-library application-services
+ (t (:framework "ApplicationServices")))
+(use-foreign-library application-services)
+
+(defctype display-id :uint32)
+(defctype size-t :uint32)
+(defcfun ("CGMainDisplayID" main-display-id) display-id)
+(defcfun ("CGDisplayCopyDisplayMode" copy-display-mode) :pointer
+ (id display-id))
+(defcfun ("CGDisplayCopyAllDisplayModes" copy-all-display-modes) :pointer
+ (id display-id)
+ (options :pointer))
+(defcfun ("CGDisplayModeGetWidth" mode-width) size-t
+ (mode :pointer))
+(defcfun ("CGDisplayModeGetHeight" mode-height) size-t
+ (mode :pointer))
+(defcfun ("CGDisplayModeGetRefreshRate" mode-rate) :double
+ (mode :pointer))
+(defcfun ("CGDisplayModeCopyPixelEncoding" %mode-pixel-encoding) :pointer
+ (mode :pointer))
+(defun mode-pixel-encoding (mode)
+ (string-get-lisp-string (%mode-pixel-encoding mode)))
Please sign in to comment.
Something went wrong with that request. Please try again.