! :folding=indent:collapseFolds=1: ! $Id$ ! ! Copyright (C) 2004 Slava Pestov. ! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions are met: ! ! 1. Redistributions of source code must retain the above copyright notice, ! this list of conditions and the following disclaimer. ! ! 2. Redistributions in binary form must reproduce the above copyright notice, ! this list of conditions and the following disclaimer in the documentation ! and/or other materials provided with the distribution. ! ! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, ! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND ! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE ! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, ! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, ! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; ! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. IN: sdl-video USE: alien USE: compiler USE: kernel USE: math ! These are the currently supported flags for the SDL_surface ! Available for SDL_CreateRGBSurface() or SDL_SetVideoMode() : SDL_SWSURFACE HEX: 00000000 ; ! Surface is in system memory : SDL_HWSURFACE HEX: 00000001 ; ! Surface is in video memory : SDL_ASYNCBLIT HEX: 00000004 ; ! Use asynchronous blits if possible ! Available for SDL_SetVideoMode() : SDL_ANYFORMAT HEX: 10000000 ; ! Allow any video depth/pixel-format : SDL_HWPALETTE HEX: 20000000 ; ! Surface has exclusive palette : SDL_DOUBLEBUF HEX: 40000000 ; ! Set up double-buffered video mode : SDL_FULLSCREEN HEX: 80000000 ; ! Surface is a full screen display : SDL_OPENGL HEX: 00000002 ; ! Create an OpenGL rendering context : SDL_OPENGLBLIT HEX: 0000000A ; ! Create an OpenGL rendering context and use it for blitting : SDL_RESIZABLE HEX: 00000010 ; ! This video mode may be resized : SDL_NOFRAME HEX: 00000020 ; ! No window caption or edge frame ! Used internally (read-only) : SDL_HWACCEL HEX: 00000100 ; ! Blit uses hardware acceleration : SDL_SRCCOLORKEY HEX: 00001000 ; ! Blit uses a source color key : SDL_RLEACCELOK HEX: 00002000 ; ! Private flag : SDL_RLEACCEL HEX: 00004000 ; ! Surface is RLE encoded : SDL_SRCALPHA HEX: 00010000 ; ! Blit uses source alpha blending : SDL_PREALLOC HEX: 01000000 ; ! Surface uses preallocated memory BEGIN-STRUCT: rect FIELD: short x FIELD: short y FIELD: ushort w FIELD: ushort h END-STRUCT BEGIN-STRUCT: format FIELD: void* palette FIELD: uchar BitsPerPixel FIELD: uchar BytesPerPixel FIELD: uchar Rloss FIELD: uchar Gloss FIELD: uchar Bloss FIELD: uchar Aloss FIELD: uchar Rshift FIELD: uchar Gshift FIELD: uchar Bshift FIELD: uchar Ashift FIELD: uint Rmask FIELD: uint Gmask FIELD: uint Bmask FIELD: uint Amask FIELD: uint colorkey FIELD: uchar alpha END-STRUCT BEGIN-STRUCT: rect FIELD: short clip-x FIELD: short clip-y FIELD: ushort clip-w FIELD: ushort clip-h END-STRUCT BEGIN-STRUCT: surface FIELD: uint flags FIELD: format* format FIELD: int w FIELD: int h FIELD: ushort pitch FIELD: void* pixels FIELD: int offset FIELD: void* hwdata FIELD: short clip-x FIELD: short clip-y FIELD: ushort clip-w FIELD: ushort clip-h FIELD: uint unused1 FIELD: uint locked FIELD: int map FIELD: uint format_version FIELD: int refcount END-STRUCT : must-lock-surface? ( surface -- ? ) #! This is a macro in SDL_video.h. dup surface-offset 0 = [ surface-flags SDL_HWSURFACE SDL_ASYNCBLIT bitor SDL_RLEACCEL bitor bitand 0 = not ] [ drop t ] ifte ; : SDL_VideoInit ( driver-name flags -- ) "int" "sdl" "SDL_VideoInit" [ "char*" "int" ] alien-invoke ; : SDL_VideoQuit ( -- ) "void" "sdl" "SDL_VideoQuit" [ ] alien-invoke ; ! SDL_VideoDriverName -- needs strings as out params. : SDL_GetVideoSurface ( -- surface ) "surface*" "sdl" "SDL_GetVideoSurface" [ ] alien-invoke ; ! SDL_GetVideoInfo needs C struct bitfield support : SDL_VideoModeOK ( width height bpp flags -- ) "int" "sdl" "SDL_VideoModeOK" [ "int" "int" "int" "int" ] alien-invoke ; ! SDL_ListModes needs array of structs support : SDL_SetVideoMode ( width height bpp flags -- ) "surface*" "sdl" "SDL_SetVideoMode" [ "int" "int" "int" "int" ] alien-invoke ; ! UpdateRects, UpdateRect : SDL_Flip ( surface -- ) "bool" "sdl" "SDL_Flip" [ "surface*" ] alien-invoke ; ! SDL_SetGamma: float types : SDL_FillRect ( surface rect color -- n ) #! If rect is null, fills entire surface. "bool" "sdl" "SDL_FillRect" [ "surface*" "rect*" "uint" ] alien-invoke ; : SDL_LockSurface ( surface -- ) "bool" "sdl" "SDL_LockSurface" [ "surface*" ] alien-invoke ; : SDL_UnlockSurface ( surface -- ) "void" "sdl" "SDL_UnlockSurface" [ "surface*" ] alien-invoke ; : SDL_MapRGB ( surface r g b -- rgb ) "uint" "sdl" "SDL_MapRGB" [ "surface*" "uchar" "uchar" "uchar" ] alien-invoke ; : SDL_WM_SetCaption ( title icon -- ) "void" "sdl" "SDL_WM_SetCaption" [ "char*" "char*" ] alien-invoke ;