Scrolling fog/cloud image for moving background

[bplus]

This is what I have for landscapes, took me too long to figure the scroll:

Code: (Select All)

_Title "Scroll landscape image test" 'b+ 2022-05-22
Const xmax = 800, ymax = 600
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 300, 40
Randomize Timer

drawLandscape
'Sleep
wImg& = _NewImage(2 * _Width, _Height, 32)
_PutImage (0, 0)-(_Width - 1, _Height - 1), 0, wImg&
_PutImage (_Width, 0)-Step(_Width - 1, _Height), 0, wImg&, (_Width, 0)-Step(-(_Width - 1), _Height)
_PutImage , wImg&, 0
'Sleep ' ok

Do
    'Cls    ' don't clear because 2 giant black lines
    '===================================================

    _PutImage (0, 0)-(_Width - 1, _Height - 1), wImg&, 0, (x, 0)-(_Width + x, ymax)
    If _Width + x >= _Width(wImg&) Then
        diff = _Width + x - _Width(wImg&)
        _PutImage (0, 0)-(diff, _Height - 1), wImg&, 0, (x, 0)-(x + diff, ymax)
        _PutImage (2 * (_Width) - x, 0)-(_Width - 1, _Height - 1), wImg&, 0, (0, 0)-(diff + 1, ymax)
        'Line (2 * _Width - x, 0)-(_Width, _Height), &HFFFF0000, BF

    Else
        _PutImage (0, 0)-(_Width - 1, _Height - 1), wImg&, 0, (x, 0)-(_Width + x, ymax)
    End If
    x = x + 2: If x > _Width(wImg&) Then x = 0

    _Display
    _Limit 60

Loop

Sub drawLandscape
    'needs midInk, irnd

    Dim i As Long, startH As Single, rr As Long, gg As Long, bb As Long
    Dim mountain As Long, Xright As Single, y As Single, upDown As Single, range As Single
    Dim lastx As Single, X As Long
    'the sky
    For i = 0 To ymax
        midInk 0, 0, 128, 128, 128, 200, i / ymax
        Line (0, i)-(xmax, i)
    Next
    'the land
    startH = ymax - 200
    rr = 70: gg = 70: bb = 90
    For mountain = 1 To 6
        Xright = 0
        y = startH
        While Xright < xmax
            ' upDown = local up / down over range, change along Y
            ' range = how far up / down, along X
            upDown = (Rnd * .8 - .35) * (mountain * .5)
            range = Xright + irnd&(15, 25) * 2.5 / mountain
            lastx = Xright - 1
            For X = Xright To range
                y = y + upDown
                Color _RGB(rr, gg, bb)
                Line (lastx, y)-(X, ymax), , BF 'just lines weren't filling right
                lastx = X
            Next
            Xright = range
        Wend
        rr = irnd&(rr - 15, rr): gg = irnd&(gg - 15, gg): bb = irnd&(bb - 25, bb)
        If rr < 0 Then rr = 0
        If gg < 0 Then gg = 0
        If bb < 0 Then bb = 0
        startH = startH + irnd&(5, 20)
    Next
End Sub

Sub midInk (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
    Color _RGB32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
End Sub

Function irnd& (n1, n2) 'return an integer between 2 numbers
    Dim l%, h%
    If n1 > n2 Then l% = n2: h% = n1 Else l% = n1: h% = n2
    irnd& = Int(Rnd * (h% - l% + 1)) + l%
End Function