program Demo1;

uses
  	MCGA256, Crt, Dos, Memory;

var
	SpriteArray: array [1..4] of SpritePointer;
    SpriteIncs: array [1..4] of record
    	ix, iy, ups: integer;
    end;
    BlackPal, EarthPal: PaletteArray;
    i, index, remap: integer;
    hr, min, sec, hund: word;
    NoFrames, StartSec, EndSec: longint;
    Ch: char;



procedure ErrorReadingFile;
begin
	CloseGraphics;
    WriteLn('Program terminated: Error reading file.');
    Halt(2);
end; {ErrorReadingFile}



procedure LoadSpriteData;
begin
    if (not LoadSprite('L.PCX', SpriteArray[1])) then ErrorReadingFile;
    SpriteArray[1]^.x := 196;		SpriteArray[1]^.y := 87;
    SpriteIncs[1].ix := 2;			SpriteIncs[1].iy := 1;
    SpriteIncs[1].ups := 0;

    if (not LoadSprite('A.PCX', SpriteArray[2])) then ErrorReadingFile;
    SpriteArray[2]^.x := 164;		SpriteArray[2]^.y := 81;
    SpriteIncs[2].ix := 2;			SpriteIncs[2].iy := -1;
    SpriteIncs[2].ups := 0;

    if (not LoadSprite('K.PCX', SpriteArray[3])) then ErrorReadingFile;
    SpriteArray[3]^.x := 132;		SpriteArray[3]^.y := 87;
    SpriteIncs[3].ix := 2;			SpriteIncs[3].iy := 1;
    SpriteIncs[3].ups := 0;

    if (not LoadSprite('PAS.PCX', SpriteArray[4])) then ErrorReadingFile;
    SpriteArray[4]^.x := 92;		SpriteArray[4]^.y := 88;
    SpriteIncs[4].ix := 2;			SpriteIncs[4].iy := -1;
    SpriteIncs[4].ups := 0;
end; {LoadSpriteData}



procedure UpdateSpriteData;
var i: byte;
begin
	for i := 1 to 4 do
	begin
  		with SpriteArray[i]^ do
		begin
      		x := x + SpriteIncs[i].ix;
      		if (x <= 0) or (x >= 320-48) then
			begin
        		SpriteIncs[i].ix := -SpriteIncs[i].ix;
        		x := x + SpriteIncs[i].ix;
      		end;
            if (SpriteIncs[i].ups = 6) then
            begin
            	SpriteIncs[i].iy := -SpriteIncs[i].iy;
                SpriteIncs[i].ups := 0;
            end;
            INC(SpriteIncs[i].ups);
            y := y + SpriteIncs[i].iy;
    	end;
  	end;
end; {UpdateSpriteData}



begin
	if (not OpenGraphics) then
    begin
    	WriteLn('Error opening graphics library.');
        Halt(1);
    end;

    for i := 1 to 3 do SpriteArray[i] := CreateSprite(32, 32);
    SpriteArray[4] := CreateSprite(48, 32);
    for i := 1 to 4 do
    begin
    	if (SpriteArray[i] = nil) then
		begin
        	CloseGraphics;
            WriteLn('Error: not enough memory.');
            Halt(3);
        end;
    end;

    SetActivePage(VirtualScreen);
    for i := 0 to 768 do BlackPal[i] := 0;
    SetPalette(BlackPal);
   	LoadSpriteData;
    FillRectangle(0, 0, 319, 199, 0);
    if (not LoadPCX('EARTH.PCX', VirtualScrPtr)) then ErrorReadingFile;
    if (not LoadPalette('EARTH.PAL', EarthPal))  then ErrorReadingFile;
    SetTextFont(3);
    SetTextSpacing(-1);
    SetTextWidth(2);
    DisplayString('WELCOME TO THE', 59, 21, 0);
    DisplayString('WELCOME TO THE', 58, 20, 71);
    DisplayString('GRAPHICS LIBRARY', 41, 161, 0);
    DisplayString('GRAPHICS LIBRARY', 40, 160, 71);
    for i := 1 to 4 do
    begin
    	SaveSprite(SpriteArray[i]);
        DrawSprite(SpriteArray[i]);
    end;
    CopyAllVirtualScreen;
    FadeIn(EarthPal);

    delay(4000);

    NoFrames := 0;
    GetTime(hr, min, sec, hund);
    StartSec := (hr * 3600) + (min * 60) + sec;
  	repeat
        for i := 4 downto 1 do RestoreSprite(SpriteArray[i]);
        for i := 1 to 4 do
	    begin
    		SaveSprite(SpriteArray[i]);
        	DrawSprite(SpriteArray[i]);
	    end;
        CopyAllVirtualScreen;
        INC(NoFrames);
    	UpdateSpriteData;
        { remap the palette }
        index := random(16) + 15;
        remap := (random(16) + 15)*3;
		DACRemapColour(index, EarthPal[remap], EarthPal[remap+1], EarthPal[remap+2]);
  	until keypressed;

    GetTime(hr, min, sec, hund);
    EndSec := (hr * 3600) + (min * 60) + sec;
  	Ch := ReadKey;
    for i := 1 to 4 do DestroySprite(SpriteArray[i]);
    FadeOut(BlackPal);
	CloseGraphics;
    WriteLn('You managed approximately ', NoFrames div (EndSec - StartSec), ' frames per second.');
end.