hedgewars/uStore.pas
changeset 1185 a17732fbaf35
parent 1180 e56317fdf78d
child 1242 4aca5f7b2504
equal deleted inserted replaced
1184:852f8872da1a 1185:a17732fbaf35
   117 end;
   117 end;
   118 
   118 
   119 procedure StoreLoad;
   119 procedure StoreLoad;
   120 var s: string;
   120 var s: string;
   121 
   121 
   122     procedure WriteNames(Font: THWFont);
   122 	procedure WriteNames(Font: THWFont);
   123     var t: LongInt;
   123 	var t: LongInt;
   124         i: LongInt;
   124 		i: LongInt;
   125         r, rr: TSDL_Rect;
   125 		r, rr: TSDL_Rect;
   126         drY: LongInt;
   126 		drY: LongInt;
   127         texsurf: PSDL_Surface;
   127 		texsurf: PSDL_Surface;
   128     begin
   128 	begin
   129     r.x:= 0;
   129 	r.x:= 0;
   130     r.y:= 0;
   130 	r.y:= 0;
   131     drY:= - 4;
   131 	drY:= - 4;
   132     for t:= 0 to Pred(TeamsCount) do
   132 	for t:= 0 to Pred(TeamsCount) do
   133      with TeamsArray[t]^ do
   133 		with TeamsArray[t]^ do
   134       begin
   134 		begin
   135       NameTagTex:= RenderStringTex(TeamName, Clan^.Color, Font);
   135 		NameTagTex:= RenderStringTex(TeamName, Clan^.Color, Font);
   136 
   136 
   137       r.w:= cTeamHealthWidth + 5;
   137 		r.w:= cTeamHealthWidth + 5;
   138       r.h:= NameTagTex^.h;
   138 		r.h:= NameTagTex^.h;
   139 
   139 
   140       texsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, r.w, r.h, 32, RMask, GMask, BMask, AMask);
   140 		texsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, r.w, r.h, 32, RMask, GMask, BMask, AMask);
   141       TryDo(texsurf <> nil, errmsgCreateSurface, true);
   141 		TryDo(texsurf <> nil, errmsgCreateSurface, true);
   142       TryDo(SDL_SetColorKey(texsurf, SDL_SRCCOLORKEY, 0) = 0, errmsgTransparentSet, true);
   142 		TryDo(SDL_SetColorKey(texsurf, SDL_SRCCOLORKEY, 0) = 0, errmsgTransparentSet, true);
   143 
   143 
   144       DrawRoundRect(@r, cWhiteColor, cColorNearBlack, texsurf, true);
   144 		DrawRoundRect(@r, cWhiteColor, cColorNearBlack, texsurf, true);
   145       rr:= r;
   145 		rr:= r;
   146       inc(rr.x, 2); dec(rr.w, 4); inc(rr.y, 2); dec(rr.h, 4);
   146 		inc(rr.x, 2); dec(rr.w, 4); inc(rr.y, 2); dec(rr.h, 4);
   147       DrawRoundRect(@rr, Clan^.Color, Clan^.Color, texsurf, false);
   147 		DrawRoundRect(@rr, Clan^.Color, Clan^.Color, texsurf, false);
   148       HealthTex:= Surface2Tex(texsurf);
   148 		HealthTex:= Surface2Tex(texsurf);
   149       SDL_FreeSurface(texsurf);
   149 		SDL_FreeSurface(texsurf);
   150 
   150 
   151       dec(drY, r.h + 2);
   151 		dec(drY, r.h + 2);
   152       DrawHealthY:= drY;
   152 		DrawHealthY:= drY;
   153       for i:= 0 to 7 do
   153 		for i:= 0 to 7 do
   154           with Hedgehogs[i] do
   154 			with Hedgehogs[i] do
   155                if Gear <> nil then
   155 				if Gear <> nil then
   156                   NameTagTex:= RenderStringTex(Name, Clan^.Color, fnt16);
   156 					NameTagTex:= RenderStringTex(Name, Clan^.Color, fnt16);
   157       end;
   157 		end;
   158     end;
   158 	end;
   159 
   159 
   160     procedure MakeCrossHairs;
   160 	procedure MakeCrossHairs;
   161     var t: LongInt;
   161 	var t: LongInt;
   162         tmpsurf, texsurf: PSDL_Surface;
   162 		tmpsurf, texsurf: PSDL_Surface;
   163         Color, i: Longword;
   163 		Color, i: Longword;
   164     begin
   164 	begin
   165     s:= Pathz[ptGraphics] + '/' + cCHFileName;
   165 	s:= Pathz[ptGraphics] + '/' + cCHFileName;
   166     tmpsurf:= LoadImage(s, true, true, false);
   166 	tmpsurf:= LoadImage(s, true, true, false);
   167 
   167 
   168     for t:= 0 to Pred(TeamsCount) do
   168 	for t:= 0 to Pred(TeamsCount) do
   169       with TeamsArray[t]^ do
   169 		with TeamsArray[t]^ do
   170       begin
   170 		begin
   171       texsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, tmpsurf^.w, tmpsurf^.h, 32, RMask, GMask, BMask, AMask);
   171 		texsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, tmpsurf^.w, tmpsurf^.h, 32, RMask, GMask, BMask, AMask);
   172       TryDo(texsurf <> nil, errmsgCreateSurface, true);
   172 		TryDo(texsurf <> nil, errmsgCreateSurface, true);
   173 
   173 
   174       Color:= Clan^.Color;
   174 		Color:= Clan^.Color;
   175       Color:= SDL_MapRGB(texsurf^.format, Color shr 16, Color shr 8, Color and $FF);
   175 		Color:= SDL_MapRGB(texsurf^.format, Color shr 16, Color shr 8, Color and $FF);
   176       SDL_FillRect(texsurf, nil, Color);
   176 		SDL_FillRect(texsurf, nil, Color);
   177 
   177 
   178       SDL_UpperBlit(tmpsurf, nil, texsurf, nil);
   178 		SDL_UpperBlit(tmpsurf, nil, texsurf, nil);
   179 
   179 
   180       TryDo(tmpsurf^.format^.BytesPerPixel = 4, 'Ooops', true);
   180 		TryDo(tmpsurf^.format^.BytesPerPixel = 4, 'Ooops', true);
   181 
   181 
   182       if SDL_MustLock(texsurf) then
   182 		if SDL_MustLock(texsurf) then
   183          SDLTry(SDL_LockSurface(texsurf) >= 0, true);
   183 			SDLTry(SDL_LockSurface(texsurf) >= 0, true);
   184 
   184 
   185       // make black pixel be alpha-transparent
   185 		// make black pixel be alpha-transparent
   186       for i:= 0 to texsurf^.w * texsurf^.h - 1 do
   186 		for i:= 0 to texsurf^.w * texsurf^.h - 1 do
   187           if PLongwordArray(texsurf^.pixels)^[i] = $FF000000 then PLongwordArray(texsurf^.pixels)^[i]:= 0;
   187 			if PLongwordArray(texsurf^.pixels)^[i] = $FF000000 then PLongwordArray(texsurf^.pixels)^[i]:= 0;
   188 
   188 
   189       if SDL_MustLock(texsurf) then
   189 		if SDL_MustLock(texsurf) then
   190          SDL_UnlockSurface(texsurf);
   190 			SDL_UnlockSurface(texsurf);
   191 
   191 
   192       CrosshairTex:= Surface2Tex(texsurf);
   192 		CrosshairTex:= Surface2Tex(texsurf);
   193       SDL_FreeSurface(texsurf)
   193 		SDL_FreeSurface(texsurf)
   194       end;
   194 		end;
   195 
   195 
   196     SDL_FreeSurface(tmpsurf)
   196 	SDL_FreeSurface(tmpsurf)
   197     end;
   197 	end;
   198 
   198 
   199     procedure InitHealth;
   199 	procedure InitHealth;
   200     var i, t: LongInt;
   200 	var i, t: LongInt;
   201     begin
   201 	begin
   202     for t:= 0 to Pred(TeamsCount) do
   202 	for t:= 0 to Pred(TeamsCount) do
   203      if TeamsArray[t] <> nil then
   203 		if TeamsArray[t] <> nil then
   204       with TeamsArray[t]^ do
   204 			with TeamsArray[t]^ do
   205           begin
   205 				begin
   206           for i:= 0 to cMaxHHIndex do
   206 				for i:= 0 to cMaxHHIndex do
   207               if Hedgehogs[i].Gear <> nil then
   207 					if Hedgehogs[i].Gear <> nil then
   208                  RenderHealth(Hedgehogs[i]);
   208 						RenderHealth(Hedgehogs[i]);
   209           end
   209 				end
   210     end;
   210 	end;
   211 
   211 
   212     procedure LoadGraves;
   212 	procedure LoadGraves;
   213     var t: LongInt;
   213 	var t: LongInt;
   214         texsurf: PSDL_Surface;
   214 		texsurf: PSDL_Surface;
   215     begin
   215 	begin
   216     for t:= 0 to Pred(TeamsCount) do
   216 	for t:= 0 to Pred(TeamsCount) do
   217      if TeamsArray[t] <> nil then
   217 	if TeamsArray[t] <> nil then
   218       with TeamsArray[t]^ do
   218 		with TeamsArray[t]^ do
   219           begin
   219 			begin
   220           if GraveName = '' then GraveName:= 'Simple';
   220 			if GraveName = '' then GraveName:= 'Simple';
   221           texsurf:= LoadImage(Pathz[ptGraves] + '/' + GraveName, false, true, true);
   221 			texsurf:= LoadImage(Pathz[ptGraves] + '/' + GraveName, false, true, true);
   222           GraveTex:= Surface2Tex(texsurf);
   222 			GraveTex:= Surface2Tex(texsurf);
   223           SDL_FreeSurface(texsurf)
   223 			SDL_FreeSurface(texsurf)
   224           end
   224 			end
   225     end;
   225 	end;
   226 
   226 
   227 var ii: TSprite;
   227 var ii: TSprite;
   228     fi: THWFont;
   228     fi: THWFont;
   229     ai: TAmmoType;
   229     ai: TAmmoType;
   230     tmpsurf: PSDL_Surface;
   230     tmpsurf: PSDL_Surface;
   231     i: LongInt;
   231     i: LongInt;
   232 begin
   232 begin
   233 for fi:= Low(THWFont) to High(THWFont) do
   233 for fi:= Low(THWFont) to High(THWFont) do
   234     with Fontz[fi] do
   234 	with Fontz[fi] do
   235          begin
   235 		begin
   236          s:= Pathz[ptFonts] + '/' + Name;
   236 		s:= Pathz[ptFonts] + '/' + Name;
   237          WriteToConsole(msgLoading + s + '... ');
   237 		WriteToConsole(msgLoading + s + '... ');
   238          Handle:= TTF_OpenFont(Str2PChar(s), Height);
   238 		Handle:= TTF_OpenFont(Str2PChar(s), Height);
   239          SDLTry(Handle <> nil, true);
   239 		SDLTry(Handle <> nil, true);
   240          TTF_SetFontStyle(Handle, style);
   240 		TTF_SetFontStyle(Handle, style);
   241          WriteLnToConsole(msgOK)
   241 		WriteLnToConsole(msgOK)
   242          end;
   242 		end;
   243 AddProgress;
   243 AddProgress;
   244 
   244 
   245 AddProgress;
   245 AddProgress;
   246 WriteNames(fnt16);
   246 WriteNames(fnt16);
   247 MakeCrossHairs;
   247 MakeCrossHairs;
   248 LoadGraves;
   248 LoadGraves;
   249 
   249 
   250 AddProgress;
   250 AddProgress;
   251 for ii:= Low(TSprite) to High(TSprite) do
   251 for ii:= Low(TSprite) to High(TSprite) do
   252     with SpritesData[ii] do
   252 	with SpritesData[ii] do
   253          begin
   253 			begin
   254          if AltPath = ptNone then
   254 			if AltPath = ptNone then
   255             tmpsurf:= LoadImage(Pathz[Path] + '/' + FileName, true, true, true)
   255 				tmpsurf:= LoadImage(Pathz[Path] + '/' + FileName, true, true, true)
   256          else begin
   256 			else begin
   257             tmpsurf:= LoadImage(Pathz[Path] + '/' + FileName, true, false, true);
   257 				tmpsurf:= LoadImage(Pathz[Path] + '/' + FileName, true, false, true);
   258             if tmpsurf = nil then
   258 				if tmpsurf = nil then
   259                tmpsurf:= LoadImage(Pathz[AltPath] + '/' + FileName, true, true, true)
   259 					tmpsurf:= LoadImage(Pathz[AltPath] + '/' + FileName, true, true, true)
   260             end;
   260 				end;
   261          if Width = 0 then Width:= tmpsurf^.w;
   261 			if Width = 0 then Width:= tmpsurf^.w;
   262          if Height = 0 then Height:= tmpsurf^.h;
   262 			if Height = 0 then Height:= tmpsurf^.h;
   263          Texture:= Surface2Tex(tmpsurf);
   263 			Texture:= Surface2Tex(tmpsurf);
   264          if saveSurf then Surface:= tmpsurf else SDL_FreeSurface(tmpsurf)
   264 			if saveSurf then Surface:= tmpsurf else SDL_FreeSurface(tmpsurf)
   265          end;
   265 			end;
   266 
   266 
   267 AddProgress;
   267 AddProgress;
   268 
   268 
   269 tmpsurf:= LoadImage(Pathz[ptGraphics] + '/' + cHHFileName, true, true, true);
   269 tmpsurf:= LoadImage(Pathz[ptGraphics] + '/' + cHHFileName, true, true, true);
   270 HHTexture:= Surface2Tex(tmpsurf);
   270 HHTexture:= Surface2Tex(tmpsurf);