'===========================================================================
' Subject: PARTICLE EXPLOSION (FIREWORKS)    Date: 08-20-97 (18:41)       
' Author:  Angelo Ken Pesce                  Code: PB                     
' Origin:  ken@uniserv.uniplan.it          Packet: GRAPHICS.ABC
'===========================================================================
' ***********************************
' ANGELO KEN PESCE 1997             *
' Email me:Ken@uniserv.uniplan.it   *
' ***********************************

' (Smooth routine made by X-Bios)



' Some "standars" 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% = 4000
 DIM objs(num%) as particle


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


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

 DO

' FLASH EFFECT ********************************************>>>>>

' 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
    FOR i = 0 to 4
       out &h3C8, 0
       out &h3C9, 0
       out &h3C9, 63
       out &h3C9, 63
       !Mov     dx, &h3DA
asmjmp12:
       !In      al, dx
       !Test    al, 8
       !Jnz     asmjmp12
asmjmp13:
       !In      al, dx
       !Test    al, 8
       !Jz      asmjmp13
       out &h3C8, 0
       out &h3C9, 0
       out &h3C9, 0
       out &h3C9, 0
       !Mov     dx, &h3DA
asmjmp12b:
       !In      al, dx
       !Test    al, 8
       !Jnz     asmjmp12b
asmjmp13b:
       !In      al, dx
       !Test    al, 8
       !Jz      asmjmp13b
    NEXT


' 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 600:  ' 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
             objs(x%).xm = objs(x%).xm / 4
             objs(x%).ym = - objs(x%).ym / 2
          ELSEIF objs(x%).y < 0 THEN
             objs(x%).y = 0
             objs(x%).xm = objs(x%).xm / 4
             objs(x%).ym = - objs(x%).ym / 2
          ELSE
             incr objs(x%).ym, GRAV#
          END IF

          IF objs(x%).x < 3 THEN
             objs(x%).x = 3
             objs(x%).xm = - objs(x%).xm / 2
             objs(x%).ym = objs(x%).ym / 4
          ELSEIF objs(x%).x > 316 THEN
             objs(x%).x = 316
             objs(x%).xm = - objs(x%).xm / 2
             objs(x%).ym = objs(x%).ym / 4
          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
          !Mov     al, maxcol%
          !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


' 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