Advertisement
mixster

mixster

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