hedgewars/checksdl.dpr
author unc0rr
Sun, 27 Aug 2006 12:41:27 +0000
changeset 126 93df479aa1b9
parent 104 e647d0589bff
child 184 f97a7a3dc8f6
permissions -rw-r--r--
- Now really fix unicode issues - Some other small fixes
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
104
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
     1
program checksdl;
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
     2
{$APPTYPE CONSOLE}
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
     3
uses
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
     4
  SDLh;
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
     5
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
     6
procedure fail;
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
     7
begin
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
     8
writeln('fail');
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
     9
halt
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    10
end;
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    11
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    12
var SDLPrimSurface: PSDL_Surface;
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    13
    Color: Longword;
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    14
begin
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    15
Write('Init SDL... ');
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    16
if SDL_Init(SDL_INIT_VIDEO) < 0 then fail;
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    17
WriteLn('ok');
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    18
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    19
Write('Create primsurface... ');
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    20
SDLPrimSurface:= SDL_SetVideoMode(640, 480, 16, 0);
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    21
if (SDLPrimSurface = nil) then fail;
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    22
WriteLn('ok');
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    23
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    24
Write('Try map color... ');
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    25
Color:= $FFFFFF;
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    26
Color:= SDL_MapRGB(SDLPrimSurface^.format, (Color shr 16) and $FF, (Color shr 8) and $FF, Color and $FF);
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    27
Writeln('ok');
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    28
Writeln('Result = ', Color);
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    29
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    30
SDL_Quit()
e647d0589bff Add simple SDL test app
unc0rr
parents:
diff changeset
    31
end.