MapEditor example: Mutative tiles

Programs/Examples/Game/GameEngine.Mod

@@ -10,9 +10,20 @@ CONST
 
   tilesInRow* = 8;
 
+  (** Direction set elements **)
+  up        = 0;
+  right     = 1;
+  down      = 2;
+  left      = 3;
+  upRight   = 4;
+  upLeft    = 5;
+  downRight = 6;
+  downLeft  = 7;
+
 TYPE
   Cell* = RECORD (** A single cell of the map *)
-    kind*: INTEGER
+    kind*: INTEGER;
+    tile*: INTEGER
   END;
 
   Map* = RECORD
@@ -27,6 +38,109 @@ TYPE
 VAR
   tiles*: G.Bitmap;
 
+PROCEDURE CheckNeighbours(VAR map: Map; x, y, kind: INTEGER): SET;
+VAR s: SET;
+  PROCEDURE P(VAR map: Map; x, y, dir: INTEGER; VAR s: SET);
+  BEGIN
+    IF (0 <= x) & (x < map.w) & (0 <= y) & (y < map.h) &
+       ((map.cells[y, x].kind = kind) OR
+        (kind = 64) & (map.cells[y, x].kind = 96))
+    THEN INCL(s, dir)
+    END
+  END P;
+BEGIN
+  s := {};
+  P(map, x    , y - 1, up       , s);
+  P(map, x + 1, y    , right    , s);
+  P(map, x    , y + 1, down     , s);
+  P(map, x - 1, y    , left     , s);
+  P(map, x - 1, y - 1, upLeft   , s);
+  P(map, x + 1, y - 1, upRight  , s);
+  P(map, x - 1, y + 1, downLeft , s);
+  P(map, x + 1, y + 1, downRight, s)
+RETURN s END CheckNeighbours;
+
+PROCEDURE UpdateMapTile*(VAR map: Map; x, y: INTEGER);
+VAR kind, tile, xx, yy: INTEGER;
+  dirs: SET; (* Set of directions of neighbours where kind is the same *)
+BEGIN
+  kind := map.cells[y, x].kind;
+  tile := kind;
+  IF (kind = 64) OR (kind = 96) THEN
+    dirs := CheckNeighbours(map, x, y, kind);
+    xx := 3; yy := 3;
+    IF up IN dirs THEN
+      IF {left, right, down} - dirs = {} THEN
+        IF    ~(upLeft    IN dirs) THEN xx := 5; yy := 1
+        ELSIF ~(upRight   IN dirs) THEN xx := 4; yy := 1
+        ELSIF ~(downLeft  IN dirs) THEN xx := 5; yy := 0
+        ELSIF ~(downRight IN dirs) THEN xx := 4; yy := 0
+        ELSE xx := 1; yy := 1
+        END
+      ELSIF {left , right}   - dirs = {} THEN xx := 1; yy := 2
+      ELSIF {left , down }   - dirs = {} THEN xx := 2; yy := 1
+      ELSIF {right, down }   - dirs = {} THEN xx := 0; yy := 1
+      ELSIF left  IN dirs THEN xx := 2; yy := 2
+      ELSIF right IN dirs THEN xx := 0; yy := 2
+      ELSIF down  IN dirs THEN xx := 3; yy := 1
+      ELSE                     xx := 3; yy := 2
+      END
+    ELSIF down IN dirs THEN
+      IF {left, right} - dirs = {} THEN xx := 1; yy := 0
+      ELSIF left  IN dirs THEN xx := 2; yy := 0
+      ELSIF right IN dirs THEN xx := 0; yy := 0
+      ELSE                     xx := 3; yy := 0
+      END
+    ELSIF left IN dirs THEN
+      IF right IN dirs THEN  xx := 1; yy := 3
+      ELSE                   xx := 2; yy := 3
+      END
+    ELSIF right IN dirs THEN xx := 0; yy := 3
+    END;
+    tile := kind + xx + yy * tilesInRow
+  END;
+  map.cells[y, x].tile := tile
+END UpdateMapTile;
+
+PROCEDURE UpdateMapTiles*(VAR map: Map);
+VAR x, y: INTEGER;
+BEGIN
+  FOR y := 0 TO map.h - 1 DO
+    FOR x := 0 TO map.w - 1 DO
+      UpdateMapTile(map, x, y)
+    END
+  END
+END UpdateMapTiles;
+
+PROCEDURE UpdateMapTileAround*(VAR map: Map; x, y: INTEGER);
+BEGIN
+  UpdateMapTile(map, x, y);
+  IF x > 0 THEN
+    UpdateMapTile(map, x - 1, y);
+    IF y > 0 THEN UpdateMapTile(map, x - 1, y - 1) END;
+    IF y < map.h - 1 THEN UpdateMapTile(map, x - 1, y + 1) END
+  END;
+  IF x < map.w - 1 THEN
+    UpdateMapTile(map, x + 1, y);
+    IF y > 0 THEN UpdateMapTile(map, x + 1, y - 1) END;
+    IF y < map.h - 1 THEN UpdateMapTile(map, x + 1, y + 1) END
+  END;
+  IF y > 0 THEN UpdateMapTile(map, x, y - 1) END;
+  IF y < map.h - 1 THEN UpdateMapTile(map, x, y + 1) END
+END UpdateMapTileAround;
+
+PROCEDURE SetCell*(VAR map: Map; x, y, kind: INTEGER);
+  PROCEDURE P(VAR cell: Cell; kind: INTEGER);
+  BEGIN
+    IF cell.kind # kind THEN
+      cell.kind := kind;
+      UpdateMapTileAround(map, x, y)
+    END
+  END P;
+BEGIN
+  P(map.cells[y, x], kind)
+END SetCell;
+
 PROCEDURE MakeRandomMap*(VAR map: Map; w, h: INTEGER);
 VAR x, y: INTEGER;
 BEGIN
@@ -35,7 +149,8 @@ BEGIN
     FOR x := 0 TO w - 1 DO
       map.cells[y, x].kind := 0 (*Random.Int(4)*)
     END
-  END
+  END;
+  UpdateMapTiles(map)
 END MakeRandomMap;
 
 PROCEDURE LoadMap*(VAR map: Map; fname: ARRAY OF CHAR): BOOLEAN;

Programs/Examples/Game/MapEditor.Mod

@@ -1,7 +1,6 @@
 MODULE MapEditor;
 IMPORT G := Graph, S := SimpleGui, Out, Int, Strings, E := GameEngine;
 CONST window = FALSE;
-
 TYPE
   MapWidget = POINTER TO MapWidgetDesc;
   MapWidgetDesc = RECORD(S.WidgetDesc)
@@ -41,8 +40,8 @@ RETURN x END Limit;
 PROCEDURE DrawCell(cell: E.Cell; x, y, toX, toY: INTEGER);
 VAR kx, ky: INTEGER;
 BEGIN
-  kx := cell.kind MOD E.tilesInRow * E.cellW;
-  ky := cell.kind DIV E.tilesInRow * E.cellH;
+  kx := cell.tile MOD E.tilesInRow * E.cellW;
+  ky := cell.tile DIV E.tilesInRow * E.cellH;
   G.DrawPart(E.tiles, kx, ky, E.cellW, E.cellH, toX, toY)
 END DrawCell;
 
@@ -56,10 +55,10 @@ VAR x: INTEGER;
 BEGIN
   m := c(MapWidget);
   G.GetClip(cx, cy, cw, ch);
-(*  INC(cx, E.cellW * 2);
+  (*INC(cx, E.cellW * 2);
   INC(cy, E.cellW * 2);
   DEC(cw, E.cellW * 4);
-  DEC(ch, E.cellW * 4); *)
+  DEC(ch, E.cellW * 4);*)
 
   x0 := (cx - msg.x) DIV E.cellW;
   IF x0 < 0 THEN x0 := 0 END;
@@ -97,14 +96,9 @@ END MapWidgetHandleDraw;
 
 (** (x; y) in cells *)
 PROCEDURE OnMapMouseDown(x, y: INTEGER);
-  PROCEDURE P(VAR cell: E.Cell);
-  BEGIN
-    IF cell.kind # wgtTileset.curTile THEN
-      cell.kind := wgtTileset.curTile;
-      S.Redraw(wgtMap)
-    END
-  END P;
-BEGIN P(game.map.cells[y, x])
+BEGIN
+  E.SetCell(game.map, x, y, wgtTileset.curTile);
+  S.Redraw(wgtMap)
 END OnMapMouseDown;
 
 PROCEDURE MapWidgetHandleMouseDown(c: S.Widget; VAR msg: S.MouseDownMsg);
@@ -222,26 +216,26 @@ BEGIN
 
   pnlTop := S.NewPanel(frmMain, 0, 0, W, 40);
 
-  lblMapName := S.NewLabel(pnlTop, 8, 9, 120, 22, 'Имя файла:');
+  lblMapName := S.NewLabel(pnlTop, 8, 9, 88, 22, 'Имя файла:');
   S.LabelSetAlign(lblMapName, S.alRight);
 
   edtMapName := S.NewEdit(pnlTop, lblMapName.x + lblMapName.w + 8,
-      9, 120, 22);
+      9, 40, 22);
 
   btnOpen := S.NewButton(pnlTop, edtMapName.x + edtMapName.w + 8,
-      8, 96, 24, 'Открыть');
+      8, 70, 24, 'Открыть');
 
   btnSave := S.NewButton(pnlTop, btnOpen.x + btnOpen.w + 8,
-      8, 96, 24, 'Сохранить');
+      8, 80, 24, 'Сохранить');
 
-  btnExit := S.NewButton(pnlTop, W - 68, 8, 60, 24, 'Выход');
+  btnExit := S.NewButton(pnlTop, W - 68, 8, 52, 24, 'Выход');
   S.SetOnClick(btnExit, BtnExitOnClick);
 
   pnlSide := S.NewPanel(frmMain, 0, pnlTop.h, 144, H - pnlTop.h);
   G.MakeCol(color, 40, 150, 40);
   S.SetBgColor(pnlSide, color);
 
-  wgtTileset := NewTilesetWidget(pnlSide, 0, 0, pnlSide.w, 200);
+  wgtTileset := NewTilesetWidget(pnlSide, 0, 0, pnlSide.w, pnlSide.h);
 
   sbxMap := S.NewScrollBox(frmMain, pnlSide.w, pnlTop.h,
       W - pnlSide.w, H - pnlTop.h);
@@ -256,8 +250,8 @@ RETURN TRUE END InitInterface;
 PROCEDURE Init(): BOOLEAN;
 VAR ok: BOOLEAN;
 BEGIN ok := TRUE;
-  (*G.Settings(320, 200, {});*)
-  IF window THEN G.Settings(640, 480, {G.window(*, G.maximized*)}) END;
+  G.Settings(320, 200, {});
+  IF window THEN G.Settings(1240, 780, {G.window(*, G.maximized*)}) END;
   G.Init;
   IF ~G.Done THEN ok := FALSE END;
   IF ok THEN