Changeset 10030 in project


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

directfb error condition, added utility functions, fixed some things

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

Legend:

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

    r9831 r10030  
    3030(define-extension directfb)
    3131(declare
    32  (export dfb-release dfb-init dfb-create dfb-set-cooperative-level
     32 (export dfb-error? dfb-error-code dfb-error-function
     33         dfb-release dfb-init dfb-create dfb-set-cooperative-level
    3334         dfb-create-surface dfb-enum-display-layers dfb-get-display-layer
    3435         dfb-get-input-device dfb-create-event-buffer
     
    249250  (if (eq? x 'OK)
    250251      (void)
    251       (error "DirectFB error" fn x)))
    252 
    253 (define (%alloc size)
    254   (or ($ c-pointer malloc (int size))
    255       (error "couldn't alloc memory" size)))
    256 
    257 (define %free (foreign-lambda void "free" c-pointer))
     252      (signal
     253       (make-composite-condition
     254        (make-property-condition 'exn 'message
     255                                 (sprintf "DirectFB error: ~A in ~A" x fn))
     256        (make-property-condition 'directfb 'code x 'function x)))))
     257
     258(define dfb-error?
     259  (let ((pred (condition-predicate 'directfb)))
     260    (lambda (x #!optional code function)
     261      (and (pred x)
     262           (or (not code) (eq? code (dfb-error-code x)))
     263           (or (not function) (eq? function (dfb-error-function x)))))))
     264(define dfb-error-code (condition-property-accessor 'directfb 'code))
     265(define dfb-error-function (condition-property-accessor 'directfb 'function))
    258266
    259267(eval-when (compile eval) (define dfb-directfb-interfaces '()))
     
    331339
    332340(define (dfb-init)
    333   (dfb-check-error "DirectFBInit" ($ dfb-result DirectFBInit (c-pointer #f) (c-pointer #f))))
     341  (dfb-check-error 'DirectFBInit ($ dfb-result DirectFBInit (c-pointer #f) (c-pointer #f))))
    334342
    335343(define (dfb-create)
    336344  (let-location ((dfb c-pointer))
    337     (dfb-check-error "DirectFBCreate" ($ dfb-result DirectFBCreate (c-pointer #$dfb)))
     345    (dfb-check-error 'DirectFBCreate ($ dfb-result DirectFBCreate (c-pointer #$dfb)))
    338346    (make-dfb-interface dfb)))
    339347
     
    946954  ($dfb$o IDirectFBFont font FindEncoding
    947955          ((nonnull-c-string name) (dfb-text-encoding-id $out$))))
     956
     957
     958(include "directfb.scm")
     959(include "dfb-utils.scm")
Note: See TracChangeset for help on using the changeset viewer.