Code:
program alletest;
{$mode objfpc}{$H+}
{$apptype gui}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, allegro, sprites, PerlinNoiseUnit, WorldGen, boolUtils,
Tilesets, ChunkUtils, Globals, states;
procedure quitfunc();CDECL;
begin
quit:=true;
end;
procedure update();CDECL;
begin
//frame update
CurrentState.Update;
end;
begin
Randomize;
//initializing Allegro
if al_init then
begin
//setting up window
al_set_color_depth(al_desktop_color_depth);
al_set_gfx_mode(AL_GFX_AUTODETECT_WINDOWED,SCREENW,SCREENH,SCREENW,SCREENH);
al_set_window_title('Super Heli Land');
al_set_close_button_callback(@quitfunc);
//installing keyboard
al_textout_ex(al_screen,al_font,'Installing keyboard... ',0,0,al_makeacol_depth(al_desktop_color_depth,128,128,128,255),al_makeacol_depth(al_desktop_color_depth,0,0,0,255));
al_install_keyboard;
al_textout_ex(al_screen,al_font,'OK',600,0,al_makeacol_depth(al_desktop_color_depth,0,255,0,255),al_makeacol_depth(al_desktop_color_depth,0,0,0,255));
//installing timers
al_textout_ex(al_screen,al_font,'Installing timers... ',0,20,al_makeacol_depth(al_desktop_color_depth,128,128,128,255),al_makeacol_depth(al_desktop_color_depth,0,0,0,255));
al_install_timer;
al_textout_ex(al_screen,al_font,'OK',600,20,al_makeacol_depth(al_desktop_color_depth,0,255,0,255),al_makeacol_depth(al_desktop_color_depth,0,0,0,255));
//installing update timer
al_textout_ex(al_screen,al_font,'Initializing update routine... ',0,40,al_makeacol_depth(al_desktop_color_depth,128,128,128,255),al_makeacol_depth(al_desktop_color_depth,0,0,0,255));
al_install_int_ex(@Update,AL_BPS_TO_TIMER(60));
al_textout_ex(al_screen,al_font,'OK',600,40,al_makeacol_depth(al_desktop_color_depth,0,255,0,255),al_makeacol_depth(al_desktop_color_depth,0,0,0,255));
//loading marioland font
MarioFont:=al_load_font('marioland.pcx',nil,nil);
al_textout_ex(al_screen,al_font,'Creating main menu... ',0,120,al_makeacol_depth(al_desktop_color_depth,128,128,128,255),al_makeacol_depth(al_desktop_color_depth,0,0,0,255));
MainMenuState:=TMainMenuState.Create;
CurrentState:=MainMenuState;
al_textout_ex(al_screen,al_font,'OK',600,120,al_makeacol_depth(al_desktop_color_depth,0,255,0,255),al_makeacol_depth(al_desktop_color_depth,0,0,0,255));
al_textout_ex(al_screen,al_font,'Starting main loop... ',0,140,al_makeacol_depth(al_desktop_color_depth,128,128,128,255),al_makeacol_depth(al_desktop_color_depth,0,0,0,255));
//main loop
repeat
CurrentState.BeforeDraw;
CurrentState.Draw;
CurrentState.Main;
until quit;
//destroying font, so we won't have any leaks
al_destroy_font(MarioFont);
if CurrentState<>nil then CurrentState.Destroy;
if MainMenuState<>nil then MainMenuState.Destroy;
end;
end.
And here is States unit which defines states:
Code:
unit States;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,sprites,allegro;
type
{ TState }
TState = class
public
constructor Create;
destructor Destroy;override;
procedure Update;
procedure BeforeDraw;
procedure Draw;
procedure Main;
private
end;
{ TMainMenuState }
TMainMenuState = class(TState)
public
constructor Create;
destructor Destroy;override;
procedure Update;
procedure BeforeDraw;
procedure Draw;
procedure Main;
private
BGSprite:TSprite;
SelectionShroomSprite:TSprite;
Buffer:AL_BITMAPptr;
StartItemSprite:TSprite;
OptionItemSprite:TSprite;
ExitItemSprite:TSprite;
MenuIndex:Integer;
destroying:boolean;
end;
function keyreleased(idx:Integer):Boolean;
implementation
uses globals;
var
last_al_key : AL_KEY_LIST;
{ TMainMenuState }
constructor TMainMenuState.Create;
var bmp:AL_BITMAPptr;
begin
inherited;
//creating title image
bmp:=al_load_pcx('title.pcx',@al_default_palette);
BGSprite:=TSprite.Create(bmp,bmp);
BGSprite.ScaleFactor:=4;
BGSprite.UpdateMask; //need to be called.
//loading selection mushroom
bmp:=al_load_pcx('mushroom.pcx',@al_default_palette);
SelectionShroomSprite:=TSprite.Create(bmp,bmp);
SelectionShroomSprite.ScaleFactor:=4;
SelectionShroomSprite.UpdateMask; //need to be called.
SelectionShroomSprite.x:=32*4;
SelectionShroomSprite.y:=96*4;
SelectionShroomSprite.magentatransparent:=true;
//creating Start option sprite
bmp:=al_create_bitmap(5*8,8);
al_clear_to_color(bmp,al_makecol(255,0,255));
al_textout_ex(bmp,MarioFont,'Start',0,0,al_makecol(0,0,0),-1);
StartItemSprite:=TSprite.Create(bmp,bmp);
StartItemSprite.ScaleFactor:=4;
StartItemSprite.x:=40*4;
StartItemSprite.y:=96*4;
StartItemSprite.magentatransparent:=true;
//creating "Option" option sprite
bmp:=al_create_bitmap(6*8,8);
al_clear_to_color(bmp,al_makecol(255,0,255));
al_textout_ex(bmp,MarioFont,'Option',0,0,al_makecol(0,0,0),-1);
OptionItemSprite:=TSprite.Create(bmp,bmp);
OptionItemSprite.ScaleFactor:=4;
OptionItemSprite.x:=40*4;
OptionItemSprite.y:=104*4;
OptionItemSprite.magentatransparent:=true;
//creating Exit option sprite
bmp:=al_create_bitmap(4*8,8);
al_clear_to_color(bmp,al_makecol(255,0,255));
al_textout_ex(bmp,MarioFont,'Exit',0,0,al_makecol(0,0,0),-1);
ExitItemSprite:=TSprite.Create(bmp,bmp);
ExitItemSprite.ScaleFactor:=4;
ExitItemSprite.x:=40*4;
ExitItemSprite.y:=112*4;
ExitItemSprite.magentatransparent:=true;
//setting menu index to 0
MenuIndex:=0;
//creating drawing buffer so it won't blink
Buffer:=al_create_bitmap(SCREENW,SCREENH);
//telling we aren't destroying state just yet
destroying:=false;
end;
destructor TMainMenuState.Destroy;
begin
inherited Destroy;
//we need to set that to avoid potential segfaults related to drawing
destroying:=true;
//removing buffer
al_destroy_bitmap(Buffer);
//removing exit option sprite
ExitItemSprite.Destroy();
//removing "option" option sprite
ExitItemSprite.Destroy();
//removing start option sprite
StartItemSprite.Destroy();
//removing selection mushroom
SelectionShroomSprite.Destroy();
//removing title card
BGSprite.Destroy();
end;
procedure TMainMenuState.Update;
const LastMenuItem=2;
begin
inherited;
if not destroying then
begin //making sure we won't get any accidental segfaults
//handling keyboard
if keyreleased(AL_KEY_UP) then Dec(MenuIndex);
if keyreleased(AL_KEY_DOWN) then Inc(MenuIndex);
if MenuIndex>LastMenuItem then MenuIndex:=0;
if MenuIndex<0 then MenuIndex:=LastMenuItem;
case MenuIndex of
0 : begin SelectionShroomSprite.y:=96*4; end; //start
1 : begin SelectionShroomSprite.y:=104*4; end;//option
2 : begin SelectionShroomSprite.y:=112*4; end;//exit
end;
if (keyreleased(AL_KEY_ENTER) or keyreleased(AL_KEY_ENTER_PAD)) then
begin
case MenuIndex of
0 : begin end; //start
1 : begin end;//option
2 : begin quit:=true; self.Destroy; end;//exit
end;
end;
end;
end;
procedure TMainMenuState.BeforeDraw;
begin
inherited;
end;
procedure TMainMenuState.Draw;
begin
inherited;
if not destroying then
begin
//we embed it that way, just to avoid potential segfaults.
BGSprite.Draw(Buffer);
StartItemSprite.Draw(Buffer);
OptionItemSprite.Draw(Buffer);
ExitItemSprite.Draw(Buffer);
SelectionShroomSprite.Draw(Buffer);
al_blit(buffer,al_screen,0,0,0,0,SCREENW,SCREENH);
end;
end;
procedure TMainMenuState.Main;
begin
inherited;
end;
function keyreleased(idx: Integer): Boolean;
begin
Result := ((al_key[idx]=0) and (last_al_key[idx]<>0));
last_al_key:=al_key;
end;
{ TState }
constructor TState.Create;
begin
inherited;
//Here state is initialized. Every state needs to keep their own buffer for
//double/triple buffering. All resource loading should be done here.
end;
destructor TState.Destroy;
begin
inherited;
//You should dispose of any resources made in Create if you don't want to cause
//memory leak
end;
procedure TState.Update;
begin
//Update is called every frame (60 times per second).
//It is designed to update objects (collision check, movement)
//You shouldn't, however, do any write to variables (change values)
//that aren't primitives (writing to integers, strings, etc. is fine)
//or you'll get memory leak
end;
procedure TState.BeforeDraw;
begin
//Like Main, this is called in main loop and usage is similar.
//It is, however called before drawing.
end;
procedure TState.Draw;
begin
//Drawing is done here. It is called in main loop (as fast as it can).
end;
procedure TState.Main;
begin
//This method is also called in main loop. It is designed to do things
//that aren't drawing and needs to be called in main loop, for example
//rebuilding map, updating frame of TAnimatedSprite, etc.
end;
end.
//edit: Globals unit which may also be part of issue:
Originally Posted by Darkhog
Posting Permissions
Reply With Quote
Bookmarks