diff --git a/BlackSharkCfg.inc b/BlackSharkCfg.inc index 497b513..f6c2ef1 100644 --- a/BlackSharkCfg.inc +++ b/BlackSharkCfg.inc @@ -1,16 +1,12 @@ {.$define DEBUG_BS} {$ifdef ANDROID} - {$ifdef DEBUG_BS} - {$define DBG_IO} - {$endif} + {$define DBG_IO} {$define SingleWinOnly} {$endif} {$ifdef ultibo} - {$ifdef DEBUG_BS} - {$define DBG_IO} - {$endif} + {$define DBG_IO} {$define SingleWinOnly} {$endif} diff --git a/Readme.md b/Readme.md index cd9d57e..e295d57 100644 --- a/Readme.md +++ b/Readme.md @@ -16,7 +16,6 @@ It's a young, a freely available, project that currently has a vector of develop for its compilation use this IDE: https://github.com/ultibohub/Core/releases/download/2.5.037/Ultibo-Core-2.5.037-Beetroot.exe; + on Raspberry OS it just has been run without special implementation; + high DPI support for default GUI sizes; - + now renderer doesn't draw invisible (with opacity 0) objects; + adaptive FPS was improved for the pure Black Shark application; + TBTable - some fixes; + refactoring of gl-context creation, bs.font, bs.renderer (multiple passes were fixed), bs.config (save and load implementations were added), bs.gui.chat. diff --git a/common/bs.lang.dictionary.pas b/common/bs.lang.dictionary.pas index bf5d486..94fbdf5 100644 --- a/common/bs.lang.dictionary.pas +++ b/common/bs.lang.dictionary.pas @@ -33,6 +33,7 @@ function GetSentence(const NameSentence: string): string; // you can add own dictionaries by AddToExisting = true function LoadLang(const NameDictionary: string; AddToExisting: boolean = true): boolean; +function IsDictionaryEmpty: boolean; implementation @@ -41,11 +42,20 @@ implementation , bs.collections , bs.utils , bs.strings + {$ifdef DEBUG_BS} + , SysUtils + , bs.log + {$endif} ; var g_DictSpell: THashTable; +function IsDictionaryEmpty: boolean; +begin + Result := g_DictSpell.Count = 0; +end; + function GetSentence(const NameSentence: string): string; begin if not g_DictSpell.Find(NameSentence, Result) then @@ -64,11 +74,24 @@ function LoadLang(const NameDictionary: string; AddToExisting: boolean = true): if not AddToExisting then g_DictSpell.Clear; path := GetFilePath(NameDictionary, 'Lang'); + {$ifdef DEBUG_BS} + bs.log.BSWriteMsg('LoadLang', path); + {$endif} xml := TheXmlWriter.Create(path, true); try node := xml.FindNode('Sentences', true); if not Assigned(node) then + begin + {$ifdef DEBUG_BS} + bs.log.BSWriteMsg('LoadLang.Sentences', 'not found!'); + {$endif} exit(false); + end; + + {$ifdef DEBUG_BS} + bs.log.BSWriteMsg('LoadLang.Sentences.Count', IntToStr(node.CountChilds)); + {$endif} + for i := 0 to node.CountChilds - 1 do begin ch := node.Childs[i]; diff --git a/core/bs.animation.pas b/core/bs.animation.pas index d8487dd..2f83e03 100644 --- a/core/bs.animation.pas +++ b/core/bs.animation.pas @@ -59,6 +59,7 @@ interface { create a simple observer and connect its to the event } function CreateObserver(ThreadCntx: TBThread; OnRsvProc: TGenericRecieveProc): IBObserver; overload; function CreateObserver(OnRsvProc: TGenericRecieveProc): IBObserver; overload; + function GetCurrentNormalizedTime: BSFloat; property Duration: int32 read GetDuration write SetDuration; property Loop: boolean read GetLoop write SetLoop; @@ -69,6 +70,7 @@ interface property CurrentValue: T read GetCurrentValue; { any user pointer } property CurrentSender: Pointer read GetCurrentSender write SetCurrentSender; + property CurrentNormalizedTime: BSFloat read GetCurrentNormalizedTime; end; { TAniValueLawBase @@ -91,6 +93,7 @@ TAniValueLawBase = class abstract (TTemplateBTask, IBAnimation) TimeStart: uint64; LastTime: uint64; CurrentDeltaTime: int32; + FCurrentNormalizedTime: BSFloat; { if TAniValueLawBase.Loop even false this method call automaticaly from thread context TBlackSharkAnimator } FDelta: T; @@ -116,12 +119,14 @@ TAniValueLawBase = class abstract (TTemplateBTask, IBAnimation) function GetCurrentValue: T; function GetCurrentSender: Pointer; procedure SetCurrentSender(Value: Pointer); + procedure Update; override; public constructor Create(ThreadContext: TBThread); { Run calculate value in depend on time } procedure Run; override; procedure Stop; override; + function GetCurrentNormalizedTime: BSFloat; end; IBAnimationLinearFloat = IBAnimation; @@ -138,6 +143,21 @@ TAniValueLawBase = class abstract (TTemplateBTask, IBAnimation) IBAnimationElipseObsrv = IBObserver; + IBAnimationPath3d = interface(IBAnimation) + procedure AddPoint(const AValue: TVec3f); + function GetInterpolateSpline: TInterpolateSpline; + procedure SetInterpolateSpline(AValue: TInterpolateSpline); + function GetInterpolateFactor: BSFloat; + procedure SetInterpolateFactor(AValue: BSFloat); + function GetOrigins: TListVec; + function GetPointsInterpolated: TListVec; + property InterpolateSpline: TInterpolateSpline read GetInterpolateSpline write SetInterpolateSpline; + property InterpolateFactor: BSFloat read GetInterpolateFactor write SetInterpolateFactor; + property Origins: TListVec read GetOrigins; + property PointsInterpolated: TListVec read GetPointsInterpolated; + end; + IBAnimationPath3dObsrv = IBObserver; + function CreateAniFloatLinear(ThreadContext: TBThread): IBAnimationLinearFloat; overload; function CreateAniFloatLinear: IBAnimationLinearFloat; overload; function CreateAniFloatLivearObsrv(const Animation: IBAnimationLinearFloat; @@ -146,14 +166,16 @@ TAniValueLawBase = class abstract (TTemplateBTask, IBAnimation) function CreateAniElipse(ThreadContext: TBThread): IBAnimationElipse; + function CreateAniPath3d(ThreadContext: TBThread): IBAnimationPath3d; overload; + function CreateAniPath3d: IBAnimationPath3d; overload; + implementation uses - {$ifndef FPC} - math, - {$endif} - bs.math + math + , bs.mesh.primitives + , bs.math ; type @@ -253,6 +275,55 @@ TAniValueLawsVec3f = class(TAniValueLawBase) procedure Run; override; end; + { TAniPath3d } + + TAniPath3d = class(TAniValueLawBase, IBAnimationPath3d) + private type + TVec3fItemQ = TItemQueue; + TVec3fDataQ = TQueueTemplate; + TIntrpFunc = procedure of object; + private + FuncIntrp: array [TInterpolateSpline] of TIntrpFunc; + FOrigins: TListVec; + FPointsInterpolated: TListVec; + FInterpolateSpline: TInterpolateSpline; + FInterpolateFactor: BSFloat; + FIsBackPass: boolean; + FCurrentIndexValue: int32; + FCurrentDelta: TVec3f; + FCurrentSnippetTimeStart: uint32; + FCurrentPoint: TVec3f; + FDurationSnippet: uint32; + procedure SplineInterpolateBezier; + procedure SplineInterpolateNone; + procedure SplineInterpolateCubic; + // https://en.wikipedia.org/wiki/Cubic_Hermite_spline#Cardinal_spline + procedure SplineInterpolateCubicHermite; + procedure BuildPath; + protected + procedure Reverse; override; + procedure Update; override; + class function GetQueueClass: TQueueWrapperClass; override; + public + procedure AfterConstruction; override; + destructor Destroy; override; + procedure Run; override; + procedure AddPoint(const AValue: TVec3f); + procedure Clear; + + function GetInterpolateSpline: TInterpolateSpline; + procedure SetInterpolateSpline(AValue: TInterpolateSpline); + function GetInterpolateFactor: BSFloat; + procedure SetInterpolateFactor(AValue: BSFloat); + function GetOrigins: TListVec; + function GetPointsInterpolated: TListVec; + + property InterpolateSpline: TInterpolateSpline read GetInterpolateSpline write SetInterpolateSpline; + property InterpolateFactor: BSFloat read GetInterpolateFactor write SetInterpolateFactor; + property Origins: TListVec read GetOrigins; + property PointsInterpolated: TListVec read GetPointsInterpolated; + end; + {$region 'TAniValueLawBase'} @@ -323,11 +394,24 @@ procedure TAniValueLawBase.Stop; inherited; end; +function TAniValueLawBase.GetCurrentNormalizedTime: BSFloat; +begin + Result := FCurrentNormalizedTime; +end; + procedure TAniValueLawBase.SetCurrentSender(Value: Pointer); begin FCurrentSender := Value; end; +procedure TAniValueLawBase.Update; +begin + CurrentDeltaTime := TBTimer.CurrentTime.Counter - TimeStart; + FCurrentNormalizedTime := CurrentDeltaTime / FDuration; + if FCurrentNormalizedTime > 1.0 then + FCurrentNormalizedTime := 1.0; +end; + procedure TAniValueLawBase.SetDuration(Value: int32); begin FDuration := Value; @@ -368,14 +452,18 @@ procedure TAniValueLawBase.Reverse; end; procedure TAniValueLawBase.SendEvent(const Value: T); +var + t: uint64; begin - if (not IsRun) or (FIntervalUpdate > TBTimer.CurrentTime.Counter - LastTime) then - exit; - LastTime := TBTimer.CurrentTime.Counter; + t := TBTimer.CurrentTime.Counter; + if (not IsRun) or (FIntervalUpdate > t - LastTime) then + exit; + LastTime := t; { Send new event-value all subscribers } if (CurrentDeltaTime > FDuration) then begin // end animation FCurrentValue := FStopValue; + FCurrentNormalizedTime := 1.0; inherited; if (FLoop) then begin @@ -403,16 +491,11 @@ procedure TAniValueLawBase.SendEvent(const Value: T); { TAniValueLawFloat } procedure TAniValueLawFloat.Update; -var - norm_time: BSFloat; begin if not IsRun then exit; - CurrentDeltaTime := TBTimer.CurrentTime.Counter - TimeStart; - norm_time := CurrentDeltaTime / FDuration; - if norm_time > 1.0 then - norm_time := 1.0; - SendEvent(FStartValue + norm_time * FDelta); + inherited; + SendEvent(FStartValue + FCurrentNormalizedTime * FDelta); end; class function TAniValueLawFloat.GetQueueClass: TQueueWrapperClass; @@ -440,16 +523,11 @@ procedure TAniValueLawFloat.Run; { TAniValueLawsInt32 } procedure TAniValueLawsInt32.Update; -var - norm_time: BSFloat; begin if not IsRun then exit; - CurrentDeltaTime := TBTimer.CurrentTime.Counter - TimeStart; - norm_time := CurrentDeltaTime / FDuration; - if norm_time > 1.0 then - norm_time := 1.0; - SendEvent(FStartValue + Round(FDelta * norm_time)); + inherited; + SendEvent(FStartValue + Round(FDelta * FCurrentNormalizedTime)); end; class function TAniValueLawsInt32.GetQueueClass: TQueueWrapperClass; @@ -475,16 +553,11 @@ procedure TAniValueLawsInt32.Run; { TAniValueLawsVec2f } procedure TAniValueLawsVec2f.Update; -var - norm_time: BSFloat; begin if not IsRun then exit; - CurrentDeltaTime := TBTimer.CurrentTime.Counter - TimeStart; - norm_time := CurrentDeltaTime / FDuration; - if norm_time > 1.0 then - norm_time := 1.0; - SendEvent(FStartValue + FDelta * norm_time); + inherited; + SendEvent(FStartValue + FDelta * FCurrentNormalizedTime); end; class function TAniValueLawsVec2f.GetQueueClass: TQueueWrapperClass; @@ -511,14 +584,11 @@ procedure TAniValueLawsVec2f.Run; { TAniValueLawsVec3f } procedure TAniValueLawsVec3f.Update; -var - norm_time: BSFloat; begin if not IsRun then exit; - CurrentDeltaTime := TBTimer.CurrentTime.Counter - TimeStart; - norm_time := CurrentDeltaTime / FDuration; - SendEvent(FStartValue + FDelta * norm_time); + inherited; + SendEvent(FStartValue + FDelta * FCurrentNormalizedTime); end; class function TAniValueLawsVec3f.GetQueueClass: TQueueWrapperClass; @@ -544,16 +614,12 @@ procedure TAniValueLawsVec3f.Run; procedure TAniValueLawElipse.Update; var - norm_time: BSFloat; v: TVec2f; begin if not IsRun then exit; - CurrentDeltaTime := TBTimer.CurrentTime.Counter - TimeStart; - norm_time := CurrentDeltaTime / FDuration; - if norm_time > 1.0 then - norm_time := 1.0; - FAngle := norm_time * 360.0; + inherited; + FAngle := FCurrentNormalizedTime * 360.0; v.x := Fa * BS_Cos(FAngle); v.y := Fb * BS_Sin(FAngle); SendEvent(v); @@ -616,5 +682,196 @@ function CreateAniElipse(ThreadContext: TBThread): IBAnimationElipse; Result := TAniValueLawElipse.Create(ThreadContext); end; +{ TAniPath3d } + +procedure TAniPath3d.AddPoint(const AValue: TVec3f); +begin + FOrigins.Add(AValue); +end; + +procedure TAniPath3d.AfterConstruction; +begin + inherited; + FOrigins := TListVec.Create; + FInterpolateSpline := isCubicHermite; + FInterpolateFactor := 0.02; + FuncIntrp[isNone ] := SplineInterpolateNone; + FuncIntrp[isBezier ] := SplineInterpolateBezier; + FuncIntrp[isCubic ] := SplineInterpolateCubic; + FuncIntrp[isCubicHermite] := SplineInterpolateCubicHermite; + FPointsInterpolated := TListVec.Create; +end; + +procedure TAniPath3d.BuildPath; +begin + FPointsInterpolated.Clear; + if (FOrigins.Count > 1) then + FuncIntrp[FInterpolateSpline](); +end; + +procedure TAniPath3d.Clear; +begin + FOrigins.Clear; +end; + +destructor TAniPath3d.Destroy; +begin + FOrigins.Free; + FPointsInterpolated.Free; + inherited; +end; + +function TAniPath3d.GetInterpolateFactor: BSFloat; +begin + Result := FInterpolateFactor; +end; + +function TAniPath3d.GetInterpolateSpline: TInterpolateSpline; +begin + Result := FInterpolateSpline; +end; + +class function TAniPath3d.GetQueueClass: TQueueWrapperClass; +begin + Result := TVec3fDataQ; +end; + +procedure TAniPath3d.Reverse; +begin + inherited; + FIsBackPass := not FIsBackPass; +end; + +procedure TAniPath3d.Run; +begin + BuildPath; + if FPointsInterpolated.Count = 0 then + exit; + + if GetLoopInverse then + begin + FCurrentIndexValue := FPointsInterpolated.Count-1; + FCurrentPoint := FOrigins.Items[FCurrentIndexValue]; + FCurrentDelta := FPointsInterpolated.Items[FPointsInterpolated.Count-2] - FCurrentPoint; + end else + begin + FCurrentIndexValue := 0; + FCurrentPoint := FOrigins.Items[FCurrentIndexValue]; + FCurrentDelta := FPointsInterpolated.Items[1] - FCurrentPoint; + end; + + FDurationSnippet := round(GetDuration/FPointsInterpolated.Count); + FCurrentSnippetTimeStart := TBTimer.CurrentTime.Counter; + inherited; +end; + +procedure TAniPath3d.SetInterpolateFactor(AValue: BSFloat); +begin + FInterpolateFactor := clamp(1.0, 0.0001, AValue); +end; + +function TAniPath3d.GetOrigins: TListVec; +begin + Result := FOrigins; +end; + +function TAniPath3d.GetPointsInterpolated: TListVec; +begin + Result := FPointsInterpolated; +end; + +procedure TAniPath3d.SetInterpolateSpline(AValue: TInterpolateSpline); +begin + FInterpolateSpline := AValue; +end; + +procedure TAniPath3d.SplineInterpolateBezier; +begin + GenerateBezierSpline(PArrayVec3f(FOrigins.ShiftData[0]), FOrigins.Count, FPointsInterpolated, FInterpolateFactor); +end; + +procedure TAniPath3d.SplineInterpolateCubic; +begin + { GenerateCubicSpline is wrong for 3d, therefor uses GenerateCubicHermiteSpline instead } + //GenerateCubicSpline(PArrayVec3f(FOrigins.ShiftData[0]), FOrigins.Count, FPointsInterpolated, FInterpolateFactor); + GenerateCubicHermiteSpline(PArrayVec3f(FOrigins.ShiftData[0]), FOrigins.Count, FPointsInterpolated, FInterpolateFactor, false); +end; + +procedure TAniPath3d.SplineInterpolateCubicHermite; +begin + GenerateCubicHermiteSpline(PArrayVec3f(FOrigins.ShiftData[0]), FOrigins.Count, FPointsInterpolated, FInterpolateFactor, false); +end; + +procedure TAniPath3d.SplineInterpolateNone; +begin + FPointsInterpolated.Add(FOrigins.ShiftData[0], FOrigins.Count); +end; + +procedure TAniPath3d.Update; +var + v: TVec3f; + currentSnippetDeltaTime: uint32; + norm_time: BSFloat; + currTime: uint32; + newIndex: int32; +begin + if not IsRun then + exit; + inherited; + currTime := TBTimer.CurrentTime.Counter; + + newIndex := trunc(FCurrentNormalizedTime*(FPointsInterpolated.Count-1)); + if FIsBackPass then + newIndex := FPointsInterpolated.Count - 1 - newIndex; + + //if newIndex >= 10 then + // newIndex := newIndex; + + if newIndex <> FCurrentIndexValue then + begin + FCurrentIndexValue := newIndex; + if FIsBackPass then + begin + if FCurrentIndexValue < 2 then + begin + CurrentDeltaTime := GetDuration+1; + SendEvent(FPointsInterpolated.Items[0]); + exit; + end; + FCurrentPoint := FPointsInterpolated.Items[FCurrentIndexValue]; + FCurrentDelta := FPointsInterpolated.Items[FCurrentIndexValue-1]-FCurrentPoint; + end else + begin + if FCurrentIndexValue > FPointsInterpolated.Count - 2 then + begin + CurrentDeltaTime := GetDuration+1; + SendEvent(FPointsInterpolated.Items[FPointsInterpolated.Count-1]); + exit; + end; + FCurrentPoint := FPointsInterpolated.Items[FCurrentIndexValue]; + FCurrentDelta := FPointsInterpolated.Items[FCurrentIndexValue+1]-FCurrentPoint; + end; + FCurrentSnippetTimeStart := currTime; + end; + + currentSnippetDeltaTime := currTime - FCurrentSnippetTimeStart; + norm_time := currentSnippetDeltaTime / FDurationSnippet; + if norm_time > 1.0 then + norm_time := 1.0; + v := FCurrentPoint + FCurrentDelta * norm_time; + SendEvent(v); + +end; + +function CreateAniPath3d(ThreadContext: TBThread): IBAnimationPath3d; +begin + Result := TAniPath3d.Create(ThreadContext); +end; + +function CreateAniPath3d: IBAnimationPath3d; +begin + Result := TAniPath3d.Create(GUIThread); +end; + end. diff --git a/core/bs.basetypes.pas b/core/bs.basetypes.pas index a1cf9c8..aff200e 100644 --- a/core/bs.basetypes.pas +++ b/core/bs.basetypes.pas @@ -488,6 +488,7 @@ TRay3d = record end; TColor4f = record + class operator Add (const AValue: TColor4f; const k: BSFloat): TColor4f; inline; class operator Implicit (const AValue: TVec4f): TColor4f; inline; class operator Implicit (const AValue: TColor4f): TVec4f; inline; class operator Explicit (const AValue: int32): TColor4f; inline; @@ -5234,6 +5235,14 @@ class function TOperatorsDateTime.ToStringInt(const Value: TDateTime): string; Result.a := AValue.w; end; +class operator TColor4f.Add(const AValue: TColor4f; const k: BSFloat): TColor4f; +begin + Result.r := AValue.r + k; + Result.g := AValue.g + k; + Result.b := AValue.b + k; + Result.w := AValue.w + k; +end; + class operator TColor4f.Equal(const v1, v2: TColor4f): boolean; begin Result := (v1.x = v2.x) and (v1.y = v2.y) and (v1.z = v2.z) and (v1.w = v2.w); diff --git a/core/bs.events.pas b/core/bs.events.pas index ca34f39..af3558b 100644 --- a/core/bs.events.pas +++ b/core/bs.events.pas @@ -268,6 +268,7 @@ TAwaitTask = record end; private class var FCountTasks: int32; + class var FLastTimeRemoveTask: int64; private FTasks: TListTasks; FAwaitTasks: TListAwaitTasks; @@ -294,7 +295,8 @@ TAwaitTask = record class procedure RemoveTask(var TaskPos: PRecTask; Context: TBThread); public property ThreadContext: TBThread read FThreadContext; - class property CountTasks: Int32 read FCountTasks; + class property CountTasks: int32 read FCountTasks; + class property LastTimeRemoveTask: int64 read FLastTimeRemoveTask; end; { the task also as IBEvent for work result return demands observers } @@ -1076,6 +1078,7 @@ class procedure TTaskExecutor.RemoveTask(var TaskPos: PRecTask; Context: TBThrea finally CS.Leave; end; + FLastTimeRemoveTask := TBTimer.CurrentTime.Counter; end; { TEmptyTask } @@ -1086,10 +1089,13 @@ class function TEmptyTask.GetQueueClass: TQueueWrapperClass; end; procedure TEmptyTask.Update; +var + t: uint64; begin - if (not IsRun) or (FIntervalUpdate > TBTimer.CurrentTime.Counter - LastTime) then - exit; - LastTime := TBTimer.CurrentTime.Counter; + t := TBTimer.CurrentTime.Counter; + if (not IsRun) or (FIntervalUpdate > t - LastTime) then + exit; + LastTime := t; SendEvent(0); end; diff --git a/core/bs.mesh.primitives.pas b/core/bs.mesh.primitives.pas index 4ae2d42..5d2d776 100644 --- a/core/bs.mesh.primitives.pas +++ b/core/bs.mesh.primitives.pas @@ -948,8 +948,7 @@ procedure GenerateCubicHermiteSpline(InBaseVertexes: PArrayVec3f; CountBaseVerte tmp_values: TListVec; ptr: PVec3f; i: int32; - x, y: bsfloat; // our x,y coords - t1x, t2x, t1y, t2y: bsfloat; // tension vectors + t1, t2: TVec3f; // tension vectors c1, c2, c3, c4: bsfloat; // cardinal points st, st2, st3: bsfloat; // steps based on num. of segments begin @@ -990,11 +989,8 @@ procedure GenerateCubicHermiteSpline(InBaseVertexes: PArrayVec3f; CountBaseVerte while st < 1 do begin // calc tension vectors - t1x := (tmp_values.Items[i+1].x - tmp_values.Items[i-1].x) * tension; - t2x := (tmp_values.Items[i+2].x - tmp_values.Items[i].x) * tension; - - t1y := (tmp_values.Items[i+1].y - tmp_values.Items[i-1].y) * tension; - t2y := (tmp_values.Items[i+2].y - tmp_values.Items[i].y) * tension; + t1 := (tmp_values.Items[i+1] - tmp_values.Items[i-1]) * tension; + t2 := (tmp_values.Items[i+2] - tmp_values.Items[i]) * tension; st2 := st * st; st3 := st2 * st; @@ -1008,12 +1004,8 @@ procedure GenerateCubicHermiteSpline(InBaseVertexes: PArrayVec3f; CountBaseVerte if st > 1.0 then st := 1.0; - // calc x and y cords with common control vectors - x := c1 * tmp_values.Items[i].x + c2 * tmp_values.Items[i+1].x + c3 * t1x + c4 * t2x; - y := c1 * tmp_values.Items[i].y + c2 * tmp_values.Items[i+1].y + c3 * t1y + c4 * t2y; - - //store points in array - OutSplineVertexes.Add(vec3(x, y, 0.0)); + // calc x and y cords with common control vectors and store points in array + OutSplineVertexes.Add(tmp_values.Items[i]*c1 + tmp_values.Items[i+1]*c2 + t1*c3 + t2*c4); end; end; tmp_values.Free; diff --git a/core/bs.renderer.pas b/core/bs.renderer.pas index c8c8e6c..7ff1ff5 100644 --- a/core/bs.renderer.pas +++ b/core/bs.renderer.pas @@ -2284,10 +2284,13 @@ procedure TBlackSharkRenderer.DrawInstance(Instance: PRendererGraphicInstance); if not Assigned(Instance^._VisibleNode) then Instance^._VisibleNode := FVisibleGI.PushToEnd(Instance); - { doesn't draw a transparent object } - if (Instance.Instance.Owner.Opacity = 0) then + if Instance.Instance.Owner.BanDraw then exit; + { doesn't draw a transparent object } + //if (Instance.Instance.Owner.Opacity = 0) then + // exit; + BSShaderManager.UseShader(Instance.Instance.Owner.Shader); if LastDrawGI <> Instance.Instance.Owner then begin diff --git a/core/bs.scene.pas b/core/bs.scene.pas index c428a22..541503b 100644 --- a/core/bs.scene.pas +++ b/core/bs.scene.pas @@ -1,4 +1,4 @@ -{ +{ -- Begin License block -- Copyright (C) 2019-2022 Pavlov V.V. (PVV) @@ -204,6 +204,7 @@ TGraphicObject = class {.$ifdef DEBUG_BS} FCaption: string; {.$endif} + FBanDraw: boolean; function GetAbsolutePosition: TVec3f; procedure GenerateProdStackMatrix(Instance: PGraphicInstance);{$ifndef DEBUG_BS} inline; {$endif} procedure GenerateModelMatrixFromAllTransformations(Instance: PGraphicInstance; ASendEvent: boolean); {$ifndef DEBUG_BS} inline; {$endif} @@ -430,6 +431,8 @@ TGraphicObject = class property SelectResolve: boolean read GetSelectResolve write SetSelectResolve; { is the object now dragging ? } property IsDrag: boolean read GetIsDrag write SetIsDrag; + { bans to draw the object } + property BanDraw: boolean read FBanDraw write FBanDraw; { a drawn mesh (shape) } property Mesh: TMesh read FMesh write SetMesh; { it determines whether participate all the object instances in space tree of the scene; diff --git a/core/bs.shader.pas b/core/bs.shader.pas index 6a32a9f..da25441 100644 --- a/core/bs.shader.pas +++ b/core/bs.shader.pas @@ -1,4 +1,4 @@ -{ +{ -- Begin License block -- Copyright (C) 2019-2022 Pavlov V.V. (PVV) diff --git a/core/bs.texture.pas b/core/bs.texture.pas index 9db2ca0..23f609c 100644 --- a/core/bs.texture.pas +++ b/core/bs.texture.pas @@ -1,4 +1,4 @@ -{ +{ -- Begin License block -- Copyright (C) 2019-2022 Pavlov V.V. (PVV) diff --git a/core/bs.window.android.pas b/core/bs.window.android.pas index 2752c5d..3ded101 100644 --- a/core/bs.window.android.pas +++ b/core/bs.window.android.pas @@ -124,6 +124,7 @@ implementation , bs.thread , bs.config , bs.events.keyboard + , bs.lang.dictionary {$ifndef FPC} , FMX.Platform.Android //, fmx.Platform.Android @@ -325,6 +326,9 @@ function bsNativeInit(PEnv: PJNIEnv; this: JObject; AAppDir, AFilesDir: jstring) SetApplicationPath(IncludeTrailingPathDelimiter(s)); BSConfig.Load; + if IsDictionaryEmpty then + LoadLang('lang.en'); + Result := BSConfig.GetProperty('ScreenOrientation', SCREEN_ORIENTATION_PORTRAIT); end; diff --git a/core/bs.window.pas b/core/bs.window.pas index c7524ff..ebdd403 100644 --- a/core/bs.window.pas +++ b/core/bs.window.pas @@ -584,7 +584,7 @@ procedure TBlackSharkApplication.ProcessMessages; t, delta: uint32; begin t := TBTimer.CurrentTime.Low; - if (BSConfig.MaxFps or (TTaskExecutor.CountTasks > 0)) and (t - TTimeProcessEvent.TimeProcessEvent.Counter < TIMEOUT_MAX_FPS) then + if (BSConfig.MaxFps or (TTaskExecutor.CountTasks > 0)) or (t - TTaskExecutor.LastTimeRemoveTask < TIMEOUT_MAX_FPS) then FApplicationSystem.Update else FApplicationSystem.UpdateWait; diff --git a/gui/bs.gui.base.pas b/gui/bs.gui.base.pas index 9cffc90..b1a31da 100644 --- a/gui/bs.gui.base.pas +++ b/gui/bs.gui.base.pas @@ -1,4 +1,4 @@ -{ +{ -- Begin License block -- Copyright (C) 2019-2022 Pavlov V.V. (PVV) diff --git a/gui/bs.gui.colorbox.pas b/gui/bs.gui.colorbox.pas index 9ed54bb..9a6720a 100644 --- a/gui/bs.gui.colorbox.pas +++ b/gui/bs.gui.colorbox.pas @@ -1,4 +1,4 @@ -{ +{ -- Begin License block -- Copyright (C) 2019-2022 Pavlov V.V. (PVV) @@ -67,6 +67,7 @@ TBCustomColorBox = class(TBCustomComboBox) procedure AfterConstruction; override; destructor Destroy; override; procedure BuildView; override; + function DefaultSize: TVec2f; override; procedure Resize(AWidth, AHeight: BSFloat); override; property SelectedColor: TGuiColor read FSelectedColor write SetSelectedColor; end; @@ -164,9 +165,15 @@ TColorValueName = record procedure TBCustomColorBox.BuildView; begin inherited; - ColorRect.Size := vec2(Height - 4, Height - 4); + ColorRect.Size := vec2(Height - 4*ToHiDpiScale, Height - 4*ToHiDpiScale); ColorRect.Build; - ColorRect.Position2d := vec2(2.0, 2.0); + ColorRect.Position2d := vec2(2.0*ToHiDpiScale, 2.0*ToHiDpiScale); +end; + +function TBCustomColorBox.DefaultSize: TVec2f; +begin + Result := inherited; + Result:= vec2(Result.x + Result.Height + 30*ToHiDpiScale, Result.y) end; destructor TBCustomColorBox.Destroy; diff --git a/gui/bs.gui.column.presentor.pas b/gui/bs.gui.column.presentor.pas index cc2d60b..aea8c2c 100644 --- a/gui/bs.gui.column.presentor.pas +++ b/gui/bs.gui.column.presentor.pas @@ -1235,6 +1235,7 @@ constructor IColumnCellPresentor.Create(AParentObject: TCanvasObject; AColumn: I FBody.Fill := true; FBody.Data.DragResolve := false; FBody.Data.SelectResolve := false; + FBody.Data.BanDraw := true; FBody.Data.Opacity := 0.0; // set over grid FBody.Layer2d := 2; @@ -1288,6 +1289,7 @@ procedure IColumnCellPresentor.MouseEnter(const AData: BMouseData); //ChangeAniStopValues(false); AnimationEnter.Run; + FBody.Data.BanDraw := false; if Assigned(FOnMouseEnter) then FOnMouseEnter(Self, AData); end; @@ -1304,6 +1306,7 @@ procedure IColumnCellPresentor.MouseLeave(const AData: BMouseData); AnimationEnter.StartValue := FBody.Data.Opacity; AnimationEnter.StopValue := int32(CellState)*0.2; AnimationEnter.Run; + FBody.Data.BanDraw := true; if Assigned(FOnMouseLeave) then FOnMouseLeave(Self, AData); end; diff --git a/gui/bs.gui.combobox.pas b/gui/bs.gui.combobox.pas index 123fc39..7d5f67c 100644 --- a/gui/bs.gui.combobox.pas +++ b/gui/bs.gui.combobox.pas @@ -1,4 +1,4 @@ -{ +{ -- Begin License block -- Copyright (C) 2019-2022 Pavlov V.V. (PVV) @@ -107,6 +107,7 @@ TBCustomComboBox = class(TBCustomEdit) public constructor Create(ACanvas: TBCanvas); override; destructor Destroy; override; + function DefaultSize: TVec2f; override; procedure BuildView; override; procedure Resize(AWidth, AHeight: BSFloat); override; procedure Clear; virtual; @@ -215,7 +216,10 @@ function TBCustomComboBox.CreateColumn(Index: int32): IColumnPresentor; begin method := GetItemData; Result := FGrid.CreateColumn(TMethod(method), TBColumnPresentorString, ''); - Result.Width := FGrid.Width; + if FGrid.ShowBorder then + Result.Width := FGrid.Width - 2*FGrid.Border.WidthLine + else + Result.Width := FGrid.Width; TBColumnPresentorString(Result).ColorText := ColorText; end; @@ -223,6 +227,7 @@ procedure TBCustomComboBox.CreateGrid; var i: int32; w: BSFloat; + c: TColor4f; begin if Assigned(FGrid) or (RowsCount = 0) then exit; @@ -260,16 +265,20 @@ procedure TBCustomComboBox.CreateGrid; if w > FListHeight then w := FListHeight; - FGrid.Resize(Width-FGrid.Border.WidthLine*2, w); - //w := FGrid.Width / CountColumns; + FGrid.Resize(Width, w); for i := 0 to CountColumns - 1 do CreateColumn(i); FGrid.Position2d := vec2(0.0, 0.0); FGrid.OnCellMouseDown := OnCellMouseDown; FGrid.Color := Color; + + c := TColor4f(Color) + 0.4; + c.a := 1.0; + FGrid.ScrollBarVert.Color := ColorFloatToByte(c).value; + FGrid.ScrollBarHor.Color := FGrid.ScrollBarVert.Color; FGrid.Count := RowsCount; - Curtain.Size := vec2(FGrid.Width+FGrid.Border.WidthLine*2, FGrid.Height+FGrid.Border.WidthLine*2); + Curtain.Size := vec2(FGrid.Width, FGrid.Height); Curtain.Build; Curtain.Position2d := vec2(0.0, Height); FGrid.Position2d := vec2(0.0, -FGrid.Height); @@ -286,6 +295,12 @@ procedure TBCustomComboBox.CreateGrid; FGrid.Focused := true; end; +function TBCustomComboBox.DefaultSize: TVec2f; +begin + Result := inherited DefaultSize; + Result.x := Result.x + Result.Height; +end; + destructor TBCustomComboBox.Destroy; var i: int32; diff --git a/gui/bs.gui.edit.pas b/gui/bs.gui.edit.pas index 32df28e..d5c7cf6 100644 --- a/gui/bs.gui.edit.pas +++ b/gui/bs.gui.edit.pas @@ -1,4 +1,4 @@ -{ +{ -- Begin License block -- Copyright (C) 2019-2022 Pavlov V.V. (PVV) diff --git a/gui/bs.gui.forms.pas b/gui/bs.gui.forms.pas index 44cb12d..63ec43c 100644 --- a/gui/bs.gui.forms.pas +++ b/gui/bs.gui.forms.pas @@ -1,4 +1,4 @@ -{ +{ -- Begin License block -- Copyright (C) 2019-2022 Pavlov V.V. (PVV) @@ -398,7 +398,7 @@ constructor TBScrolledWindowCustom.Create(ACanvas: TBCanvas); FScrollBarHor.MainBody.Data.DragResolve := false; // be careful, because if TBScrolledWindowCustom will have parent with high Layer2d // then ScrollBar can be hided or one of its parts - FScrollBarHor.MainBody.Layer2d := Round(TBlackSharkFrustum.MAX_COUNT_LAYERS - 5); + FScrollBarHor.MainBody.Layer2d := Round(TBlackSharkFrustum.MAX_COUNT_LAYERS - 20); FScrollBarHor.OnChangePosition := ChangeScrollHor; FScrollBarHor.MainBody.Parent := FClipObject; @@ -474,9 +474,9 @@ procedure TBScrolledWindowCustom.BuildView; CheckSizeScrollBars; if Assigned(Border) then begin - FBorder.Size := vec2(FClipObject.Width, FClipObject.Height) + FBorder.WidthLine*2; + FBorder.Size := vec2(FClipObject.Width, FClipObject.Height); FBorder.Build; - FBorder.Position2d := vec2(-round(FBorder.WidthLine), -round(FBorder.WidthLine)); + FBorder.Position2d := vec2(0.0, 0.0); end; if not FAllowDragWindowOverData then @@ -651,12 +651,10 @@ procedure TBScrolledWindowCustom.DoAfterScale; inherited DoAfterScale; if Assigned(Border) then begin - Border.Size := vec2(FClipObject.Width+FBorder.WidthLine*2, FClipObject.Height+FBorder.WidthLine*2); + Border.Size := vec2(FClipObject.Width, FClipObject.Height); Border.Build; - FBorder.Position2d := vec2(-round(FBorder.WidthLine*0.5), -round(FBorder.WidthLine*0.5)); + FBorder.Position2d := vec2(0.0, 0.0); end; - //FScrollBarHor.DoScaling; - //FScrollBarVert.DoScaling; CheckSizeScrollBars; if Assigned(FSpaceTree) then begin @@ -747,14 +745,11 @@ procedure TBScrolledWindowCustom.BorderCreate; if Border = nil then begin FBorder := TRectangle.Create(FCanvas, FClipObject); - FBorder.Position2d := vec2(-1.0, -1.0); FBorder.Color := BS_CL_MED_GRAY; FBorder.Data.Interactive := false; FBorder.WidthLine := round(1.0*ToHiDpiScale); - //FBorder.FixedWidthLine := true; FBorder.BanScalableMode := true; FBorder.Layer2d := FScrollBarHor.MainBody.Layer2d + 1; - //FBorder.Align := TObjectAlign.oaClient; end; end; @@ -877,8 +872,16 @@ procedure TBScrolledWindowCustom.CheckSizeScrollBars; work_area_height: BSFloat; work_area_width: BSFloat; begin - work_area_height := FClipObject.Height - FScrollBarsPaddingTop - FScrollBarsPaddingBottom; - work_area_width := FClipObject.Width - FScrollBarsPaddingLeft - FScrollBarsPaddingRight; + if ShowBorder then + begin + work_area_height := FClipObject.Height - FScrollBarsPaddingTop - FScrollBarsPaddingBottom - FBorder.WidthLine*2; + work_area_width := FClipObject.Width - FScrollBarsPaddingLeft - FScrollBarsPaddingRight - FBorder.WidthLine*2; + end else + begin + work_area_height := FClipObject.Height - FScrollBarsPaddingTop - FScrollBarsPaddingBottom; + work_area_width := FClipObject.Width - FScrollBarsPaddingLeft - FScrollBarsPaddingRight; + end; + if Canvas.Scalable then begin hh := WidthScrollBars; @@ -922,8 +925,15 @@ procedure TBScrolledWindowCustom.CheckSizeScrollBars; end; end; - FScrollBarVert.Position2d := vec2(FClipObject.Width - FScrollBarVert.Width - FScrollBarsPaddingRight, FScrollBarsPaddingTop); - FScrollBarHor.Position2d := vec2(FScrollBarsPaddingLeft, FClipObject.Height - FScrollBarsPaddingBottom - FScrollBarHor.Height); + if ShowBorder then + begin + FScrollBarVert.Position2d := vec2(FClipObject.Width - FScrollBarVert.Width - FScrollBarsPaddingRight - FBorder.WidthLine, FScrollBarsPaddingTop + FBorder.WidthLine); + FScrollBarHor.Position2d := vec2(FScrollBarsPaddingLeft + FBorder.WidthLine, FClipObject.Height - FScrollBarsPaddingBottom - FScrollBarHor.Height - FBorder.WidthLine); + end else + begin + FScrollBarVert.Position2d := vec2(FClipObject.Width - FScrollBarVert.Width - FScrollBarsPaddingRight, FScrollBarsPaddingTop); + FScrollBarHor.Position2d := vec2(FScrollBarsPaddingLeft, FClipObject.Height - FScrollBarsPaddingBottom - FScrollBarHor.Height); + end; end; procedure TBScrolledWindowCustom.ChangeScrollHor(ScrollBar: TBScrollBar); diff --git a/gui/bs.gui.scrollbar.pas b/gui/bs.gui.scrollbar.pas index 4c03f59..7f1f6c5 100644 --- a/gui/bs.gui.scrollbar.pas +++ b/gui/bs.gui.scrollbar.pas @@ -1,4 +1,4 @@ -{ +{ -- Begin License block -- Copyright (C) 2019-2022 Pavlov V.V. (PVV) @@ -92,6 +92,8 @@ TBScrollBar = class(TBControl) ObsrvBtnDwnRgtMD: IBMouseDownEventObserver; ObsrvBtnUpLeftMU: IBMouseDownEventObserver; ObsrvBtnDwnRgtMU: IBMouseDownEventObserver; + ObsrvBtnDwnRgtMDbl: IBMouseDownEventObserver; + ObsrvBtnUpLeftMDbl: IBMouseDownEventObserver; ObsrvSliderMU: IBMouseDownEventObserver; ObsrvSliderMD: IBMouseDownEventObserver; @@ -102,12 +104,16 @@ TBScrollBar = class(TBControl) WaitTimerObsrv: IBAnimationLinearFloatObsrv; WaitTimerUp: boolean; + FMouseDataDblClick: BMouseData; + procedure SetHorizontal(const Value: boolean); procedure BtnUpLeftMouseDown({%H-}const Data: BMouseData); procedure BtnDownRightMouseDown({%H-}const Data: BMouseData); procedure BtnUpLeftMouseUp({%H-}const Data: BMouseData); procedure BtnDownRightMouseUp({%H-}const Data: BMouseData); + procedure BtnDownRightDblClick({%H-}const Data: BMouseData); + procedure BtnUpLeftDblClick({%H-}const Data: BMouseData); procedure BodyMouseDown({%H-}const Data: BMouseData); procedure OnChangeMVP({%H-}const Data: BTransformData); @@ -125,6 +131,8 @@ TBScrollBar = class(TBControl) procedure UpdatePostion; procedure OnWaitTime(const AValue: BSFloat); procedure DoChangePosition; inline; + procedure AwaitDblClickUpLeft(AData: Pointer); + procedure AwaitDblClickDownRight(AData: Pointer); protected BtnUpLeft: TRectangle; BtnDownRight: TRectangle; @@ -218,6 +226,16 @@ procedure TBScrollBar.OnWaitTime(const AValue: BSFloat); end; end; +procedure TBScrollBar.AwaitDblClickDownRight(AData: Pointer); +begin + BtnDownRightMouseUp(PMouseData(AData)^); +end; + +procedure TBScrollBar.AwaitDblClickUpLeft(AData: Pointer); +begin + BtnUpLeftMouseUp(PMouseData(AData)^); +end; + procedure TBScrollBar.BodyMouseDown(const Data: BMouseData); var page_size: int32; @@ -235,6 +253,13 @@ procedure TBScrollBar.BodyMouseDown(const Data: BMouseData); Position := FPosition - page_size; end; +procedure TBScrollBar.BtnDownRightDblClick(const Data: BMouseData); +begin + FMouseDataDblClick := Data; + BtnDownRightMouseDown(Data); + TTaskExecutor.AwaitExecuteTask(AwaitDblClickDownRight, @FMouseDataDblClick); +end; + procedure TBScrollBar.BtnDownRightMouseDown(const Data: BMouseData); begin if not Slider.Data.Hidden and (FPosition + 1 + Slider.Height < FSize) then @@ -251,6 +276,13 @@ procedure TBScrollBar.BtnDownRightMouseUp(const Data: BMouseData); WaitTimer.Stop; end; +procedure TBScrollBar.BtnUpLeftDblClick(const Data: BMouseData); +begin + FMouseDataDblClick := Data; + BtnUpLeftMouseDown(Data); + TTaskExecutor.AwaitExecuteTask(AwaitDblClickUpLeft, @FMouseDataDblClick); +end; + procedure TBScrollBar.BtnUpLeftMouseDown(const Data: BMouseData); begin if not Slider.Data.Hidden and (FPosition > 0) then @@ -339,7 +371,7 @@ constructor TBScrollBar.Create(ACanvas: TBCanvas); FMainBody.Color := FBody.Color; FOnMouseEnterLeaveBody := TOnMouseColorExchanger.Create(FBody); - ObsrvBodyMD := FBody.Data.EventMouseDown.CreateObserver(GUIThread, BodyMouseDown); + ObsrvBodyMD := FBody.Data.EventMouseDown.CreateObserver(BodyMouseDown); // create button Up/Left BtnUpLeft := TRectangle.Create(FCanvas, FBody); @@ -347,8 +379,9 @@ constructor TBScrollBar.Create(ACanvas: TBCanvas); BtnUpLeft.Data.DragResolve := false; BtnUpLeft.Data.SelectResolve := false; BtnUpLeft.Size := vec2(FBody.Size.Width, FBody.Size.Width); - ObsrvBtnUpLeftMD := BtnUpLeft.Data.EventMouseDown.CreateObserver(GUIThread, BtnUpLeftMouseDown); - ObsrvBtnUpLeftMU := BtnUpLeft.Data.EventMouseUp.CreateObserver(GUIThread, BtnUpLeftMouseUp); + ObsrvBtnUpLeftMD := BtnUpLeft.Data.EventMouseDown.CreateObserver(BtnUpLeftMouseDown); + ObsrvBtnUpLeftMU := BtnUpLeft.Data.EventMouseUp.CreateObserver(BtnUpLeftMouseUp); + ObsrvBtnUpLeftMDbl := BtnUpLeft.Data.EventMouseDblClick.CreateObserver(BtnUpLeftDblClick); FOnMouseEnterLeaveLeftUpBtn := TOnMouseMoveAndClickColorExchanger.Create(BtnUpLeft); // create button Right/Down @@ -357,8 +390,9 @@ constructor TBScrollBar.Create(ACanvas: TBCanvas); BtnDownRight.Data.DragResolve := false; BtnDownRight.Data.SelectResolve := false; BtnDownRight.Size := BtnUpLeft.Size; - ObsrvBtnDwnRgtMD := BtnDownRight.Data.EventMouseDown.CreateObserver(GUIThread, BtnDownRightMouseDown); - ObsrvBtnDwnRgtMU := BtnDownRight.Data.EventMouseUp.CreateObserver(GUIThread, BtnDownRightMouseUp); + ObsrvBtnDwnRgtMD := BtnDownRight.Data.EventMouseDown.CreateObserver(BtnDownRightMouseDown); + ObsrvBtnDwnRgtMU := BtnDownRight.Data.EventMouseUp.CreateObserver(BtnDownRightMouseUp); + ObsrvBtnDwnRgtMDbl := BtnDownRight.Data.EventMouseDblClick.CreateObserver(BtnDownRightDblClick); FOnMouseEnterLeaveRightDownBtn := TOnMouseMoveAndClickColorExchanger.Create(BtnDownRight); // create triangle inside buttons diff --git a/gui/bs.gui.table.pas b/gui/bs.gui.table.pas index 6a2a8c2..31cc8b9 100644 --- a/gui/bs.gui.table.pas +++ b/gui/bs.gui.table.pas @@ -1,4 +1,4 @@ -{ +{ -- Begin License block -- Copyright (C) 2019-2022 Pavlov V.V. (PVV) @@ -275,7 +275,6 @@ constructor TBCustomTable.Create(ACanvas: TBCanvas); ScrollBarVert.Step := round(FRealRowHeight); if FShowGrid then CreateGrid; - //Selector.SpaceTree. end; function TBCustomTable.CreateColumn(ADataGetter: TMethod; AColumnClass: IColumnPresentorClass; const AHeaderCaption: string): IColumnPresentor; diff --git a/gui/bs.selectors.pas b/gui/bs.selectors.pas index 6d86aa5..b341c79 100644 --- a/gui/bs.selectors.pas +++ b/gui/bs.selectors.pas @@ -1,4 +1,4 @@ -{ +{ -- Begin License block -- Copyright (C) 2019-2022 Pavlov V.V. (PVV) diff --git a/tests/bs.test.gui.pas b/tests/bs.test.gui.pas index 022a4bd..5193df1 100644 --- a/tests/bs.test.gui.pas +++ b/tests/bs.test.gui.pas @@ -2297,9 +2297,9 @@ constructor TBSTestComboBox.Create(ARenderer: TBlackSharkRenderer); begin inherited; ComboBox := TBComboBox.Create(ARenderer); - ComboBox.Resize(120*ToHiDpiScale, ComboBox.Height); - for i := 0 to 10 do - ComboBox.AddItem('I ' + IntToStr(i)); + //ComboBox.Resize(120*ToHiDpiScale, ComboBox.Height); + for i := 0 to 15 do + ComboBox.AddItem('Item ' + IntToStr(i)); //Renderer.Frustum.Angle := vec3(Renderer.Frustum.Angle.x, Renderer.Frustum.Angle.y + 90, Renderer.Frustum.Angle.z); end; diff --git a/tests/bs.test.mesh.pas b/tests/bs.test.mesh.pas index bf44e05..4a58915 100644 --- a/tests/bs.test.mesh.pas +++ b/tests/bs.test.mesh.pas @@ -15,6 +15,8 @@ interface , bs.mesh.primitives , bs.shader , bs.animation + , bs.events + , bs.gui.buttons ; type @@ -46,13 +48,16 @@ TBSTestMeshCylinder = class(TBSTest) class function TestName: string; override; end; + { TBSTestEarth } + TBSTestEarth = class(TBSTest) private - //Canvas: TBlackSharkCanvas; AniLaw: IBAnimationLinearFloat; AniLawElipse: IBAnimationElipse; ObsrvFloat: IBAnimationLinearFloatObsrv; ObsrvElipse: IBAnimationElipseObsrv; + AniFly: IBAnimationPath3d; + ObsrvFly: IBAnimationPath3dObsrv; Earth: TTexturedVertexes; Clouds: TTexturedVertexes; CloudsBack: TTexturedVertexes; @@ -62,8 +67,13 @@ TBSTestEarth = class(TBSTest) EmptyMoonAngle: TGraphicObject; Sky: TTexturedVertexes; //Tmp: TColoredVertexes; + Button: TBButton; + OnClckObsr: IBMouseDownEventObserver; + //Path: TGraphicObjectLines; procedure OnUpdateValueAngle(const Value: BSFloat); procedure OnUpdateValueTrackMoon(const Value: TVec2f); + procedure OnUpdatePosFly(const Value: TVec3f); + procedure OnButtonFlyClick(const AData: BMouseData); public constructor Create(ARenderer: TBlackSharkRenderer); override; destructor Destroy; override; @@ -82,6 +92,7 @@ implementation {$endif} , bs.thread , bs.texture + , bs.graphics ; { TBSTestMesh } @@ -155,12 +166,45 @@ procedure TBSTestEarth.OnUpdateValueTrackMoon(const Value: TVec2f); Moon.Angle := vec3(0.0, AniLawElipse.Angle, 0.0); end; +procedure TBSTestEarth.OnUpdatePosFly(const Value: TVec3f); +begin + if not AniFly.IsRun then + exit; + Renderer.Frustum.BeginUpdate; + Renderer.Frustum.Position := Value; + Renderer.Frustum.Angle := vec3(0.0, AniFly.CurrentNormalizedTime*360, 0.0); + Renderer.Frustum.EndUpdate; +end; + +procedure TBSTestEarth.OnButtonFlyClick(const AData: BMouseData); +//var +// i: int32; +begin + if AniFly.IsRun then + begin + AniFly.Stop; + end else + begin + AniFly.Run; + //Path.Clear; + //Path.BeginUpdate; + //Path.MoveTo(AniFly.PointsInterpolated.Items[0]); + //for i := 1 to AniFly.PointsInterpolated.Count - 1 do + //begin + // Path.LineTo(AniFly.PointsInterpolated.Items[i]); + //end; + //Path.EndUpdate(false); + end; +end; + constructor TBSTestEarth.Create(ARenderer: TBlackSharkRenderer); begin inherited; + AllowMoveCameraByKeyboard := true; Renderer.Frustum.Angle := vec3(0.0, 0.0, 0.0); + Renderer.Frustum.DistanceFarPlane := 500; Sky := TTexturedVertexes.Create(Self, nil, Renderer.Scene); - TBlackSharkFactoryShapesPT.GenerateSphere(Sky.Mesh, 10, Renderer.Frustum.DistanceFarPlane - Renderer.Frustum.DEFAULT_POSITION.z, true); // + TBlackSharkFactoryShapesPT.GenerateSphere(Sky.Mesh, 10, Renderer.Frustum.DistanceFarPlane * 0.5, true); // Sky.Texture := BSTextureManager.LoadTexture('Pictures/earth/sky.png', false, false); Sky.Interactive := false; Sky.DrawSides := dsBack; @@ -172,7 +216,7 @@ constructor TBSTestEarth.Create(ARenderer: TBlackSharkRenderer); EmptyMoon := TGraphicObject.Create(Self, Empty, Renderer.Scene); EmptyMoonAngle := TGraphicObject.Create(Self, EmptyMoon, Renderer.Scene); Earth := TTexturedVertexes.Create(Self, Empty , Renderer.Scene); - TBlackSharkFactoryShapesPT.GenerateSphere(Earth.Mesh, 10, Renderer.ScreenSizeToScene(500), true); + TBlackSharkFactoryShapesPT.GenerateSphere(Earth.Mesh, 10, Renderer.ScreenSizeToScene(round(500)), true); Earth.Texture := BSTextureManager.LoadTexture('Pictures/earth/earthmap1k.png'); Earth.Shader := TBlackSharkTextureOutShader(BSShaderManager.Load('SimpleTexture', TBlackSharkTextureOutShader)); //Earth.Position := vec3(0.0, 0.0, -4.0); @@ -184,7 +228,7 @@ constructor TBSTestEarth.Create(ARenderer: TBlackSharkRenderer); Earth.DrawSides := dsFront; //Earth.Hide := true; Clouds := TTexturedVertexes.Create(Self, Earth, Renderer.Scene); - TBlackSharkFactoryShapesPT.GenerateSphere(Clouds.Mesh, 10, Renderer.ScreenSizeToScene(525), true); + TBlackSharkFactoryShapesPT.GenerateSphere(Clouds.Mesh, 10, Renderer.ScreenSizeToScene(round(525)), true); Clouds.Texture := BSTextureManager.LoadTexture('Pictures/earth/earthcloudmapcolortrans.png'); Clouds.Shader := TBlackSharkTextureOutShader(BSShaderManager.Load('SimpleTexture', TBlackSharkTextureOutShader)); Clouds.Interactive := false; @@ -193,7 +237,7 @@ constructor TBSTestEarth.Create(ARenderer: TBlackSharkRenderer); Clouds.ChangedMesh; Clouds.DrawSides := dsFront; CloudsBack := TTexturedVertexes.Create(Self, Earth , Renderer.Scene); - TBlackSharkFactoryShapesPT.GenerateSphere(CloudsBack.Mesh, 10, Renderer.ScreenSizeToScene(525), true); + TBlackSharkFactoryShapesPT.GenerateSphere(CloudsBack.Mesh, 10, Renderer.ScreenSizeToScene(round(525)), true); CloudsBack.Texture := BSTextureManager.LoadTexture('Pictures/earth/earthcloudmapcolortrans.png'); //CloudsBack.Texture := Clouds.Texture; CloudsBack.Shader := TBlackSharkTextureOutShader(BSShaderManager.Load('SimpleTexture', TBlackSharkTextureOutShader)); @@ -204,7 +248,7 @@ constructor TBSTestEarth.Create(ARenderer: TBlackSharkRenderer); CloudsBack.DrawSides := dsBack; EmptyMoon.Angle := vec3(0.0, 0.0, 15.0); Moon := TTexturedVertexes.Create(Self, EmptyMoonAngle , Renderer.Scene); - TBlackSharkFactoryShapesPT.GenerateSphere(Moon.Mesh, 10, Renderer.ScreenSizeToScene(150), true); + TBlackSharkFactoryShapesPT.GenerateSphere(Moon.Mesh, 10, Renderer.ScreenSizeToScene(round(150)), true); Moon.Texture := BSTextureManager.LoadTexture('Pictures/earth/moonmap1k.png'); Moon.Shader := TBlackSharkTextureOutShader(BSShaderManager.Load('SimpleTexture', TBlackSharkTextureOutShader)); //Moon.DragResolve := false; @@ -212,12 +256,13 @@ constructor TBSTestEarth.Create(ARenderer: TBlackSharkRenderer); Moon.DrawSides := dsFront; Moon.ChangedMesh; //Moon.Hide := true; - EmptyMoonAngle.Position := vec3(Renderer.ScreenSizeToScene(2000), 0.0, 0.0); + EmptyMoonAngle.Position := vec3(Renderer.ScreenSizeToScene(round(2000)), 0.0, 0.0); AniLaw := CreateAniFloatLinear(GUIThread); ObsrvFloat := AniLaw.CreateObserver(GUIThread, OnUpdateValueAngle); AniLaw.Duration := 20000; AniLaw.Loop := true; + AniLaw.IntervalUpdate := 0; //AniLaw.LoopInverse := true; AniLaw.StartValue := 0.0; AniLaw.StopValue := 360.0; @@ -226,23 +271,52 @@ constructor TBSTestEarth.Create(ARenderer: TBlackSharkRenderer); AniLawElipse.c := EmptyMoonAngle.Position.x; AniLawElipse.Duration := round(AniLaw.Duration*3); AniLawElipse.Loop := true; + AniLawElipse.IntervalUpdate := 0; //AniLaw.LoopInverse := true; AniLawElipse.StartValue := vec2(EmptyMoonAngle.Position.x, EmptyMoonAngle.Position.y); AniLawElipse.StopValue := vec2(EmptyMoonAngle.Position.x, EmptyMoonAngle.Position.y); + + Button := TBButton.Create(ARenderer); + Button.Caption := 'Fly'; + Button.Canvas.Font.Size := 10; + OnClckObsr := Button.OnClickEvent.CreateObserver(OnButtonFlyClick); + Button.Position2d := vec2(20.0, 20.0); + + AniFly := CreateAniPath3d(NextExecutor); + ObsrvFly := AniFly.CreateObserver(GUIThread, OnUpdatePosFly); + AniFly.Duration := 10000; + AniFly.IntervalUpdate := 0; + AniFly.InterpolateFactor := 0.001; + AniFly.Loop := false; + AniFly.InterpolateSpline := TInterpolateSpline.isCubicHermite; + AniFly.AddPoint(Renderer.Frustum.Position); + AniFly.AddPoint(vec3(-3, 0.0, -4.0)); + AniFly.AddPoint(vec3(0.0, 0.0, -7)); + AniFly.AddPoint(vec3(3, 0.0, -4.0)); + AniFly.AddPoint(Renderer.Frustum.Position); + AniFly.StartValue := Renderer.Frustum.Position; + AniFly.StopValue := Renderer.Frustum.Position; + + //Path := TGraphicObjectLines.Create(nil, nil, Renderer.Scene); end; destructor TBSTestEarth.Destroy; begin AniLaw.Stop; AniLawElipse.Stop; + AniFly.Stop; + ObsrvFly := nil; + AniFly := nil; ObsrvElipse := nil; ObsrvFloat := nil; AniLaw := nil; AniLawElipse := nil; + //Path.Free; Sky.Free; Moon.Free; Earth.Free; Empty.Free; + Button.Free; inherited; end; diff --git a/tests/bsApplication/BSApplicationExample.pas b/tests/bsApplication/BSApplicationExample.pas index 8f740d5..c1f57cd 100644 --- a/tests/bsApplication/BSApplicationExample.pas +++ b/tests/bsApplication/BSApplicationExample.pas @@ -66,9 +66,11 @@ procedure BSApplicationExampleRun; constructor TBSApplicationExample.Create; begin inherited; + {$ifndef ultibo} // ultibo transmits own params in command line; + {$ifndef android} // for android it is library CommandLineParam := ParamStr(1); - {$ifndef ultibo} // ultibo transmits own params in command line if CommandLineParam = '' then + {$endif} {$endif} CommandLineParam := 'TBSTestWindows'; //TBSTestWindows TBSTestEarth TBSTestCanvasImages TBSTestEdit TBSTestButton TBSTestTable TBSTestWindows TBSTestSimple TBSTestCollada TBSTestCanvas end; @@ -139,7 +141,7 @@ procedure TBSApplicationExample.DoUpdateFps; begin FpsOut.Text := 'Tasks: ' + IntToStr(TTaskExecutor.CountTasks) + '; FPS: ' + IntToStr(MainWindow.Renderer.FPS); end; - end; +end; procedure TBSApplicationExample.OnGLContextLost; begin diff --git a/tests/lazarus/Android/HelloBlackShark/src/org/bshark/blackshark/BlackSharkApplication.java b/tests/lazarus/Android/HelloBlackShark/src/org/bshark/blackshark/BlackSharkApplication.java index fd01114..da885ba 100644 --- a/tests/lazarus/Android/HelloBlackShark/src/org/bshark/blackshark/BlackSharkApplication.java +++ b/tests/lazarus/Android/HelloBlackShark/src/org/bshark/blackshark/BlackSharkApplication.java @@ -265,7 +265,7 @@ public void onCreate(Bundle savedInstanceState) { appSourceDir = getApplicationInfo().sourceDir; dataDir = getFilesDir().getAbsolutePath(); - //ref. http://stackoverflow.com/questions/8706464/defaulthttpclient-to-androidhttpclient + // http://stackoverflow.com/questions/8706464/defaulthttpclient-to-androidhttpclient int systemVersion = android.os.Build.VERSION.SDK_INT; if (systemVersion > 9) { @@ -346,8 +346,7 @@ public void onConfigurationChanged(Configuration newConfig) { super.onConfigurationChanged(newConfig); screenOrientation = newConfig.orientation; - //newConfig. - + glSurfaceView.requestLayout(); //bsNativeOnChanged(); } @@ -406,8 +405,6 @@ private boolean doOnKeyDown(int keyCode, KeyEvent event) { //mute = bsNativeOnKeyDown(c,keyCode,KeyEvent.keyCodeToString(keyCode)); break;*/ - /*commented! need SDK API >= 18 [Android 4.3] to compile!*/ - /*case KeyEvent.KEYCODE_BRIGHTNESS_DOWN: bsNativeOnKeyDown(c,keyCode,KeyEvent.keyCodeToString(keyCode)); break; @@ -483,11 +480,6 @@ private void runLoop(){ private void stopLoop() { if (updateTask != null) { updateTask.cancel(); -// try { -// updateTask.wait(); -// } catch (InterruptedException e) { -// e.printStackTrace(); -// } updateTask = null; timer = null; } @@ -510,20 +502,12 @@ private void unpackAssets() throws IOException { while (zipEntry != null) { if (!zipEntry.isDirectory() && (zipEntry.toString().contains("assets/"))) { String newFile = dataDir + "/" + zipEntry.toString().substring(7); - // write file content -// try { -// Files.createFile(Paths.get(newFile)); -// } catch (IOException e) { -// e.printStackTrace(); -// } int len; File file = new File(newFile); File parent = new File(file.getParent()); if (!parent.exists()) { parent.mkdirs(); } - //File f = Files.exists() - //if (path.) FileOutputStream fos = new FileOutputStream(newFile); while (true) { len = 0; @@ -545,7 +529,6 @@ private void unpackAssets() throws IOException { e.printStackTrace(); } fos = null; - //zipEntry. } try { zipEntry = zis.getNextEntry();