hedgewars/checksdl.dpr
author displacer
Wed, 24 Jan 2007 21:58:43 +0000
changeset 363 c0d788307314
parent 184 f97a7a3dc8f6
permissions -rw-r--r--
more accurate selection colors for teamselect widget
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
184
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
     1
program checksdl;
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
     2
{$APPTYPE CONSOLE}
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
     3
uses
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
     4
  SDLh;
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
     5
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
     6
procedure fail;
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
     7
begin
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
     8
writeln('fail');
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
     9
halt
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    10
end;
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    11
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    12
var SDLPrimSurface: PSDL_Surface;
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    13
    Color: Longword;
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    14
begin
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    15
Write('Init SDL... ');
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    16
if SDL_Init(SDL_INIT_VIDEO) < 0 then fail;
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    17
WriteLn('ok');
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    18
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    19
Write('Create primsurface... ');
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    20
SDLPrimSurface:= SDL_SetVideoMode(640, 480, 16, 0);
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    21
if (SDLPrimSurface = nil) then fail;
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    22
WriteLn('ok');
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    23
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    24
Write('Try map color... ');
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    25
Color:= $FFFFFF;
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    26
Color:= SDL_MapRGB(SDLPrimSurface^.format, (Color shr 16) and $FF, (Color shr 8) and $FF, Color and $FF);
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    27
Writeln('ok');
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    28
Writeln('Result = ', Color);
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    29
f97a7a3dc8f6 - Update more headers
unc0rr
parents: 104
diff changeset
    30
SDL_Quit()
104
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    31
end.