Advertisement
mixster

mixster

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