module "/pliant/language/context.pli"
module "/pliant/SDL/SDL.pli"
#Some stdlib functions:
constant stdlib "libc.so.6"
function srand seed
arg Int seed
external stdlib "srand"
function rand -> z
arg uInt z
external stdlib "rand"
function time timeptr -> epoc
arg uInt epoc
arg Address timeptr
external stdlib "time"
constant NUM_SPRITES 100
constant MAX_SPEED 1
gvar Pointer:SDL_Surface sprite
gvar Int numsprites
gvar (Array SDL_Rect) sprite_rects
gvar (Array SDL_Rect) back_rects
gvar (Array SDL_Rect) positions
gvar (Array SDL_Rect) velocities
gvar CBool sprites_visible
gvar uInt sprite_w sprite_h
function LoadSprite screen file -> z
arg Pointer:SDL_Surface screen
arg Str file;arg Int z
var Pointer:SDL_Surface temp
console "loading bitmap:" file eol
sprite :> SDL_LoadBMP file
if not (exists sprite)
console "Could not load Sprite Bitmap: " file eol
z := -1
return
#First pixel in bitmap is the background; or color key
var uInt8 color_key := sprite:pixels map uInt8
SDL_SetColorKey sprite (SDL_SRCCOLORKEY .or. SDL_RLEACCEL) color_key
temp :> SDL_DisplayFormat sprite
SDL_FreeSurface sprite
sprite :> temp
z:=0
function MoveSprites screen background
arg Pointer:SDL_Surface screen
arg uInt background
var Int i nupdates
var SDL_Rect front back
var Pointer:SDL_Rect position velocity
nupdates := 0
if sprites_visible
SDL_FillRect screen null background
for i 0 numsprites
position :> positions:i
velocity :> velocities:i
back := position
position:x += velocity:x
if (position:x < 0) or (position:x > (screen:w - sprite_w))
velocity:x := -1 * velocity:x
position:x += velocity:x
position:y += velocity:y
if (position:y < 0) or (position:y > (screen:h - sprite_h))
velocity:y := -1 * velocity:y
position:y += velocity:y
front := position
#Blit the sprite onto screen at new position
SDL_BlitSurface sprite null screen front
sprite_rects:nupdates := front
back_rects:nupdates := back
nupdates += 1
if (screen:flags .and. SDL_DOUBLEBUF) = SDL_DOUBLEBUF
SDL_Flip screen
else
SDL_UpdateRects screen nupdates back_rects:first
SDL_UpdateRects screen nupdates sprite_rects:first
sprites_visible := true
function sprites
var Pointer:SDL_Surface screen
var Int height width
var Int video_bpp
var uInt videoflags
var uInt background
var Int i
var CBool done
var SDL_Event event
#Initialize SDL
if (SDL_Init SDL_INIT_VIDEO) < 0
console "Cound not initalize SDL!" eol
exit 1
numsprites := NUM_SPRITES
videoflags := SDL_SWSURFACE .or. SDL_ANYFORMAT
width := 640
height := 480
video_bpp := 8
screen :> SDL_SetVideoMode width height video_bpp videoflags
#Set video mode
if not (exists screen)
console "Could not set " width "x" height " video mode..." eol
exit 2
#Load the sprite
if (LoadSprite screen "icon.bmp") < 0
console "Could not load sprite data." eol
exit 1
#Allocate memory for sprite info. Easier than C version...
positions size := numsprites
velocities size := numsprites
sprite_rects size := numsprites
back_rects size := numsprites
sprite_w := sprite:w
sprite_h := sprite:h
srand (time null)
for i 0 numsprites
positions:i:x := rand % (screen:w - sprite_w)
positions:i:y := rand % (screen:h - sprite_h)
positions:i:w := sprite_w
positions:i:h := sprite_h
velocities:i:x := 0
velocities:i:y := 0
while (velocities:i:x = 0) and (velocities:i:y = 0)
velocities:i:x := (rand % (MAX_SPEED*2+1) ) - MAX_SPEED
velocities:i:y := (rand % (MAX_SPEED*2+1) ) - MAX_SPEED
background := SDL_MapRGB screen:format 00h 00h 00h
#Run a sample blit to trigger blit acceleration
var SDL_Rect dst
dst:x := 0
dst:y := 0
dst:w := sprite:w
dst:h := sprite:h
SDL_BlitSurface sprite null screen dst
SDL_FillRect screen dst background
done := false
sprites_visible := false
console "Beginning loop." eol
while not done
while (SDL_PollEvent:event > 0)
if event:type = SDL_KEYDOWN
done := true
eif event:type = SDL_QUIT
done := true
MoveSprites screen background
SDL_FreeSurface sprite
exit 0
sprites