'===========================================================================
' Subject: DANCING JELLO                     Date: 01-01-00 (02:59)       
' Author:  Davey W. Taylor                   Code: QB, QBasic, PDS        
' Origin:  logiclord@swipnet.se            Packet: GRAPHICS.ABC
'===========================================================================
'DANCING JELLO
'
'Hey! I havn't contributed to ABC in quite a while now, sorry about that!
'Heres some nice demo like eyecandy for your enjoyment!
'It still needs a pretty fast computer to run smootly say like a P200 when
'compiled and a P250 when running in the programming environ.
'May flip occasionally, sorry about that... :>
'
'Yeah, I know, you can probably find a million things to fix and
'optimize so please do, because this is just the beginning of
'a basic/asm project and I can use all the tips I can get!
'So if you improve the code tell me about it :}
'
'I also need an asm rout that will map a texture to an area on the screen
'defined by four xy coordinates. I'd be real happy if you would send
'it to me or tell me where I can download it... thanks! :)
'
'Have Phun! /LogicLord (logiclord@swipnet.se)

DECLARE SUB relate (a%, b%)
TYPE advnode
 xp AS SINGLE
 yp AS SINGLE
 xv AS SINGLE
 yv AS SINGLE
 xo AS SINGLE
 yo AS SINGLE
END TYPE
TYPE basnode
 xp AS INTEGER
 yp AS INTEGER
END TYPE
TYPE basrelation
 ni AS INTEGER
 nd AS SINGLE
END TYPE

CONST hinode% = 27
DIM SHARED node(0 TO hinode%) AS advnode
DIM SHARED newnode(0 TO hinode%) AS basnode
DIM SHARED oldnode(0 TO hinode%) AS basnode
DIM SHARED relation(0 TO hinode%, 0 TO hinode%) AS basrelation
DIM SHARED floor(319) AS INTEGER

SCREEN 13
RANDOMIZE TIMER

'create floor
ys% = INT(RND * 50) + 150
yb% = ys%
xs% = 0
xd% = INT(RND * 39) + 1
yd% = INT(RND * 50) + 150
f! = (yd% - ys%) / xd%
FOR n% = 0 TO 319
 IF n% = xd% THEN
  xs% = n%
  xd% = INT(RND * 39) + n% + 1
  ys% = yd%
  yd% = INT(RND * 50) + 150
  IF xd% > 320 THEN
   xd% = 320
   yd% = yb%
  END IF
  f! = (yd% - ys%) / (xd% - xs%)
 END IF
 floor(n%) = ys% + f! * (n% - xs%)
NEXT n%

'interpolate
FOR n% = 0 TO 319
 y% = floor(n%) + floor((n% + 1) MOD 320) + floor((n% + 2) MOD 320) + floor((n% + 3) MOD 320) + floor((n% + 4) MOD 320)
 floor((n% + 2) MOD 320) = y% / 5
NEXT n%

'set nodes
n% = 0
FOR y% = 0 TO 3
 FOR x% = 0 TO 6
  newnode(n%).xp = 160
  newnode(n%).yp = 50
  node(n%).xp = x% * 25 + 85
  node(n%).yp = y% * 25 + 30
  n% = n% + 1
 NEXT x%
NEXT y%

'create relations
n% = 0
FOR y% = 0 TO 3
 relate y% * 7, y% * 7 + 6
NEXT y%
FOR x% = 0 TO 6
 relate x%, x% + 21
NEXT x%

FOR y% = 0 TO 3
 FOR x% = 0 TO 6
  IF x% < 6 THEN
   relate n%, n% + 1
  END IF
  IF y% < 3 THEN
   relate n%, n% + 7
  END IF
  IF x% < 6 AND y% < 3 THEN
   relate n%, n% + 8
   relate n% + 1, n% + 7
  END IF
 n% = n% + 1
 NEXT x%
NEXT y%

'factors... don't change it'll prolly flip
dfactor% = 10
sfactor% = 100
vfactor% = 2
ifactor% = 8

WHILE INKEY$ = ""
 'gravity
 FOR n% = 0 TO hinode%
  node(n%).yv = node(n%).yv + .01
 NEXT n%

 'calculate average distance from related nodes
 FOR n% = 0 TO hinode%
  node(n%).xo = 0
  node(n%).yo = 0
  FOR r% = 0 TO hinode%
   nd! = relation(n%, r%).nd
   IF nd! = 0 THEN
    EXIT FOR
   ELSE
    ni% = relation(n%, r%).ni
    d! = (ABS(SQR((node(n%).xp - node(ni%).xp) ^ 2 + (node(n%).yp - node(ni%).yp) ^ 2)) - nd!) / dfactor%
    'd! = d! / dfactor%
    node(n%).xo = node(n%).xo + (node(n%).xp - node(ni%).xp) * d!
    node(n%).yo = node(n%).yo + (node(n%).yp - node(ni%).yp) * d!
   END IF
  NEXT r%
  node(n%).xv = node(n%).xv - (node(n%).xo) / sfactor%
  node(n%).yv = node(n%).yv - (node(n%).yo) / sfactor%
 NEXT n%

 'move node based on calculated velocity
 FOR n% = 0 TO hinode%
  node(n%).xp = node(n%).xp + node(n%).xv * vfactor%
  node(n%).yp = node(n%).yp + node(n%).yv * vfactor%
 NEXT n%

 FOR n% = 0 TO hinode%
  'bounce off left and right
  IF node(n%).xp < 0 THEN
   node(n%).xp = 0
   node(n%).xv = 0
  END IF
  IF node(n%).xp > 319 THEN
   node(n%).xp = 319
   node(n%).xv = 0
  END IF

  'floor collision detection
  xf% = INT(node(n%).xp) MOD 320
  IF node(n%).yp >= floor(xf%) THEN
   node(n%).yp = floor(xf%) - 1
   d! = floor(xf%) - floor((xf% + 1) MOD 320)
   node(n%).xv = node(n%).xv - d!
   node(n%).yv = 0
  END IF
 NEXT n%

 'sync
 WAIT &H3DA, 8

 'erase old block
 FOR n% = 0 TO 5
  LINE (oldnode(n%).xp, oldnode(n%).yp)-(oldnode(n% + 1).xp, oldnode(n% + 1).yp), 0
  LINE (oldnode(n% + 21).xp, oldnode(n% + 21).yp)-(oldnode(n% + 22).xp, oldnode(n% + 22).yp), 0
 NEXT n%
 FOR n% = 0 TO 2
  LINE (oldnode(n% * 7).xp, oldnode(n% * 7).yp)-(newnode(n% * 7 + 7).xp, newnode(n% * 7 + 7).yp), 0
  LINE (oldnode(n% * 7 + 6).xp, oldnode(n% * 7 + 6).yp)-(newnode(n% * 7 + 13).xp, newnode(n% * 7 + 13).yp), 0
 NEXT n%

 'calc new nodes by interpolation and remember old
 FOR n% = 0 TO hinode%
  newnode(n%).xp = newnode(n%).xp + (node(n%).xp - newnode(n%).xp) / ifactor%
  newnode(n%).yp = newnode(n%).yp + (node(n%).yp - newnode(n%).yp) / ifactor%
  oldnode(n%).xp = newnode(n%).xp
  oldnode(n%).yp = newnode(n%).yp
 NEXT n%

 'draw new block
 FOR n% = 0 TO 5
  LINE (newnode(n%).xp, newnode(n%).yp)-(newnode(n% + 1).xp, newnode(n% + 1).yp), 63
  LINE (newnode(n% + 21).xp, newnode(n% + 21).yp)-(newnode(n% + 22).xp, newnode(n% + 22).yp), 63
 NEXT n%
 FOR n% = 0 TO 2
  LINE (newnode(n% * 7).xp, newnode(n% * 7).yp)-(newnode(n% * 7 + 7).xp, newnode(n% * 7 + 7).yp), 63
  LINE (newnode(n% * 7 + 6).xp, newnode(n% * 7 + 6).yp)-(newnode(n% * 7 + 13).xp, newnode(n% * 7 + 13).yp), 63
 NEXT n%

 'move floor
 floorm% = floor(0)
 FOR n% = 0 TO 318
  PSET (n%, floor(n%)), 0
  floor(n%) = floor(n% + 1)
  PSET (n%, floor(n%)), 38
  LINE (n%, floor(n%) + 1)-(n%, 199), 0
 NEXT n%
 floor(319) = floorm%

 COLOR 72
 LOCATE 1, 1
 PRINT "LogicLord '2k"
WEND
WIDTH 80, 25

'eliminate the black-line-at-the-bottom-of-the-screen bug in win95/98
COLOR 7, 0
CLS

PRINT "LogicLord '2k"

'Hey, whaddaya know... nothing happened!

SUB relate (a%, b%)
 d! = ABS(SQR((node(a%).xp - node(b%).xp) ^ 2 + (node(a%).yp - node(b%).yp) ^ 2))
' PRINT d!
 FOR n% = 0 TO hinode%
  IF relation(a%, n%).nd = 0 THEN
   relation(a%, n%).ni = b%
   relation(a%, n%).nd = d!
   EXIT FOR
  ELSE
   IF relation(a%, n%).ni = b% THEN EXIT FOR
  END IF
 NEXT n%
 FOR n% = 0 TO hinode%
  IF relation(b%, n%).nd = 0 THEN
   relation(b%, n%).ni = a%
   relation(b%, n%).nd = d!
   EXIT FOR
  ELSE
   IF relation(b%, n%).ni = a% THEN EXIT FOR
  END IF
 NEXT n%
END SUB