module "/pliant/language/context.pli" module "/pliant/SDL/SDL.pli" module "/pliant/math/functions.pli" constant stdlib "libc.so.6" constant sdl_lib "libSDL.so" constant SDL_DISABLE 0 constant SDL_ENABLE 1 #Not implemented in bindings... yet. function SDL_ShowCursor toggle arg Int toggle external sdl_lib "SDL_ShowCursor" #Some stdlib functions: 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 ASTEROID_MAX 30 #Max. number of asteroids at a time #Asteroid sprite flags constant ASTEROID_NORMAL 00h #Asteroid is normal constant ASTEROID_HIT 01h #Asteroid is and was hit constant ASTEROID_VISIBLE 02h #Asteroid cannot be seen constant ASTEROID_GONE 04h #Asteroid left game field constant ASTEROID_NEW 08h #Asteroid left game field #system gvar Pointer:SDL_Surface screen #Screen gvar SDL_Event event; #Event structure gvar Int mouse_x mouse_y #Mouse position gvar Int joypos_x joypos_y #Joystick position gvar CBool mouse_button1 #Mouse button 1 #Game objects gvar SDL_Rect playfield #Dimensions of playinf field gvar SDL_Rect pan_velocity #Speed of panning motion gvar SDL_Rect viewingArea #Viewable area of game field gvar SDL_Rect targetzone #Area within target can move w/o panning gvar SDL_Rect targetlocation #Where target is located. type Sprite field uInt flags # State flag field SDL_Rect rectangle # Position & size field SDL_Rect bounds # Collistion boundries field SDL_Rect velocity # Directional velocity field uInt alpha # 0-255; transparency field Pointer:SDL_Surface image # Source image gvar Array:Sprite asteroids #Asteroids! #Game graphics gvar Pointer:SDL_Surface backdrop; constant backdrop_file "images/Planet.bmp" gvar Pointer:SDL_Surface crosshairs; constant crosshairs_file "images/crosshairs.bmp" gvar Pointer:SDL_Surface viewport; constant viewport_file "images/viewport.bmp" gvar Pointer:SDL_Surface asteroid_field #Buffer where asteroids are scattered. gvar Pointer:SDL_Surface asteroidA; constant asteroidA_file "images/asteroidA.bmp" gvar Pointer:SDL_Surface asteroidB; constant asteroidB_file "images/asteroidB.bmp" gvar Pointer:SDL_Surface asteroidC; constant asteroidC_file "images/asteroidC.bmp" gvar Pointer:SDL_Surface explosion; constant explosion_file "images/explosion.bmp" #Clean up for exit. function clean_up if exists:backdrop SDL_FreeSurface backdrop if exists:viewport SDL_FreeSurface viewport if exists:crosshairs SDL_FreeSurface crosshairs SDL_Quit function Load_Bitmap surface file -> z arg_rw Pointer:SDL_Surface surface #arg_rw says I can modify the argument. arg Str file arg Int z var Pointer:SDL_Surface temp surface :> SDL_LoadBMP file if not exists:surface console "Could not open " file eol return -1 temp :> SDL_DisplayFormat surface SDL_FreeSurface surface surface :> temp return 0 function Load_Graphics -> z arg Int z if (Load_Bitmap viewport viewport_file) < 0 return -1 if (Load_Bitmap backdrop backdrop_file) < 0 return -1 if (Load_Bitmap crosshairs crosshairs_file) < 0 return -1 if (Load_Bitmap asteroid_field backdrop_file) < 0 return -1 if (Load_Bitmap asteroidA asteroidA_file) < 0 return -1 if (Load_Bitmap asteroidB asteroidB_file) < 0 return -1 if (Load_Bitmap asteroidC asteroidC_file) < 0 return -1 if (Load_Bitmap explosion explosion_file) < 0 return -1 #Blank the asteroid field to get a black image w/ same dimensions of backdrop SDL_FillRect asteroid_field null (SDL_MapRGB asteroid_field:format 0 255 0) #Set color keys. Keys are colors in the image that is invisible SDL_SetColorKey crosshairs SDL_SRCCOLORKEY .or. SDL_RLEACCEL 0 #black SDL_SetColorKey explosion SDL_SRCCOLORKEY .or. SDL_RLEACCEL 0 SDL_SetColorKey asteroid_field SDL_SRCCOLORKEY SDL_MapRGB viewport:format 0 255 0 #green SDL_SetColorKey viewport SDL_SRCCOLORKEY .or. SDL_RLEACCEL SDL_MapRGB viewport:format 0 255 0 SDL_SetColorKey asteroidA SDL_SRCCOLORKEY .or. SDL_RLEACCEL SDL_MapRGB asteroidA:format 0 255 0 SDL_SetColorKey asteroidB SDL_SRCCOLORKEY .or. SDL_RLEACCEL SDL_MapRGB asteroidB:format 0 255 0 SDL_SetColorKey asteroidC SDL_SRCCOLORKEY .or. SDL_RLEACCEL SDL_MapRGB asteroidC:format 0 255 0 #Making surface semi-transparent. SDL_SetAlpha explosion SDL_SRCALPHA .or. SDL_RLEACCEL 128 return 0 #Init function init_sdl -> z arg Int z #Initalize SDL if (SDL_Init SDL_INIT_VIDEO) < 0 console "Could not initialize video subsystem." return -1 #Open screen screen :> SDL_SetVideoMode 640 480 16 SDL_SWSURFACE if not exists:screen console "Could not open display." return -1 SDL_ShowCursor SDL_DISABLE return 0 function init_game -> z arg Int z playfield:x := 0; playfield:y := 0 playfield:w := backdrop:w playfield:h := backdrop:h viewingArea:x := 0; viewingArea:y := 0 viewingArea:w := screen:w viewingArea:h := screen:h targetlocation:x := 0; targetlocation:y := 0 targetlocation:w := crosshairs:w targetlocation:h := crosshairs:h targetzone:x := targetlocation:x targetzone:y := targetlocation:y targetzone:w := targetlocation:w + targetlocation:x targetzone:h := targetlocation:h + targetlocation:y pan_velocity:x := 2; pan_velocity:y := 2 #Seed the randomizer with current time srand (time null) return 0 function update_backdrop if mouse_x < (screen:w\2) if viewingArea:x > 0 viewingArea:x -= pan_velocity:x eif mouse_x > (screen:w\2) if viewingArea:x+viewingArea:w < playfield:w viewingArea:x += pan_velocity:x if mouse_y < (screen:h\2) if viewingArea:y > 0 viewingArea:y -= pan_velocity:y eif mouse_y > (screen:h\2) if viewingArea:y+viewingArea:h < playfield:h viewingArea:y += pan_velocity:y return function asteroid_add var Sprite a var Int whichtype var Pointer:SDL_Surface image if (asteroids size) > ASTEROID_MAX return #Randomly pick either one of 3 asteroid shapes. #3 times out of 10, an asteroid will be made. whichtype := rand % 3 if whichtype = 0 image :> asteroidA eif whichtype = 1 image :> asteroidB eif whichtype = 2 image :> asteroidC else return a:flags := ASTEROID_NORMAL .or. ASTEROID_NEW a:image :> image a:rectangle:x := rand % (asteroid_field:w - a:image:w) a:rectangle:y := rand % (asteroid_field:h - a:image:h) a:rectangle:w := a:image:w; a:rectangle:h := a:image:h a:velocity:x := 1 a:velocity:y := 1 a:alpha:= 255 asteroids += a return function asteroid_del index arg Int index if (asteroids size) = 0 return asteroids index := asteroids:(asteroids:size - 1) asteroids size := asteroids:size - 1 return function checkIfHit asteroid arg_rw Sprite asteroid var Int top right bottom left var Int target_x target_y var CBool fire top := asteroid:rectangle:y right := asteroid:rectangle:x + asteroid:rectangle:w bottom := asteroid:rectangle:y + asteroid:rectangle:h left := asteroid:rectangle:x fire := mouse_button1 target_x := mouse_x + viewingArea:x target_y := mouse_y + viewingArea:y if target_x > left and target_x < right and target_y > top and target_y < bottom and fire asteroid:flags := asteroid:flags .or. ASTEROID_HIT return function checkIfGone asteroid arg_rw Sprite asteroid var Int top right bottom left if asteroid:flags .and. ASTEROID_GONE > 0 return top := asteroid:rectangle:y right := asteroid:rectangle:x + asteroid:rectangle:w bottom := asteroid:rectangle:y + asteroid:rectangle:h left := asteroid:rectangle:x if (right < playfield:x) or (left > playfield:w) or (bottom < playfield:h) or (top > playfield:y) asteroid:flags := asteroid:flags .and. ASTEROID_GONE console "gone" eol return function update_asteroids var Int i var Pointer:Sprite asteroid for i 0 (asteroids:size - 1) asteroid :> (asteroids i) checkIfHit asteroid if (asteroid:flags .and. ASTEROID_HIT) > 0 asteroid:image :> explosion #checkIfGone asteroid #if (asteroid:flags .and. ASTEROID_GONE) > 0 # asteroid_del i #asteroid:rectangle:x += asteroid:velocity:x #asteroid:rectangle:y += asteroid:velocity:y asteroid_add return function draw_asteroids var Int i var Pointer:Sprite asteroid for i 0 (asteroids:size - 1) asteroid :> asteroids i SDL_BlitSurface asteroid:image null asteroid_field asteroid:rectangle SDL_BlitSurface asteroid_field viewingArea screen null return function update_crosshairs targetlocation:x := mouse_x - crosshairs:w \ 2 targetlocation:y := mouse_y - crosshairs:h \ 2 return function draw_backdrop SDL_BlitSurface backdrop viewingArea screen null return function draw_viewport SDL_BlitSurface viewport null screen null return function refresh SDL_Flip screen return function draw_crosshairs SDL_BlitSurface crosshairs null screen targetlocation return #Main function main -> z arg Int z var CBool done if ((init_sdl) < 0) console "Initialization failed." eol clean_up return 1 if ((Load_Graphics) < 0) console "Cannot load graphics." eol clean_up return 1 if ((init_game) < 0 ) console "Cannot intialize game." eol clean_up return 1 done := false var uInt32 i i:=0 mouse_button1 := false while not done update_backdrop update_asteroids update_crosshairs draw_backdrop draw_asteroids draw_crosshairs draw_viewport refresh while (SDL_PollEvent:event > 0) if event:type = SDL_QUIT done := true eif event:type = SDL_KEYUP if event:key:keysym:sym = SDLK_ESCAPE done := true eif event:type = SDL_MOUSEMOTION mouse_x := event:motion:x mouse_y := event:motion:y eif event:type = SDL_MOUSEBUTTONDOWN mouse_button1 := true eif event:type = SDL_MOUSEBUTTONUP mouse_button1 := false clean_up return 0 main