Keskustelu: Koodit: QB: 3D-Starfield

' 3D-starfield with antialiased pixels and camera
' Author: fawkz <_____@luukku.com>
' You can put up somekind of delay if it runs too fast for you...
' ..or increase the amount of stars.
' For my 150MHz Pentium 200 stars seems to be a quite good value..
' Not too fast, but not too slow neither.
' On a GHz-puter you might want maybe about 1000-2000 stars :)

DEFINT A-Z
DECLARE SUB APIXEL (wx AS DOUBLE, wy AS DOUBLE, c AS DOUBLE)

' 320x200 w/ 256 colors.. good ol' mode13h
SCREEN 13

' set grayscale-palette
OUT &H3C8, 0
FOR c = 0 TO 255
  OUT &H3C9, INT(c / 4)
  OUT &H3C9, INT(c / 4)
  OUT &H3C9, INT(c / 4)
NEXT

' type for 3d-star
TYPE star3
  x AS DOUBLE
  y AS DOUBLE
  z AS DOUBLE
  v AS DOUBLE ' velocity
END TYPE

' this is type for star when it's projected to 2d-cordinates
TYPE star2
  x AS DOUBLE
  y AS DOUBLE
END TYPE

' camera -type, it doesn't have a position (because we don't need it :)
' just an angles.. and velocities for it's movement
TYPE camera
  xan AS DOUBLE ' angles for each x, y, and z
  yan AS DOUBLE
  zan AS DOUBLE
  xve AS DOUBLE ' velocities
  yve AS DOUBLE
  zve AS DOUBLE
  xac AS DOUBLE ' accelerations
  yac AS DOUBLE
  zac AS DOUBLE
END TYPE

CONST CENTERX = 160   ' screen horizontal center
CONST CENTERY = 100   ' and vertical..
CONST STARS = 200     ' amount of stars (will be 0-STARS so 200 means 201 stars)
CONST SCALE = 255     ' scale
CONST ACC = .00001    ' acceleration value
CONST DAMP = .99      ' damping value for smooth movement..

DIM s(STARS) AS star3   ' 3d-stars..
DIM ss(STARS) AS star2  ' ..projected to 2d-screen
DIM n AS star3          ' for 3d-rotation
DIM r AS star3          ' rotated position
DIM cam AS camera       ' make a camera :)

RANDOMIZE TIMER         ' initialize rng by timer

FOR i = 0 TO STARS      ' get random positions+velocities for stars
  s(i).x = (RND * 1000) - 500
  s(i).y = (RND * 1000) - 500
  s(i).z = (RND * 100) + 900
  s(i).v = (RND * 50) + 5
NEXT i

DO
  ' handle camera-rotations, increase accelerations
  cam.xac = (cam.xac + (RND * ACC * 2) - ACC)
  cam.yac = (cam.yac + (RND * ACC * 2) - ACC)
  cam.zac = (cam.zac + (RND * ACC * 2) - ACC)

  ' increase velocities (accelerate)
  cam.xve = cam.xve + cam.xac
  cam.yve = cam.yve + cam.yac
  cam.zve = cam.zve + cam.zac

  ' damp the motion (will go more and more towards zero)
  cam.xac = cam.xac * DAMP
  cam.yac = cam.yac * DAMP
  cam.zac = cam.zac * DAMP

  ' ..same here
  cam.xve = cam.xve * DAMP
  cam.yve = cam.yve * DAMP
  cam.zve = cam.zve * DAMP

  ' get new angles.. move the camera..
  cam.xan = (cam.xan + cam.xve) * DAMP
  cam.yan = (cam.yan + cam.yve) * DAMP
  cam.zan = (cam.zan + cam.zve) * DAMP

  FOR i = 0 TO STARS               ' loop for all stars..
    APIXEL ss(i).x, ss(i).y, 0       ' erase old star
    s(i).z = s(i).z - s(i).v         ' move star on z-axis

    ' rotate stars.. based on the camera-angle
    ' around the x-axis
    n.y = COS(cam.xan) * s(i).y - SIN(cam.xan) * s(i).z
    n.z = SIN(cam.xan) * s(i).y - COS(cam.xan) * s(i).z

    ' around the y-axis
    n.x = COS(cam.yan) * s(i).x + SIN(cam.yan) * n.z
    r.z = -SIN(cam.yan) * s(i).x + COS(cam.yan) * n.z

    ' and around the z-axis
    r.x = COS(cam.zan) * n.x - SIN(cam.zan) * n.y
    r.y = SIN(cam.zan) * n.x + COS(cam.zan) * n.y

    ' project the stars to screen 2d-coordinates
    ss(i).x = r.x / r.z * SCALE + CENTERX
    ss(i).y = r.y / r.z * SCALE + CENTERY

    IF ss(i).x < 0 OR ss(i).x > CENTERX * 2 OR ss(i).y < 0 OR ss(i).y > CENTERY * 2 OR s(i).z < 1 THEN
      ' if star out from screen or z below zero..
      ' get a new random position & velocity for star
      s(i).x = (RND * 1000) - 500
      s(i).y = (RND * 1000) - 500
      s(i).z = (RND * 100) + 900
      s(i).v = (RND * 50) + 5
    END IF
    ' plot antialiased pixel.. :)
    APIXEL ss(i).x, ss(i).y, 255 - (s(i).z * (255 / 1000))
  NEXT
LOOP UNTIL INKEY$ = CHR$(27) ' loop until ESC-pressed

DEFSNG A-Z
SUB APIXEL (wx AS DOUBLE, wy AS DOUBLE, c AS DOUBLE)
  ' antialiased-pixel routine.. basicly the "pixel"
  ' consists of 4 pixels, which colors are calculated
  ' based on the position (floating point) of them..
  ' wx & wy are coordinates, c is brightness

  DIM x AS LONG, y AS LONG
  DIM fx AS DOUBLE, fy AS DOUBLE
  DIM btl AS LONG, btr AS LONG, bbl AS LONG, bbr AS LONG

  x = INT(wx): y = INT(wy)                ' integer part
  fx = wx - x: fy = wy - y                ' fractional part

  ' calculate colors
  btl = (1 - fx) * (1 - fy) * c
  btr = (fx) * (1 - fy) * c
  bbl = (1 - fx) * (fy) * c
  bbr = (fx) * (fy) * c

  ' put pixels
  PSET (x, y), btl
  PSET (x + 1, y), btr
  PSET (x, y + 1), bbl
  PSET (x + 1, y + 1), bbr
END SUB