Code: (Select All)
'///////////////////////////////////////////////////////////////////////////////////////
'// Pushing Bplus's code to the max! Sun, Sky and sea!
'///////////////////////////////////////////////////////////////////////////////////////
CONST xmax = 800, ymax = 600
CONST horizonY = ymax / 2
CONST sunRadius = 80
CONST numShimmers = 100
TYPE Vector2
X AS SINGLE
Y AS SINGLE
END TYPE
TYPE Sun
x AS SINGLE
y AS SINGLE
radius AS INTEGER
color AS _UNSIGNED LONG
alpha AS SINGLE
END TYPE
' Global data for the Perlin noise algorithm.
DIM SHARED g_p(511) AS INTEGER ' Permutation table, doubled to wrap
DIM SHARED g_grad(31) AS Vector2 ' Predefined gradient vectors
DIM SHARED g_initialized AS INTEGER, g_time AS SINGLE '// setup complete and animation timer
DIM SHARED time AS SINGLE
DIM SHARED screenBuffer AS LONG
DIM SHARED mySun AS Sun
DIM SHARED y AS INTEGER
DIM SHARED i AS INTEGER
DIM SHARED yPos AS SINGLE
DIM SHARED lineLength AS SINGLE
DIM SHARED xPos AS SINGLE
DIM SHARED sunColor AS LONG
DIM SHARED shimmerColor AS LONG
DIM SHARED alpha AS SINGLE
DIM SHARED r AS INTEGER
DIM SHARED reflectionY AS SINGLE
DIM SHARED angle AS SINGLE
DIM SHARED sunsetFactor AS SINGLE
'///////////////////////////////////////////////////////////////////////////////////////
InitPerlin ' Initialize the Perlin noise system by filling the permutation tables
'///////////////////////////////////////////////////////////////////////////////////////////////////
SCREEN _NEWIMAGE(xmax, ymax, 32)
screenBuffer = _NEWIMAGE(xmax, ymax, 32)
_TITLE "Sunset with Color Adjustment"
mySun.radius = sunRadius
mySun.color = _RGB32(255, 255, 0, 255)
'///////////////////////////////////////////////////////////////////////////////////////
DO
_LIMIT 60
_DEST screenBuffer
time = time + 0.01
SUN_Update mySun, time, xmax, horizonY, sunsetFactor
' Draw sky gradient
FOR y = 0 TO horizonY - 1
LINE (0, y)-(xmax - 1, y), midInk_Func(200, 50, 0, 80, 0, 80, y / horizonY, sunsetFactor)
NEXT
' Draw water reflection gradient
FOR y = horizonY TO ymax - 1
LINE (0, y)-(xmax - 1, y), midInk_Func(0, 255, 255, 0, 80, 0, (y - horizonY) / horizonY, 1)
NEXT
' Draw the sun
IF mySun.y + mySun.radius > 0 AND mySun.y <= horizonY THEN
FOR r = mySun.radius TO 0 STEP -1
alpha = (1 - (r / mySun.radius)) * 255
sunColor = _RGB32(255, 255 - r * 8, 0, alpha)
_SETALPHA alpha, sunColor
CIRCLE (mySun.x, mySun.y), r, sunColor
NEXT
END IF
' Draw the reflection of the sun with perspective
IF mySun.y + mySun.radius > 0 AND mySun.y <= horizonY THEN
reflectionY = horizonY + (horizonY - mySun.y)
DIM distanceFactor AS SINGLE
distanceFactor = (reflectionY - horizonY) / (ymax - horizonY) ' 0 at horizon, 1 at bottom
FOR r = mySun.radius TO 0 STEP -1
alpha = (1 - (r / mySun.radius)) * 255
sunColor = _RGB32(255, 255 - r * 8, 0, alpha)
' Increase opacity with distance
_SETALPHA alpha * (0.5 + distanceFactor * 0.5), sunColor
' Stretch horizontally based on distance
CIRCLE (mySun.x, reflectionY), r * (1 + distanceFactor * 2), sunColor
NEXT
END IF
' --- Shimmering Reflections ---
shimmerColor = _RGB32(255, 255, 0, alpha)
FOR i = 0 TO numShimmers - 1
yPos = RND * (ymax - horizonY) + horizonY
lineLength = 5 + RND * 20
xPos = RND * (xmax - lineLength)
alpha = 50 + RND * 50
_SETALPHA alpha, shimmerColor
LINE (xPos, yPos)-(xPos + lineLength, yPos)
NEXT i
g_time = g_time + 15 ' Adjust this value to change the speed
DrawClouds 800, 300, 4, .05 '// last two parameters are detail level...lower = faster but worse and last is scale...make larger for smaller clouds
_DISPLAY
_DEST 0
_PUTIMAGE , screenBuffer
_DISPLAY
LOOP UNTIL _KEYDOWN(27)
_FREEIMAGE screenBuffer
SYSTEM
'///////////////////////////////////////////////////////////////////////////////////////////////////
' Sub to initialize the permutation and gradient tables. This creates a more organic cloud
SUB InitPerlin
IF g_initialized THEN EXIT SUB
' Permutation table, as a string of hex values.
p_hex$ = "9BA1B2ED B168D1B6 722D8B87 795B066C 7F27B5C7 E3C90CE2 B7460320 4C1B8C99 470A940F EBE430C5 AB1E594D 3F53A8BF E5CCA42F 08E8F243 417E2AD5 333CDE29 0D883B48 6E1018A7 139ED4AE 6D80504B E9EEF076 634A043A A9372C45 C25CA55E 07C6F76B 9F899362 1C703E60 C4D80009 8291B87D CFF87A16 7B6A8386 A6D067B9 648A0B54 DF320121 85D35A96 BA558F31 7465FC02 1A1DA32B 52927C8D 26421744 23358475 9A6FDA73 1FAA4990 22589D95 24E171D7 FD51BDA0 14255777 8ECA380E 78156111 BCF69756 9CCD A2FB AD3934D6 5F6905DB C8B0E6C1 ECBEFA12 D9F966F4 CB98E7C3 BBDCFECE F5B3B43D AC C0FFDD F32EAF F1B0"
DIM p(255) AS INTEGER, i AS INTEGER, j AS INTEGER
FOR i = 1 TO LEN(p_hex$)
hex_char$ = MID$(p_hex$, i, 1)
IF hex_char$ <> " " THEN
val_str$ = val_str$ + hex_char$
IF LEN(val_str$) = 2 THEN
p(j) = VAL("&H" + val_str$) '// convert to hex value
val_str$ = ""
j = j + 1
END IF
END IF
NEXT i
' Copy the table to itself for wrapping.
FOR i = 0 TO 255
g_p(i) = p(i)
g_p(i + 256) = p(i)
NEXT i
' Predefined gradient vectors for 2D.
g_grad(0).X = 1: g_grad(0).Y = 1
g_grad(1).X = -1: g_grad(1).Y = 1
g_grad(2).X = 1: g_grad(2).Y = -1
g_grad(3).X = -1: g_grad(3).Y = -1
g_grad(4).X = 1: g_grad(4).Y = 0
g_grad(5).X = -1: g_grad(5).Y = 0
g_grad(6).X = 0: g_grad(6).Y = 1
g_grad(7).X = 0: g_grad(7).Y = -1
g_initialized = 1
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////
' Sub to generate and draw the cloud effect using FBM.
SUB DrawClouds (width AS INTEGER, height AS INTEGER, FineDetail, Scale)
DIM x AS INTEGER, y AS INTEGER
DIM clr AS LONG, shadowClr AS LONG, cloudClr AS LONG, highlightClr AS LONG
shadowClr = _RGB32(5, 5, 5) ' Dark shadow color (purplish grey)
cloudClr = _RGB32(120, 120, 130) ' Main cloud body color (light grey)
highlightClr = _RGB32(255, 255, 255) ' Bright highlight color (pure white)
octaves = FineDetail ' Use more octaves for finer detail
persistence = 0.5
'scale = 0.0005 ' Smaller scale for larger cloud features
FOR y = 0 TO height - 1
FOR x = 0 TO width - 1
noiseValue = 0
frequency = Scale
amplitude = 1
' Fractal Brownian Motion (FBM) loop
FOR i = 1 TO octaves
' Add g_time to the x-coordinate to simulate horizontal movement
noiseValue = noiseValue + PerlinNoise((x + g_time) * frequency, y * frequency) * amplitude
frequency = frequency * 2
amplitude = amplitude * persistence
NEXT i
' Clamp and adjust noise for appearance.
noiseValue = ABS(noiseValue) ^ 0.7
IF noiseValue > 1 THEN noiseValue = 1
IF noiseValue < 0 THEN noiseValue = 0
' Map the noise value to a color.
IF noiseValue < 0.5 THEN
clr = LerpClr(shadowClr, cloudClr, noiseValue * 2)
ELSE
clr = LerpClr(cloudClr, highlightClr, (noiseValue - 0.5) * 2)
PSET (x, y), clr
END IF
NEXT x
NEXT y
END SUB
'///////////////////////////////////////////////////////////////////////////////////////////////////
' Function to perform linear interpolation between two colors.
FUNCTION LerpClr& (clr1 AS LONG, clr2 AS LONG, t AS SINGLE)
DIM r1 AS INTEGER, g1 AS INTEGER, b1 AS INTEGER
DIM r2 AS INTEGER, g2 AS INTEGER, b2 AS INTEGER
DIM r AS INTEGER, g AS INTEGER, b AS INTEGER
r1 = _RED32(clr1)
g1 = _GREEN32(clr1)
b1 = _BLUE32(clr1)
r2 = _RED32(clr2)
g2 = _GREEN32(clr2)
b2 = _BLUE32(clr2)
r = r1 + t * (r2 - r1)
g = g1 + t * (g2 - g1)
b = b1 + t * (b2 - b1)
LerpClr& = _RGB32(r, g, b)
END FUNCTION
'///////////////////////////////////////////////////////////////////////////////////////////////////
' Main Perlin noise function for 2D.
FUNCTION PerlinNoise! (x AS SINGLE, y AS SINGLE)
DIM x_int AS INTEGER, y_int AS INTEGER
DIM gi00 AS Vector2, gi01 AS Vector2, gi10 AS Vector2, gi11 AS Vector2
DIM dist00 AS Vector2, dist01 AS Vector2, dist10 AS Vector2, dist11 AS Vector2
' Get the integer and fractional parts.
x_int = INT(x) AND 255
y_int = INT(y) AND 255
x_frac = x - INT(x)
y_frac = y - INT(y)
' Get the gradients for the four corners.
gi00 = g_grad(g_p(g_p(x_int) + y_int) AND 7)
gi01 = g_grad(g_p(g_p(x_int) + y_int + 1) AND 7)
gi10 = g_grad(g_p(g_p(x_int + 1) + y_int) AND 7)
gi11 = g_grad(g_p(g_p(x_int + 1) + y_int + 1) AND 7)
' Create and populate temporary distance vectors.
dist00.X = x_frac: dist00.Y = y_frac
dist01.X = x_frac: dist01.Y = y_frac - 1
dist10.X = x_frac - 1: dist10.Y = y_frac
dist11.X = x_frac - 1: dist11.Y = y_frac - 1
' Calculate dot products of gradient and distance vectors.
n00 = DotProduct(gi00, dist00)
n01 = DotProduct(gi01, dist01)
n10 = DotProduct(gi10, dist10)
n11 = DotProduct(gi11, dist11)
' Smooth the interpolation (fade function).
u = Fade(x_frac)
v = Fade(y_frac)
' Interpolate to find the final noise value.
PerlinNoise = Lerp(Lerp(n00, n10, u), Lerp(n01, n11, u), v)
END FUNCTION
'///////////////////////////////////////////////////////////////////////////////////////////////////
' Hermite interpolation function (6t^5 - 15t^4 + 10t^3).
FUNCTION Fade (t AS SINGLE)
Fade = t * t * t * (t * (t * 6 - 15) + 10)
END FUNCTION
'///////////////////////////////////////////////////////////////////////////////////////////////////
' Linear interpolation function.
FUNCTION Lerp (a AS SINGLE, b AS SINGLE, t AS SINGLE)
Lerp = a + t * (b - a)
END FUNCTION
'///////////////////////////////////////////////////////////////////////////////////////////////////
' Helper function to compute the dot product of two vectors.
FUNCTION DotProduct (v1 AS Vector2, v2 AS Vector2)
DotProduct = v1.X * v2.X + v1.Y * v2.Y
END FUNCTION
'///////////////////////////////////////////////////////////////////////////////////////////////////
SUB SUN_Update (sun AS Sun, time AS SINGLE, xmax AS INTEGER, horizonY AS INTEGER, sunsetFactor AS SINGLE)
' Set the sun's x-position to be permanently in the center
sun.x = xmax / 2
' The sun's y-position increases linearly with time
sun.y = time * (horizonY + sun.radius)
' Calculate sunsetFactor based on the sun's vertical position
' It goes from 1.0 (sun at top) to 0.0 (sun below horizon)
IF sun.y <= horizonY + sun.radius THEN
sunsetFactor = 1 - (sun.y / horizonY)
IF sunsetFactor < 0 THEN sunsetFactor = 0
ELSE
sunsetFactor = 0
END IF
' Reset the position once it passes the horizon
IF sun.y > (horizonY + (sun.radius * 2)) THEN
time = 0
sun.y = -sun.radius ' Start above the screen
END IF
END SUB
'///////////////////////////////////////////////////////////////////////////////////////
FUNCTION midInk_Func~& (r1%, g1%, b1%, r2%, g2%, b2%, fr##, sunsetFactor AS SINGLE)
' Interpolate between colors
redComp = r1% + (r2% - r1%) * fr##
greenComp = g1% + (g2% - g1%) * fr##
blueComp = b1% + (b2% - b1%) * fr##
' Darken the colors based on sunsetFactor
redComp = redComp * sunsetFactor
greenComp = greenComp * sunsetFactor
blueComp = blueComp * sunsetFactor
' Return the adjusted color
midInk_Func~& = _RGB32(redComp, greenComp, blueComp)
END FUNCTION
'///////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////
Best i've got for now son!
Its fun though!
John
Clouds? for 100 Lines or Less Challenge
