Skip to content

Instantly share code, notes, and snippets.

@toomasv
Last active November 7, 2018 15:31
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save toomasv/d687889418ebb3c21c03e1745bbbb47f to your computer and use it in GitHub Desktop.
Save toomasv/d687889418ebb3c21c03e1745bbbb47f to your computer and use it in GitHub Desktop.
Study of stick behavior
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