From 13a9b539082eec2f6c5991d7e196efccecf4e20b Mon Sep 17 00:00:00 2001 From: Daniel Hartwig Date: Mon, 11 Feb 2013 14:14:16 +0800 Subject: [PATCH] add glut callback-pointer types * figl/glut/types.scm: New file. Contains types previously defined in low-level. Add callback-pointer types, but not used yet. * figl/glut/low-level.scm: Move previous type definitions to new types module. * Makefile.am: Update for new file. --- Makefile.am | 1 + figl/glut/low-level.scm | 17 +----- figl/glut/types.scm | 129 ++++++++++++++++++++++++++++++++++++++++ 3 files changed, 131 insertions(+), 16 deletions(-) create mode 100644 figl/glut/types.scm diff --git a/Makefile.am b/Makefile.am index ac513a4..64b93d9 100644 --- a/Makefile.am +++ b/Makefile.am @@ -26,6 +26,7 @@ SOURCES = \ figl/glx/enums.scm \ figl/glx.scm \ \ + figl/glut/types.scm \ figl/glut/runtime.scm \ figl/glut/low-level.scm \ figl/glut/enums.scm \ diff --git a/figl/glut/low-level.scm b/figl/glut/low-level.scm index 8f87dbb..2f9a855 100644 --- a/figl/glut/low-level.scm +++ b/figl/glut/low-level.scm @@ -26,8 +26,8 @@ ;;; Code: (define-module (figl glut low-level) - #:use-module (figl runtime) #:use-module (figl glut runtime) + #:use-module (figl glut types) #:use-module (figl gl types) #:use-module ((system foreign) #:renamer (symbol-prefix-proc 'ffi:)) #:use-module (srfi srfi-26) ; cut @@ -143,17 +143,6 @@ glutWireTeapot )) -(define-simple-foreign-type int ffi:int) -(define-simple-foreign-type unsigned-int ffi:unsigned-int) - -;; GLUT specifies that all strings are ASCII encoded. -(define-foreign-type char-* '* - (cut ffi:string->pointer <> "ASCII") - (cut ffi:pointer->string <> -1 "ASCII")) - -(define-simple-foreign-type int-* '*) -(define-simple-foreign-type char-** '*) - ;;; ;;; 2 Initialization ;;; @@ -427,10 +416,6 @@ (glutMenuStatusFunc (func void-*) -> void) #f) -(define-glut-procedure - (glutMenuStateFunc (func void-*) -> void) - #f) - (define-glut-procedure (glutIdleFunc (func void-*) -> void) #f) diff --git a/figl/glut/types.scm b/figl/glut/types.scm new file mode 100644 index 0000000..da1fb25 --- /dev/null +++ b/figl/glut/types.scm @@ -0,0 +1,129 @@ +;;; figl +;;; Copyright (C) 2013 Daniel Hartwig +;;; +;;; Figl is free software: you can redistribute it and/or modify it +;;; under the terms of the GNU Lesser General Public License as +;;; published by the Free Software Foundation, either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; Figl 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 program. If not, see +;;; . + +;;; Commentary: +;; +;; Mappings from GLUT to FFI types. +;; +;;; Code: + +(define-module (figl glut types) + #:use-module (figl runtime) + #:use-module (figl gl types) + #:use-module ((system foreign) #:renamer (symbol-prefix-proc 'ffi:)) + #:use-module (srfi srfi-26) ; cut + #:export (unsigned-char + int + unsigned-int + char-* + int-* + char-** + + display-callback-* + overlay-display-callback-* + reshape-callback-* + keyboard-callback-* + mouse-callback-* + motion-callback-* + passive-motion-callback-* + visibility-callback-* + entry-callback-* + special-callback-* + spaceball-motion-callback-* + spaceball-rotate-callback-* + spaceball-button-callback-* + button-box-callback-* + dials-callback-* + tablet-motion-callback-* + tablet-button-callback-* + menu-status-callback-* + idle-callback-* + timer-callback-*)) + +(define-simple-foreign-type unsigned-char ffi:uint8) +(define-simple-foreign-type int ffi:int) +(define-simple-foreign-type unsigned-int ffi:unsigned-int) + +;; GLUT specifies that all strings are ASCII encoded. +(define-foreign-type char-* '* + (cut ffi:string->pointer <> "ASCII") + (cut ffi:pointer->string <> -1 "ASCII")) + +(define-simple-foreign-type int-* '*) +(define-simple-foreign-type char-** '*) + +(define (coerce-callback-pointer x return-type arg-types) + (cond + ((ffi:pointer? x) + x) + ((procedure? x) + (ffi:procedure->pointer return-type x arg-types)) + (else + (error "unhandled callback-pointer type" x)))) + +(define-syntax define-callback-pointer-type + (syntax-rules (->) + ((_ name ((pname ptype) ... -> type)) + (define-foreign-type name '* + (cute coerce-callback-pointer <> (type) (list (ptype) ...)) + (lambda (x) x))))) + +;; TODO: These callback-pointer types are not used at, as it is not +;; clear how to efficiently keep the pointers alive. Defined now +;; anyway as a stub, and users can access them if they keep the +;; pointer alive themselves. + +(define-callback-pointer-type display-callback-* + (-> void)) +(define-callback-pointer-type overlay-display-callback-* + (-> void)) +(define-callback-pointer-type reshape-callback-* + ((width int) (height int) -> void)) +(define-callback-pointer-type keyboard-callback-* + ((key unsigned-char) (x int) (y int) -> void)) +(define-callback-pointer-type mouse-callback-* + ((button int) (state int) (x int) (y int) -> void)) +(define-callback-pointer-type motion-callback-* + ((x int) (y int) -> void)) +(define-callback-pointer-type passive-motion-callback-* + ((x int) (y int) -> void)) +(define-callback-pointer-type visibility-callback-* + ((state int) -> void)) +(define-callback-pointer-type entry-callback-* + ((state int) -> void)) +(define-callback-pointer-type special-callback-* + ((key int) (x int) (y int) -> void)) +(define-callback-pointer-type spaceball-motion-callback-* + ((x int) (y int) (z int) -> void)) +(define-callback-pointer-type spaceball-rotate-callback-* + ((x int) (y int) (z int) -> void)) +(define-callback-pointer-type spaceball-button-callback-* + ((button int) (state int) -> void)) +(define-callback-pointer-type button-box-callback-* + ((button int) (state int) -> void)) +(define-callback-pointer-type dials-callback-* + ((dial int) (value int) -> void)) +(define-callback-pointer-type tablet-motion-callback-* + ((x int) (y int) -> void)) +(define-callback-pointer-type tablet-button-callback-* + ((button int) (state int) (x int) (y int) -> void)) +(define-callback-pointer-type menu-status-callback-* + ((status int) (x int) (y int) -> void)) +(define-callback-pointer-type idle-callback-* + (-> void)) +(define-callback-pointer-type timer-callback-* + ((value int) -> void)) -- 2.20.1