Last active
November 7, 2018 15:31
-
-
Save toomasv/d687889418ebb3c21c03e1745bbbb47f to your computer and use it in GitHub Desktop.
Study of stick behavior
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Red [ | |
Author: {Toomas Vooglaid} | |
Date: 2018-11-07 | |
Purpose: {Study of stick} | |
] | |
pos: joint: bone: len: none | |
sel: "Move:" | |
mode: "Mode-1" | |
movs: make block! 20 | |
distance: func [a b][sqrt (power b/1 - a/1 2) + (power b/2 - a/2 2)] | |
between: func [p1 p2 e][] | |
rise: 6 | |
between?: function [line-start line-end point distance][ | |
offset-line: line-end - line-start | |
offset-point: point - line-start | |
angle-line: arctangent2 offset-line/y offset-line/x | |
angle-point: arctangent2 offset-point/y offset-point/x | |
angle: angle-point - angle-line | |
length-line: sqrt (offset-line/x ** 2) + (offset-line/y ** 2) | |
length-hypotenuse: sqrt (offset-point/x ** 2) + (offset-point/y ** 2) | |
length-opposite-side: absolute angle * length-hypotenuse | |
length-adjacent-side: sqrt (length-hypotenuse ** 2) - (length-opposite-side ** 2) | |
all [length-adjacent-side >= 0 length-adjacent-side <= length-line length-opposite-side <= distance] | |
] | |
get-point: function [diff [pair!]][ | |
angle: arctangent2 diff/y diff/x | |
x: len * cos angle | |
y: len * sin angle | |
as-pair x y | |
] | |
avg-pairs: function [ | |
"Calculate average of coordinates in block" | |
pairs [block!] | |
][ | |
len: length? pairs | |
x: y: 0 | |
forall pairs [ | |
x: x + pairs/1/x | |
y: y + pairs/1/y | |
] | |
as-pair 1.0 * x / len 1.0 * y / len | |
] | |
sum-pairs: function [ | |
"Calculate sum of coordinates in block" | |
pairs [block!] | |
][ | |
pair: 0x0 | |
forall pairs [pair: pair + pairs/1] | |
] | |
view [ | |
title "Study of stick" | |
style rad: radio [if face/data [sel: face/text]] | |
style md: radio [if face/data [mode: face/text]] | |
at 10x10 rad "Rotate" | |
at 100x10 rad "Length" | |
at 190x10 rad "Move:" data true | |
at 280x10 pan: panel white [origin 10x0 md "Mode-1" data true md "Mode-2" md "Mode-3" md "Mode-4"] | |
bx: box 800x500 draw [ | |
fill1: fill-pen 0.0.0.254 | |
pen silver | |
c4: circle 700x150 25 | |
c3: circle 700x150 15 | |
fill2: fill-pen 0.0.0.200 | |
c2: circle 700x150 5 | |
pen black | |
c1: circle 700x150 1 | |
pen silver | |
line-width 5 | |
ground: line 0x500 800x500 | |
pen brown | |
fill-pen 0.0.0.254 | |
line-width 2 | |
bones_: [line 100x150 200x150] | |
joints_: [[circle 100x150 3][circle 200x150 3]] | |
] | |
on-down [ | |
pos: event/offset | |
forall joints [ | |
case [ | |
5 >= distance pos joints/1/2 [ | |
joint: index? joints | |
ref: switch joint [1 [2] 2 [1]] | |
switch mode [ | |
"Mode-3" [ | |
mov: 0 | |
clear movs | |
] | |
"Mode-4" [ | |
jn: bone-points/:joint | |
rf: bone-points/:ref | |
base-vec: rf - jn | |
base-ang: arctangent2 base-vec/y base-vec/x | |
] | |
] | |
] | |
all [ | |
1 < length? joints | |
between? joints/1/2 joints/2/2 pos 3 | |
][ | |
bone: index? joints | |
diff1: bone-points/:bone - pos | |
diff2: bone-points/(bone + 1) - pos | |
] | |
] | |
] | |
] | |
all-over | |
on-over [ | |
if all [pos event/down? any [joint bone]] [ | |
if joint [ | |
switch sel [ | |
"Rotate" [ | |
diff: event/offset - bone-points/:ref | |
point: get-point diff | |
bone-points/:joint: joints/:joint/2: bone-points/:ref + point | |
] | |
"Move:" [ | |
switch mode [ | |
"Mode-1" [ | |
diff: bone-points/:ref - event/offset | |
point: get-point diff | |
bone-points/:joint: joints/:joint/2: event/offset | |
bone-points/:ref: joints/:ref/2: bone-points/:joint + point | |
] | |
"Mode-2" [ | |
vec1: bone-points/:ref - bone-points/:joint ; initial bone-vec | |
ang1: arctangent2 vec1/y vec1/x ; its rise angle | |
vec2: event/offset - bone-points/:joint ; change vec of active joint (end)) | |
ang2: arctangent2 vec2/y vec2/x ; its rise angle | |
ang3: ang1 - ang2 ; summary angle of two previous | |
len2: distance bone-points/:joint event/offset ; length of change vec | |
ang4: asin ((sin ang3) / len * len2) ; sine-theorem | |
ang5: pi - ang3 - ang4 ; sum of inner angles | |
len3: sqrt ((len2 * len2) + (len * len) - (2 * len2 * len * cos ang5)) ; cosine-theorem ; length of segment of initial vec to new ref-point | |
x: len3 * cos ang1 ; x-coord of new ref-vec | |
y: len3 * sin ang1 ; y-coord of new ref-vec | |
ref-vec: as-pair x y ; new ref-vec | |
bone-points/:ref: joints/:ref/2: bone-points/:joint + ref-vec ; new ref-point | |
bone-points/:joint: joints/:joint/2: event/offset ; new joint-point | |
] | |
"Mode-3" [ | |
mov: mov + 1 | |
either mov <= 30 [ | |
append movs bone-points/:joint - event/offset | |
][ | |
append remove movs bone-points/:joint - event/offset | |
] | |
diff: sum-pairs movs | |
point: get-point diff | |
bone-points/:joint: joints/:joint/2: event/offset | |
bone-points/:ref: joints/:ref/2: bone-points/:joint + point | |
] | |
"Mode-4" [ | |
either (ground/2/y - rise - event/offset/y) >= len [ | |
bone-points/:joint: joints/:joint/2: event/offset | |
bone-points/:ref: joints/:ref/2: event/offset + as-pair 0 len | |
][ | |
;print ["Ref: " bone-points/:ref "Joint: " bone-points/:joint "Ofs-y: " event/offset/y event/offset/y + rise "Ground-y: " ground/2/y] | |
if event/offset/x <> bone-points/:ref/x [ | |
y: either event/offset/y + rise > ground/2/y [ | |
bone-points/:joint: joints/:joint/2: as-pair event/offset/x ground/2/y - rise | |
0 | |
][ | |
bone-points/:joint: joints/:joint/2: event/offset | |
ground/2/y - rise - event/offset/y | |
] | |
x: either y = 0 [len][len * sin acos 1.0 * y / len] | |
if bone-points/:ref/x < event/offset/x [x: negate x] | |
ref-vec: as-pair x y | |
bone-points/:ref: joints/:ref/2: bone-points/:joint + ref-vec | |
] | |
] | |
] | |
] | |
case [ | |
bone-points/:ref = c1/2 [fill2/2: 250.0.0 wait 0.5 fill1/2: 250.250.0] | |
c4/3 < distance bone-points/:ref c1/2 [fill2/2: 0.0.0.200 fill1/2: 0.0.0.254] | |
] | |
] | |
"Length" [ | |
bone-points/:joint: joints/:joint/2: event/offset | |
len: distance bone-points/1 bone-points/2 | |
] | |
] | |
] | |
if bone [ | |
bone-points/:bone: joints/:bone/2: event/offset + diff1 | |
bone-points/(bone + 1): joints/(bone + 1)/2: event/offset + diff2 | |
] | |
] | |
] | |
on-up [pos: joint: bone: none] | |
on-dbl-click [ | |
forall joints [ | |
case [ | |
5 >= distance pos joints/1/2 [ | |
joint: index? joints | |
ref: switch joint [1 [2] 2 [1]] | |
] | |
] | |
] | |
foreach-face/with face/parent [ | |
me: face | |
face/data: true | |
either face/parent/type = 'window [ | |
sel: face/text | |
][ | |
mode: face/text | |
] | |
foreach fc face/parent/pane [ | |
all [ | |
fc/type = 'radio | |
me <> fc | |
fc/data: false | |
] | |
] | |
][ | |
all [ | |
face/type = 'radio | |
ofs: either face/parent/type = 'panel [face/parent/offset + face/offset][face/offset] | |
within? bone-points/:ref + 10 ofs face/size | |
not face/data | |
] | |
] | |
] | |
do [ | |
bones: bones_/1 | |
joints: joints_/1 | |
bone-points: next bones | |
len: distance bone-points/1 bone-points/2 | |
] | |
] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment