Program: Virtual.bas

DECLARE SUB GETSCREEN ()
DECLARE SUB SETSTANDARD ()

'                              VIRTUAL.BAS
'              Revision 1.0    Original                 28 Dec 1995

CONST pi = 3.141592653589#
CONST pi2 = 2 * pi
CONST ESC = 27
CONST up = 72, DOWN = 80, LEFT = 75, RIGHT = 77

DIM SHARED xmax, ymax, xchrmax, ychrmax, fract
DIM SHARED scren0%, scren%
DIM SHARED c00(3), c0(3), c(3)  ' speed of sound,light and gravity
DIM SHARED dalp0%, dalp%          ' delta angle
DIM SHARED deltat0, deltat      ' delta time
DIM SHARED waittim0, waittim    ' wait time
DIM SHARED test%, nobjects
DIM SHARED title$               ' title
DIM SHARED cond, cond0          ' 0 = slow, 1 = fast
DIM x(3), y(3), xp(3), yp(3)
title$ = "Virtual Point Demonstration"
null$ = CHR$(0)                        ' See page 191

SETSTANDARD                            'set standard demo parameters.

s0:

s1:
SCREEN scren%: CLS
COLOR 15
LOCATE 1, 25: PRINT title$
LOCATE 14, 13: PRINT "O"
LOCATE ychrmax - 1, 1: PRINT "1 Use RIGHT (and LEFT) arrow key to move direction clock wise";
COLOR 7
LOCATE ychrmax, 1: PRINT "2 Use UP (and DOWN) arrow to increase (decrease) speed";

send = 0                       ' end condition
x0 = -100: y0 = 0
x(1) = 100: y(1) = y0: xp(1) = x(1): yp(1) = y(1)  ' point 1
x(2) = 100: y(2) = y0: xp(2) = x(2): yp(2) = y(2)  ' point 2
x(3) = 100: y(3) = y0: xp(3) = x(3): yp(3) = y(3)  ' point 3
x0disp = xmax / 2 - 100: y0disp = ymax / 2

alp% = 0: alpbase = 45            ' initial angle
dv = 1 * deltat                  ' delta speed = 1 * delta time
dispt = 4
dalpup = 0                       ' delta alpha up
v = 4: vbase = 0                 ' initial speed
countinit = 1: count = countinit      ' initial

PSET (x0disp + x0 * fract, y0disp - y0), 15
time1 = TIMER

str:
IF waittim > 0 THEN
  DO WHILE TIMER < time1 + waittim: LOOP     'update every 1 seconds
  time1 = TIMER
END IF

IF cond = 1 THEN new = 0
PSET (x0disp + x0 * fract, y0disp - y0), 15
PSET (x0disp + x(1) * fract, y0disp - y(1)), 15

vx = v * COS(alp% * pi / 180): vy = v * SIN(alp% * pi / 180)
vbasex = vbase * COS(alpbase * pi / 180): vbasey = vbase * SIN(alpbase * pi / 180)
x1o = x1s: y1o = y1s                   ' old arrow
x1baseo = x1bases: y1baseo = y1bases   ' old arrow
x0baseo = x0bases: y0baseo = y0bases   ' old arrow
x1o1 = x1s1: y1o1 = y1s1
x1o2 = x1s2: y1o2 = y1s2
x1s = x(1) + vx * dispt                ' new arrow end x
y1s = y(1) + vy * dispt                ' new arrow end y
x0bases = x0 + vbasex * dispt          ' new arrow end x
y0bases = y0 + vbasey * dispt          ' new arrow end y
x1bases = x(1) + vbasex * dispt        ' new arrow end x
y1bases = y(1) + vbasey * dispt        ' new arrow end y

LINE (x0disp + x(1) * fract, y0disp - y(1))-(x0disp + x1o * fract, y0disp - y1o), 0' clear
LINE (x0disp + x(1) * fract, y0disp - y(1))-(x0disp + x1s * fract, y0disp - y1s), 15' direction of movement arrow
LINE (x0disp + x(1) * fract, y0disp - y(1))-(x0disp + x1baseo * fract, y0disp - y1baseo), 0' clear
LINE (x0disp + x(1) * fract, y0disp - y(1))-(x0disp + x1bases * fract, y0disp - y1bases), 7' direction of movement arrow
LINE (x0disp + x0 * fract, y0disp - y0)-(x0disp + x0baseo * fract, y0disp - y0baseo), 0' clear
LINE (x0disp + x0 * fract, y0disp - y0)-(x0disp + x0bases * fract, y0disp - y0bases), 7' direction of movement arrow

IF new = 1 THEN
  count = count + 1
  FOR i% = 1 TO 3
    dx = x(i%) - x0: dy = y(i%) - y0: dist = SQR(dx * dx + dy * dy)
    t = dist / c(i%): xp(i%) = x(i%) - vx * t - vbasex * t: yp(i%) = y(i%) - vy * t - vbasey * t' virtual position 1
  NEXT i%
  new = 0
ELSE                                      ' new = 0
  IF count < 15 THEN
    count = count + 1
    FOR i% = 1 TO 3
      dx = xp(i%) - x0: dy = yp(i%) - y0
      dist = SQR(dx * dx + dy * dy)
      IF dist > 100000! THEN dist = 100000!
      t = dist / c(i%)
      xp(i%) = x(i%) - vx * t - vbasex * t: yp(i%) = y(i%) - vy * t - vbasey * t' virtual position 1
    NEXT i%
  END IF
END IF
  IF x1o <> x1s OR y1o <> y1s THEN
    alpha = (alp% - 45) * pi / 180
    LINE (x0disp + x1o * fract, y0disp - y1o)-(x0disp + x1o1 * fract, y0disp - y1o1), 0  ' arrow in black
    x1s1 = x1s - 5 * COS(alpha): y1s1 = y1s - 5 * SIN(alpha)
    LINE (x0disp + x1s * fract, y0disp - y1s)-(x0disp + x1s1 * fract, y0disp - y1s1), 15 ' arrow in white
    alpha = (alp% + 45) * pi / 180
    LINE (x0disp + x1o * fract, y0disp - y1o)-(x0disp + x1o2 * fract, y0disp - y1o2), 0  ' arrow in black
    x1s2 = x1s - 5 * COS(alpha): y1s2 = y1s - 5 * SIN(alpha)
    LINE (x0disp + x1s * fract, y0disp - y1s)-(x0disp + x1s2 * fract, y0disp - y1s2), 15 ' arrow in white
  END IF

COLOR 7
LOCATE 2, 1: PRINT "v "; v;
IF nobjects = 1 THEN PRINT TAB(12); "c  "; c(1);
IF nobjects > 1 THEN PRINT TAB(12); "c1 "; c(1); TAB(24); "c2 "; c(2); TAB(36); "c3 "; c(3);
PRINT TAB(54); "angle "; alp%; TAB(66); "ë angle "; dalp%;
IF ABS(yp(1)) < .001 THEN yp(1) = 0
LOCATE 3, 1: PRINT "xv "; xp(1); TAB(16); "yv "; yp(1); SPACE$(10)
IF cond = 0 THEN COLOR 12 ELSE COLOR 14
COLOR count
PSET (x0disp + xp(1) * fract, y0disp - yp(1))

IF nobjects > 1 THEN
  COLOR 13
  PSET (x0disp + xp(2) * fract, y0disp - yp(2))    ' light
  COLOR 14
  IF nobjects = 3 THEN PSET (x0disp + xp(3) * fract, y0disp - yp(3))     ' gravity
END IF

IF count < 15 THEN GOTO str

a$ = INKEY$
IF a$ = CHR$(ESC) THEN send = 1
IF a$ = null$ + CHR$(up) THEN new = 1: v = v + dv
IF a$ = null$ + CHR$(DOWN) THEN new = 1: v = v - dv
IF v < 0 THEN v = 0
IF a$ = null$ + CHR$(LEFT) THEN new = 1: alp% = alp% + dalp%: alp% = INT(alp% * 10 + .01) / 10
IF alp% >= 360 THEN alp% = alp% - 360
IF a$ = null$ + CHR$(RIGHT) THEN new = 1: alp% = alp% - dalp%: alp% = INT(alp% * 10 + .01) / 10
IF alp% < 0 THEN alp% = alp% + 360
IF UCASE$(a$) = "C" THEN cond = cond + 1: CLS : x1s = -1: IF cond = 2 THEN cond = 0
IF UCASE$(a$) = "D" THEN
  IF dalp% = 10 OR dalpup = 0 THEN
    dalpup = 0: dalp% = dalp% / 10
    IF dalp% = .1 THEN dalpup = 1
  ELSE
    dalpup = 1: dalp% = dalp% * 10
  END IF
END IF
IF UCASE$(a$) = "V" THEN
   vbase = vbase + 1            ' increase base speed
END IF
IF UCASE$(a$) = "W" THEN
   vbase = vbase - 1            ' decrease base speed
   IF vbase < 0 THEN vbase = 0
END IF
IF new = 1 THEN count = countinit

IF x1 < 0 THEN END
IF send = 1 THEN GOTO s10
GOTO str

s10:
COLOR 15

SUB GETSCREEN
'                                                                    GETSCREEN
SELECT CASE scren%
CASE 7
   xmax = 320: ymax = 200: fract = 1.2
   xchrmax = 40: ychrmax = 25
CASE 8
   xmax = 640: ymax = 200: fract = 2.4
   xchrmax = 80: ychrmax = 25
CASE 9
   xmax = 640: ymax = 350: fract = 1.368
   xchrmax = 80: ychrmax = 25
CASE 12
   xmax = 640: ymax = 480: fract = 1
   xchrmax = 80: ychrmax = 30
CASE ELSE
   PRINT "SCREEN ERROR, not 7, 8, 9 or 12"
END SELECT
END SUB

SUB SETSTANDARD
'                                                                 SETSTANDARD
scren% = 9                            ' SCREEN mode
c(1) = 10                             ' speed of noise
c(2) = 50                             ' speed of light
c(3) = 100                            ' speed of gravity
waittim = 0!                          ' wait time
deltat = 1
dalp% = 10                            ' delta angle
nobjects = 3                          ' number of objects
cond = 1

GETSCREEN                              ' SCREEN parameters

END SUB