(define device
(create-device
#:device-type 'software
- #:window-size (make-dimension2d 640 480)))
+ #:window-size '(640 480)))
(when (not device)
(exit #f))
(add-static-text!
gui-env
"Hello World! This is the Irrlicht Software renderer!"
- (make-rect 10 10 260 22)
+ '(10 10 260 22)
#:border #t)
;; load a Quake2 model
(define device
(create-device
#:device-type driver
- #:window-size (make-dimension2d 640 480)))
+ #:window-size '(640 480)))
(when (not device)
(exit #f))
(eval-when (eval load compile)
;; load public symbols into current module
(let ((public-modules
- '((irrlicht aabbox3d)
- (irrlicht device)
- (irrlicht dimension2d)
+ '((irrlicht device)
(irrlicht gui)
(irrlicht io)
- (irrlicht rect)
(irrlicht scene)
(irrlicht video)))
(current-interface
+++ /dev/null
-;;; guile-irrlicht --- FFI bindings for Irrlicht Engine
-;;; Copyright (C) 2019 Javier Sancho <jsf@jsancho.org>
-;;;
-;;; This file is part of guile-irrlicht.
-;;;
-;;; Guile-irrlicht 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.
-;;;
-;;; Guile-irrlicht 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
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU Lesser General Public
-;;; License along with guile-irrlicht. If not, see
-;;; <http://www.gnu.org/licenses/>.
-
-
-(define-module (irrlicht aabbox3d)
- #:use-module (srfi srfi-9)
- #:use-module (srfi srfi-9 gnu)
- #:use-module (system foreign)
- #:use-module ((irrlicht bindings core) #:prefix ffi-core:)
- #:export (make-aabbox3d
- aabbox3d-min-edge
- aabbox3d-max-edge
- aabbox3d-reset!
- aabbox3d-add-internal-point!))
-
-(define-record-type <aabbox3d>
- (make-raw-aabbox3d c-pointer)
- aabbox3d?
- (c-pointer aabbox3d-c-pointer))
-
-(define* (make-aabbox3d #:optional (min-edge '(0 0 0)) (max-edge min-edge))
- (make-raw-aabbox3d
- (make-c-struct ffi-core:aabbox3d_f32 (append min-edge max-edge))))
-
-(define (aabbox3d-min-edge box)
- (let ((data (parse-c-struct (aabbox3d-c-pointer box) ffi-core:aabbox3d_f32)))
- (list-head data 3)))
-
-(define (aabbox3d-max-edge box)
- (let ((data (parse-c-struct (aabbox3d-c-pointer box) ffi-core:aabbox3d_f32)))
- (list-tail data 3)))
-
-(define (aabbox3d-reset! box point)
- (ffi-core:aabbox3d-reset
- (aabbox3d-c-pointer box)
- (make-c-struct ffi-core:vector3df point)))
-
-(define (aabbox3d-add-internal-point! box point)
- (ffi-core:aabbox3d-add-internal-point
- (aabbox3d-c-pointer box)
- (make-c-struct ffi-core:vector3df point)))
-
-(set-record-type-printer! <aabbox3d>
- (lambda (record port)
- (let ((min (aabbox3d-min-edge record))
- (max (aabbox3d-max-edge record)))
- (format port "#<aabbox3d min: ~a max: ~a>" min max))))
(define-module (irrlicht bindings)
#:use-module (system foreign)
- #:use-module (irrlicht util))
+ #:use-module (irrlicht util foreign))
(define-foreign create-device
'* "irr_createDevice" (list int '* uint32 int int int))
(define-module (irrlicht bindings core)
#:use-module (system foreign)
- #:use-module (irrlicht util))
+ #:use-module (irrlicht util foreign))
+
+;; dimension2d struct
+(define-public dimension2d
+ (list uint32 uint32))
+
+(define-public (dimension2d->pointer data)
+ (make-c-struct dimension2d data))
+
+;; rect struct
+(define-public rect
+ (list int32 int32 int32 int32))
+
+(define-public (rect->pointer data)
+ (make-c-struct rect data))
;; vector2df struct
(define-public vector2df
- (list float float float))
+ (list float float))
+
+(define-public (vector2df->pointer data)
+ (make-c-struct vector2df data))
;; vector3df struct
(define-public vector3df
(list float float float))
-;; aabbox3d f32 struct and functions
-(define-public aabbox3d_f32
- (append
- vector3df ; min-edge
- vector3df ; max-edge
- ))
+(define-public (vector3df->pointer data)
+ (make-c-struct vector3df data))
+
+;; aabbox3df struct
+(define-public aabbox3df
+ (list vector3df vector3df))
+
+(define-public (aabbox3df->pointer data)
+ (make-c-struct aabbox3df data))
(define-foreign aabbox3d-add-internal-point
void "irr_core_aabbox3d_addInternalPoint" (list '* '*))
(define-module (irrlicht bindings gui)
#:use-module (system foreign)
- #:use-module (irrlicht util))
+ #:use-module (irrlicht util foreign))
(define-foreign add-static-text
'* "irr_gui_addStaticText" (list '* '* '* int int '* int int))
(define-module (irrlicht bindings io)
#:use-module (system foreign)
#:use-module (rnrs arithmetic bitwise)
- #:use-module (irrlicht util))
+ #:use-module (irrlicht util foreign))
(define (make-cirr-id c0 c1 c2 c3)
(define (char->numeric c)
(define-module (irrlicht bindings scene)
#:use-module (system foreign)
- #:use-module (irrlicht util))
+ #:use-module (irrlicht util foreign))
;; irr_scene_EMD2_ANIMATION_TYPE enum
(define-public EMAT_STAND 0)
'* "irr_scene_addCameraSceneNodeFPS" (list '* '* float float int '* int int float int int))
(define-foreign add-custom-scene-node
- '* "irr_scene_addCustomSceneNode" (list '* '* int '*))
+ '* "irr_scene_addCustomSceneNode" (list '* '* int '* '* '* '* '* '* '*))
(define-foreign add-octree-scene-node
'* "irr_scene_addOctreeSceneNode" (list '* '* '* int int int))
(define-module (irrlicht bindings video)
#:use-module (system foreign)
- #:use-module (irrlicht util))
+ #:use-module (irrlicht util foreign))
;; E_DRIVER_TYPE enum
(define-public EDT_NULL 0)
(define-public scolor
(list uint8 uint8 uint8 uint8))
+(define-public (scolor->pointer data)
+ (make-c-struct scolor (reverse data)))
+
;; Driver functions
(define-foreign begin-scene
int "irr_video_beginScene" (list '* int int '* '* '*))
#:use-module (ice-9 match)
#:use-module (system foreign)
#:use-module ((irrlicht bindings) #:prefix ffi:)
+ #:use-module ((irrlicht bindings core) #:prefix ffi-core:)
#:use-module ((irrlicht bindings video) #:prefix ffi-video:)
- #:use-module (irrlicht dimension2d)
#:use-module (irrlicht util)
#:export (create-device
get-cursor-control
(define* (create-device #:key
(device-type 'software)
- (window-size (make-dimension2d 640 480))
+ (window-size '(640 480))
(bits 16)
(fullscreen #f)
(stencilbuffer #f)
('opengl ffi-video:EDT_OPENGL)
('count ffi-video:EDT_COUNT))))
(let ((device (ffi:create-device driver
- (foreign-record->pointer window-size)
+ (ffi-core:dimension2d->pointer window-size)
bits
(bool->integer fullscreen)
(bool->integer stencilbuffer)
+++ /dev/null
-;;; guile-irrlicht --- FFI bindings for Irrlicht Engine
-;;; Copyright (C) 2019 Javier Sancho <jsf@jsancho.org>
-;;;
-;;; This file is part of guile-irrlicht.
-;;;
-;;; Guile-irrlicht 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.
-;;;
-;;; Guile-irrlicht 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
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU Lesser General Public
-;;; License along with guile-irrlicht. If not, see
-;;; <http://www.gnu.org/licenses/>.
-
-
-(define-module (irrlicht dimension2d)
- #:use-module (system foreign)
- #:use-module (irrlicht util)
- #:export (dimension2d
- make-dimension2d
- dimension2d?
- dimension2d-width
- dimension2d-height))
-
-;; dimension2d struct
-(define-foreign-record-type dimension2d
- (make-dimension2d width height)
- dimension2d?
- (width uint32 dimension2d-width)
- (height uint32 dimension2d-height))
(fill-background #f))
(ffi-gui:add-static-text gui-env
(string->pointer text)
- (foreign-record->pointer rectangle)
+ (ffi-core:rect->pointer rectangle)
(bool->integer border)
(bool->integer word-wrap)
parent
+++ /dev/null
-;;; guile-irrlicht --- FFI bindings for Irrlicht Engine
-;;; Copyright (C) 2019 Javier Sancho <jsf@jsancho.org>
-;;;
-;;; This file is part of guile-irrlicht.
-;;;
-;;; Guile-irrlicht 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.
-;;;
-;;; Guile-irrlicht 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
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU Lesser General Public
-;;; License along with guile-irrlicht. If not, see
-;;; <http://www.gnu.org/licenses/>.
-
-
-(define-module (irrlicht rect)
- #:use-module (system foreign)
- #:use-module (irrlicht util)
- #:export (rect
- make-rect
- rect?
- rect-x
- rect-y
- rect-x2
- rect-y2))
-
-;; rect struct
-(define-foreign-record-type rect
- (make-rect x y x2 y2)
- rect?
- (x int32 rect-x)
- (y int32 rect-y)
- (x2 int32 rect-x2)
- (y2 int32 rect-y2))
mesh
parent
id
- (make-c-struct ffi-core:vector3df position)
- (make-c-struct ffi-core:vector3df rotation)
- (make-c-struct ffi-core:vector3df scale)
+ (ffi-core:vector3df->pointer position)
+ (ffi-core:vector3df->pointer rotation)
+ (ffi-core:vector3df->pointer scale)
(bool->integer also-add-if-mesh-pointer-zero))))
(if (null-pointer? node) #f node)))
(let ((camera (ffi-scene:add-camera-scene-node
scene-manager
parent
- (make-c-struct ffi-core:vector3df position)
- (make-c-struct ffi-core:vector3df lookat)
+ (ffi-core:vector3df->pointer position)
+ (ffi-core:vector3df->pointer lookat)
id
(bool->integer make-active))))
(if (null-pointer? camera) #f camera)))
(bool->integer invert-mouse)
(bool->integer make-active)))
-(define (add-custom-scene-node! parent
- scene-manager
- id
- custom-render)
- (ffi-scene:add-custom-scene-node
- parent
- scene-manager
- id
- (procedure->pointer void custom-render '())))
+(define* (add-custom-scene-node! scene-manager
+ render
+ get-bounding-box
+ get-material-count
+ get-material
+ #:key
+ (parent %null-pointer)
+ (id -1)
+ (position '(0 0 0))
+ (rotation '(0 0 0))
+ (scale '(1 1 1)))
+ (let ((c-get-bounding-box
+ (lambda ()
+ (ffi-core:aabbox3df->pointer (get-bounding-box))))
+ (c-get-material
+ (lambda (i)
+ (ffi-core:material->pointer (get-material i)))))
+ (ffi-scene:add-custom-scene-node
+ scene-manager
+ parent
+ id
+ (ffi-core:vector3df->pointer position)
+ (ffi-core:vector3df->pointer rotation)
+ (ffi-core:vector3df->pointer scale)
+ (procedure->pointer void render '())
+ (procedure->pointer '* c-get-bounding-box '())
+ (procedure->pointer uint32 get-material-count '())
+ (procedure->pointer '* c-get-material (list uint32)))))
(define* (add-octree-scene-node scene-manager mesh
#:key
(define (set-position! node newpos)
(ffi-scene:set-position
node
- (make-c-struct ffi-core:vector3df newpos)))
+ (ffi-core:vector3df->pointer newpos)))
(define-module (irrlicht util)
- #:use-module (system foreign)
- #:use-module (srfi srfi-1)
- #:use-module (rnrs bytevectors)
#:export (bool->integer
- integer->bool
- define-foreign
- define-foreign-record-type
- foreign-record->pointer))
+ integer->bool))
(define (bool->integer var)
(if var 1 0))
(define (integer->bool var)
(if (= var 0) #f #t))
-
-;; Based on guile-sdl2 function, thanks a lot
-(define irrlicht-func
- (let ((cirr (dynamic-link "libCIrrlicht")))
- (lambda (return-type function-name arg-types)
- (pointer->procedure return-type
- (dynamic-func function-name cirr)
- arg-types))))
-
-(define-syntax-rule (define-foreign name return-type func-name arg-types)
- (define-public name
- (irrlicht-func return-type func-name arg-types)))
-
-;; foreign struct record type
-(define-syntax define-foreign-record-type
- (lambda (x)
- (define (field-names field-specs)
- (map (lambda (field-spec)
- (syntax-case field-spec ()
- ((name type getter) #'name)
- ((name type getter setter) #'name)))
- field-specs))
-
- (define (field-types field-specs)
- (map (lambda (field-spec)
- (syntax-case field-spec ()
- ((name type getter) #'type)
- ((name type getter setter) #'type)))
- field-specs))
-
- (define (field-getters field-specs)
- (map (lambda (field-spec field-id)
- (syntax-case field-spec ()
- ((name type getter) (list #'getter field-id))
- ((name type getter setter) (list #'getter field-id))))
- field-specs
- (iota (length field-specs))))
-
- (define (field-setters field-specs)
- (filter-map (lambda (field-spec field-id)
- (syntax-case field-spec ()
- ((name type getter) #f)
- ((name type getter setter) (list #'setter field-id))))
- field-specs
- (iota (length field-specs))))
-
- (syntax-case x ()
- ((_ name (make-name make-arg ...) predicate? field-spec ...)
- (with-syntax (((type-id ...) (field-types #'(field-spec ...)))
- ((field-name ...) (field-names #'(field-spec ...)))
- (((getter getter-id) ...) (field-getters #'(field-spec ...)))
- (((setter setter-id) ...) (field-setters #'(field-spec ...))))
- #'(begin
- (define-wrapped-pointer-type name
- predicate?
- wrap-record unwrap-record
- (lambda (record port)
- (format port "#<~a" 'name)
- (let ((values (parse-c-struct (unwrap-record record) (list type-id ...))))
- (for-each (lambda (field value)
- (format port " ~a: ~a" field value))
- '(field-name ...)
- values))
- (format port ">")))
-
- (define (make-name make-arg ...)
- (wrap-record (make-c-struct (list type-id ...) (list make-arg ...))))
-
- (define (getter record)
- (let ((values (parse-c-struct (unwrap-record record) (list type-id ...))))
- (list-ref values getter-id)))
- ...
-
- (define (setter record new-value)
- (let* ((types (list type-id ...))
- (type (list-ref types setter-id))
- (len (sizeof type))
- (offset (if (> setter-id 0)
- (sizeof (list-head types setter-id))
- 0))
- (bv (pointer->bytevector (unwrap-record record) len offset 'u32)))
- (bytevector-set! bv new-value type)
- new-value))
- ...))))))
-
-(define (bytevector-set! bv value type)
- (let ((procedure
- (cond
- ((= type int8) bytevector-s8-set!)
- ((= type int16) bytevector-s16-native-set!)
- ((= type int32) bytevector-s32-native-set!)
- ((= type int64) bytevector-s64-native-set!)
- ((= type uint8) bytevector-u8-set!)
- ((= type uint16) bytevector-u16-native-set!)
- ((= type uint32) bytevector-u32-native-set!)
- ((= type uint64) bytevector-u64-native-set!)
- ((= type float) bytevector-ieee-single-native-set!)
- ((= type double) bytevector-ieee-double-native-set!)
- (else #f))))
- (if procedure
- (apply procedure bv 0 value '()))))
-
-(define (foreign-record->pointer record)
- (struct-ref record 0))
--- /dev/null
+;;; guile-irrlicht --- FFI bindings for Irrlicht Engine
+;;; Copyright (C) 2019 Javier Sancho <jsf@jsancho.org>
+;;;
+;;; This file is part of guile-irrlicht.
+;;;
+;;; Guile-irrlicht 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.
+;;;
+;;; Guile-irrlicht 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
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with guile-irrlicht. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+
+(define-module (irrlicht util foreign)
+ #:use-module (system foreign)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-9 gnu)
+ #:use-module (rnrs bytevectors)
+ #:export (define-foreign
+ define-foreign-record-type
+ foreign-record->pointer))
+
+
+;; Based on guile-sdl2 function, thanks a lot
+(define irrlicht-func
+ (let ((cirr (dynamic-link "libCIrrlicht")))
+ (lambda (return-type function-name arg-types)
+ (pointer->procedure return-type
+ (dynamic-func function-name cirr)
+ arg-types))))
+
+(define-syntax-rule (define-foreign name return-type func-name arg-types)
+ (define-public name
+ (irrlicht-func return-type func-name arg-types)))
+
+
+;; foreign record type
+(define-record-type standard-foreign-record-type
+ (make-foreign-record-type name types fields)
+ foreign-record-type?
+ (name foreign-record-type-name)
+ (types foreign-record-type-types)
+ (fields foreign-record-type-fields))
+
+(define (foreign-record-type-basic-types record-type)
+ (map (lambda (type)
+ (if (foreign-record-type? type)
+ (foreign-record-type-basic-types type)
+ type))
+ (foreign-record-type-types record-type)))
+
+
+;; foreign record
+(define-record-type foreign-record
+ (make-foreign-record type pointer)
+ foreign-record?
+ (type foreign-record-type)
+ (pointer foreign-record-pointer))
+
+(set-record-type-printer! foreign-record
+ (lambda (record port)
+ (let* ((record-type (foreign-record-type record))
+ (name (foreign-record-type-name record-type))
+ (pointer (foreign-record-pointer record))
+ (types (foreign-record-type-types record-type))
+ (fields (foreign-record-type-fields record-type))
+ (values (parse-c-struct pointer types)))
+ (format port "#<~a" name)
+ (for-each (lambda (field value)
+ (format port " ~a: ~a" field value))
+ fields
+ values)
+ (format port ">"))))
+
+(define (foreign-record->pointer record)
+ (foreign-record-pointer record))
+
+
+;; define-foreign-record-type
+(define-syntax define-foreign-record-type
+ (lambda (x)
+ (define (field-names field-specs)
+ (map (lambda (field-spec)
+ (syntax-case field-spec ()
+ ((name type getter) #'name)
+ ((name type getter setter) #'name)))
+ field-specs))
+
+ (define (field-types field-specs)
+ (map (lambda (field-spec)
+ (syntax-case field-spec ()
+ ((name type getter) #'type)
+ ((name type getter setter) #'type)))
+ field-specs))
+
+ (define (field-getters field-specs)
+ (map (lambda (field-spec field-id)
+ (syntax-case field-spec ()
+ ((name type getter) (list #'getter field-id))
+ ((name type getter setter) (list #'getter field-id))))
+ field-specs
+ (iota (length field-specs))))
+
+ (define (field-setters field-specs)
+ (filter-map (lambda (field-spec field-id)
+ (syntax-case field-spec ()
+ ((name type getter) #f)
+ ((name type getter setter) (list #'setter field-id))))
+ field-specs
+ (iota (length field-specs))))
+
+ (syntax-case x ()
+ ((_ name (make-name make-arg ...) predicate? field-spec ...)
+ (with-syntax (((type-id ...) (field-types #'(field-spec ...)))
+ ((field-name ...) (field-names #'(field-spec ...)))
+ (((getter getter-id) ...) (field-getters #'(field-spec ...)))
+ (((setter setter-id) ...) (field-setters #'(field-spec ...))))
+ #'(begin
+ (define name
+ (make-foreign-record-type 'name (list type-id ...) (list 'field-name ...)))
+
+ (define (make-name make-arg ...)
+ (let ((pointer (make-c-struct (list type-id ...) (list make-arg ...))))
+ (make-foreign-record name pointer)))
+
+ (define (predicate? record)
+ (and (foreign-record? record)
+ (equal? (foreign-record-type-name (foreign-record-type record)) 'name)))
+
+ (define (getter record)
+ (let ((values (parse-c-struct (foreign-record-pointer record) (list type-id ...))))
+ (list-ref values getter-id)))
+ ...
+
+ (define (setter record new-value)
+ (let* ((types (list type-id ...))
+ (type (list-ref types setter-id))
+ (len (sizeof type))
+ (offset (if (> setter-id 0)
+ (sizeof (list-head types setter-id))
+ 0))
+ (bv (pointer->bytevector (foreign-record-pointer record) len offset 'u32)))
+ (bytevector-set! bv new-value type)
+ new-value))
+ ...))))))
+
+(define (bytevector-set! bv value type)
+ (let ((procedure
+ (cond
+ ((= type int8) bytevector-s8-set!)
+ ((= type int16) bytevector-s16-native-set!)
+ ((= type int32) bytevector-s32-native-set!)
+ ((= type int64) bytevector-s64-native-set!)
+ ((= type uint8) bytevector-u8-set!)
+ ((= type uint16) bytevector-u16-native-set!)
+ ((= type uint32) bytevector-u32-native-set!)
+ ((= type uint64) bytevector-u64-native-set!)
+ ((= type float) bytevector-ieee-single-native-set!)
+ ((= type double) bytevector-ieee-double-native-set!)
+ (else #f))))
+ (if procedure
+ (apply procedure bv 0 value '()))))
(ffi-video:begin-scene driver
(bool->integer back-buffer)
(bool->integer z-buffer)
- (make-c-struct ffi-video:scolor (reverse color))
+ (ffi-video:scolor->pointer color)
video-data
(if (null? source-rect)
%null-pointer
- (make-c-struct ffi-core:rect source-rect))))
+ (ffi-core:rect->pointer source-rect))))
(define (end-scene driver)
(ffi-video:end-scene driver))
--- /dev/null
+%%%% Starting test foreign-record
+Group begin: foreign-record
+Test begin:
+ source-file: "tests/foreign-record.scm"
+ source-line: 36
+ source-form: (test-assert (dimension2d? dim))
+Test end:
+ result-kind: pass
+ actual-value: #t
+Test begin:
+ source-file: "tests/foreign-record.scm"
+ source-line: 37
+ source-form: (test-equal 10 (dimension2d-width dim))
+Test end:
+ result-kind: pass
+ actual-value: 10
+ expected-value: 10
+Test begin:
+ source-file: "tests/foreign-record.scm"
+ source-line: 38
+ source-form: (test-equal 20 (dimension2d-height dim))
+Test end:
+ result-kind: pass
+ actual-value: 20
+ expected-value: 20
+Test begin:
+ source-file: "tests/foreign-record.scm"
+ source-line: 43
+ source-form: (test-equal 50 (dimension2d-width dim))
+Test end:
+ result-kind: pass
+ actual-value: 50
+ expected-value: 50
+Test begin:
+ source-file: "tests/foreign-record.scm"
+ source-line: 44
+ source-form: (test-equal 100 (dimension2d-height dim))
+Test end:
+ result-kind: pass
+ actual-value: 100
+ expected-value: 100
+Test begin:
+ source-file: "tests/foreign-record.scm"
+ source-line: 47
+ source-form: (test-assert (pointer? (foreign-record->pointer dim)))
+Test end:
+ result-kind: pass
+ actual-value: #t
+Group end: foreign-record
+# of expected passes 6
(use-modules (system foreign)
(srfi srfi-64)
- (irrlicht util))
+ (irrlicht util foreign))
(test-begin "foreign-record")
;; Create dimension
(define dim (make-dimension2d 10 20))
+(test-assert (dimension2d? dim))
(test-equal 10 (dimension2d-width dim))
(test-equal 20 (dimension2d-height dim))
;; Is a pointer
(test-assert (pointer? (foreign-record->pointer dim)))
+;; Foreign record types as types for other foreign records
+(define-foreign-record-type point
+ (make-point x y)
+ point?
+ (x int64 point-x)
+ (y int64 point-y))
+
+(define-foreign-record-type triangle
+ (make-triangle p1 p2 p3)
+ triangle?
+ (p1 point triangle-p1)
+ (p2 point triangle-p2)
+ (p3 point triangle-p3))
+
+;(define tr (make-triangle (make-point 0 10) (make-point -10 5) (make-point 15 -7)))
+;(test-equal -10 (point-x (triangle-p2 tr)))
+
(test-end "foreign-record")
projects / guile-irrlicht.git / commitdiff