graphics/3D/stars.bas

   1 ' 3D starfield\r
   2 ' made by Svjatoslav Agejenko\r
   3 ' in 2003.03\r
   4 ' H-Page: svjatoslav.eu\r
   5 ' E-Mail: svjatoslav@svjatoslav.eu\r
   6 \r
   7 DECLARE SUB setstar (x2!, y2!, z2!)\r
   8 DECLARE SUB galaxy ()\r
   9 Dim Shared mitu\r
  10 Dim Shared mituv\r
  11 \r
  12 \r
  13 Randomize Timer\r
  14 mituv = 2000\r
  15 mitu = mituv\r
  16 rns = 500\r
  17 wl = 0\r
  18 \r
  19 Dim Shared px(1 To mitu + 1000)\r
  20 Dim Shared py(1 To mitu + 1000)\r
  21 Dim Shared pz(1 To mitu + 1000)\r
  22 \r
  23 For a = 1 To mitu\r
  24     pz(a) = Rnd * 500 + 20\r
  25     n = Rnd * 100\r
  26     px(a) = Sin(n) * 20\r
  27     py(a) = Cos(n) * 20\r
  28 Next a\r
  29 \r
  30 \r
  31 Screen 13\r
  32 \r
  33 \r
  34 frm = 10\r
  35 1\r
  36 fps = fps + 1\r
  37 If tm$ <> Time$ Then\r
  38     'LOCATE 1, 1\r
  39     'PRINT fps\r
  40     If fps > 20 Then wl = wl + 2 Else wl = wl - 1\r
  41     If wl < 0 Then wl = 0\r
  42     fps = 0\r
  43     tm$ = Time$\r
  44 End If\r
  45 frm = frm + 1\r
  46 xp = Sin(frm / 21) * 3\r
  47 yp = Sin(frm / 18) * 3\r
  48 \r
  49 nrk = (3.1412) / 2 + Sin(frm / 35) / 100 + Sin(frm / 21) / 100\r
  50 rs1 = Sin(nrk)\r
  51 rc1 = Cos(nrk)\r
  52 \r
  53 For a = 1 To mitu\r
  54     x = px(a)\r
  55     y = py(a)\r
  56     z = pz(a)\r
  57     x1 = x / z * 160 + 160\r
  58     y1 = y / z * 100 + 100\r
  59     PSet (x1, y1), 0\r
  60 \r
  61     x5 = x * rs1 - y * rc1\r
  62     y5 = x * rc1 + y * rs1\r
  63 \r
  64     x = x5\r
  65     y = y5\r
  66 \r
  67     z = z - 3\r
  68     x = x + xp\r
  69     y = y + yp\r
  70     If z < 10 Then\r
  71         z = Rnd * 300 + 400\r
  72         x = Rnd * 800 - 400\r
  73         y = Rnd * 800 - 400\r
  74     End If\r
  75 \r
  76     x1 = x / z * 160 + 160\r
  77     y1 = y / z * 100 + 100\r
  78     c = 3000 / z + 15\r
  79     If c > 31 Then c = 31\r
  80     PSet (x1, y1), c\r
  81 \r
  82     px(a) = x\r
  83     py(a) = y\r
  84     pz(a) = z\r
  85 Next a\r
  86 \r
  87 \r
  88 If mituv - mitu > rns Then galaxy: rns = Rnd * 800 + 100\r
  89 \r
  90 For a = 1 To 2\r
  91     b = Rnd * (mitu - 10) + 1\r
  92     Swap px(mitu), px(b)\r
  93     Swap py(mitu), py(b)\r
  94     Swap pz(mitu), pz(b)\r
  95 \r
  96     x = px(mitu)\r
  97     y = py(mitu)\r
  98     z = pz(mitu)\r
  99     x1 = x / z * 160 + 160\r
 100     y1 = y / z * 100 + 100\r
 101     PSet (x1, y1), 0\r
 102     mitu = mitu - 1\r
 103 Next a\r
 104 \r
 105 'LOCATE 2, 1\r
 106 'PRINT wl\r
 107 For a = 0 To wl\r
 108     For b = 0 To 1000\r
 109         c = c / 100\r
 110     Next b\r
 111 Next a\r
 112 \r
 113 If InKey$ <> "" Then System\r
 114 sound 0,1\r
 115 GoTo 1\r
 116 \r
 117 Sub galaxy\r
 118 \r
 119     xf = Rnd * 4 - 2\r
 120     yf = Rnd * 4 - 2\r
 121     xp = Rnd * 200 - 100\r
 122     yp = Rnd * 200 - 100\r
 123 \r
 124     For a = 1 To Rnd * 15 + 10 Step .04\r
 125         x = Sin(a) * a * a / 10\r
 126         y = Cos(a) * a * a / 10\r
 127         setstar x + Rnd * a * a / 30 + xp, y + Rnd * a * a / 30 + yp, 700 + Rnd * a * a / 30 + (x * xf) + (y * yf)\r
 128     Next a\r
 129 \r
 130     'SOUND 1000, 1\r
 131 End Sub\r
 132 \r
 133 Sub setstar (x2, y2, z2)\r
 134     mitu = mitu + 1\r
 135     s = mitu\r
 136 \r
 137     px(s) = x2\r
 138     py(s) = y2\r
 139     pz(s) = z2\r
 140 End Sub\r
 141 \r