'//LensFlare in 32 bit '//Relsoft 2004 '//v3cz0r is da man! '//Use Freebasic(by v3cz0r) to compile '//Texture algo by BlackPawn '// defint a-z '$include: 'tinyptc.bi' TYPE vector2d '2d vector used to get flare positions x AS SINGLE 'x component y AS SINGLE mag AS SINGLE 'length END TYPE declare sub cls(byref buffer()) declare sub pcopy ( byref dest() as integer, byref source() as integer) declare sub smooth( byref buffer()) declare sub put_pixel(byref buffer(), byval x as integer, byval y as integer, byval col as integer) declare sub draw_line(byref buffer(), byval x as integer, byval y as integer, byval x2 as integer, byval y2 as integer, byval col as integer) declare sub draw_line_h ( byref buffer(), byval x1 as integer, byval y as integer, byval x2 as integer, byval col as integer) declare sub draw_line_v ( byref buffer(), byval x as integer, byval y1 as integer, byval y2 as integer, byval col as integer) declare sub draw_rect_fill(byref buffer(), byval x1 as integer, byval y1 as integer, byval x2 as integer, byval y2 as integer, byval col as integer) declare sub draw_rect(byref buffer(), byval x1 as integer, byval y1 as integer, byval x2 as integer, byval y2 as integer, byval col as integer) declare sub put_solid (byref buffer(), byval x as integer, byval y as integer, byref sprite()) declare sub put_trans (byref buffer(), byval x as integer, byval y as integer, byref sprite()) declare sub putx (byref buffer(), byval x as integer, byval y as integer, byref sprite()) declare sub get_sprite( byref buffer() as integer, byval x1 as integer, byval y1 as integer _ , byval x2 as integer, byval y2 as integer, byref sprite() as integer) declare function size_of_image(byval x1 as integer, byval y1 as integer, byval x2 as integer _ , byval y2 as integer) declare FUNCTION smoothstep! (byval a!,byval b!,byval x!) declare SUB normalizevec (byref v AS vector2d) const SCR_WIDTH = 320 * 1 const SCR_HEIGHT = 240 * 1 const SCR_SIZE = SCR_WIDTH*SCR_HEIGHT CONST xcenter = SCR_WIDTH \ 2 CONST ycenter = SCR_HEIGHT \ 2 const PI = 3.141593 const radius1 = 32 const radius2 = 20 const radius3 = 16 const radius4 = 24 const radius5 = 32 const IMGSIZE1 = ((radius1*2) ^ 2) + 2 const IMGSIZE2 = ((radius2*2.5) ^ 2) + 2 const IMGSIZE3 = ((radius3*2.5) ^ 2) + 2 const IMGSIZE4 = ((radius4*2) ^ 2) + 2 const IMGSIZE5 = ((radius5*2) ^ 2) + 2 dim shared buffer( 0 to SCR_SIZE-1 ) as integer dim shared flare1( 0 to IMGSIZE1 ) as integer dim shared flare2( 0 to IMGSIZE2 ) as integer dim shared flare3( 0 to IMGSIZE3 ) as integer dim shared flare4( 0 to IMGSIZE4 ) as integer dim shared flare5( 0 to IMGSIZE5 ) as integer DIM vec AS vector2d 'dimension both the light DIM light AS vector2d 'and direction vector if( ptc_open( "freeBASIC v0.01 - RelGFX win demo(Relsoft)", SCR_WIDTH, SCR_HEIGHT ) = 0 ) then end -1 end if '// #1 FOR y = 0 TO radius1 * 2 FOR x = 0 TO radius1 * 2 dx = radius1 - x dy = radius1 - y r! = SQR(dx * dx + dy * dy) / radius1 c! = 1 - r! c! = c! * c! IF r! > 1 THEN c! = 0 cr = c! * 255 cg = c! * 128 cb = c! * 255 put_pixel buffer(),x, y, cr shl 16 or cg shl 8 or cb NEXT x NEXT y dimen = (radius1 * 2) - 1 get_sprite buffer(), 0, 0, dimen, dimen, flare1() cls buffer() '// #2 FOR y = 0 TO radius2 * 2 FOR x = 0 TO radius2 * 2 dx = radius2 - x dy = radius2 - y r! = SQR(dx * dx + dy * dy) / radius2 c! = r! c! = c! * (1 - smoothstep!(1 - .04, 1 + .04, r!)) cr = c! * 155 cg = c! * 255 cb = c! * 0 put_pixel buffer(),x, y, cr shl 16 or cg shl 8 or cb NEXT x NEXT y dimen = (radius2 * 2) get_sprite buffer(), 0, 0, dimen, dimen, flare2() cls buffer() '// #3 FOR y = 0 TO radius3 * 2 FOR x = 0 TO radius3 * 2 dx = radius3 - x dy = radius3 - y r! = SQR(dx * dx + dy * dy) / radius3 c! = r! * r! c! = c! * c! c! = c! * c! * c! c! = c! * (1 - smoothstep!(1 - .04, 1 + .04, r!)) cr = c! * 0 cg = c! * 255 cb = c! * 128 put_pixel buffer(),x, y, cr shl 16 or cg shl 8 or cb NEXT x NEXT y dimen = (radius3 * 2) get_sprite buffer(), 0, 0, dimen, dimen, flare3() cls buffer() '// #4 FOR y = 0 TO radius4 * 2 FOR x = 0 TO radius4 * 2 dx = radius4 - x dy = radius4 - y r! = SQR(dx * dx + dy * dy) / radius4 c! = 1 - ABS(r! - .9) / .19 c! = c! * c! c! = c! * c! IF c! > 1 THEN c! = 1 IF r! > 1 THEN c! = 0 'try to rem this cr = c! * 155 cg = c! * 255 cb = c! * 155 put_pixel buffer(),x, y, cr shl 16 or cg shl 8 or cb NEXT x NEXT y dimen = (radius4 * 2) - 1 get_sprite buffer(), 0, 0, dimen, dimen, flare4() cls buffer() '// #5 FOR y = 0 TO radius5 * 2 FOR x = 0 TO radius5 * 2 dx = radius5 - x dy = radius5 - y r! = SQR(dx * dx + dy * dy) / radius5 c! = 1 - ABS(r! - .9) / .19 IF c! < 0 THEN c! = 0 c! = c! * c! c! = c! * c! IF c! > 1 THEN c! = 1 IF r! > 1 THEN c! = 0 'try to rem this cr = c! * 0 cg = c! * 0 cb = c! * 255 if cb < 64 then cb = 0 put_pixel buffer(),x, y, cr shl 16 or cg shl 8 or cb NEXT x NEXT y dimen = (radius5 * 2) - 1 get_sprite buffer(), 0, 0, dimen, dimen, flare5() cls buffer() cx = xcenter 'center of screen cy = ycenter frame& = 0 do frame& = (frame& + 1) mod 360 dim t! T! = TIMER light.x = INT(COS(T! * .4) + SIN(T!) * SCR_WIDTH \ 2 ) light.y = INT(SIN(T! + .2) * SIN(T! * .5) * SCR_HEIGHT \ 2 ) 'change the length for cooler effect leng = INT(SIN(T! + .2) * SIN(T! * .5) * SCR_HEIGHT) 'center our light vector light.x = light.x + cx light.y = light.y + cy 'derive flare vector from center and light vec.x = cx - light.x vec.y = cy - light.y 'normalize it normalizevec vec 'get positions of flares relative to center l1! = leng l2! = leng / 1.5 l3! = leng / 2 l4! = -leng / 8 l5! = -leng / 2 l6! = -leng cls buffer() IF (frame& AND 1) THEN 'do some nice flicker fx 'get flare position of flare using a line derived 'by leng*vec nx! = vec.x * l1! + cx ny! = vec.y * l1! + cy put_trans buffer(), nx! - radius5, ny! - radius5, flare5() 'combine 2 flares for put_trans buffer(), nx! - radius1, ny! - radius1, flare1() 'cooler fx. :*) 'ditto but single flare nx! = vec.x * l2! + cx ny! = vec.y * l2! + cy put_trans buffer(), nx! - radius3, ny! - radius3, flare3() put_trans buffer(), nx! - radius2, ny! - radius2, flare2() 'ditto nx! = vec.x * l3! + cx ny! = vec.y * l3! + cy put_trans buffer(), nx! - radius4, ny! - radius4, flare4() 'ditto nx! = vec.x * l4! + cx ny! = vec.y * l4! + cy put_trans buffer(), nx! - radius3, ny! - radius3, flare3() 'ditto nx! = vec.x * l5! + cx ny! = vec.y * l5! + cy put_trans buffer(), nx! - radius2, ny! - radius2, flare2() 'ditto nx! = vec.x * l6! + cx ny! = vec.y * l6! + cy put_trans buffer(), nx! - radius3, ny! - radius3, flare3() 'put_trans buffer(), nx! - radius5, ny! - radius5, flare5() put_trans buffer(), nx! - radius1, ny! - radius1, flare1() END IF ptc_update varptr( buffer(0) ) loop ptc_close '******************************************************************************************* ' ' '******************************************************************************************* private FUNCTION smoothstep! (byval a!,byval b!,byval x!) 'smooths the edges of the flare 'Algo by BlackPawn IF x! < a! THEN smoothstep! = 0 EXIT FUNCTION ELSEIF x! >= b! THEN smoothstep! = 1 EXIT FUNCTION END IF x! = (x! - a!) / (b! - a!) smoothstep! = (x! * x!) * (3 - 2 * x!) END FUNCTION private SUB normalizevec (byref v AS vector2d) 'normalizes v to give it a length of 1 dx! = v.x dy! = v.y dist! = SQR(dx! * dx! + dy! * dy!) IF dist! < .00001 THEN EXIT SUB 'just a precaution for too small 'values v.x = dx! / dist! v.y = dy! / dist! v.mag = dist! END SUB '******************************************************************************************* 'GFX subs/Funks ' '******************************************************************************************* private sub put_pixel(byref buffer(), byval x as integer, byval y as integer, byval col as integer) buffer(y * SCR_WIDTH + x) = col end sub private sub pcopy ( byref dest() as integer, byref source() as integer) dim offset as long for offset = 0 to SCR_SIZE -1 dest( offset ) = source( offset ) next offset end sub private sub cls(byref buffer()) dim offset as long for offset = 0 to SCR_SIZE -1 buffer( offset ) = 0 next offset end sub private sub smooth( byref buffer()) dim maxpixel as integer dim offset as integer dim pixel as integer dim r as integer dim g as integer dim b as integer dim nr as integer dim ng as integer dim nb as integer maxpixel = ubound(buffer) for offset = SCR_WIDTH to maxpixel-SCR_WIDTH pixel = buffer(offset-1) r = pixel shr 16 g = pixel shr 8 and 255 b = pixel and 255 nr = r shr 2 ng = g shr 2 nb = b shr 2 pixel = buffer(offset+1) r = pixel shr 16 g = pixel shr 8 and 255 b = pixel and 255 nr = nr + ( r shr 2 ) ng = ng + ( g shr 2 ) nb = nb + ( b shr 2 ) pixel = buffer(offset+SCR_WIDTH) r = pixel shr 16 g = pixel shr 8 and 255 b = pixel and 255 nr = nr + ( r shr 2 ) ng = ng + ( g shr 2 ) nb = nb + ( b shr 2 ) pixel = buffer(offset-SCR_WIDTH) r = pixel shr 16 g = pixel shr 8 and 255 b = pixel and 255 nr = nr + ( r shr 2 ) ng = ng + ( g shr 2 ) nb = nb + ( b shr 2 ) buffer(offset) = nr shl 16 or ng shl 8 or nb next i end sub private sub draw_line(byref buffer(), byval x as integer, byval y as integer, byval x2 as integer, byval y2 as integer, byval col as integer) dim i as integer dim slope as integer dim eterm as integer dim dx as integer dim dy as integer dim sx as integer dim sy as integer dim notclip as integer dim temp as integer const scrxmax = SCR_WIDTH - 1 const scrymax = SCR_HEIGHT - 1 I = 0 Slope = 0 Eterm = 0 IF (X2 - X) > 0 THEN SX = 1 ELSE SX = -1 END IF Dx = ABS(X2 - X) IF (Y2 - Y) > 0 THEN SY = 1 ELSE SY = -1 END IF Dy = ABS(Y2 - Y) IF (Dy > Dx) THEN Slope = 1 temp = x x = y y = temp temp = dx dx = dy dy = temp temp = sx sx = sy sy = temp END IF Eterm = 2 * Dy - Dx FOR I = 0 TO Dx - 1 IF Slope = 1 THEN NotClip = (((Y < 0) + (X < 0) + (Y > scrxmax) + (X > scrymax)) = 0) IF NotClip THEN buffer(x * SCR_WIDTH + y ) = col ELSE NotClip = (((X < 0) + (Y < 0) + (X > scrxmax) + (Y > scrymax)) = 0) IF NotClip THEN buffer(Y * SCR_WIDTH + X ) = col END IF WHILE Eterm >= 0 Y = Y + SY: Eterm = Eterm - 2 * Dx WEND X = X + SX: Eterm = Eterm + 2 * Dy NEXT I NotClip = (((X2 < 0) + (Y2 < 0) + (X2 > scrxmax) + (Y2 > scrymax)) = 0) IF NotClip THEN buffer(Y2 * SCR_WIDTH + X2 ) = col end sub private sub draw_line_h ( byref buffer(), byval x1 as integer, byval y as integer, byval x2 as integer, byval col as integer) const SCR_X_MAX = SCR_WIDTH - 1 const SCR_Y_MAX = SCR_HEIGHT - 1 dim wid as integer dim offset as long dim counter as integer dim temp as integer if (y < 0) or (y > SCR_Y_MAX) then exit sub if (x1 > x2) then temp = x1 x1 = x2 x2 = temp end if if x1 > SCR_X_MAX then exit sub if x2 < 0 then exit sub if x1 < 0 then x1 = 0 if (x2 - x1) < 0 then exit sub end if if x2 > SCR_X_MAX then x2 = SCR_X_MAX if (x2 - x1) < 0 then exit sub end if wid = (x2 - x1) + 1 if wid <= 0 then exit sub offset = y * SCR_WIDTH + x1 for counter = 0 to (wid - 1) buffer( offset ) = col offset = offset + 1 next counter end sub private sub draw_line_v ( byref buffer(), byval x as integer, byval y1 as integer, byval y2 as integer, byval col as integer) const SCR_X_MAX = SCR_WIDTH - 1 const SCR_Y_MAX = SCR_HEIGHT - 1 dim hite as integer dim offset as long dim counter as integer dim temp as integer if (x < 0) or (x > SCR_X_MAX) then exit sub if (y1 > y2) then temp = y1 y1 = y2 y2 = temp end if if y1 > SCR_Y_MAX then exit sub if y2 < 0 then exit sub if y1 < 0 then y1 = 0 if (y2 - y1) < 0 then exit sub end if if y2 > SCR_Y_MAX then y2 = SCR_Y_MAX if (y2 - y1) < 0 then exit sub end if hite = (y2 - y1) + 1 if hite <= 0 then exit sub offset = y1 * SCR_WIDTH + x for counter = 0 to (hite - 1) buffer( offset ) = col offset = offset + SCR_WIDTH next counter end sub private sub draw_rect_fill(byref buffer(), byval x1 as integer, byval y1 as integer, byval x2 as integer, byval y2 as integer, byval col as integer) const SCR_X_MAX = SCR_WIDTH - 1 const SCR_Y_MAX = SCR_HEIGHT - 1 dim hite as integer dim wid as integer dim offset as long dim xcounter as integer dim ycounter as integer dim temp as integer if (x1 > x2) then temp = x1 x1 = x2 x2 = temp end if if x1 > SCR_X_MAX then exit sub if x2 < 0 then exit sub if x1 < 0 then x1 = 0 if (x2 - x1) < 0 then exit sub end if if x2 > SCR_X_MAX then x2 = SCR_X_MAX if (x2 - x1) < 0 then exit sub end if wid = (x2 - x1) + 1 if wid <= 0 then exit sub if (y1 > y2) then temp = y1 y1 = y2 y2 = temp end if if y1 > SCR_Y_MAX then exit sub if y2 < 0 then exit sub if y1 < 0 then y1 = 0 if (y2 - y1) < 0 then exit sub end if if y2 > SCR_Y_MAX then y2 = SCR_Y_MAX if (y2 - y1) < 0 then exit sub end if hite = (y2 - y1) + 1 if hite <= 0 then exit sub offset = y1 * SCR_WIDTH + x1 for ycounter = 0 to (hite - 1) for xcounter = 0 to (wid - 1) buffer( offset + xcounter ) = col next xcounter offset = offset + SCR_WIDTH next ycounter end sub private sub draw_rect(byref buffer(), byval x1 as integer, byval y1 as integer, byval x2 as integer, byval y2 as integer, byval col as integer) draw_line_h buffer(), x1, y1, x2, col draw_line_v buffer(), x1, y1, y2, col draw_line_h buffer(), x1, y2, x2, col draw_line_v buffer(), x2, y1, y2, col end sub private function size_of_image(byval x1 as integer, byval y1 as integer, byval x2 as integer, byval y2 as integer) dim s as integer dim temp as integer if x1 > x2 then temp = x1 x1 = x2 x2 = temp end if if y1 > y2 then temp = y1 y1 = y2 y2 = temp end if s = ((x2 - x1) + 1) * ((y2 - y1) + 1) + 2 size_of_image = s end function private sub put_solid (byref buffer(), byval x as integer, byval y as integer, byref sprite()) const SCR_X_MAX = SCR_WIDTH - 1 const SCR_Y_MAX = SCR_HEIGHT - 1 dim owid as integer dim ohei as integer dim wid as integer dim hei as integer dim wcounter as integer dim hcounter as integer dim offset as integer ptr dim soffset as integer ptr dim htemp as integer dim wtemp as integer dim erroradd as integer ptr dim sprclipadd as integer ptr if (x > SCR_X_MAX) then exit sub if (y > SCR_Y_MAX) then exit sub owid = sprite(0) ohei = sprite(1) wid = owid hei = ohei erroradd = 0 sprclipadd = 0 soffset = @sprite(2) if y < 0 then y = -y soffset = soffset + (wid * y) hei = hei - y if hei <= 0 then exit sub y = 0 end if if (y + hei) > SCR_Y_MAX then htemp = (y + hei) - SCR_HEIGHT hei = hei - htemp if hei <= 0 then exit sub end if if x < 0 then x = -x soffset= soffset + x wid = wid - x if wid <= 0 then exit sub sprclipadd = x * len (integer) x = 0 end if if (x + wid) > SCR_X_MAX then wtemp = (x + wid) - SCR_WIDTH wid = wid - wtemp sprclipadd = wtemp * len (integer) if (wid <= 0) then exit sub end if erroradd = (SCR_WIDTH - wid) * len(integer) offset = @buffer(0)+ ((y * SCR_WIDTH + x)* len(integer)) for hcounter = 0 to (hei - 1) for wcounter = 0 to (wid - 1 ) *offset = *soffset soffset = soffset + len(integer) offset = offset + len(integer) next wcounter offset = offset + erroradd soffset = soffset + sprclipadd next hcounter end sub private sub putx (byref buffer(), byval x as integer, byval y as integer, byref sprite()) const SCR_X_MAX = SCR_WIDTH - 1 const SCR_Y_MAX = SCR_HEIGHT - 1 dim owid as integer dim ohei as integer dim wid as integer dim hei as integer dim wcounter as integer dim hcounter as integer dim offset as long dim soffset as long dim htemp as integer dim wtemp as integer dim pixel as integer if (x > SCR_X_MAX) then exit sub if (y > SCR_Y_MAX) then exit sub owid = sprite(0) ohei = sprite(1) wid = owid hei = ohei soffset = 2 if y < 0 then y = -y soffset = soffset + (wid * y) hei = hei - y if hei <= 0 then exit sub y = 0 end if if (y + hei) > SCR_Y_MAX then htemp = (y + hei) - SCR_HEIGHT hei = hei - htemp if hei <= 0 then exit sub end if if x < 0 then x = -x soffset= soffset + x wid = wid - x if wid <= 0 then exit sub x = 0 end if if (x + wid) > SCR_X_MAX then wtemp = (x + wid) - SCR_WIDTH wid = wid - wtemp if (wid <= 0) then exit sub end if offset = y * SCR_WIDTH + x for hcounter = 0 to (hei - 1) for wcounter = 0 to (wid - 1 ) pixel = sprite(soffset + wcounter) if pixel <> 0 then buffer( offset + wcounter) = pixel next wcounter offset = offset + SCR_WIDTH soffset = soffset + owid next hcounter end sub private sub put_trans (byref buffer(), byval x as integer, byval y as integer, byref sprite()) const SCR_X_MAX = SCR_WIDTH - 1 const SCR_Y_MAX = SCR_HEIGHT - 1 dim owid as integer dim ohei as integer dim wid as integer dim hei as integer dim wcounter as integer dim hcounter as integer dim offset as long dim soffset as long dim htemp as integer dim wtemp as integer dim pixel as integer dim r as integer dim g as integer dim b as integer dim br as integer dim bg as integer dim bb as integer if (x > SCR_X_MAX) then exit sub if (y > SCR_Y_MAX) then exit sub owid = sprite(0) ohei = sprite(1) wid = owid hei = ohei soffset = 2 if y < 0 then y = -y soffset = soffset + (wid * y) hei = hei - y if hei <= 0 then exit sub y = 0 end if if (y + hei) > SCR_Y_MAX then htemp = (y + hei) - SCR_HEIGHT hei = hei - htemp if hei <= 0 then exit sub end if if x < 0 then x = -x soffset= soffset + x wid = wid - x if wid <= 0 then exit sub x = 0 end if if (x + wid) > SCR_X_MAX then wtemp = (x + wid) - SCR_WIDTH wid = wid - wtemp if (wid <= 0) then exit sub end if offset = y * SCR_WIDTH + x for hcounter = 0 to (hei - 1) for wcounter = 0 to (wid - 1 ) pixel = sprite(soffset + wcounter) if pixel <> 0 then r = pixel shr 16 g = pixel shr 8 and 255 b = pixel and 255 pixel = buffer( offset + wcounter) br = pixel shr 16 bg = pixel shr 8 and 255 bb = pixel and 255 r = (r + br) shr 1 g = (g + bg) shr 1 b = (b + bb) shr 1 pixel = r shl 16 or g shl 8 or b buffer( offset + wcounter) = pixel end if next wcounter offset = offset + SCR_WIDTH soffset = soffset + owid next hcounter end sub private sub get_sprite( byref buffer() as integer, byval x1 as integer, byval y1 as integer _ , byval x2 as integer, byval y2 as integer, byref sprite() as integer) const SCR_X_MAX = SCR_WIDTH - 1 const SCR_Y_MAX = SCR_HEIGHT - 1 dim hite as integer dim wid as integer dim offset as integer ptr dim soffset as integer ptr dim xcounter as integer dim ycounter as integer dim temp as integer dim erroradd as integer ptr erroradd = 0 if (x1 > x2) then temp = x1 x1 = x2 x2 = temp end if if x1 > SCR_X_MAX then exit sub if x2 < 0 then exit sub if x1 < 0 then x1 = 0 if (x2 - x1) < 0 then exit sub end if if x2 > SCR_X_MAX then x2 = SCR_X_MAX if (x2 - x1) < 0 then exit sub end if wid = (x2 - x1) + 1 if wid <= 0 then exit sub if (y1 > y2) then temp = y1 y1 = y2 y2 = temp end if if y1 > SCR_Y_MAX then exit sub if y2 < 0 then exit sub if y1 < 0 then y1 = 0 if (y2 - y1) < 0 then exit sub end if if y2 > SCR_Y_MAX then y2 = SCR_Y_MAX if (y2 - y1) < 0 then exit sub end if hite = (y2 - y1) + 1 if hite <= 0 then exit sub sprite(0) = wid sprite(1) = hite soffset = @sprite(2) erroradd = (SCR_WIDTH - wid) * len(integer) offset = @buffer(0) + ((y1 * SCR_WIDTH + x1)* len(integer)) for ycounter = 0 to (hite - 1) for xcounter = 0 to (wid -1) *soffset = *offset soffset = soffset + len(integer) offset = offset + len(integer) next xcounter offset = offset + erroradd next ycounter end sub