'===========================================================================
' Subject: ANIMATED TUNNEL2                  Date: 12-02-97 (00:36)       
' Author:  Danny Beardsley                   Code: PB                     
' Origin:  beards@dnai.com                 Packet: GRAPHICS.ABC
'===========================================================================
'ANIMATED TUNNEL2 BY DANNY BEARDSLEY
'MADE WITH POWERBASIC 3.2
'USE THE ARROW KEYS TO MOVE THE TUNNEL
'IF YOU HAVE ANY IDEAS ON HOW TO IMPROVE IT EMAIL ME
'
'EMAIL: DSB@CYBERDUDE.COM
'HOMEPAGE: HTTP://WWW.DNAI.COM/~BEARDS
'ICQ#: 3758561
$DYNAMIC
DECLARE SUB plasma ()
DECLARE SUB Splitbox (X1%, Y1%, X2%, Y2%)
DECLARE SUB Newcolor (XA%, YA%, x%, y%, XB%, YB%)
DIM absolute scrn(319,200) as byte at &HA000
DIM x(319,200) AS byte
DIM y(319,200) AS byte
DIM PIC(255, 255) AS byte
DIM MAX.Y AS INTEGER
DIM MAXX AS INTEGER
shared maxx
shared max.y
MAXX = 256
MAX.Y = 256
shared scrn()
shared pic()
DIM CONV AS SINGLE
DIM CONV2 AS SINGLE
CONV = 3.141592 / 180
CONV2 = (256) / 360
DIM s AS INTEGER
DIM x AS integer
DIM y AS INTEGER
DIM i AS INTEGER
DIM COLOUR AS INTEGER
RANDOMIZE TIMER

RANDOMIZE TIMER
PRINT "ANIMATED TUNNEL2 BY DANNY BEARDSLEY"
PRINT "MADE WITH POWERBASIC 3.2"
PRINT "USE THE ARROW KEYS TO MOVE THE TUNNEL"
PRINT
PRINT "PRESS Z....NO W...NO Q....AH THE HECK WITH IT, PRESS ANY! KEY"
SLEEP
CLS
PRINT "INITIALIZING...(HOLD ON)"
PRINT "GENERATING TEXTURE..."
plasma
PRINT "SMOOTHING TEXTURE..."
FOR repet = 1 TO 4
  FOR y = 0 TO 255
    ky = y - 1
    IF y = 0 THEN ky = 255
    FOR x = 0 TO 254
      kx = x - 1
      IF kx = -1 THEN kx = 254
      s = PIC(x, y) + PIC((x + 1) MOD MAXX, y) + PIC(kx, y) + PIC(x, ((y + 1) MOD MAX.Y)) + PIC(x, ky)
      s = s \ 5
      PIC(x, y) = s
    NEXT x
  NEXT y
NEXT
PRINT "GENERATING TUNNEL..."
FOR y = 0 TO 200
  LOCATE 4,21
  PRINT Y\2;"%"
  FOR x = 0 TO 319
      A = (x - 160): B = (y - 100)
      IF B = 0 THEN ANGLE = 90*SGN(A): R=5000/(ABS(A)+.0001):GOTO SKIPANGLECALC
      R = 5000 / (SQR(A ^ 2 + B ^ 2))

      'SQR(A^2 +B^2)
      ANGLE = ATN(A / B) / CONV
SKIPANGLECALC:
      'CORRECT ANGLE
      IF B < 0 THEN ANGLE = ANGLE - 180
      ANGLE = (ANGLE + 360) * CONV2
      x(x,y) = ((R) MOD (MAXX ))
      y(x,y) = ((ANGLE) MOD (MAX.Y - 1)) + 1
   NEXT x
NEXT y
! Mov   AX, 19
! int   16

FOR i% = 1 TO 128
  OUT &H3C8, i%
  OUT &H3C9, (64-((I%+1)\2))
  OUT &H3C9, ((I%-1)\2)
  OUT &H3C9, 0
NEXT i%
FOR i% = 1 TO 128
  OUT &H3C8, i%+128
  OUT &H3C9, 0
  OUT &H3C9, (64-((I%+1)\2))
  OUT &H3C9, 0
NEXT i%

TIM!=TIMER
DO
  SELECT CASE INP(96)
    CASE 72
      inx! = inx! + .5
    CASE 80
      inx! = inx! - .5
    CASE 77
      iny! = iny! + .5
    CASE 75
      iny! = iny! - .5
  END SELECT
  i% = i% + inx! MOD 255
  iy% = iy% + iny! MOD 256

  XSEG??=VARSEG(X(0,0))
  YSEG??=VARSEG(Y(0,0))
  PICSEG??=VARSEG(PIC(0,0))
  !XOR SI,SI

  SILOOP:
  !INC SI
    !MOV ES,XSEG??
    !MOV BL,ES:[SI]
    !MOV ES,YSEG??
    !ADD BL,I%
    !MOV BH,ES:[SI]
    !MOV ES,PICSEG??
    !ADD BH,IY%
    !MOV DX,&HA000
    !MOV AL,ES:[BX]
    !MOV ES,DX
    !MOV ES:[SI],AL
  !CMP SI,&HFA00
  !JB SILOOP

  IF INP(96) = 1 THEN EXIT DO
  F&=F&+1
LOOP
FPS!=F&/(TIMER-TIM!)
SLEEP
! Mov   AX, 3
! int   16
PRINT FPS!
SLEEP
END

DEFINT A-Z
SUB Newcolor (XA, YA, x, y, XB, YB)       'puts a new color based on average

IF PIC(x MOD MAXX, y MOD MAX.Y) <> 0 THEN EXIT SUB

avg = ABS(XA - XB) + ABS(YA - YB)

COLOUR = (PIC(XA MOD MAXX, YA MOD MAX.Y) + PIC(XB MOD MAXX, YB MOD MAX.Y)) \ 2 + ((RND - .5) * avg * 8)
    IF COLOUR > 250 THEN COLOUR = 250
    IF COLOUR < 1 THEN COLOUR = 1
PIC(x MOD MAXX, y MOD MAX.Y) = COLOUR

END SUB

'DEFSNG A-Z
SUB plasma

PIC(128, 128) = RND * 250

Splitbox 128, 128, 384, 384
END SUB

'
SUB Splitbox (X1, Y1, X2, Y2)

IF (X2 - X1 < 2) AND (Y2 - Y1 < 2) THEN EXIT SUB

x = (X1 + X2) \ 2
y = (Y1 + Y2) \ 2

Newcolor X1, Y1, X1, y, X1, Y2
Newcolor X1, Y2, x, Y2, X2, Y2
Newcolor X2, Y2, X2, y, X2, Y1
Newcolor X2, Y1, x, Y1, X1, Y1
IF PIC(x MOD MAXX, y MOD MAX.Y) = 0 THEN
    COLOUR = (PIC(X1 MOD MAXX, Y1 MOD MAX.Y) + PIC(X2 MOD MAXX, Y1 MOD MAX.Y) + PIC(X1 MOD MAXX, Y2 MOD MAX.Y) + PIC(X2 MOD MAXX, Y2 MOD MAX.Y)) \ 4
    IF COLOUR > 250 THEN COLOUR = 250
    IF COLOUR < 1 THEN COLOUR = 1
    PIC(x MOD MAXX, y MOD MAX.Y) = COLOUR
END IF

Splitbox X1, Y1, x, y
Splitbox x, Y1, X2, y
Splitbox x, y, X2, Y2
Splitbox X1, y, x, Y2

END SUB