updated license and email addresses
[qbasicapps.git] / graphics / spirals / spiral8.bas
1 ' Spiral\r
2 ' made by Svjatoslav Agejenko\r
3 ' in 2003.12\r
4 ' H-Page: svjatoslav.eu\r
5 ' E-Mail: svjatoslav@svjatoslav.eu\r
6  \r
7 \r
8 DECLARE SUB fill (x1, y1, x2, y2, xx1, yy1, xx2, yy2)\r
9 DIM SHARED torux(1 TO 10000)\r
10 DIM SHARED toruy(1 TO 10000)\r
11 DIM SHARED sin1(1 TO 10000)\r
12 DIM SHARED cos1(1 TO 10000)\r
13 DIM SHARED tor\r
14 SCREEN 12\r
15 su = 200\r
16 tor = 0\r
17 FOR a = 1 TO 97 STEP .15\r
18 tor = tor + 1\r
19 su = SIN(a / 31) * 100\r
20 x = SIN(a) * su * 3 + 320\r
21 y = COS(a) * su + 250\r
22 y = y - (COS(a / 31) * 200)\r
23 sin1(tor) = a\r
24 cos1(tor) = a / 31\r
25 torux(tor) = x\r
26 toruy(tor) = y\r
27 PSET (x, y), 15\r
28 NEXT a\r
29 OPEN "texture.dat" FOR INPUT AS #1\r
30 DIM SHARED text$(1 TO 1000)\r
31 a = 0\r
32 1\r
33 LINE INPUT #1, a$\r
34 IF LEFT$(a$, 3) = "END" THEN GOTO 2\r
35 a = a + 1\r
36 text$(a) = a$\r
37 GOTO 1\r
38 2\r
39 CLOSE #1\r
40 CLS\r
41 a = 1\r
42 FOR c = 1 TO 20\r
43 FOR b = 1 TO LEN(text$(c))\r
44 a$ = RIGHT$(LEFT$(text$(c), b), 1)\r
45 a = a + 1\r
46 IF a > tor - 43 THEN GOTO 3\r
47 tee = SIN(sin1(a + 32))\r
48 tee = tee - COS(cos1(a))\r
49 \r
50 IF tee <= 0 THEN\r
51 LINE (torux(a), toruy(a))-(torux(a + 1), toruy(a + 1)), 15\r
52 LINE (torux(a), toruy(a))-(torux(a + 42), toruy(a + 42)), 15\r
53 IF a$ = "M" THEN fill torux(a), toruy(a), torux(a + 1), toruy(a + 1), torux(a + 42), toruy(a + 42), torux(a + 43), toruy(a + 43)\r
54 END IF\r
55 \r
56 NEXT b\r
57 NEXT c\r
58 3\r
59 a$ = INPUT$(1)\r
60 SYSTEM\r
61 \r
62 SUB fill (zx1, zy1, zx2, zy2, zxx1, zyy1, zxx2, zyy2)\r
63 x1 = zx1\r
64 y1 = zy1\r
65 x2 = zx2\r
66 y2 = zy2\r
67 xx1 = zxx1\r
68 yy1 = zyy1\r
69 xx2 = zxx2\r
70 yy2 = zyy2\r
71 j = 10\r
72 x3 = (x2 - x1) / j\r
73 y3 = (y2 - y1) / j\r
74 xx3 = (xx2 - xx1) / j\r
75 yy3 = (yy2 - yy1) / j\r
76 FOR a = 1 TO j\r
77 x1 = x1 + x3\r
78 y1 = y1 + y3\r
79 xx1 = xx1 + xx3\r
80 yy1 = yy1 + yy3\r
81 LINE (x1, y1)-(xx1, yy1), 15\r
82 NEXT a\r
83 END SUB\r
84 \r