29 procedure GenPreview(out Preview: TPreview); |
29 procedure GenPreview(out Preview: TPreview); |
30 |
30 |
31 implementation |
31 implementation |
32 uses uConsole, uStore, uRandom, uLandObjects, uIO, uLandTexture, SysUtils, |
32 uses uConsole, uStore, uRandom, uLandObjects, uIO, uLandTexture, SysUtils, |
33 uVariables, uUtils, uCommands, adler32, uDebug, uLandPainted, uTextures, |
33 uVariables, uUtils, uCommands, adler32, uDebug, uLandPainted, uTextures, |
34 uLandGenMaze, uLandOutline; |
34 uLandGenMaze, uLandOutline, uPhysFSLayer; |
35 |
35 |
36 var digest: shortstring; |
36 var digest: shortstring; |
37 |
37 |
38 procedure ResizeLand(width, height: LongWord); |
38 procedure ResizeLand(width, height: LongWord); |
39 var potW, potH: LongInt; |
39 var potW, potH: LongInt; |
422 BlitImageAndGenerateCollisionInfo(rightX - 150 - tmpsurf^.w, LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf); |
422 BlitImageAndGenerateCollisionInfo(rightX - 150 - tmpsurf^.w, LAND_HEIGHT - tmpsurf^.h, tmpsurf^.w, tmpsurf); |
423 SDL_FreeSurface(tmpsurf); |
423 SDL_FreeSurface(tmpsurf); |
424 end; |
424 end; |
425 |
425 |
426 procedure LoadMapConfig; |
426 procedure LoadMapConfig; |
427 var f: textfile; |
427 var f: PFSFile; |
428 s: shortstring; |
428 s: shortstring; |
429 begin |
429 begin |
430 // unC0Rr - should this be passed from the GUI? I am not sure which layer does what |
430 s:= cPathz[ptMapCurrent] + '/map.cfg'; |
431 s:= UserPathz[ptMapCurrent] + '/map.cfg'; |
431 |
432 if not FileExists(s) then |
|
433 s:= Pathz[ptMapCurrent] + '/map.cfg'; |
|
434 WriteLnToConsole('Fetching map HH limit'); |
432 WriteLnToConsole('Fetching map HH limit'); |
435 {$I-} |
433 |
436 Assign(f, s); |
434 f:= pfsOpenRead(s); |
437 filemode:= 0; // readonly |
435 if f <> nil then |
438 Reset(f); |
436 begin |
439 if IOResult <> 0 then |
437 pfsReadLn(f, s); |
440 begin |
438 if not pfsEof(f) then |
441 s:= Pathz[ptMissionMaps] + '/' + ExtractFileName(Pathz[ptMapCurrent]) + '/map.cfg'; |
439 begin |
442 Assign(f, s); |
440 pfsReadLn(f, s); |
443 Reset(f); |
441 val(s, MaxHedgehogs) |
444 end; |
442 end; |
445 Readln(f); |
443 |
446 if not eof(f) then |
444 pfsClose(f) |
447 Readln(f, MaxHedgehogs); |
445 end; |
448 {$I+} |
446 |
449 if (MaxHedgehogs = 0) then |
447 if (MaxHedgehogs = 0) then |
450 MaxHedgehogs:= 18; |
448 MaxHedgehogs:= 18; |
451 end; |
449 end; |
452 |
450 |
453 // Loads Land[] from an image, allowing overriding standard collision |
451 // Loads Land[] from an image, allowing overriding standard collision |
457 x, y, cpX, cpY: Longword; |
455 x, y, cpX, cpY: Longword; |
458 mapName: shortstring; |
456 mapName: shortstring; |
459 begin |
457 begin |
460 tmpsurf:= LoadDataImage(ptMapCurrent, 'mask', ifAlpha or ifTransparent or ifIgnoreCaps); |
458 tmpsurf:= LoadDataImage(ptMapCurrent, 'mask', ifAlpha or ifTransparent or ifIgnoreCaps); |
461 if tmpsurf = nil then |
459 if tmpsurf = nil then |
462 tmpsurf:= LoadImage(Pathz[ptMapCurrent] + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps); |
460 begin |
463 if tmpsurf = nil then |
461 mapName:= ExtractFileName(cPathz[ptMapCurrent]); |
464 begin |
|
465 mapName:= ExtractFileName(Pathz[ptMapCurrent]); |
|
466 tmpsurf:= LoadDataImage(ptMissionMaps, mapName + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps); |
462 tmpsurf:= LoadDataImage(ptMissionMaps, mapName + '/mask', ifAlpha or ifTransparent or ifIgnoreCaps); |
467 end; |
463 end; |
468 |
464 |
469 |
465 |
470 if (tmpsurf <> nil) and (tmpsurf^.format^.BytesPerPixel = 4) then |
466 if (tmpsurf <> nil) and (tmpsurf^.format^.BytesPerPixel = 4) then |
536 WriteLnToConsole('Loading land from file...'); |
532 WriteLnToConsole('Loading land from file...'); |
537 AddProgress; |
533 AddProgress; |
538 tmpsurf:= LoadDataImage(ptMapCurrent, 'map', ifAlpha or ifTransparent or ifIgnoreCaps); |
534 tmpsurf:= LoadDataImage(ptMapCurrent, 'map', ifAlpha or ifTransparent or ifIgnoreCaps); |
539 if tmpsurf = nil then |
535 if tmpsurf = nil then |
540 begin |
536 begin |
541 mapName:= ExtractFileName(Pathz[ptMapCurrent]); |
537 mapName:= ExtractFileName(cPathz[ptMapCurrent]); |
542 tmpsurf:= LoadDataImage(ptMissionMaps, mapName + '/map', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps); |
538 tmpsurf:= LoadDataImage(ptMissionMaps, mapName + '/map', ifAlpha or ifCritical or ifTransparent or ifIgnoreCaps); |
543 end; |
539 end; |
544 // (bare) Sanity check. Considering possible LongInt comparisons as well as just how much system memoery it would take |
540 // (bare) Sanity check. Considering possible LongInt comparisons as well as just how much system memoery it would take |
545 TryDo((tmpsurf^.w < $40000000) and (tmpsurf^.h < $40000000) and (tmpsurf^.w * tmpsurf^.h < 6*1024*1024*1024), 'Map dimensions too big!', true); |
541 TryDo((tmpsurf^.w < $40000000) and (tmpsurf^.h < $40000000) and (tmpsurf^.w * tmpsurf^.h < 6*1024*1024*1024), 'Map dimensions too big!', true); |
546 |
542 |
547 ResizeLand(tmpsurf^.w, tmpsurf^.h); |
543 ResizeLand(tmpsurf^.w, tmpsurf^.h); |
548 LoadMapConfig; |
544 LoadMapConfig; |
549 |
|
550 // unC0Rr - should this be passed from the GUI? I am not sure which layer does what |
|
551 s:= UserPathz[ptMapCurrent] + '/map.cfg'; |
|
552 if not FileExists(s) then |
|
553 s:= Pathz[ptMapCurrent] + '/map.cfg'; |
|
554 WriteLnToConsole('Fetching map HH limit'); |
|
555 {$I-} |
|
556 Assign(f, s); |
|
557 filemode:= 0; // readonly |
|
558 Reset(f); |
|
559 if IOResult <> 0 then |
|
560 begin |
|
561 s:= Pathz[ptMissionMaps] + '/' + mapName + '/map.cfg'; |
|
562 Assign(f, s); |
|
563 Reset(f); |
|
564 end; |
|
565 Readln(f); |
|
566 if not eof(f) then |
|
567 Readln(f, MaxHedgehogs); |
|
568 |
|
569 {$I+} |
|
570 if (MaxHedgehogs = 0) then |
|
571 MaxHedgehogs:= 18; |
|
572 |
545 |
573 playHeight:= tmpsurf^.h; |
546 playHeight:= tmpsurf^.h; |
574 playWidth:= tmpsurf^.w; |
547 playWidth:= tmpsurf^.w; |
575 leftX:= (LAND_WIDTH - playWidth) div 2; |
548 leftX:= (LAND_WIDTH - playWidth) div 2; |
576 rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1; |
549 rightX:= (playWidth + ((LAND_WIDTH - playWidth) div 2)) - 1; |
608 LandPixels[(Longword(cWaterLine) - 1 - w) div 2, x div 2]:= c |
581 LandPixels[(Longword(cWaterLine) - 1 - w) div 2, x div 2]:= c |
609 end |
582 end |
610 end; |
583 end; |
611 |
584 |
612 procedure GenMap; |
585 procedure GenMap; |
613 var x, y, w, c : Longword; |
586 var x, y, w, c: Longword; |
614 usermap, usermask, map, mask: shortstring; |
587 map, mask: shortstring; |
615 maskOnly : boolean; |
588 maskOnly: boolean; |
616 begin |
589 begin |
617 hasBorder:= false; |
590 hasBorder:= false; |
618 maskOnly:= false; |
591 maskOnly:= false; |
619 |
592 |
620 LoadThemeConfig; |
593 LoadThemeConfig; |
622 // is this not needed any more? lets hope setlength sets also 0s |
595 // is this not needed any more? lets hope setlength sets also 0s |
623 //if ((GameFlags and gfForts) <> 0) or (Pathz[ptMapCurrent] <> '') then |
596 //if ((GameFlags and gfForts) <> 0) or (Pathz[ptMapCurrent] <> '') then |
624 // FillChar(Land,SizeOf(TCollisionArray),0);*) |
597 // FillChar(Land,SizeOf(TCollisionArray),0);*) |
625 |
598 |
626 if (GameFlags and gfForts) = 0 then |
599 if (GameFlags and gfForts) = 0 then |
627 if Pathz[ptMapCurrent] <> '' then |
600 if cPathz[ptMapCurrent] <> '' then |
628 begin |
601 begin |
629 usermap:= UserPathz[ptMapCurrent] + '/map.png'; |
602 map:= cPathz[ptMapCurrent] + '/map.png'; |
630 usermask:= UserPathz[ptMapCurrent] + '/mask.png'; |
603 mask:= cPathz[ptMapCurrent] + '/mask.png'; |
631 map:= Pathz[ptMapCurrent] + '/map.png'; |
604 if (not(FileExists(map)) and FileExists(mask)) then |
632 mask:= Pathz[ptMapCurrent] + '/mask.png'; |
|
633 if (not(FileExists(usermap)) and FileExists(usermask)) or |
|
634 (not(FileExists(map)) and FileExists(mask)) then |
|
635 begin |
605 begin |
636 maskOnly:= true; |
606 maskOnly:= true; |
637 LoadMask; |
607 LoadMask; |
638 GenLandSurface |
608 GenLandSurface |
639 end |
609 end |
817 else |
787 else |
818 TryDo(s = digest, 'Different maps generated, sorry', true); |
788 TryDo(s = digest, 'Different maps generated, sorry', true); |
819 end; |
789 end; |
820 |
790 |
821 procedure chSendLandDigest(var s: shortstring); |
791 procedure chSendLandDigest(var s: shortstring); |
822 var adler, i : LongInt; |
792 var adler, i: LongInt; |
823 begin |
793 begin |
824 adler:= 1; |
794 adler:= 1; |
825 for i:= 0 to LAND_HEIGHT-1 do |
795 for i:= 0 to LAND_HEIGHT-1 do |
826 begin |
796 begin |
827 adler:= Adler32Update(adler, @Land[i,0], LAND_WIDTH); |
797 adler:= Adler32Update(adler, @Land[i,0], LAND_WIDTH); |
852 *) |
822 *) |
853 end; |
823 end; |
854 |
824 |
855 procedure freeModule; |
825 procedure freeModule; |
856 begin |
826 begin |
857 |
827 SetLength(Land, 0, 0); |
858 SetLength(LandPixels, 0, 0); |
828 SetLength(LandPixels, 0, 0); |
859 |
829 SetLength(LandDirty, 0, 0); |
860 SetLength(Land, 0, 0); |
|
861 |
|
862 SetLength(LandDirty, 0, 0); |
|
863 |
|
864 end; |
830 end; |
865 |
831 |
866 end. |
832 end. |