'===========================================================================
' Subject: FAST ANIMATED BUMP MAP            Date: 08-28-97 (13:59)       
' Author:  Danny Beardsley                   Code: QB, QBasic, PDS        
' Origin:  beards@dnai.com                 Packet: GRAPHICS.ABC
'===========================================================================
DECLARE SUB plasma ()
DECLARE SUB Splitbox (X1%, Y1%, X2%, Y2%)
DECLARE SUB Newcolor (XA%, YA%, x%, y%, XB%, YB%)
DECLARE SUB init ()
' $DYNAMIC
SCREEN 13
TYPE pnt
  x AS INTEGER
  y AS INTEGER
END TYPE
DIM x AS INTEGER
DIM y AS INTEGER
DIM D AS INTEGER
DIM SHARED pic(32200) AS INTEGER
DIM SHARED mp(15751) AS INTEGER
DIM SHARED SN(360) AS INTEGER
DIM vsp AS INTEGER
DIM vsp2 AS INTEGER
DIM rond(360) AS pnt

DIM u1 AS INTEGER
DIM l1 AS INTEGER
DIM r1 AS INTEGER
DIM le1 AS INTEGER
DIM u2 AS INTEGER
DIM l2 AS INTEGER
DIM wv AS INTEGER


vsp = VARSEG(pic(0))
vsp2 = vsp + 2000
PRINT "hold on" '     (NUMPAD MOVES THE LIGHT)"
init
CLS
'PRINT "(NUMPAD KEYS MOVE THE LIGHT) press a key"
'SLEEP
FOR i% = 1 TO 127
OUT &H3C8, i%
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, i% \ 2
OUT &H3C8, i% + 127
OUT &H3C9, i% \ 2
OUT &H3C9, i% \ 2
OUT &H3C9, 63
NEXT i%
FOR i = 0 TO 360
rond(i).x = SIN(i * (3.1415929# / 180)) * 60
rond(i).y = COS(i * (3.1415929# / 180)) * 60
NEXT i
CLS
RANDOMIZE TIMER
plasma
GOTO skipit

'DEF SEG = (&HA000)
'FOR y = 1 TO 100
'  FOR x = 0 TO 319
'    r = SQR((x - 160) ^ 2 + (100 - y) ^ 2)
'    c = PEEK(y * 320 + x) + (SN((r * 30) MOD 360) \ (r \ 10 + 1))
'    IF c < 0 THEN c = 0
'    IF c > 250 THEN c = 250
'    POKE (y * 320 + x), c
'  NEXT x
'NEXT y
'DEF SEG = (&HA000 + &H7D0)
'FOR y = 1 TO 99
'  FOR x = 0 TO 319
'    r = SQR((x - 160) ^ 2 + y ^ 2)
'    c = PEEK(y * 320 + x) + (SN((r * 30) MOD 360) \ (r \ 10 + 1))
'    IF c < 0 THEN c = 0
'    IF c > 250 THEN c = 250
'    POKE (y * 320 + x), c
'    'POKE (y * 320 + x), SIN(r / 2) * (120 - (r \ 2)) + 128
'  NEXT x
'NEXT y
skipit:
'FOR w% = 1 TO 9
'CIRCLE (160, 100), w% + 35, 195
'LINE (160 - w%, 100 - w%)-(120 + w%, 180 + w%), 195, B
'NEXT w%
'tim = TIMER

FOR D = 1 TO 1
 
  DEF SEG = (&HA000)
 
  FOR y = 1 TO 100
    FOR x = 0 TO 319
     
      s% = PEEK(y * 320 + x) + PEEK(y * 320 + x + 1) + PEEK(y * 320 + x - 1) + PEEK(y * 320 + 320 + x) + PEEK(y * 320 - 320 + x) '+ PEEK(y * 320 - 320 + x - 1) + PEEK(y * 320 - 320 + x + 1) + PEEK(y * 320 + 320 + x - 1) + PEEK(y * 320 + 320 + x + 1)
      s% = s% \ 5
      POKE (y * 320 + x), s%
   
    NEXT x
  NEXT y
 
  DEF SEG = (&HA000 + &H7D0)

  FOR y = 1 TO 99
    FOR x = 0 TO 319
    
      s% = PEEK(y * 320 + x) + PEEK(y * 320 + x + 1) + PEEK(y * 320 + x - 1) + PEEK(y * 320 + 320 + x) + PEEK(y * 320 - 320 + x) '+ PEEK(y * 320 - 320 + x - 1) + PEEK(y * 320 - 320 + x + 1) + PEEK(y * 320 + 320 + x - 1) + PEEK(y * 320 + 320 + x + 1)
      s% = s% \ 5
      POKE (y * 320 + x), s%
    
    NEXT x
  NEXT y
NEXT D

FOR y = 1 TO 100
  ym% = 320 * y
  FOR x = 0 TO 319
    yd% = ym% + x
    DEF SEG = (&HA000)
    e = PEEK(yd%)
    DEF SEG = vsp
    POKE (yd%), e
  NEXT x
NEXT y
DEF SEG = (&HA7D0)
FOR y = 1 TO 99
  ym% = 320 * y
  FOR x = 0 TO 319
    yd% = ym% + x
    DEF SEG = (&HA7D0)
    e = PEEK(yd%)
    DEF SEG = vsp2
    POKE (yd%), e
  NEXT x
NEXT y
CLS
tim = TIMER
r:
lpx% = 160
lpy% = 100
wv = 79
DO

lpx% = rond((l% * 2) MOD 360).x + 160
lpy% = rond((l% * 2) MOD 360).y + 100

l% = l% + 1
DEF SEG = (&HA000)
u1 = lpy% - wv
l1 = lpy% + wv
r1 = lpx% + wv
le1 = lpx% - wv
IF r1 > 320 THEN r1 = 320
IF le1 < 0 THEN le1 = 0
IF l1 > 100 THEN l1 = 100
IF u1 < 0 THEN u1 = 0
IF u1 > 100 THEN GOTO sktp

FOR y = u1 TO l1
  ym% = y * 320
  ly% = y - lpy%
  FOR x = le1 TO r1
    lx% = x - lpx%
    yd% = ym% + x
    DEF SEG = vsp
    c% = PEEK(yd%) - 125
    ny% = (PEEK(yd% + 320) - c% - ly%)
    nx% = (PEEK(yd% + 1) - c% - lx%)
    IF nx% < 10 OR nx% > 240 THEN nx% = 1: GOTO k
    IF nx% > 125 THEN nx% = 125 - ABS(125 - nx%)
    IF ny% < 10 OR ny% > 240 THEN ny% = 1: GOTO k
    IF ny% > 125 THEN ny% = 125 - ABS(125 - ny%)
    DEF SEG = &HA000
    POKE (yd%), mp(nx% * 125 + ny%)
k:
  NEXT x
sky:
NEXT y
sktp:
DEF SEG = &HA7D0
u2 = lpy% - wv - 100
l2 = lpy% + wv - 100
IF l2 > 99 THEN l2 = 99
IF u2 < 0 THEN u2 = 0
IF l2 < 0 THEN GOTO skbt
FOR y = u2 TO l2
  ym% = y * 320
  ty% = y + 100
  ly% = ty% - lpy%
  FOR x = le1 TO r1
    lx% = x - lpx%
    yd% = ym% + x
    DEF SEG = vsp2
    c% = PEEK(yd%) - 125
    ny% = (PEEK(yd% + 320) - c% - ly%)
    nx% = (PEEK(yd% + 1) - c% - lx%)
    IF nx% < 10 OR nx% > 240 THEN nx% = 1: GOTO s
    IF nx% > 125 THEN nx% = 125 - ABS(125 - nx%)
    IF ny% < 10 OR ny% > 240 THEN ny% = 1: GOTO s
    IF ny% > 125 THEN ny% = 125 - ABS(125 - ny%)
    DEF SEG = &HA7D0
    POKE (yd%), mp(nx% * 125 + ny%)
s:
  NEXT x
sky2:
NEXT y
skbt:
LINE (le1, u1)-(r1, l2 + 100), 0, B
LINE (le1 - 1, u1 - 1)-(r1 + 1, l2 + 101), 0, B
LINE (le1 - 2, u1 - 2)-(r1 + 2, l2 + 102), 0, B
a$ = INKEY$
IF a$ = CHR$(27) THEN GOTO 12
'IF a$ = "6" THEN lpx% = lpx% + 2
'IF a$ = "4" THEN lpx% = lpx% - 2
'IF a$ = "2" THEN lpy% = lpy% + 2
'IF a$ = "8" THEN lpy% = lpy% - 2

LOOP
'GOTO r
12
q = l% / (TIMER - tim)
DEF SEG
CLS
FOR i% = 1 TO 255
OUT &H3C8, i%
OUT &H3C9, 63
OUT &H3C9, 63
OUT &H3C9, 63
NEXT i%
SCREEN 12
PRINT q
DO
LOOP UNTIL INKEY$ = ""
PRINT "FAST ANIMATED BUMP MAP BY DANNY BEARDSLEY (made in QB4.5)"
PRINT "COMPILE ME! 5 TIMES FASTER"
PRINT "COMPILE ME! 5 TIMES FASTER"
PRINT "COMPILE ME! 5 TIMES FASTER"
PRINT "_______________________________________________________"
PRINT "      This is a VERY! fast animated bump routine"
PRINT "    If you COMPILE it will be !!!5 times faster!!!!"
PRINT "      it is very delicate dont mess up the source"
PRINT "  If you want more code for other amazing feats then"
PRINT "-------------------------------------------------------"
PRINT "Email:       dsb@cyberdude.com"
PRINT "Homepage:    www.dnai.com/~beards"
PRINT "FREEWARE (just put my name in somewhere if you use it {:-)"
SLEEP

END

REM $STATIC
SUB init
SCREEN 13
FOR y% = 0 TO 125
  LOCATE 1, 9
  PRINT CINT(y% / 1.25); "%"
  FOR x% = 1 TO 125
    nx = (x% - 125) / 125
    ny = (y% - 125) / 125
    nz = 1 - (SQR(nx ^ 2 + ny ^ 2) * 1.5)
    IF nz < 0 THEN nz = 0
    mp(x% * 125 + y%) = CINT(nz * 250)
  NEXT x%
NEXT y%
'EXIT SUB
'FOR y% = 0 TO 100
'  LOCATE 1, 9
'  PRINT y%; "%"
'  FOR x% = 0 TO 320
'    nx = (x% - 160) + .00001
'    ny = (y% - 100) + .00001
'    nz = SQR(nx ^ 2 + ny ^ 2) + .000001
'    a = ATN(nx / ny) + ((180 - nz) * .002)
'    qx = (SIN(a) * nz) MOD 320
'    qy = (COS(a) * nz) MOD 200
'    IF qy < 0 THEN qy = 200 + qy
'    IF qx < 0 THEN qx = 320 + qx
'    rd(x%, y%) = qy * 320 + qx
'  NEXT x%
'NEXT y%
'
END SUB

DEFINT A-Z
SUB Newcolor (XA, YA, x, y, XB, YB)       'puts a new color based on average
IF POINT(x, y) <> 0 THEN EXIT SUB
avg = ABS(XA - XB) + ABS(YA - YB)
COLOUR = (POINT(XA, YA) + POINT(XB, YB)) / 2 + (RND - .5) * avg * 3
    IF COLOUR > 250 THEN COLOUR = 250
    IF COLOUR < 1 THEN COLOUR = 1
PSET (x, y), COLOUR

END SUB

DEFSNG A-Z
SUB plasma
DEF SEG = (&HA000)
POKE (0), RND * 250
POKE (320), RND * 250
DEF SEG = (&HA000 + &H7D0)
POKE (100 * 320), RND * 250
POKE (100 * 320 + 320), RND * 250

'use Set13Pixel to plant "seed" pixels here, if wanted

't# = TIMER
Splitbox 0, 0, 320, 320
END SUB

DEFINT A-Z
'
SUB Splitbox (X1, Y1, X2, Y2)            'this is the main subroutine
                                         '
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 POINT(x, y) = 0 THEN
    COLOUR = (POINT(X1, Y1) + POINT(X2, Y1) + POINT(X1, Y2) + POINT(X2, Y2)) / 4
    IF COLOUR > 250 THEN COLOUR = 250
    IF COLOUR < 1 THEN COLOUR = 1
    PSET (x, 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