Advertisement
mixster

mixster

Jun 19th, 2009
206
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 48.85 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: T2DPointArray; // Holds the tiles in a box shape of which to draw
  37.   drawArea: TPoint; // Holds the position where the mouse was pressed down on the map
  38.   mode: TPoint; // Holds which method of altering and in what way
  39.   selTiles: TPointArray; // Holds the tiles that are selected when in mode x2
  40.  
  41.   fMain: TForm; // Main form for editing or creating a map
  42.   iMain: TImage; // Main visible component for displaying the map
  43.   mMain: TMainMenu; // Main menu holder thingy
  44.   mFile: TMenuItem; // Menu that holds file relating stuff
  45.   mFileOpts: array of TMenuItem; // Run of the mill menu options stored in an array
  46.   menuNames: TStringArray; // Holds the names for the options in the mFileOpts array
  47.   pSheet: TPanel; // Holds all the tilesheet relating stuff
  48.   iSheet: TImage; // Visible component for displaying the tilesheet
  49.   pTile: TPanel; // Panel to hold the currently selected tile(s) and similar stuff
  50.   iTile: TImage; // Visible component for displaying currently selected tile
  51.   bTools: array of TButton; // Buttons that switch to different map tools
  52.   toolHints: TStringArray; // Holds the hints for the buttons
  53.   tcMain: TTabControl; // Main tab bit for holding the maps
  54.   sbHorz, sbVert: TScrollBar; // Main scrollbars for scrolling map movement
  55.   sbSheet: TScrollBox; // Scrollbox that the tilesheet goes into
  56.   bLayUp, bLayDo: TButton; // Change the layer that is currently being overwritten
  57.   lCurLay: TLabel; // Holds the visual display of currently select layer
  58.   ppMain: TPopupMenu; // The main popup menu for when right clicking on the map - handles size adjustment
  59.   pmMain: array of TMenuItem; // Holds the main menu items for the popup
  60.   pmSub: array of array of TMenuItem; // Holds the submenu items for the the popup
  61.   pmOpts: array of array of array of TMenuItem; // Holds the popup menu options for adjusting map size
  62.  
  63. procedure Crash(str: string); // Simple procedure to allow the script to crash easily from a single line due to laziness
  64. begin
  65.   Writeln('Crashing: ' + str); // Print the crashing reason
  66.   TerminateScript; // Stop the script running
  67. end;
  68.  
  69. function MBitmap(w, h: Integer; str, from: string): Integer; // Creation half of the memory leak debugging
  70. begin
  71.   Result := BitmapFromString(w, h, str); // Start by actually making the bitmap since we need the reference number
  72.   while (Length(bitDeb) < Result + 1) do // While the string is too short
  73.     bitDeb := bitDeb + '2'; // Increase the length of the string by adding a 2 which signifies bitmap created by alternate means
  74.   bitDeb[Result + 1] := '1'; // Set the index to 1 to signify in use - string's start at 1 not 0, hence the + 1
  75.   SetLength(bitLoc, Length(bitDeb) + 1); // This is 1 longer than the string due to it starting on 0 and me wanting them in line
  76.   bitLoc[Result + 1] := from; // Set where the bitmap was created from
  77. end;
  78.  
  79.  
  80. procedure MFreeBitmap(b: Integer); // Destroying half of the memory leak debugging
  81. begin
  82.   FreeBitmap(b); // Start by freeing it as the reference remains afterwards
  83.   b := b + 1 // Increment it to line it up with the arrays
  84.   if (b > Length(bitDeb)) then // If the debug string is too short
  85.     exit; // Then we don't need to change anything (created by LoadBitmap or something similar) so exit procedure
  86.   bitDeb[b] := '0'; // Set to 0 to signify not in use
  87.   bitLoc[b] := ''; // Set to blank
  88. end;
  89.  
  90. procedure LoadSheet(var sheet: TSheet; filename: string); // Loads a sheet from a file
  91. var
  92.   s: TPoint;
  93. begin
  94.   sheet.b := LoadBitmap(filename); // Load the bitmap
  95.   GetBitmapSize(sheet.b, s.x, s.y); // Get actual dimensions
  96.   sheet.w := s.x div 32; // Convert to tile dimenions
  97.   sheet.h := s.y div 32; // As above
  98.   sheet.c := GetBitmapCanvas(sheet.b); // Get the canvas for the bitmap
  99. end;
  100.  
  101. procedure ConvertTile(var p: TPoint; i: Integer); // Changes integer based reference to an actual position
  102. begin
  103.   p.x := (i mod shTile.w) * 32; // mod by width to get the .x then * 32 to get actual location
  104.   p.y := (i div shTile.w) * 32; // div by width to get the .y then same as above
  105. end;
  106.  
  107. function ConvertBack(p: TPoint): Integer; // Change actual location back to integer reference
  108. begin
  109.   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
  110. end;
  111.  
  112. procedure FreeVisibleMap(tempMap: TMap); // Frees all the drawing bitmaps
  113. var
  114.   z: Integer;
  115. begin
  116.   for z := 0 to tempMap.depth - 1 do // Loop through all the layers
  117.     MFreeBitmap(tempMap.vis[z]); // and free the bitmap used for drawing
  118. end;
  119.  
  120. procedure CreateVisibleMap(var tempMap: TMap);
  121. var
  122.   z: Integer;
  123. begin
  124.   SetLength(tempMap.vis, tempMap.depth);
  125.   for z := 0 to tempMap.depth - 1 do
  126.     tempMap.vis[z] := MBitmap(drawSize.x * 32, drawSize.y * 32, '', 'CreateVisibleMap');
  127. end;
  128.  
  129. procedure GenerateBlankMap(var map: TMap; w, h, d: Integer);
  130. var
  131.   z, y, x: Integer;
  132. begin
  133.   map.depth := d;
  134.   map.height := h;
  135.   map.width := w;
  136.   map.sprite := Round(h / 1.5);
  137.   map.mC := Point(0, 0);
  138.   map.fp := ScriptPath;
  139.   map.saved := true;
  140.  
  141.   SetLength(map.layers, d);
  142.   SetLength(map.vis, d);
  143.  
  144.   for z := 0 to d - 1 do
  145.   begin
  146.     SetLength(map.layers[z], h);
  147.     if (z = 0) then
  148.       SetLength(map.attribs, h);
  149.     for y := 0 to h - 1 do
  150.     begin
  151.       SetLength(map.layers[z][y], w);
  152.       if (z = 0) then
  153.         SetLength(map.attribs[y], w);
  154.       for x := 0 to w - 1 do
  155.       begin
  156.         map.layers[z][y][x] := Point(-1, 0);
  157.         if (z = 0) then
  158.           map.attribs[y][x] := 0;
  159.       end;
  160.     end;
  161.   end;
  162.   CreateVisibleMap(map);
  163. end;
  164.  
  165. procedure PaintMap; // Paints the layers on to the form so we can see the map
  166. var
  167.   t, i: Integer;
  168. begin
  169.   t := MBitmap(480, 480, '', 'PaintMap'); // Create temp bitmap
  170.   FastDrawClear(t, 16448505); // Ensure temp bitmap is blank
  171.  
  172.   for i := 0 to maps[curMap].depth - 1 do // Loop through all layers
  173.   begin
  174.     SetTransparentColor(maps[curMap].vis[i], 16448505); // Set transparent colour so the layers work nicely
  175.     FastDrawTransparent(0, 0, maps[curMap].vis[i], t); // Draw sprite layer on with transparency so bottom layer is visible
  176.   end;
  177.  
  178.   SafeDrawBitmap(t, iMain.Canvas, 0, 0); // Draw the map onto the visual component
  179.   MFreeBitmap(t); // Free our temp bitmap
  180. end;
  181.  
  182. procedure RedrawMap(tempMap: TMap); // Draw the map entirely from scratch - can be very confusing to understand, but straight forward enough
  183. var
  184.   z, y, x, t, d, blankTile: Integer;
  185.   p: TPoint;
  186.   ts, ds: TCanvas;
  187. begin
  188.   t := MBitmap(drawSize.x * 32, drawSize.y * 32, '', 'RedrawMap'); // Create temp bitmap
  189.  
  190.   ts := shTile.c; // Get the tilesheet's canvas
  191.   ds := GetBitmapCanvas(t); // Get the temp bitmap's canvas
  192.  
  193.   blankTile := MBitmap(32, 32, '', 'RedrawArea');
  194.   FastDrawClear(blankTile, clBlack);
  195.  
  196.   for z := 0 to tempMap.depth - 1 do // Loop through all the layers
  197.   begin
  198.     FastDrawClear(tempMap.vis[z], clBlack); // Ensure layer is clear
  199.     d := tempMap.vis[z]; // Set d to current layer
  200.     FastDrawClear(t, clBlack); // Clear the temp bitmap
  201.     p.y := -32; // Holds where to draw on the visible map - reset it here
  202.     for y := tempMap.mC.y to tempMap.mC.y + drawSize.y do // Loop through all on screen vertical tiles
  203.     begin
  204.       p.y := p.y + 32; // Increment the position by the height of a tile (32)
  205.  
  206.       if (y >= tempMap.height) then // If y is off the bottom of the map
  207.         break; // It won't go back on, so break the loop
  208.  
  209.       p.x := -32; // Holds where to draw on the visible map - reset it here
  210.       for x := tempMap.mC.x to tempMap.mC.x + drawSize.x do // Loop through all on screen horizontal tiles
  211.       begin
  212.         p.x := p.x + 32; // Increment the position by the width of a tile
  213.  
  214.         if (x >= tempMap.width) then // If x is off the right of the map
  215.           break; // It won't go back on, so break the loop
  216.  
  217.         if (tempMap.layers[z][y][x].x <> -1) then
  218.           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
  219.         else
  220.           SafeDrawBitmap(blankTile, ds, p.x, p.y);
  221.       end;
  222.     end;
  223.     FastDrawTransparent(0, 0, t, d); // Draw the layer without transparency onto appropriate bitmap
  224.   end;
  225.  
  226.   MFreeBitmap(t); // Free our temp bitmap
  227.   MFreeBitmap(blankTile);
  228. end;
  229.  
  230. procedure RepaintArea(ts, te, dp: TPoint);
  231. var
  232.   t, p, z, w, h: Integer;
  233.   tempMap: TMap;
  234. begin
  235.   tempMap := maps[curMap];
  236.   w := ((te.x + 1) - ts.x) * 32; // Get the width to draw by getting the difference in start and end then multiplying by tile width
  237.   h := ((te.y + 1) - ts.y) * 32; // As above, only height
  238.   t := MBitmap(w, h, '', 'RepaintArea');
  239.   p := MBitmap(w, h, '', 'RepaintArea');
  240.   FastDrawClear(p, clBlack);
  241.   for z := 0 to tempMap.depth - 1 do
  242.   begin
  243.     SafeCopyCanvas(GetBitmapCanvas(tempMap.vis[z]), GetBitmapCanvas(t), dp.x, dp.y, dp.x + w, dp.y + h, 0, 0, w, h);
  244.     SetTransparentColor(t, 16448505); // Set transparent colour so the layers work nicely
  245.     FastDrawTransparent(0, 0, t, p);
  246.     FastDrawClear(t, 16448505);
  247.   end;
  248.  
  249.   MFreeBitmap(t);
  250.   SafeDrawBitmap(p, iMain.Canvas, dp.x, dp.y); // Draw the map onto the visual component
  251.   MFreeBitmap(p);
  252. end;
  253.  
  254. 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
  255. var
  256.   t, d, z, y, x, w, h, blankTile: Integer;
  257.   tc, tsc: TCanvas;
  258.   p: TPoint;
  259.   tempMap: TMap;
  260. begin
  261.   tempMap := maps[curMap];
  262.   w := (te.x - ts.x) * 32; // Get the width to draw by getting the difference in start and end then multiplying by tile width
  263.   h := (te.y - ts.y) * 32; // As above, only height
  264.   t := MBitmap(w + 32, h + 32, '', 'RedrawArea'); // Setup the bitmap used to draw the new stuff
  265.   tsc := shTile.c; // Get the tilesheet's canvas
  266.   tc := GetBitmapCanvas(t); // Get the temp bitmap's canvas
  267.   blankTile := MBitmap(32, 32, '', 'RedrawArea');
  268.   FastDrawClear(blankTile, clBlack);
  269.  
  270.   if (ts.y < 0) then
  271.     ts.y := 0;
  272.   if (te.y >= tempMap.height) then
  273.     te.y := tempMap.height - 1;
  274.  
  275.   if (ts.x < 0) then
  276.     ts.x := 0;
  277.   if (te.x >= tempMap.width) then
  278.     te.x := tempMap.width - 1;
  279.  
  280.  
  281.   for z := 0 to tempMap.depth - 1 do // Loop through all layers
  282.   begin
  283.     d := tempMap.vis[z];
  284.     FastDrawClear(t, clBlack); // Clear temp bitmap
  285.     p.y := -32; // Reset p.y
  286.     for y := ts.y to te.y do
  287.     begin
  288.       p.y := p.y + 32; // Increment position to draw to
  289.       p.x := -32;
  290.  
  291.       for x := ts.x to te.x do // Loop through all columns
  292.       begin
  293.         p.x := p.x + 32; // Increment position to draw to
  294.        
  295.         if (tempMap.layers[z][y][x].x <> -1) then
  296.           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
  297.         else
  298.           SafeDrawBitmap(blankTile, tc, p.x, p.y);
  299.       end;
  300.     end;
  301.  
  302.     FastDrawTransparent(dp.x, dp.y, t, d); // Draw the layer onto appropriate bitmap without transparency for this bit
  303.   end;
  304.  
  305.   MFreeBitmap(t); // Free our temp bitmap
  306.   MFreeBitmap(blankTile);
  307.   RepaintArea(ts, te, dp);
  308. end;
  309.  
  310. procedure HandleMovement(amount: Integer; dir: Integer); // Wrapper procedure for RedrawArea
  311. var
  312.   t, z: Integer;
  313.   tc: TCanvas;
  314.   s, e, o, d: TPoint;
  315. begin
  316.   if (amount < 0) then
  317.     amount := - amount;
  318.   if (not (InRange(dir, 1, 4))) then
  319.   begin
  320.     Writeln('Invalid dir passed to HandleMovement');
  321.     exit;
  322.   end;
  323.  
  324.   t := MBitmap((drawSize.x + 1) * 32, (drawSize.y + 1) * 32, '', 'HandleMovement');
  325.   tc := GetBitmapCanvas(t);
  326.   SafeCopyCanvas(iMain.Canvas, tc, 0, 0, iMain.Width, iMain.Height, 0, 0, iMain.Width, iMain.Height);
  327.   s := maps[curMap].mC;
  328.   e := Point(s.x + drawSize.x, s.y + drawSize.y);
  329.   o := Point(0, 0);
  330.   d := Point(0, 0);
  331.   case dir of
  332.     1: begin
  333.       e.y := s.y + amount;
  334.       o.y := amount * 32;
  335.     end;
  336.     2: begin
  337.       e.x := s.x + amount;
  338.       o.x := amount * 32;
  339.     end;
  340.     3: begin
  341.       s.y := e.y - amount;
  342.       o.y := - (amount * 32);
  343.       d.y := (drawSize.y - amount) * 32;
  344.     end;
  345.     4: begin
  346.       s.x := e.x - amount;
  347.       o.x := - (amount * 32);
  348.       d.x := (drawSize.x - amount) * 32;
  349.     end;
  350.   end;
  351.  
  352.   SafeDrawBitmap(t, iMain.Canvas, o.x, o.y);
  353.   FastDrawClear(t, clBlack);
  354.  
  355.   for z := 0 to maps[curMap].depth - 1 do
  356.   begin
  357.     SafeDrawBitmap(maps[curMap].vis[z], tc, 0, 0);
  358.     SafeDrawBitmap(t, GetBitmapCanvas(maps[curMap].vis[z]), o.x, o.y);
  359.   end;
  360.  
  361.   MFreeBitmap(t);
  362.  
  363.   RedrawArea(s, e, d);
  364. end;
  365.  
  366. procedure AddMap(w, h, d: Integer); // Handles the setting up of a new map
  367. var
  368.   l: Integer;
  369. begin
  370.   l := Length(maps); // Get the length of the array
  371.   SetLength(maps, l + 1); // Increase the length of the array by 1 for the new map
  372.   GenerateBlankMap(maps[l], w, h, d); // See 'GenerateBlankMap'
  373.   tcMain.Tabs.Append('Untitled'); // Add a new tab to access it
  374.   tcMain.TabIndex := tcMain.Tabs.Count - 1; // Switch to the new tab
  375.   curMap := l; // Update curMap as well so that drawing isn't done to random maps
  376.   maps[curMap].fp := ScriptPath;
  377.   maps[curMap].fn := 'Untitled';
  378.   curLay := d - 1; // Set the drawing layer to the top layer by default
  379.   lCurLay.Caption := 'Layer ' + IntToStr(curLay) + ' selected'; // Update the layer caption so we know where we are at
  380.   sbHorz.Max := maps[curMap].Width - drawSize.x;
  381.   sbVert.Max := maps[curMap].Height - drawSize.y;
  382. end;
  383.  
  384. procedure NewMap;
  385. begin
  386.   AddMap(25, 25, 3);
  387.   RedrawMap(maps[curMap]);
  388.   PaintMap;
  389. end;
  390.  
  391. procedure SetMapInfo(index: Integer; fpstr: string);
  392. begin
  393.   maps[index].saved := True; // Toggle saved to true to show that it has been saved and not modified
  394.   maps[index].fp := ExtractFilePath(fpstr); // Update the filepath to the map
  395.   maps[index].fn := ExtractFileName(fpstr); // Update the filename of the map
  396.   maps[index].fn := Copy(maps[index].fn, 1, LastPos('.', maps[curMap].fn) - 1); // And remove the file extension
  397.   tcMain.Tabs[index] := maps[index].fn; // Update the tab to show the filename minus extension
  398. end;
  399.  
  400. procedure MapImplode(var arr: TStringArray; var tempMap: TMap); // Breaks down the map into an array to be used for saving maps
  401. var
  402.   z, y, x, i: Integer;
  403. begin
  404.   SetLength(arr, 0); // Ensure array passed is empty
  405.   if ((tempMap.depth <= 0) or (tempMap.height <= 0) or (tempMap.width <= 0)) then // If map is blank/invalid size
  406.     Crash('Imploding map of invalid dimensions (one is set to zero)'); // Crash
  407.   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
  408.   SetLength(arr, i); // Set the length so it's the right length for the data
  409.   arr[0] := IntToStr(tempMap.width) + ',' + IntToStr(tempMap.height) + ',' + IntToStr(tempMap.depth); // Set first array index to hold dimenions info (x by y by z)
  410.   for x := 1 to i - 1 do // Loop through all arrays
  411.     arr[x] := ''; // Set to blank to ensure no corruption
  412.   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
  413.   for z := 0 to tempMap.depth do // Loop through all layers and the attributes
  414.   begin
  415.     for y := 0 to tempMap.height - 1 do // Loop through all rows
  416.     begin
  417.       i := i + 1; // Increment i so it points to next blank array
  418.       for x := 0 to tempMap.width - 1 do // Loop through all columns
  419.         if (z < tempMap.depth) then // if it is a visual layer
  420.           arr[i] := arr[i] + IntToStr(ConvertBack(tempMap.layers[z][y][x])) + ',' // Append the converted tile and a comma to the end of the array
  421.         else // if it is the attirbutes layer
  422.           arr[i] := arr[i] + IntToStr(tempMap.attribs[y][x]) + ','; // Append the attribute and a comma to the end of the array
  423.       Delete(arr[i], Length(arr[i]), 1); // Remove the trailing comma
  424.     end;
  425.     i := i + 1; // Increment i to give the blank line between "paragraphs"
  426.   end;
  427. end;
  428.  
  429. procedure SaveMap(filename: string); // Outputs the map to a file
  430. var
  431.   f, i: Integer;
  432.   s: TStringArray;
  433. begin
  434.   f := RewriteFile(filename, False); // Open file and wipe it or create the file then assign to f
  435.   MapImplode(s, maps[curMap]); // See MapImplode
  436.   for i := 0 to High(s) do // Loop through s
  437.     WriteFileString(f, s[i] + #13 + #10); // Write to file with new line after
  438.   CloseFile(f); // Close the file
  439. end;
  440.  
  441. procedure ExportMap; // GUI method of saving a map by opening a TSaveDialog
  442. var
  443.   dialog: TSaveDialog;
  444. begin
  445.   dialog := TSaveDialog.Create(nil); // Create parentless save dialog
  446.   dialog.Filter := 'ScaRPG map|*.srpg'; // Set filter to only allow the the extension specified
  447.   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
  448.   if (not dialog.Execute) then // If no file is specified after opening the dialog and it is closed
  449.     exit; // exit procedure
  450.   SaveMap(dialog.filename); // See SaveMap - the chosen file is passed as where to save it to
  451.   SetMapInfo(curMap, dialog.filename);
  452. end;
  453.  
  454. procedure MExplode(var arr: TStringArray; str, del: string); // Standard Explode procedure written for older Scar versions
  455. var
  456.   i, h, l: Integer;
  457. begin
  458.   SetLength(arr, 0); // Ensure passed array is blank
  459.   h := -1; // Set high of array to -1
  460.   l := Length(del) - 1; // Amount to delete by based on del's length to ensure it is removed if longer than 1 char
  461.   while (true) do // Endless loop
  462.   begin
  463.     h := h + 1; // Increment h
  464.     SetLength(arr, h + 1); // Make array longer by one
  465.     i := Pos(del, str); // Find first occurence of del in str
  466.     if (i = 0) then // If it is not found
  467.       break; // Break from loop
  468.     arr[h] := Copy(str, 1, i - 1); // Copy the text until del (not including del) to the array
  469.     Delete(str, 1, i + l); // Remove copied text as well as del
  470.   end;
  471.   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
  472. end;
  473.  
  474. function StrInt(s: string): Integer; // "Safe" version of IntToStr to catch dodgy map files specifically
  475. begin
  476.   try
  477.     Result := StrToInt(s); // Try standard conversion
  478.   except // If it is non-numeric
  479.     if (s = '') then // If it is blank
  480.       Result := 0 // Set to 0
  481.     else // If non-numeric and not blank
  482.       Crash('StrInt passed invalid string - "' + s + '"'); // Crash
  483.   end;
  484. end;
  485.  
  486. procedure MapExplode(var tempMap: TMap; str: string); // Creates the backend for the visual map from a string
  487. var
  488.   lineArr: TStringArray;
  489.   mapArr: array of TStringArray;
  490.   i, z, y, x: Integer;
  491. begin
  492.   if (Pos(#13 + #10, str) = 0) then // If no enter's are found in the string
  493.     Crash('Exploding map from an invalid input string'); // Crash
  494.  
  495.   MExplode(lineArr, str, #13 + #10); // See MExplode - breaks into seperate lines
  496.   SetLength(mapArr, Length(lineArr)); // Set 2D array to the same length as the number of lines
  497.   for i := 0 to High(lineArr) do // Loop through all the lines
  498.     MExplode(mapArr[i], lineArr[i], ','); //See MExplode - breaks into seperate values between the comma's
  499.    
  500.   tempMap.width := StrInt(mapArr[0][0]); // Set the dimension of the map based on the extracted values
  501.   tempMap.height := StrInt(mapArr[0][1]); // As above
  502.   tempMap.depth := StrInt(mapArr[0][2]); // As above
  503.  
  504.   i := 2; // Set i to 2 - the first array relating to the map
  505.  
  506.   // This section is like the inverse of the main loop in MapImplode
  507.   SetLength(tempMap.layers, tempMap.depth); // Set the 3D TPoint array to length of the depth
  508.   for z := 0 to tempMap.depth - 1 do // Loop through all layers and the attribute layer
  509.   begin
  510.     SetLength(tempMap.layers[z], tempMap.height); // Set a 2D TPoint array to length of the height
  511.     for y := 0 to tempMap.height - 1 do // Loop through all rows
  512.     begin
  513.       SetLength(tempMap.layers[z][y], tempMap.width); // Set the TPoint array to the length of the width
  514.       for x := 0 to tempMap.width - 1 do // Loop through all columns
  515.         ConvertTile(tempMap.layers[z][y][x], StrInt(mapArr[i][x])); // See ConvertTile - this is done so that map painting requires less calculations
  516.       i := i + 1; // Go onto the next line of the loaded "paragraph"
  517.     end;
  518.     i := i + 1; // Would be a blank line here, so go on to the next
  519.   end;
  520.  
  521.   SetLength(tempMap.attribs, tempMap.height); // Set the height of the 2DIntArray
  522.   for y := 0 to tempMap.height - 1 do // Loop through all rows
  523.   begin
  524.     SetLength(tempMap.attribs[y], tempMap.width); // Set the width of the TIntegerArray
  525.     for x := 0 to tempMap.width - 1 do // Loop through all columns
  526.       tempMap.attribs[y][x] := StrInt(mapArr[i][x]); // Convert the string into an integer attribute value
  527.     i := i + 1;
  528.   end;
  529. end;
  530.  
  531. procedure LoadMap(filename: string); // Handles the loading of a map file and doing what needs to be done
  532. var
  533.   f: Integer;
  534.   s: string;
  535. begin
  536.   if (not FileExists(filename)) then // If file does not exist
  537.     Crash('File specified to load does not exist - "' + filename + '"'); // Crash
  538.   f := OpenFile(filename, False); // Open the file specified
  539.   ReadFileString(f, s, FileSize(f)); // Read the contents of the file
  540.   CloseFile(f); // Close the file
  541.   MapExplode(maps[curMap], s); // See MapExplode - pass the file contents to break apart
  542. end;
  543.  
  544. procedure ImportMap; // GUI method of opening a map by opening a TOpemDialog
  545. var
  546.   dialog: TOpenDialog;
  547. begin
  548.   dialog := TOpenDialog.Create(nil); // Create a parentless open dialog
  549.   dialog.Filter := 'ScaRPG map|*.srpg'; // Set the filter to only show map files
  550.   if (ScriptPath <> '') then // If the script is saved
  551.     dialog.InitialDir := ScriptPath; // Set the starting directory to the place where the script is saved in
  552.   if (not dialog.Execute) then // If the dialog is launched and no file is selected when closed
  553.     exit; // exit procedure
  554.   if (not maps[curMap].saved) then // If map isn't saved
  555.     AddMap(1, 1, 1); // Then open a new tab instead
  556.   FreeVisibleMap(maps[curMap]); // Need to "refresh" the visible bitmap holders
  557.   LoadMap(dialog.filename); // See LoadMap - passing the selected file as the one to load
  558.   CreateVisibleMap(maps[curMap]); // Set up the visible layers
  559.   SetMapInfo(curMap, dialog.filename);
  560.   RedrawMap(maps[curMap]); // Redraw the map as it is unconstructed
  561.   PaintMap; // Then paint it onto the form
  562. end;
  563.  
  564. procedure CloseMap(var index: Integer);
  565. var
  566.   i: Integer;
  567. begin
  568.   FreeVisibleMap(maps[index]);
  569.   if (index < High(maps)) then
  570.   begin
  571.     for i := index to High(maps) - 1 do
  572.       Swap(maps[i], maps[i + 1]);
  573.   end
  574.   else if (index = 0) then
  575.   begin
  576.     AddMap(25, 25, 3);
  577.     curMap := 0;
  578.     Swap(maps[0], maps[1]);
  579.     RedrawMap(maps[0]);
  580.   end;
  581.   SetLength(maps, High(maps));
  582.   tcMain.Tabs.Delete(index);
  583.   if (index > High(maps)) then
  584.     index := index - 1;
  585.   PaintMap;
  586. end;
  587.  
  588. procedure PaintDrawTiles;
  589. var
  590.   t, w, h, x, y: Integer;
  591.   r: Extended;
  592. begin
  593.   h := High(drawTiles);
  594.   if (h >= 0) then
  595.     w := High(drawTiles[0])
  596.   else
  597.     w := -1;
  598.  
  599.   t := MBitmap(64, 64, '', 'PaintDrawTiles');
  600.   FastDrawClear(t, clBlack);
  601.   SafeDrawBitmap(t, iTile.Canvas, 0, 0);
  602.   MFreeBitmap(t);
  603.  
  604.   if (w = -1) then
  605.     iTile.Canvas.TextOut(16, 8, 'None')
  606.   else
  607.   begin
  608.     r := 64.0 / (Max(w, h) + 1);
  609.     for y := 0 to h do
  610.       for x := 0 to w do
  611.         if (drawTiles[y][x].x > -1) then
  612.           SafeCopyCanvas(shTile.c, iTile.Canvas, drawTiles[y][x].x, drawTiles[y][x].y, drawTiles[y][x].x + 32, drawTiles[y][x].y + 32, Round(x * r), Round(y * r), Round((x + 1) * r), Round((y + 1) * r));
  613.   end;
  614. end;
  615.  
  616. procedure MaskTile(dp: TPoint);
  617. begin
  618.   iMain.Canvas.Pen.Color := clRed;
  619.   iMain.Canvas.Brush.Style := bsFrame;
  620.   iMain.Canvas.Rectangle(dp.x + 1, dp.y + 1, dp.x + 31, dp.y + 31);
  621. end;
  622.  
  623. procedure MaskSelectedTiles;
  624. var
  625.   i, h: Integer;
  626.   p: TPoint;
  627.   ar: TBox;
  628. begin
  629.   h := Length(selTiles) - 1;
  630.   if (h = -1) then
  631.     exit;
  632.    
  633.   ar := IntToBox(maps[curMap].mC.x, maps[curMap].mC.y, maps[curMap].mC.x + drawSize.x, maps[curMap].mC.y + drawSize.y);
  634.   for i := 0 to h do
  635.     try
  636.     if (PointInBox(selTiles[i], ar)) then
  637.     begin
  638.       p := Point((selTiles[i].x - maps[curMap].mC.x) * 32, (selTiles[i].y - maps[curMap].mC.y) * 32);
  639.       MaskTile(p);
  640.     end;
  641.     except
  642.       Writeln(IntToStr(i) + ' of ' + IntToStr(h));
  643.     end;
  644. end;
  645.  
  646. procedure OnMapMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  647. begin
  648.   if ((mode.y = 0) or (mode.y = 1) or (mode.y = 4)) then
  649.     exit;
  650.   X := Trunc(X / 32.0);
  651.   Y := Trunc(Y / 32.0);
  652.   drawArea := Point(X, Y);
  653. end;
  654.  
  655. procedure OnMapMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  656. var
  657.   d, t, r: TPoint;
  658.   a, b, w, h: Integer;
  659.   s: Boolean;
  660.   sT: T2DPointArray;
  661. begin
  662.   if (mbRight = Button) then
  663.   begin
  664.     X := Trunc(X / 32.0);
  665.     Y := Trunc(Y / 32.0);
  666.     drawArea := Point(maps[curMap].mC.x + X, maps[curMap].mC.y + Y);
  667.  
  668.     GetMousePos(X, Y);
  669.     ppMain.Popup(X, Y);
  670.     exit;
  671.   end;
  672.   if ((mode.y = 1) or (mode.y = 4)) then
  673.     exit;
  674.    
  675.   if (mode.x = 0) then
  676.   begin
  677.     if (Length(drawTiles) = 0) then
  678.       exit
  679.     else if (Length(drawTiles[0]) = 0) then
  680.       exit;
  681.   end;
  682.  
  683.   if (mode.y <> 0) then
  684.   begin
  685.     X := Trunc(X / 32.0);
  686.     Y := Trunc(Y / 32.0);
  687.     if (X >= maps[curMap].width) then
  688.       X := maps[curMap].width - 1
  689.     else if (X < 0) then
  690.       X := 0;
  691.     if (Y >= maps[curMap].height) then
  692.       Y := maps[curMap].height - 1
  693.     else if (Y < 0) then
  694.       Y := 0;
  695.     d := Point(X, Y);
  696.     if (d.x < drawArea.x) then
  697.       Swap(d.x, drawArea.x);
  698.     if (d.y < drawArea.y) then
  699.       Swap(d.y, drawArea.y);
  700.     X := maps[curMap].mC.x + drawArea.x;
  701.     Y := maps[curMap].mC.y + drawArea.y;
  702.     t := Point(d.x - drawArea.x, d.y - drawArea.y);
  703.   end
  704.   else
  705.   begin
  706.     drawArea := Point(0, 0);
  707.     d := Point(maps[curMap].width - 1, maps[curMap].height - 1);
  708.     t := d;
  709.     X := 0;
  710.     Y := 0;
  711.   end;
  712.   s := False;
  713.  
  714.   if ((mode.x = 0) and (mode.y = 3)) then
  715.   begin
  716.     h := Length(drawTiles);
  717.     if (h <> 0) then
  718.       w := Length(drawTiles[0])
  719.     else
  720.       w := 0;
  721.     if ((h < 3) or (w < 3) or (t.y < 3) or (t.x < 3)) then
  722.     begin
  723.       s := True;
  724.       mode.y := 2;
  725.     end
  726.     else
  727.     begin
  728.       h := h - 1;
  729.       w := w - 1;
  730.       SetLength(sT, h - 1);
  731.       for a := 0 to h - 2 do
  732.       begin
  733.         SetLength(sT[a], w - 1);
  734.         for b := 0 to w - 2 do
  735.           sT[a][b] := drawTiles[(a mod (h - 1)) + 1][(b mod (w - 1)) + 1];
  736.       end;
  737.      
  738.       if (drawTiles[0][0].x <> -2) then
  739.         maps[curMap].layers[curLay][Y][X] := drawTiles[0][0];
  740.       if (drawTiles[h][0].x <> -2) then
  741.         maps[curMap].layers[curLay][Y + t.y][X] := drawTiles[h][0];
  742.       if (drawTiles[0][w].x <> -2) then
  743.         maps[curMap].layers[curLay][Y][X + t.x] := drawTiles[0][w];
  744.       if (drawTiles[h][w].x <> -2) then
  745.         maps[curMap].layers[curLay][Y + t.y][X + t.x] := drawTiles[h][w];
  746.        
  747.       for a := 1 to t.y - 1 do
  748.       begin
  749.         if (drawTiles[((a - 1) mod (h - 1)) + 1][0].x <> -2) then
  750.           maps[curMap].layers[curLay][Y + a][X] := drawTiles[((a - 1) mod (h - 1)) + 1][0];
  751.         if (drawTiles[((a - 1) mod (h - 1)) + 1][w].x <> -2) then
  752.           maps[curMap].layers[curLay][Y + a][X + t.x] := drawTiles[((a - 1) mod (h - 1)) + 1][w];
  753.       end;
  754.       for b := 1 to t.x - 1 do
  755.       begin
  756.         if (drawTiles[0][((b - 1) mod (w - 1)) + 1].x <> -2) then
  757.           maps[curMap].layers[curLay][Y][X + b] := drawTiles[0][((b - 1) mod (w - 1)) + 1];
  758.         if (drawTiles[h][((b - 1) mod (w - 1)) + 1].x <> -2) then
  759.           maps[curMap].layers[curLay][Y + t.y][X + b] := drawTiles[h][((b - 1) mod (w - 1)) + 1];
  760.       end;
  761.  
  762.       for a := 1 to t.y - 1 do
  763.         for b := 1 to t.x - 1 do
  764.           if (sT[(a - 1) mod Length(sT)][(b - 1) mod Length(sT[0])].x <> -2) then
  765.             maps[curMap].layers[curLay][Y + a][X + b] := sT[(a - 1) mod Length(sT)][(b - 1) mod Length(sT[0])];
  766.     end;
  767.   end;
  768.   if ((mode.x = 0) and ((mode.y = 0) or (mode.y = 2))) then
  769.   begin
  770.     for a := 0 to t.y do
  771.       for b := 0 to t.x do
  772.         if (drawTiles[a mod Length(drawTiles)][b mod Length(drawTiles[0])].x <> -2) then
  773.           maps[curMap].layers[curLay][Y + a][X + b] := drawTiles[a mod Length(drawTiles)][b mod Length(drawTiles[0])];
  774.   end;
  775.  
  776.   if (mode.x = 2) then
  777.   begin
  778.     SetLength(selTiles, (t.x + 1) * (t.y + 1));
  779.     w := -1;
  780.     for a := 0 to t.y do
  781.       for b := 0 to t.x do
  782.       begin
  783.         w := w + 1;
  784.         selTiles[w] := Point(X + b,Y + a);
  785.       end;
  786.     Writeln(IntToStr(X) + ',' + IntToStr(Y) + ' - ' + IntToStr(X + t.x) + ',' + IntToStr(Y + t.y));
  787.   end;
  788.  
  789.   if (mode.x = 1) then
  790.   begin
  791.     for a := 0 to t.y do
  792.       for b := 0 to t.x do
  793.         maps[curMap].layers[curLay][Y + a][X + b] := Point(-1, 0);
  794.   end;
  795.  
  796.   if (s) then
  797.     mode.y := 3;
  798.  
  799.   r := Point(drawArea.x * 32, drawArea.y * 32);
  800.   if (mode.y <> 0) then
  801.     RedrawArea(Point(X, Y), Point(X + t.x, Y + t.y), r)
  802.   else
  803.   begin
  804.     RedrawMap(maps[curMap]);
  805.     PaintMap;
  806.   end;
  807.   if (mode.x = 2) then
  808.     MaskSelectedTiles;
  809. end;
  810.  
  811. procedure OnMapMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  812. var
  813.   dp: TPoint;
  814.   h, i: Integer;
  815. begin
  816.   if (mode.y <> 1) then
  817.     exit;
  818.   if (not (ssLeft in Shift)) then
  819.     exit;
  820.  
  821.   if (mode.x = 0) then
  822.   begin
  823.     if (Length(drawTiles) = 0) then
  824.       exit
  825.     else if (Length(drawTiles[0]) = 0) then
  826.       exit;
  827.   end;
  828.  
  829.   dp := Point(Trunc(X / 32.0), Trunc(Y / 32.0));
  830.   X := dp.x + maps[curMap].mC.x;
  831.   Y := dp.y + maps[curMap].mC.y;
  832.   dp := Point(dp.x * 32, dp.y * 32);
  833.   if (X >= maps[curMap].Width) then
  834.   begin
  835.     X := maps[curMap].Width - 1;
  836.     dp.x := iMain.Width - 32;
  837.   end
  838.   else if (X < 0) then
  839.   begin
  840.     X := 0;
  841.     dp.x := 0;
  842.   end;
  843.   if (Y >= maps[curMap].Height) then
  844.   begin
  845.     Y := maps[curMap].Height - 1;
  846.     dp.y := iMain.Height - 32;
  847.   end
  848.   else if (Y < 0) then
  849.   begin
  850.     Y := 0;
  851.     dp.y := 0;
  852.   end;
  853.  
  854.   if (mode.x = 0) then
  855.   begin
  856.     if (High(drawTiles) <> -1) then
  857.       if (High(drawTiles[0]) <> -1) then
  858.        if ((maps[curMap].layers[curLay][Y][X].x = drawTiles[0][0].x) and (maps[curMap].layers[curLay][Y][X].y = drawTiles[0][0].y)) then
  859.          exit;
  860.     maps[curMap].layers[curLay][Y][X] := drawTiles[0][0];
  861.   end
  862.   else if (mode.x = 1) then
  863.   begin
  864.     if (maps[curMap].layers[curLay][Y][X].x = -1) then
  865.       exit;
  866.     maps[curMap].layers[curLay][Y][X] := Point(-1, 0)
  867.   end
  868.   else if (mode.x = 2) then
  869.   begin
  870.     h := Length(selTiles);
  871.     if ((ssCtrl in Shift) <> (PointInTPA(Point(X, Y), selTiles))) then
  872.       if (h <> 0) then
  873.         exit;
  874.  
  875.     if (not (ssCtrl in Shift)) then
  876.     begin
  877.       SetLength(selTiles, h + 1);
  878.       selTiles[h] := Point(X, Y);
  879.       MaskTile(dp);
  880.     end
  881.     else
  882.     begin
  883.       if (h = 0) then
  884.         exit;
  885.       h := h - 1;
  886.       for i := 0 to h - 1 do
  887.         if ((selTiles[i].x = X) and (selTiles[i].y = Y)) then
  888.         begin
  889.           Swap(selTiles[i], selTiles[h]);
  890.           break;
  891.         end;
  892.       SetLength(selTiles, h);
  893.       RedrawArea(Point(X, Y), Point(X , Y), dp);
  894.     end;
  895.   end;
  896.  
  897.   if ((mode.x = 0) or (mode.x = 1)) then
  898.     RedrawArea(Point(X, Y), Point(X , Y), dp);
  899. end;
  900.  
  901. procedure OnToolClick(Sender: TObject);
  902. var
  903.   i, ii, t: Integer;
  904.   ar: TBox;
  905. begin
  906.   t := -1;
  907.   for i := 0 to High(bTools) do
  908.     if (Sender = bTools[i]) then
  909.     begin
  910.       t := i;
  911.       break;
  912.     end;
  913.   if (t = -1) then
  914.     exit;
  915.   if ((mode.x = 2) and (t < 2)) then
  916.   begin
  917.     ar := IntToBox(maps[curMap].mC.x, maps[curMap].mC.y, maps[curMap].mC.x + drawSize.x, maps[curMap].mC.y + drawSize.y);
  918.     for i := 0 to High(selTiles) do
  919.       if (PointInBox(selTiles[i], ar)) then
  920.         RedrawArea(selTiles[i], selTiles[i], Point((selTiles[i].x - maps[curMap].mC.x) * 32, (selTiles[i].y - maps[curMap].mC.y) * 32));    SetLength(selTiles, 0);
  921.   end;
  922.   if (t = 7) then
  923.   begin
  924.     if (Length(selTiles) = 0) then
  925.       exit;
  926.     ar := GetTPABounds(selTiles);
  927.     ar.x2 := ar.x2 - ar.x1;
  928.     ar.y2 := ar.y2 - ar.y1;
  929.     SetLength(drawTiles, ar.y2 + 1)
  930.     for i := 0 to ar.y2 do
  931.     begin
  932.       SetLength(drawTiles[i], ar.x2 + 1);
  933.       for ii := 0 to ar.x2 do
  934.         drawTiles[i][ii] := Point(-2, 0);
  935.     end;
  936.     for i := 0 to High(selTiles) do
  937.       drawTiles[selTiles[i].y - ar.y1][selTiles[i].x - ar.x1] := maps[curMap].layers[curLay][selTiles[i].y][selTiles[i].x];
  938.     PaintDrawTiles;
  939.   end
  940.   else if (t <= 2) then
  941.     mode.x := t
  942.   else
  943.     mode.y := t - 3;
  944. end;
  945.  
  946. procedure OnMapScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
  947. var
  948.   dir, amo: Integer;
  949. begin
  950.   dir := 0;
  951.   if (Sender = sbHorz) then
  952.   begin
  953.     amo := maps[curMap].mC.x - sbHorz.Position;
  954.     maps[curMap].mC.x := sbHorz.Position;
  955.     if (amo < 0) then
  956.       dir := 4
  957.     else if (amo > 0) then
  958.       dir := 2;
  959.   end
  960.   else if (Sender = sbVert) then
  961.   begin
  962.     amo := maps[curMap].mC.y - sbVert.Position;
  963.     maps[curMap].mC.y := sbVert.Position;
  964.     if (amo < 0) then
  965.       dir := 3
  966.     else if (amo > 0) then
  967.       dir := 1;
  968.   end;
  969.   if (dir = 0) then
  970.     exit;
  971.   HandleMovement(amo, dir);
  972. end;
  973.  
  974. procedure OnTilesheetMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  975. begin
  976.   drawArea := Point(Trunc(X / 32.0), Trunc(Y / 32.0));
  977. end;
  978.  
  979. procedure OnTilesheetMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  980. var
  981.   w, h, a, b: Integer;
  982. begin
  983.   X := Trunc(X / 32.0);
  984.   Y := Trunc(Y / 32.0);
  985.   if (X >= shTile.w) then
  986.     X := shTile.w - 1
  987.   else if (X < 0) then
  988.     X := 0;
  989.   if (Y >= shTile.h) then
  990.     Y := shTile.h - 1
  991.   else if (Y < 0) then
  992.     Y := 0;
  993.   if (X < drawArea.x) then
  994.     Swap(X, drawArea.x);
  995.   if (Y < drawArea.y) then
  996.     Swap(Y, drawArea.y);
  997.  
  998.   h := Y - drawArea.y;
  999.   w := X - drawArea.x;
  1000.   SetLength(drawTiles, h + 1);
  1001.   for a := 0 to h do
  1002.   begin
  1003.     SetLength(drawTiles[a], w + 1);
  1004.     for b := 0 to w do
  1005.       drawTiles[a][b] := Point((drawArea.x + b) * 32, (drawArea.y + a) * 32);
  1006.   end;
  1007.  
  1008.   PaintDrawTiles;
  1009. end;
  1010.  
  1011. procedure OnButtonClick(Sender: TObject);
  1012. begin
  1013.   if (Sender = bLayUp) then
  1014.   begin
  1015.     curLay := curLay + 1;
  1016.     if (curLay >= maps[curMap].depth) then
  1017.       curLay := 0;
  1018.   end
  1019.   else
  1020.   begin
  1021.     curLay := curLay - 1;
  1022.     if (curLay <= -1) then
  1023.       curLay := maps[curMap].depth - 1;
  1024.   end;
  1025.   lCurLay.Caption := 'Layer ' + IntToStr(curLay) + ' selected'; // Update the layer caption so we know where we are drawing at
  1026. end;
  1027.  
  1028. procedure OnMenuClick(Sender: TObject);
  1029. var
  1030.   i, opt: Integer;
  1031. begin
  1032.   opt := -1;
  1033.   for i := 0 to High(mFileOpts) do
  1034.     if (Sender = mFileOpts[i]) then
  1035.     begin
  1036.       opt := i;
  1037.       break;
  1038.     end;
  1039.   if (opt = -1) then
  1040.   begin
  1041.     Writeln('I don''t know how you managed it, but you clicked on a non-existent menu item');
  1042.     exit;
  1043.   end;
  1044.   case opt of
  1045.     0: NewMap;
  1046.     1: ImportMap;
  1047.     2: ExportMap;
  1048.     3: CloseMap(curMap);
  1049.     4: begin RedrawMap(maps[curMap]); PaintMap; end;
  1050.   end;
  1051.  
  1052.   sbHorz.Position := maps[curMap].mC.x;
  1053.   sbVert.Position := maps[curMap].mC.y;
  1054. end;
  1055.  
  1056. procedure OnTabChange(Sender: TObject);
  1057. begin
  1058.   curMap := tcMain.TabIndex;
  1059.   sbHorz.Position := maps[curMap].mC.x;
  1060.   sbHorz.Max := maps[curMap].Width - drawSize.x;
  1061.   sbVert.Position := maps[curMap].mC.y;
  1062.   sbVert.Max := maps[curMap].Height - drawSize.y;
  1063.   PaintMap;
  1064. end;
  1065.  
  1066. procedure DeleteRowCol(pos: TPoint; row: Boolean);
  1067. var
  1068.   x, y, z: Integer;
  1069. begin
  1070.   for z := 0 to maps[curMap].depth - 1 do
  1071.   begin
  1072.     if (row) then
  1073.     begin
  1074.       for y := pos.y + 1 to maps[curMap].height - 1 do
  1075.         Swap(maps[curMap].layers[z][y - 1], maps[curMap].layers[z][y]);
  1076.       SetLength(maps[curMap].layers[z], maps[curMap].height - 1);
  1077.     end
  1078.     else
  1079.       for y := 0 to maps[curMap].height - 1 do
  1080.       begin
  1081.         for x := pos.x + 1 to maps[curMap].width - 1 do
  1082.           Swap(maps[curMap].layers[z][y][x - 1], maps[curMap].layers[z][y][x]);
  1083.         SetLength(maps[curMap].layers[z][y], maps[curMap].width - 1);
  1084.       end;
  1085.   end;
  1086.  
  1087.   if (row) then
  1088.     maps[curMap].height := maps[curMap].height - 1
  1089.   else
  1090.     maps[curMap].width := maps[curMap].width - 1;
  1091.   sbHorz.Max := maps[curMap].Width - drawSize.x;
  1092.   sbVert.Max := maps[curMap].Height - drawSize.y;
  1093. end;
  1094.  
  1095. procedure InsertRowCol(pos: TPoint; row: Boolean);
  1096. var
  1097.   x, y, z: Integer;
  1098. begin
  1099.   for z := 0 to maps[curMap].depth - 1 do
  1100.   begin
  1101.     if (row) then
  1102.     begin
  1103.       SetLength(maps[curMap].layers[z], maps[curMap].height + 1);
  1104.       SetLength(maps[curMap].layers[z][maps[curMap].height], maps[curMap].width);
  1105.       for x := 0 to maps[curMap].width - 1 do
  1106.         maps[curMap].layers[z][maps[curMap].height][x] := Point(-1, 0);
  1107.       for y := maps[curMap].height downto pos.y + 1 do
  1108.         Swap(maps[curMap].layers[z][y - 1], maps[curMap].layers[z][y]);
  1109.     end
  1110.     else
  1111.     begin
  1112.       for y := 0 to maps[curMap].height - 1 do
  1113.       begin
  1114.         SetLength(maps[curMap].layers[z][y], maps[curMap].width + 1);
  1115.         maps[curMap].layers[z][y][maps[curMap].width] := Point(-1, 0);
  1116.         for x := maps[curMap].width downto pos.x + 1 do
  1117.           Swap(maps[curMap].layers[z][y][x - 1], maps[curMap].layers[z][y][x]);
  1118.       end;
  1119.     end;
  1120.   end;
  1121.  
  1122.   if (row) then
  1123.     maps[curMap].height := maps[curMap].height + 1
  1124.   else
  1125.     maps[curMap].width := maps[curMap].width + 1;
  1126.  
  1127.   sbHorz.Max := maps[curMap].Width - drawSize.x;
  1128.   sbVert.Max := maps[curMap].Height - drawSize.y;
  1129. end;
  1130.  
  1131. procedure OnPopupClick(Sender: TObject);
  1132. var
  1133.   a, b, c: Integer;
  1134.   f: Boolean;
  1135. begin
  1136.   f := False;
  1137.   for a := 0 to Length(pmOpts) - 1 do
  1138.     if (f) then
  1139.       break
  1140.     else
  1141.       for b := 0 to Length(pmOpts[a]) - 1 do
  1142.         if (f) then
  1143.           break
  1144.         else
  1145.           for c := 0 to Length(pmOpts[a][b]) - 1 do
  1146.             if (Sender = pmOpts[a][b][c]) then
  1147.             begin
  1148.               f := True;
  1149.               break;
  1150.             end;
  1151.   if (not f) then
  1152.   begin
  1153.     Writeln('Invalid menu item pointing to OnPopupClick');
  1154.     exit;
  1155.   end;
  1156.   a := a - 1;
  1157.   b := b - 1;
  1158.   if (a = 1) then
  1159.   begin
  1160.     if ((c = 0) or (c = 1) or (c = 3)) then
  1161.     begin
  1162.       if (c = 1) then
  1163.         drawArea := Point(drawArea.x - 1, drawArea.y - 1)
  1164.       else if (c = 3) then
  1165.         drawArea := Point(drawArea.x + 1, drawArea.y + 1);
  1166.       DeleteRowCol(drawArea, b = 0);
  1167.     end
  1168.     else
  1169.     begin
  1170.       a := -1
  1171.       while a = -1 do
  1172.         a := StrToIntDef(Readln('How many to delete (0 to cancel)'), -1);
  1173.       if (a = 0) then
  1174.         exit;
  1175.       if (c = 2) then
  1176.         drawArea := Point(drawArea.x - a, drawArea.y - a)
  1177.       else
  1178.         drawArea := Point(drawArea.x + 1, drawArea.y + 1);
  1179.       for c := 1 to a do
  1180.         DeleteRowCol(Point(drawArea.x, drawArea.y), b = 0);
  1181.     end;
  1182.   end
  1183.   else
  1184.   begin
  1185.     if ((c = 0) or (c = 2)) then
  1186.     begin
  1187.       if (c = 2) then
  1188.         drawArea := Point(drawArea.x + 1, drawArea.y + 1);
  1189.       InsertRowCol(drawArea, b = 0);
  1190.     end
  1191.     else
  1192.     begin
  1193.       a := -1
  1194.       while a = -1 do
  1195.         a := StrToIntDef(Readln('How many to insert (0 to cancel)'), -1);
  1196.       if (a = 0) then
  1197.         exit;
  1198.       if (c = 3) then
  1199.         drawArea := Point(drawArea.x + 1, drawArea.y + 1);
  1200.       for c := 1 to a do
  1201.         InsertRowCol(Point(drawArea.x, drawArea.y), b = 0);
  1202.   end;
  1203.   end;
  1204.   RedrawMap(maps[curMap]);
  1205.   PaintMap;
  1206. end;
  1207.  
  1208. procedure ApplyGrid(var img: TImage; col: Integer);
  1209. var
  1210.   x, y, xl, yl, tc: Integer;
  1211. begin
  1212.   xl := img.Width div 32;
  1213.   yl := img.Height div 32;
  1214.   tc := img.Canvas.Pen.Color;
  1215.   img.Canvas.Pen.Color := col;
  1216.   if (yl > 2) then
  1217.     for y := 1 to yl - 1 do
  1218.     begin
  1219.       img.Canvas.MoveTo(0, y * 32);
  1220.       img.Canvas.LineTo(img.Width, y * 32);
  1221.     end;
  1222.   if (xl > 2) then
  1223.     for x := 1 to xl - 1 do
  1224.     begin
  1225.       img.Canvas.MoveTo(x * 32, 0);
  1226.       img.Canvas.LineTo(x * 32, img.Height);
  1227.     end;
  1228.   img.Canvas.Pen.Color := tc;
  1229. end;
  1230.  
  1231. // Standard form setup procedure - no comments
  1232. procedure SetupForm;
  1233. var
  1234.   i, ii, iii: Integer;
  1235.   popMode, popDir: TStringArray;
  1236.   popAmount: array of TStringArray;
  1237. begin
  1238.   fMain := CreateForm;
  1239.  
  1240.   mMain := TMainMenu.Create(fMain);
  1241.   mFile := TMenuItem.Create(fMain);
  1242.   mFIle.Caption := 'File';
  1243.   menuNames := ['New', 'Open', 'Save', 'Close', 'Refresh'];
  1244.   SetLength(mFileOpts, Length(menuNames));
  1245.  
  1246.   for i := 0 to High(mFileOpts) do
  1247.   begin
  1248.     mFileOpts[i] := TMenuItem.Create(fMain);
  1249.     mFileOpts[i].Caption := menuNames[i];
  1250.     mFileOpts[i].OnClick := @OnMenuClick;
  1251.     mFIle.Add(mFileOpts[i]);
  1252.   end;
  1253.  
  1254.   mMain.Items.Add(mFile);
  1255.  
  1256.   with fMain do
  1257.   begin
  1258.     Caption := 'ScaRPG - Map Editor';
  1259.     ClientWidth := ((drawSize.x + 1) * 32) + ((shTile.w + 1) * 32) + 32;
  1260.     ClientHeight := ((drawSize.y + 1) * 32) + 32;
  1261.     Position := poDesktopCenter;
  1262.   end;
  1263.  
  1264.   pSheet := TPanel.Create(fMain);
  1265.   with pSheet do
  1266.   begin
  1267.     Parent := fMain;
  1268.     Width := (shTile.w + 1) * 32;
  1269.     Height := fMain.ClientHeight;
  1270.     Left := fMain.ClientWidth - Width;
  1271.     Top := 0;
  1272.   end;
  1273.  
  1274.   sbSheet := TScrollBox.Create(pSheet);
  1275.   with sbSheet do
  1276.   begin
  1277.     Parent := pSheet;
  1278.     Align := alClient;
  1279.     VertScrollBar.Increment := 32;
  1280.   end;
  1281.  
  1282.   iSheet := TImage.Create(sbSheet);
  1283.   with iSheet do
  1284.   begin
  1285.     Parent := sbSheet;
  1286.     Left := 0;
  1287.     Top := 0;
  1288.     Width := (shTile.w * 32);
  1289.     Height := (shTile.h * 32);
  1290.     SafeDrawBitmap(shTile.b, Canvas, 0, 0);
  1291.     OnMouseDown := @OnTilesheetMouseDown;
  1292.     OnMouseUp := @OnTilesheetMouseUp;
  1293.     ApplyGrid(iSheet, clRed);
  1294.   end;
  1295.  
  1296.   pTile := TPanel.Create(pSheet);
  1297.   with pTile do
  1298.   begin
  1299.     Parent := pSheet;
  1300.     Align := alBottom;
  1301.     Height := 96;
  1302.   end;
  1303.  
  1304.   iTile := TImage.Create(pTile);
  1305.   with iTile do
  1306.   begin
  1307.     Parent := pTile;
  1308.     Left := 16;
  1309.     Top := 16;
  1310.     Width := 64;
  1311.     Height := 64;
  1312.     PaintDrawTiles;
  1313.   end;
  1314.  
  1315.   bLayUp := TButton.Create(pTile);
  1316.   with bLayUp do
  1317.   begin
  1318.     Parent := pTile;
  1319.     Left := 96;
  1320.     Top := 16;
  1321.     Width := 32;
  1322.     Height := 32;
  1323.     Caption := '^';
  1324.     OnClick := @OnButtonClick;
  1325.   end;
  1326.  
  1327.   bLayDo := TButton.Create(pTile);
  1328.   with bLayDo do
  1329.   begin
  1330.     Parent := pTile;
  1331.     Left := 96;
  1332.     Top := 48;
  1333.     Width := 32;
  1334.     Height := 32;
  1335.     Caption := 'v';
  1336.     OnClick := @OnButtonClick;
  1337.   end;
  1338.  
  1339.   toolHints := ['Draw', 'Erase', 'Select', 'Flood', 'Pencil', 'Tile', 'Box', 'Copy'];
  1340.   SetLength(bTools, Length(toolHints));
  1341.   for i := 0 to High(toolHints) do
  1342.   begin
  1343.     bTools[i] := TButton.Create(pTile);
  1344.     with bTools[i] do
  1345.     begin
  1346.       Parent := pTile;
  1347.       Left := 144 + ((i mod 4) * 32);
  1348.       Top := 16 + ((i div 4) * 32);
  1349.       Width := 32;
  1350.       Height := 32;
  1351.       Hint := toolHints[i];
  1352.       Caption := Copy(toolHints[i], 1, 4);
  1353.       OnClick := @OnToolClick;
  1354.     end;
  1355.   end;
  1356.  
  1357.   lCurLay := TLabel.Create(pTile);
  1358.   with lCurLay do
  1359.   begin
  1360.     Parent := pTile;
  1361.     Left := 16;
  1362.     Top := 0;
  1363.     Caption := 'Layer ' + IntToStr(curLay) + ' selected';
  1364.   end;
  1365.  
  1366.   tcMain := TTabControl.Create(fMain);
  1367.   with tcMain do
  1368.   begin
  1369.     Parent := fMain;
  1370.     Left := 0;
  1371.     Top := 0;
  1372.     Width := (drawSize.x * 32) + 48;
  1373.     Height := (drawSize.y * 32) + 64;
  1374.     AddMap(20, 20, 3);
  1375.     OnChange := @OnTabChange;
  1376.   end;
  1377.  
  1378.   iMain := TImage.Create(tcMain);
  1379.   with iMain do
  1380.   begin
  1381.     Parent := tcMain;
  1382.     Left := 16;
  1383.     Top := 32;
  1384.     Width := drawSize.x * 32;
  1385.     Height := drawSize.y * 32;
  1386.     OnMouseDown := @OnMapMouseDown;
  1387.     OnMouseUp := @OnMapMouseUp;
  1388.     OnMouseMove := @OnMapMouseMove;
  1389.     ApplyGrid(iMain, clRed);
  1390.   end;
  1391.  
  1392.   sbHorz := TScrollBar.Create(tcMain);
  1393.   with sbHorz do
  1394.   begin
  1395.     Parent := tcMain;
  1396.     Left := 16;
  1397.     Top := 32 + iMain.Height;
  1398.     Width := iMain.Width;
  1399.     Height := 16;
  1400.     Kind := sbHorizontal;
  1401.     Max := maps[curMap].Width - drawSize.x;
  1402.     OnScroll := @OnMapScroll;
  1403.   end;
  1404.  
  1405.   sbVert := TScrollBar.Create(tcMain);
  1406.   with sbVert do
  1407.   begin
  1408.     Parent := tcMain;
  1409.     Left := 16 + iMain.Width;
  1410.     Top := 32;
  1411.     Width := iMain.Width;
  1412.     Height := 16;
  1413.     Kind := sbVertical;
  1414.     Max := maps[curMap].Height - drawSize.y;
  1415.     OnScroll := @OnMapScroll;
  1416.   end;
  1417.  
  1418.   ppMain := TPopupMenu.Create(fMain);
  1419.  
  1420.   popMode := ['Insert', 'Delete', 'Cancel'];
  1421.   SetLength(pmMain, Length(popMode));
  1422.   for i := 0 to Length(popMode) - 1 do
  1423.   begin
  1424.     pmMain[i] := TMenuItem.Create(fMain);
  1425.     pmMain[i].Caption := popMode[i];
  1426.   end;
  1427.  
  1428.   popDir := ['Row', 'Column'];
  1429.   SetLength(pmSub, Length(pmMain) - 1);
  1430.   for i := 0 to Length(pmSub) - 1 do
  1431.   begin
  1432.     SetLength(pmSub[i], Length(popDir));
  1433.     for ii := 0 to Length(pmSub[i]) - 1 do
  1434.     begin
  1435.       pmSub[i][ii] := TMenuItem.Create(fMain);
  1436.       pmSub[i][ii].Caption := popDir[ii];
  1437.     end;
  1438.   end;
  1439.  
  1440.   SetLength(popAmount, Length(pmSub));
  1441.   for i := 0 to Length(popAmount) - 1 do
  1442.     case i of
  1443.       0: popAmount[i] := ['1 Before', 'x Before', '1 After', 'x After'];
  1444.       1: popAmount[i] := ['Current', 'Previous', 'Previous x', 'Next', 'Next x'];
  1445.     end;
  1446.  
  1447.   SetLength(pmOpts, Length(pmSub));
  1448.   for i := 0 to Length(pmOpts) - 1 do
  1449.   begin
  1450.     SetLength(pmOpts[i], Length(pmSub[i]));
  1451.     for ii := 0 to Length(pmOpts[i]) - 1 do
  1452.     begin
  1453.       SetLength(pmOpts[i][ii], Length(popAmount[i]));
  1454.       for iii := 0 to Length(pmOpts[i][ii]) - 1 do
  1455.       begin
  1456.         pmOpts[i][ii][iii] := TMenuItem.Create(fMain);
  1457.         pmOpts[i][ii][iii].Caption := popAmount[i][iii];
  1458.         pmOpts[i][ii][iii].OnClick := @OnPopupClick;
  1459.         pmSub[i][ii].Add(pmOpts[i][ii][iii]);
  1460.       end;
  1461.     end;
  1462.   end;
  1463.  
  1464.   for i := 0 to Length(pmSub) - 1 do
  1465.     for ii := 0 to Length(pmSub[i]) - 1 do
  1466.       pmMain[i].Add(pmSub[i][ii]);
  1467.      
  1468.   for i := 0 to Length(popMode) - 1 do
  1469.     ppMain.Items.Add(pmMain[i]);
  1470.  
  1471.   RedrawMap(maps[curMap]);
  1472.   PaintMap;
  1473.   fMain.ShowModal;
  1474. end;
  1475.  
  1476. var
  1477.   v: TVariantArray;
  1478.   m, z, i: Integer;
  1479. // Main loop - no comments
  1480. begin
  1481.   Writeln('begin');
  1482.   drawSize := Point(15, 15);
  1483.   mode := Point(0, 1);
  1484.   LoadSheet(shTile, ScriptPath + 'Tiles.bmp');
  1485.  
  1486.   ThreadSafeCall('SetupForm', v);
  1487. //  SetupForm; // Use without SafeCall for debugging unknown errors, though very prone to self destruct when done so - use at own risk
  1488.   FreeForm(fMain);
  1489.  
  1490.   for m := 0 to High(maps) do
  1491.     for z := 0 to maps[m].depth - 1 do
  1492.       MFreeBitmap(maps[m].vis[z]);
  1493.   FreeBitmap(shTile.b);
  1494.  
  1495.   // Section for debugging memory leaks - see MBitmap and MFreeBitmap
  1496.   // Don't rely on it for fixing all leaks - only works when you use MBitmap and not LoadBitmap etc.
  1497.   while True do
  1498.   begin
  1499.     i := Pos('1', bitDeb);
  1500.     if (i = 0) then
  1501.       Break;
  1502.     Writeln('Bitmap created from ''' + bitLoc[i] + ''' not freed!');
  1503.     MFreeBitmap(i - 1);
  1504.   end;
  1505.  
  1506.   Writeln('end');
  1507. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement