graphics/animations/mkcircle.bas

   1 ' Svjatoslav Agejenko  svjatoslavagejenko@gmail.com\r
   2 ' 2003.10\r
   3 \r
   4 \r
   5 DECLARE SUB textpage ()\r
   6 DECLARE SUB mkcircle ()\r
   7 DECLARE SUB mklines ()\r
   8 DECLARE SUB disp ()\r
   9 DECLARE SUB fill ()\r
  10 DIM SHARED pi\r
  11 DIM SHARED an\r
  12 DIM SHARED frm\r
  13 DIM SHARED buf2(1 TO 50, 1 TO 80) AS STRING * 1\r
  14 DIM SHARED buf(1 TO 50, 1 TO 80) AS STRING * 1\r
  15 DIM SHARED col(1 TO 50, 1 TO 80) AS INTEGER\r
  16 \r
  17 DIM SHARED vl, hl, vls, hls\r
  18 \r
  19 WIDTH 80, 50\r
  20 VIEW PRINT 1 TO 50\r
  21 pi = 3.14159\r
  22 OPEN "mkcircle.bas" FOR INPUT AS #1\r
  23 \r
  24 CLS\r
  25 \r
  26 hl = 20\r
  27 hls = 1\r
  28 vl = 20\r
  29 vls = 1\r
  30 \r
  31 1\r
  32 frm = frm + 1\r
  33 \r
  34 textpage\r
  35 fill\r
  36 mklines\r
  37 mkcircle\r
  38 disp\r
  39 IF INKEY$ <> "" THEN GOTO 2\r
  40 GOTO 1\r
  41 2\r
  42 CLOSE #1\r
  43 SYSTEM\r
  44 \r
  45 SUB disp\r
  46 COLOR 7, 0\r
  47 LOCATE 1, 1\r
  48 FOR y = 1 TO 50\r
  49   FOR x = 1 TO 80\r
  50     COLOR col(y, x)\r
  51     PRINT buf(y, x);\r
  52     buf(y, x) = buf2(y, x)\r
  53     col(y, x) = 4\r
  54   NEXT x\r
  55 NEXT y\r
  56 \r
  57 END SUB\r
  58 \r
  59 SUB fill\r
  60 COLOR 4, 0\r
  61 siz = SIN(frm / 7) + 1.1\r
  62 \r
  63 an = an + SIN(frm / 30) / 10\r
  64 rsx = 50 - SIN(an + pi / 4) * 12 * 20 * siz\r
  65 rsy = 50 - COS(an + pi / 4) * 12 * 20 * siz\r
  66 \r
  67 sxp = SIN(an) * 6 * siz\r
  68 syp = COS(an) * 6 * siz\r
  69 rsxp = SIN(an + pi / 2) * 6 * siz\r
  70 rsyp = COS(an + pi / 2) * 6 * siz\r
  71 \r
  72 FOR y = 1 TO 50\r
  73 rsx = rsx + rsxp\r
  74 rsy = rsy + rsyp\r
  75 \r
  76 4\r
  77 IF rsx > 100 THEN rsx = rsx - 100: GOTO 4\r
  78 IF rsx < 0 THEN rsx = rsx + 100: GOTO 4\r
  79 IF rsy > 100 THEN rsy = rsy - 100: GOTO 4\r
  80 IF rsy < 0 THEN rsy = rsy + 100: GOTO 4\r
  81 \r
  82 sx = rsx\r
  83 sy = rsy\r
  84 \r
  85 FOR x = 1 TO 80\r
  86   c = 0\r
  87   sx = sx + sxp\r
  88   sy = sy + syp\r
  89   \r
  90 3\r
  91   IF sx > 100 THEN sx = sx - 100: GOTO 3\r
  92   IF sx < 0 THEN sx = sx + 100: GOTO 3\r
  93   IF sy > 100 THEN sy = sy - 100: GOTO 3\r
  94   IF sy < 0 THEN sy = sy + 100: GOTO 3\r
  95 \r
  96   IF sx < 12 OR sy < 12 THEN buf(y, x) = "*": col(y, x) = 9\r
  97   NEXT x\r
  98 NEXT y\r
  99 END SUB\r
 100 \r
 101 SUB mkcircle\r
 102 cs = (SIN(frm / 10) + 1.01) * 30\r
 103 cy = SIN(frm / 12) * 30 + 40\r
 104 cx = COS(frm / 17) * 15 + 25\r
 105 \r
 106 FOR y = 1 TO 50\r
 107 xp = SIN(y / 5 + frm / 30) * cs / 10\r
 108 \r
 109 IF (y >= cy - cs) AND (y <= cy + cs) THEN\r
 110 \r
 111 h1 = SQR((y - (cy - cs)) * ((cy + cs) - y))\r
 112 IF (y >= cy - cs / 2) AND (y <= cy + cs / 2) THEN h2 = SQR((y - (cy - cs / 2)) * ((cy + cs / 2) - y)) ELSE h2 = 0\r
 113 \r
 114 \r
 115 s = cx - h1 + xp\r
 116 IF s < 1 THEN s = 1\r
 117 e = cx - h2 + xp\r
 118 IF e > 80 THEN e = 80\r
 119 \r
 120 FOR x = s TO e\r
 121 buf(y, x) = CHR$(RND * 40 + 48)\r
 122 col(y, x) = RND * 15\r
 123 NEXT x\r
 124 \r
 125 \r
 126 s = cx + h2 + xp\r
 127 IF s < 1 THEN s = 1\r
 128 e = cx + h1 + xp\r
 129 IF e > 80 THEN e = 80\r
 130 \r
 131 FOR x = s TO e\r
 132 buf(y, x) = CHR$(RND * 200 + 32)\r
 133 col(y, x) = RND * 15\r
 134 NEXT x\r
 135 \r
 136 END IF\r
 137 \r
 138 \r
 139 NEXT y\r
 140 \r
 141 \r
 142 \r
 143 END SUB\r
 144 \r
 145 SUB mklines\r
 146 vl = vl + vls\r
 147 IF vl > 49 THEN vls = -1\r
 148 IF vl < 2 THEN vls = 1\r
 149 \r
 150 hl = hl + hls\r
 151 IF hl > 79 THEN hls = -1\r
 152 IF hl < 2 THEN hls = 1\r
 153 \r
 154 FOR x = 1 TO 80\r
 155   IF buf(vl, x) = "*" THEN c = 31 ELSE c = 10\r
 156   buf(vl, x) = "#"\r
 157   col(vl, x) = c\r
 158 NEXT x\r
 159 \r
 160 FOR y = 1 TO 50\r
 161   IF buf(y, hl) = "*" THEN c = 31 ELSE c = 10\r
 162   buf(y, hl) = "#"\r
 163   col(y, hl) = c\r
 164 NEXT y\r
 165 END SUB\r
 166 \r
 167 SUB textpage\r
 168 IF EOF(1) <> 0 THEN\r
 169   CLOSE 1\r
 170   OPEN "mkcircle.bas" FOR INPUT AS #1\r
 171 END IF\r
 172 \r
 173 LINE INPUT #1, a$\r
 174 \r
 175 FOR y = 1 TO 49\r
 176 FOR x = 1 TO 80\r
 177   buf2(y, x) = buf2(y + 1, x)\r
 178 NEXT x\r
 179 NEXT y\r
 180 \r
 181 FOR x = 1 TO 80\r
 182   buf2(50, x) = " "\r
 183 NEXT x\r
 184 \r
 185 IF LEN(a$) > 80 THEN a$ = LEFT$(a$, 80)\r
 186 FOR b = 1 TO LEN(a$)\r
 187   c$ = RIGHT$(LEFT$(a$, b), 1)\r
 188   buf2(50, b) = c$\r
 189 NEXT b\r
 190 \r
 191 \r
 192 \r
 193 END SUB\r
 194 \r