'===========================================================================
' Subject: PARTICLE FOUNTAIN                 Date: 08-20-97 (18:41)       
' Author:  Angelo Ken Pesce                  Code: PB                     
' Origin:  ken@uniserv.uniplan.it          Packet: GRAPHICS.ABC
'===========================================================================
' Original particle fountain source: Daniel Davies

' PB PORTING, MODE13ROUTINES, SMOOTH EFFECT, DOUBLE BUFFERING,
' CODE REVISION AND ALL THE OTHER THINGS NEEDED TO MAKE A GOOD
' EFFECT: Angelo KEN Pesce ;-)

' Email me:Ken@uniserv.uniplan.it

' W ITALY!!!!!!

' TO DO LIST:
' 1)OPTIMIZE
' 2)WIND# & GRAV# ANIMATION (I'm not too good with those x=f(t) functions
'   mabye x-bios can do something...)
' 3)EVERY PARTICLE MUST HAVE ITS OWN WIND# AND GRAV# VALUES (needed for w&g anim)


$OPTIMIZE SPEED
' 386 is REQUIRED...
$CPU 80386
$LIB ALL OFF
$ERROR ALL OFF
$FLOAT NPX


' Init mode 13h
!mov ax,&h13
!int &h10


' Init Screen buffer
DIM screenbuffer(32000+(320/2)) as word
DIM scrseg as word
scrseg=varseg(screenbuffer(0))


' Palette
maxcol%=128
OUT &H3C8, 0
FOR i = 0 TO 63
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, i
NEXT
FOR i = 0 TO 63
OUT &H3C9, 0
OUT &H3C9, i
OUT &H3C9, 63
NEXT

' UNCOMMENT THOSE LINES FOR 192 COLORS VERSION
' maxcol%=192
'FOR i = 0 TO 63
'OUT &H3C9, i
'OUT &H3C9, 63
'OUT &H3C9, 63
'NEXT


TYPE particle
x AS single
y AS single
xm AS single
ym AS single
END TYPE

num% = 3000
DIM objs(num%) AS particle
wind# = 0
GRAV# = .019
DO

FOR x% = 1 TO num%

IF objs(x%).y > 199 OR objs(x%).x > 319 OR objs(x%).y < 0 OR objs(x%).x < 1 THEN
objs(x%).x = 158 + (RND * 4)
objs(x%).y = 0
objs(x%).xm = (RND * 2) - 1
objs(x%).ym = (RND * 3) + 2
ELSE

' Put pixel into buffer
x1%=int(objs(x%).x)
y1%=int(199-objs(x%).y)
 !Mov     di,y1%
' SHL DI,8
 !Dw      &hE7C1
 !Db      8
 !Mov     bx, y1%
' SHL BX,6
 !Dw      &hE3C1
 !Db      6
 !Add     di, x1%
 !Mov     es, scrseg
 !Add     di, bx
 !Mov     dl, maxcol%
 !Mov     es:[di], dl

incr objs(x%).x, objs(x%).xm
incr objs(x%).y, objs(x%).ym
decr objs(x%).ym, GRAV#
incr objs(x%).xm, wind#
END IF

NEXT x%

' SMOOTH BUFFER
 !mov     es,scrseg
 !Mov     di, &hF8c0 ; 64000-320:Don't smooth last line
 !Xor     bx, bx
jmp1:
 !Mov     bl, es:[di]
 !Add     ax, bx
 !Mov     bl, es:[di + 320]
 !Add     ax, bx
 !Mov     bl, es:[di - 1]
 !Add     ax, bx
 !Dw      &hE8C1
 !Db      2
 !Mov     es:[di], al
 !Dec     di
 !Jnz     jmp1


' COPY BUFFER TO SCREEN
 !Push    ds
 !Push    si
 !Mov     ds, scrseg
 !Mov     si, 0
 !Mov     di, 0
 !Mov     ax, &ha000
 !Mov     es, ax
 !Mov     cx, &h3e60
 !Db      &hF3
 !Db      &h66
 !Db      &hA5
 !Pop     si
 !Pop     ds

LOOP until len(inkey$)