Changeset 9796 in project


Ignore:
Timestamp:
03/16/08 02:38:22 (12 years ago)
Author:
hans
Message:

directfb: error codes are now symbols and some other fixes

Location:
release/2/directfb/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/2/directfb/trunk/directfb-base.scm

    r9762 r9796  
    8484;;; Enums
    8585
     86(define-foreign-open-enum (dfb-result int) (strip-prefix: DFB_)
     87  DFB_OK DFB_FAILURE DFB_INIT DFB_BUG DFB_DEAD DFB_UNSUPPORTED
     88  DFB_UNIMPLEMENTED DFB_ACCESSDENIED DFB_INVARG DFB_NOSYSTEMMEMORY
     89  DFB_NOVIDEOMEMORY DFB_LOCKED DFB_BUFFEREMPTY DFB_FILENOTFOUND
     90  DFB_IO DFB_BUSY DFB_NOIMPL DFB_MISSINGFONT DFB_TIMEOUT DFB_MISSINGIMAGE
     91  DFB_THIZNULL DFB_IDNOTFOUND DFB_INVAREA DFB_DESTROYED DFB_FUSION
     92  DFB_BUFFERTOOLARGE DFB_INTERRUPTED DFB_NOCONTEXT DFB_TEMPUNAVAIL
     93  DFB_LIMITEXCEEDED DFB_NOSUCHMETHOD DFB_NOSUCHINSTANCE DFB_ITEMNOTFOUND
     94  DFB_VERSIONMISMATCH DFB_NOSHAREDMEMORY DFB_EOF DFB_SUSPENDED DFB_INCOMPLETE
     95  DFB_NOCORE)
     96
    8697(define-foreign-open-enum (dfb-cooperative-level int) (strip-prefix: DFSCL_)
    8798  DFSCL_NORMAL DFSCL_FULLSCREEN DFSCL_EXCLUSIVE)
     
    206217
    207218(define (dfb-check-error fn x)
    208   (if (fx= x (foreign-value "DFB_OK" int))
     219  (if (eq? x 'OK)
    209220      (void)
    210       (error "dfb error" fn x)))
     221      (error "DirectFB error" fn x)))
    211222
    212223(define (%alloc size)
     
    237248    (maybe-check-error
    238249     `((,(if safe 'foreign-safe-lambda* 'foreign-lambda*)
    239            int ((,scheme-type ,g-obj)
    240                 ,@(map (lambda (arg sym) (list (car arg) sym))
    241                        args g-args))
    242          ,(with-output-to-string
    243             (lambda ()
    244               (printf "return(((~a*)~a)->~a(~a" type g-obj method g-obj)
    245               (for-each (lambda (sym) (printf ",~a" (->string sym))) g-args)
    246               (display "));"))))
     250        dfb-result
     251        ((,scheme-type ,g-obj)
     252         ,@(map (lambda (arg sym) (list (car arg) sym))
     253                args g-args))
     254        ,(with-output-to-string
     255           (lambda ()
     256             (printf "return(((~a*)~a)->~a(~a" type g-obj method g-obj)
     257             (for-each (lambda (sym) (printf ",~a" (->string sym))) g-args)
     258             (display "));"))))
    247259       ,obj
    248260       ,@(map (cut cadr <>) args)))))
     
    269281  (flush-output)
    270282  (dfb-check-error 'Release
    271                    ((foreign-lambda* int ((c-pointer inst))
     283                   ((foreign-lambda* dfb-result ((c-pointer inst))
    272284                      "return(((IDirectFB*)inst)->Release(inst));")
    273285                    (block-ref inst 1))))
     
    289301
    290302(define (dfb-init)
    291   (dfb-check-error "DirectFBInit" ($ int DirectFBInit (c-pointer #f) (c-pointer #f))))
     303  (dfb-check-error "DirectFBInit" ($ dfb-result DirectFBInit (c-pointer #f) (c-pointer #f))))
    292304
    293305(define (dfb-create)
    294306  (let-location ((dfb c-pointer))
    295     (dfb-check-error "DirectFBCreate" ($ int DirectFBCreate (c-pointer #$dfb)))
     307    (dfb-check-error "DirectFBCreate" ($ dfb-result DirectFBCreate (c-pointer #$dfb)))
    296308    (make-dfb-interface dfb)))
    297309
     
    667679
    668680(define (dfbeb-wait-for-event-with-timeout eb seconds milli-seconds)
    669   ($dfb$ IDirectFBEventBuffer eb WaitForEventWithTimeout
    670          ((unsigned-int seconds) (unsigned-int milli-seconds))))
     681  (let ((r ($dfb$ IDirectFBEventBuffer eb WaitForEventWithTimeout
     682                  ((unsigned-int seconds) (unsigned-int milli-seconds))
     683                  check-error: #f)))
     684    (case r
     685      ((OK) #t)
     686      ((TIMEOUT) #f)
     687      (else (dfb-check-error 'WaitForEventWithTimeout r)))))
    671688
    672689(define (make-dfb-event-blob)
     
    687704(define (dfbeb-get-event eb)
    688705  (let ((e (make-dfb-event-blob)))
    689     (and (fx= (foreign-value "DFB_OK" int)
    690               ($dfb$ IDirectFBEventBuffer eb GetEvent ((blob e))
    691                      check-error: #f))
     706    (and (eq? 'OK ($dfb$ IDirectFBEventBuffer eb GetEvent ((blob e))
     707                         check-error: #f))
    692708         (wrap-dfb-event-blob e))))
    693709
     
    812828   'SetStreamAttributes
    813829   ((foreign-lambda*
    814         int
     830        dfb-result
    815831        ((dfbvp-interface vp) (dfb-stream-description attr))
    816832     "return(((IDirectFBVideoProvider*)vp)->SetStreamAttributes(vp,*((DFBStreamDescription*)attr)));")
  • release/2/directfb/trunk/directfb.scm

    r9763 r9796  
    3232  `(let ,(map (lambda (o) (list (car o) #f)) objs)
    3333     (dynamic-wind
     34         void
    3435         (lambda ()
    35            ,@(map (lambda (o) `(set! ,(car o) ,(cadr o))) objs))
    36          (lambda () ,@body)
     36           ,@(map (lambda (o) `(set! ,(car o) ,(cadr o))) objs)
     37           ,@body)
    3738         (lambda ()
    3839           ,@(map (lambda (o)
     
    4041                       (dfb-release ,(car o))
    4142                       (set! ,(car o) #f)))
    42                   objs)))))
     43                  (reverse objs))))))
    4344
    4445(define-macro (dfb-give var)
Note: See TracChangeset for help on using the changeset viewer.