(module allegro mzscheme
(require (lib "foreign.ss")) (unsafe!)
(define *dir*
(let-syntax ((current-module-directory
(lambda (stx)
(datum->syntax-object
stx (current-load-relative-directory)))))
(current-module-directory)))
(putenv "ALLEGRO_MODULES" (path->string (build-path *dir* "../allegro-4.2.0/lib/unix")))
(case (system-type)
((windows) (begin
(ffi-lib "libz")
(ffi-lib (build-path *dir* "../windows/png12"))))
((unix) (begin
(ffi-lib "libz")
(ffi-lib (build-path *dir* "../allegro-4.2.0/lib/unix/libpng12")))))
(define liballegro (ffi-lib (case (system-type)
((windows) (build-path *dir* "../windows/alleg42"))
((unix) (begin
(build-path *dir* "../allegro-4.2.0/lib/unix/liballeg-4.2.0")))
((macosx) (error "not implemented yet")))))
(define-syntax defallegro
(syntax-rules (:)
[(_ id : x ...)
(define id
(get-ffi-obj (regexp-replaces 'id '((#rx"-" "_"))) liballegro (_fun x ...))
)]))
(define-syntax defallegro*
(syntax-rules ()
[(_ name : x ...) (begin (defallegro name : x ...) (provide name))]))
(define _fixed _int)
(define-cstruct _FONT
((data _pointer)
(height _int)
(vtable _pointer)))
(define-cstruct _BITMAP
((w _int)
(h _int)
(clip _int)
(cl _int)
(cr _int)
(ct _int)
(cb _int)
(vtable _pointer)
(write_bank _pointer)
(read_bank _pointer)
(dat _pointer)
(id _ulong)
(extra _pointer)
(x_ofs _int)
(y_ofs _int)
(seg _int)
(line _pointer)))
(provide BITMAP-w BITMAP-h)
(define-cstruct _SAMPLE
((bits _int)
(stereo _int)
(freq _int)
(priority _int)
(len _ulong)
(loop-start _ulong)
(loop-end _ulong)
(param _ulong)
(data _pointer)))
(define-cstruct _PALETTE
((hold _int)))
(define-cstruct _MATRIX
((data _bytes)))
(define-cstruct _RGB
((r _int8)
(g _int8)
(b _int8)
(filler _int8)))
(provide _RGB RGB-tag set-RGB-r! set-RGB-g! set-RGB-b! RGB-r RGB-g RGB-b)
(define (make-list num)
(let loop ((nums '())
(n 0))
(if (>= n num)
nums
(loop (cons 0 nums) (add1 n)))))
(define-cstruct _COLORMAP
((data _pointer)))
(define (make-COLORMAP*)
(let ((f (malloc _ubyte (* 256 256))))
(cpointer-push-tag! f COLORMAP-tag)
(set-COLORMAP-data! f f)
(set-COLORMAP-data! f (list->cblock (make-list (* 256 256)) _ubyte))
f)
(make-COLORMAP (list->cblock (make-list (* 256 256)) _ubyte)))
(define-cstruct _RGBMAP
((data _pointer)))
(define (make-RGBMAP*)
(let ((f (malloc _ubyte (* 32 32 32))))
(cpointer-push-tag! f RGBMAP-tag)
(set-RGBMAP-data! f (list->cblock (make-list (* 32 32 32)) _ubyte))
f)
(make-RGBMAP (list->cblock (make-list (* 32 32 32)) _ubyte)))
(define-cstruct _V3D_f
((hold _int)))
(define-cstruct _v3d
((x _float)
(y _float)
(z _float)
(u _float)
(v _float)
(c _int)))
(provide make-v3d _v3d v3d-x v3d-y v3d-z v3d-u v3d-v v3d-c)
(define PolyType
(_enum '(POLYTYPE-FLAT = 0
POLYTYPE-GCOL = 1
POLYTYPE-GRGB = 2
POLYTYPE-ATEX = 3
POLYTYPE-PTEX = 4
POLYTYPE-ATEX-MASK = 5
POLYTYPE-PTEX-MASK = 6
POLYTYPE-ATEX-LIT = 7
POLYTYPE-PTEX-LIT = 8
POLYTYPE-ATEX-MASK-LIT = 9
POLYTYPE-PTEX-MASK-LIT = 10
POLYTYPE-ATEX-TRANS = 11
POLYTYPE-PTEX-TRANS = 12
POLYTYPE-ATEX-MASK-TRANS = 13
POLYTYPE-PTEX-MASK-TRANS = 14
POLYTYPE-MAX = 15
POLYTYPE-ZBUF = 16)))
(provide ColorConversion)
(define ColorConversion
(_bitmask '(NONE = #x0000000
8-TO-15 = #x0000001
8-TO-16 = #x0000002
8-TO-24 = #x0000004
8-TO-32 = #x0000008
15-TO-8 = #x0000010
15-TO-16 = #x0000020
15-TO-24 = #x0000040
15-TO-32 = #x0000080
16-TO-8 = #x0000100
16-TO-15 = #x0000200
16-TO-24 = #x0000400
16-TO-32 = #x0000800
24-TO-8 = #x0001000
24-TO-15 = #x0002000
24-TO-16 = #x0004000
24-TO-32 = #x0008000
32-TO-8 = #x0010000
32-TO-15 = #x0020000
32-TO-16 = #x0040000
32-TO-24 = #x0080000
32A-TO-8 = #x0100000
32A-TO-15 = #x0200000
32A-TO-16 = #x0400000
32A-TO-24 = #x0800000
DITHER-PAL = #x1000000
DITHER-HI = #x2000000
KEEP-TRANS = #x4000000)))
(define DITHER (list 'DITHER-HI 'DITHER-PAL))
(provide DITHER)
(define EXPAND-256
'(8-TO-15
8-TO-16
8-TO-24
8-TO-32))
(define REDUCE-TO-256
'(15-TO-8
16-TO-8
24-TO-8
32-TO-8
32A-TO-8))
(define EXPAND-15-TO-16
'(15-TO-16))
(define REDUCE-16-TO-15
'(16-TO-15))
(define EXPAND-HI-TO-TRUE
'(15-TO-24
15-TO-32
16-TO-24
16-TO-32))
(define REDUCE-TRUE-TO-HI
'(24-TO-15
24-TO-16
32-TO-15
32-TO-16))
(define 24-EQUALS-32
'(24-TO-32
32-TO-24))
(provide TOTAL)
(define TOTAL
(append
EXPAND-256
REDUCE-TO-256
EXPAND-15-TO-16
REDUCE-16-TO-15
EXPAND-HI-TO-TRUE
REDUCE-TRUE-TO-HI
24-EQUALS-32
'(32A-TO-15
32A-TO-16
32A-TO-24)))
(define PARTIAL
'(EXPAND-15-TO-16
REDUCE-16-TO-15
24-EQUALS-32))
(define MOST
'(EXPAND-15-TO-16
REDUCE-16-TO-15
EXPAND-HI-TO-TRUE
REDUCE-TRUE-TO-HI
24-EQUALS-32))
(define COLORCONV_KEEP_ALPHA
'(COLORCONV_TOTAL
& ~(COLORCONV_32A_TO_8
COLORCONV_32A_TO_15
COLORCONV_32A_TO_16
COLORCONV_32A_TO_24)))
(define Gfx-Mode
(_enum '(TEXT = -1
AUTO = 0
FULLSCREEN = 1
WINDOWED = 2
SAFE 1396786757)))
(define SwitchMode
(_enum '(NONE = 0
PAUSE = 1
AMNESIA = 2
BACKGROUND = 3
BACKAMNESIA = 4)))
(provide Sound-Mode)
(define Sound-Mode
(_enum '(AUTODETECT = -1
NONE = 0)))
(provide Midi-Mode)
(define Midi-Mode
(_enum '(AUTODETECT = -1
NONE = 0)))
(provide mask-color)
(define (mask-color)
(makecol 255 0 255))
(defallegro -install-allegro :
(_int = 0) (_pointer = #f) (_pointer = #f) -> _int)
(define (install-allegro)
(-install-allegro))
(provide install-allegro)
(provide desktop-palette palette-color
color-map rgb-map default-font
screen mouse-y mouse-x mouse-b)
(provide screen mouse-y mouse-x mouse-b default-font key-shifts)
(define (allegro-parameter name type)
(make-c-parameter name liballegro type))
(define desktop-palette (ffi-obj-ref "desktop_palette" liballegro))
(define palette-color (allegro-parameter "palette_color" _pointer))
(define rgb-map (let ((f (malloc _RGBMAP (* 32 32 32))))
(cpointer-push-tag! f RGBMAP-tag)
(set-RGBMAP-data! f f)
(set-ffi-obj! "rgb_map" liballegro _RGBMAP-pointer f)
f))
(define color-map (let ((f (malloc _ubyte 'raw (* 256 256))))
(cpointer-push-tag! f COLORMAP-tag)
(set-COLORMAP-data! f f)
(set-ffi-obj! "color_map" liballegro _COLORMAP-pointer f)
f))
(define memcpy
(case (system-type)
((windows) (lambda (dest src bytes)
(let loop ((pos 0))
(when (< pos bytes)
(ptr-set! dest _byte pos (ptr-ref src _byte))
(loop (add1 pos))))))
((unix macosx) (get-ffi-obj "memcpy" #f
(_fun _pointer _pointer _int -> _pointer)))))
(provide set-rgb-map!)
(define (set-rgb-map! new)
(memcpy rgb-map new (* 32 32 32)))
(provide set-color-map!)
(define (set-color-map! new)
(memcpy color-map new (* 256 256)))
(define KeyShifts
(_bitmask '(shift = #x0001
ctrl = #x0002
alt = #x0004
lwin = #x0008
rwin = #x0010
menu = #x0020
command = #x0040
scrolock = #x0100
numlock = #x0200
capslock = #x0400
inaltseq = #x0800
accent1 = #x1000
accent2 = #x2000
accent3 = #x4000
accent4 = #x8000)
_int))
(define default-font (allegro-parameter "font" _FONT-pointer))
(define screen (allegro-parameter "screen" _BITMAP-pointer))
(define key-shifts (allegro-parameter "key_shifts" KeyShifts))
(define mouse-x (allegro-parameter "mouse_x" _int))
(define mouse-y (allegro-parameter "mouse_y" _int))
(define mouse-b (allegro-parameter "mouse_b" _int))
(define key-list
'([A 1] [B 2] [C 3] [D 4] [E 5] [F 6] [G 7] [H 8] [I 9] [J 10] [K 11]
[L 12] [M 13] [N 14] [O 15] [P 16] [Q 17] [R 18] [S 19] [T 20] [U 21]
[V 22] [W 23] [X 24] [Y 25] [Z 26] [NUM-0 27] [NUM-1 28] [NUM-2 29]
[NUM-3 30] [NUM-4 31] [NUM-5 32] [NUM-6 33] [NUM-7 34] [NUM-8 35]
[NUM-9 36] [PAD-0 37] [PAD-1 38] [PAD-2 39] [PAD-3 40] [PAD-4 41]
[PAD-5 42] [PAD-6 43] [PAD-7 44] [PAD-8 45] [PAD-9 46] [F1 47]
[F2 48] [F3 49] [F4 50] [F5 51] [F6 52] [F7 53] [F8 54] [F9 55]
[F10 56] [F11 57] [F12 58] [ESC 59] [TILDE 60]
[MINUS 61] [EQUALS 62] [BACKSPACE 63] [TAB 64] [OPENBRACE 65]
[CLOSEBRACE 66] [ENTER 67] [COLON 68] [QUOTE 69] [BACKSLASH 70]
[BACKSLASH2 71] [COMMA 72] [STOP 73] [SLASH 74] [SPACE 75] [INSERT 76]
[DEL 77] [HOME 78] [END 79] [PGUP 80] [PGDN 81] [LEFT 82] [RIGHT 83]
[UP 84] [DOWN 85] [SLASH_PAD 86] [ASTERISK 87] [MINUS_PAD 88]
[PLUS_PAD 89] [DEL_PAD 90] [ENTER_PAD 91] [PRTSCR 92] [PAUSE 93]
[ABNT_C1 94] [YEN 95] [KANA 96] [CONVERT 97] [NOCONVERT 98] [AT 99]
[CIRCUMFLEX 100] [COLON2 101] [KANJI 102]
[EQUALS_PAD 103] [BACKQUOTE 104] [SEMICOLON 105] [COMMAND 106] [UNKNOWN1 107]
[UNKNOWN2 108]
[UNKNOWN3 109]
[UNKNOWN4 110]
[UNKNOWN5 111]
[UNKNOWN6 112]
[UNKNOWN7 113]
[UNKNOWN8 114]
[MODIFIERS 115]
[LSHIFT 115]
[RSHIFT 116]
[LCONTROL 117]
[RCONTROL 118]
[ALT 119]
[ALTGR 120]
[LWIN 121]
[RWIN 122]
[MENU 123]
[SCRLOCK 124]
[NUMLOCK 125]
[CAPSLOCK 126]
[MAX 127]))
(define Key
(let ((codes (make-hash-table)))
(for-each
(lambda (pair)
(hash-table-put! codes (car pair) (cadr pair))
(hash-table-put! codes (cadr pair) (car pair)))
key-list)
(make-ctype _int
(lambda (sym)
(arithmetic-shift (hash-table-get codes sym) 8))
(lambda (num)
(hash-table-get codes (arithmetic-shift num -8))))))
(define key-array
(let ([keys (ffi-obj-ref "key" liballegro)]
[codes (make-hash-table)])
(for-each
(lambda (pair) (hash-table-put! codes (car pair) (cadr pair)))
key-list)
(lambda (key)
(not (zero? (ptr-ref keys _byte (hash-table-get codes key)))))))
(provide key-array)
(define key-shifts
(make-c-parameter "key_shifts" liballegro _int))
(provide key-shifts)
(defallegro* allegro-exit : -> _void)
(defallegro* loadpng-init : -> _int)
(defallegro* get-mouse-mickeys :
(x : (_ptr o _int))
(y : (_ptr o _int))
-> _void
-> (values x y))
(defallegro* install-keyboard : -> _int)
(defallegro remove-keyboard : -> _void)
(defallegro poll-keyboard : -> _int)
(defallegro keyboard-needs-poll : -> _int)
(defallegro* keypressed : -> _bool)
(defallegro* readkey : -> Key)
(defallegro ureadkey : _pointer -> _int)
(defallegro* simulate-keypress : Key -> _void)
(defallegro simulate-ukeypress : _int _int -> _void)
(defallegro* clear-keybuf : -> _void)
(defallegro set-leds : _int -> _void)
(defallegro set-keyboard-rate :
_int _int -> _void)
(defallegro scancode-to-ascii :
_int -> _int)
(defallegro scancode-to-name :
_int -> _string)
(defallegro* bitmap-mask-color :
_BITMAP-pointer -> _int)
(defallegro* install-mouse : -> _int)
(defallegro remove-mouse : -> _int)
(defallegro* getpixel :
_BITMAP-pointer _int _int -> _int)
(defallegro* putpixel :
_BITMAP-pointer _int _int _int -> _void)
(defallegro -allegro-vline :
_BITMAP-pointer _int _int _int _int -> _void)
(defallegro -allegro-hline :
_BITMAP-pointer _int _int _int _int -> _void)
(defallegro* line :
_BITMAP-pointer _int _int _int _int _int -> _void)
(defallegro* fastline :
_BITMAP-pointer _int _int _int _int _int -> _void)
(defallegro* rectfill :
_BITMAP-pointer _int _int _int _int _int -> _void)
(defallegro* triangle :
_BITMAP-pointer _int _int _int _int _int _int _int -> _void)
(defallegro* polygon :
_BITMAP-pointer _int _pointer _int -> _void)
(defallegro* rect :
_BITMAP-pointer _int _int _int _int _int -> _void)
(defallegro* circle :
_BITMAP-pointer _int _int _int _int -> _void)
(defallegro* circlefill :
_BITMAP-pointer _int _int _int _int -> _void)
(defallegro* ellipse :
_BITMAP-pointer _int _int _int _int _int -> _void)
(defallegro* ellipsefill :
_BITMAP-pointer _int _int _int _int _int -> _void)
(defallegro* arc :
_BITMAP-pointer _int _int _fixed _fixed _int _int -> _void)
(defallegro* spline :
_BITMAP-pointer _pointer -> _void)
(defallegro* floodfill :
_BITMAP-pointer _int _int _int -> _void)
(defallegro polygon3d :
_BITMAP-pointer _int _BITMAP-pointer _int _v3d-pointer -> _void)
(provide (rename polygon3d-f polygon3d))
(defallegro* polygon3d-f :
_BITMAP-pointer PolyType _BITMAP-pointer _int _v3d-pointer -> _void)
(defallegro triangle3d :
_BITMAP-pointer _int _BITMAP-pointer _v3d-pointer _v3d-pointer _v3d-pointer -> _void)
(provide (rename triangle3d-f triangle3d))
(defallegro triangle3d-f :
_BITMAP-pointer PolyType _BITMAP-pointer _v3d-pointer _v3d-pointer _v3d-pointer -> _void)
(defallegro* set-projection-viewport :
_int _int _int _int -> _void)
(defallegro quad3d :
_BITMAP-pointer _int _BITMAP-pointer _v3d-pointer _v3d-pointer _v3d-pointer _v3d-pointer -> _void)
(provide (rename polygon-z-normal-f polygon-z-normal))
(defallegro polygon-z-normal-f :
_v3d-pointer _v3d-pointer _v3d-pointer -> _float)
(provide (rename quad3d-f quad3d))
(defallegro quad3d-f :
_BITMAP-pointer PolyType _BITMAP-pointer _v3d-pointer _v3d-pointer _v3d-pointer _v3d-pointer -> _void)
(defallegro* draw-sprite :
_BITMAP-pointer _BITMAP-pointer _int _int -> _void)
(defallegro* draw-sprite-v-flip :
_BITMAP-pointer _BITMAP-pointer _int _int -> _void)
(defallegro* draw-sprite-h-flip :
_BITMAP-pointer _BITMAP-pointer _int _int -> _void)
(defallegro* draw-sprite-vh-flip :
_BITMAP-pointer _BITMAP-pointer _int _int -> _void)
(defallegro* draw-trans-sprite :
_BITMAP-pointer _BITMAP-pointer _int _int -> _void)
(defallegro* draw-lit-sprite :
_BITMAP-pointer _BITMAP-pointer _int _int _int -> _void)
(defallegro* draw-gouraud-sprite :
_BITMAP-pointer _BITMAP-pointer _int _int _int _int _int _int -> _void)
(defallegro* draw-character-ex :
_BITMAP-pointer _BITMAP-pointer _int _int _int _int -> _void)
(defallegro* rotate-sprite :
_BITMAP-pointer _BITMAP-pointer _int _int _fixed -> _void)
(defallegro* rotate-sprite-v-flip :
_BITMAP-pointer _BITMAP-pointer _int _int _fixed -> _void)
(defallegro* rotate-scaled-sprite :
_BITMAP-pointer _BITMAP-pointer _int _int _fixed _fixed -> _void)
(defallegro* rotate-scaled-sprite-v-flip :
_BITMAP-pointer _BITMAP-pointer _int _int _fixed _fixed -> _void)
(defallegro* pivot-sprite :
_BITMAP-pointer _BITMAP-pointer _int _int _int _int _fixed -> _void)
(defallegro* pivot-sprite-v-flip :
_BITMAP-pointer _BITMAP-pointer _int _int _int _int _fixed -> _void)
(defallegro* pivot-scaled-sprite :
_BITMAP-pointer _BITMAP-pointer _int _int _int _int _fixed _fixed -> _void)
(defallegro* pivot-scaled-sprite-v-flip :
_BITMAP-pointer _BITMAP-pointer _int _int _int _int _fixed _fixed -> _void)
(defallegro* blit :
_BITMAP-pointer _BITMAP-pointer _int _int _int _int _int _int -> _void)
(defallegro* masked-blit :
_BITMAP-pointer _BITMAP-pointer _int _int _int _int _int _int -> _void)
(defallegro* stretch-blit :
_BITMAP-pointer _BITMAP-pointer _int _int _int _int _int _int _int _int -> _void)
(defallegro* masked-stretch-blit :
_BITMAP-pointer _BITMAP-pointer _int _int _int _int _int _int _int _int -> _void)
(defallegro* stretch-sprite :
_BITMAP-pointer _BITMAP-pointer _int _int _int _int -> _void)
(defallegro -putpixel :
_BITMAP-pointer _int _int _int -> _void)
(defallegro -getpixel :
_BITMAP-pointer _int _int -> _int)
(defallegro -putpixel15 :
_BITMAP-pointer _int _int _int -> _void)
(defallegro -getpixel15 : _BITMAP-pointer _int _int -> _int)
(defallegro -putpixel16 : _BITMAP-pointer _int _int _int -> _void)
(defallegro -getpixel16 : _BITMAP-pointer _int _int -> _int)
(defallegro -putpixel24 :
_BITMAP-pointer _int _int _int -> _void)
(defallegro -getpixel24 : _BITMAP-pointer _int _int -> _int)
(defallegro -putpixel32 : _BITMAP-pointer _int _int _int -> _void)
(defallegro -getpixel32 : _BITMAP-pointer _int _int -> _int)
(defallegro* bmp-unwrite-line : _BITMAP-pointer -> _void)
(defallegro* bmp-write-line : _BITMAP-pointer _int -> _pointer)
(defallegro* bmp-read-line : _BITMAP-pointer _int -> _pointer)
(defallegro destroy-gfx-mode-list : _pointer -> _void)
(defallegro* set-color-depth : _int -> _void)
(defallegro get-color-depth : -> _int)
(defallegro* set-color-conversion : ColorConversion -> _void)
(defallegro get-color-conversion : -> ColorConversion)
(defallegro request-refresh-rate : _int -> _void)
(defallegro get-refresh-rate : -> _int)
(defallegro* set-gfx-mode : Gfx-Mode _int _int _int _int -> _int)
(defallegro* set-display-switch-mode : SwitchMode -> _int)
(defallegro scroll-screen : _int _int -> _int)
(defallegro request-scroll : _int _int -> _int)
(defallegro poll-scroll : -> _int)
(defallegro show-video-bitmap : _BITMAP-pointer -> _int)
(defallegro request-video-bitmap : _BITMAP-pointer -> _int)
(defallegro enable-triple-buffer : -> _int)
(defallegro* create-bitmap : _int _int -> _BITMAP-pointer)
(defallegro* create-bitmap-ex : _int _int _int -> _BITMAP-pointer)
(defallegro* create-sub-bitmap :
_BITMAP-pointer _int _int _int _int -> _BITMAP-pointer)
(defallegro create-video-bitmap : _int _int -> _BITMAP-pointer)
(defallegro create-system-bitmap : _int _int -> _BITMAP-pointer)
(defallegro* destroy-bitmap : _BITMAP-pointer -> _void)
(defallegro* load-bitmap : _string _RGB-pointer/null -> _BITMAP-pointer/null)
(defallegro* save-bitmap : _string _BITMAP-pointer _RGB-pointer/null -> _int)
(defallegro set-clip-rect :
_BITMAP-pointer _int _int _int _int -> _void)
(defallegro add-clip-rect :
_BITMAP-pointer _int _int _int _int -> _void)
(defallegro* clear-bitmap : _BITMAP-pointer -> _void)
(defallegro* clear-to-color : _BITMAP-pointer _int -> _void)
(defallegro* acquire-screen : -> _void)
(defallegro* release-screen : -> _void)
(defallegro vsync : -> _void)
(defallegro set-color :
_int _RGB-pointer -> _void)
(defallegro* set-palette :
_RGB-pointer -> _void)
(defallegro set-palette-range :
_RGB-pointer _int _int _int -> _void)
(defallegro get-color :
_int _RGB-pointer -> _void)
(defallegro* get-palette :
_RGB-pointer -> _void)
(defallegro get-palette-range :
_PALETTE-pointer _int _int -> _void)
(defallegro fade-interpolate :
_PALETTE-pointer _PALETTE-pointer _PALETTE-pointer _int _int _int -> _void)
(defallegro fade-from-range :
_PALETTE-pointer _PALETTE-pointer _int _int _int -> _void)
(defallegro fade-in-range :
_PALETTE-pointer _int _int _int -> _void)
(defallegro fade-out-range :
_int _int _int -> _void)
(defallegro fade-from :
_PALETTE-pointer _PALETTE-pointer _int -> _void)
(defallegro fade-in :
_PALETTE-pointer _int -> _void)
(defallegro fade-out :
_int -> _void)
(defallegro select-palette :
_PALETTE-pointer -> _void)
(defallegro unselect-palette : -> _void)
(defallegro generate-332-palette :
_PALETTE-pointer -> _void)
(defallegro generate-optimized-palette :
_BITMAP-pointer _PALETTE-pointer _pointer -> _int)
(defallegro create-rgb-table :
_RGBMAP-pointer _RGB-pointer _pointer -> _void)
(provide (rename create-rgb-table- create-rgb-table))
(define (create-rgb-table- pal)
(let ((rgb (make-RGBMAP*)))
(create-rgb-table rgb pal #f)
rgb))
(defallegro create-light-table :
_COLORMAP-pointer _RGB-pointer _int _int _int _pointer -> _void)
(provide (rename create-light-table- create-light-table))
(define (create-light-table- pal r g b)
(let ((map (make-COLORMAP*)))
(create-light-table map pal r g b #f)
map))
(defallegro create-trans-table :
_int -> _void)
(defallegro create-color-table :
_int -> _void)
(defallegro create-blender-table :
_int -> _void)
(defallegro set-blender-mode :
_BLENDER_FUNC _BLENDER_FUNC _BLENDER_FUNC _int _int _int _int -> _void)
(defallegro set-blender-mode-ex :
_BLENDER_FUNC _BLENDER_FUNC _BLENDER_FUNC _BLENDER_FUNC _BLENDER_FUNC _BLENDER_FUNC _BLENDER_FUNC _int _int _int _int -> _void)
(defallegro* set-alpha-blender : -> _void)
(defallegro* set-write-alpha-blender : -> _void)
(defallegro* set-trans-blender :
_int _int _int _int -> _void)
(defallegro* set-add-blender :
_int _int _int _int -> _void)
(defallegro* set-burn-blender :
_int _int _int _int -> _void)
(defallegro* set-color-blender :
_int _int _int _int -> _void)
(defallegro* set-difference-blender :
_int _int _int _int -> _void)
(defallegro* set-dissolve-blender :
_int _int _int _int -> _void)
(defallegro* set-dodge-blender :
_int _int _int _int -> _void)
(defallegro* set-hue-blender :
_int _int _int _int -> _void)
(defallegro* set-invert-blender :
_int _int _int _int -> _void)
(defallegro* set-luminance-blender :
_int _int _int _int -> _void)
(defallegro* set-multiply-blender :
_int _int _int _int -> _void)
(defallegro* set-saturation-blender :
_int _int _int _int -> _void)
(defallegro* set-screen-blender :
_int _int _int _int -> _void)
(defallegro hsv-to-rgb :
_float _float _float _pointer _pointer _pointer -> _void)
(defallegro rgb-to-hsv :
_int _int _int _pointer _pointer _pointer -> _void)
(defallegro bestfit-color :
_PALETTE-pointer _int _int _int -> _int)
(defallegro* makecol :
_int _int _int -> _int)
(defallegro makecol8 :
_int _int _int -> _int)
(defallegro makecol-depth :
_int _int _int _int -> _int)
(defallegro makeacol :
_int _int _int _int -> _int)
(defallegro makeacol-depth :
_int _int _int _int _int -> _int)
(defallegro makecol15-dither :
_int _int _int _int _int -> _int)
(defallegro makecol16-dither :
_int _int _int _int _int -> _int)
(defallegro* getr : _int -> _int)
(defallegro* getg : _int -> _int)
(defallegro* getb : _int -> _int)
(defallegro* geta : _int -> _int)
(defallegro getr-depth :
_int _int -> _int)
(defallegro getg-depth :
_int _int -> _int)
(defallegro getb-depth :
_int _int -> _int)
(defallegro geta-depth :
_int _int -> _int)
(defallegro reserve-voices :
_int _int -> _void)
(defallegro set-volume-per-voice :
_int -> _void)
(defallegro* install-sound : Sound-Mode Midi-Mode _string -> _int)
(defallegro remove-sound : -> _void)
(defallegro install-sound-input :
_int _int -> _int)
(defallegro remove-sound-input : -> _void)
(defallegro set-volume :
_int _int -> _void)
(defallegro set-hardware-volume :
_int _int -> _void)
(defallegro set-mixer-quality :
_int -> _void)
(defallegro get-mixer-quality : -> _int)
(defallegro get-mixer-frequency : -> _int)
(defallegro get-mixer-bits : -> _int)
(defallegro get-mixer-channels : -> _int)
(defallegro get-mixer-voices : -> _int)
(defallegro get-mixer-buffer-length : -> _int)
(defallegro detect-digi-driver :
_int -> _int)
(defallegro* load-sample :
_string -> _SAMPLE-pointer/null)
(defallegro load-wav :
_string -> _SAMPLE-pointer/null)
(defallegro load-wav-pf :
_pointer -> _SAMPLE-pointer)
(defallegro load-voc :
_string -> _SAMPLE-pointer)
(defallegro load-voc-pf :
_pointer -> _SAMPLE-pointer)
(defallegro save-sample :
_string _SAMPLE-pointer -> _int)
(defallegro create-sample :
_int _int _int _int -> _SAMPLE-pointer)
(defallegro destroy-sample :
_SAMPLE-pointer -> _void)
(defallegro* play-sample :
_SAMPLE-pointer _int _int _int _int -> _int)
(defallegro* stop-sample :
_SAMPLE-pointer -> _void)
(defallegro adjust-sample :
_SAMPLE-pointer _int _int _int _int -> _void)
(defallegro allocate-voice :
_SAMPLE-pointer -> _int)
(defallegro deallocate-voice :
_int -> _void)
(defallegro reallocate-voice :
_int _SAMPLE-pointer -> _void)
(defallegro release-voice :
_int -> _void)
(defallegro voice-start :
_int -> _void)
(defallegro voice-stop :
_int -> _void)
(defallegro voice-set-priority :
_int _int -> _void)
(defallegro voice-check :
_int -> _SAMPLE-pointer)
(defallegro voice-set-playmode :
_int _int -> _void)
(defallegro voice-get-position :
_int -> _int)
(defallegro voice-set-position :
_int _int -> _void)
(defallegro voice-get-volume :
_int -> _int)
(defallegro voice-set-volume :
_int _int -> _void)
(defallegro voice-ramp-volume :
_int _int _int -> _void)
(defallegro voice-stop-volumeramp :
_int -> _void)
(defallegro voice-get-frequency :
_int -> _int)
(defallegro voice-set-frequency :
_int _int -> _void)
(defallegro voice-sweep-frequency :
_int _int _int -> _void)
(defallegro voice-stop-frequency-sweep :
_int -> _void)
(defallegro voice-get-pan :
_int -> _int)
(defallegro voice-set-pan :
_int _int -> _void)
(defallegro voice-sweep-pan :
_int _int _int -> _void)
(defallegro voice-stop-pan-sweep :
_int -> _void)
(defallegro voice-set-echo :
_int _int _int -> _void)
(defallegro voice-set-tremolo :
_int _int _int -> _void)
(defallegro voice-set-vibrato :
_int _int _int -> _void)
(defallegro get-sound-input-cap-bits : -> _int)
(defallegro get-sound-input-cap-stereo : -> _int)
(defallegro get-sound-input-cap-rate :
_int _int -> _int)
(defallegro get-sound-input-cap-parm :
_int _int _int -> _int)
(defallegro set-sound-input-source :
_int -> _int)
(defallegro start-sound-input :
_int _int _int -> _int)
(defallegro stop-sound-input : -> _void)
(defallegro read-sound-input :
_pointer -> _int)
(defallegro lock-sample :
_SAMPLE-pointer -> _void)
(defallegro get-transformation-matrix-f :
_MATRIX-pointer _float _float _float
_float _float _float _float -> _void)
(provide get-transformation-matrix)
(define (get-transformation-matrix scale xrot yrot zrot x y z)
(let ((m (malloc _MATRIX (* 9 (ctype-sizeof _float)))))
(cpointer-push-tag! m MATRIX-tag)
(get-transformation-matrix-f m scale
(+ xrot 0.0)
(+ yrot 0.0)
(+ zrot 0.0)
(+ x 0.0)
(+ y 0.0)
(+ z 0.0))
m))
(provide apply-matrix)
(define (apply-matrix matrix x y z)
(apply-matrix-f matrix (+ x 0.0) (+ y 0.0) (+ z 0.0)))
(defallegro apply-matrix-f :
_MATRIX-pointer _float _float _float
(x : (_ptr o _float))
(y : (_ptr o _float))
(z : (_ptr o _float))
-> _void
-> (values x y z))
(provide persp-project)
(define (persp-project x y z)
(persp-project-f (+ x 0.0) (+ y 0.0) (+ z 0.0)))
(defallegro persp-project-f :
_float _float _float
(x : (_ptr o _float))
(y : (_ptr o _float))
-> _void
-> (values x y))
(define-syntax textfunction
(syntax-rules ()
[(_ id)
(defallegro* id :
_BITMAP-pointer _FONT-pointer _string _int _int _int _int -> _void)]))
(textfunction textout-ex)
(textfunction textout-centre-ex)
(textfunction textout-right-ex)
(textfunction textout-justify-ex)
)