graphics/4D engine/qeng.bas

   1 ' 4D engine\r
   2 ' made by Svjatoslav Agejenko\r
   3 ' in 2003.08\r
   4 ' H-Page: svjatoslav.eu\r
   5 ' E-Mail: svjatoslavagejenko@gmail.com\r
   6  \r
   7 DECLARE SUB chlin (x1!, y1!, z1!, q1!, x2!, y2!, z2!, q2!)\r
   8 DECLARE SUB rot (x1!, y1!, z1!, q1!, x4!, y4!, z4!, q4!)\r
   9 DECLARE SUB setpal ()\r
  10 DECLARE SUB getp (x1!, y1!, z1!, q1!, x2!, y2!, z2!, q2!, n!, rx!, ry!, rz!, rq!)\r
  11 DECLARE SUB qpyra (x1!, y1!, z1!, q1!, x2!, y2!, z2!, q2!, x3!, y3!, z3!, q3!, x4!, y4!, z4!, q4!, x5!, y5!, z5!, q5!)\r
  12 DECLARE FUNCTION vahe! (x1!, y1!, z1!, q1!, x2!, y2!, z2!, q2!)\r
  13 DIM SHARED siz\r
  14 DIM SHARED an1, an2, an3, an4, an5, an6\r
  15 DIM SHARED myx, myy, myz, myq\r
  16 DIM SHARED pi\r
  17 DIM SHARED s1, s2, s3, s4, s5, s6\r
  18 DIM SHARED c1, c2, c3, c4, c5, c6\r
  19 \r
  20 DIM SHARED px(1 TO 10)\r
  21 DIM SHARED py(1 TO 10)\r
  22 DIM SHARED pm\r
  23 DIM SHARED frm\r
  24 \r
  25 PRINT " 4D Engine, 2003.08"\r
  26 PRINT " Svjatoslav Agejenko: n0@hot.ee"\r
  27 PRINT ""\r
  28 PRINT " use keys:"\r
  29 PRINT "       rotate:"\r
  30 PRINT "               qw - XZ"\r
  31 PRINT "               as - YZ"\r
  32 PRINT "               zx - XY"\r
  33 PRINT "               er - QX"\r
  34 PRINT "               df - QY"\r
  35 PRINT "               cv - QZ"\r
  36 PRINT "       move:"\r
  37 PRINT "               46 - x"\r
  38 PRINT "               82 - y"\r
  39 PRINT "               71 - z"\r
  40 PRINT "               -+ - q"\r
  41 PRINT\r
  42 PRINT "       ESC - to quit program"\r
  43 PRINT\r
  44 PRINT "press any key to continue..."\r
  45 a$ = INPUT$(1)\r
  46 \r
  47 pi = 3.1415\r
  48 \r
  49 an1 = pi * .5\r
  50 an2 = an1\r
  51 an3 = an1\r
  52 an4 = an1\r
  53 an5 = an1\r
  54 an6 = an1\r
  55 \r
  56 myx = 0\r
  57 myy = 0\r
  58 myz = 0\r
  59 myq = .5\r
  60 SCREEN 12\r
  61 setpal\r
  62 \r
  63 \r
  64 1\r
  65 CLS\r
  66 s1 = SIN(an1): c1 = COS(an1)\r
  67 s2 = SIN(an2): c2 = COS(an2)\r
  68 s3 = SIN(an3): c3 = COS(an3)\r
  69 s4 = SIN(an4): c4 = COS(an4)\r
  70 s5 = SIN(an5): c5 = COS(an5)\r
  71 s6 = SIN(an6): c6 = COS(an6)\r
  72 \r
  73 FOR frm = 1 TO 15 STEP 3\r
  74   qpyra -10, -10, -10, 0, 10, -10, -10, 0, 0, -10, 10, 0, 0, 10, 0, 0, 0, 0, 0, 10\r
  75 NEXT frm\r
  76 \r
  77 a$ = INPUT$(1)\r
  78 \r
  79 SELECT CASE a$\r
  80 CASE CHR$(27)\r
  81   SYSTEM\r
  82 CASE "q"\r
  83   an1 = an1 + .1\r
  84 CASE "w"\r
  85   an1 = an1 - .1\r
  86 CASE "a"\r
  87   an2 = an2 + .1\r
  88 CASE "s"\r
  89   an2 = an2 - .1\r
  90 CASE "z"\r
  91   an3 = an3 + .1\r
  92 CASE "x"\r
  93   an3 = an3 - .1\r
  94 CASE "e"\r
  95   an4 = an4 + .1\r
  96 CASE "r"\r
  97   an4 = an4 - .1\r
  98 CASE "d"\r
  99   an5 = an5 + .1\r
 100 CASE "f"\r
 101   an5 = an5 - .1\r
 102 CASE "c"\r
 103   an6 = an6 + .1\r
 104 CASE "v"\r
 105   an6 = an6 - .1\r
 106 \r
 107 CASE "4"\r
 108   myx = myx - 3\r
 109 CASE "6"\r
 110   myx = myx + 3\r
 111 CASE "8"\r
 112   myz = myz + 3\r
 113 CASE "2"\r
 114   myz = myz - 3\r
 115 CASE "7"\r
 116   myy = myy + 3\r
 117 CASE "1"\r
 118   myy = myy - 3\r
 119 CASE "+"\r
 120   myq = myq + .3\r
 121 CASE "-"\r
 122   myq = myq - .3\r
 123 \r
 124 END SELECT\r
 125 GOTO 1\r
 126 \r
 127 SUB chlin (ox1, oy1, oz1, oq1, ox2, oy2, oz2, oq2)\r
 128 x1 = ox1: y1 = oy1: z1 = oz1: q1 = oq1\r
 129 x2 = ox2: y2 = oy2: z2 = oz2: q2 = oq2\r
 130 \r
 131 IF (q1 > myq) AND (q2 < myq) THEN\r
 132   SWAP x1, x2\r
 133   SWAP y1, y2\r
 134   SWAP z1, z2\r
 135   SWAP q1, q2\r
 136 END IF\r
 137 \r
 138 IF (q1 < myq) AND (q2 > myq) THEN\r
 139   vq = q2 - q1\r
 140   vmq = myq - q1\r
 141   jt = vmq / vq\r
 142   pm = pm + 1\r
 143   rx = (x2 - x1) * jt + x1\r
 144   ry = (y2 - y1) * jt + y1\r
 145   rz = (z2 - z1) * jt + z1 + 50\r
 146   px(pm) = rx / rz * 700 + 320\r
 147   py(pm) = ry / rz * 700 + 240\r
 148 END IF\r
 149 END SUB\r
 150 \r
 151 SUB getp (x1, y1, z1, q1, x2, y2, z2, q2, n, rx, ry, rz, rq)\r
 152 xv = x2 - x1\r
 153 yv = y2 - y1\r
 154 zv = z2 - z1\r
 155 qv = q2 - q1\r
 156 \r
 157 rx = x1 + (xv * n)\r
 158 ry = y1 + (yv * n)\r
 159 rz = z1 + (zv * n)\r
 160 rq = q1 + (qv * n)\r
 161 END SUB\r
 162 \r
 163 SUB qpyra (ox1, oy1, oz1, oq1, ox2, oy2, oz2, oq2, ox3, oy3, oz3, oq3, ox4, oy4, oz4, oq4, ox5, oy5, oz5, oq5)\r
 164 \r
 165 ox1 = ox1 - myx\r
 166 oy1 = oy1 - myy\r
 167 oz1 = oz1 - myz\r
 168 oq1 = oq1 - myq - frm\r
 169 \r
 170 ox2 = ox2 - myx\r
 171 oy2 = oy2 - myy\r
 172 oz2 = oz2 - myz\r
 173 oq2 = oq2 - myq - frm\r
 174 \r
 175 ox3 = ox3 - myx\r
 176 oy3 = oy3 - myy\r
 177 oz3 = oz3 - myz\r
 178 oq3 = oq3 - myq - frm\r
 179 \r
 180 ox4 = ox4 - myx\r
 181 oy4 = oy4 - myy\r
 182 oz4 = oz4 - myz\r
 183 oq4 = oq4 - myq - frm\r
 184 \r
 185 ox5 = ox5 - myx\r
 186 oy5 = oy5 - myy\r
 187 oz5 = oz5 - myz\r
 188 oq5 = oq5 - myq - frm\r
 189 \r
 190 rot ox1, oy1, oz1, oq1, x1, y1, z1, q1\r
 191 rot ox2, oy2, oz2, oq2, x2, y2, z2, q2\r
 192 rot ox3, oy3, oz3, oq3, x3, y3, z3, q3\r
 193 rot ox4, oy4, oz4, oq4, x4, y4, z4, q4\r
 194 rot ox5, oy5, oz5, oq5, x5, y5, z5, q5\r
 195 \r
 196 pm = 0\r
 197 \r
 198 chlin x1, y1, z1, q1, x2, y2, z2, q2\r
 199 chlin x1, y1, z1, q1, x3, y3, z3, q3\r
 200 chlin x1, y1, z1, q1, x4, y4, z4, q4\r
 201 chlin x1, y1, z1, q1, x5, y5, z5, q5\r
 202 \r
 203 chlin x2, y2, z2, q2, x3, y3, z3, q3\r
 204 chlin x2, y2, z2, q2, x4, y4, z4, q4\r
 205 chlin x2, y2, z2, q2, x5, y5, z5, q5\r
 206 \r
 207 chlin x3, y3, z3, q3, x4, y4, z4, q4\r
 208 chlin x3, y3, z3, q3, x5, y5, z5, q5\r
 209 \r
 210 chlin x4, y4, z4, q4, x5, y5, z5, q5\r
 211 \r
 212 FOR a = 1 TO pm\r
 213   FOR b = a + 1 TO pm\r
 214     LINE (px(a), py(a))-(px(b), py(b)), 15 - frm\r
 215   NEXT b\r
 216 NEXT a\r
 217 \r
 218 \r
 219 END SUB\r
 220 \r
 221 SUB rot (x1, y1, z1, q1, x4, y4, z4, q4)\r
 222 \r
 223 ' qx\r
 224 q2 = q1 * s4 - x1 * c4\r
 225 x2 = q1 * c4 + x1 * s4\r
 226 \r
 227 ' qy\r
 228 q3 = q2 * s5 - y1 * c5\r
 229 y2 = q2 * c5 + y1 * s5\r
 230 \r
 231 ' qz\r
 232 q4 = q3 * s6 - z1 * c6\r
 233 z2 = q3 * c6 + z1 * s6\r
 234 \r
 235 ' zx\r
 236 x3 = x2 * s1 - z2 * c1\r
 237 z3 = x2 * c1 + z2 * s1\r
 238 \r
 239 ' zy\r
 240 y3 = y2 * s2 - z3 * c2\r
 241 z4 = y2 * c2 + z3 * s2\r
 242 \r
 243 ' xy\r
 244 y4 = y3 * s3 - x3 * c3\r
 245 x4 = y3 * c3 + x3 * s3\r
 246 \r
 247 \r
 248 END SUB\r
 249 \r
 250 SUB setpal\r
 251 \r
 252 FOR a = 0 TO 15\r
 253   OUT &H3C8, a\r
 254   OUT &H3C9, a * 4\r
 255   OUT &H3C9, a * 4\r
 256   OUT &H3C9, a * 4\r
 257   LINE (a, 0)-(a, 400), a\r
 258 NEXT a\r
 259 'a$ = INPUT$(1)\r
 260 END SUB\r
 261 \r
 262 FUNCTION vahe (x1, y1, z1, q1, x2, y2, z2, q2)\r
 263 vahe = SQR((x1 - x2) ^ 2 + (y1 - y2) ^ 2 + (z1 - z2) ^ 2 + (q1 - q2) ^ 2)\r
 264 END FUNCTION\r
 265 \r