'===========================================================================
' Subject: SINGLE PARTICLE EXPLOSION         Date: 04-05-98 (17:20)       
' Author:  Marc van den Dikkenberg           Code: PB                     
' Origin:  excel@xs4all.nl                 Packet: GRAPHICS.ABC
'===========================================================================
' PARTICLE EXPLOSION (FIREWORKS)
' Original Code: Angelo Ken Pesce -- ken@uniserv.uniplan.it
' Smooth routine made by X-Bios
'
' Modified by Marc van den Dikkenberg -- pb@excelsior.xs4all.nl

'---------------------------------------------------------------

' Some "standard" pb inits
$OPTIMIZE SPEED
' 386 is REQUIRED...
$CPU 80386
$LIB ALL OFF
$ERROR ALL OFF
$FLOAT NPX

Randomize Timer

' Init mode 13h + SQUARE PIXELS
 !Mov     ax, &h13
 !Int     &h10
 !mov dx,&h3c2
 !mov al,&h0e3
 !out dx,al

' Init Screen buffer
 DIM screenbuffer(32000) as WORD
 DIM scrseg as WORD
 scrseg = varseg(screenbuffer(0))

' Generate Palette
 maxcol% = 255
 CALL setpal

' Init particle array
 TYPE particle
    x as SINGLE
    y as SINGLE
    xm as SINGLE
    ym as SINGLE
 END TYPE

 num% = 1000
 DIM objs(num%) as particle

 GRAV# = 0.01:  'TRY OTHER GRAV# VALUES LIKE 0;0.01 etc...
GRAV#=0.001

' ********************************************>>>>>
' MAIN ********************************************>>>>>
' ********************************************>>>>>

 DO

' Clear screen
    !Xor     di, di
    !Mov     es, scrseg
    !Mov     cx, 16000
    !Xor     ax, ax
    !Push    ax
    !Db      &h66
    !Db      &hC1
    !Db      &hE0
    !Db      16
    !Pop     ax
    !Db      &hF3
    !Db      &h66
    !Db      &hAB

' GENERATE PARTICLES ********************************>>>>>
    xsrc% = rnd * 320
    ysrc% = rnd * 200
    FOR x% = 1 to num%
       objs(x%).x = xsrc%
       objs(x%).y = ysrc%
       lx! = (rnd * 2) -1
       ly! = (rnd * 2) -1
       dist! = rnd * 5
       ln! = sqr(lx!^2 + ly!^2)
       IF ln! = 0 THEN
          objs(x%).xm = lx!
          objs(x%).ym = ly!
       ELSE
          objs(x%).xm = lx! * (ln! * dist!)
          objs(x%).ym = ly! * (ln! * dist!)
       END IF
    NEXT x%

    FOR sloop% = 1 to 400:  ' Main smoothing & grav loop *****************>>>>>

       FOR x% = 1 to num%
          incr objs(x%).x, objs(x%).xm
          incr objs(x%).y, objs(x%).ym

          IF objs(x%).y > 199 THEN
             objs(x%).y = 199
          ELSEIF objs(x%).y < 0 THEN
             objs(x%).y = 0
          ELSE
             incr objs(x%).ym, GRAV#
          END IF

          IF objs(x%).x < 1 THEN
             objs(x%).x = 1
          ELSEIF objs(x%).x > 319 THEN
             objs(x%).x = 319
          END IF

' Put pixel into buffer
          x1% = int(objs(x%).x)
          y1% = int(objs(x%).y)

          !Mov     es, scrseg
          !Mov     di, x1%
          !Mov     ax, y1%
          !Dw      &hE0C1
          !Db      6
          !Add     di, ax
          !Dw      &hE0C1
          !Db      2
          !Add     di, ax

	if x1%>3 and x1%<316 and y1%>0 and y1%<199 then
		!Mov     al, maxcol%
	else
	   !Mov     al, 0
	end if

	!Mov     es:[di], al
   NEXT x%


' SMOOTH BUFFER

'		 !mov     es,scrseg
       !Mov     di, &hF8c0 ; 64000-320:Don't smooth last line
       !Xor     bx, bx
'      !Mov     bl, es:[di]
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
       !Jz      jmp2
       !Dec     al
jmp2:
       !Mov     es:[di], al
       !Dec     di
       !Jnz     jmp1

verder:

' COPY BUFFER TO SCREEN
       !Push    ds
'		 !Push    si
       !Mov     ds, scrseg
       !Xor     si, si
       !Xor     di, di
       !Mov     ax, &hA000
       !Mov     es, ax
       !Mov     cx, &h3e30
       !Db      &hF3
       !Db      &h66
       !Db      &hA5
'		 !Pop     si
       !Pop     ds

    NEXT sloop%

 LOOP

SUB setpal ()
 out &h3C8, 0
 FOR i = 0 to 63
    out &h3C9, 0
    out &h3C9, i / 6
    out &h3C9, i / 8
 NEXT
 FOR i = 0 to 63
    out &h3C9, i
    out &h3C9, 0
    out &h3C9, 0
 NEXT
 FOR i = 0 to 63
    out &h3C9, 63
    out &h3C9, i
    out &h3C9, 0
 NEXT
 FOR i = 0 to 63
    out &h3C9, 63
    out &h3C9, 63
    out &h3C9, i
 NEXT
END SUB