graphics/animations/matrix4.bas

   1 ' by Svjatoslav Agejenko svjatoslav@svjatoslav.eu\r
   2 ' 2003.04\r
   3 \r
   4 DECLARE FUNCTION getc% ()\r
   5 DECLARE SUB mks ()\r
   6 DEFINT A-Y\r
   7 DECLARE SUB disp ()\r
   8 DECLARE SUB shpal ()\r
   9 DECLARE SUB start ()\r
  10 \r
  11 DIM SHARED buf(1 TO 40, 1 TO 25) AS INTEGER\r
  12 DIM SHARED col(1 TO 40, 1 TO 25) AS INTEGER\r
  13 DIM SHARED snd(1 TO 20)\r
  14 DIM SHARED sndp\r
  15 \r
  16 start\r
  17 'shpal\r
  18 \r
  19 FOR y = 1 TO 25\r
  20   FOR x = 1 TO 40\r
  21     buf(x, y) = getc\r
  22   NEXT x\r
  23 NEXT y\r
  24 \r
  25 FOR y = 1 TO 25\r
  26   FOR x = 1 TO 40\r
  27     col(x, y) = 1\r
  28   NEXT x\r
  29 NEXT y\r
  30 \r
  31 act = 0\r
  32 1\r
  33 mks\r
  34 frm = frm + 1\r
  35 IF frm > 10000 THEN frm = 1\r
  36 FOR y = 25 TO 2 STEP -1\r
  37   FOR x = 1 TO 40\r
  38     buf(x, y) = buf(x, y - 1)\r
  39   NEXT x\r
  40 NEXT y\r
  41 mks\r
  42 FOR x = 1 TO 40\r
  43   buf(x, 1) = buf(x, 25)\r
  44 NEXT x\r
  45 buf(RND * 39 + 1, RND * 10 + 1) = getc\r
  46 act = act + 1\r
  47 disp\r
  48 SELECT CASE act\r
  49 CASE 1\r
  50          FOR a = 1 TO 20\r
  51            snd(a) = 0\r
  52            IF RND * 100 < 2 THEN snd(a) = RND * 4000 + 4000\r
  53          NEXT a\r
  54          b = SIN(frm / 100) * 3 + 6\r
  55          FOR a = 1 TO 20 STEP b\r
  56            snd(a) = 10000\r
  57          NEXT a\r
  58 \r
  59 CASE 2\r
  60          c = RND * 5\r
  61          x1 = RND * 38 + 1\r
  62          y = RND * 23 + 1\r
  63          x2 = RND * 38 + 1\r
  64          IF x1 > x2 THEN SWAP x1, x2\r
  65          FOR x = x1 TO x2\r
  66            col(x, y) = c\r
  67          NEXT x\r
  68 CASE 3\r
  69          c = RND * 5\r
  70          y1 = RND * 23 + 1\r
  71          x = RND * 38 + 1\r
  72          y2 = RND * 23 + 1\r
  73          IF y1 > y2 THEN SWAP x1, x2\r
  74          FOR y = y1 TO y2\r
  75            col(x, y) = c\r
  76          NEXT y\r
  77 CASE 4\r
  78         IF RND * 100 < 20 THEN\r
  79         FOR y = 1 TO 25\r
  80            FOR x = 1 TO 40\r
  81              IF col(x, y) > 1 THEN col(x, y) = col(x, y) - 1\r
  82            NEXT x\r
  83          NEXT y\r
  84         END IF\r
  85 CASE 5\r
  86         IF RND * 100 < 5 THEN\r
  87         FOR y = 1 TO 25 STEP 2\r
  88            FOR x = 1 TO 40\r
  89              col(x, y) = 1\r
  90            NEXT x\r
  91          NEXT y\r
  92         END IF\r
  93 CASE 6\r
  94         IF RND * 100 < 5 THEN\r
  95         FOR x = 1 TO 40 STEP 2\r
  96            FOR y = 1 TO 25\r
  97              col(x, y) = 1\r
  98            NEXT y\r
  99          NEXT x\r
 100         END IF\r
 101 CASE 7\r
 102         FOR a = 1 TO 30\r
 103           col(RND * 39 + 1, RND * 23 + 1) = RND * 4 + 1\r
 104         NEXT a\r
 105 CASE 8\r
 106         IF INKEY$ <> "" THEN SYSTEM\r
 107         act = 0\r
 108 END SELECT\r
 109 GOTO 1\r
 110 \r
 111 SYSTEM\r
 112 \r
 113 SUB disp\r
 114 \r
 115 mks\r
 116 LOCATE 1, 1\r
 117 FOR y = 1 TO 10\r
 118 FOR x = 1 TO 40\r
 119 COLOR col(x, y), 0\r
 120 PRINT CHR$(buf(x, y));\r
 121 NEXT x\r
 122 NEXT y\r
 123 mks\r
 124 FOR y = 11 TO 20\r
 125 FOR x = 1 TO 40\r
 126 COLOR col(x, y), 0\r
 127 PRINT CHR$(buf(x, y));\r
 128 NEXT x\r
 129 NEXT y\r
 130 mks\r
 131 FOR y = 21 TO 25\r
 132 FOR x = 1 TO 40\r
 133 COLOR col(x, y), 0\r
 134 PRINT CHR$(buf(x, y));\r
 135 NEXT x\r
 136 NEXT y\r
 137 mks\r
 138 \r
 139 END SUB\r
 140 \r
 141 FUNCTION getc\r
 142 IF RND * 100 > 50 THEN\r
 143   a = RND * 9 + 48\r
 144 ELSE\r
 145   a = RND * 25 + 65\r
 146 END IF\r
 147 IF RND * 100 < 15 THEN a = 32\r
 148 getc = a\r
 149 END FUNCTION\r
 150 \r
 151 SUB mks\r
 152 sndp = sndp + 1\r
 153 IF sndp > 20 THEN sndp = 1\r
 154 SOUND snd(sndp), .07\r
 155 'SOUND 0, .07\r
 156 END SUB\r
 157 \r
 158 SUB shpal\r
 159 \r
 160 FOR a = 0 TO 16\r
 161 COLOR a\r
 162 PRINT a, "Palette test"\r
 163 NEXT a\r
 164 a$ = INPUT$(1)\r
 165 END SUB\r
 166 \r
 167 SUB start\r
 168 RANDOMIZE TIMER\r
 169 CLS\r
 170 WIDTH 40, 25\r
 171 VIEW PRINT 1 TO 25\r
 172 \r
 173   OUT &H3C8, 0\r
 174   OUT &H3C9, 0\r
 175   OUT &H3C9, 0\r
 176   OUT &H3C9, 0\r
 177 \r
 178 FOR a = 1 TO 5\r
 179   OUT &H3C8, a\r
 180 \r
 181   b = a * 5\r
 182   g = a * 10 + 20\r
 183   r = a * 0\r
 184 \r
 185   IF r > 63 THEN r = 63\r
 186   IF g > 63 THEN g = 63\r
 187   IF b > 63 THEN b = 63\r
 188   OUT &H3C9, r\r
 189   OUT &H3C9, g\r
 190   OUT &H3C9, b\r
 191 NEXT a\r
 192 \r
 193 END SUB\r
 194 \r