initial cammit
[qbasicapps.git] / graphics / presentations / tour.bas
1 DECLARE SUB setink (a!)\r
2 DECLARE SUB inke (a$)\r
3 DECLARE SUB mkjuku (x!, y!, a!, c!)\r
4 DECLARE SUB pr (x!, y!, s!, c!, n!, a$)\r
5 DECLARE SUB wpr ()\r
6 DECLARE SUB sc7 ()\r
7 DECLARE SUB sc6 ()\r
8 DECLARE SUB sc5 ()\r
9 DECLARE SUB pal4 (c, r!, g!, b!)\r
10 DECLARE SUB sc4 ()\r
11 DECLARE SUB inpur ()\r
12 DECLARE SUB ef5 ()\r
13 DECLARE SUB sc3 ()\r
14 DECLARE SUB prin (x1!, y1!, s!, c, a$)\r
15 DECLARE SUB pal3 (r!, g!, b!)\r
16 DECLARE SUB mkfont ()\r
17 DECLARE SUB pal2 (r!, g!, b!)\r
18 DECLARE SUB box1 (x1!, y1!, x2!, y2!, c!)\r
19 DECLARE SUB mkback ()\r
20 DECLARE SUB sc2 ()\r
21 DECLARE SUB resiz ()\r
22 DECLARE SUB pri (x!, y!, a$, c!)\r
23 DECLARE SUB deca (xs!, ys!, fx!, fy!)\r
24 DECLARE SUB box (xs!, ys!)\r
25 DECLARE SUB ef4 ()\r
26 DECLARE SUB ef3 ()\r
27 DECLARE SUB ef2 ()\r
28 DECLARE SUB ef1 ()\r
29 DECLARE SUB start ()\r
30 DECLARE SUB sc1 ()\r
31 DECLARE SUB pal (x!)\r
32 DIM SHARED fontt(0 TO 7, 0 TO 7, 0 TO 255)\r
33 DIM SHARED tim\r
34 DIM SHARED tim2\r
35 DIM SHARED jas(1 TO 500)\r
36 DIM SHARED pii\r
37 DIM SHARED tmr\r
38 DIM SHARED ink\r
39 DIM SHARED tim$\r
40 \r
41 start\r
42 \r
43 \r
44 CLS\r
45 'GOTO 8\r
46 \r
47 sc1\r
48 ef1\r
49 ef2\r
50 ef3\r
51 \r
52 ef4\r
53 sc2\r
54 sc4\r
55 8\r
56 sc5\r
57 sc6\r
58 \r
59 sc7\r
60 sc3\r
61 ef5\r
62 \r
63 SYSTEM\r
64 \r
65 SUB box (xs, ys)\r
66 LINE (0, 186)-(0 + xs, 186 - ys), 15, B\r
67 LINE (1, 187)-(-1 + xs, 187 - ys), 25, B\r
68 LINE (2, 188)-(-2 + xs, 188 - ys), 15, B\r
69 PSET (0, 188), 0\r
70 PSET (0 + xs, 188), 0\r
71 PSET (0, 186 - ys), 0\r
72 PSET (0 + xs, 186 - ys), 0\r
73 END SUB\r
74 \r
75 DEFINT Z\r
76 SUB box1 (x1, y1, x2, y2, c)\r
77 \r
78 IF c = 1 THEN za = 51 ELSE za = 102\r
79 \r
80 \r
81 FOR zy = y1 + 7 TO y2 + 7\r
82 FOR zx = x1 + 7 TO x2 + 7\r
83 zc = POINT(zx, zy)\r
84 IF zc < 51 THEN\r
85 IF zc > 25 THEN zc = 50 - zc\r
86 zc = zc / 2\r
87 PSET (zx, zy), zc\r
88 END IF\r
89 NEXT zx\r
90 NEXT zy\r
91 \r
92 FOR zy = y1 TO y2\r
93 FOR zx = x1 TO x2\r
94 zc = POINT(zx, zy)\r
95 IF zc > 50 THEN zc = zc - 51\r
96 PSET (zx, zy), zc + za\r
97 NEXT zx\r
98 NEXT zy\r
99 \r
100 \r
101 END SUB\r
102 \r
103 DEFSNG Z\r
104 SUB deca (xs, ys, fx, fy)\r
105 LINE (0, 185 - ys)-(xs, 185 - ys + fy), 0, BF\r
106 LINE (xs, 18 - ys)-(xs - fx, 188), 0, BF\r
107 xs = xs - fx\r
108 ys = ys - fy\r
109 box xs, ys\r
110 END SUB\r
111 \r
112 SUB ef1\r
113   \r
114 pal 3\r
115 \r
116 'LINE (51, 171)-(270, 190), 25, BF\r
117 \r
118 DIM buf1(1 TO 10000)\r
119 DIM buf2(1 TO 10000)\r
120 DIM buf3(1 TO 400)\r
121 \r
122 FOR a = 1 TO 320\r
123 buf3(a) = 200\r
124 NEXT a\r
125 \r
126 \r
127 b = 0\r
128 c1 = 1\r
129 setink 10\r
130 1\r
131 c1 = c1 + 1\r
132 IF c1 > 50 THEN c1 = 1\r
133 LINE (0, 40)-(0, 43), c1\r
134 c2 = c1\r
135 IF c2 > 25 THEN c2 = 50 - c2\r
136 c2 = c2 - 5\r
137 IF c2 < 0 THEN c2 = 0\r
138 PSET (0, 39), c2\r
139 PSET (0, 44), c2\r
140 LINE (319, 76)-(319, 79), c1\r
141 PSET (319, 75), c2\r
142 PSET (319, 80), c2\r
143 \r
144 GET (0, 39)-(318, 44), buf1(1)\r
145 PUT (1, 39), buf1(1), PSET\r
146 \r
147 GET (1, 75)-(319, 80), buf1(1)\r
148 PUT (0, 75), buf1(1), PSET\r
149 \r
150 b = b + 1\r
151 buf3(271) = SIN(b / 50 + 1.57) * 30 + 160\r
152 FOR x = 50 TO 270\r
153 PSET (x, buf3(x) - 1), 0\r
154 IF x > 50 THEN\r
155 PSET (x, buf3(x)), 15\r
156 PSET (x, buf3(x) + 1), 20\r
157 PSET (x, buf3(x) + 2), 25\r
158 END IF\r
159 buf3(x) = buf3(x + 1)\r
160 NEXT x\r
161 \r
162 \r
163 a = 50\r
164 FOR x = 65 + 18 TO 270 STEP 40\r
165 a = a + 1\r
166 IF buf3(x - 1) < 190 THEN\r
167 mkjuku x, buf3(x - 1) - 27, x, 0\r
168 mkjuku x, buf3(x) - 27, x, a\r
169 END IF\r
170 NEXT x\r
171 \r
172 inke a$\r
173 SOUND 0, .4\r
174 IF a$ = "" THEN GOTO 1\r
175 \r
176  \r
177 END SUB\r
178 \r
179 SUB ef2\r
180 \r
181 FOR a = 1 TO 30\r
182 e = 0\r
183 c = (3.8 * (30 - a)) / 30\r
184 \r
185 FOR f = 0 TO 50\r
186 IF f < 25 THEN e = e + 4 ELSE e = e - c\r
187 OUT &H3C8, f\r
188 OUT &H3C9, e / 4\r
189 OUT &H3C9, e / 1.9\r
190 OUT &H3C9, e / 3\r
191 NEXT f\r
192 \r
193 FOR b = 1 TO 3\r
194 SOUND 0, .3\r
195 NEXT b\r
196 NEXT a\r
197 \r
198 \r
199 \r
200 FOR a = 20 TO 0 STEP -1\r
201 b = (a * 4) / 20\r
202 e = 0\r
203 FOR f = 0 TO 60\r
204 IF f < 25 THEN e = e + b\r
205 OUT &H3C8, f\r
206 OUT &H3C9, e / 4\r
207 OUT &H3C9, e / 1.9\r
208 OUT &H3C9, e / 3\r
209 NEXT f\r
210 \r
211 FOR b = 1 TO 2\r
212 SOUND 0, .3\r
213 NEXT b\r
214 \r
215 NEXT a\r
216 \r
217 END SUB\r
218 \r
219 SUB ef3\r
220 SCREEN 7\r
221 SCREEN 7, , , 1\r
222 \r
223 OUT &H3C8, 1\r
224 OUT &H3C9, 64 / 4\r
225 OUT &H3C9, 64 / 1.9\r
226 OUT &H3C9, 64 / 3\r
227 \r
228 b = 2\r
229 c = .01\r
230 2\r
231 x = x + 1\r
232 y = y + 1\r
233 c = c + .01\r
234 b = b + c\r
235 \r
236 FOR a = 0 TO 160 STEP b\r
237 LINE (160 + a, 0)-(160 + a, 199), 1\r
238 LINE (160 - a, 0)-(160 - a, 199), 1\r
239 LINE (0, 100 + a)-(319, 100 + a), 1\r
240 LINE (0, 100 - a)-(319, 100 - a), 1\r
241 NEXT a\r
242 \r
243 \r
244 PCOPY 0, 1\r
245 CLS\r
246 SOUND 0, .4\r
247 IF b < 50 THEN GOTO 2\r
248 \r
249 SCREEN 13\r
250 pal 2\r
251 \r
252 FOR a = 0 TO 160 STEP b\r
253 LINE (160 + a, 0)-(160 + a, 199), 25\r
254 LINE (160 - a, 0)-(160 - a, 199), 25\r
255 LINE (0, 100 + a)-(319, 100 + a), 25\r
256 LINE (0, 100 - a)-(319, 100 - a), 25\r
257 NEXT a\r
258 \r
259 \r
260 resiz\r
261 pal 3\r
262 \r
263 pri 11, 8, "-* A U T O R I D *-", 55\r
264 pri 10, 11, CHR$(254) + " Danel Makko", 55\r
265 pri 10, 13, CHR$(254) + " Meelis Altma", 55\r
266 pri 10, 15, CHR$(254) + " Svjatoslav Agejenko", 55\r
267 'pri 10, 17, CHR$(254) + " Kenno Kink", 55\r
268 pri 20, 19, "I-01  a. 2001", 55\r
269 \r
270 inpur\r
271 CLS\r
272 END SUB\r
273 \r
274 SUB ef4\r
275 pal 2\r
276 xs = 317\r
277 ys = 185\r
278 box xs, ys\r
279 tey = 20\r
280 \r
281 DIM buf4(1 TO 10000)\r
282 \r
283 b = 0\r
284 setink 10\r
285 COLOR 25\r
286 4\r
287 b = b + 1\r
288 \r
289 SELECT CASE b\r
290 CASE 50 TO 200\r
291 deca xs, ys, 1, 1\r
292 \r
293 CASE 201\r
294 'pal4 255, 63, 45, 0\r
295 'prin 10, tey, 2, 255, "Infoallikas:"\r
296 tey = tey + 20\r
297 \r
298 CASE 290\r
299 pal4 254, 20, 20, 63\r
300 prin 70, tey, 7, 254, "NETI"\r
301 tey = tey + 60\r
302 \r
303 CASE 350\r
304 pal4 254, 20, 20, 63\r
305 prin 100, tey, 2, 254, "www.neti.ee"\r
306 tey = tey + 20\r
307 \r
308 CASE 400\r
309 pal4 254, 20, 20, 63\r
310 prin 100, tey, 2, 254, CHR$(16) + "\84ri\turism"\r
311 tey = tey + 10\r
312 \r
313 \r
314 END SELECT\r
315 \r
316 FOR a = 2 TO (xs - 5) / 8\r
317 LOCATE 23, a\r
318 PRINT CHR$(RND * 1 + 48)\r
319 NEXT a\r
320 \r
321 FOR x = 3 TO xs - 3 STEP 8\r
322 GET (x, 183 - ys + 14)-(x + 7, 183), buf4(1)\r
323 PUT (x, 183 - ys + 6), buf4(1), PSET\r
324 NEXT x\r
325 \r
326 \r
327 inke a$\r
328 \r
329 IF a$ <> "" THEN GOTO 3\r
330 wpr\r
331 GOTO 4\r
332 \r
333 \r
334 \r
335 3\r
336 END SUB\r
337 \r
338 SUB ef5\r
339 DIM buf(1 TO 5000)\r
340 \r
341 FOR a = 1 TO 1000\r
342 x = RND * 298 + 1\r
343 y = RND * 178 + 1\r
344 GET (x, y)-(x + 19, y + 19), buf(1)\r
345 IF RND * 100 < 50 THEN x = x + 1 ELSE x = x - 1\r
346 IF RND * 100 < 50 THEN y = y + 1\r
347 PUT (x, y), buf(1), PSET\r
348 SOUND 0, .05\r
349 NEXT a\r
350 \r
351 FOR a = 0 TO 100\r
352 LINE (0, a)-(319, a), 0\r
353 LINE (0, 200 - a)-(319, 200 - a), 0\r
354 SOUND 0, .4\r
355 NEXT a\r
356 \r
357 \r
358 END SUB\r
359 \r
360 SUB inke (a$)\r
361 IF tim$ <> TIME$ THEN\r
362 ink = ink - 1\r
363 tim$ = TIME$\r
364 END IF\r
365 IF (ink <= 0) AND (tmr = 1) THEN a$ = " " ELSE a$ = ""\r
366 IF INKEY$ <> "" THEN a$ = " "\r
367 END SUB\r
368 \r
369 SUB inpur\r
370 setink 10\r
371 11\r
372 inke a$\r
373 IF a$ = "" THEN GOTO 11\r
374 END SUB\r
375 \r
376 DEFINT A-Z\r
377 SUB mkback\r
378 CLS\r
379 lm1 = 0\r
380 lm2 = 50\r
381 \r
382 s = 2 ^ 7\r
383 \r
384 7\r
385 s = s \ 2\r
386 \r
387 FOR y = 0 TO 199 STEP s\r
388 FOR x = 0 TO 319 STEP s\r
389 \r
390 c1 = POINT(x, y)\r
391 c2 = POINT(x + s, y)\r
392 c3 = POINT(x, y + s)\r
393 c4 = POINT(x + s, y + s)\r
394 \r
395 sp = s \ 2\r
396 \r
397 c5 = (c1 + c2 + c3 + c4) / 4 + RND * s - sp\r
398 IF c5 > lm2 THEN c5 = lm2\r
399 IF c5 < lm1 THEN c5 = lm1\r
400 \r
401 c6 = (c2 + c4) / 2 + RND * s - sp\r
402 IF c6 > lm2 THEN c6 = lm2\r
403 IF c6 < lm1 THEN c6 = lm1\r
404 \r
405 c7 = (c3 + c4) / 2 + RND * s - sp\r
406 IF c7 > lm2 THEN c7 = lm2\r
407 IF c7 < lm1 THEN c7 = lm1\r
408 \r
409 \r
410 IF INT(RND * 30) = 2 THEN c5 = 50\r
411 PSET (x + sp, y + sp), c5\r
412 PSET (x + s, y + sp), c6\r
413 PSET (x + sp, y + s), c7\r
414 \r
415 NEXT x\r
416 NEXT y\r
417 IF s > 2 THEN GOTO 7\r
418 END SUB\r
419 \r
420 DEFSNG A-Z\r
421 SUB mkfont\r
422 SCREEN 13\r
423 FOR a = 0 TO 255\r
424 LOCATE 1, 1\r
425 IF a <> 7 THEN PRINT CHR$(a)\r
426 \r
427 FOR y = 0 TO 7\r
428 FOR x = 0 TO 7\r
429 fontt(x, y, a) = POINT(x, y)\r
430 NEXT x\r
431 NEXT y\r
432 NEXT a\r
433 \r
434 \r
435 END SUB\r
436 \r
437 SUB mkjuku (x, y, a, c)\r
438 jas(a) = jas(a) + .08\r
439 IF jas(a) > 30000 THEN jas(a) = 0\r
440 b = jas(a)\r
441 IF c = 0 THEN b = jas(a) - .08\r
442 x1 = x + COS(b) * 10\r
443 y1 = y + SIN(b) * 5 + 20\r
444 \r
445 x2 = x + COS(b) * 5 + 2\r
446 y2 = y + SIN(b) * 3 + 10\r
447 \r
448 x3 = x + COS(b + 1) * 2\r
449 y3 = y + SIN(b + 1) * 2 + 2\r
450 \r
451 \r
452 LINE (x2, y2)-(x1, y1), c\r
453 LINE (x2, y2)-(x3, y3), c\r
454 \r
455 \r
456 x1 = x + COS(b + pii) * 10\r
457 y1 = y + SIN(b + pii) * 5 + 20\r
458 \r
459 x2 = x + COS(b + pii) * 5 + 2\r
460 y2 = y + SIN(b + pii) * 3 + 10\r
461 \r
462 LINE (x2, y2)-(x1, y1), c\r
463 LINE (x2, y2)-(x3, y3), c\r
464 \r
465 x4 = x + COS(b + 1.2) * 3 - 1\r
466 y4 = y + SIN(b + 1.2) * 1 - 10\r
467 \r
468 LINE (x4, y4)-(x3, y3), c\r
469 \r
470 x5 = x + COS(b + .5) * 13 - 3\r
471 y5 = y + SIN(b + .5) * 2 + 1\r
472 \r
473 x6 = x + COS(b + .5) * 15 - 1\r
474 y6 = y + SIN(b + .5) * 3 + 4\r
475 \r
476 LINE (x5, y5)-(x4, y4), c\r
477 LINE (x5, y5)-(x6, y6), c\r
478 \r
479 x5 = x + COS(b + pii) * 13 - 3\r
480 y5 = y + SIN(b + pii) * 2 + 1\r
481 \r
482 x6 = x + COS(b + pii) * 15 - 1\r
483 y6 = y + SIN(b + pii) * 3 + 4\r
484 \r
485 LINE (x5, y5)-(x4, y4), c\r
486 LINE (x5, y5)-(x6, y6), c\r
487 \r
488 x7 = x + COS(b + 1.2) * 2\r
489 y7 = y + SIN(b + 1.2) * 1 - 14\r
490 \r
491 LINE (x7, y7 + 2)-(x4, y4), c\r
492 \r
493 CIRCLE (x7, y7), 3, c\r
494 \r
495 \r
496 \r
497 END SUB\r
498 \r
499 SUB pal (x)\r
500 SELECT CASE x\r
501 CASE 1\r
502 FOR f = 0 TO 25\r
503 OUT &H3C8, f\r
504 OUT &H3C9, f * 4.1\r
505 OUT &H3C9, f * 4.1\r
506 OUT &H3C9, f * 4.1\r
507 NEXT f\r
508 \r
509 CASE 2\r
510 e = 0\r
511 FOR f = 0 TO 50\r
512 IF f < 25 THEN e = e + 4 ELSE e = e - 3.8\r
513 OUT &H3C8, f\r
514 OUT &H3C9, e / 4\r
515 OUT &H3C9, e / 1.9\r
516 OUT &H3C9, e / 3\r
517 NEXT f\r
518 CASE 3\r
519 \r
520 FOR f = 51 TO 60\r
521 OUT &H3C8, f\r
522 OUT &H3C9, SIN(f) * 30 + 30\r
523 OUT &H3C9, SIN(f * 2) * 30 + 30\r
524 OUT &H3C9, SIN(f * 3) * 30 + 30\r
525 NEXT f\r
526 \r
527 CASE 4\r
528 FOR f = 0 TO 25\r
529 OUT &H3C8, f\r
530 OUT &H3C9, f * 2.5\r
531 OUT &H3C9, f * 2.5\r
532 OUT &H3C9, f * 1.5\r
533 NEXT f\r
534 FOR f = 26 TO 50\r
535 OUT &H3C8, f\r
536 OUT &H3C9, (50 - f) * 2.5\r
537 OUT &H3C9, (50 - f) * 2.5\r
538 OUT &H3C9, (50 - f) * 1.5\r
539 NEXT f\r
540 \r
541 END SELECT\r
542 \r
543 END SUB\r
544 \r
545 SUB pal2 (r, g, b)\r
546 FOR f = 0 TO 25\r
547 OUT &H3C8, f + 51\r
548 OUT &H3C9, (f * 2.5 + r * 1) / 2\r
549 OUT &H3C9, (f * 2.5 + g * 1) / 2\r
550 OUT &H3C9, (f * 1.5 + b * 1) / 2\r
551 NEXT f\r
552 FOR f = 26 TO 50\r
553 OUT &H3C8, f + 51\r
554 OUT &H3C9, ((50 - f) * 2.5 + r * 1) / 2\r
555 OUT &H3C9, ((50 - f) * 2.5 + g * 1) / 2\r
556 OUT &H3C9, ((50 - f) * 1.5 + b * 1) / 2\r
557 NEXT f\r
558 END SUB\r
559 \r
560 SUB pal3 (r, g, b)\r
561 FOR f = 0 TO 25\r
562 OUT &H3C8, f + 102\r
563 OUT &H3C9, (f * 2.5 + r * 1) / 2\r
564 OUT &H3C9, (f * 2.5 + g * 1) / 2\r
565 OUT &H3C9, (f * 1.5 + b * 1) / 2\r
566 NEXT f\r
567 FOR f = 26 TO 50\r
568 OUT &H3C8, f + 102\r
569 OUT &H3C9, ((50 - f) * 2.5 + r * 1) / 2\r
570 OUT &H3C9, ((50 - f) * 2.5 + g * 1) / 2\r
571 OUT &H3C9, ((50 - f) * 1.5 + b * 1) / 2\r
572 NEXT f\r
573 END SUB\r
574 \r
575 SUB pal4 (c, r, g, b)\r
576 OUT &H3C8, c\r
577 OUT &H3C9, r\r
578 OUT &H3C9, g\r
579 OUT &H3C9, b\r
580 END SUB\r
581 \r
582 SUB pr (x, y, s, c, n, a$)\r
583 IF n > LEN(a$) THEN GOTO 10\r
584 a$ = RIGHT$(LEFT$(a$, n), 1)\r
585 x1 = n * 8 * s + x\r
586 prin x1, y, s, c, a$\r
587 10\r
588 END SUB\r
589 \r
590 SUB pri (x, y, a$, c)\r
591 COLOR c\r
592 FOR a = 1 TO LEN(a$)\r
593 b$ = RIGHT$(LEFT$(a$, a), 1)\r
594 LOCATE y, x + a\r
595 PRINT b$\r
596 SOUND 0, 1\r
597 NEXT a\r
598 \r
599 \r
600 END SUB\r
601 \r
602 SUB prin (x1, y1, s, c1, a$)\r
603 \r
604 FOR a = 1 TO LEN(a$)\r
605 b = ASC(RIGHT$(LEFT$(a$, a), 1))\r
606 c = (a - 1) * 8 * s + x1\r
607 FOR y = 0 TO 7\r
608 FOR x = 0 TO 7\r
609 IF fontt(x, y, b) > 0 THEN\r
610 LINE (x * s + c, y * s + y1)-(x * s + s - 1 + c, y * s + s - 1 + y1), c1, BF\r
611 END IF\r
612 NEXT x\r
613 NEXT y\r
614 \r
615 NEXT a\r
616 \r
617 END SUB\r
618 \r
619 SUB resiz\r
620 \r
621 \r
622 FOR a = 1 TO 10\r
623 CIRCLE (160, 100), a, a * 2 + 5\r
624 NEXT a\r
625 PSET (160, 100), 0\r
626 \r
627 DIM buff1(1 TO 10000)\r
628 DIM buff2(1 TO 10000)\r
629 \r
630 a = 10\r
631 GET (160 - a, 90)-(160, 110), buff1(1)\r
632 GET (160, 90)-(160 + a, 110), buff2(1)\r
633 5\r
634 PUT (159 - a, 90), buff1(1), PSET\r
635 PUT (150 + a, 90), buff2(1), PSET\r
636 a = a + 1\r
637 SOUND 0, .2\r
638 IF a < 140 THEN GOTO 5\r
639 \r
640 a = 1\r
641 \r
642 GET (20, 90)-(300, 100), buff1(1)\r
643 GET (20, 100)-(300, 110), buff2(1)\r
644 6\r
645 PUT (20, 90 - a), buff1(1), PSET\r
646 PUT (20, 100 + a), buff2(1), PSET\r
647 \r
648 a = a + 1\r
649 SOUND 0, .2\r
650 IF a < 60 THEN GOTO 6\r
651 END SUB\r
652 \r
653 SUB sc1\r
654 \r
655 pal 2\r
656 LOCATE 1, 1\r
657 COLOR 1\r
658 PRINT "TURISM"\r
659 \r
660 FOR x = 0 TO 80\r
661 FOR y = 0 TO 16\r
662 c = POINT(x, y)\r
663 IF c > 0 THEN c1 = 50 ELSE c1 = 0\r
664 LINE (x * 5 + 35, y * 3 + 50)-(x * 5 + 4 + 35, y * 3 + 2 + 50), c1, BF\r
665 NEXT y\r
666 NEXT x\r
667 \r
668 LOCATE 1, 1\r
669 PRINT "      "\r
670 \r
671 \r
672 FOR y = 30 TO 80\r
673 FOR x = 0 TO 319\r
674 c = POINT(x, y)\r
675 c1 = (c1 * 1 + c) / 2\r
676 PSET (x, y), c1\r
677 NEXT x\r
678 NEXT y\r
679 \r
680 FOR x = 0 TO 319\r
681 FOR y = 30 TO 80\r
682 c = POINT(x, y)\r
683 c1 = (c1 * 1 + c) / 2\r
684 PSET (x, y), c1\r
685 NEXT y\r
686 NEXT x\r
687 \r
688 FOR y = 30 TO 80\r
689 FOR x = 319 TO 0 STEP -1\r
690 c = POINT(x, y)\r
691 c1 = (c1 * 1 + c) / 2\r
692 PSET (x, y), c1\r
693 NEXT x\r
694 NEXT y\r
695 \r
696 FOR x = 0 TO 319\r
697 FOR y = 80 TO 30 STEP -1\r
698 c = POINT(x, y)\r
699 c1 = (c1 * 1 + c) / 2\r
700 PSET (x, y), c1\r
701 NEXT y\r
702 NEXT x\r
703 \r
704 \r
705 \r
706 \r
707 \r
708 \r
709 END SUB\r
710 \r
711 SUB sc2\r
712 \r
713 CLS\r
714 pal 4\r
715 mkback\r
716 \r
717 pal2 40, 64, 63\r
718 pal3 0, 0, 0\r
719 \r
720 box1 30, 30, 290, 170, 1\r
721 \r
722 prin 65, 50, 3, 0, "Eesm\84rk:"\r
723 \r
724 prin 40, 100, 1, 0, CHR$(254) + " Uurida, interneti kaudu tu-"\r
725 prin 40, 108, 1, 0, "  rismifirmade poolt pakutavaid"\r
726 prin 40, 116, 1, 0, "  teenuseid."\r
727 prin 40, 130, 1, 0, CHR$(254) + " Saada hinne."\r
728 \r
729 \r
730 inpur\r
731 \r
732 END SUB\r
733 \r
734 SUB sc3\r
735 mkback\r
736 \r
737 pal2 64, 64, 0\r
738 box1 30, 30, 290, 150, 1\r
739 \r
740 prin 57, 50, 3, 0, "  T\84nan"\r
741 prin 45, 74, 3, 0, "t\84helepanu"\r
742 prin 45, 98, 3, 0, "   eest"\r
743 inpur\r
744 \r
745 END SUB\r
746 \r
747 SUB sc4\r
748 \r
749 pal 4\r
750 mkback\r
751 \r
752 \r
753 \r
754 pal2 0, 0, 32\r
755 box1 3, 3, 260, 50, 1\r
756 \r
757 pal4 255, 50, 50, 0\r
758 prin 10, 10, 2, 255, "Eesti Reisiinfo"\r
759 prin 50, 30, 1, 255, "www.reisiinfo.ee"\r
760 \r
761 pal3 10, 20, 0\r
762 box1 20, 40, 290, 180, 2\r
763 \r
764 pal4 254, 63, 45, 0\r
765 \r
766 \r
767 b = 25\r
768 prin 40, 60, 1, 254, CHR$(254) + " Eestisisesed reisid"\r
769 a = b\r
770 prin 40, 60 + a, 1, 254, CHR$(254) + " Reisiv\93imaluste tutvustus"\r
771 a = a + b\r
772 prin 40, 60 + a, 1, 254, CHR$(254) + " Otsingumootor"\r
773 a = a + b\r
774 prin 40, 60 + a, 1, 254, CHR$(254) + " Valida sobiv tegevus"\r
775 \r
776 \r
777 inpur\r
778 \r
779 \r
780 \r
781 \r
782 END SUB\r
783 \r
784 SUB sc5\r
785 pal 4\r
786 mkback\r
787 \r
788 pal2 0, 0, 32\r
789 box1 3, 3, 300, 50, 1\r
790 \r
791 pal4 255, 50, 50, 0\r
792 prin 10, 10, 2, 255, "Wristours"\r
793 prin 50, 30, 1, 255, "www.wristours.ee"\r
794 \r
795 pal3 20, 32, 63\r
796 box1 20, 40, 290, 180, 2\r
797 \r
798 pal4 254, 63, 45, 0\r
799 b = 25\r
800 prin 40, 60, 1, 254, CHR$(254) + " Reisid \81le maailma"\r
801 a = b\r
802 prin 40, 60 + a, 1, 254, CHR$(254) + " Väimalus tellida"\r
803 a = a + b\r
804 prin 40, 60 + a, 1, 254, CHR$(254) + " Info viisade kohta"\r
805 a = a + b\r
806 prin 40, 60 + a, 1, 254, CHR$(254) + " V\93imalus liisinguks"\r
807 \r
808 inpur\r
809 \r
810 \r
811 \r
812 END SUB\r
813 \r
814 SUB sc6\r
815 pal 4\r
816 mkback\r
817 \r
818 pal2 0, 0, 32\r
819 box1 3, 3, 300, 50, 1\r
820 \r
821 pal4 255, 50, 50, 0\r
822 prin 10, 10, 2, 255, "F R I S O N"\r
823 prin 50, 30, 1, 255, "www.frison.ee"\r
824 \r
825 pal3 30, 20, 10\r
826 box1 20, 40, 290, 180, 2\r
827 \r
828 pal4 254, 63, 45, 0\r
829 b = 25\r
830 prin 40, 60, 1, 254, CHR$(254) + " Aktiivne puhkus"\r
831 a = b\r
832 prin 40, 60 + a, 1, 254, CHR$(254) + " Reisipaiga valik"\r
833 a = a + b\r
834 prin 40, 60 + a, 1, 254, CHR$(254) + " V\93imalused  registreerida"\r
835 a = a + b\r
836 prin 40, 60 + a, 1, 254, CHR$(254) + " Tellimusreisid"\r
837 \r
838 inpur\r
839 \r
840 \r
841 \r
842 \r
843 END SUB\r
844 \r
845 SUB sc7\r
846 pal 4\r
847 mkback\r
848 \r
849 pal2 0, 0, 32\r
850 box1 3, 3, 300, 50, 1\r
851 \r
852 pal4 255, 50, 50, 0\r
853 prin 10, 10, 2, 255, "Last Minute"\r
854 prin 50, 30, 1, 255, "www.lastminute.ee"\r
855 \r
856 pal3 20, 32, 63\r
857 box1 20, 40, 290, 180, 2\r
858 \r
859 pal4 254, 63, 45, 0\r
860 b = 25\r
861 prin 40, 60, 1, 254, CHR$(254) + " Reisid"\r
862 a = b\r
863 prin 40, 60 + a, 1, 254, CHR$(254) + " Valida sihtkoht"\r
864 a = a + b\r
865 prin 40, 60 + a, 1, 254, CHR$(254) + " V\93imalused tellida reis"\r
866 a = a + b\r
867 prin 40, 60 + a, 1, 254, CHR$(254) + " V\93imalus reisikindlustuseks"\r
868 \r
869 inpur\r
870 \r
871 \r
872 \r
873 \r
874 END SUB\r
875 \r
876 SUB setink (a)\r
877 ink = a\r
878 tim$ = TIME$\r
879 END SUB\r
880 \r
881 SUB start\r
882 SCREEN 13\r
883 RANDOMIZE TIMER\r
884 \r
885 mkfont\r
886 tim = 0\r
887 tim2 = 0\r
888 \r
889 \r
890 FOR a = 1 TO 500\r
891 jas(a) = RND * 10\r
892 NEXT a\r
893 \r
894 pii = 3.14\r
895 IF COMMAND$ = "t" OR COMMAND$ = "T" THEN\r
896 tmr = 1\r
897 PRINT "timer is on"\r
898 SLEEP 1\r
899 ELSE\r
900 tmr = 0\r
901 END IF\r
902 END SUB\r
903 \r
904 SUB wpr\r
905 tim = tim + 1\r
906 IF tim \ 10 = tim / 10 THEN\r
907 a = tim / 10\r
908 SELECT CASE tim2\r
909 CASE 0\r
910 IF a = 10 THEN tim2 = 1: tim = 0: pal4 255, 63, 45, 0\r
911 CASE 1\r
912 pr 10, 10, 2, 255, a, "Infoallikas:"\r
913 \r
914 \r
915 END SELECT\r
916 END IF\r
917 END SUB\r
918 \r