=head1 NAME

SDL - Parrot extension for SDL bindings

=head1 SYNOPSIS

None.

You probably shouldn't use this library directly, unless you're writing your
own wrappers around the SDL NCI code or if you're calling the NCI functions
directly.

In that case, I'm perfectly happy saying "Hey buddy, you're on your own!"

=head1 DESCRIPTION

This is the library that contains all of the actual NCI bindings and Parrot
data structure definitions to work with SDL from Parrot.  Normal people, run
away to L<SDL::App> right now instead.  This is pretty low-level stuff and you
shouldn't have to use it or even know that it's here if you want to work with
SDL from Parrot.

On the other hand, if you want to use these functions directly, write your own
wrappers, or add wrappers that aren't already here, you should know how it
works.

=head2 The SDL Namespace

The C<SDL> namespace holds only a few functions right now, initializers for
various libraries.  These load the PASM code that actually creates the SDL NCI
bindings and initialize all of the SDL-specific data structures needed to
access structs passed to and returned from SDL calls.  There's no need to load
sound components if you don't have sound installed, for example.

Each struct layout has its own function that creates and stores the appropriate
data structure.  The order of calling really matters here, as some structs
contain other structs.

When you load this file with C<load_bytecode>, it initializes the C<SDL_video>
subsystem.  You'll have to use the appropriate IMC modules or initialize the
other subsystems manually.

The subsystem initalizers include:

=over 4

=cut

.namespace [ 'SDL' ]

.macro store_nci_func( func_name, signature )
	c_func_name = prefix . .func_name
	dlfunc c_function, libsdl, c_func_name, .signature
	store_global namespace, .func_name, c_function
.endm

.sub _sdl_init :load
	_init_video()

	.local pmc layouts
	layouts = new OrderedHash
	store_global 'SDL::NCI', 'layouts', layouts

	# this order matters; trust me!
	_set_Event_layout(        layouts )
	_set_Rect_layout(         layouts )
	_set_Rect_Array_layout(   layouts )
	_set_Color_layout(        layouts )
	_set_Palette_layout(      layouts )
	_set_PixelFormat_layout(  layouts )
	_set_Pixels_layout(       layouts )
	_set_Surface_layout(      layouts )

.end

=item _init_video()

Initialize the video subsystem.  You shouldn't ever need to call this directly.
In fact, don't count on it sticking around.  It may not.  Then again, it might.

=cut

.sub _init_video
	.local pmc libsdl
	.local pmc sdl_function

	loadlib libsdl, 'libSDL'
	$I0 = typeof libsdl
	if $I0 != .Undef goto OK
	
	# second try
	loadlib libsdl, 'libSDL-1.2'
	$I0 = typeof libsdl
	if $I0 != .Undef goto OK_HINT1

	# third try
	loadlib libsdl, 'libSDL-1.2.so.0'
	$I0 = typeof libsdl
	if $I0 != .Undef goto OK_HINT2
	
	# failed to load libSDL
	$P0 = new Exception
	$P0["_message"] = "libSDL not found!"
	throw $P0
	branch OK
OK_HINT1:
	printerr "Hint: create a link from libSDL-1.2.so to libSDL.so to disable the error messages.\n"
	branch OK
OK_HINT2:
	printerr "Hint: create a link from libSDL-1.2.so.0 to libSDL_image.so to disable the error messages.\n"
OK:
	.local string namespace
	namespace = 'SDL::NCI'

	.local string prefix
	prefix    = 'SDL_'

	.local string c_func_name
	.local pmc    c_function

	.store_nci_func( 'Init', 'ii' )

#	dlfunc sdl_function, libsdl, 'SDL_Init', 'ii'
#	store_global 'SDL::NCI', 'Init', sdl_function
	dlfunc sdl_function, libsdl, 'SDL_SetVideoMode', 'piiil'
	store_global 'SDL::NCI', 'SetVideoMode', sdl_function
	dlfunc sdl_function, libsdl, 'SDL_Quit', 'v'
	store_global 'SDL::NCI', 'Quit', sdl_function
	dlfunc sdl_function, libsdl, 'SDL_FillRect', 'ippi'
	store_global 'SDL::NCI', 'FillRect', sdl_function
	dlfunc sdl_function, libsdl, 'SDL_UpdateRect', 'vpiiii'
	store_global 'SDL::NCI', 'UpdateRect', sdl_function
	dlfunc sdl_function, libsdl, 'SDL_UpdateRects', 'vpip'
	store_global 'SDL::NCI', 'UpdateRects', sdl_function
	dlfunc sdl_function, libsdl, 'SDL_Flip', 'ip'
	store_global 'SDL::NCI', 'Flip', sdl_function
	dlfunc sdl_function, libsdl, 'SDL_FreeSurface', 'vp'
	store_global 'SDL::NCI', 'FreeSurface', sdl_function
	dlfunc sdl_function, libsdl, 'SDL_LoadBMP_RW', 'ppi'
	store_global 'SDL::NCI', 'LoadBMP_RW', sdl_function
	dlfunc sdl_function, libsdl, 'SDL_DisplayFormat', 'pp'
	store_global 'SDL::NCI', 'DisplayFormat', sdl_function
	dlfunc sdl_function, libsdl, 'SDL_UpperBlit', 'ipppp'
	store_global 'SDL::NCI', 'BlitSurface', sdl_function
	dlfunc sdl_function, libsdl, 'SDL_WaitEvent', 'ip'
	store_global 'SDL::NCI', 'WaitEvent', sdl_function
	dlfunc sdl_function, libsdl, 'SDL_PollEvent', 'ip'
	store_global 'SDL::NCI', 'PollEvent', sdl_function
	dlfunc sdl_function, libsdl, 'SDL_GetKeyName', 'ti'
	store_global 'SDL::NCI', 'GetKeyName', sdl_function
	dlfunc sdl_function, libsdl, 'SDL_GetError', 'tv'
	store_global 'SDL::NCI', 'GetError', sdl_function
	dlfunc sdl_function, libsdl, 'SDL_SetColorKey', 'ipii'
	store_global 'SDL::NCI', 'SetColorKey', sdl_function
	dlfunc sdl_function, libsdl, 'SDL_LockSurface', 'ip'
	store_global 'SDL::NCI', 'LockSurface', sdl_function
	dlfunc sdl_function, libsdl, 'SDL_UnlockSurface', 'vp'
	store_global 'SDL::NCI', 'UnlockSurface', sdl_function
	dlfunc sdl_function, libsdl, 'SDL_CreateRGBSurface', 'piiiiiiii'
	store_global 'SDL::NCI', 'CreateRGBSurface', sdl_function
.end

=item _init_image()

Initialize the C<SDL_image> subsystem.  If you don't have the appropriate
library installed, this won't work very well.  You'll probably want to use the
SDL::Image library anyway, which calls this for you.

=cut

.sub _init_image
	.local pmc image_lib
	.local pmc nci_sub

	loadlib image_lib, 'libSDL_image'
	$I0 = typeof image_lib
	if $I0 != .Undef goto OK

	loadlib image_lib, 'libSDL_image-1.2'
	$I0 = typeof image_lib
	if $I0 != .Undef goto OK_HINT1

	loadlib image_lib, 'libSDL_image-1.2.so.0'
	$I0 = typeof image_lib
	if $I0 != .Undef goto OK_HINT2

	# failed to load libSDL
	$P0 = new Exception
	$P0["_message"] = "libSDL_image not found!"
	throw $P0
	branch OK
OK_HINT1:
	printerr "Hint: create a link from libSDL_image-1.2.so to libSDL_image.so to disable the error messages.\n"
	branch OK
OK_HINT2:
	printerr "Hint: create a link from libSDL_image-1.2.so.0 to libSDL_image.so to disable the error messages.\n"
OK:
	dlfunc nci_sub, image_lib, 'IMG_Load', 'pt'
	store_global 'SDL::NCI', 'IMG_Load', nci_sub
.end

=item _init_ttf()

Initialize the C<SDL_ttf> subsystem.  If you don't have the appropriate
library installed, this won't work very well.  You'll probably want to use the
SDL::Font library anyway, which calls this for you.

=back

=cut

.sub _init_ttf
	.local pmc ttf_lib
	.local pmc nci_sub

	loadlib ttf_lib, 'libSDL_ttf'
	dlfunc nci_sub, ttf_lib, 'TTF_Init', 'iv'
	store_global 'SDL::NCI::TTF', 'Init', nci_sub
	
	.local int initialized
	initialized = nci_sub()

	if initialized goto error
	goto success

	# XXX: wow, this is unspectacular error handling!
error:
	print "SDL_ttf not initialized\n"
	end

success:

	dlfunc nci_sub, ttf_lib, 'TTF_OpenFont', 'pti'
	store_global 'SDL::NCI::TTF', 'OpenFont', nci_sub

	dlfunc nci_sub, ttf_lib, 'TTF_RenderText_Solid', 'pptp'
	store_global 'SDL::NCI::TTF', 'RenderText_Solid', nci_sub
	dlfunc nci_sub, ttf_lib, 'TTF_RenderUTF8_Solid', 'pptp'
	store_global 'SDL::NCI::TTF', 'RenderUTF8_Solid', nci_sub

	# this one could be wrong
	dlfunc nci_sub, ttf_lib, 'TTF_RenderUNICODE_Solid', 'pptp'
	store_global 'SDL::NCI::TTF', 'RenderUNICODE_Solid', nci_sub

	dlfunc nci_sub, ttf_lib, 'TTF_SizeText', 'ipt33'
	store_global 'SDL::NCI::TTF', 'SizeText', nci_sub
	dlfunc nci_sub, ttf_lib, 'TTF_SizeUTF8', 'ipt33'
	store_global 'SDL::NCI::TTF', 'SizeUTF8', nci_sub
	dlfunc nci_sub, ttf_lib, 'TTF_SizeUNICODE', 'ipt33'
	store_global 'SDL::NCI::TTF', 'SizeUNICODE', nci_sub

	dlfunc nci_sub, ttf_lib, 'TTF_CloseFont', 'vp'
	store_global 'SDL::NCI::TTF', 'CloseFont', nci_sub
	dlfunc nci_sub, ttf_lib, 'TTF_Quit', 'vv'
	store_global 'SDL::NCI::TTF', 'Quit', nci_sub
	dlfunc nci_sub, ttf_lib, 'TTF_WasInit', 'iv'
	store_global 'SDL::NCI::TTF', 'WasInit', nci_sub
.end

.sub _set_Event_layout
	.param pmc layouts

	.local pmc layout
	layout = new OrderedHash

	# this is the only element in common in the SDL_Event union
	set  layout[ 'type' ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'pad0' ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'pad1' ], .DATATYPE_UINT16
	push layout, 0
	push layout, 0
	set  layout[ 'pad2' ], .DATATYPE_UINT32
	push layout, 0
	push layout, 0
	set  layout[ 'pad3' ], .DATATYPE_UINT32
	push layout, 0
	push layout, 0
	set  layout[ 'pad4' ], .DATATYPE_UINT32
	push layout, 0
	push layout, 0
	set  layout[ 'pad5' ], .DATATYPE_UINT32
	push layout, 0
	push layout, 0

	set  layouts[ 'Event::Generic' ], layout

	# SDL_KeyboardEvent is the largest struct in the SDL_Event union
	layout = new OrderedHash
	set  layout[ 'type' ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'which' ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'state' ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'padding' ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'scancode' ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'padding_a' ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'padding_b' ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'padding_c' ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'sym' ], .DATATYPE_INT
	push layout, 0
	push layout, 0
	set  layout[ 'mod' ], .DATATYPE_INT
	push layout, 0
	push layout, 0
	set  layout[ 'unicode' ], .DATATYPE_UINT16
	push layout, 0
	push layout, 0

	set  layouts[ 'Event::Keyboard' ], layout

	# SDL_MouseMotionEvent
	layout = new OrderedHash
	set  layout[ 'type' ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'pad0' ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'state' ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'x' ], .DATATYPE_UINT16
	push layout, 0
	push layout, 0
	set  layout[ 'y' ], .DATATYPE_UINT16
	push layout, 0
	push layout, 0
	set  layout[ 'xrel' ], .DATATYPE_INT16
	push layout, 0
	push layout, 0
	set  layout[ 'yrel' ], .DATATYPE_INT16
	push layout, 0
	push layout, 0

	set  layouts[ 'Event::MouseMotion' ], layout

	# SDL_MouseButtonEvent
	layout = new OrderedHash
	set  layout[ 'type' ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'button' ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'state' ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'x' ], .DATATYPE_UINT16
	push layout, 0
	push layout, 0
	set  layout[ 'y' ], .DATATYPE_UINT16
	push layout, 0
	push layout, 0

	set  layouts[ 'Event::MouseButton' ], layout
.end

.sub _set_Rect_layout 
	.param pmc layouts
	.local pmc layout

	layout = new OrderedHash
	set  layout[ 'x' ],      .DATATYPE_INT16
	push layout, 0
	push layout, 0
	set  layout[ 'y' ],      .DATATYPE_INT16
	push layout, 0
	push layout, 0
	set  layout[ 'width' ],  .DATATYPE_UINT16
	push layout, 0
	push layout, 0
	set  layout[ 'height' ], .DATATYPE_UINT16
	push layout, 0
	push layout, 0

	set  layouts[ 'Rect' ], layout
.end

.sub _set_Rect_Array_layout 
	.param pmc layouts

	.local pmc fetch_struct
	fetch_struct = find_global 'SDL::NCI', 'fetch_struct'

	.local pmc rect
	rect   = fetch_struct( 'Rect', 0 )

	.local pmc layout
	layout = new OrderedHash

	set  layout[ 'RectArray' ], .DATATYPE_STRUCT

	set     $P1, layout[ -1 ]
	setprop $P1, '_struct', rect

	# this is wrong; you need to reset it
	push layout, 0
	push layout, 0

	set  layouts[ 'Rect_Array' ], layout
.end

.sub _set_Surface_layout
	.param pmc layouts

	.local pmc fetch_struct
	fetch_struct = find_global 'SDL::NCI', 'fetch_struct'

	# SDL_PixelFormat struct pointer
	.local pmc pixelformat
	pixelformat = fetch_struct( 'PixelFormat', 0 )

	# SDL_Rect struct
	.local pmc rect
	rect        = fetch_struct( 'Rect', 0 )

	# SDL_Pixels struct (workaround?)
	.local pmc pixels
	rect        = fetch_struct( 'Pixels', 0 )

	.local pmc layout
	layout = new OrderedHash
	set  layout[ 'flags' ], .DATATYPE_UINT32
	push layout, 0
	push layout, 0

	set  layout[ 'format' ], .DATATYPE_STRUCT_PTR

	# SDL_PixelFormat struct pointer
	.local pmc format_pointer
	set        format_pointer, layout[ -1 ]
	setprop    format_pointer, '_struct', pixelformat

	push layout, 0
	push layout, 0

	set  layout[ 'w' ],      .DATATYPE_INT
	push layout, 0
	push layout, 0
	set  layout[ 'h' ],      .DATATYPE_INT
	push layout, 0
	push layout, 0
	set  layout[ 'pitch' ],  .DATATYPE_UINT16
	push layout, 0
	push layout, 0

	.local pmc pixels_layout
	.local pmc pixels_array
	pixels_layout = new OrderedHash

	set  pixels_layout[ 'array' ], .DATATYPE_INT
	push pixels_layout, 0
	push pixels_layout, 0
	pixels_array  = new UnManagedStruct, pixels_layout

	set  layout[ 'pixels' ], .DATATYPE_STRUCT_PTR
	set        format_pointer, layout[ -1 ]
	setprop    format_pointer, '_struct', pixels_array

	push layout, 0
	push layout, 0
	set  layout[ 'offset' ], .DATATYPE_INT
	push layout, 0
	push layout, 0

	# private_hwdata struct pointer
	set  layout[ 'hwdata' ], .DATATYPE_PTR

	push layout, 0
	push layout, 0

	set layout[ 'clip_rect' ], .DATATYPE_STRUCT

	.local pmc rect_pointer
	set        rect_pointer, layout[ -1 ]
	setprop    rect_pointer, '_struct', rect

	push layout, 0
	push layout, 0

	set  layout[ 'unused1' ], .DATATYPE_UINT32
	push layout, 0
	push layout, 0
	set  layout[ 'locked' ], .DATATYPE_UINT32
	push layout, 0
	push layout, 0

	# SDL_BlitMap struct pointer
	set  layout[ 'map' ], .DATATYPE_PTR
	push layout, 0
	push layout, 0

	set  layout[ 'format_version' ], .DATATYPE_UINT
	push layout, 0
	push layout, 0
	set  layout[ 'refcount' ], .DATATYPE_INT
	push layout, 0
	push layout, 0

	set  layouts[ 'Surface' ], layout
.end

.sub _set_PixelFormat_layout
	.param pmc layouts

	.local pmc fetch_struct
	fetch_struct = find_global 'SDL::NCI', 'fetch_struct'

	.local pmc palette
	palette = fetch_struct( 'Palette', 0 )

	.local pmc layout
	layout = new OrderedHash
	set  layout[ 'palette' ], .DATATYPE_STRUCT_PTR

	.local pmc palette_pointer
	set        palette_pointer, layout[ -1 ]
	setprop    palette_pointer, '_struct', palette

	push layout, 0
	push layout, 0

	set  layout[ 'BitsPerPixel' ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'BytesPerPixel' ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'Rloss' ],         .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'Gloss' ],         .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'Bloss' ],         .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'Aloss' ],         .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'Rshift' ],        .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'Gshift' ],        .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'Bshift' ],        .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'Ashift' ],        .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'Rmask' ],         .DATATYPE_UINT32
	push layout, 0
	push layout, 0
	set  layout[ 'Gmask' ],         .DATATYPE_UINT32
	push layout, 0
	push layout, 0
	set  layout[ 'Bmask' ],         .DATATYPE_UINT32
	push layout, 0
	push layout, 0
	set  layout[ 'Amask' ],         .DATATYPE_UINT32
	push layout, 0
	push layout, 0
	set  layout[ 'colorkey' ],      .DATATYPE_UINT32
	push layout, 0
	push layout, 0
	set  layout[ 'alpha' ],         .DATATYPE_UINT8
	push layout, 0
	push layout, 0

	set  layouts[ 'PixelFormat' ], layout
.end

.sub _set_Palette_layout
	.param pmc layouts

	.local pmc fetch_struct
	fetch_struct = find_global 'SDL::NCI', 'fetch_struct'

	.local pmc color
	color  = fetch_struct( 'Color', 0 )

	.local pmc layout
	layout = new OrderedHash

	set  layout[ 'ncolors' ], .DATATYPE_INT
	push layout, 0
	push layout, 0
	set  layout[ 'colors' ],  .DATATYPE_STRUCT_PTR

	.local pmc color_pointer
	set        color_pointer, layout[ -1 ]
	setprop    color_pointer, '_struct', color

	push layout, 0
	push layout, 0

	set  layouts[ 'Palette' ], layout
.end

.sub _set_Color_layout
	.param pmc layouts

	.local pmc layout
	layout = new OrderedHash

	set  layout[ 'r'      ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'g'      ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'b'      ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0
	set  layout[ 'unused' ], .DATATYPE_UINT8
	push layout, 0
	push layout, 0

	set  layouts[ 'Color' ], layout
.end

.sub _set_Pixels_layout
	.param pmc layouts

	.local pmc layout
	layout = new OrderedHash
	push layout, .DATATYPE_UINT16
	push layout, 2
	push layout, 0

	set  layouts[ 'Pixels' ], layout
.end

=head2 The SDL::NCI Namespace

Besides all of the actual NCI subs, there's one additional subroutine in the
SDL::NCI namespace.

C<fetch_layout()> takes one argument, a string containing the name of the SDL_*
data structure layout PMC to return.  You can then C<assign> the layout to an
C<UnManagedStruct> or C<ManagedStruct> PMC to assign to and read from various
struct members.

Note that the name of the layout has the leading C<SDL_> prefix removed; to
fetch the layout for an C<SDL_Rect> struct, ask for C<Rect>.

This currently doesn't do much if you request an unknown layout.  Suggestions
welcome.

In addition to the various SDL data structures, this makes the following other layouts available:

=over

=item * Rect_Array

An array of SDL_Rect structs.  Use this for such things as passing multiple
rects to a surface update function, for example.  Note that you'll have to
update the element at index 1 with the proper count of the number of rects in
the array.

If this confuses you, see C<SDL::Surface::update_rects()> and imagine how I<I>
felt when I wrote it!

=back

=cut

.namespace [ 'SDL::NCI' ]

.sub fetch_struct
	.param string struct_name
	.param int    managed

	.local pmc initializer
	.local pmc struct

	.local pmc fetch_layout
	fetch_layout = find_global 'SDL::NCI', 'fetch_layout'
	initializer  = fetch_layout( struct_name )

	if managed == 1 goto build_managed
	struct       = new UnManagedStruct, initializer
	goto built_struct

build_managed:
	struct       = new ManagedStruct,   initializer

built_struct:
	.return( struct )
.end

.sub fetch_layout
	.param string layout_name

	.local pmc layouts
	.local pmc layout

	layouts = find_global 'SDL::NCI', 'layouts'

	exists $I0, layouts[ layout_name ]
	if $I0 goto found
	layout = new OrderedHash

	print "SDL::fetch_layout warning: layout '"
	print layout_name
	print "' not found!\n"
	goto found_done
	
found:
	layout = layouts[ layout_name ]

found_done:
	.return( layout )
.end

=head1 AUTHOR

Written and maintained by chromatic, E<lt>chromatic at wgz dot orgE<gt>.
Please send patches, feedback, and suggestions to the Perl 6 Internals mailing
list.

=head1 COPYRIGHT

Copyright (c) 2004, 2006 The Perl Foundation.

=cut
