520 |
533 |
521 tmpsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, 2048, 1024, 32, RMask, GMask, BMask, 0); |
534 tmpsurf:= SDL_CreateRGBSurface(SDL_SWSURFACE, 2048, 1024, 32, RMask, GMask, BMask, 0); |
522 |
535 |
523 TryDo(tmpsurf <> nil, 'Error creating pre-land surface', true); |
536 TryDo(tmpsurf <> nil, 'Error creating pre-land surface', true); |
524 ColorizeLand(tmpsurf); |
537 ColorizeLand(tmpsurf); |
|
538 AddBorder(tmpsurf); |
|
539 |
|
540 LandSurface2Land(tmpsurf); |
|
541 SDL_FreeSurface(tmpsurf); |
|
542 |
525 AddProgress; |
543 AddProgress; |
526 AddBorder(tmpsurf); |
544 |
527 |
545 AddObjects; |
528 LandSurface:= SDL_CreateRGBSurface(SDL_SWSURFACE, 2048, 1024, 32, RMask, GMask, BMask, AMask); |
546 |
529 |
547 UpdateLandTexture(0, 1023); |
530 TryDo(LandSurface <> nil, 'Error creating land surface', true); |
|
531 SDL_FillRect(LandSurface, nil, 0); |
|
532 AddProgress; |
|
533 SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, 0); |
|
534 AddObjects(tmpsurf, LandSurface); |
|
535 SDL_FreeSurface(tmpsurf); |
|
536 |
|
537 UpdateLandTexture(0, 1024); |
|
538 AddProgress |
548 AddProgress |
539 end; |
549 end; |
540 |
550 |
541 procedure MakeFortsMap; |
551 procedure MakeFortsMap; |
542 var tmpsurf: PSDL_Surface; |
552 var tmpsurf: PSDL_Surface; |
543 begin |
553 begin |
544 WriteLnToConsole('Generating forts land...'); |
554 WriteLnToConsole('Generating forts land...'); |
545 TryDo(ClansCount = 2, 'More or less than 2 clans on map in forts mode!', true); |
555 TryDo(ClansCount = 2, 'More or less than 2 clans on map in forts mode!', true); |
546 |
556 |
547 LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, 32, RMask, GMask, BMask, AMask); |
557 tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[0]^.Teams[0]^.FortName + 'L', true, true, true); |
548 |
558 BlitImageAndGenerateCollisionInfo(0, 0, tmpsurf); |
549 SDL_FillRect(LandSurface, nil, 0); |
|
550 |
|
551 tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[0]^.Teams[0]^.FortName + 'L', false, true, true); |
|
552 BlitImageAndGenerateCollisionInfo(0, 0, tmpsurf, LandSurface); |
|
553 SDL_FreeSurface(tmpsurf); |
559 SDL_FreeSurface(tmpsurf); |
554 |
560 |
555 tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[0]^.Teams[0]^.FortName + 'R', false, true, true); |
561 tmpsurf:= LoadImage(Pathz[ptForts] + '/' + ClansArray[0]^.Teams[0]^.FortName + 'R', true, true, true); |
556 BlitImageAndGenerateCollisionInfo(1024, 0, tmpsurf, LandSurface); |
562 BlitImageAndGenerateCollisionInfo(1024, 0, tmpsurf); |
557 SDL_FreeSurface(tmpsurf); |
563 SDL_FreeSurface(tmpsurf); |
558 |
564 |
559 UpdateLandTexture(0, 1024) |
565 UpdateLandTexture(0, 1023) |
560 end; |
566 end; |
561 |
567 |
562 procedure LoadMap; |
568 procedure LoadMap; |
563 var x, y: Longword; |
569 var x, y: Longword; |
564 p: PByteArray; |
570 p: PByteArray; |
|
571 LandSurface: PSDL_Surface; |
565 begin |
572 begin |
566 WriteLnToConsole('Loading land from file...'); |
573 WriteLnToConsole('Loading land from file...'); |
567 AddProgress; |
574 AddProgress; |
568 LandSurface:= LoadImage(Pathz[ptMapCurrent] + '/map', false, true, true); |
575 LandSurface:= LoadImage(Pathz[ptMapCurrent] + '/map', true, true, true); |
569 TryDo((LandSurface^.w = 2048) and (LandSurface^.h = 1024), 'Map dimensions should be 2048x1024!', true); |
576 TryDo((LandSurface^.w = 2048) and (LandSurface^.h = 1024), 'Map dimensions should be 2048x1024!', true); |
570 |
577 |
571 if SDL_MustLock(LandSurface) then |
578 if SDL_MustLock(LandSurface) then |
572 SDLTry(SDL_LockSurface(LandSurface) >= 0, true); |
579 SDLTry(SDL_LockSurface(LandSurface) >= 0, true); |
573 |
580 |
574 p:= LandSurface^.pixels; |
581 TryDo(LandSurface^.format^.BytesPerPixel = 4, 'Map should be 32bit', true); |
575 case LandSurface^.format^.BytesPerPixel of |
582 |
576 1: OutError('We don''t work with 8 bit surfaces', true); |
583 for y:= 0 to 1023 do |
577 2: OutError('We don''t work with 16 bit surfaces', true); |
584 begin |
578 3: for y:= 0 to 1023 do |
585 for x:= 0 to 2047 do |
579 begin |
586 if (PLongword(@(p^[x * 4]))^ and $FF000000) <> 0 then Land[y, x]:= COLOR_LAND; |
580 for x:= 0 to 2047 do |
587 p:= @(p^[LandSurface^.pitch]); |
581 if (p^[x * 3 + 0] <> 0) |
588 end; |
582 or (p^[x * 3 + 1] <> 0) |
|
583 or (p^[x * 3 + 2] <> 0) then Land[y, x]:= COLOR_LAND; |
|
584 p:= @(p^[LandSurface^.pitch]); |
|
585 end; |
|
586 4: for y:= 0 to 1023 do |
|
587 begin |
|
588 for x:= 0 to 2047 do |
|
589 if (PLongword(@(p^[x * 4]))^ and $FF000000) <> 0 then Land[y, x]:= COLOR_LAND; |
|
590 p:= @(p^[LandSurface^.pitch]); |
|
591 end; |
|
592 end; |
|
593 |
589 |
594 if SDL_MustLock(LandSurface) then |
590 if SDL_MustLock(LandSurface) then |
595 SDL_UnlockSurface(LandSurface); |
591 SDL_UnlockSurface(LandSurface); |
596 |
592 |
597 UpdateLandTexture(0, 1024) |
593 UpdateLandTexture(0, 1023) |
598 end; |
594 end; |
599 |
595 |
600 procedure GenMap; |
596 procedure GenMap; |
601 begin |
597 begin |
602 LoadThemeConfig; |
598 LoadThemeConfig; |
632 GenPreview:= Preview |
628 GenPreview:= Preview |
633 end; |
629 end; |
634 |
630 |
635 procedure UpdateLandTexture(Y, Height: LongInt); |
631 procedure UpdateLandTexture(Y, Height: LongInt); |
636 begin |
632 begin |
637 if LandTexture <> nil then |
633 if (Height <= 0) then exit; |
638 begin |
634 TryDo((Y >= 0) and (Y < 1024), 'UpdateLandTexture: wrong Y parameter', true); |
639 if (Height <= 0) then exit; |
635 TryDo(Y + Height < 1024, 'UpdateLandTexture: wrong Height parameter', true); |
640 TryDo((Y >= 0) and (Y < 1024), 'UpdateLandTexture: wrong Y parameter', true); |
636 |
641 TryDo(Y + Height < 1024, 'UpdateLandTexture: wrong Height parameter', true); |
637 if LandTexture = nil then |
642 glBindTexture(GL_TEXTURE_2D, LandTexture^.id); |
638 LandTexture:= NewTexture(2048, 1024, @LandPixels) |
643 |
639 else |
644 glTexSubImage2D(GL_TEXTURE_2D, 0, 0, Y, 2048, Height, GL_RGBA, GL_UNSIGNED_BYTE, @LandPixels[Y, 0]); |
640 begin |
645 end else |
641 glBindTexture(GL_TEXTURE_2D, LandTexture^.id); |
646 begin |
642 glTexSubImage2D(GL_TEXTURE_2D, 0, 0, Y, 2048, Height, GL_RGBA, GL_UNSIGNED_BYTE, @LandPixels[Y, 0]); |
647 TryDo(LandSurface <> nil, 'Assert (LandSurface <> nil) failed', true); |
643 end |
648 LandTexture:= Surface2Tex(LandSurface); |
|
649 |
|
650 if SDL_MustLock(LandSurface) then |
|
651 SDLTry(SDL_LockSurface(LandSurface) >= 0, true); |
|
652 |
|
653 Move(LandSurface^.pixels^, LandPixels, 2048 * 1024 * 4); |
|
654 |
|
655 if SDL_MustLock(LandSurface) then |
|
656 SDL_UnlockSurface(LandSurface); |
|
657 |
|
658 SDL_FreeSurface(LandSurface); |
|
659 LandSurface:= nil |
|
660 end; |
|
661 |
|
662 end; |
644 end; |
663 |
645 |
664 initialization |
646 initialization |
665 |
647 |
666 end. |
648 end. |