Skip to content

Instantly share code, notes, and snippets.

@toomasv
Last active October 26, 2017 17:48
Show Gist options
  • Save toomasv/918853e224591997ce857f306ac71936 to your computer and use it in GitHub Desktop.
Save toomasv/918853e224591997ce857f306ac71936 to your computer and use it in GitHub Desktop.
Red [
Author: "Toomas Vooglaid"
Date: 2017-10-24
Needs: View
]
context [
system/view/auto-sync?: dragable?: off-the-post?: no
offset: pos-x: post: current-post: post1: post2: post3: disc: disc1: disc2: disc3: disc4: steps: thickness: none
post1-narrow: charset [ 48 - 52]
post2-narrow: charset [148 - 152]
post3-narrow: charset [248 - 252]
post1-wide: charset [ 0 - 100]
post2-wide: charset [101 - 200]
post3-wide: charset [201 - 300]
posts: union union post1-wide post2-wide post3-wide
target: none
detach: func [f][remove select f/data 'data]
attach: func [face post][
unless empty? post/data [
if post/data/1/size/x < face/size/x [attach face current-post return none]
]
y: either empty? post/data [184][(pick select first post/data 'offset 2) - 16]
face/offset: to-pair reduce [post/offset/x + 5 - (face/size/x / 2) y]
do [show face]
insert post/data face
face/data: post
]
let-go: func [face][
case [
find post1-wide pos-x [attach face post1]
find post2-wide pos-x [attach face post2]
find post3-wide pos-x [attach face post3]
]
]
constrain: func [face post][
face/offset/x: post/offset/x + 5 - (face/size/x / 2)
unless empty? post/data [face/offset/y: min face/offset/y post/data/1/offset/y - 16]
off-the-post?: no
]
view [
size 300x240
style post: box 10x100 data copy []
draw [fill-pen linear 50.50.50 150.150.150 0.2 50.50.50 0.6 black 1.0 box 0x0 10x100]
on-down [
either target = face [
face/draw: [fill-pen linear 50.50.50 150.150.150 0.2 50.50.50 0.6 black 1.0 box 0x0 10x100]
target: none
][
if target [
target/draw: [fill-pen linear 50.50.50 150.150.150 0.2 50.50.50 0.6 black 1.0 box 0x0 10x100]
show target
]
face/draw: [fill-pen linear brick 250.100.100 0.2 brick 0.6 100.0.0 1.0 box 0x0 10x100]
target: face
]
show face
]
style disc: box loose
on-drag-start [
current-post: face/data
offset: face/offset
if face = first current-post/data [
dragable?: yes
detach face
pos-x: face/offset/x + (face/size/x / 2)
]
]
on-drag [
either dragable? [
face/offset: max 0x0 min (300x200 - face/size) face/offset
either (face/offset/y + 16) < 100 [
pos-x: face/offset/x + (face/size/x / 2)
off-the-post?: yes
][
if off-the-post? [pos-x: face/offset/x + (face/size/x / 2)]
case [
find post1-narrow pos-x [constrain face post1]
find post2-narrow pos-x [constrain face post2]
find post3-narrow pos-x [constrain face post3]
true [face/offset/y: 84]
]
]
][face/offset: offset]
]
on-drop [
if dragable? [
let-go face
dragable?: no
steps/data: steps/data + 1
show steps
]
]
button "Restore" [
foreach disc reduce [disc1 disc2 disc3 disc4 disc5][detach disc]
foreach disc reduce [disc1 disc2 disc3 disc4 disc5][attach disc post1]
steps/data: 0 show steps
]
button "Random" [
foreach disc reduce [disc1 disc2 disc3 disc4 disc5][detach disc]
foreach disc reduce [disc1 disc2 disc3 disc4 disc5][attach disc get pick [post1 post2 post3] random 3]
steps/data: 0 show steps
]
at 200x10 text "Steps:" 40x24 center
at 245x10 steps: field 25x24 data 0 disabled
at 0x40 panel [
at 0x0 image 300x200
at 45x100 post1: post
at 145x100 post2: post
at 245x100 post3: post
at 3x184 disc1: disc 94x16 data post1 draw [
fill-pen linear brown 250.200.100 0.2 brown 0.6 80.10.0 1.0
box 0x0 94x16
]
at 11x168 disc2: disc 78x16 data post1 draw [
fill-pen linear brown 250.200.100 0.2 brown 0.6 80.10.0 1.0
box 0x0 78x16
]
at 19x152 disc3: disc 62x16 data post1 draw [
fill-pen linear brown 250.200.100 0.2 brown 0.6 80.10.0 1.0
box 0x0 62x16
]
at 27x136 disc4: disc 46x16 data post1 draw [
fill-pen linear brown 250.200.100 0.2 brown 0.6 80.10.0 1.0
box 0x0 46x16
]
at 35x120 disc5: disc 30x16 data post1 draw [
fill-pen linear brown 250.200.100 0.2 brown 0.6 80.10.0 1.0
box 0x0 30x16
]
do [post1/data: reduce [disc5 disc4 disc3 disc2 disc1]]
]
]
]
@toomasv
Copy link
Author

toomasv commented Oct 24, 2017

24.10 2017 Updated it to 5 discs and with better look.
26.10.2017 Added button "Random" to randomize configuration and ability to mark target peg by clicking on it.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment