Advertisement
mixster

mixster

May 13th, 2009
243
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 32.48 KB | None | 0 0
  1. program ScaRPG_Map_Editor;
  2. {
  3.     ScaRPG Map Editor
  4.     A tool that allows anyone to create an intricate map
  5.     Author for used procedures and functions is 'mixster' unless otherwise stated
  6.     Extremely heavy commenting required. If distributed without, kill whoever did it
  7.     Designed primarily for adaptation. If you don't like it, change it - that's why heavy commenting required
  8. }
  9. type
  10.   TSheet = record // Record of information on a sheet e.g. tilesheet; spritesheet.
  11.     b: Integer; // Bitmap holder for the sheet
  12.     h: Integer; // Height in tiles of sheet
  13.     w: Integer; // Width in tiles of sheet
  14.     c: TCanvas; // Holds the canvas for the bitmap 'b'
  15.   end;
  16.  
  17.   TMap = record //Record of information for the entire map
  18.     layers: array of T2DPointArray; // 3D integer array with the information for drawing the tiles. The TPoint holds the actual top left corner on the tilesheet
  19.     attribs: T2DIntArray; // layer that holds attributes for a tile
  20.     width, height, depth, sprite: Integer; // Width, height and depth for dimensions; sprite is layer where sprites are drawn on top of
  21.     vis: TIntegerArray; // Holds bitmap for visible layers
  22.     mC: TPoint; // Holds the top left position so we know which bits to draw
  23.     saved: Boolean; // Holds whether or not the map is currently saved
  24.     fp: string; // Holds filepath of where it is currently saved
  25.     fn: string; // Holds filename of map
  26.   end;
  27.  
  28. var
  29.   maps: array of TMap; // Holds the currently open maps
  30.   curMap: Integer; // Holds the index of currently visible map
  31.   curLay: Integer; // Holds the layer that everything is drawn onto
  32.   bitDeb: string; // Holds the string that has the info about all the bitmaps currently in use
  33.   bitLoc: TStringArray; // Holds the location from where the relating bitmap was created
  34.   drawSize: TPoint; // Holds the number of tiles to draw in regards to .x = width .y = height
  35.   shTile: TSheet; // See TSheet. shTile for tilesheet
  36.   drawTiles: TBox; // Holds the top left of the tile which is to be drawn upon clicking and the point where to draw to
  37.   drawArea: TPoint; // Holds the position where the mouse was pressed down on the map
  38.  
  39.   fMain: TForm; // Main form for editing or creating a map
  40.   iMain: TImage; // Main visible component for displaying the map
  41.   mMain: TMainMenu; // Main menu holder thingy
  42.   mFile: TMenuItem; // Menu that holds file relating stuff
  43.   mFileOpts: array of TMenuItem; // Run of the mill menu options stored in an array
  44.   menuNames: TStringArray; // Holds the names for the options in the mFileOpts array
  45.   pSheet: TPanel; // Holds all the tilesheet relating stuff
  46.   iSheet: TImage; // Visible component for displaying the tilesheet
  47.   pTile: TPanel; // Panel to hold the currently selected tile(s)
  48.   iTile: TImage; // Visible component for displaying currently selected tile
  49.   tcMain: TTabControl; // Main tab bit for holding the maps
  50.   sbHorz, sbVert: TScrollBar; // Main scrollbars for scrolling map movement
  51.   sbSheet: TScrollBox; // Scrollbox that the tilesheet goes into
  52.   bLayUp, bLayDo: TButton; // Change the layer that is currently being overwritten
  53.   lCurLay: TLabel; // Holds the visual display of currently select layer
  54.  
  55. procedure Crash(str: string); // Simple procedure to allow the script to crash easily from a single line due to laziness
  56. begin
  57.   Writeln('Crashing: ' + str); // Print the crashing reason
  58.   TerminateScript; // Stop the script running
  59. end;
  60.  
  61. function MBitmap(w, h: Integer; str, from: string): Integer; // Creation half of the memory leak debugging
  62. begin
  63.   Result := BitmapFromString(w, h, str); // Start by actually making the bitmap since we need the reference number
  64.   while (Length(bitDeb) < Result + 1) do // While the string is too short
  65.     bitDeb := bitDeb + '2'; // Increase the length of the string by adding a 2 which signifies bitmap created by alternate means
  66.   bitDeb[Result + 1] := '1'; // Set the index to 1 to signify in use - string's start at 1 not 0, hence the + 1
  67.   SetLength(bitLoc, Length(bitDeb) + 1); // This is 1 longer than the string due to it starting on 0 and me wanting them in line
  68.   bitLoc[Result + 1] := from; // Set where the bitmap was created from
  69.   //Writeln('Created bitmap number ' + IntToStr(Result + 1) + ' in procedure ''' + from + ''''); // Results in extremely large debug box
  70. end;
  71.  
  72.  
  73. procedure MFreeBitmap(b: Integer); // Destroying half of the memory leak debugging
  74. begin
  75.   FreeBitmap(b); // Start by freeing it as the reference remains afterwards
  76.   b := b + 1 // Increment it to line it up with the arrays
  77.   if (b > Length(bitDeb)) then // If the debug string is too short
  78.     exit; // Then we don't need to change anything (created by LoadBitmap or something similar) so exit procedure
  79.   //Writeln('Destroyed bitmap number ' + IntToStr(b) + ' which was created in procedure ''' + bitLoc[b] + ''''); // Results in extremely large debug box
  80.   bitDeb[b] := '0'; // Set to 0 to signify not in use
  81.   bitLoc[b] := ''; // Set to blank
  82. end;
  83.  
  84. procedure LoadSheet(var sheet: TSheet; filename: string); // Loads a sheet from a file
  85. var
  86.   s: TPoint;
  87. begin
  88.   sheet.b := LoadBitmap(filename); // Load the bitmap
  89.   GetBitmapSize(sheet.b, s.x, s.y); // Get actual dimensions
  90.   sheet.w := s.x div 32; // Convert to tile dimenions
  91.   sheet.h := s.y div 32; // As above
  92.   sheet.c := GetBitmapCanvas(sheet.b); // Get the canvas for the bitmap
  93. end;
  94.  
  95. procedure ConvertTile(var p: TPoint; i: Integer); // Changes integer based reference to an actual position
  96. begin
  97.   p.x := (i mod shTile.w) * 32; // mod by width to get the .x then * 32 to get actual location
  98.   p.y := (i div shTile.w) * 32; // div by width to get the .y then same as above
  99. end;
  100.  
  101. function ConvertBack(p: TPoint): Integer; // Change actual location back to integer reference
  102. begin
  103.   Result := ((p.y div 32) * shTile.w) + (p.x div 32); // div both by 32 to get tile reference then .y * width and add on .x
  104. end;
  105.  
  106. procedure FreeVisibleMap(tempMap: TMap);
  107. var
  108.   z: Integer;
  109. begin
  110.   for z := 0 to tempMap.depth - 1 do
  111.     MFreeBitmap(tempMap.vis[z]);
  112. end;
  113.  
  114. procedure CreateVisibleMap(var tempMap: TMap);
  115. var
  116.   z: Integer;
  117. begin
  118.   SetLength(tempMap.vis, tempMap.depth);
  119.   for z := 0 to tempMap.depth - 1 do
  120.     tempMap.vis[z] := MBitmap(drawSize.x * 32, drawSize.y * 32, '', 'CreateVisibleMap');
  121. end;
  122.  
  123. procedure GenerateBlankMap(var map: TMap; w, h, d: Integer);
  124. var
  125.   z, y, x: Integer;
  126. begin
  127.   map.depth := d;
  128.   map.height := h;
  129.   map.width := w;
  130.   map.sprite := Round(h / 1.5);
  131.   map.mC := Point(0, 0);
  132.   map.fp := ScriptPath;
  133.   map.saved := true;
  134.  
  135.   SetLength(map.layers, d);
  136.   SetLength(map.vis, d);
  137.  
  138.   for z := 0 to d - 1 do
  139.   begin
  140.     SetLength(map.layers[z], h);
  141.     if (z = 0) then
  142.       SetLength(map.attribs, h);
  143.     for y := 0 to h - 1 do
  144.     begin
  145.       SetLength(map.layers[z][y], w);
  146.       if (z = 0) then
  147.         SetLength(map.attribs[y], w);
  148.       for x := 0 to w - 1 do
  149.       begin
  150.         map.layers[z][y][x] := Point(-32, 0);
  151.         if (z = 0) then
  152.           map.attribs[y][x] := 0;
  153.       end;
  154.     end;
  155.   end;
  156.   CreateVisibleMap(map);
  157. end;
  158.  
  159. procedure PaintMap; // Paints the layers on to the form so we can see the map
  160. var
  161.   t, i: Integer;
  162. begin
  163.   t := MBitmap(480, 480, '', 'PaintMap'); // Create temp bitmap
  164.   FastDrawClear(t, clBlack); // Ensure temp bitmap is blank
  165.  
  166.   for i := 0 to maps[curMap].depth - 1 do // Loop through all layers
  167.   begin
  168.     SetTransparentColor(maps[curMap].vis[i], clBlack); // Set transparent colour so the layers work nicely
  169.     FastDrawTransparent(0, 0, maps[curMap].vis[i], t); // Draw sprite layer on with transparency so bottom layer is visible
  170.   end;
  171.  
  172.   SafeDrawBitmap(t, iMain.Canvas, 0, 0); // Draw the map onto the visual component
  173.   MFreeBitmap(t); // Free our temp bitmap
  174. end;
  175.  
  176. procedure RedrawMap(tempMap: TMap); // Draw the map entirely from scratch - can be very confusing to understand, but straight forward enough
  177. var
  178.   z, y, x, t, d: Integer;
  179.   p: TPoint;
  180.   ts, ds: TCanvas;
  181. begin
  182.   t := MBitmap(drawSize.x * 32, drawSize.y * 32, '', 'RedrawMap'); // Create temp bitmap
  183.  
  184.   ts := shTile.c; // Get the tilesheet's canvas
  185.   ds := GetBitmapCanvas(t); // Get the temp bitmap's canvas
  186.  
  187.   for z := 0 to tempMap.depth - 1 do // Loop through all the layers
  188.   begin
  189.     FastDrawClear(tempMap.vis[z], clBlack); // Ensure layer is clear
  190.     d := tempMap.vis[z]; // Set d to current layer
  191.     FastDrawClear(t, clBlack); // Clear the temp bitmap
  192.     p.y := -32; // Holds where to draw on the visible map - reset it here
  193.     for y := tempMap.mC.y to tempMap.mC.y + drawSize.y do // Loop through all on screen vertical tiles
  194.     begin
  195.       p.y := p.y + 32; // Increment the position by the height of a tile (32)
  196.       if (y < 0) then // If y is off the top of the map
  197.         continue // Go back to the beginning of the loop
  198.       else if (y >= tempMap.height) then // If y is off the bottom of the map
  199.         break; // It won't go back on, so break the loop
  200.  
  201.       p.x := -32; // Holds where to draw on the visible map - reset it here
  202.       for x := tempMap.mC.x to tempMap.mC.x + drawSize.x do // Loop through all on screen horizontal tiles
  203.       begin
  204.         p.x := p.x + 32; // Increment the position by the width of a tile
  205.         if (x < 0) then // If x is off the left of the map
  206.           continue // Go back to the beginning of the loop
  207.         else if (x >= tempMap.width) then // If x is off the right of the map
  208.           break; // It won't go back on, so break the loop
  209.         SafeCopyCanvas(ts, ds, tempMap.layers[z][y][x].x, tempMap.layers[z][y][x].y, tempMap.layers[z][y][x].x + 32, tempMap.layers[z][y][x].y + 32, p.x, p.y, p.x + 32, p.y + 32); // Using the 3D TPoint array, copy the tile onto the temp bitmap using TPoint p for where to draw
  210.       end;
  211.     end;
  212.     SetTransparentColor(t, 16448505); // Tiles use a near white colour for transparency, so set it to allow layered maps
  213.     FastDrawTransparent(0, 0, t, d); // Draw the layer transparently onto appropriate bitmap
  214.   end;
  215.  
  216.   MFreeBitmap(t); // Free our temp bitmap
  217. end;
  218.  
  219. procedure RedrawArea(ts, te, dp: TPoint); // A procedure similar to RedrawMap, but with alterations so it only redraws the set area and then draws it where told
  220. var
  221.   t, d, z, y, x, w, h: Integer;
  222.   tc, tsc: TCanvas;
  223.   p: TPoint;
  224.   tempMap: TMap;
  225. begin
  226.   tempMap := maps[curMap];
  227.   w := (te.x - ts.x) * 32; // Get the width to draw by getting the difference in start and end then multiplying by tile width
  228.   h := (te.y - ts.y) * 32; // As above, only height
  229.   t := MBitmap(w + 32, h + 32, '', 'RedrawArea'); // Setup the bitmap used to draw the new stuff
  230.   tsc := shTile.c; // Get the tilesheet's canvas
  231.   tc := GetBitmapCanvas(t); // Get the temp bitmap's canvas
  232.  
  233.   for z := 0 to tempMap.depth - 1 do // Loop through all layers
  234.   begin
  235.     d := tempMap.vis[z];
  236.     FastDrawClear(t, clBlack); // Clear temp bitmap
  237.     p.y := -32; // Reset p.y
  238.     for y := ts.y to te.y do
  239.     begin
  240.       p.y := p.y + 32; // Increment position to draw to
  241.       p.x := -32;
  242.       if (y < 0) then // If y is not valid due to being too far up
  243.         Continue // Skip to beginning of loop
  244.       else if (y >= tempMap.width) then // If y is not valid due to being too far down
  245.         break; // Break the loop as there's no hope of it returning
  246.  
  247.       for x := ts.x to te.x do // Loop through all columns
  248.       begin
  249.         p.x := p.x + 32; // Increment position to draw to
  250.         if (x < 0) then // If x is not valid due to being too far left
  251.           Continue // Skip to beginning of loop
  252.         else if (x >= tempMap.width) then // If x is not valid due to being too far right
  253.           break; // Break the loop as there's no hope of it returning
  254.  
  255.         SafeCopyCanvas(tsc, tc, tempMap.layers[z][y][x].x, tempMap.layers[z][y][x].y, tempMap.layers[z][y][x].x + 32, tempMap.layers[z][y][x].y + 32, p.x, p.y, p.x + 32, p.y + 32); // Using the 3D TPoint array, copy the tile onto the temp bitmap using TPoint p for where to draw
  256.       end;
  257.     end;
  258.  
  259.     SetTransparentColor(t, 16448505); // Tiles use a near white colour for transparency, so set it to allow layered maps
  260.     FastDrawTransparent(dp.x, dp.y, t, d); // Draw the layer transparently onto appropriate bitmap
  261.   end;
  262.  
  263.   MFreeBitmap(t); // Free our temp bitmap
  264. end;
  265.  
  266. procedure HandleMovement(amount: Integer; dir: Integer); // Wrapper procedure for RedrawArea
  267. var
  268.   t, z: Integer;
  269.   tc: TCanvas;
  270.   s, e, o, d: TPoint;
  271. begin
  272.   if (amount < 0) then
  273.     amount := - amount;
  274.   t := MBitmap((drawSize.x + 1) * 32, (drawSize.y + 1) * 32, '', 'HandleMovement');
  275.   tc := GetBitmapCanvas(t);
  276.   s := maps[curMap].mC;
  277.   e := Point(s.x + drawSize.x, s.y + drawSize.y);
  278.   o := Point(0, 0);
  279.   d := Point(0, 0);
  280.   case dir of
  281.     1: begin
  282.       e.y := s.y + amount;
  283.       o.y := amount * 32;
  284.     end;
  285.     2: begin
  286.       e.x := s.x + amount;
  287.       o.x := amount * 32;
  288.     end;
  289.     3: begin
  290.       s.y := e.y - amount;
  291.       o.y := - (amount * 32);
  292.       d.y := (drawSize.y - amount) * 32;
  293.     end;
  294.     4: begin
  295.       s.x := e.x - amount;
  296.       o.x := - (amount * 32);
  297.       d.x := (drawSize.x - amount) * 32;
  298.     end;
  299.   end;
  300.  
  301.   for z := 0 to maps[curMap].depth - 1 do
  302.   begin
  303.     SafeDrawBitmap(maps[curMap].vis[z], tc, o.x, o.y);
  304.     SafeDrawBitmap(t, GetBitmapCanvas(maps[curMap].vis[z]), 0, 0);
  305.   end;
  306.  
  307.   MFreeBitmap(t);
  308.  
  309.   RedrawArea(s, e, d);
  310.   PaintMap;
  311. end;
  312.  
  313. procedure AddMap(w, h, d: Integer); // Handles the setting up of a new map
  314. var
  315.   l: Integer;
  316. begin
  317.   l := Length(maps); // Get the length of the array
  318.   SetLength(maps, l + 1); // Increase the length of the array by 1 for the new map
  319.   GenerateBlankMap(maps[l], w, h, d); // See 'GenerateBlankMap'
  320.   tcMain.Tabs.Append('Untitled'); // Add a new tab to access it
  321.   tcMain.TabIndex := tcMain.Tabs.Count - 1; // Switch to the new tab
  322.   curMap := l; // Update curMap as well so that drawing isn't done to random maps
  323.   maps[curMap].fp := ScriptPath;
  324.   maps[curMap].fn := 'Untitled';
  325.   curLay := d - 1; // Set the drawing layer to the top layer by default
  326.   lCurLay.Caption := 'Layer ' + IntToStr(curLay) + ' selected'; // Update the layer caption so we know where we are at
  327. end;
  328.  
  329. procedure NewMap;
  330. begin
  331.   AddMap(25, 25, 3);
  332.   RedrawMap(maps[curMap]);
  333.   PaintMap;
  334. end;
  335.  
  336. procedure SetMapInfo(index: Integer; fpstr: string);
  337. begin
  338.   maps[index].saved := True; // Toggle saved to true to show that it has been saved and not modified
  339.   maps[index].fp := ExtractFilePath(fpstr); // Update the filepath to the map
  340.   maps[index].fn := ExtractFileName(fpstr); // Update the filename of the map
  341.   maps[index].fn := Copy(maps[index].fn, 1, LastPos('.', maps[curMap].fn) - 1); // And remove the file extension
  342.   tcMain.Tabs[index] := maps[index].fn; // Update the tab to show the filename minus extension
  343. end;
  344.  
  345. procedure MapImplode(var arr: TStringArray; var tempMap: TMap); // Breaks down the map into an array to be used for saving maps
  346. var
  347.   z, y, x, i: Integer;
  348. begin
  349.   SetLength(arr, 0); // Ensure array passed is empty
  350.   if ((tempMap.depth <= 0) or (tempMap.height <= 0) or (tempMap.width <= 0)) then // If map is blank/invalid size
  351.     Crash('Imploding map of invalid dimensions (one is set to zero)'); // Crash
  352.   i := 2 + (((tempMap.depth + 1) * (tempMap.height + 1)) - 1); // 2 is for the first line to hold dimension size then a blank line after. Layers held in "paragraphs", so for every layer, there should be height + 1 strings to allow for blank line underneath and then you take one away as bottom "paragraph" doesn't need blank line and 1 as added to depth for the attributes layer
  353.   SetLength(arr, i); // Set the length so it's the right length for the data
  354.   arr[0] := IntToStr(tempMap.width) + ',' + IntToStr(tempMap.height) + ',' + IntToStr(tempMap.depth); // Set first array index to hold dimenions info (x by y by z)
  355.   for x := 1 to i - 1 do // Loop through all arrays
  356.     arr[x] := ''; // Set to blank to ensure no corruption
  357.   i := 1; // Set i to 1 as 0 is used for dimensions, then 1 as a blank line - i is incremented once before being used for the first time
  358.   for z := 0 to tempMap.depth do // Loop through all layers and the attributes
  359.   begin
  360.     for y := 0 to tempMap.height - 1 do // Loop through all rows
  361.     begin
  362.       i := i + 1; // Increment i so it points to next blank array
  363.       for x := 0 to tempMap.width - 1 do // Loop through all columns
  364.         if (z < tempMap.depth) then // if it is a visual layer
  365.           arr[i] := arr[i] + IntToStr(ConvertBack(tempMap.layers[z][y][x])) + ',' // Append the converted tile and a comma to the end of the array
  366.         else // if it is the attirbutes layer
  367.           arr[i] := arr[i] + IntToStr(tempMap.attribs[y][x]) + ','; // Append the attribute and a comma to the end of the array
  368.       Delete(arr[i], Length(arr[i]), 1); // Remove the trailing comma
  369.     end;
  370.     i := i + 1; // Increment i to give the blank line between "paragraphs"
  371.   end;
  372. end;
  373.  
  374. procedure SaveMap(filename: string); // Outputs the map to a file
  375. var
  376.   f, i: Integer;
  377.   s: TStringArray;
  378. begin
  379.   f := RewriteFile(filename, False); // Open file and wipe it or create the file then assign to f
  380.   MapImplode(s, maps[curMap]); // See MapImplode
  381.   for i := 0 to High(s) do // Loop through s
  382.     WriteFileString(f, s[i] + #13 + #10); // Write to file with new line after
  383.   CloseFile(f); // Close the file
  384. end;
  385.  
  386. procedure ExportMap; // GUI method of saving a map by opening a TSaveDialog
  387. var
  388.   dialog: TSaveDialog;
  389. begin
  390.   dialog := TSaveDialog.Create(nil); // Create parentless save dialog
  391.   dialog.Filter := 'ScaRPG map|*.srpg'; // Set filter to only allow the the extension specified
  392.   dialog.InitialDir := maps[curMap].fp; // Set starting directory to same as where script is saved if not saved, else to same place if previously saved
  393.   if (not dialog.Execute) then // If no file is specified after opening the dialog and it is closed
  394.     exit; // exit procedure
  395.   SaveMap(dialog.filename); // See SaveMap - the chosen file is passed as where to save it to
  396.   SetMapInfo(curMap, dialog.filename);
  397. end;
  398.  
  399. procedure MExplode(var arr: TStringArray; str, del: string); // Standard Explode procedure written for older Scar versions
  400. var
  401.   i, h, l: Integer;
  402. begin
  403.   SetLength(arr, 0); // Ensure passed array is blank
  404.   h := -1; // Set high of array to -1
  405.   l := Length(del) - 1; // Amount to delete by based on del's length to ensure it is removed if longer than 1 char
  406.   while (true) do // Endless loop
  407.   begin
  408.     h := h + 1; // Increment h
  409.     SetLength(arr, h + 1); // Make array longer by one
  410.     i := Pos(del, str); // Find first occurence of del in str
  411.     if (i = 0) then // If it is not found
  412.       break; // Break from loop
  413.     arr[h] := Copy(str, 1, i - 1); // Copy the text until del (not including del) to the array
  414.     Delete(str, 1, i + l); // Remove copied text as well as del
  415.   end;
  416.   arr[h] := Copy(str, 1, Length(str)); // Copy remaining text into the array - del should not be on it, so no need to copy shorter than the length
  417. end;
  418.  
  419. function StrInt(s: string): Integer; // "Safe" version of IntToStr to catch dodgy map files specifically
  420. begin
  421.   try
  422.     Result := StrToInt(s); // Try standard conversion
  423.   except // If it is non-numeric
  424.     if (s = '') then // If it is blank
  425.       Result := 0 // Set to 0
  426.     else // If non-numeric and not blank
  427.       Crash('StrInt passed invalid string - "' + s + '"'); // Crash
  428.   end;
  429. end;
  430.  
  431. procedure MapExplode(var tempMap: TMap; str: string); // Creates the backend for the visual map from a string
  432. var
  433.   lineArr: TStringArray;
  434.   mapArr: array of TStringArray;
  435.   i, z, y, x: Integer;
  436. begin
  437.   if (Pos(#13 + #10, str) = 0) then // If no enter's are found in the string
  438.     Crash('Exploding map from an invalid input string'); // Crash
  439.  
  440.   MExplode(lineArr, str, #13 + #10); // See MExplode - breaks into seperate lines
  441.   SetLength(mapArr, Length(lineArr)); // Set 2D array to the same length as the number of lines
  442.   for i := 0 to High(lineArr) do // Loop through all the lines
  443.     MExplode(mapArr[i], lineArr[i], ','); //See MExplode - breaks into seperate values between the comma's
  444.    
  445.   tempMap.width := StrInt(mapArr[0][0]); // Set the dimension of the map based on the extracted values
  446.   tempMap.height := StrInt(mapArr[0][1]); // As above
  447.   tempMap.depth := StrInt(mapArr[0][2]); // As above
  448.  
  449.   i := 2; // Set i to 2 - the first array relating to the map
  450.  
  451.   // This section is like the inverse of the main loop in MapImplode
  452.   SetLength(tempMap.layers, tempMap.depth); // Set the 3D TPoint array to length of the depth
  453.   for z := 0 to tempMap.depth - 1 do // Loop through all layers and the attribute layer
  454.   begin
  455.     SetLength(tempMap.layers[z], tempMap.height); // Set a 2D TPoint array to length of the height
  456.     for y := 0 to tempMap.height - 1 do // Loop through all rows
  457.     begin
  458.       SetLength(tempMap.layers[z][y], tempMap.width); // Set the TPoint array to the length of the width
  459.       for x := 0 to tempMap.width - 1 do // Loop through all columns
  460.         ConvertTile(tempMap.layers[z][y][x], StrInt(mapArr[i][x])); // See ConvertTile - this is done so that map painting requires less calculations
  461.       i := i + 1; // Go onto the next line of the loaded "paragraph"
  462.     end;
  463.     i := i + 1; // Would be a blank line here, so go on to the next
  464.   end;
  465.  
  466.   SetLength(tempMap.attribs, tempMap.height); // Set the height of the 2DIntArray
  467.   for y := 0 to tempMap.height - 1 do // Loop through all rows
  468.   begin
  469.     SetLength(tempMap.attribs[y], tempMap.width); // Set the width of the TIntegerArray
  470.     for x := 0 to tempMap.width - 1 do // Loop through all columns
  471.       tempMap.attribs[y][x] := StrInt(mapArr[i][x]); // Convert the string into an integer attribute value
  472.     i := i + 1;
  473.   end;
  474. end;
  475.  
  476. procedure LoadMap(filename: string); // Handles the loading of a map file and doing what needs to be done
  477. var
  478.   f: Integer;
  479.   s: string;
  480. begin
  481.   if (not FileExists(filename)) then // If file does not exist
  482.     Crash('File specified to load does not exist - "' + filename + '"'); // Crash
  483.   f := OpenFile(filename, False); // Open the file specified
  484.   ReadFileString(f, s, FileSize(f)); // Read the contents of the file
  485.   CloseFile(f); // Close the file
  486.   MapExplode(maps[curMap], s); // See MapExplode - pass the file contents to break apart
  487. end;
  488.  
  489. procedure ImportMap; // GUI method of opening a map by opening a TOpemDialog
  490. var
  491.   dialog: TOpenDialog;
  492. begin
  493.   dialog := TOpenDialog.Create(nil); // Create a parentless open dialog
  494.   dialog.Filter := 'ScaRPG map|*.srpg'; // Set the filter to only show map files
  495.   if (ScriptPath <> '') then // If the script is saved
  496.     dialog.InitialDir := ScriptPath; // Set the starting directory to the place where the script is saved in
  497.   if (not dialog.Execute) then // If the dialog is launched and no file is selected when closed
  498.     exit; // exit procedure
  499.   if (not maps[curMap].saved) then // If map isn't saved
  500.     AddMap(1, 1, 1); // Then open a new tab instead
  501.   FreeVisibleMap(maps[curMap]); // Need to "refresh" the visible bitmap holders
  502.   LoadMap(dialog.filename); // See LoadMap - passing the selected file as the one to load
  503.   CreateVisibleMap(maps[curMap]); // Set up the visible layers
  504.   SetMapInfo(curMap, dialog.filename);
  505.   RedrawMap(maps[curMap]); // Redraw the map as it is unconstructed
  506.   PaintMap; // Then paint it onto the form
  507. end;
  508.  
  509. procedure CloseMap(var index: Integer);
  510. var
  511.   i: Integer;
  512. begin
  513.   FreeVisibleMap(maps[index]);
  514.   if (index < High(maps)) then
  515.   begin
  516.     for i := index to High(maps) - 1 do
  517.       Swap(maps[i], maps[i + 1]);
  518.   end
  519.   else if (index = 0) then
  520.   begin
  521.     AddMap(25, 25, 3);
  522.     curMap := 0;
  523.     Swap(maps[0], maps[1]);
  524.     RedrawMap(maps[0]);
  525.   end;
  526.   SetLength(maps, High(maps));
  527.   tcMain.Tabs.Delete(index);
  528.   if (index > High(maps)) then
  529.     index := index - 1;
  530.   PaintMap;
  531. end;
  532.  
  533. procedure OnMapMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  534. begin
  535.   drawArea := Point(Trunc(x / 32.0), Trunc(y / 32.0));
  536. end;
  537.  
  538. procedure OnMapMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  539. var
  540.   d, t, r: TPoint;
  541.   a, b: Integer;
  542. begin
  543.   X := Trunc(X / 32.0);
  544.   Y := Trunc(Y / 32.0);
  545.   d := Point(X, Y);
  546.   if (d.x < drawArea.x) then
  547.     Swap(d.x, drawArea.x);
  548.   if (d.y < drawArea.y) then
  549.     Swap(d.y, drawArea.y);
  550.   X := maps[curMap].mC.x + drawArea.x;
  551.   Y := maps[curMap].mC.y + drawArea.y;
  552.   t := Point(d.x - drawArea.x, d.y - drawArea.y);
  553.   for a := 0 to t.y do
  554.     for b := 0 to t.x do
  555.       maps[curMap].layers[curLay][Y + a][X + b] := Point(drawTiles.x1 + ((b mod drawTiles.x2) * 32), drawTiles.y1 + ((a mod drawTiles.y2) * 32));
  556.   r := Point(drawArea.x * 32, drawArea.y * 32);
  557.   RedrawArea(Point(X, Y), Point(X + t.x, Y + t.y), r);
  558.   PaintMap;
  559. end;
  560.  
  561. procedure OnMapScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
  562. var
  563.   dir, amo: Integer;
  564. begin
  565.   if (Sender = sbHorz) then
  566.   begin
  567.     amo := maps[curMap].mC.x - sbHorz.Position;
  568.     maps[curMap].mC.x := sbHorz.Position;
  569.     if (amo < 0) then
  570.       dir := 4
  571.     else
  572.       dir := 2;
  573.   end
  574.   else if (Sender = sbVert) then
  575.   begin
  576.     amo := maps[curMap].mC.y - sbVert.Position;
  577.     maps[curMap].mC.y := sbVert.Position;
  578.     if (amo < 0) then
  579.       dir := 3
  580.     else
  581.       dir := 1;
  582.   end;
  583.   HandleMovement(amo, dir);
  584. end;
  585.  
  586. procedure OnTilesheetMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  587. begin
  588.   drawTiles.x1 := Trunc(X / 32.0) * 32;
  589.   drawTiles.y1 := Trunc(Y / 32.0) * 32;
  590. end;
  591.  
  592. procedure OnTilesheetMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  593. var
  594.   r, h: Integer;
  595. begin
  596.   X := Trunc(X / 32.0) * 32;
  597.   Y := Trunc(Y / 32.0) * 32;
  598.   drawTiles.x2 := X
  599.   drawTiles.y2 := Y;
  600.   if (drawTiles.x2 < drawTiles.x1) then
  601.     Swap(drawTiles.x1, drawTiles.x2);
  602.   if (drawTiles.y2 < drawTiles.y1) then
  603.     Swap(drawTiles.y1, drawTiles.y2);
  604.  
  605.   drawTiles.x2 := ((drawTiles.x2 - drawTiles.x1) div 32) + 1
  606.   drawTiles.y2 := ((drawTiles.y2 - drawTiles.y1) div 32) + 1
  607.  
  608.   if (drawTiles.x2 >= drawTiles.y2) then
  609.     h := drawTiles.x2
  610.   else
  611.     h := drawTiles.y2;
  612.   if (h = 0) then
  613.     h := 1;
  614.   r := Trunc(64.0 / h);
  615.   if (r = 0) then
  616.     r := 1;
  617.  
  618.   iTile.Canvas.Brush.Color := clBlack;
  619.   iTile.Canvas.Rectangle(0, 0, 64, 64);
  620.   SafeCopyCanvas(shTile.c, iTile.Canvas, drawTiles.x1, drawTiles.y1, drawTiles.x1 + (drawTiles.x2 * 32), drawTiles.y1 + (drawTiles.y2 * 32), 0, 0, drawTiles.x2 * r, drawTiles.y2 * r);
  621. end;
  622.  
  623. procedure OnButtonClick(Sender: TObject);
  624. begin
  625.   if (Sender = bLayUp) then
  626.   begin
  627.     curLay := curLay + 1;
  628.     if (curLay >= maps[curMap].depth) then
  629.       curLay := 0;
  630.   end
  631.   else
  632.   begin
  633.     curLay := curLay - 1;
  634.     if (curLay <= -1) then
  635.       curLay := maps[curMap].depth - 1;
  636.   end;
  637.   lCurLay.Caption := 'Layer ' + IntToStr(curLay) + ' selected'; // Update the layer caption so we know where we are drawing at
  638. end;
  639.  
  640. procedure OnMenuClick(Sender: TObject);
  641. var
  642.   i, opt: Integer;
  643. begin
  644.   opt := -1;
  645.   for i := 0 to High(mFileOpts) do
  646.     if (Sender = mFileOpts[i]) then
  647.     begin
  648.       opt := i;
  649.       break;
  650.     end;
  651.   if (opt = -1) then
  652.   begin
  653.     Writeln('I don''t know how you managed it, but you clicked on a non-existent menu item');
  654.     exit;
  655.   end;
  656.   case opt of
  657.     0: NewMap;
  658.     1: ImportMap;
  659.     2: ExportMap;
  660.     3: CloseMap(curMap);
  661.   end;
  662.  
  663.   sbHorz.Position := maps[curMap].mC.x;
  664.   sbVert.Position := maps[curMap].mC.y;
  665. end;
  666.  
  667. procedure OnTabChange(Sender: TObject);
  668. begin
  669.   curMap := tcMain.TabIndex;
  670.   sbHorz.Position := maps[curMap].mC.x;
  671.   sbVert.Position := maps[curMap].mC.y;
  672.   PaintMap;
  673. end;
  674.  
  675. procedure ApplyGrid(var img: TImage; col: Integer);
  676. var
  677.   x, y, xl, yl, tc: Integer;
  678. begin
  679.   xl := img.Width div 32;
  680.   yl := img.Height div 32;
  681.   tc := img.Canvas.Pen.Color;
  682.   img.Canvas.Pen.Color := col;
  683.   if (yl > 2) then
  684.     for y := 1 to yl - 1 do
  685.     begin
  686.       img.Canvas.MoveTo(0, y * 32);
  687.       img.Canvas.LineTo(img.Width, y * 32);
  688.     end;
  689.   if (xl > 2) then
  690.     for x := 1 to xl - 1 do
  691.     begin
  692.       img.Canvas.MoveTo(x * 32, 0);
  693.       img.Canvas.LineTo(x * 32, img.Height);
  694.     end;
  695.   img.Canvas.Pen.Color := tc;
  696. end;
  697.  
  698. // Standard form setup procedure - no comments
  699. procedure SetupForm;
  700. var
  701.   i: Integer;
  702. begin
  703.   fMain := CreateForm;
  704.  
  705.   mMain := TMainMenu.Create(fMain);
  706.   mFile := TMenuItem.Create(fMain);
  707.   mFIle.Caption := 'File';
  708.   menuNames := ['New', 'Open', 'Save', 'Close'];
  709.   SetLength(mFileOpts, Length(menuNames));
  710.  
  711.   for i := 0 to High(mFileOpts) do
  712.   begin
  713.     mFileOpts[i] := TMenuItem.Create(fMain);
  714.     mFileOpts[i].Caption := menuNames[i];
  715.     mFileOpts[i].OnClick := @OnMenuClick;
  716.     mFIle.Add(mFileOpts[i]);
  717.   end;
  718.  
  719.   mMain.Items.Add(mFile);
  720.  
  721.   with fMain do
  722.   begin
  723.     Caption := 'ScaRPG - Map Editor';
  724.     ClientWidth := ((drawSize.x + 1) * 32) + ((shTile.w + 1) * 32) + 32;
  725.     ClientHeight := ((drawSize.y + 1) * 32) + 32;
  726.     Position := poDesktopCenter;
  727.   end;
  728.  
  729.   pSheet := TPanel.Create(fMain);
  730.   with pSheet do
  731.   begin
  732.     Parent := fMain;
  733.     Width := (shTile.w + 1) * 32;
  734.     Height := fMain.ClientHeight;
  735.     Left := fMain.ClientWidth - Width;
  736.     Top := 0;
  737.   end;
  738.  
  739.   sbSheet := TScrollBox.Create(pSheet);
  740.   with sbSheet do
  741.   begin
  742.     Parent := pSheet;
  743.     Align := alClient;
  744.   end;
  745.  
  746.   iSheet := TImage.Create(sbSheet);
  747.   with iSheet do
  748.   begin
  749.     Parent := sbSheet;
  750.     Left := 0;
  751.     Top := 0;
  752.     Width := (shTile.w * 32);
  753.     Height := (shTile.h * 32);
  754.     SafeDrawBitmap(shTile.b, Canvas, 0, 0);
  755.     OnMouseDown := @OnTilesheetMouseDown;
  756.     OnMouseUp := @OnTilesheetMouseUp;
  757.     ApplyGrid(iSheet, clRed);
  758.   end;
  759.  
  760.   pTile := TPanel.Create(pSheet);
  761.   with pTile do
  762.   begin
  763.     Parent := pSheet;
  764.     Align := alBottom;
  765.     Height := 96;
  766.   end;
  767.  
  768.   iTile := TImage.Create(pTile);
  769.   with iTile do
  770.   begin
  771.     Parent := pTile;
  772.     Left := 16;
  773.     Top := 16;
  774.     Width := 64;
  775.     Height := 64;
  776.     SafeCopyCanvas(shTile.c, Canvas, 0, 0, 32, 32, 0, 0, 64, 64);
  777.   end;
  778.  
  779.   bLayUp := TButton.Create(pTile);
  780.   with bLayUp do
  781.   begin
  782.     Parent := pTile;
  783.     Left := 96;
  784.     Top := 16;
  785.     Width := 32;
  786.     Height := 32;
  787.     Caption := '^';
  788.     OnClick := @OnButtonClick;
  789.   end;
  790.  
  791.   bLayDo := TButton.Create(pTile);
  792.   with bLayDo do
  793.   begin
  794.     Parent := pTile;
  795.     Left := 96;
  796.     Top := 48;
  797.     Width := 32;
  798.     Height := 32;
  799.     Caption := 'v';
  800.     OnClick := @OnButtonClick;
  801.   end;
  802.  
  803.   lCurLay := TLabel.Create(pTile);
  804.   with lCurLay do
  805.   begin
  806.     Parent := pTile;
  807.     Left := 144;
  808.     Top := 32;
  809.     Caption := 'Layer ' + IntToStr(curLay) + ' selected';
  810.   end;
  811.  
  812.   tcMain := TTabControl.Create(fMain);
  813.   with tcMain do
  814.   begin
  815.     Parent := fMain;
  816.     Left := 0;
  817.     Top := 0;
  818.     Width := (drawSize.x * 32) + 48;
  819.     Height := (drawSize.y * 32) + 64;
  820.     AddMap(20, 20, 3);
  821.     OnChange := @OnTabChange;
  822.   end;
  823.  
  824.   iMain := TImage.Create(tcMain);
  825.   with iMain do
  826.   begin
  827.     Parent := tcMain;
  828.     Left := 16;
  829.     Top := 32;
  830.     Width := drawSize.x * 32;
  831.     Height := drawSize.y * 32;
  832.     OnMouseDown := @OnMapMouseDown;
  833.     OnMouseUp := @OnMapMouseUp;
  834.     ApplyGrid(iMain, clRed);
  835.   end;
  836.  
  837.   sbHorz := TScrollBar.Create(tcMain);
  838.   with sbHorz do
  839.   begin
  840.     Parent := tcMain;
  841.     Left := 16;
  842.     Top := 32 + iMain.Height;
  843.     Width := iMain.Width;
  844.     Height := 16;
  845.     Kind := sbHorizontal;
  846.     Max := maps[curMap].Width - drawSize.x;
  847.     OnScroll := @OnMapScroll;
  848.   end;
  849.  
  850.   sbVert := TScrollBar.Create(tcMain);
  851.   with sbVert do
  852.   begin
  853.     Parent := tcMain;
  854.     Left := 16 + iMain.Width;
  855.     Top := 32;
  856.     Width := iMain.Width;
  857.     Height := 16;
  858.     Kind := sbVertical;
  859.     Max := maps[curMap].Height - drawSize.y;
  860.     OnScroll := @OnMapScroll;
  861.   end;
  862.  
  863.   RedrawMap(maps[curMap]);
  864.   PaintMap;
  865.   fMain.ShowModal;
  866. end;
  867.  
  868. var
  869.   v: TVariantArray;
  870.   m, z, i: Integer;
  871. // Main loop - no comments
  872. begin
  873.   Writeln('begin');
  874.   drawSize := Point(15, 15);
  875.   LoadSheet(shTile, ScriptPath + 'Tiles.bmp');
  876.  
  877.   ThreadSafeCall('SetupForm', v);
  878. //  SetupForm; // Use without SafeCall for debugging unknown errors, though very prone to self destruct when done so - use at own risk
  879.   FreeForm(fMain);
  880.  
  881.   for m := 0 to High(maps) do
  882.     for z := 0 to maps[m].depth - 1 do
  883.       MFreeBitmap(maps[m].vis[z]);
  884.   FreeBitmap(shTile.b);
  885.  
  886.   // Section for debugging memory leaks - see MBitmap and MFreeBitmap
  887.   // Don't rely on it for fixing all leaks - only works when you use MBitmap and not LoadBitmap etc.
  888.   while True do
  889.   begin
  890.     i := Pos('1', bitDeb);
  891.     if (i = 0) then
  892.       Break;
  893.     Writeln('Bitmap created from ''' + bitLoc[i] + ''' not freed!');
  894.     MFreeBitmap(i - 1);
  895.   end;
  896.  
  897.   Writeln('end');
  898. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement