Skip to content
This repository was archived by the owner on Dec 16, 2024. It is now read-only.

Commit 0fcb2d0

Browse files
fliderosflideros
committed
Saving progress on SelectionControl. Minor refactor of domain model. added System type to represent diferent systems such as a truss.
1 parent 6029862 commit 0fcb2d0

5 files changed

Lines changed: 69 additions & 64 deletions

File tree

‎Analysis Lab/AnalysisControls.fs‎

Lines changed: 35 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -355,7 +355,10 @@ type WolframResultControl(wolframCode:SharedValue<string>,
355355
member _this.result image = result_Viewbox image
356356
member _this.setGraphics k = setGraphicsFromKernel k
357357

358-
type SelectionControl (orginPoint:SharedValue<Point>) as this =
358+
type SelectionControl (orginPoint:SharedValue<Point>,
359+
system:SharedValue<ElementDomain.System option>,
360+
selectedPart:SharedValue<ElementDomain.Part option>
361+
) as this =
359362
inherit UserControl()
360363
do Install() |> ignore
361364

@@ -367,37 +370,26 @@ type SelectionControl (orginPoint:SharedValue<Point>) as this =
367370
l.FontSize <- 20.
368371
l.TextWrapping <- TextWrapping.Wrap
369372
l.Text <- "Selection Mode"
370-
l
371-
let delete_RadioButton =
372-
let r = RadioButton()
373-
let tb = TextBlock(Text="Delete", FontSize=15.)
374-
do r.Content <- tb
375-
r.IsChecked <- true |> Nullable<bool>
376-
r
377-
let inspect_RadioButton =
378-
let r = RadioButton()
379-
let tb = TextBlock(Text="Inspect", FontSize=15.)
380-
do r.Content <- tb
381-
r.IsChecked <- false |> Nullable<bool>
382-
r
383-
let modify_RadioButton =
384-
let r = RadioButton()
385-
let tb = TextBlock(Text="Modify", FontSize=15.)
386-
do r.Content <- tb
387-
r.IsChecked <- false |> Nullable<bool>
388-
r
389-
(*let delete_Button =
390-
let b = Button()
391-
let handleClick () =
392-
let newState = trussServices.removeTrussPartFromTruss state
393-
do state <- newState
394-
label.Text <- newState.ToString()
373+
l
374+
let selectionMode_ComboBox =
375+
let cb = ComboBox()
376+
do cb.Text <- "Selection Mode"
377+
//cb.Width <- 200.
378+
//cb.Height <- 30.
379+
cb.FontSize <- 15.
380+
cb.VerticalContentAlignment <- VerticalAlignment.Center
381+
cb.SelectedItem <- "Delete"
382+
cb.ItemsSource <- ["Delete";"Inspect";"Modify"]
383+
cb
384+
385+
let delete_Button =
386+
let b = Button()
395387
do b.Content <- "Delete"
396388
b.FontSize <- 12.
397389
b.FontWeight <- FontWeights.Bold
398390
b.VerticalAlignment <- VerticalAlignment.Center
399-
b.Click.AddHandler(RoutedEventHandler(fun _ _ -> handleClick()))
400-
b*)
391+
b
392+
401393
let newPX_TextBlock =
402394
let tb = TextBlock(Text = "X")
403395
do tb.SetValue(Grid.RowProperty,0)
@@ -428,6 +420,7 @@ type SelectionControl (orginPoint:SharedValue<Point>) as this =
428420
sp.Children.Add(newPY_TextBox) |> ignore
429421
sp.Visibility <- Visibility.Collapsed
430422
sp
423+
431424
let newFMag_TextBlock =
432425
let tb = TextBlock(Text = "Magnitude")
433426
do tb.SetValue(Grid.RowProperty,0)
@@ -458,16 +451,15 @@ type SelectionControl (orginPoint:SharedValue<Point>) as this =
458451
sp.Children.Add(newFDir_TextBox) |> ignore
459452
sp.Visibility <- Visibility.Collapsed
460453
sp
454+
461455
let selectionMode_StackPanel =
462456
let sp = StackPanel()
463457
do sp.Margin <- Thickness(Left = 10., Top = 0., Right = 0., Bottom = 0.)
464458
sp.MaxWidth <- 150.
465459
sp.IsHitTestVisible <- true
466460
sp.Orientation <- Orientation.Vertical
467461
sp.Children.Add(selectionMode_Label) |> ignore
468-
sp.Children.Add(delete_RadioButton) |> ignore
469-
sp.Children.Add(inspect_RadioButton) |> ignore
470-
sp.Children.Add(modify_RadioButton) |> ignore
462+
sp.Children.Add(selectionMode_ComboBox) |> ignore
471463
//sp.Children.Add(delete_Button) |> ignore
472464
sp.Children.Add(newP_StackPanel) |> ignore
473465
sp.Children.Add(newF_StackPanel) |> ignore
@@ -479,4 +471,16 @@ type SelectionControl (orginPoint:SharedValue<Point>) as this =
479471
do g.Children.Add(selectionMode_StackPanel) |> ignore
480472
g
481473

474+
// logic
475+
let deletePart () =
476+
match system.Get.IsSome && selectedPart.Get.IsSome with
477+
| true -> ()
478+
| false ->
479+
match system.Get.Value with
480+
| ElementDomain.System.Beam -> ()
481+
| ElementDomain.System.TrussSystem t ->
482+
let tOut = TrussImplementation.removeTrussPartFromTruss t selectedPart.Get
483+
do system.Set (ElementDomain.System.TrussSystem tOut |> Some)
484+
482485
do this.Content <- screen_Grid
486+
delete_Button.Click.AddHandler(RoutedEventHandler(fun _ _ -> deletePart()))

‎Analysis Lab/DomainModels.fs‎

Lines changed: 13 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -56,14 +56,18 @@ module ElementDomain =
5656
| Hinge
5757
| Fixed
5858
| Simple
59-
6059

61-
type Truss = {members:Member list; forces:JointForce list; supports:Support list}
62-
type TrussPart = // A joint by itself is not a part, rather it is a cosequence of connecting two (or more) members
60+
type Part = // A joint by itself is not a part, rather it is a cosequence of connecting two (or more) members
6361
| Member of Member
6462
| Force of JointForce
65-
| Support of Support
66-
type TrussNode = (Joint*TrussPart list)
63+
| Support of Support
64+
type Node = (Joint*Part list)
65+
66+
type Truss = {members:Member list; forces:JointForce list; supports:Support list}
67+
type System =
68+
| TrussSystem of Truss
69+
| Beam // TODO
70+
// etc.
6771

6872
module BuilderDomain =
6973
open AtomicDomain
@@ -79,7 +83,7 @@ module BuilderDomain =
7983
| BuildSupport of SupportBuilder
8084
| Control
8185
type BuildOpResult =
82-
| TrussPart of TrussPart
86+
| TrussPart of Part
8387
| TrussBuildOp of TrussBuildOp
8488

8589
module ErrorDomain =
@@ -115,7 +119,7 @@ module TrussAnalysisDomain =
115119
| Determinate
116120
| Indeterminate
117121

118-
type TrussMemberForce = (float*TrussPart)
122+
type TrussMemberForce = (float*Part)
119123

120124
type TrussMode =
121125
| Settings
@@ -154,11 +158,11 @@ module TrussAnalysisDomain =
154158
type MethodOfJointsCalculationStateData =
155159
{solvedMembers: TrussMemberForce list;
156160
memberEquations : string list;
157-
nodes : TrussNode list;
161+
nodes : Node list;
158162
reactions : SupportReactionResult list;
159163
variables : string list}
160164
type MethodOfJointsAnalysisStateData =
161-
{zeroForceMembers: TrussPart list;
165+
{zeroForceMembers: Part list;
162166
tensionMembers: TrussMemberForce list;
163167
compressionMembers: TrussMemberForce list;
164168
reactions : SupportReactionResult list}

‎Analysis Lab/ElementControls.fs‎

Lines changed: 1 addition & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -410,10 +410,7 @@ type SupportBuilderControl(mousePosition:SharedValue<Point>,
410410
l
411411
let supportType_ComboBox =
412412
let cb = ComboBox()
413-
do cb.Text <- "Support Type"
414-
//cb.Width <- 200.
415-
//cb.Height <- 30.
416-
cb.FontSize <- 15.
413+
do cb.FontSize <- 15.
417414
cb.VerticalContentAlignment <- VerticalAlignment.Center
418415
cb.SelectedItem <- "Roller"
419416
cb.ItemsSource <- ["Roller";"Pin";"Fixed";"Hinge";"Simple"]

‎Analysis Lab/TrussImplementation.fs‎

Lines changed: 18 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -126,21 +126,21 @@ module TrussImplementation =
126126
| BuilderDomain.SupportBuilder.Pin (p,_) -> p.joint
127127
let getJointFromSupport (s:Support) = match s with | Pin p -> Some p.normal.joint | Roller r -> Some r.joint | _ -> None
128128

129-
let sumForcesX (p:TrussPart list) =
129+
let sumForcesX (p:Part list) =
130130
let forces = List.choose (fun x -> match x with | Force f -> Some (getComponentForcesFrom f) | _ -> None) p
131131
List.fold (fun acc x -> x.magnitudeX + acc ) 0. forces
132-
let sumForcesY (p:TrussPart list) =
132+
let sumForcesY (p:Part list) =
133133
let forces = List.choose (fun x -> match x with | Force f -> Some (getComponentForcesFrom f) | _ -> None) p
134134
List.fold (fun acc y -> y.magnitudeY + acc ) 0. forces
135-
let sumForceMoments (s:Support) (p:TrussPart list) =
135+
let sumForceMoments (s:Support) (p:Part list) =
136136
let forces = List.choose (fun x -> match x with | Force f -> Some (getComponentForcesFrom f) | _ -> None) p
137137
let j = getJointFromSupport s
138138
let getMomentArmY fj = (getYFrom fj - getYFrom j.Value)
139139
let getMomentArmX fj = (getXFrom fj - getXFrom j.Value)
140140
List.fold (fun acc cf -> cf.magnitudeX*(getMomentArmY cf.atJoint) + cf.magnitudeY*(getMomentArmX cf.atJoint) + acc ) 0. forces
141141

142142
// Support Reaction Equations
143-
let getXForceReactionEquation (p:TrussPart list) =
143+
let getXForceReactionEquation (p:Part list) =
144144
let supports = List.choose (fun x -> match x with | Support s -> Some s | _ -> None) p
145145
let reactions = List.mapi (fun i x ->
146146
match x with
@@ -152,7 +152,7 @@ module TrussImplementation =
152152
Math.Abs x/d,"Rx" + i.ToString()
153153
| _ -> 0.0,"Not Implemented") supports
154154
createEquation (sumForcesX p) reactions
155-
let getYForceReactionEquation (p:TrussPart list) =
155+
let getYForceReactionEquation (p:Part list) =
156156
let supports = List.choose (fun y -> match y with | Support s -> Some s | _ -> None) p
157157
let reactions = List.mapi (fun i y ->
158158
match y with
@@ -164,7 +164,7 @@ module TrussImplementation =
164164
y/d,"Ry" + i.ToString()
165165
| _ -> 0.0,"Not Implemented") supports
166166
createEquation (sumForcesY p) reactions
167-
let addSupportXY (p:TrussPart list) =
167+
let addSupportXY (p:Part list) =
168168
let supports = List.choose (fun x -> match x with | Support s -> Some s | _ -> None) p
169169
match supports with
170170
| [] -> false
@@ -174,7 +174,7 @@ module TrussImplementation =
174174
match m = 0. || m = Double.PositiveInfinity with | true -> false | false -> true
175175
| Pin p1 :: Pin p2 :: [] -> true
176176
| _ -> true
177-
let supportXY rSting add (p:TrussPart list) =
177+
let supportXY rSting add (p:Part list) =
178178
let supports = List.choose (fun y -> match y with | Support s -> Some s | _ -> None) p
179179
match supports with
180180
| [] -> []
@@ -193,7 +193,7 @@ module TrussImplementation =
193193
| true -> [createEquation (0.) [(1., rSting + i1.ToString());(-1., rSting + i2.ToString())]]
194194
| false -> []
195195
| _ -> []
196-
let getYMomentReactionEquations (p:TrussPart list) =
196+
let getYMomentReactionEquations (p:Part list) =
197197
let supports = List.choose (fun x -> match x with | Support s -> Some s | _ -> None) p
198198
let supportXY = supportXY "Rx" (addSupportXY p) p
199199
let getSupportMoments (s:Support) =
@@ -212,7 +212,7 @@ module TrussImplementation =
212212
List.concat [ly;lx]
213213
let momentEquations = List.map (fun y -> createEquation (sumForceMoments y p) (getSupportMoments y)) supports
214214
List.concat [momentEquations; supportXY]
215-
let getXMomentReactionEquations (p:TrussPart list) =
215+
let getXMomentReactionEquations (p:Part list) =
216216
let supports = List.choose (fun x -> match x with | Support s -> Some s | _ -> None) p
217217
let supportXY = supportXY "Ry" (addSupportXY p) p
218218
let getSupportMoments (s:Support) =
@@ -235,12 +235,12 @@ module TrussImplementation =
235235
List.concat [momentEquations; supportXY]
236236

237237
// Basic operations on truss
238-
let addTrussPartToTruss (t:Truss) (p:TrussPart) =
238+
let addTrussPartToTruss (t:Truss) (p:Part) =
239239
match p with
240240
| Member m -> {t with members = m::t.members}
241241
| Force f -> {t with forces = f::t.forces}
242242
| Support s -> {t with supports = s::t.supports}
243-
let removeTrussPartFromTruss (t:Truss) (p:TrussPart option) =
243+
let removeTrussPartFromTruss (t:Truss) (p:Part option) =
244244
match p with
245245
| Some (Member m) ->
246246
let mOut = List.except [m] t.members
@@ -267,7 +267,7 @@ module TrussImplementation =
267267
| Hinge -> i,"Hinge"
268268
| Simple -> i,"Simple"
269269
// Method of Joints
270-
let isColinear (p1:TrussPart) (p2:TrussPart) =
270+
let isColinear (p1:Part) (p2:Part) =
271271
match p1, p2 with
272272
| Member m1, Member m2 -> (getMemberLineOfActionFrom m1) = (getMemberLineOfActionFrom m2)
273273
| Member m1, Force f
@@ -277,7 +277,7 @@ module TrussImplementation =
277277
| Support (Pin p), Member m1
278278
| Member m1,Support (Pin (p)) -> (getMemberLineOfActionFrom m1) = (getLineOfActionFrom p.normal)*)
279279
| _ -> false
280-
let getZFM (tpl:TrussPart list) =
280+
let getZFM (tpl:Part list) =
281281
match tpl with
282282
// case 1 -- no load, 2 non-colinear members, both members are zero force
283283
| [Member m1;Member m2] when (isColinear (Member m1) (Member m2)) = false -> [Member m1;Member m2]
@@ -300,7 +300,7 @@ module TrussImplementation =
300300
| [Member m1;Support s;Member m2]
301301
| [Support s;Member m1;Member m2] when (isColinear (Member m2) (Support s)) && ((isColinear (Member m1) (Member m2)) = false) -> [Member m1]
302302
| _ -> []
303-
let partitionNode (tpl:TrussNode list) =
303+
let partitionNode (tpl:Node list) =
304304
List.map (fun (j,pl) ->
305305
let zfm = getZFM pl
306306
let pl' = List.except zfm pl
@@ -320,10 +320,10 @@ module TrussImplementation =
320320
let jointParts = getJointPartListFrom t
321321
let partition = partitionNode jointParts
322322
let zfm = getZeroForceMembers t
323-
List.fold (fun acc x -> match x with | (j,pl,_zfm) -> TrussNode (j,List.except zfm pl)::acc) [] partition
323+
List.fold (fun acc x -> match x with | (j,pl,_zfm) -> Node (j,List.except zfm pl)::acc) [] partition
324324
let getMemberVariables (t:Truss) =
325325
let nl = getNodeList t
326-
let processNode (n:TrussNode) =
326+
let processNode (n:Node) =
327327
let _j,pl = n
328328
let members =
329329
List.choose (fun x -> match x with | Member m -> Some m | _ -> None) pl
@@ -358,7 +358,7 @@ module TrussImplementation =
358358
let d = match Math.Sqrt (x*x + y*y) with | n when n = 0. -> 0. | n -> n
359359
let name = "M" + index.ToString()
360360
( y/d,name) //Math.Abs
361-
let analyzeNode (n:TrussNode) (t:Truss) (r:SupportReactionResult list) =
361+
let analyzeNode (n:Node) (t:Truss) (r:SupportReactionResult list) =
362362
let j,pl = n
363363
let supportReactions =
364364
let s = List.tryFind (fun x -> match x with | Support _ -> true | _ -> false) pl
@@ -380,7 +380,7 @@ module TrussImplementation =
380380
List.choose (fun y -> match y with | Member m -> Some m | _ -> None) pl
381381
|> List.map (fun y -> getMemberExpressionsY j y (getMemberIndex y t))
382382
[createEquation sumfx membersX;createEquation sumfy membersY]
383-
let getMemberForceAtJoint (j:Joint) (m:TrussPart) (mf:TrussMemberForce list) =
383+
let getMemberForceAtJoint (j:Joint) (m:Part) (mf:TrussMemberForce list) =
384384
let tf = List.tryFind (fun (_f,p) -> p = m ) mf
385385
match tf with
386386
| None -> m

‎Analysis Lab/TrussServices.fs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,7 @@ module TrussServices =
3030
type GetSupportReactionEquationsFromState = bool -> TrussAnalysisState -> TrussAnalysisState
3131
type GetSupportReactionSolve = bool -> TrussAnalysisState -> string
3232
type GetReactionForcesFromState = bool -> TrussAnalysisState -> JointForce list
33-
type GetMemberOptionFromTrussPart = TrussPart -> (System.Windows.Point*System.Windows.Point) Option
33+
type GetMemberOptionFromTrussPart = Part -> (System.Windows.Point*System.Windows.Point) Option
3434
type GetAnalysisReport = TrussAnalysisState -> string
3535
type GetSupportIndexAtJoint = Joint -> Support list -> int*string
3636
type GetMemberIndex = Member -> Truss -> int
@@ -797,7 +797,7 @@ module TrussServices =
797797
|> List.concat
798798
|> List.distinctBy (fun (m,p) -> (m,p))
799799
|> List.map (fun x -> TrussMemberForce x)
800-
let replaceMembersWithForces (n:TrussNode) =
800+
let replaceMembersWithForces (n:Node) =
801801
let (j,pl) = n
802802
let memberCount pl' = List.filter (fun x -> match x with | Member _ -> true | _ -> false) pl' |> List.length
803803
let newPl =

0 commit comments

Comments
 (0)