-
1
-
2
-
3
-
4
-
5
-
6
-
7
-
8
-
9
-
10
-
11
-
12
-
13
-
14
-
15
-
16
-
17
-
18
-
19
-
20
-
21
-
22
-
23
-
24
-
25
-
26
-
27
-
28
-
29
-
30
-
31
-
32
-
33
-
34
-
35
-
36
-
37
-
38
-
39
-
40
-
41
-
42
-
43
-
44
-
45
-
46
-
47
-
48
-
49
-
50
-
51
-
52
-
53
-
54
-
55
-
56
-
57
-
58
-
59
-
60
-
61
-
62
-
63
-
64
-
65
-
66
-
67
-
68
-
69
-
70
-
71
-
72
-
73
-
74
-
75
-
76
-
77
-
78
-
79
-
80
-
81
-
82
-
83
-
84
-
85
-
86
-
87
-
88
-
89
-
90
-
91
-
92
-
93
-
94
-
95
-
96
-
97
-
98
-
99
-
100
-
101
-
102
-
103
-
104
-
105
-
106
-
107
-
108
-
109
-
110
-
111
-
112
-
113
-
114
-
115
-
116
-
117
-
118
-
119
-
120
-
121
-
122
-
123
-
124
-
125
-
126
-
127
-
128
-
129
-
130
-
131
-
132
-
133
-
134
-
135
-
136
-
137
-
138
-
139
-
140
-
141
-
142
-
143
-
144
-
145
-
146
-
147
-
148
-
149
-
150
-
151
-
152
-
153
-
154
-
155
-
156
-
157
-
158
-
159
-
160
-
161
-
162
-
163
-
164
-
165
-
166
-
167
-
168
-
169
-
170
-
171
-
172
-
173
-
174
-
175
-
176
-
177
-
178
-
179
-
180
-
181
-
182
-
183
-
184
-
185
-
186
-
187
-
188
-
189
-
190
-
191
-
192
-
193
-
194
-
195
-
196
-
197
-
198
-
199
-
200
-
201
-
202
-
203
-
204
-
205
-
206
-
207
-
208
-
209
-
210
-
211
-
212
-
213
-
214
-
215
-
216
-
217
-
218
-
219
-
220
-
221
-
222
-
223
-
224
-
225
-
226
-
227
-
228
-
229
-
230
-
231
-
232
-
233
-
234
-
235
-
236
-
237
-
238
-
239
-
240
-
241
-
242
-
243
-
244
-
245
-
246
-
247
-
248
-
249
-
250
-
251
-
252
-
253
-
254
-
255
-
256
-
257
-
258
-
259
-
260
-
261
-
262
-
263
-
264
-
265
-
266
-
267
-
268
-
269
-
270
-
271
-
272
-
273
-
274
-
275
-
276
-
277
-
278
-
279
-
280
-
281
-
282
-
283
-
284
-
285
-
286
-
287
-
288
-
289
-
290
-
291
-
292
-
293
-
294
-
295
-
296
-
297
-
298
-
299
-
300
-
301
-
302
-
303
-
304
-
305
-
306
-
307
-
308
-
309
-
310
-
311
-
312
-
313
-
314
-
315
-
316
-
317
-
318
-
319
-
320
-
321
-
322
-
323
-
324
-
325
-
326
-
327
-
328
-
329
-
330
-
331
-
332
-
333
-
334
-
335
-
336
-
337
-
338
-
339
-
340
-
341
-
342
-
343
-
344
-
345
-
346
-
347
-
348
-
349
-
350
-
351
-
352
-
353
-
354
-
355
-
356
-
357
-
358
-
359
-
360
-
361
-
362
-
363
-
364
-
365
-
366
-
367
-
368
-
369
-
370
-
371
-
372
-
373
-
374
-
375
-
376
-
377
-
378
-
379
-
380
-
381
-
382
-
383
-
384
-
385
-
386
-
387
-
388
-
389
-
390
-
391
-
392
-
393
-
394
-
395
-
396
-
397
-
398
-
399
-
400
-
401
-
402
-
403
-
404
-
405
-
406
-
407
-
408
-
409
-
410
-
411
-
412
-
413
-
414
-
415
-
416
-
417
-
418
-
419
-
420
-
421
-
422
-
423
-
424
-
425
-
426
-
427
-
428
-
429
-
430
-
431
-
432
-
433
-
434
-
435
-
436
-
437
-
438
-
439
-
440
-
441
-
442
-
443
-
444
-
445
-
446
-
447
-
448
-
449
-
450
-
451
-
452
-
453
-
454
-
455
-
456
-
457
-
458
-
459
-
460
-
461
-
462
-
463
-
464
-
465
-
466
-
467
-
468
-
469
-
470
-
471
-
472
-
473
-
474
-
475
-
476
-
477
-
478
-
479
-
480
-
481
-
482
-
483
-
484
-
485
-
486
-
487
-
488
-
489
-
490
-
491
-
492
-
493
-
494
-
495
-
496
-
497
-
498
-
499
-
500
-
501
-
502
-
503
-
504
-
505
-
506
-
507
-
508
-
509
-
510
-
511
-
512
-
513
-
514
-
515
-
516
-
517
-
518
-
519
-
520
-
521
-
522
-
523
-
524
-
525
-
526
-
527
-
528
-
529
-
530
-
531
-
532
-
533
-
534
-
535
-
536
-
537
-
538
-
539
-
540
-
541
-
542
-
543
-
544
-
545
-
546
-
547
-
548
-
549
-
550
-
551
-
552
-
553
-
554
-
555
-
556
-
557
-
558
-
559
-
560
-
561
-
562
-
563
-
564
-
565
-
566
-
567
-
568
-
569
-
570
-
571
-
572
-
573
-
574
-
575
-
576
-
577
-
578
-
579
-
580
-
581
-
582
-
583
-
584
-
585
-
586
-
587
-
588
-
589
-
590
-
591
-
592
-
593
-
594
-
595
-
596
-
597
-
598
-
599
-
600
-
601
-
602
-
603
-
604
-
605
-
606
-
607
-
608
-
609
-
610
-
611
-
612
-
613
-
614
-
615
-
616
-
617
-
618
-
619
-
620
-
621
-
622
-
623
-
624
-
625
-
626
-
627
-
628
-
629
-
630
-
631
-
632
-
633
-
634
-
635
-
636
-
637
-
638
-
639
-
640
-
641
-
642
-
643
-
644
-
645
-
646
-
647
-
648
-
649
-
650
-
651
-
652
-
653
-
654
-
655
-
656
-
657
-
658
-
659
-
660
-
661
-
662
-
663
-
664
-
665
-
666
-
667
-
668
-
669
-
670
-
671
-
672
-
673
-
674
-
675
-
676
-
677
-
678
-
679
-
680
-
681
-
682
-
683
-
684
-
685
-
686
-
687
-
688
-
689
-
690
-
691
-
692
-
693
-
694
-
695
-
696
-
697
-
698
-
699
-
700
-
701
-
702
-
703
-
704
-
705
-
706
-
707
-
708
-
709
-
710
-
711
-
712
-
713
-
714
-
715
-
716
-
717
-
718
-
719
-
720
-
721
-
722
-
723
-
724
-
725
-
726
-
727
-
728
-
729
-
730
-
731
-
732
-
733
-
734
-
735
-
736
-
737
-
738
-
739
-
740
-
741
-
742
-
743
-
744
-
745
-
746
-
747
-
748
-
749
-
750
-
751
-
752
-
753
-
754
-
755
-
756
-
757
-
758
-
759
-
760
-
761
-
762
-
763
-
764
-
765
-
766
-
767
-
768
-
769
-
770
-
771
-
772
-
773
-
774
-
775
-
776
-
777
-
778
-
779
-
780
-
781
-
782
-
783
-
784
-
785
-
786
-
787
-
788
-
789
-
790
-
791
-
792
-
793
-
794
-
795
-
796
-
797
-
798
-
799
-
800
-
801
-
802
-
803
-
804
-
805
-
806
-
807
-
808
-
809
-
810
-
811
-
812
-
813
-
814
-
815
-
816
-
817
-
818
-
819
-
820
-
821
-
822
-
823
-
824
-
825
-
826
-
827
-
828
-
829
-
830
-
831
-
832
-
833
-
834
-
835
-
836
-
837
-
838
-
839
-
840
-
841
-
842
-
843
-
844
-
845
-
846
-
847
-
848
-
849
-
850
-
851
-
852
-
853
-
854
-
855
-
856
-
857
-
858
-
859
-
860
-
861
-
862
-
863
-
864
-
865
-
866
-
867
-
868
-
869
-
870
-
871
-
872
-
873
-
874
-
875
-
876
-
877
-
878
-
879
-
880
-
881
-
882
-
883
-
884
-
885
-
886
-
887
-
888
-
889
-
890
-
891
-
892
-
893
-
894
-
895
-
896
-
897
-
898
-
899
-
900
-
901
-
902
-
903
-- Copyright 2026 Shota FUJI
--
-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at https://mozilla.org/MPL/2.0/.
--
-- SPDX-License-Identifier: MPL-2.0
module Template.Cuts exposing (cuts)
import Length exposing (Length, toMM)
import Parameters exposing (LoopStyle(..), Parameters)
import Parameters.Key exposing (Key(..))
import Svg exposing (..)
import Svg.Attributes exposing (..)
import Svg.Path as Path exposing (..)
import Template.Layout.Container as Container exposing (aligned, columns, gapped, noGrow, padded, rows, sized)
import Template.Layout.Coordinate exposing (Request(..))
import Template.Layout.Item exposing (Item)
highlightStroke : Bool -> Svg.Attribute msg
highlightStroke enabled =
if enabled then
class "highlight-stroke"
else
class "highlight-none"
cuts : Parameters -> Maybe Key -> Item msg
cuts params highlighting =
-- TODO: Pack items more smartly, so it won't push infoArea out
rows
|> sized (AtLeast 0) (AtLeast 0)
|> aligned Container.Start
|> padded (toMM params.rendering.gap / 2)
|> gapped (toMM params.rendering.gap)
|> Container.build
([ columns
|> gapped (toMM params.rendering.gap)
|> Container.build
([ surfacePieces params highlighting
, linings params highlighting
]
|> List.map noGrow
)
|> Just
, loops params highlighting
]
|> List.filterMap identity
|> List.map noGrow
)
surfacePieces : Parameters -> Maybe Key -> Item msg
surfacePieces params highlighting =
rows
|> aligned Container.Center
|> gapped (toMM params.rendering.gap / 2)
|> Container.build
[ Item
{ width = Exactly 50, height = Exactly 5 }
(\p size ->
text_
[ x (String.fromFloat (p.x + size.width / 2))
, y (String.fromFloat p.y)
, fontSize "5"
, fontWeight "100"
, textAnchor "middle"
, dominantBaseline "hanging"
, fill "currentColor"
]
[ text ("Surfaces / t = " ++ (toMM params.thickness |> String.fromFloat) ++ "mm") ]
)
, columns
|> gapped (toMM params.rendering.gap)
|> Container.build
[ longPiece params highlighting, shortPiece params highlighting ]
]
skivingSeamStroke : Parameters -> List (Svg.Attribute msg)
skivingSeamStroke params =
[ fill "none"
, stroke "currentColor"
, strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
, strokeDasharray "1 0.5"
]
longPieceShape : ( Float, Float ) -> Parameters -> Maybe Key -> List Path.PathCommand -> Svg msg
longPieceShape ( x, y ) params highlighting commands =
let
lugWidth =
toMM params.lugWidth
length =
toMM params.longPiece.length
taperUntil =
Basics.min
(toMM params.longPiece.buckleHole.offset - toMM params.longPiece.buckleHole.interval)
(length / 2)
taper =
toMM params.taper
buckleWidth =
lugWidth - taper
in
Svg.path
[ Path.d
(MoveTo Absolute ( x, y )
:: CubicBezierCurve Relative
( ( taper / 2, taperUntil )
, ( taper / 2, taperUntil )
, ( taper / 2, length - buckleWidth / 2 )
)
[]
:: EllipticalArcCurve Relative
{ rx = buckleWidth / 2
, ry = buckleWidth / 2
, angle = 0.0
, largeArcFlag = LargeArc
, sweepFlag = Counterclockwise
, x = buckleWidth
, y = 0
}
[]
:: CubicBezierCurve Absolute
( ( x + lugWidth - taper / 2, y + taperUntil )
, ( x + lugWidth - taper / 2, y + taperUntil )
, ( x + lugWidth, y )
)
[]
:: commands
)
, fill "none"
, stroke "currentColor"
, strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
, highlightStroke
(highlighting
== Just LongPieceLength
|| highlighting
== Just LugWidth
|| highlighting
== Just Taper
|| (toMM params.taper
> 0
&& (highlighting
== Just BuckleHoleOffset
|| highlighting
== Just BuckleHoleInterval
)
)
)
]
[]
longPiece : Parameters -> Maybe Key -> Item msg
longPiece params highlighting =
let
lugWidth =
toMM params.lugWidth
length =
toMM params.longPiece.length
flap =
toMM params.longPiece.flap
in
{ size = { width = Exactly lugWidth, height = Exactly (length + flap) }
, element =
\p _ ->
g
[]
(longPieceShape
( p.x, p.y + flap )
params
highlighting
[ VerticalLineTo Relative -flap
, HorizontalLineTo Relative -lugWidth
, VerticalLineTo Relative flap
, ClosePath
]
:: Svg.path
(Path.d
[ MoveTo Absolute ( p.x, p.y + flap )
, HorizontalLineTo Relative lugWidth
]
:: skivingSeamStroke params
)
[]
:: Svg.path
[ Path.d
[ MoveTo Absolute ( p.x, p.y )
, HorizontalLineTo Relative lugWidth
, VerticalLineTo Relative flap
, HorizontalLineTo Relative -lugWidth
, ClosePath
]
, fill "url(#SkivingPattern)"
]
[]
:: (List.range 0 (params.longPiece.buckleHole.count - 1)
|> List.map
(\index ->
let
{ buckleHole } =
params.longPiece
offset =
toMM buckleHole.offset
interval =
toMM buckleHole.interval
in
hole
params
buckleHole.diameter
( p.x + lugWidth / 2
, p.y + offset + interval * toFloat index
)
[ highlightStroke
(highlighting
== Just BuckleHoleDiameter
|| highlighting
== Just BuckleHoleCount
|| highlighting
== Just BuckleHoleInterval
|| highlighting
== Just BuckleHoleOffset
)
]
)
)
)
}
hole : Parameters -> Length -> ( Float, Float ) -> List (Svg.Attribute msg) -> Svg msg
hole params diameter ( cx, cy ) attrs =
let
radius =
toMM diameter / 2
in
g
[]
[ circle
(Svg.Attributes.cx (String.fromFloat cx)
:: Svg.Attributes.cy (String.fromFloat cy)
:: r (String.fromFloat radius)
:: fill "none"
:: stroke "currentColor"
:: strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
:: attrs
)
[]
, g
[ fill "none"
, stroke "currentColor"
, strokeWidth "0.1"
]
[ Svg.path
[ Path.d
[ MoveTo Absolute ( cx - radius / 2, cy )
, HorizontalLineTo Relative radius
]
]
[]
, Svg.path
[ Path.d
[ MoveTo Absolute ( cx, cy - radius / 2 )
, VerticalLineTo Relative radius
]
]
[]
]
]
type alias ShortPieceOptions =
{ includeCaseSideFlap : Bool
, includeClaspSideFlap : Bool
, at : ( Float, Float )
}
shortPieceShape : Parameters -> Maybe Key -> ShortPieceOptions -> Svg msg
shortPieceShape params highlighting { includeCaseSideFlap, includeClaspSideFlap, at } =
let
lugWidth =
toMM params.lugWidth
length =
toMM params.shortPiece.length
taperUntil =
Basics.min
(toMM params.longPiece.buckleHole.offset - toMM params.longPiece.buckleHole.interval)
(length / 2)
taper =
toMM params.taper
( x, y ) =
at
in
Svg.path
[ Path.d
([ Just (MoveTo Absolute ( x, y ))
, if includeCaseSideFlap then
Just (VerticalLineTo Relative (toMM params.shortPiece.caseSideFlap))
else
Nothing
, Just
(CubicBezierCurve Relative
( ( taper / 2, taperUntil )
, ( taper / 2, taperUntil )
, ( taper / 2, length )
)
[]
)
, if includeClaspSideFlap then
Just (VerticalLineTo Relative (toMM params.shortPiece.claspSideFlap))
else
Nothing
, Just (HorizontalLineTo Relative (lugWidth - taper))
, if includeClaspSideFlap then
Just (VerticalLineTo Relative -(toMM params.shortPiece.claspSideFlap))
else
Nothing
, Just
(CubicBezierCurve Relative
( ( 0, -length + taperUntil )
, ( 0, -length + taperUntil )
, ( taper / 2, -length )
)
[]
)
, if includeCaseSideFlap then
Just (VerticalLineTo Relative -(toMM params.shortPiece.caseSideFlap))
else
Nothing
, Just ClosePath
]
|> List.filterMap identity
)
, fill "none"
, stroke "currentColor"
, strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
, highlightStroke
(highlighting
== Just ShortPieceLength
|| highlighting
== Just LugWidth
|| highlighting
== Just Taper
|| (toMM params.taper
> 0
&& (highlighting
== Just BuckleHoleOffset
|| highlighting
== Just BuckleHoleInterval
)
)
)
]
[]
shortPiece : Parameters -> Maybe Key -> Item msg
shortPiece params highlighting =
let
lugWidth =
toMM params.lugWidth
taper =
toMM params.taper
buckleWidth =
lugWidth - taper
length =
toMM params.shortPiece.length
caseSideFlap =
toMM params.shortPiece.caseSideFlap
claspSideFlap =
toMM params.shortPiece.claspSideFlap
in
{ size =
{ width = Exactly lugWidth, height = Exactly (length + caseSideFlap + claspSideFlap) }
, element =
\p _ ->
g
[]
[ shortPieceShape params
highlighting
{ includeCaseSideFlap = True
, includeClaspSideFlap = True
, at = ( p.x, p.y )
}
, g
(skivingSeamStroke params)
[ Svg.path
[ Path.d
[ MoveTo Absolute ( p.x, p.y + caseSideFlap )
, HorizontalLineTo Relative lugWidth
]
]
[]
, Svg.path
[ Path.d
[ MoveTo Absolute ( p.x + taper / 2, p.y + caseSideFlap + length )
, HorizontalLineTo Relative buckleWidth
]
]
[]
]
, g
[ fill "url(#SkivingPattern)" ]
[ Svg.path
[ Path.d
[ MoveTo Absolute ( p.x, p.y )
, HorizontalLineTo Relative lugWidth
, VerticalLineTo Relative caseSideFlap
, HorizontalLineTo Relative -lugWidth
, ClosePath
]
]
[]
, Svg.path
[ Path.d
[ MoveTo Absolute ( p.x + taper / 2, p.y + caseSideFlap + length )
, HorizontalLineTo Relative buckleWidth
, VerticalLineTo Relative claspSideFlap
, HorizontalLineTo Relative -buckleWidth
, ClosePath
]
]
[]
]
]
}
linings : Parameters -> Maybe Key -> Item msg
linings params highlighting =
rows
|> aligned Container.Center
|> gapped (toMM params.rendering.gap / 2)
|> Container.build
[ Item
{ width = Exactly 50, height = Exactly 5 }
(\p size ->
text_
[ x (String.fromFloat (p.x + size.width / 2))
, y (String.fromFloat p.y)
, fontSize "5"
, fontWeight "100"
, textAnchor "middle"
, dominantBaseline "hanging"
, fill "currentColor"
]
[ text ("Linings / t = " ++ (toMM params.lining |> String.fromFloat) ++ "mm") ]
)
, columns
|> gapped (toMM params.rendering.gap)
|> Container.build
[ longLining params highlighting, shortLining params highlighting ]
]
longLining : Parameters -> Maybe Key -> Item msg
longLining params highlighting =
let
lugWidth =
toMM params.lugWidth
length =
toMM params.longPiece.length
in
{ size =
{ width = Exactly lugWidth, height = Exactly length }
, element =
\p _ ->
longPieceShape
( p.x, p.y )
params
highlighting
[ HorizontalLineTo Relative -lugWidth
, ClosePath
]
}
shortLining : Parameters -> Maybe Key -> Item msg
shortLining params highlighting =
let
lugWidth =
toMM params.lugWidth
length =
toMM params.shortPiece.length
in
{ size =
{ width = Exactly lugWidth, height = Exactly length }
, element =
\p _ ->
shortPieceShape params
highlighting
{ at = ( p.x, p.y )
, includeCaseSideFlap = False
, includeClaspSideFlap = False
}
}
loops : Parameters -> Maybe Key -> Maybe (Item msg)
loops params highlighting =
let
root =
params.shortPiece.loops
in
case ( root.fixed, root.free ) of
( Nothing, Nothing ) ->
Nothing
_ ->
rows
|> aligned Container.Center
|> gapped (toMM params.rendering.gap / 2)
|> Container.build
[ Item
{ width = Exactly 40, height = Exactly 5 }
(\p size ->
text_
[ x (String.fromFloat (p.x + size.width / 2))
, y (String.fromFloat p.y)
, fontSize "5"
, fontWeight "100"
, textAnchor "middle"
, dominantBaseline "hanging"
, fill "currentColor"
]
[ text ("Loops / t = " ++ (toMM root.thickness |> String.fromFloat) ++ "mm") ]
)
, columns
|> gapped (toMM params.rendering.gap)
|> Container.build
([ fixedLoop params highlighting
, freeLoop params highlighting
]
|> List.filterMap identity
)
]
|> Just
fixedLoop : Parameters -> Maybe Key -> Maybe (Item msg)
fixedLoop params highlighting =
Maybe.map
(\{ width, play } ->
let
strapThickness =
toMM params.thickness + toMM params.lining
lugWidth =
toMM params.lugWidth
length =
lugWidth * 2 + strapThickness * 2 + toMM play
in
{ size =
{ width = Exactly length
, height =
Exactly
(case params.shortPiece.loops.style of
Simple ->
toMM width
Folded ->
toMM width * 2
)
}
, element =
\p size ->
let
hCutLine : Float -> Svg msg
hCutLine yOffset =
g
[ fill "none"
, stroke "currentColor"
, strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
]
[ Svg.path
[ Path.d
[ MoveTo Absolute ( p.x, p.y + yOffset )
, HorizontalLineTo Relative lugWidth
]
, highlightStroke (highlighting == Just LugWidth)
]
[]
, Svg.path
[ Path.d
[ MoveTo Absolute ( p.x + lugWidth, p.y + yOffset )
, HorizontalLineTo Relative strapThickness
]
, highlightStroke (highlighting == Just SurfaceThickness || highlighting == Just LiningThickness)
]
[]
, Svg.path
[ Path.d
[ MoveTo Absolute ( p.x + lugWidth + strapThickness, p.y + yOffset )
, HorizontalLineTo Relative lugWidth
]
, highlightStroke (highlighting == Just LugWidth)
]
[]
, Svg.path
[ Path.d
[ MoveTo Absolute ( p.x + lugWidth * 2 + strapThickness, p.y + yOffset )
, HorizontalLineTo Relative strapThickness
]
, highlightStroke (highlighting == Just SurfaceThickness || highlighting == Just LiningThickness)
]
[]
, Svg.path
[ Path.d
[ MoveTo Absolute ( p.x + lugWidth * 2 + strapThickness * 2, p.y + yOffset )
, HorizontalLineTo Relative (toMM play)
]
, highlightStroke (highlighting == Just FixedLoopPlay)
]
[]
]
in
g
[]
[ hCutLine 0
, hCutLine size.height
, case params.shortPiece.loops.style of
Simple ->
g
[ fill "none"
, stroke "currentColor"
, strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
]
[ Svg.path
[ Path.d
[ MoveTo Absolute ( p.x, p.y )
, VerticalLineTo Relative (toMM width)
]
, highlightStroke (highlighting == Just FixedLoopWidth)
]
[]
, Svg.path
[ Path.d
[ MoveTo Absolute ( p.x + length, p.y )
, VerticalLineTo Relative (toMM width)
]
, highlightStroke (highlighting == Just FixedLoopWidth)
]
[]
]
Folded ->
g
[]
[ g
[ fill "none"
, stroke "currentColor"
, strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
, strokeDasharray "1 0.5"
]
[ Svg.path
[ Path.d
[ MoveTo Absolute ( p.x, p.y + toMM width / 2 )
, HorizontalLineTo Relative length
]
]
[]
, Svg.path
[ Path.d
[ MoveTo Absolute ( p.x, p.y + toMM width * 1.5 )
, HorizontalLineTo Relative length
]
]
[]
]
, g
[ fill "none"
, stroke "currentColor"
, strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
]
[ Svg.path
[ Path.d
[ MoveTo Absolute ( p.x, p.y )
, VerticalLineTo Relative (toMM width * 2)
]
, highlightStroke (highlighting == Just FixedLoopWidth)
]
[]
, Svg.path
[ Path.d
[ MoveTo Absolute ( p.x + length, p.y )
, VerticalLineTo Relative (toMM width * 2)
]
, highlightStroke (highlighting == Just FixedLoopWidth)
]
[]
]
]
]
}
)
params.shortPiece.loops.fixed
freeLoop : Parameters -> Maybe Key -> Maybe (Item msg)
freeLoop params highlighting =
Maybe.map
(\{ width, play, overlap } ->
let
strapThickness =
toMM params.thickness + toMM params.lining
lugWidth =
toMM params.lugWidth
length =
lugWidth * 2 + strapThickness * 2 + toMM play + toMM overlap
materialWidth =
case params.shortPiece.loops.style of
Simple ->
toMM width
Folded ->
toMM width * 2
in
{ size =
{ width = Exactly length, height = Exactly materialWidth }
, element =
\p _ ->
let
hCutLine : Float -> Svg msg
hCutLine yOffset =
g
[ fill "none"
, stroke "currentColor"
, strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
]
[ Svg.path
[ Path.d
[ MoveTo Absolute ( p.x, p.y + yOffset )
, HorizontalLineTo Relative lugWidth
]
, highlightStroke (highlighting == Just LugWidth)
]
[]
, Svg.path
[ Path.d
[ MoveTo Absolute ( p.x + lugWidth, p.y + yOffset )
, HorizontalLineTo Relative strapThickness
]
, highlightStroke (highlighting == Just SurfaceThickness || highlighting == Just LiningThickness)
]
[]
, Svg.path
[ Path.d
[ MoveTo Absolute ( p.x + lugWidth + strapThickness, p.y + yOffset )
, HorizontalLineTo Relative lugWidth
]
, highlightStroke (highlighting == Just LugWidth)
]
[]
, Svg.path
[ Path.d
[ MoveTo Absolute ( p.x + lugWidth * 2 + strapThickness, p.y + yOffset )
, HorizontalLineTo Relative strapThickness
]
, highlightStroke (highlighting == Just SurfaceThickness || highlighting == Just LiningThickness)
]
[]
, Svg.path
[ Path.d
[ MoveTo Absolute ( p.x + lugWidth * 2 + strapThickness * 2, p.y + yOffset )
, HorizontalLineTo Relative (toMM play)
]
, highlightStroke (highlighting == Just FreeLoopPlay)
]
[]
, Svg.path
[ Path.d
[ MoveTo Absolute ( p.x + lugWidth * 2 + strapThickness * 2 + toMM play, p.y + yOffset )
, HorizontalLineTo Relative (toMM overlap)
]
, highlightStroke (highlighting == Just FreeLoopOverlap)
]
[]
]
in
g
[]
[ hCutLine 0
, hCutLine materialWidth
, Svg.path
[ Path.d
[ MoveTo Absolute ( p.x + length - toMM overlap, p.y )
, VerticalLineTo Relative materialWidth
]
, fill "none"
, stroke "currentColor"
, strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
, strokeDasharray "1 0.5"
]
[]
, case params.shortPiece.loops.style of
Simple ->
g
[ fill "none"
, stroke "currentColor"
, strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
]
[ Svg.path
[ Path.d
[ MoveTo Absolute ( p.x, p.y )
, VerticalLineTo Relative (toMM width)
]
, highlightStroke (highlighting == Just FreeLoopWidth)
]
[]
, Svg.path
[ Path.d
[ MoveTo Absolute ( p.x + length, p.y )
, VerticalLineTo Relative (toMM width)
]
, highlightStroke (highlighting == Just FreeLoopWidth)
]
[]
]
Folded ->
g
[]
[ g
[ fill "none"
, stroke "currentColor"
, strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
, strokeDasharray "1 0.5"
]
[ Svg.path
[ Path.d
[ MoveTo Absolute ( p.x, p.y + toMM width / 2 )
, HorizontalLineTo Relative length
]
]
[]
, Svg.path
[ Path.d
[ MoveTo Absolute ( p.x, p.y + toMM width * 1.5 )
, HorizontalLineTo Relative length
]
]
[]
]
, g
[ fill "none"
, stroke "currentColor"
, strokeWidth (toMM params.rendering.lineWidth |> String.fromFloat)
]
[ Svg.path
[ Path.d
[ MoveTo Absolute ( p.x, p.y )
, VerticalLineTo Relative (toMM width * 2)
]
, highlightStroke (highlighting == Just FreeLoopWidth)
]
[]
, Svg.path
[ Path.d
[ MoveTo Absolute ( p.x + length, p.y )
, VerticalLineTo Relative (toMM width * 2)
]
, highlightStroke (highlighting == Just FreeLoopWidth)
]
[]
]
]
]
}
)
params.shortPiece.loops.free