graphics/animations/matrix.bas

   1 ' Svjatoslav Agejenko\r
   2 ' year: 2002\r
   3 \r
   4 DECLARE SUB adus (a%)\r
   5 DECLARE SUB pt (x%, y%)\r
   6 DECLARE SUB addn (x%, y%)\r
   7 DECLARE SUB smo (x1%, y1%, x2%, y2%, r%)\r
   8 DECLARE SUB putsym (x%, y%, a%)\r
   9 DECLARE SUB setpal (b%)\r
  10 DECLARE SUB start ()\r
  11 DECLARE SUB getfnt ()\r
  12 DEFINT A-Z\r
  13 DIM SHARED font1(1 TO 400, 1 TO 10)\r
  14 DIM SHARED font2(1 TO 400, 1 TO 10)\r
  15 DIM SHARED font3(1 TO 400, 1 TO 10)\r
  16 DIM SHARED pag(0 TO 20, 0 TO 20)\r
  17 DIM SHARED pah(0 TO 20, 0 TO 20)\r
  18 DIM SHARED pat(0 TO 20, 0 TO 20)\r
  19 DIM SHARED usx(0 TO 20)\r
  20 DIM SHARED usy(0 TO 20)\r
  21 DIM SHARED uso(0 TO 20)\r
  22 DIM SHARED tmr AS DOUBLE\r
  23 usm = 8\r
  24 \r
  25 start\r
  26 \r
  27 2\r
  28 FOR a = 1 TO usm\r
  29 IF uso(a) = 0 THEN adus a\r
  30 addn usx(a), usy(a)\r
  31 usy(a) = usy(a) + 1\r
  32 IF usy(a) > 13 THEN usy(a) = 0\r
  33 uso(a) = uso(a) - 1\r
  34 NEXT a\r
  35 \r
  36 \r
  37 FOR y = 0 TO 13\r
  38 FOR x = 0 TO 18\r
  39 a = pat(x, y)\r
  40 a = a + 1\r
  41 IF a = 2 THEN pah(x, y) = 2: pt x, y\r
  42 IF a = 5 THEN pah(x, y) = 3: pt x, y\r
  43 IF a = 30 THEN pag(x, y) = 0: pt x, y\r
  44 pat(x, y) = a\r
  45 NEXT x\r
  46 NEXT y\r
  47 \r
  48 3\r
  49 IF ABS(tmr - TIMER) < .1 THEN GOTO 3\r
  50 tmr = TIMER\r
  51 IF INKEY$ <> "" THEN SYSTEM\r
  52 GOTO 2\r
  53 \r
  54 SUB addn (x, y)\r
  55 pag(x, y) = RND * 8 + 1\r
  56 pah(x, y) = 1\r
  57 pat(x, y) = 0\r
  58 pt x, y\r
  59 \r
  60 \r
  61 END SUB\r
  62 \r
  63 SUB adus (a)\r
  64 usx(a) = RND * 18\r
  65 usy(a) = RND * 13\r
  66 uso(a) = RND * 5 + 3\r
  67 END SUB\r
  68 \r
  69 SUB getfnt\r
  70 FOR a = 1 TO 9\r
  71 LOCATE 1, 1\r
  72 PRINT "Loading:" + STR$(a * 10) + "%"\r
  73 LINE (49, 49)-(83, 83), 0, BF\r
  74 putsym 50, 50, a\r
  75 smo 50, 50, 82, 82, 1\r
  76 GET (50, 50)-(82, 82), font1(1, a)\r
  77 \r
  78 LINE (49, 49)-(83, 83), 0, BF\r
  79 putsym 50, 50, a\r
  80 smo 50, 50, 82, 82, 2\r
  81 GET (50, 50)-(82, 82), font2(1, a)\r
  82 \r
  83 LINE (49, 49)-(83, 83), 0, BF\r
  84 putsym 50, 50, a\r
  85 smo 50, 50, 82, 82, 3\r
  86 GET (50, 50)-(82, 82), font3(1, a)\r
  87 \r
  88 NEXT a\r
  89 CLS\r
  90 END SUB\r
  91 \r
  92 SUB pt (x, y)\r
  93 x1 = x * 32 + 12\r
  94 y1 = y * 32 + 15\r
  95 \r
  96 a = pag(x, y)\r
  97 b = pah(x, y)\r
  98 \r
  99 IF a = 0 THEN\r
 100 LINE (x1, y1)-(x1 + 32, y1 + 32), 0, BF\r
 101 ELSE\r
 102 SELECT CASE b\r
 103 CASE 1\r
 104 PUT (x1, y1), font1(1, a), PSET\r
 105 CASE 2\r
 106 PUT (x1, y1), font2(1, a), PSET\r
 107 CASE 3\r
 108 PUT (x1, y1), font3(1, a), PSET\r
 109 END SELECT\r
 110 END IF\r
 111 \r
 112 END SUB\r
 113 \r
 114 SUB putsym (x, y, a)\r
 115 SELECT CASE a\r
 116 CASE 1\r
 117 LINE (x + 10, y + 5)-(x + 10, y + 20), 14\r
 118 LINE (x + 5, y + 15)-(x + 20, y + 15), 14\r
 119 LINE (x + 15, y + 25)-(x + 20, y + 25), 14\r
 120 LINE (x + 20, y + 25)-(x + 25, y + 20), 14\r
 121 LINE (x + 25, y + 20)-(x + 25, y + 5), 14\r
 122 CASE 2\r
 123 LINE (x + 5, y + 15)-(x + 25, y + 10), 14\r
 124 LINE (x + 15, y + 5)-(x + 10, y + 25), 14\r
 125 LINE (x + 25, y + 5)-(x + 20, y + 20), 14\r
 126 LINE (x + 20, y + 30)-(x + 30, y + 20), 14\r
 127 CASE 3\r
 128 LINE (x + 5, y + 5)-(x + 5, y + 25), 14\r
 129 LINE (x + 5, y + 5)-(x + 25, y + 25), 14\r
 130 LINE (x + 5, y + 25)-(x + 25, y + 25), 14\r
 131 LINE (x + 10, y + 10)-(x + 25, y + 5), 14\r
 132 CASE 4\r
 133 LINE (x + 10, y + 5)-(x + 20, y + 5), 14\r
 134 LINE (x + 20, y + 5)-(x + 25, y + 10), 14\r
 135 LINE (x + 25, y + 20)-(x + 20, y + 25), 14\r
 136 LINE (x + 20, y + 25)-(x + 10, y + 25), 14\r
 137 LINE (x + 10, y + 25)-(x + 10, y + 5), 14\r
 138 LINE (x + 5, y + 15)-(x + 20, y + 15), 14\r
 139 CASE 5\r
 140 LINE (x + 5, y + 5)-(x + 10, y + 10), 14\r
 141 LINE (x + 10, y + 10)-(x + 10, y + 25), 14\r
 142 LINE (x + 10, y + 25)-(x + 5, y + 30), 14\r
 143 LINE (x + 10, y + 25)-(x + 15, y + 30), 14\r
 144 LINE (x + 15, y + 30)-(x + 25, y + 30), 14\r
 145 LINE (x + 10, y + 20)-(x + 25, y + 20), 14\r
 146 CASE 6\r
 147 LINE (x + 5, y + 5)-(x + 10, y + 5), 14\r
 148 LINE (x + 5, y + 5)-(x + 5, y + 10), 14\r
 149 LINE (x + 10, y + 10)-(x + 10, y + 15), 14\r
 150 LINE (x + 10, y + 15)-(x + 20, y + 30), 14\r
 151 LINE (x + 20, y + 30)-(x + 25, y + 30), 14\r
 152 LINE (x + 5, y + 30)-(x + 10, y + 30), 14\r
 153 LINE (x + 25, y + 15)-(x + 10, y + 30), 14\r
 154 CASE 7\r
 155 LINE (x + 5, y + 15)-(x + 10, y + 15), 14\r
 156 LINE (x + 10, y + 15)-(x + 25, y + 5), 14\r
 157 LINE (x + 5, y + 25)-(x + 10, y + 25), 14\r
 158 LINE (x + 10, y + 25)-(x + 15, y + 5), 14\r
 159 LINE (x + 20, y + 5)-(x + 20, y + 20), 14\r
 160 PSET (x + 15, y + 25), 14\r
 161 PSET (x + 22, y + 25), 14\r
 162 CASE 8\r
 163 'line (x+,y+)-(x+,y+),15\r
 164 LINE (x + 15, y + 10)-(x + 15, y + 25), 14\r
 165 LINE (x + 20, y + 15)-(x + 20, y + 25), 14\r
 166 LINE (x + 5, y + 20)-(x + 10, y + 25), 14\r
 167 LINE (x + 10, y + 25)-(x + 25, y + 25), 14\r
 168 CASE 9\r
 169 LINE (x + 5, y + 5)-(x + 25, y + 5), 14\r
 170 LINE (x + 15, y + 5)-(x + 5, y + 20), 14\r
 171 LINE (x + 15, y + 5)-(x + 25, y + 20), 14\r
 172 LINE (x + 15, y + 5)-(x + 15, y + 25), 14\r
 173 LINE (x + 5, y + 30)-(x + 20, y + 20), 14\r
 174 \r
 175 END SELECT\r
 176 \r
 177 \r
 178 \r
 179 \r
 180 END SUB\r
 181 \r
 182 SUB setpal (b)\r
 183 SELECT CASE b\r
 184 CASE 2\r
 185 FOR a = 0 TO 14\r
 186 OUT &H3C8, a\r
 187 OUT &H3C9, a * 2\r
 188 OUT &H3C9, a * 4.5\r
 189 OUT &H3C9, a * 3\r
 190 NEXT a\r
 191 CASE 1\r
 192 FOR a = 0 TO 14\r
 193 OUT &H3C8, a\r
 194 OUT &H3C9, 0\r
 195 OUT &H3C9, 0\r
 196 OUT &H3C9, 0\r
 197 NEXT a\r
 198 OUT &H3C8, 15\r
 199 OUT &H3C9, 20\r
 200 OUT &H3C9, 63\r
 201 OUT &H3C9, 63\r
 202 END SELECT\r
 203 END SUB\r
 204 \r
 205 SUB smo (x1, y1, x2, y2, r)\r
 206 \r
 207 c1 = 0\r
 208 \r
 209 FOR y = y1 TO y2\r
 210 FOR x = x1 TO x2\r
 211 c = POINT(x, y)\r
 212 c1 = c1 - 5\r
 213 IF c1 < 0 THEN c1 = 0\r
 214 IF c > c1 THEN c1 = c\r
 215 PSET (x, y), c1\r
 216 NEXT x\r
 217 NEXT y\r
 218 \r
 219 FOR x = x1 TO x2\r
 220 c1 = 0\r
 221 FOR y = y1 TO y2\r
 222 c = POINT(x, y)\r
 223 c1 = c1 - 5\r
 224 IF c1 < 0 THEN c1 = 0\r
 225 IF c > c1 THEN c1 = c\r
 226 PSET (x, y), c1\r
 227 NEXT y\r
 228 NEXT x\r
 229  \r
 230 \r
 231 FOR y = y1 TO y2\r
 232 c1 = 0\r
 233 FOR x = x2 TO x1 STEP -1\r
 234 c = POINT(x, y)\r
 235 c1 = c1 - 5\r
 236 IF c1 < 0 THEN c1 = 0\r
 237 IF c > c1 THEN c1 = c\r
 238 PSET (x, y), c1\r
 239 NEXT x\r
 240 NEXT y\r
 241 \r
 242 \r
 243 FOR x = x1 TO x2\r
 244 c1 = 0\r
 245 FOR y = y2 TO y1 STEP -1\r
 246 c = POINT(x, y)\r
 247 c1 = c1 - 5\r
 248 IF c1 < 0 THEN c1 = 0\r
 249 IF c > c1 THEN c1 = c\r
 250 PSET (x, y), c1\r
 251 NEXT y\r
 252 NEXT x\r
 253 \r
 254 \r
 255 \r
 256 \r
 257 IF r = 1 THEN GOTO 1\r
 258 rr = r + 1\r
 259 \r
 260 \r
 261 FOR y = y1 TO y2\r
 262 c1 = 0\r
 263 FOR x = x1 TO x2\r
 264 c = POINT(x, y)\r
 265 c1 = (c1 * r + c) / rr\r
 266 c2 = c1 - r\r
 267 IF c2 < 0 THEN c2 = 0\r
 268 PSET (x, y), c2\r
 269 NEXT x\r
 270 NEXT y\r
 271 \r
 272 FOR x = x1 TO x2\r
 273 c1 = 0\r
 274 FOR y = y1 TO y2\r
 275 c = POINT(x, y)\r
 276 c1 = c1 - 5\r
 277 IF c1 < 0 THEN c1 = 0\r
 278 IF c > c1 THEN c1 = c\r
 279 PSET (x, y), c1\r
 280 NEXT y\r
 281 NEXT x\r
 282 \r
 283 \r
 284 FOR y = y1 TO y2\r
 285 c1 = 0\r
 286 FOR x = x2 TO x1 STEP -1\r
 287 c = POINT(x, y)\r
 288 c1 = c1 - 5\r
 289 IF c1 < 0 THEN c1 = 0\r
 290 IF c > c1 THEN c1 = c\r
 291 PSET (x, y), c1\r
 292 NEXT x\r
 293 NEXT y\r
 294 \r
 295 \r
 296 FOR x = x1 TO x2\r
 297 c1 = 0\r
 298 FOR y = y2 TO y1 STEP -1\r
 299 c = POINT(x, y)\r
 300 c1 = c1 - 5\r
 301 IF c1 < 0 THEN c1 = 0\r
 302 IF c > c1 THEN c1 = c\r
 303 PSET (x, y), c1\r
 304 NEXT y\r
 305 NEXT x\r
 306 \r
 307 1\r
 308 \r
 309 \r
 310 \r
 311 END SUB\r
 312 \r
 313 SUB start\r
 314 SCREEN 12\r
 315 setpal 1\r
 316 getfnt\r
 317 setpal 2\r
 318 \r
 319 END SUB\r
 320 \r