3D Fire Lines - DARK BASIC port - Version 03

; PROJECT : 3D Fire Lines - DARK BASIC port - Version 03
; AUTHOR  : Kev Picone - http://PlayBASIC.com
; CREATED : 15/04/2022
; EDITED  : 17/04/2022
; ---------------------------------------------------------------------

` *=---------------------------------------------------------------------=*
` *=---------------------------------------------------------------------=*
` *=-------------------->> PORTED FROM DARK BASIC <<---------------------=*
` *=---------------------------------------------------------------------=*
` *=---------------------------------------------------------------------=*


`    This is the final version of the effect.  In this edition we've
`   added smoother motion of the fire lines with alpha addition for
`   the rendering a circle to show the head of the line as well as
`   a pass of alpha multiply.

` *=---------------------------------------------------------------------=*
`
`                         >> 3D Fire Lines V0.03 <<
`
`                              By Kevin Picone
`
`                          Original:  24,May,2001
`
`                       PlayBASIC Update:  15,April,2022
`
`      (c) Copyright 2001/2022, By Kevin Picone, All Rights Reserved.
`
` *=---------------------------------------------------------------------=*
`              www.Underwaredesign.com    www.PlayBASIC.com
` *=---------------------------------------------------------------------=*
`
`  So WHAT does this do ?:
`  =======================
`
`   The Idea for this effect comes from both a demo "Jn_omega" wrote and a
`  open gl demo I saw a while back. Figured, it might make an interesting
`  snippet, so here it is.
`
`   This demo renders a group of glowing (for want of a better word) lines
`  moving in 3D space. While DB's line speed does put the breaks on this
`  effect, it's 'not' entirely to blame, as the update routine is shifting
`  data it really doesn't need too.. but i'm not fussed Smiley
`
`
`  Bugs:
`  =====
`
`   One thing that is missing from this demo and perhaps those will a keen
`  eye would have spotted it, is the lack of zbuffering in the rendering,
`  granted it's fairly hard to tell with only a hand full of lines, but
`  it is missing none the less.
`
`
`  Release Info:
`  =============
`
`   Your welcome to use this code freely in your own projects, a credit
`  and perhaps a link would be nice.  Thank You.
`
`
`  Cya,
`  Kevin Picone
`
` *=---------------------------------------------------------------------=*


   #include "blitimage"

`  Define Useful Constants (just makes the code more user friendly/readable)


   constant Mode_3d=ac(1)
   constant Mode_2d=ac(1)



`  Define Program Constants.

   ScreenWidth      =GetScreenWidth()
   ScreenHeight   =GetScreenHeight()
   ScreenBitDepth=16

   Title$         = "3D Fire Lines"
   Version$         = "V0.03"

   titlescreen  Title$+" "+Version$



   ` Setup The Fire Line Array and Define How many LINES we want, and how
   ` LONG they should be.

   Numb_of_FireLines            =200
   Numb_of_FireLinesSegMents   =200


   ` Select a mode to run the demo in 3D or 2D are possible

   FireLines_status=Mode_3D
`   FireLines_status=MODE_2D



   gosub _Init_Fire_lines



` *=----------------------------------------------------------------=*
`                            Main Loop
` *=----------------------------------------------------------------=*

   Screen=NewFXImage(   ScreenWidth,   ScreenHeight)

   do

      rendertoimage Screen


      gosub _Handle_Fire_Lines


      inkmode 1+64
      if FireLines_status=MOde_3D

         ` Change Angles for 3D Fire lines
         anglex#=wrapangle(anglex#,0)
         angley#=wrapangle(angley#,0.2)
         anglez#=wrapangle(anglez#,0.15)

         gosub _Render_3D_Fire_Lines

      else
         gosub _Render_2D_Fire_Lines
      endif
      inkmode 1

      rendertoscreen


      BlitImageAlphaPostMultColour(Screen,0,0,RGB(200,190,190))

      sync
   loop Spacekey()=true



   end





_Init_Fire_lines:


   if FireLines_status=MODE_3D
      limit=2000
      FireLine_Limits_xposr=limit
      FireLine_Limits_xposl=FireLine_Limits_xposr*-1
      FireLine_Limits_yposr=limit
      FireLine_Limits_yposl=FireLine_Limits_yposr*-1
      FireLine_Limits_zposr=limit
      FireLine_Limits_zposl=FireLine_Limits_zposr*-1
   else
      FireLine_Limits_xposr=screenwidth
      FireLine_Limits_xposl=0
      FireLine_Limits_yposr=screenheight
      FireLine_Limits_yposl=0
      FireLine_Limits_zposr=screnwidth
      FireLine_Limits_zposl=0
   endif

   ` define fire line structures.

   i=0

   FirelineSeg_xpos=i: inc i
   FirelineSeg_ypos=i: inc i
   FirelineSeg_zpos=i: inc i
   FirelineSeg_Size=i


   i=0

   Fireline_PaletteNumber=i   : inc i

   Fireline_UpdateTimer=i      : inc i
   Fireline_ResetTimer=i      : inc i


   Fireline_Xchange=i         : inc i
   Fireline_Ychange=i         : inc i
   Fireline_Zchange=i         : inc i

   Fireline_XSpeed=i            : inc i
   Fireline_YSpeed=i            : inc i
   Fireline_ZSpeed=i            : inc i


   Fireline_NEW_XSpeed=i            : inc i
   Fireline_NEW_YSpeed=i            : inc i
   Fireline_NEW_ZSpeed=i            : inc i


   Fireline_SegmentHeader=i    : inc i,(Numb_of_FireLinesSegments*FirelineSeg_Size)
   Fireline_SegmentEnd=I      : inc i

   Fireline_SegmentRotXHeader=i      : inc i,Numb_of_FireLinesSegments
   Fireline_SegmentRotYHeader=i      : inc i,Numb_of_FireLinesSegments



   Fireline_StructureSize=i: inc i

   if FireLines_status=MODE_2D
      Speed=3
   else
      Speed=16
   endif

   dim FireLineBuffer#(Numb_of_FireLines,Fireline_StructureSize)

      for Lp=0 to Numb_of_FireLines-1

          FireLineBuffer#(lp,Fireline_ResetTimer)   =rndrange(10,50)
          FireLineBuffer#(lp,Fireline_UpdateTimer)   =0
          FireLineBuffer#(lp,Fireline_Xchange)=RndSpeed#(Speed)
          FireLineBuffer#(lp,Fireline_Ychange)=RndSpeed#(Speed)
          FireLineBuffer#(lp,Fireline_Zchange)=RndSpeed#(Speed)

            o=Fireline_Segmentheader

            x=random_range(FireLine_Limits_xposl,FireLine_Limits_xposr)
            y=random_range(FireLine_Limits_yposl,FireLine_Limits_yposr)
            z=random_range(FireLine_Limits_zposl,FireLine_Limits_zposr)


            for lp2=0 to Numb_of_FireLinesSegments-1

             FireLineBuffer#(lp,o+FirelineSeg_xpos)=x
             FireLineBuffer#(lp,o+FirelineSeg_ypos)=y
             FireLineBuffer#(lp,o+FirelineSeg_zpos)=z

             o=o+FirelineSeg_Size

            next lp2

         next lp

      dim palettes(0,0)

      gosub _Build_Palettes


   return


` *=----------------------------------------------------------------=*
` *=-------------------- Render 3D Fire Lines ----------------------=*
` *=----------------------------------------------------------------=*
`
`   This routine first rotates and projects a fire lines vertex then
` renders it to the display.



_Render_3D_Fire_Lines:

        cx#=cos(anglex#)
        sx#=sin(anglex#)
        cy#=cos(angley#)
        sy#=sin(angley#)
        cz#=cos(anglez#)
        sz#=sin(anglez#)

         scale#=3000+cos(ScaleAngle#)*500
         ScaleAngle#=wrapangle(ScaleAngle#,0.25)
         projection#=400


         Screen_CentX=ScreenWidth/2
         Screen_CentY=ScreenHeight/2


      lockbuffer
      For Lp=0 to Numb_of_FireLines-1

         xpos=Fireline_SegmentHeader+FirelineSeg_xpos
         ypos=Fireline_SegmentHeader+FirelineSeg_ypos
         zpos=Fireline_SegmentHeader+FirelineSeg_zpos

         rxpos=Fireline_SegmentRotXHeader
         rypos=Fireline_SegmentRotYHeader


         depth_of_header#=0

         for rotatelp=0 to Numb_of_FireLinesSegments-1
         ` Rotate Points

            y#=(cx#*FireLineBuffer#(lp,ypos))-(sx#*FireLineBuffer#(lp,zpos))
            z#=(cx#*FireLineBuffer#(lp,zpos))+(sx#*FireLineBuffer#(lp,ypos))
            x#=(cY#*Z#)-(sy#*FireLineBuffer#(lp,xpos))
            z#=((cy#*FireLineBuffer#(lp,xpos))+(sy#*Z#))+scale#

               ` Projected this point to screen for 2d rendering

            if z#=0 then z#=0.01

            if rotatelp=0
               depth_of_header#=z#
            endif

            FireLineBuffer#(lp,rxpos)=((((cz#*X#)-(sz#*Y#))*projection#)/z#)+Screen_CentX
            FireLineBuffer#(lp,rypos)=((((cz#*Y#)+(sz#*X#))*projection#)/z#)+Screen_CentY

            inc rXpos
            inc rYpos

            Xpos=Xpos+FirelineSeg_Size
            Ypos=Ypos+FirelineSeg_Size
            Zpos=Zpos+FirelineSeg_Size
         next rotatelp


         ` Render Fire Line
         xpos=Fireline_SegmentRotXHeader
         ypos=Fireline_SegmentRotYHeader


         LastWidth#=50
         if depth_of_header#>1
         for renderlp=0 to Numb_of_FireLinesSegments-2

            NextRGB = palettes(lp,renderlp)
            x1=FireLineBuffer#(lp,xpos)
            y1=FireLineBuffer#(lp,ypos)

            if renderlp=0
               Radius# = (200*projection#)/depth_of_header#
                  for z=0 to 90-1 step 20
                     circlec x1,y1,sin(z)*Radius#,true, rgbfade( NextRGB,(90-(z/0.9))*0.15)
                  next

            endif

            inc Xpos
            inc Ypos
            linec x1,y1,FireLineBuffer#(lp,xpos),FireLineBuffer#(lp,ypos),NextRGB

            next renderlp
         endif

      next lp
      unlockbuffer
   Return





` *=----------------------------------------------------------------=*
` *=---------------------- 2D Fire Lines --------------------------=*
` *=----------------------------------------------------------------=*

`  render the fire lines in 2D, so this routine ingore's the Z cords
` and renders the pure X & Y coords directly to the display..



_Render_2D_Fire_Lines:

      For Lp=0 to Numb_of_FireLines-1

         xpos=Fireline_SegmentHeader+FirelineSeg_xpos
         ypos=Fireline_SegmentHeader+FirelineSeg_ypos

         for renderlp=0 to Numb_of_FireLinesSegments-2

            ink palettes(lp,renderlp)
            x1=FireLineBuffer#(lp,xpos)
            y1=FireLineBuffer#(lp,ypos)

            Xpos=Xpos+FirelineSeg_Size
            Ypos=Ypos+FirelineSeg_Size

            line x1,y1,FireLineBuffer#(lp,xpos),FireLineBuffer#(lp,ypos)

         next renderlp

      next lp

   Return



` *=----------------------------------------------------------------=*
` *=--------------------- Handle Fire Lines ------------------------=*
` *=----------------------------------------------------------------=*




_Handle_Fire_Lines:


      ` precalc the segment headers
      sh_xpos=Fireline_SegmentHeader+FirelineSeg_xpos
      sh_ypos=Fireline_SegmentHeader+FirelineSeg_ypos
      sh_zpos=Fireline_SegmentHeader+FirelineSeg_zpos


      ` Process the fire lines (move the head point and scroll point data)
      For Lp=0 to Numb_of_FireLines-1


         UpdateFrames#=FireLineBuffer#(lp,Fireline_ResetTimer)



         if FireLineBuffer#(lp,Fireline_UpdateTimer) >UpdateFrames#

            FireLineBuffer#(lp,Fireline_UpdateTimer)=0
               speed=16
             FireLineBuffer#(lp,Fireline_Xchange)=RndSpeed#(Speed)
             FireLineBuffer#(lp,Fireline_Ychange)=RndSpeed#(Speed)
             FireLineBuffer#(lp,Fireline_Zchange)=RndSpeed#(Speed)


            xchange=FireLineBuffer#(lp,FireLine_XChange)
            ychange=FireLineBuffer#(lp,FireLine_YChange)
            zchange=FireLineBuffer#(lp,FireLine_ZChange)

            Speedx#=FireLineBuffer#(lp,FireLine_NEW_XSpeed)
            Speedy#=FireLineBuffer#(lp,FireLine_NEW_YSpeed)
            Speedz#=FireLineBuffer#(lp,FireLine_NEW_ZSpeed)

            // old new speed , old speed
            FireLineBuffer#(lp,FireLine_XSpeed)   = Speedx#
            FireLineBuffer#(lp,FireLine_YSpeed)   = Speedy#
            FireLineBuffer#(lp,FireLine_ZSpeed)   = Speedz#

            FireLineBuffer#(lp,FireLine_NEW_XSpeed)=Xchange
            FireLineBuffer#(lp,FireLine_NEW_YSpeed)=Ychange
            FireLineBuffer#(lp,FireLine_NEW_ZSpeed)=Zchange

         endif


         LerpScale# =FireLineBuffer#(lp,Fireline_UpdateTimer)/UpdateFrames#

         FireLineBuffer#(lp,Fireline_UpdateTimer)++

         ` Scroll Coords Segment Data,
         Doffset=Fireline_SegmentEnd-(FirelineSeg_Size)
         Soffset=Doffset-(FirelineSeg_Size)

         for scrsegslp=0 to Numb_of_FireLinesSegments-2

            FireLineBuffer#(lp,Doffset)   =FireLineBuffer#(lp,Soffset)
            FireLineBuffer#(lp,Doffset+1)   =FireLineBuffer#(lp,Soffset+1)
            FireLineBuffer#(lp,Doffset+2)   =FireLineBuffer#(lp,Soffset+2)

            Soffset   =Soffset-FirelineSeg_Size
            Doffset   =Doffset-FirelineSeg_Size

         next ScrSegslp


         ` Move Header Point

         oldXpos#=FireLineBuffer#(lp,sh_xpos)
         oldYpos#=FireLineBuffer#(lp,sh_ypos)
         oldZpos#=FireLineBuffer#(lp,sh_zpos)


         SpeedX# = lerp#(FireLineBuffer#(lp,FireLine_XSpeed),FireLineBuffer#(lp,FireLine_NEW_XSpeed),LerpScale#)
         SpeedY# = lerp#(FireLineBuffer#(lp,FireLine_YSpeed),FireLineBuffer#(lp,FireLine_NEW_YSpeed),LerpScale#)
         SpeedZ# = lerp#(FireLineBuffer#(lp,FireLine_ZSpeed),FireLineBuffer#(lp,FireLine_NEW_ZSpeed),LerpScale#)

         Xpos#=oldXpos#+speedx#   ;FireLineBuffer#(lp,FireLine_Xspeed)
         Ypos#=oldYpos#+speedy#   ; FireLineBuffer#(lp,FireLine_Yspeed)
         Zpos#=oldZpos#+speedz#   ;FireLineBuffer#(lp,FireLine_Zspeed)

         ` rebound point if it's outside the legal movement area
         if xpos# > FireLine_Limits_xposr then FireLineBuffer#(lp,FireLine_Xspeed)=FireLineBuffer#(lp,FireLine_New_Xspeed)*-1: xpos#=oldXpos#
         if ypos# > FireLine_Limits_yposr then FireLineBuffer#(lp,FireLine_Yspeed)=FireLineBuffer#(lp,FireLine_New_Yspeed)*-1: Ypos#=oldYpos#
         if zpos# > FireLine_Limits_zposr then FireLineBuffer#(lp,FireLine_Zspeed)=FireLineBuffer#(lp,FireLine_New_Zspeed)*-1: Zpos#=oldZpos#

         if xpos# < FireLine_Limits_xposl then FireLineBuffer#(lp,FireLine_Xspeed)=FireLineBuffer#(lp,FireLine_New_Xspeed)*-1: xpos#=oldXpos#
         if ypos# < FireLine_Limits_yposl then FireLineBuffer#(lp,FireLine_Yspeed)=FireLineBuffer#(lp,FireLine_New_Yspeed)*-1: ypos#=oldYpos#
         if zpos# < FireLine_Limits_zposl then FireLineBuffer#(lp,FireLine_Zspeed)=FireLineBuffer#(lp,FireLine_New_Zspeed)*-1: zpos#=oldZpos#


         FireLineBuffer#(lp,sh_xpos)=xpos#
         FireLineBuffer#(lp,sh_ypos)=ypos#
         FireLineBuffer#(lp,sh_zpos)=zpos#


      next Lp
   return






` *=----------------------------------------------------------------=*
` *=---------------------- Build Palettes --------------------------=*
` *=----------------------------------------------------------------=*

` Palette spread ='s  255,255,255 towards RANDOM COLOUR towards BLACK


_Build_Palettes:

   dim palettes(Numb_of_FireLines,Numb_of_FireLinesSegments)

   _mid=8
   Theend=Numb_of_FireLinesSegments
   lockbuffer
      for palettelp=0 to Numb_of_FireLines-1

         ` create fire line main colour
         mr#=rnd(255)
         mg#=rnd(255)
         mb#=rnd(255)

         ` Interpolate palette WHITE to FIRE LINES COLOUR

   ;      r1#=255:   g1#=255:   b1#=255
         r2#=mr#:   g2#=mg#:   b2#=mb#
   ;      _int_colours(palettelp,0,_mid,r1#,g1#,b1#,r2#,g2#,b2#)


;         gouraudstriph  0,$ffffff,_mid,rgb(mr#,mg#,mb#),0
         ` Interpolate FIRE LINES COLOUR to BLACK

         r1#=mr#:   g1#=mg#:   b1#=mb#
         r2#=0:   g2#=0:   b2#=0
;         _int_colours(palettelp,_mid,theend,r1#,g1#,b1#,r2#,g2#,b2#)
         _int_colours(palettelp, 0,theend,r1#,g1#,b1#,r2#,g2#,b2#)

      next palettelp
      unlockbuffer
   return


function _int_colours(l,p1,p2,r1#,g1#,b1#,r2#,g2#,b2#)

   dp#=p2-p1

   dr#=r2#-r1#
   dg#=g2#-g1#
   db#=b2#-b1#

   gr#=dr#/dp#
   gg#=dg#/dp#
   gb#=db#/dp#

   for lp=p1 to p2-1
      c=rgb(r1#,g1#,b1#)
      palettes(l,lp)=c
      r1#=r1#+gr#
      g1#=g1#+gg#
      b1#=b1#+gb#
      dotc lp,l,c
   next lp
   c=rgb(r1#,g1#,b1#)
   palettes(l,lp)=c

endfunction


function random_range(bot,top)
   if bot>top
      b=top:t=bot
      else
      b=bot:t=top
   endif
   d=top-bot
   result=bot+(rnd(d))
endfunction result



Function Lerp#(Src#,Dest#,Scale#)
         Result#=Src#+((Dest#-src#)*Scale#)
EndFunction Result#




Function RndSpeed#(ThisRange)
      repeat
         result#=rndrange#(-ThisRange,ThisRange)
      until result#
EndFunction Result#