Complete BigTask

code/KM_Render_Mobile.pas

@@ -14,16 +14,174 @@ function KMRenderMobileCreateTexture(aMinFilter, aMagFilter: TKMFilterType): Car
 procedure KMRenderMobileDeleteTexture(aTexId: Cardinal);
 procedure KMRenderMobileUpdateTexture(aTexture: Cardinal; aWidth, aHeight: Word; aMode: TKMTexFormat; const aData: Pointer);
 procedure KMRenderMobileInvalidateTextureBindingCache;
+procedure KMRenderMobileApplyOrdinary2DProjection(aScreenX, aScreenY: Word);
+procedure KMRenderMobileClearCurrentTarget;
+procedure KMRenderMobileSetActiveTextureUnit0;
+procedure KMRenderMobileDrawSampledTriangles(
+  const aPositionData, aTexCoordData: Pointer;
+  aStride, aVertexCount: Integer;
+  aColorR, aColorG, aColorB, aColorA: Single);
+procedure KMRenderMobileActivateSampledProgram;
+procedure KMRenderMobileInvalidateSampledProgram;
+procedure KMRenderMobileInitializeSampledProgram;
+function KMRenderMobileSampledProgramReady: Boolean;
+procedure KMRenderMobileDrawBrightnessOverlay(
+  aIntensity: Single; aWidth, aHeight: Word);
 
 implementation
 
 uses
-  SysUtils, CastleGLUtils, CastleGLES;
+  SysUtils, CastleGLUtils, CastleGLES, CastleRectangles, CastleProjection, CastleRenderContext, CastleVectors,
+  CastleGLShaders, CastleRenderOptions;
 
 var
   gTextureBackendReady: Boolean;
   gTextureBindingKnown: Boolean;
   gCachedTextureId: Cardinal;
+  gSampledProgram: TGLSLProgram;
+
+const
+  SampledVertexShader =
+    'attribute vec3 aPosition;' + #10 +
+    'attribute vec2 aTexCoord;' + #10 +
+    'uniform mat4 uProjection;' + #10 +
+    'varying vec2 vTexCoord;' + #10 +
+    'void main() {' + #10 +
+    '  gl_Position = uProjection * vec4(aPosition, 1.0);' + #10 +
+    '  vTexCoord = aTexCoord;' + #10 +
+    '}';
+  SampledFragmentShader =
+    'uniform sampler2D uTexture;' + #10 +
+    'uniform vec4 uColor;' + #10 +
+    'varying vec2 vTexCoord;' + #10 +
+    'void main() {' + #10 +
+    '  gl_FragColor = texture2D(uTexture, vTexCoord) * uColor;' + #10 +
+    '}';
+
+
+procedure KMRenderMobileApplyOrdinary2DProjection(aScreenX, aScreenY: Word);
+var
+  Dimensions: TFloatRectangle;
+begin
+  Dimensions.Left := 0;
+  Dimensions.Width := aScreenX;
+  Dimensions.Bottom := aScreenY;
+  Dimensions.Height := -Single(aScreenY);
+  RenderContext.ProjectionMatrix := OrthoProjectionMatrix(Dimensions, -100, 100);
+end;
+
+
+procedure KMRenderMobileClearCurrentTarget;
+begin
+  RenderContext.Clear([cbColor, cbDepth, cbStencil], TVector4.Zero);
+end;
+
+
+procedure KMRenderMobileDrawBrightnessOverlay(
+  aIntensity: Single; aWidth, aHeight: Word);
+begin
+  DrawRectangle(
+    Rectangle(0, 0, aWidth, aHeight),
+    Vector4(aIntensity, aIntensity, aIntensity, aIntensity),
+    bsDstColor, bdOne, True);
+  RenderContext.BlendingEnable(bsSrcAlpha, bdOneMinusSrcAlpha);
+end;
+
+
+procedure KMRenderMobileSetActiveTextureUnit0;
+begin
+  CastleGLES.glActiveTexture(CastleGLES.GL_TEXTURE0);
+end;
+
+
+procedure KMRenderMobileInitializeSampledProgram;
+var
+  candidate: TGLSLProgram;
+  positionAttribute, texCoordAttribute: TGLSLAttribute;
+  projectionUniform, textureUniform, colorUniform: TGLSLUniform;
+begin
+  if gSampledProgram <> nil then Exit;
+
+  candidate := TGLSLProgram.Create;
+  try
+    candidate.FragmentShaderRequired := True;
+    candidate.AttachVertexShader(SampledVertexShader);
+    candidate.AttachFragmentShader(SampledFragmentShader);
+    candidate.Link;
+    positionAttribute := candidate.Attribute('aPosition');
+    texCoordAttribute := candidate.Attribute('aTexCoord');
+    projectionUniform := candidate.Uniform('uProjection', umIgnore);
+    textureUniform := candidate.Uniform('uTexture', umIgnore);
+    colorUniform := candidate.Uniform('uColor', umIgnore);
+    if (projectionUniform.Location = -1) or (textureUniform.Location = -1)
+       or (colorUniform.Location = -1) then
+      raise Exception.Create('Sampled shader is missing a required uniform');
+    gSampledProgram := candidate;
+    candidate := nil;
+  finally
+    candidate.Free;
+  end;
+end;
+
+
+procedure KMRenderMobileActivateSampledProgram;
+begin
+  if gSampledProgram = nil then
+    raise Exception.Create('Sampled shader program is not ready');
+  gSampledProgram.Enable;
+end;
+
+
+procedure KMRenderMobileInvalidateSampledProgram;
+begin
+  FreeAndNil(gSampledProgram);
+end;
+
+
+function KMRenderMobileSampledProgramReady: Boolean;
+begin
+  Result := gSampledProgram <> nil;
+end;
+
+
+procedure KMRenderMobileDrawSampledTriangles(
+  const aPositionData, aTexCoordData: Pointer;
+  aStride, aVertexCount: Integer;
+  aColorR, aColorG, aColorB, aColorA: Single);
+var
+  positionAttribute, texCoordAttribute: TGLSLAttribute;
+  projectionUniform, colorUniform: TGLSLUniform;
+  positionEnabled, texCoordEnabled: Boolean;
+begin
+  if (aPositionData = nil) or (aTexCoordData = nil) or (aStride <= 0) or (aVertexCount <= 0) then
+    raise Exception.Create('Invalid sampled triangle draw input');
+  if gSampledProgram = nil then
+    KMRenderMobileActivateSampledProgram;
+
+  positionAttribute := gSampledProgram.Attribute('aPosition');
+  texCoordAttribute := gSampledProgram.Attribute('aTexCoord');
+  projectionUniform := gSampledProgram.Uniform('uProjection', umIgnore);
+  colorUniform := gSampledProgram.Uniform('uColor', umIgnore);
+  if (projectionUniform.Location = -1) or (colorUniform.Location = -1) then
+    raise Exception.Create('Sampled shader is missing a required draw uniform');
+
+  KMRenderMobileActivateSampledProgram;
+  projectionUniform.SetValue(RenderContext.ProjectionMatrix);
+  colorUniform.SetValue(Vector4(aColorR, aColorG, aColorB, aColorA));
+  RenderContext.BindBuffer[btArray] := 0;
+  positionEnabled := False;
+  texCoordEnabled := False;
+  try
+    positionAttribute.EnableArrayVector3(nil, CastleGLES.GLsizei(aStride), PtrUInt(aPositionData));
+    positionEnabled := True;
+    texCoordAttribute.EnableArrayVector2(nil, CastleGLES.GLsizei(aStride), PtrUInt(aTexCoordData));
+    texCoordEnabled := True;
+    CastleGLES.glDrawArrays(CastleGLES.GL_TRIANGLES, 0, CastleGLES.GLsizei(aVertexCount));
+  finally
+    if texCoordEnabled then texCoordAttribute.DisableArray;
+    if positionEnabled then positionAttribute.DisableArray;
+  end;
+end;
 
 
 procedure RequireTextureBackendReady;

config/extra-paths.json

@@ -25,7 +25,10 @@
     "src/res/KM_Resource.pas",
     "src/common/KM_Defaults.pas",
     "src/res/KM_ResTypes.pas",
-    "src/utils/KromOGLUtils.pas"
+    "src/utils/KromOGLUtils.pas",
+    "src/render/KM_RenderPool.pas",
+    "src/gui/KM_InterfaceGame.pas",
+    "src/render/KM_RenderTerrain.pas"
   ],
   "source_paths": [
     "code/resource"

port-source/kam_remake/src/KM_GameApp.pas

@@ -310,6 +310,8 @@ begin
   fApplicationGraphicsReadyGeneration := 0;
   if not TKMRender.TextureBackendReady then
     Exit;
+  if not TKMRender.SampledProgramReady then
+    Exit;
   if gGame <> nil then
   begin
     if gRes = nil then

port-source/kam_remake/src/common/KM_Defaults.pas

@@ -185,7 +185,6 @@ var
   SHOW_TERRAIN_PASS       :Byte = 0; //Byte(TKMTerrainPassability)
   SHOW_TILES_OWNER        :Boolean = False; //Show tiles owner
   SHOW_ATTACK_RADIUS      :Boolean = False; //Render towers/archers attack radius
-  RENDER_3D               :Boolean = False; //Experimental 3D render
   {Render}
   SAVE_MAP_TO_FBO_RENDER  :Boolean = False; //Do Render is performed into FBO off-screen buffer?
   {Stats}

port-source/kam_remake/src/gui/KM_InterfaceGame.pas

@@ -0,0 +1,707 @@
+unit KM_InterfaceGame;
+{$I KaM_Remake.inc}
+interface
+uses
+  {$IFDEF MSWindows} Windows, {$ENDIF}
+  {$IFDEF FPC}
+  {$IFDEF Unix} LCLIntF, {$ENDIF}
+  {$ENDIF}
+  SysUtils, Classes, Math, Controls,
+  KM_Defaults,
+  KM_Controls, KM_ControlsBase,
+  KM_Points,
+  KM_InterfaceDefaults, KM_CommonTypes, KM_Render, KM_MinimapGame, KM_Viewport, KM_ResFonts,
+  KM_ResTypes, KM_CommonClassesExt, KM_AITypes;
+
+
+type
+  // Common class for ingame interfaces (Gameplay, MapEd)
+  TKMUserInterfaceGame = class abstract(TKMUserInterfaceCommon)
+  private
+    fDragScrollingCursorPos: TPoint;
+    fDragScrollingViewportPos: TKMPointF;
+    fOnUserAction: TKMUserActionEvent;
+
+    fLogStringList: TKMLimitedList<string>;
+
+    function GetLogString(aLimit: Integer): string;
+    procedure LogMessageHappened(const aLogMessage: UnicodeString);
+
+    procedure ResetDragScrolling;
+    procedure PaintDefences;
+  protected
+    fMinimap: TKMMinimapGame;
+    fViewport: TKMViewport;
+    fDragScrolling: Boolean;
+
+    fPaintDefences: Boolean;
+
+    Bevel_DebugInfo: TKMBevel;
+    Label_DebugInfo: TKMLabel;
+
+    function ZoomChangeBlocked: Boolean; virtual;
+
+    function IsDragScrollingAllowed: Boolean; virtual;
+    function GetHintPositionBase: TKMPoint; override;
+    function GetHintFont: TKMFont; override;
+    function GetHintKind: TKMHintKind; override;
+
+    function GetDebugInfo: string; virtual;
+
+    procedure InitDebugControls;
+
+    procedure ViewportPositionChanged(const aPos: TKMPointF);
+    procedure OptionsChanged; virtual; abstract;
+
+    procedure HandleScrollKeysDown(Key: Word; var aHandled: Boolean);
+    procedure HandleScrollKeysUp(Key: Word; var aHandled: Boolean);
+  public
+    constructor Create(aRender: TKMRender); reintroduce;
+    destructor Destroy; override;
+
+    property Minimap: TKMMinimapGame read fMinimap;
+    property Viewport: TKMViewport read fViewport;
+    property OnUserAction: TKMUserActionEvent read fOnUserAction write fOnUserAction;
+
+    function CursorToMapCoord(X, Y: Integer): TKMPointF;
+
+    procedure DebugControlsUpdated(aSenderTag: Integer); override;
+
+    procedure KeyDown(Key: Word; Shift: TShiftState; aIsFirst: Boolean; var aHandled: Boolean); override;
+    procedure KeyUp(Key: Word; Shift: TShiftState; var aHandled: Boolean); override;
+    procedure KeyPress(Key: Char); override;
+    procedure MouseWheel(Shift: TShiftState; WheelSteps: Integer; X,Y: Integer; var aHandled: Boolean); override;
+    procedure MouseMove(Shift: TShiftState; X,Y: Integer; var aHandled: Boolean); override;
+    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;
+    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;
+
+    procedure ShowDebugInfo;
+
+    procedure GameSpeedChanged(aFromSpeed, aToSpeed: Single);
+    procedure SyncUI(aMoveViewport: Boolean = True); virtual;
+    procedure SyncUIView(const aCenter: TKMPointF); overload;
+    procedure SyncUIView(const aCenter: TKMPointF; aZoom: Single); overload;
+    procedure UpdateGameCursor(X, Y: Integer; Shift: TShiftState);
+    procedure UpdateStateIdle(aFrameTime: Cardinal); virtual; abstract;
+    procedure UpdateState(aGlobalTickCount: Cardinal); override;
+
+    procedure Paint; override;
+  end;
+
+
+const
+  // Toolbar pads
+  TB_PAD = 9; // Picked up empirically
+  TB_WIDTH = 180; // Max width of sidebar elements
+  TB_MAP_ED_WIDTH = MAPED_TOOLBAR_WIDTH - 44; //Max width of sidebar elements in Map Editor
+  PAGE_TITLE_Y = 5; // Page title offset
+  TERRAIN_PAGE_TITLE_Y = PAGE_TITLE_Y + 2; // Terrain pages title offset
+  STATS_LINES_CNT = 13; //Number of stats (F3) lines
+
+  DEFENCE_LINE_TYPE_COL: array [TKMAIDefencePosType] of Cardinal = ($FF80FF00, $FFFF8000);
+
+  // Shortcuts
+  // All shortcuts are in English and are the same for all languages to avoid
+  // naming collisions and confusion in discussions
+
+  GUI_HOUSE_COUNT = 28;   // Number of KaM houses to show in GUI
+  GUIHouseOrder: array [1..GUI_HOUSE_COUNT] of TKMHouseType = (
+    htSchool, htInn, htQuarry, htWoodcutters, htSawmill,
+    htFarm, htMill, htBakery, htSwine, htButchers,
+    htVineyard, htGoldMine, htCoalMine, htMetallurgists, htWeaponWorkshop,
+    htTannery, htArmorWorkshop, htStables, htIronMine, htIronSmithy,
+    htWeaponSmithy, htArmorSmithy, htBarracks, htStore, htWatchTower,
+    htFishermans, htMarket, htTownHall);
+
+  // Template for how resources are shown in Barracks
+  BARRACKS_RES_COUNT = 11;
+  BarracksResType: array [1..BARRACKS_RES_COUNT] of TKMWareType =
+    (wtWoodenShield, wtIronShield, wtLeatherArmor, wtIronArmor, wtAxe, wtSword,
+     wtLance, wtPike, wtBow, wtCrossbow, wtHorse);
+
+  // Layout of resources in Store
+  STORE_RES_COUNT = 28;
+  StoreResType: array [1..STORE_RES_COUNT] of TKMWareType =
+    (wtTrunk,    wtStone,   wtTimber,        wtIronOre,   wtGoldOre,
+     wtCoal,     wtIron,   wtGold,        wtWine,      wtCorn,
+     wtBread,    wtFlour,   wtLeather,     wtSausage,  wtPig,
+     wtSkin,     wtWoodenShield,  wtIronShield, wtLeatherArmor,     wtIronArmor,
+     wtAxe,      wtSword,   wtLance,        wtPike, wtBow,
+     wtCrossbow,  wtHorse,   wtFish);
+
+  School_Order: array [0..13] of TKMUnitType = (
+    utSerf, utBuilder, utStonemason, utWoodcutter, utCarpenter,
+    utFisher, utFarmer, utBaker, utAnimalBreeder, utButcher,
+    utMiner, utMetallurgist, utSmith, utRecruit);
+
+  Barracks_Order: array [0..8] of TKMUnitType = (
+    utMilitia, utAxeFighter, utSwordFighter, utBowman, utCrossbowman,
+    utLanceCarrier, utPikeman, utScout, utKnight);
+
+  TownHall_Order: array [0..4] of TKMUnitType = (
+    utRebel, utRogue, utVagabond, utBarbarian, utWarrior);
+
+  Soldiers_Order: array[0..13] of TKMUnitType = (
+    utMilitia, utAxeFighter, utSwordFighter, utBowman, utCrossbowman,
+    utLanceCarrier, utPikeman, utScout, utKnight,
+    utRebel, utRogue, utVagabond, utBarbarian, utWarrior);
+
+  // Stats get stacked by UI logic (so that on taller screens they all were
+  // in nice pairs, and would stack up only on short screens)
+  StatPlan: array [0..STATS_LINES_CNT-1] of record
+    HouseType: array [0..3] of TKMHouseType;
+    UnitType: array [0..1] of TKMUnitType;
+  end = (
+    (HouseType: (htQuarry, htNone, htNone, htNone);                     UnitType: (utStonemason, utNone)),
+    (HouseType: (htWoodcutters, htNone, htNone, htNone);                UnitType: (utWoodcutter, utNone)),
+    (HouseType: (htFishermans, htNone, htNone, htNone);                 UnitType: (utFisher, utNone)),
+    (HouseType: (htFarm, htVineyard, htNone, htNone);                   UnitType: (utFarmer, utNone)),
+    (HouseType: (htMill, htBakery, htNone, htNone);                     UnitType: (utBaker, utNone)),
+    (HouseType: (htSwine, htStables, htNone, htNone);                   UnitType: (utAnimalBreeder, utNone)),
+    (HouseType: (htButchers, htTannery, htNone, htNone);                UnitType: (utButcher, utNone)),
+    (HouseType: (htMetallurgists, htIronSmithy, htNone, htNone);        UnitType: (utMetallurgist, utNone)),
+    (HouseType: (htArmorSmithy, htWeaponSmithy, htNone, htNone);        UnitType: (utSmith, utNone)),
+    (HouseType: (htCoalMine, htIronMine, htGoldMine, htNone);           UnitType: (utMiner, utNone)),
+    (HouseType: (htSawmill, htWeaponWorkshop, htArmorWorkshop, htNone); UnitType: (utCarpenter, utNone)),
+    (HouseType: (htBarracks, htTownHall, htWatchTower, htNone);         UnitType: (utRecruit, utNone)),
+    (HouseType: (htStore, htSchool, htInn, htMarket);                   UnitType: (utSerf, utBuilder))
+    );
+
+  MapEd_Order: array [0..13] of TKMUnitType = (
+    utMilitia, utAxeFighter, utSwordFighter, utBowman, utCrossbowman,
+    utLanceCarrier, utPikeman, utScout, utKnight, utBarbarian,
+    utRebel, utRogue, utWarrior, utVagabond);
+
+  MapEd_Icon: array [0..13] of Word = (
+    61, 62, 63, 64, 65,
+    66, 67, 68, 69, 70,
+    79, 80, 81, 82);
+
+  Animal_Order: array [0..7] of TKMUnitType = (
+    utWolf, utFish,        utWatersnake, utSeastar,
+    utCrab, utWaterflower, utWaterleaf,  utDuck);
+
+  Animal_Icon: array [0..7] of Word = (
+    71, 72, 73, 74,
+    75, 76, 77, 78);
+
+  MARKET_RES_HEIGHT = 35;
+
+  // Big tab buttons in MapEd
+  BIG_TAB_W = 41;
+  BIG_PAD_W = 41;
+  BIG_TAB_H = 36;
+  // Small sub-tab buttons in MapEd
+  SMALL_TAB_W = 30;
+  SMALL_PAD_W = 30;
+  SMALL_TAB_H = 26;
+
+  MESSAGE_AREA_HEIGHT = 173+17; // Image_ChatHead + Image_ChatBody
+  MESSAGE_AREA_RESIZE_Y = 200; // How much can we resize it
+
+
+implementation
+uses
+  StrUtils, KromUtils,
+  KM_AIDefensePos,
+  KM_Cursor, KM_Main, KM_System,
+  KM_GameParams, KM_GameSettings,
+  KM_HandsCollection, 
+  KM_Terrain, 
+  KM_RenderPool, KM_RenderUI, KM_Pics,  
+  KM_Resource, KM_ResKeys,
+  KM_Sound, KM_ScriptSound,
+  KM_CommonUtils, KM_Log;
+
+
+{ TKMUserInterfaceGame }
+constructor TKMUserInterfaceGame.Create(aRender: TKMRender);
+begin
+  inherited Create(aRender.ScreenX, aRender.ScreenY);
+
+  fMinimap := TKMMinimapGame.Create(False);
+  fViewport := TKMViewport.Create(GetToolbarWidth, aRender.ScreenX, aRender.ScreenY, ViewportPositionChanged);
+
+  gLog.AddOnLogEventSub(LogMessageHappened);
+  fLogStringList := TKMLimitedList<string>.Create(80); // 80 lines max
+
+  fDragScrolling := False;
+  fDragScrollingCursorPos.X := 0;
+  fDragScrollingCursorPos.Y := 0;
+  fDragScrollingViewportPos := KMPOINTF_ZERO;
+
+  fPaintDefences := False;
+
+  gRenderPool := TKMRenderPool.Create(fViewport);
+end;
+
+
+destructor TKMUserInterfaceGame.Destroy;
+begin
+  gLog.RemoveOnLogEventSub(LogMessageHappened);
+  fLogStringList.Free;
+
+  FreeAndNil(fMinimap);
+  FreeAndNil(fViewport);
+  FreeAndNil(gRenderPool);
+  inherited;
+end;
+
+
+procedure TKMUserInterfaceGame.DebugControlsUpdated(aSenderTag: Integer);
+begin
+  inherited;
+
+  if aSenderTag = Ord(dcFlatTerrain) then
+    gTerrain.UpdateLighting;
+end;
+
+
+function TKMUserInterfaceGame.GetHintPositionBase: TKMPoint;
+begin
+  Result := TKMPoint.New(GetToolbarWidth + 35, Panel_Main.Height);
+end;
+
+
+function TKMUserInterfaceGame.GetHintFont: TKMFont;
+begin
+  Result := fntOutline;
+end;
+
+
+function TKMUserInterfaceGame.GetHintKind: TKMHintKind;
+begin
+  Result := hkStatic;
+end;
+
+
+procedure TKMUserInterfaceGame.LogMessageHappened(const aLogMessage: UnicodeString);
+begin
+  if Self = nil then Exit;
+
+  if SHOW_LOG_IN_GUI or UPDATE_LOG_FOR_GUI then
+    fLogStringList.Add(ReplaceStr(DeleteDoubleSpaces(aLogMessage), EolW, '|'));
+end;
+
+
+
+function TKMUserInterfaceGame.GetLogString(aLimit: Integer): string;
+var
+  I: Integer;
+begin
+  Result := '';
+  // attach from the end, the most fresh log lines, till the limit
+  for I := fLogStringList.Count - 1 downto Max(fLogStringList.Count - aLimit - 1, 0) do
+    Result := fLogStringList[I] + '|' + Result;
+end;
+
+
+function TKMUserInterfaceGame.GetDebugInfo: string;
+begin
+  Result :='';
+
+  if SHOW_VIEWPORT_INFO then
+    Result := Result + 'Viewport: ' + fViewport.ToStr + '|';
+
+  if SHOW_FPS then
+    Result := Result + gMain.FPSString + '|';
+end;
+
+
+procedure TKMUserInterfaceGame.ShowDebugInfo;
+const
+  BEVEL_PAD = 20;
+var
+  S: string;
+  linesCnt: Integer;
+  textSize: TKMPoint;
+begin
+  S := GetDebugInfo;
+
+  // Add logs at the end
+  if SHOW_LOG_IN_GUI then
+  begin
+    linesCnt := (Bevel_DebugInfo.Parent.Height
+                  - Bevel_DebugInfo.Top
+                  - BEVEL_PAD
+                  - gRes.Fonts[Label_DebugInfo.Font].GetTextSize(S).Y)
+                div gRes.Fonts[Label_DebugInfo.Font].LineHeight;
+    S := S + '|Logs:|' + GetLogString(linesCnt - 1);
+  end;
+
+  Label_DebugInfo.Caption := S;
+  Label_DebugInfo.Visible := (Trim(S) <> '');
+
+  Assert(InRange(DEBUG_TEXT_FONT_ID, Ord(Low(TKMFont)), Ord(High(TKMFont))));
+  Label_DebugInfo.Font := TKMFont(DEBUG_TEXT_FONT_ID);
+
+  textSize := gRes.Fonts[Label_DebugInfo.Font].GetTextSize(S);
+
+  Bevel_DebugInfo.Width := IfThen(textSize.X <= 1, 0, textSize.X + BEVEL_PAD);
+  Bevel_DebugInfo.Height := IfThen(textSize.Y <= 1, 0, textSize.Y + BEVEL_PAD);
+
+  Bevel_DebugInfo.Visible := SHOW_DEBUG_OVERLAY_BEVEL and (Trim(S) <> '') ;
+end;
+
+
+procedure TKMUserInterfaceGame.ViewportPositionChanged(const aPos: TKMPointF);
+begin
+  gSoundPlayer.UpdateListener(aPos.X, aPos.Y);
+  if gScriptSounds <> nil then
+    gScriptSounds.UpdateListener(aPos.X, aPos.Y);
+end;
+
+
+procedure TKMUserInterfaceGame.KeyPress(Key: Char);
+begin
+  if Assigned(fOnUserAction) then
+    fOnUserAction(uatKeyPress);
+
+  inherited;
+end;
+
+
+procedure TKMUserInterfaceGame.HandleScrollKeysDown(Key: Word; var aHandled: Boolean);
+{$IFDEF MSWindows}
+var
+  windowRect: TRect;
+{$ENDIF}
+begin
+  aHandled := True;
+
+  if gMySpectator.Hand.InCinematic then
+  begin
+    aHandled := False;
+    Exit;
+  end;
+
+  //Scrolling
+  if Key = gResKeys[kfScrollLeft]       then
+    fViewport.ScrollKeyLeft  := True
+  else if Key = gResKeys[kfScrollRight] then
+    fViewport.ScrollKeyRight := True
+  else if Key = gResKeys[kfScrollUp]    then
+    fViewport.ScrollKeyUp    := True
+  else if Key =  gResKeys[kfScrollDown] then
+    fViewport.ScrollKeyDown  := True
+  else if Key = gResKeys[kfZoomIn]      then
+    fViewport.ZoomKeyIn      := True
+  else if Key = gResKeys[kfZoomOut]     then
+    fViewport.ZoomKeyOut     := True
+  else if Key = gResKeys[kfZoomReset]   then
+    fViewport.ResetZoom
+  else if (Key = gResKeys[kfMapDragScroll])
+      and IsDragScrollingAllowed then
+  begin
+    fDragScrolling := True;
+   // Restrict the cursor to the window, for now.
+   //todo -cPractical: Allow one to drag out of the window, and still capture.
+   {$IFDEF MSWindows}
+     windowRect := gMain.ClientRect(1); //Reduce ClientRect by 1 pixel, to fix 'jump viewport' bug when dragscrolling over the window border
+     ClipCursor(@windowRect);
+   {$ENDIF}
+   fDragScrollingCursorPos.X := gCursor.Pixel.X;
+   fDragScrollingCursorPos.Y := gCursor.Pixel.Y;
+   fDragScrollingViewportPos.X := fViewport.Position.X;
+   fDragScrollingViewportPos.Y := fViewport.Position.Y;
+   gSystem.Cursor := kmcDrag;
+  end
+  else
+    aHandled := False;
+end;
+
+
+// This event happens every ~33ms if the Key is Down and holded
+procedure TKMUserInterfaceGame.KeyDown(Key: Word; Shift: TShiftState; aIsFirst: Boolean; var aHandled: Boolean);
+begin
+  if Assigned(fOnUserAction) then
+    fOnUserAction(uatKeyDown);
+
+  if aHandled then Exit;
+
+  inherited;
+
+  // Update game options in case we used sounds hotkeys
+  if aHandled then
+  begin
+    OptionsChanged;
+    Exit;
+  end;
+
+  HandleScrollKeysDown(Key, aHandled);
+end;
+
+
+procedure TKMUserInterfaceGame.HandleScrollKeysUp(Key: Word; var aHandled: Boolean);
+begin
+  aHandled := True;
+
+  if gMySpectator.Hand.InCinematic then
+  begin
+    aHandled := False;
+    Exit;
+  end;
+
+  //Scrolling
+  if Key = gResKeys[kfScrollLeft]       then
+    fViewport.ScrollKeyLeft := False
+  else if Key = gResKeys[kfScrollRight] then
+    fViewport.ScrollKeyRight := False
+  else if Key = gResKeys[kfScrollUp]    then
+    fViewport.ScrollKeyUp := False
+  else if Key =  gResKeys[kfScrollDown] then
+    fViewport.ScrollKeyDown  := False
+  else if Key = gResKeys[kfZoomIn]      then
+    fViewport.ZoomKeyIn := False
+  else if Key = gResKeys[kfZoomOut]     then
+    fViewport.ZoomKeyOut := False
+  else if Key = gResKeys[kfZoomReset]   then
+    fViewport.ResetZoom
+  else if Key = gResKeys[kfMapDragScroll] then
+  begin
+    if fDragScrolling then
+      ResetDragScrolling;
+  end
+  else
+    aHandled := False;
+end;
+
+
+procedure TKMUserInterfaceGame.KeyUp(Key: Word; Shift: TShiftState; var aHandled: Boolean);
+begin
+  if Assigned(fOnUserAction) then
+    fOnUserAction(uatKeyUp);
+
+  if aHandled then Exit;
+
+  inherited;
+
+  // Update game options in case we used sounds hotkeys
+  if aHandled then
+  begin
+    OptionsChanged;
+    Exit;
+  end;
+
+  HandleScrollKeysUp(Key, aHandled);
+end;
+
+
+procedure TKMUserInterfaceGame.ResetDragScrolling;
+begin
+  fDragScrolling := False;
+  gSystem.Cursor := kmcDefault; //Reset cursor
+  gMain.ApplyCursorRestriction;
+end;
+
+
+procedure TKMUserInterfaceGame.InitDebugControls;
+begin
+  // Debugging displays
+  Bevel_DebugInfo := TKMBevel.Create(Panel_Main, ToolbarWidth + 8 - 10, 133 - 10, Panel_Main.Width - ToolbarWidth - 8, 0);
+  Bevel_DebugInfo.BackAlpha := 0.5;
+  Bevel_DebugInfo.Hitable := False;
+  Bevel_DebugInfo.Hide;
+  Label_DebugInfo := TKMLabel.Create(Panel_Main, ToolbarWidth + 8, 133, '', fntMonospaced, taLeft);
+  Label_DebugInfo.Hide;
+end;
+
+
+function TKMUserInterfaceGame.IsDragScrollingAllowed: Boolean;
+begin
+  Result := True; // Allow drag scrolling by default
+end;
+
+
+procedure TKMUserInterfaceGame.MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
+begin
+  inherited;
+  if Assigned(fOnUserAction) then
+    fOnUserAction(uatMouseUp);
+end;
+
+
+procedure TKMUserInterfaceGame.MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
+begin
+  inherited;
+
+  if Assigned(fOnUserAction) then
+    fOnUserAction(uatMouseDown);
+end;
+
+
+procedure TKMUserInterfaceGame.MouseMove(Shift: TShiftState; X,Y: Integer; var aHandled: Boolean);
+var
+  VP: TKMPointF;
+begin
+  inherited;
+
+  if Assigned(fOnUserAction) then
+    fOnUserAction(uatMouseMove);
+
+  aHandled := False;
+  if fDragScrolling then
+  begin
+    if GetKeyState(gResKeys[kfMapDragScroll]) < 0 then
+    begin
+      UpdateGameCursor(X, Y, Shift);
+      VP.X := fDragScrollingViewportPos.X + (fDragScrollingCursorPos.X - X) / (CELL_SIZE_PX * fViewport.Zoom);
+      VP.Y := fDragScrollingViewportPos.Y + (fDragScrollingCursorPos.Y - Y) / (CELL_SIZE_PX * fViewport.Zoom);
+      fViewport.Position := VP;
+      aHandled := True;
+    end else
+      ResetDragScrolling;
+  end;
+end;
+
+
+function TKMUserInterfaceGame.ZoomChangeBlocked: Boolean;
+begin
+  Result := False;
+end;
+
+
+procedure TKMUserInterfaceGame.MouseWheel(Shift: TShiftState; WheelSteps, X, Y: Integer; var aHandled: Boolean);
+var
+  prevCursor: TKMPointF;
+begin
+  inherited;
+
+  if Assigned(fOnUserAction) then
+    fOnUserAction(uatMouseWheel);
+
+  if (X < 0) or (Y < 0) then Exit; // This happens when you use the mouse wheel on the window frame
+
+  // Allow to zoom only when cursor is over map. Controls handle zoom on their own
+  if aHandled or ZoomChangeBlocked then Exit;
+  
+  UpdateGameCursor(X, Y, Shift); // Make sure we have the correct cursor position to begin with
+  prevCursor := gCursor.Float;
+  // +1 for ScrollSpeed = 0.
+  // Sqrt to reduce Scroll speed importance
+  // 11 = 10 + 1, 10 is default scroll speed
+  fViewport.Zoom := fViewport.Zoom * (1 + WheelSteps * Sqrt((gGameSettings.ScrollSpeed + 1) / 11) / 12);
+  UpdateGameCursor(X, Y, Shift); // Zooming changes the cursor position
+  // Move the center of the screen so the cursor stays on the same tile, thus pivoting the zoom around the cursor
+  fViewport.Position := KMPointF(fViewport.Position.X + prevCursor.X-gCursor.Float.X,
+                                 fViewport.Position.Y + prevCursor.Y-gCursor.Float.Y);
+  UpdateGameCursor(X, Y, Shift); // Recentering the map changes the cursor position
+  aHandled := True;
+end;
+
+
+procedure TKMUserInterfaceGame.PaintDefences;
+var
+  I, K: Integer;
+  DP: TAIDefencePosition;
+  locF: TKMPointF;
+  screenLoc: TKMPoint;
+begin
+  for I := 0 to gHands.Count - 1 do
+    for K := 0 to gHands[I].AI.General.DefencePositions.Count - 1 do
+    begin
+      DP := gHands[I].AI.General.DefencePositions[K];
+      locF := gTerrain.FlatToHeight(KMPointF(DP.Position.Loc.X-0.5, DP.Position.Loc.Y-0.5));
+      screenLoc := fViewport.MapToScreen(locF);
+
+      if KMInRect(screenLoc, fViewport.ViewRect) then
+      begin
+        //Dir selector
+        TKMRenderUI.WritePicture(screenLoc.X, screenLoc.Y, 0, 0, [], rxGui,  510 + Byte(DP.Position.Dir));
+        TKMRenderUI.WriteTextInShape(IntToStr(K+1), screenLoc.X, screenLoc.Y - 28, DEFENCE_LINE_TYPE_COL[DP.DefenceType],
+                                     FlagColorToTextColor(GROUP_TXT_COLOR[DP.GroupType]), $80000000, IntToStr(I + 1), gHands[I].FlagColor, icWhite);
+        //GroupType icon
+        TKMRenderUI.WritePicture(screenLoc.X, screenLoc.Y, 0, 0, [], rxGui, GROUP_IMG[DP.GroupType]);
+      end;
+    end;
+end;
+
+
+procedure TKMUserInterfaceGame.Paint;
+begin
+  if (mlDefencesAll in gGameParams.VisibleLayers) then
+    fPaintDefences := True;
+
+  if fPaintDefences then
+    PaintDefences;
+
+  fPaintDefences := False;
+
+  inherited;
+end;
+
+
+procedure TKMUserInterfaceGame.GameSpeedChanged(aFromSpeed, aToSpeed: Single);
+begin
+  fViewport.GameSpeedChanged(aFromSpeed, aToSpeed);
+end;
+
+
+procedure TKMUserInterfaceGame.SyncUI(aMoveViewport: Boolean = True);
+begin
+  fMinimap.LoadFromTerrain;
+  fMinimap.Update;
+
+  gTerrain.OnTopHillChanged := fViewport.TopHillChanged;
+
+  if aMoveViewport then
+  begin
+    fViewport.ResizeMap(gTerrain.MapX, gTerrain.MapY, gTerrain.TopHill / CELL_SIZE_PX);
+    fViewport.ResetZoom;
+  end;
+
+  UpdateHotkeys;
+end;
+
+
+procedure TKMUserInterfaceGame.SyncUIView(const aCenter: TKMPointF);
+begin
+  fViewport.Zoom := gGameSettings.DefaultZoom; // Set Zoom first, since it can apply restrictions on Position near map borders
+  fViewport.Position := aCenter;
+end;
+
+
+procedure TKMUserInterfaceGame.SyncUIView(const aCenter: TKMPointF; aZoom: Single);
+begin
+  fViewport.Zoom := aZoom; // Set Zoom first, since it can apply restrictions on Position near map borders
+  fViewport.Position := aCenter;
+end;
+
+
+function TKMUserInterfaceGame.CursorToMapCoord(X, Y: Integer): TKMPointF;
+begin
+  Result.X := fViewport.Position.X + (X-fViewport.ViewRect.Right/2-GetToolbarWidth/2)/CELL_SIZE_PX/fViewport.Zoom;
+  Result.Y := fViewport.Position.Y + (Y-fViewport.ViewRect.Bottom/2)/CELL_SIZE_PX/fViewport.Zoom;
+  Result.Y := gTerrain.ConvertCursorToMapCoord(Result.X, Result.Y);
+end;
+
+
+// Compute cursor position and store it in global variables
+procedure TKMUserInterfaceGame.UpdateGameCursor(X, Y: Integer; Shift: TShiftState);
+begin
+  UpdateCursor(X, Y, Shift);
+
+  with gCursor do
+  begin
+    Float := CursorToMapCoord(X, Y);
+
+    PrevCell := Cell; //Save previous cell
+
+    // Cursor cannot reach row MapY or column MapX, they're not part of the map (only used for vertex height)
+    Cell.X := EnsureRange(Round(Float.X+0.5), 1, gTerrain.MapX-1); // Cell below cursor in map bounds
+    Cell.Y := EnsureRange(Round(Float.Y+0.5), 1, gTerrain.MapY-1);
+
+    ObjectUID := gRenderPool.RenderList.GetSelectionUID(Float);
+  end;
+end;
+
+
+procedure TKMUserInterfaceGame.UpdateState(aGlobalTickCount: Cardinal);
+begin
+  inherited;
+
+  ShowDebugInfo;
+end;
+
+
+end.

port-source/kam_remake/src/render/KM_Render.pas

@@ -12,7 +12,12 @@ const
   TEX_FORMAT_SIZE: array [TKMTexFormat] of Byte = (2, 4, 1);
 
 type
-  TKMRenderMode = (rm2D, rm3D);
+  TKMRenderMode = (rm2D);
+
+  TKMSampledVertex = record
+    X, Y, Z: Single;
+    U, V: Single;
+  end;
 
   //General OpenGL handling
   TKMRender = class
@@ -34,10 +39,12 @@ type
     constructor Create(aScreenX, aScreenY: Integer);
     destructor Destroy; override;
 
-    procedure SetRenderMode(aRenderMode: TKMRenderMode); //Switch between 2D and 3D perspectives
+    procedure SetRenderMode(aRenderMode: TKMRenderMode);
 
     class procedure GraphicsContextChanged(aAvailable: Boolean); static;
     class function TextureBackendReady: Boolean; static;
+    class function SampledProgramReady: Boolean; static;
+    class procedure DrawSampledTriangles(const aVertices: array of TKMSampledVertex; const aColor: TKMColor4f); static;
     class function GetMaxTexSize: Cardinal; static;
     class function GetMaxViewportDim: Cardinal; static;
     class function GenerateTextureCommon(aMinFilter, aMagFilter: TKMFilterType): Cardinal;
@@ -70,8 +77,9 @@ var
 implementation
 uses
   SysUtils, Math,
+  CastleRenderContext, CastleRenderOptions,
   KromOGLUtils, KromUtils,
-  KM_Log, KM_Defaults, KM_IoPNG, KM_CommonClasses,
+  KM_Defaults, KM_IoPNG, KM_CommonClasses,
   KM_Render_Mobile;
 
 const
@@ -85,38 +93,23 @@ constructor TKMRender.Create(aScreenX, aScreenY: Integer);
 begin
   inherited Create;
 
-  gLog.AddTime('Init Render started');
-
   fFBOInited := False;
   if not fBlind then
   begin
     fMaxViewportDim := GetMaxViewportDim;
-    gLog.AddTime('GL_MAX_VIEWPORT_DIM = ' + IntToStr(fMaxViewportDim));
 
-    glClearColor(0, 0, 0, 0); 	   //Background
-    glClearStencil(0);
-    glDepthFunc(GL_LEQUAL);
-    glShadeModel(GL_SMOOTH);                 //Enables Smooth Color Shading
-    glPolygonMode(GL_FRONT, GL_FILL);
-    glEnable(GL_NORMALIZE);
-    glEnable(GL_BLEND);
-    glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); //Set alpha mode
-    glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
-    glEnable(GL_COLOR_MATERIAL);                 //Enable Materials
-    glEnable(GL_TEXTURE_2D);                     // Enable Texture Mapping
-    glDisable(GL_LIGHTING); //We don't need it
     //glEnable(GL_CULL_FACE);
     //glCullFace(GL_FRONT);
 
 
   end;
   Resize(aScreenX, aScreenY);
-  gLog.AddTime('Init Render Done');
 end;
 
 
 destructor TKMRender.Destroy;
 begin
+  KMRenderMobileInvalidateSampledProgram;
   if not fBlind then
   begin
     if fFBOInited then
@@ -171,19 +164,9 @@ end;
 
 procedure TKMRender.SetRenderMode(aRenderMode: TKMRenderMode);
 begin
-  if fBlind then Exit;
-
-  glMatrixMode(GL_PROJECTION); //Change Matrix Mode to Projection
-  glLoadIdentity; //Reset View
-
   //In 2D mode we use Z-test to clip terrain shadows behind mountains
   //1 unit for each tile strip. 512 means we can handle up to 512x512 maps
-  case aRenderMode of
+  KMRenderMobileApplyOrdinary2DProjection(fScreenX, fScreenY);
-    rm2D: glOrtho(0, fScreenX, fScreenY, 0, -100, 100);
-    rm3D: gluPerspective(80, -fScreenX/fScreenY, 0.1, 5000);
-  end;
-  glMatrixMode(GL_MODELVIEW); //Return to the modelview matrix
-  glLoadIdentity; //Reset View
 end;
 
 
@@ -224,9 +207,15 @@ end;
 class procedure TKMRender.GraphicsContextChanged(aAvailable: Boolean);
 begin
   if aAvailable then
-    KMRenderMobileInitializeCurrentContext
+  begin
+    KMRenderMobileInitializeCurrentContext;
+    KMRenderMobileInitializeSampledProgram;
+  end
   else
+  begin
     KMRenderMobileInvalidateCurrentContext;
+    KMRenderMobileInvalidateSampledProgram;
+  end;
 end;
 
 
@@ -236,6 +225,26 @@ begin
 end;
 
 
+class function TKMRender.SampledProgramReady: Boolean;
+begin
+  Result := KMRenderMobileSampledProgramReady;
+end;
+
+
+class procedure TKMRender.DrawSampledTriangles(const aVertices: array of TKMSampledVertex; const aColor: TKMColor4f);
+begin
+  if Length(aVertices) = 0 then Exit;
+  if (Length(aVertices) mod 3) <> 0 then
+    raise Exception.Create('Sampled triangle vertex count must be divisible by three');
+
+  RenderContext.DepthFunc := dfLessEqual;
+  RenderContext.BlendingEnable(bsSrcAlpha, bdOneMinusSrcAlpha);
+  KMRenderMobileDrawSampledTriangles(@aVertices[0].X, @aVertices[0].U,
+    SizeOf(TKMSampledVertex), Length(aVertices),
+    aColor.R, aColor.G, aColor.B, aColor.A);
+end;
+
+
 class function TKMRender.GetMaxTexSize: Cardinal;
 begin
   Result := KMRenderMobileMaxTextureSize;
@@ -309,8 +318,6 @@ end;
 
 procedure TKMRender.BeginFrame;
 begin
-  if fBlind then Exit;
-
   if SAVE_MAP_TO_FBO_RENDER then
   begin
     if not fFBOInited then
@@ -320,31 +327,28 @@ begin
       glBindFramebuffer(GL_DRAW_FRAMEBUFFER, fFBO);
   end;
 
-  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT or GL_STENCIL_BUFFER_BIT);
+  KMRenderMobileClearCurrentTarget;
   SetRenderMode(rm2D);
 
+  KMRenderMobileSetActiveTextureUnit0;
+  TKMRender.InvalidateTextureBindingCache;
+  RenderContext.DepthFunc := dfLessEqual;
+  RenderContext.BlendingEnable(bsSrcAlpha, bdOneMinusSrcAlpha);
+
   //RC.Activate for OSX
 end;
 
 
 //Render highlight overlay to make whole picture look brighter (more saturated)
 procedure TKMRender.RenderBrightness(aValue: Byte);
+var
+  intensity: Single;
 begin
-  if fBlind then Exit;
-
   //There will be no change to image anyway
   if aValue = 0 then Exit;
 
-  BindTexture(0); // We have to reset texture to default (0), because it could be bind to any other texture (atlas)
+  intensity := aValue / 20;
-
+  KMRenderMobileDrawBrightnessOverlay(intensity, ScreenX, ScreenY);
-  glLoadIdentity;
-  glBlendFunc(GL_DST_COLOR, GL_ONE);
-  glColor4f(aValue/20, aValue/20, aValue/20, aValue/20);
-  glBegin(GL_QUADS);
-    glkRect(0, 0, ScreenX, ScreenY);
-  glEnd;
-
-  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 end;