Add springies

extra/springies/models/2snake/2snake.factor

@@ -0,0 +1,123 @@
+
+USING: kernel namespaces arrays sequences math math.vectors random
+       springies springies.ui ;
+
+IN: springies.models.2snake
+
+: model ( -- )
+
+{ } clone >nodes
+{ } clone >springs
+0.001 >time-slice
+gravity off
+
+1 19.0 328.0 0.0 0.0 1.0 1.0 mass
+2 36.0 328.0 0.0 0.0 1.0 1.0 mass
+3 54.0 328.0 0.0 0.0 1.0 1.0 mass
+4 72.0 328.0 0.0 0.0 1.0 1.0 mass
+5 90.0 328.0 0.0 0.0 1.0 1.0 mass
+6 108.0 328.0 0.0 0.0 1.0 1.0 mass
+7 126.0 328.0 0.0 0.0 1.0 1.0 mass
+8 144.0 328.0 0.0 0.0 1.0 1.0 mass
+9 162.0 328.0 0.0 0.0 1.0 1.0 mass
+10 180.0 328.0 0.0 0.0 1.0 1.0 mass
+11 198.0 328.0 0.0 0.0 1.0 1.0 mass
+12 216.0 328.0 0.0 0.0 1.0 1.0 mass
+13 234.0 328.0 0.0 0.0 1.0 1.0 mass
+14 252.0 328.0 0.0 0.0 1.0 1.0 mass
+15 270.0 328.0 0.0 0.0 1.0 1.0 mass
+16 288.0 328.0 0.0 0.0 1.0 1.0 mass
+17 306.0 328.0 0.0 0.0 1.0 1.0 mass
+18 324.0 328.0 0.0 0.0 1.0 1.0 mass
+19 342.0 328.0 0.0 0.0 1.0 1.0 mass
+20 360.0 328.0 0.0 0.0 1.0 1.0 mass
+21 378.0 328.0 0.0 0.0 1.0 1.0 mass
+22 396.0 328.0 0.0 0.0 1.0 1.0 mass
+23 414.0 328.0 0.0 0.0 1.0 1.0 mass
+24 432.0 328.0 0.0 0.0 1.0 1.0 mass
+25 450.0 328.0 0.0 0.0 1.0 1.0 mass
+26 468.0 328.0 0.0 0.0 1.0 1.0 mass
+27 504.0 328.0 0.0 0.0 1.0 1.0 mass
+28 486.0 328.0 0.0 0.0 1.0 1.0 mass
+29 522.0 328.0 0.0 0.0 1.0 1.0 mass
+30 540.0 328.0 0.0 0.0 1.0 1.0 mass
+31 558.0 328.0 0.0 0.0 1.0 1.0 mass
+32 576.0 328.0 0.0 0.0 1.0 1.0 mass
+33 594.0 328.0 0.0 0.0 1.0 1.0 mass
+34 612.0 328.0 0.0 0.0 1.0 1.0 mass
+35 630.0 328.0 0.0 0.0 1.0 1.0 mass
+1 1 2 200.0 1.500000 18.0 spng
+2 3 2 200.0 1.500000 18.0 spng
+3 3 4 200.0 1.500000 18.0 spng
+4 4 5 200.0 1.500000 18.0 spng
+5 5 6 200.0 1.500000 18.0 spng
+6 6 7 200.0 1.500000 18.0 spng
+7 7 8 200.0 1.500000 18.0 spng
+8 8 9 200.0 1.500000 18.0 spng
+9 9 10 200.0 1.500000 18.0 spng
+10 10 11 200.0 1.500000 18.0 spng
+11 11 12 200.0 1.500000 18.0 spng
+12 12 13 200.0 1.500000 18.0 spng
+13 13 14 200.0 1.500000 18.0 spng
+14 14 15 200.0 1.500000 18.0 spng
+15 15 16 200.0 1.500000 18.0 spng
+16 16 17 200.0 1.500000 18.0 spng
+17 17 18 200.0 1.500000 18.0 spng
+18 18 19 200.0 1.500000 18.0 spng
+19 19 20 200.0 1.500000 18.0 spng
+20 20 21 200.0 1.500000 18.0 spng
+21 21 22 200.0 1.500000 18.0 spng
+22 22 23 200.0 1.500000 18.0 spng
+23 23 24 200.0 1.500000 18.0 spng
+24 24 25 200.0 1.500000 18.0 spng
+25 25 26 200.0 1.500000 18.0 spng
+26 26 28 200.0 1.500000 18.0 spng
+27 28 27 200.0 1.500000 18.0 spng
+28 27 29 200.0 1.500000 18.0 spng
+29 29 30 200.0 1.500000 18.0 spng
+30 30 31 200.0 1.500000 18.0 spng
+31 31 32 200.0 1.500000 18.0 spng
+32 32 33 200.0 1.500000 18.0 spng
+33 33 34 200.0 1.500000 18.0 spng
+34 34 35 200.0 1.500000 18.0 spng
+35 1 3 200.0 1.500000 36.0 spng
+36 2 4 200.0 1.500000 36.0 spng
+37 3 5 200.0 1.500000 36.0 spng
+38 4 6 200.0 1.500000 36.0 spng
+39 5 7 200.0 1.500000 36.0 spng
+40 6 8 200.0 1.500000 36.0 spng
+41 7 9 200.0 1.500000 36.0 spng
+42 8 10 200.0 1.500000 36.0 spng
+43 9 11 200.0 1.500000 36.0 spng
+44 10 12 200.0 1.500000 36.0 spng
+45 11 13 200.0 1.500000 36.0 spng
+46 12 14 200.0 1.500000 36.0 spng
+47 13 15 200.0 1.500000 36.0 spng
+48 14 16 200.0 1.500000 36.0 spng
+49 15 17 200.0 1.500000 36.0 spng
+50 16 18 200.0 1.500000 36.0 spng
+51 17 19 200.0 1.500000 36.0 spng
+52 18 20 200.0 1.500000 36.0 spng
+53 19 21 200.0 1.500000 36.0 spng
+54 20 22 200.0 1.500000 36.0 spng
+55 21 23 200.0 1.500000 36.0 spng
+56 22 24 200.0 1.500000 36.0 spng
+57 23 25 200.0 1.500000 36.0 spng
+58 24 26 200.0 1.500000 36.0 spng
+59 25 28 200.0 1.500000 36.0 spng
+60 26 27 200.0 1.500000 36.0 spng
+61 28 29 200.0 1.500000 36.0 spng
+62 27 30 200.0 1.500000 36.0 spng
+63 29 31 200.0 1.500000 36.0 spng
+64 30 32 200.0 1.500000 36.0 spng
+65 31 33 200.0 1.500000 36.0 spng
+66 32 34 200.0 1.500000 36.0 spng
+67 33 35 200.0 1.500000 36.0 spng
+
+nodes> [ 400 random -200 + 400 random -200 + 2array swap set-node-vel ] each ;
+
+USING: threads ui ;
+
+: go ( -- ) [ [ springies-window* 1000 sleep model ] with-scope ] with-ui ;
+
+MAIN: go

extra/springies/models/ball/ball.factor

@@ -0,0 +1,255 @@
+
+USING: kernel namespaces sequences springies springies.ui ;
+
+IN: springies.models.ball
+
+: model ( -- )
+
+{ } clone >nodes
+{ } clone >springs
+0.01 >time-slice
+gravity on
+
+1 325.191871 140.872641 40.832215 -5.301529 1.0 1.0 mass
+2 313.933994 149.011616 55.240875 5.026852 1.0 1.0 mass
+3 309.133386 162.523019 72.798059 5.594199 1.0 1.0 mass
+4 312.887152 176.436760 83.754277 -1.370025 1.0 1.0 mass
+5 321.660596 187.895952 91.634021 -8.308630 1.0 1.0 mass
+6 335.256132 192.503856 94.772924 -18.985044 1.0 1.0 mass
+7 348.254504 188.731936 92.657963 -29.982110 1.0 1.0 mass
+8 359.050972 180.780059 86.668616 -39.817638 1.0 1.0 mass
+9 363.685639 167.752177 76.554871 -47.987107 1.0 1.0 mass
+10 360.449954 154.092353 57.992242 -48.045772 1.0 1.0 mass
+11 352.201411 142.382665 41.200547 -39.924209 1.0 1.0 mass
+12 338.754859 137.460615 32.306364 -22.707784 1.0 1.0 mass
+13 312.911184 114.835962 8.342965 5.878311 1.0 1.0 mass
+14 290.521818 132.872407 33.212103 28.391710 1.0 1.0 mass
+15 281.048450 160.314206 66.319674 32.935324 1.0 1.0 mass
+16 287.450075 188.730522 93.898071 21.966741 1.0 1.0 mass
+17 305.987715 211.206959 112.571044 5.089593 1.0 1.0 mass
+18 333.289699 220.830317 121.166705 -17.204713 1.0 1.0 mass
+19 361.089678 214.901909 117.183695 -41.776506 1.0 1.0 mass
+20 382.690515 197.005784 101.789802 -63.980298 1.0 1.0 mass
+21 392.095364 170.108402 75.453780 -78.414351 1.0 1.0 mass
+22 386.286391 142.033621 41.812216 -77.402424 1.0 1.0 mass
+23 368.355658 119.326317 12.658676 -58.885262 1.0 1.0 mass
+24 341.159901 109.253775 -0.645459 -27.346079 1.0 1.0 mass
+25 300.792976 88.652764 -23.770230 17.788258 1.0 1.0 mass
+26 266.917041 116.942125 11.387083 52.603190 1.0 1.0 mass
+27 252.824303 157.992984 59.144863 62.163730 1.0 1.0 mass
+28 261.812599 201.245775 103.542171 47.141708 1.0 1.0 mass
+29 290.323965 234.792944 133.016945 18.136362 1.0 1.0 mass
+30 330.805232 249.331769 145.899409 -16.478401 1.0 1.0 mass
+31 373.715232 241.181453 141.068680 -55.103677 1.0 1.0 mass
+32 406.314817 213.217096 116.087430 -90.844012 1.0 1.0 mass
+33 420.647493 172.661774 73.304028 -110.880720 1.0 1.0 mass
+34 412.375908 129.697207 24.072484 -106.129512 1.0 1.0 mass
+35 384.555754 95.915740 -16.565355 -77.142380 1.0 1.0 mass
+36 344.134757 80.886540 -34.250916 -30.871105 1.0 1.0 mass
+37 288.774590 62.672780 -55.431084 28.821437 1.0 1.0 mass
+38 244.055965 100.457489 -9.756397 76.701354 1.0 1.0 mass
+39 224.574635 156.693148 53.845562 91.755892 1.0 1.0 mass
+40 235.856891 213.935639 112.462316 73.437061 1.0 1.0 mass
+41 273.697931 257.991035 152.320671 33.701056 1.0 1.0 mass
+42 329.129445 277.782400 170.727571 -15.899371 1.0 1.0 mass
+43 386.065290 267.474982 165.436658 -68.761273 1.0 1.0 mass
+44 429.946314 229.605765 132.087682 -116.795195 1.0 1.0 mass
+45 449.164590 174.189613 73.084826 -143.228528 1.0 1.0 mass
+46 438.674101 117.351918 9.340834 -136.225613 1.0 1.0 mass
+47 401.586435 72.955570 -42.523445 -98.317857 1.0 1.0 mass
+48 346.207804 52.561279 -67.447974 -34.980297 1.0 1.0 mass
+1 1 2 150.0 2.0 14.0 spng
+2 2 3 150.0 2.0 14.0 spng
+3 3 4 150.0 2.0 14.0 spng
+4 4 5 150.0 2.0 14.0 spng
+5 5 6 150.0 2.0 14.0 spng
+6 6 7 150.0 2.0 14.0 spng
+7 7 8 150.0 2.0 14.0 spng
+8 8 9 150.0 2.0 14.0 spng
+9 9 10 150.0 2.0 14.0 spng
+10 10 11 150.0 2.0 14.0 spng
+11 11 12 150.0 2.0 14.0 spng
+12 12 1 150.0 2.0 14.0 spng
+13 13 14 150.0 2.0 28.0 spng
+14 14 15 150.0 2.0 28.0 spng
+15 15 16 150.0 2.0 28.0 spng
+16 16 17 150.0 2.0 28.0 spng
+17 17 18 150.0 2.0 28.0 spng
+18 18 19 150.0 2.0 28.0 spng
+19 19 20 150.0 2.0 28.0 spng
+20 20 21 150.0 2.0 28.0 spng
+21 21 22 150.0 2.0 28.0 spng
+22 22 23 150.0 2.0 28.0 spng
+23 23 24 150.0 2.0 28.0 spng
+24 24 13 150.0 2.0 28.0 spng
+25 25 26 150.0 2.0 44.0 spng
+26 26 27 150.0 2.0 43.0 spng
+27 27 28 150.0 2.0 44.0 spng
+28 28 29 150.0 2.0 44.0 spng
+29 29 30 150.0 2.0 43.0 spng
+30 30 31 150.0 2.0 44.0 spng
+31 31 32 150.0 2.0 43.0 spng
+32 32 33 150.0 2.0 43.0 spng
+33 33 34 150.0 2.0 44.0 spng
+34 34 35 150.0 2.0 44.0 spng
+35 35 36 150.0 2.0 43.0 spng
+36 36 25 150.0 2.0 44.0 spng
+37 37 38 150.0 2.0 58.0 spng
+38 38 39 150.0 2.0 59.0 spng
+39 39 40 150.0 2.0 58.0 spng
+40 40 41 150.0 2.0 58.0 spng
+41 41 42 150.0 2.0 59.0 spng
+42 42 43 150.0 2.0 58.0 spng
+43 43 44 150.0 2.0 58.0 spng
+44 44 45 150.0 2.0 59.0 spng
+45 45 46 150.0 2.0 58.0 spng
+46 46 47 150.0 2.0 58.0 spng
+47 47 48 150.0 2.0 59.0 spng
+48 48 37 150.0 2.0 58.0 spng
+49 1 13 150.0 2.0 29.0 spng
+50 2 14 150.0 2.0 28.0 spng
+51 3 15 150.0 2.0 28.0 spng
+52 4 16 150.0 2.0 29.0 spng
+53 5 17 150.0 2.0 28.0 spng
+54 6 18 150.0 2.0 28.0 spng
+55 7 19 150.0 2.0 29.0 spng
+56 8 20 150.0 2.0 28.0 spng
+57 9 21 150.0 2.0 28.0 spng
+58 10 22 150.0 2.0 29.0 spng
+59 11 23 150.0 2.0 28.0 spng
+60 12 24 150.0 2.0 28.0 spng
+61 13 25 150.0 2.0 29.0 spng
+62 14 26 150.0 2.0 28.0 spng
+63 15 27 150.0 2.0 28.0 spng
+64 16 28 150.0 2.0 29.0 spng
+65 17 29 150.0 2.0 28.0 spng
+66 18 30 150.0 2.0 28.0 spng
+67 19 31 150.0 2.0 29.0 spng
+68 20 32 150.0 2.0 28.0 spng
+69 21 33 150.0 2.0 28.0 spng
+70 22 34 150.0 2.0 29.0 spng
+71 23 35 150.0 2.0 28.0 spng
+72 24 36 150.0 2.0 28.0 spng
+73 25 37 150.0 2.0 29.0 spng
+74 26 38 150.0 2.0 28.0 spng
+75 27 39 150.0 2.0 28.0 spng
+76 28 40 150.0 2.0 29.0 spng
+77 29 41 150.0 2.0 28.0 spng
+78 30 42 150.0 2.0 28.0 spng
+79 31 43 150.0 2.0 29.0 spng
+80 32 44 150.0 2.0 28.0 spng
+81 33 45 150.0 2.0 28.0 spng
+82 34 46 150.0 2.0 29.0 spng
+83 35 47 150.0 2.0 28.0 spng
+84 36 48 150.0 2.0 28.0 spng
+85 1 14 150.0 2.0 35.0 spng
+86 2 15 150.0 2.0 35.0 spng
+87 3 16 150.0 2.0 34.0 spng
+88 4 17 150.0 2.0 35.0 spng
+89 5 18 150.0 2.0 35.0 spng
+90 6 19 150.0 2.0 34.0 spng
+91 7 20 150.0 2.0 35.0 spng
+92 8 21 150.0 2.0 35.0 spng
+93 9 22 150.0 2.0 34.0 spng
+94 10 23 150.0 2.0 35.0 spng
+95 11 24 150.0 2.0 35.0 spng
+96 12 13 150.0 2.0 34.0 spng
+97 13 26 150.0 2.0 46.0 spng
+98 14 27 150.0 2.0 45.0 spng
+99 15 28 150.0 2.0 45.0 spng
+100 16 29 150.0 2.0 46.0 spng
+101 17 30 150.0 2.0 45.0 spng
+102 18 31 150.0 2.0 45.0 spng
+103 19 32 150.0 2.0 45.0 spng
+104 20 33 150.0 2.0 45.0 spng
+105 21 34 150.0 2.0 45.0 spng
+106 22 35 150.0 2.0 46.0 spng
+107 23 36 150.0 2.0 45.0 spng
+108 24 25 150.0 2.0 45.0 spng
+109 25 38 150.0 2.0 58.0 spng
+110 26 39 150.0 2.0 58.0 spng
+111 27 40 150.0 2.0 58.0 spng
+112 28 41 150.0 2.0 58.0 spng
+113 29 42 150.0 2.0 58.0 spng
+114 30 43 150.0 2.0 58.0 spng
+115 31 44 150.0 2.0 58.0 spng
+116 32 45 150.0 2.0 58.0 spng
+117 33 46 150.0 2.0 58.0 spng
+118 34 47 150.0 2.0 58.0 spng
+119 35 48 150.0 2.0 58.0 spng
+120 36 37 150.0 2.0 58.0 spng
+121 1 24 150.0 2.0 35.0 spng
+122 2 13 150.0 2.0 34.0 spng
+123 3 14 150.0 2.0 35.0 spng
+124 4 15 150.0 2.0 35.0 spng
+125 5 16 150.0 2.0 34.0 spng
+126 6 17 150.0 2.0 35.0 spng
+127 7 18 150.0 2.0 35.0 spng
+128 8 19 150.0 2.0 34.0 spng
+129 9 20 150.0 2.0 35.0 spng
+130 10 21 150.0 2.0 35.0 spng
+131 11 22 150.0 2.0 34.0 spng
+132 12 23 150.0 2.0 35.0 spng
+133 13 36 150.0 2.0 46.0 spng
+134 14 25 150.0 2.0 45.0 spng
+135 15 26 150.0 2.0 45.0 spng
+136 16 27 150.0 2.0 46.0 spng
+137 17 28 150.0 2.0 45.0 spng
+138 18 29 150.0 2.0 45.0 spng
+139 19 30 150.0 2.0 46.0 spng
+140 20 31 150.0 2.0 45.0 spng
+141 21 32 150.0 2.0 45.0 spng
+142 22 33 150.0 2.0 46.0 spng
+143 23 34 150.0 2.0 45.0 spng
+144 24 35 150.0 2.0 45.0 spng
+145 25 48 150.0 2.0 58.0 spng
+146 26 37 150.0 2.0 58.0 spng
+147 27 38 150.0 2.0 58.0 spng
+148 28 39 150.0 2.0 58.0 spng
+149 29 40 150.0 2.0 58.0 spng
+150 30 41 150.0 2.0 58.0 spng
+151 31 42 150.0 2.0 58.0 spng
+152 32 43 150.0 2.0 58.0 spng
+153 33 44 150.0 2.0 58.0 spng
+154 34 45 150.0 2.0 58.0 spng
+155 35 46 150.0 2.0 58.0 spng
+156 36 47 150.0 2.0 58.0 spng
+157 10 4 150.0 2.0 52.331631 spng
+158 7 1 150.0 2.0 52.436772 spng
+159 12 6 150.0 2.0 54.680698 spng
+160 5 11 150.0 2.0 54.589379 spng
+161 9 3 150.0 2.0 54.451569 spng
+162 2 8 150.0 2.0 54.482231 spng
+163 45 11 150.0 2.0 101.408150 spng
+164 46 12 150.0 2.0 101.542452 spng
+165 47 1 150.0 2.0 101.963064 spng
+166 48 2 150.0 2.0 101.517329 spng
+167 37 3 150.0 2.0 101.603694 spng
+168 38 4 150.0 2.0 102.014031 spng
+169 39 5 150.0 2.0 101.547660 spng
+170 40 6 150.0 2.0 101.573762 spng
+171 41 7 150.0 2.0 101.897300 spng
+172 42 8 150.0 2.0 101.497982 spng
+173 43 9 150.0 2.0 101.870594 spng
+174 44 10 150.0 2.0 102.043753 spng
+175 45 11 150.0 2.0 101.408150 spng
+176 46 8 150.0 2.0 101.548938 spng
+177 47 10 150.0 2.0 90.645939 spng
+178 48 10 150.0 2.0 101.952119 spng
+179 37 11 150.0 2.0 101.552352 spng
+180 38 12 150.0 2.0 101.491447 spng
+181 39 1 150.0 2.0 101.971524 spng
+182 40 2 150.0 2.0 101.587400 spng
+183 41 3 150.0 2.0 101.519279 spng
+184 42 4 150.0 2.0 101.976181 spng
+185 43 5 150.0 2.0 101.714570 spng
+186 44 6 150.0 2.0 101.388747 spng
+187 45 7 150.0 2.0 101.773286 spng
+
+nodes> [ { 0 100 } swap set-node-vel ] each ;
+
+USING: threads ui ;
+
+: go ( -- ) [ [ springies-window* 1000 sleep model ] with-scope ] with-ui ;
+
+MAIN: go

extra/springies/springies.factor

@@ -0,0 +1,246 @@
+
+USING: kernel combinators sequences arrays math math.vectors
+       combinators.lib shuffle vars ;
+
+IN: springies
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: scalar-projection ( a b -- n ) [ v. ] [ nip norm ] 2bi / ;
+
+: vector-projection ( a b -- vec )
+  [ nip normalize ] [ scalar-projection ] 2bi v*n ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+VAR: nodes
+VAR: springs
+VAR: time-slice
+VAR: world-size
+
+: world-width ( -- width ) world-size> first ;
+
+: world-height ( -- height ) world-size> second ;
+
+VAR: gravity
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! node
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+TUPLE: node mass elas pos vel force ;
+
+C: <node> node
+
+: >>pos ( node pos -- node ) over set-node-pos ;
+
+: >>vel ( node vel -- node ) over set-node-vel ;
+
+: pos-x ( node -- x ) node-pos first ;
+: pos-y ( node -- y ) node-pos second ;
+: vel-x ( node -- y ) node-vel first ;
+: vel-y ( node -- y ) node-vel second ;
+
+: >>pos-x ( node x -- node ) over node-pos set-first ;
+: >>pos-y ( node y -- node ) over node-pos set-second ;
+: >>vel-x ( node x -- node ) over node-vel set-first ;
+: >>vel-y ( node y -- node ) over node-vel set-second ;
+
+: apply-force ( node vec -- ) over node-force v+ swap set-node-force ;
+
+: reset-force ( node -- ) 0 0 2array swap set-node-force ;
+
+: node-id ( id -- node ) 1- nodes> nth ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! spring
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+TUPLE: spring rest-length k damp node-a node-b ;
+
+C: <spring> spring
+
+: end-points ( spring -- b-pos a-pos )
+  [ spring-node-b node-pos ] [ spring-node-a node-pos ] bi ;
+
+: spring-length ( spring -- length ) end-points v- norm ;
+
+: stretch-length ( spring -- length )
+  [ spring-length ] [ spring-rest-length ] bi - ;
+
+: dir ( spring -- vec ) end-points v- normalize ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Hooke
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! 
+! F = -kx
+! 
+! k :: spring constant
+! x :: distance stretched beyond rest length
+! 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: hooke-force-mag ( spring -- mag ) [ spring-k ] [ stretch-length ] bi * ;
+
+: hooke-force ( spring -- force ) [ dir ] [ hooke-force-mag ] bi v*n ;
+
+: hooke-forces ( spring -- a b ) hooke-force dup vneg ;
+
+: act-on-nodes-hooke ( spring -- )
+  [ spring-node-a ] [ spring-node-b ] [ ] tri hooke-forces swapd
+  apply-force
+  apply-force ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! damping
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! 
+! F = -bv
+! 
+! b :: Damping constant
+! v :: Velocity
+! 
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! : damping-force-a ( spring -- vec )
+!   [ spring-node-a node-vel ] [ spring-damp ] bi v*n vneg ;
+
+! : damping-force-b ( spring -- vec )
+!   [ spring-node-b node-vel ] [ spring-damp ] bi v*n vneg ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: relative-velocity-a ( spring -- vel )
+  [ spring-node-a node-vel ] [ spring-node-b node-vel ] bi v- ;
+
+: unit-vec-b->a ( spring -- vec )
+  [ spring-node-a node-pos ] [ spring-node-b node-pos ] bi v- ;
+
+: relative-velocity-along-spring-a ( spring -- vel )
+  [ relative-velocity-a ] [ unit-vec-b->a ] bi vector-projection ;
+
+: damping-force-a ( spring -- vec )
+  [ relative-velocity-along-spring-a ] [ spring-damp ] bi v*n vneg ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: relative-velocity-b ( spring -- vel )
+  [ spring-node-b node-vel ] [ spring-node-a node-vel ] bi v- ;
+
+: unit-vec-a->b ( spring -- vec )
+  [ spring-node-b node-pos ] [ spring-node-a node-pos ] bi v- ;
+
+: relative-velocity-along-spring-b ( spring -- vel )
+  [ relative-velocity-b ] [ unit-vec-a->b ] bi vector-projection ;
+
+: damping-force-b ( spring -- vec )
+  [ relative-velocity-along-spring-b ] [ spring-damp ] bi v*n vneg ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: act-on-nodes-damping ( spring -- )
+  dup
+  [ spring-node-a ] [ damping-force-a ] bi apply-force
+  [ spring-node-b ] [ damping-force-b ] bi apply-force ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: below? ( node -- ? ) pos-y 0 < ;
+
+: above? ( node -- ? ) pos-y world-height >= ;
+
+: beyond-left? ( node -- ? ) pos-x 0 < ; 
+
+: beyond-right? ( node -- ? ) pos-x world-width >= ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: bounce-top ( node -- )
+  world-height 1- >>pos-y
+  dup [ vel-y ] [ node-elas ] bi * neg >>vel-y
+  drop ;
+
+: bounce-bottom ( node -- )
+  0 >>pos-y
+  dup [ vel-y ] [ node-elas ] bi * neg >>vel-y
+  drop ;
+
+: bounce-left ( node -- )
+  0 >>pos-x
+  dup [ vel-x ] [ node-elas ] bi * neg >>vel-x
+  drop ;
+
+: bounce-right ( node -- )
+  world-width 1- >>pos-x
+  dup [ vel-x ] [ node-elas ] bi * neg >>vel-x
+  drop ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: handle-bounce ( node -- )
+  { { [ dup above? ]        [ bounce-top ] }
+    { [ dup below? ]        [ bounce-bottom ] }
+    { [ dup beyond-left? ]  [ bounce-left ] }
+    { [ dup beyond-right? ] [ bounce-right ] }
+    { [ t ] 		    [ drop ] } }
+  cond ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: act-on-nodes ( spring -- )
+  dup
+  act-on-nodes-hooke
+  act-on-nodes-damping ;
+
+! : act-on-nodes ( spring -- ) act-on-nodes-hooke ;
+
+: loop-over-springs ( -- ) springs> [ act-on-nodes ] each ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: apply-gravity ( node -- ) { 0 -9.8 } apply-force ;
+
+: do-gravity ( -- ) gravity> [ nodes> [ apply-gravity ] each ] when ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! F = ma
+
+: calc-acceleration ( node -- vec ) [ node-force ] [ node-mass ] bi v/n ;
+
+: new-vel ( node -- vel )
+  [ node-vel ] [ calc-acceleration time-slice> v*n ] bi v+ ;
+
+: new-pos ( node -- pos ) [ node-pos ] [ node-vel time-slice> v*n ] bi v+ ;
+
+: iterate-node ( node -- )
+  dup new-pos >>pos
+  dup new-vel >>vel
+  dup reset-force
+  handle-bounce ;
+
+: iterate-nodes ( -- ) nodes> [ iterate-node ] each ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: iterate-system ( -- ) do-gravity loop-over-springs iterate-nodes ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Reading xspringies data files
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: mass ( id x y x-vel y-vel mass elas -- )
+  7 nrot drop
+  6 nrot 6 nrot 2array
+  5 nrot 5 nrot 2array
+  0 0 2array <node>
+  nodes> swap add >nodes ;
+
+: spng ( id id-a id-b k damp rest-length -- )
+  6 nrot drop
+  -rot
+  5 nrot node-id
+  5 nrot node-id
+  <spring>
+  springs> swap add >springs ;

extra/springies/ui/ui.factor

@@ -0,0 +1,61 @@
+
+USING: kernel namespaces threads sequences math math.vectors combinators.lib
+       opengl.gl opengl colors ui ui.gadgets ui.gadgets.slate
+       rewrite-closures vars springies ;
+
+IN: springies.ui
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: draw-node ( node -- ) node-pos { -5 -5 } v+ dup { 10 10 } v+ gl-rect ;
+
+: draw-spring ( spring -- )
+  [ spring-node-a node-pos ] [ spring-node-b node-pos ] bi gl-line ;
+
+: draw-nodes ( -- ) nodes> [ draw-node ] each ;
+
+: draw-springs ( -- ) springs> [ draw-spring ] each ;
+
+: set-projection ( -- )
+  GL_PROJECTION glMatrixMode
+  glLoadIdentity
+  0 world-width 1- 0 world-height 1- -1 1 glOrtho
+  GL_MODELVIEW glMatrixMode
+  glLoadIdentity ;
+
+: display ( -- ) set-projection black gl-color draw-nodes draw-springs ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+VAR: slate
+
+VAR: loop
+
+: update-world-size ( -- ) slate> rect-dim >world-size ;
+
+: refresh-slate ( -- ) slate> relayout-1 ;
+
+DEFER: maybe-loop
+
+: run ( -- )
+  update-world-size
+  iterate-system
+  refresh-slate
+  yield
+  maybe-loop ;
+
+: maybe-loop ( -- ) loop> [ run ] when ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: springies-window* ( -- )
+
+  C[ display ] <slate> >slate
+    { 500 500 }					     slate> set-slate-dim
+    C[ { 500 500 } >world-size loop on [ run ] in-thread ]
+      slate> set-slate-graft
+    C[ loop off ]	       	 	     	     slate> set-slate-ungraft
+
+  slate> "Springies" open-window ;
+
+: springies-window ( -- ) [ [ springies-window* ] with-scope ] with-ui ;