* fixed some email addresses
[qbasicapps.git] / simulation / explosion / explode.bas
1 ' Material simulation, simulates shockwaves propagation in gas.\r
2 ' made by Svjatoslav Agejenko\r
3 ' in 2003\r
4 ' homepage: svjatoslav.eu\r
5 ' email:    svjatoslav@svjatoslav.eu\r
6  \r
7 DECLARE SUB saveit ()\r
8 DECLARE SUB playit ()\r
9 DECLARE SUB frmget ()\r
10 DECLARE SUB frmsav ()\r
11 DECLARE SUB spot (x!, y!, p!)\r
12 DECLARE SUB lin (x1!, y1!, x2!, y2!)\r
13 DECLARE SUB disp ()\r
14 DECLARE SUB start ()\r
15 DIM SHARED wal\r
16 wal = 9980\r
17 \r
18 DIM SHARED press(1 TO 100, 1 TO 100)\r
19 DIM SHARED spdx(1 TO 100, 1 TO 100)\r
20 DIM SHARED spdy(1 TO 100, 1 TO 100)\r
21 DIM SHARED spdxp(1 TO 100, 1 TO 100)\r
22 DIM SHARED spdyp(1 TO 100, 1 TO 100)\r
23 DIM SHARED nam$, frm\r
24 DIM SHARED linb AS STRING * 100\r
25 frm = 0\r
26 \r
27 SCREEN 13\r
28 PAINT (1, 1), 1\r
29 \r
30 OPEN "tst.an0" FOR BINARY AS #1\r
31 \r
32 \r
33 start\r
34 \r
35 1\r
36 'disp\r
37 \r
38 FOR y = 2 TO 99\r
39     FOR x = 2 TO 99\r
40         IF press(x, y) = wal THEN spdx(x - 1, y) = 0: spdy(x, y - 1) = 0: spdx(x, y) = 0: spdy(x, y) = 0: GOTO 3\r
41         spdy(x, y) = spdy(x, y) - (press(x, y) / 500) ' gravitation\r
42 \r
43         IF press(x + 1, y) = wal THEN spdx(x, y) = 0: GOTO 2\r
44         spdx(x, y) = (press(x + 1, y) - press(x, y)) / 20 + spdx(x, y)\r
45         2\r
46         IF press(x, y + 1) = wal THEN spdy(x, y) = 0: GOTO 3\r
47         spdy(x, y) = (press(x, y + 1) - press(x, y)) / 20 + spdy(x, y)\r
48         3\r
49     NEXT x\r
50 NEXT y\r
51 \r
52 \r
53 4\r
54 b = 0\r
55 FOR y = 2 TO 99\r
56     FOR x = 2 TO 99\r
57         a = press(x, y) + spdx(x, y) + spdy(x, y) - spdx(x - 1, y) - spdy(x, y - 1)\r
58 \r
59         IF a = 0 OR ((a < 0) AND (a > -.0001)) THEN\r
60             IF spdx(x, y) < 0 THEN spdx(x, y) = 0\r
61             IF spdy(x, y) < 0 THEN spdy(x, y) = 0\r
62             IF spdx(x - 1, y) > 0 THEN spdx(x - 1, y) = 0\r
63             IF spdy(x, y - 1) > 0 THEN spdy(x, y - 1) = 0\r
64         END IF\r
65 \r
66         IF a < 0 THEN\r
67             IF spdx(x, y) < 0 THEN spdx(x, y) = spdx(x, y) / 1.5\r
68             IF spdy(x, y) < 0 THEN spdy(x, y) = spdy(x, y) / 1.5\r
69             IF spdx(x - 1, y) > 0 THEN spdx(x - 1, y) = spdx(x - 1, y) / 1.5\r
70             IF spdy(x, y - 1) > 0 THEN spdy(x, y - 1) = spdy(x, y - 1) / 1.5\r
71             b = 1\r
72             LOCATE 20, 1\r
73             PRINT a\r
74         END IF\r
75     NEXT x\r
76 NEXT y\r
77 IF b = 1 THEN GOTO 4\r
78 \r
79 FOR y = 2 TO 99\r
80     FOR x = 2 TO 99\r
81         IF spdx(x, y) > 0 THEN spdxp(x - 1, y) = ((press(x, y) * spdx(x - 1, y)) + (spdx(x, y) * spdx(x, y))) / (press(x, y) + spdx(x, y)) - spdx(x - 1, y)\r
82         IF spdy(x, y) > 0 THEN spdyp(x, y - 1) = ((press(x, y) * spdy(x, y - 1)) + (spdy(x, y) * spdy(x, y))) / (press(x, y) + spdy(x, y)) - spdy(x, y - 1)\r
83         IF spdx(x - 1, y) < 0 THEN spdxp(x, y) = ((press(x, y) * spdx(x, y)) - (spdx(x - 1, y) * spdx(x - 1, y))) / (press(x, y) - spdx(x - 1, y)) - spdx(x, y)\r
84         IF spdy(x, y - 1) < 0 THEN spdyp(x, y) = ((press(x, y) * spdy(x, y)) - (spdy(x, y - 1) * spdy(x, y - 1))) / (press(x, y) - spdy(x, y - 1)) - spdy(x, y)\r
85     NEXT x\r
86 NEXT y\r
87 \r
88 \r
89 FOR y = 2 TO 99\r
90     FOR x = 2 TO 99\r
91         press(x + 1, y) = press(x + 1, y) - spdx(x, y)\r
92         press(x, y + 1) = press(x, y + 1) - spdy(x, y)\r
93         press(x, y) = press(x, y) + spdx(x, y)\r
94         press(x, y) = press(x, y) + spdy(x, y)\r
95     NEXT x\r
96 NEXT y\r
97 \r
98 FOR y = 2 TO 99\r
99     FOR x = 2 TO 99\r
100         spdx(x, y) = spdx(x, y) + spdxp(x, y)\r
101         spdxp(x, y) = 0\r
102         spdy(x, y) = spdy(x, y) + spdyp(x, y)\r
103         spdyp(x, y) = 0\r
104     NEXT x\r
105 NEXT y\r
106 \r
107 \r
108 FOR y = 1 TO 100\r
109     FOR x = 1 TO 100\r
110         PSET (x, y), press(x, y) + 16\r
111     NEXT x\r
112 NEXT y\r
113 \r
114 saveit\r
115 \r
116 \r
117 \r
118 \r
119 GOTO 1\r
120 \r
121 CLOSE #1\r
122 \r
123 SUB disp\r
124 FOR y = 47 TO 53\r
125     FOR x = 47 TO 53\r
126         LOCATE y - 46, (x - 46) * 4\r
127         PRINT press(x, y)\r
128     NEXT x\r
129 NEXT y\r
130 \r
131 a$ = INPUT$(1)\r
132 \r
133 END SUB\r
134 \r
135 SUB lin (x1, y1, x2, y2)\r
136 \r
137 m = ABS(x1 - x2)\r
138 m1 = ABS(y1 - y2)\r
139 IF m1 > m THEN m = m1\r
140 \r
141 x3 = x2 - x1\r
142 y3 = y2 - y1\r
143 \r
144 FOR a = 0 TO m\r
145     x5 = x3 * a / m + x1\r
146     y5 = y3 * a / m + y1\r
147     press(x5, y5) = wal\r
148 NEXT a\r
149 \r
150 \r
151 END SUB\r
152 \r
153 SUB saveit\r
154 FOR y = 1 TO 100\r
155     a$ = ""\r
156     FOR x = 1 TO 100\r
157         a$ = a$ + CHR$(POINT(x, y))\r
158     NEXT x\r
159     linb = a$\r
160     PUT #1, , linb\r
161 NEXT y\r
162 \r
163 \r
164 END SUB\r
165 \r
166 SUB spot (x, y, p)\r
167 press(x, y) = p\r
168 press(x + 1, y) = p\r
169 press(x, y + 1) = p\r
170 press(x + 1, y + 1) = p\r
171 END SUB\r
172 \r
173 SUB start\r
174 frm = 0\r
175 \r
176 FOR a = 1 TO 100\r
177     FOR b = 1 TO 100\r
178         press(a, b) = 3\r
179         spdx(a, b) = 0\r
180         spdy(a, b) = 0\r
181         spdxp(a, b) = 0\r
182         spdyp(a, b) = 0\r
183     NEXT b\r
184 NEXT a\r
185 \r
186 FOR y = 30 TO 60\r
187     FOR x = 10 TO 50\r
188         spot x, y, 30\r
189     NEXT x\r
190 NEXT y\r
191 \r
192 lin 2, 2, 2, 99\r
193 lin 99, 2, 99, 99\r
194 lin 2, 99, 99, 99\r
195 lin 2, 2, 99, 2\r
196 \r
197 FOR x = 5 TO 40 STEP 5\r
198     lin x, 80, x + 50, 80 - x\r
199 NEXT x\r
200 \r
201 END SUB\r
202 \r