Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
alien skies
#12
Trees Reflection
Here is an example of water reflection and trees too for that matter. I hope it helps add to this wonderful project. I have to give it a thumbs up because you got me pulling out old old code and translating it to QB64!

Code: (Select All)
_Title "Trees Reflection" 'b+ trans from SB 2022-05-06
Rem trees reflection.bas 2016-02-22 SmallBASIC 0.12.2 [B+=MGA]
'lakeshore demo repurposed with new and improved trees reflected in lake

Const xmax = 1024, ymax = 600

Screen _NewImage(xmax, ymax, 32)
_ScreenMove 200, 80 ' clear sides
Dim Shared As _Unsigned Long qb(15)
qb(0) = &HFF000000
qb(1) = &HFF000088
qb(2) = &HFF008800
qb(3) = &HFF008888
qb(4) = &HFF880000
qb(5) = &HFF880088
qb(6) = &HFF888800
qb(7) = &HFFCCCCCC
qb(8) = &HFF888888
qb(9) = &HFF0000FF
qb(10) = &HFF00FF00
qb(11) = &HFF00FFFF
qb(12) = &HFFFF0000
qb(13) = &HFFFF00FF
qb(14) = &HFFFFFF00
qb(15) = &HFFFFFFFF

For i = 0 To ymax
    Line (0, i)-(xmax, i), _RGB32(70, 60, i / ymax * 160)
Next
stars = xmax * ymax * 10 ^ -4
horizon = .67 * ymax
For i = 1 To stars 'stars in sky
    PSet (Rnd * xmax, Rnd * horizon), qb(11)
Next
stars = stars / 2
For i = 1 To stars
    fcirc Rnd * xmax, Rnd * horizon, 1, qb(11)
Next
stars = stars / 2
For i = 1 To stars
    fcirc Rnd * xmax, Rnd * horizon, 2, qb(11)
Next
For i = .67 * ymax To .8 * ymax
    gc = max(0, 100 - (i - .67 * ymax) * .5)
    Line (0, i)-(xmax, i), _RGB32(gc, gc, gc)
Next
branch xmax * .6 + Rnd * .3 * xmax, ymax * .75 - .07 * ymax, 6, 90, xmax / 20, 0
branch Rnd * .3 * xmax, ymax * .75 - .05 * ymax, 7, 90, xmax / 18, 0
branch xmax / 2, ymax * .77, 8, 90, xmax / 16, 0
Line (0, .8 * ymax)-(xmax, .8 * ymax + 1), _RGB32(70, 70, 70), BF
For y = .8 * ymax To ymax
    For x = 0 To xmax
        yy = .8 * ymax - (y - .8 * ymax) * 4
        PSet (x, y), Point(x, yy)
    Next
Next
_Display

'code from lakeshore make waves in tree reflection??
' This image size: 1,1-400,270
' Water area: 1,190 - 400,270  that means wh=270-190=80 ww=400-1=399
'now water area is .8*ymax to ymax by 0 to xmax
wh = Int(.2 * ymax): ww = xmax
Dim t1(.25 * ymax + 3, xmax + 2) As _Unsigned Long ' store water area > t1(), make it slighly bigger
For ii = .8 * ymax To ymax
    For iii = 0 To xmax
        t1(ii - Int(.8 * ymax), iii) = Point(iii, ii)
    Next
Next

' *** Let's wave it ***
waveit:
mo = 3 '  height of strip, bigger > waves, smaller > flickering
If bb < mo Then bb = wh - 3
colp = (colp + 1) Mod 4 'need to random place for to create clickering
aa = 0
For aa1 = 1 To (mo - 1)
    aa = bb - aa1 + Int(.8 * ymax) - 1
    For aaa = 0 To xmax
        PSet (aaa, aa), t1(aa + colp - .8 * ymax, aaa)
        PSet (aaa, aa + 1), t1(aa + colp - Int(.8 * ymax), aaa)
        PSet (aaa, aa + 2), t1(aa + colp - Int(.8 * ymax), aaa)
    Next
Next
bb = bb - (mo + 1) ' next strip place
_Display
_Limit 5
If _KeyDown(27) Then End
GoTo waveit

Sub branch (x, y, startr, angD, lngth, lev)
    ' local x2,y2,dx,dy,bc,i
    Dim bc As _Unsigned Long
    x2 = x + Cos(_D2R(angD)) * lngth
    y2 = y - Sin(_D2R(angD)) * lngth
    dx = (x2 - x) / lngth
    dy = (y2 - y) / lngth
    bc = _RGB32(10 + lev, 15 + lev, 10)
    For i = 0 To lngth
        fcirc x + dx * i, y + dy * i, startr, bc
    Next
    If startr - 1 < 0 Or lev > 11 Or lngth < 5 Then Exit Sub
    lev2 = lev + 1
    branch x2, y2, startr - 1, angD + 10 + 30 * Rnd, .8 * lngth + .2 * Rnd * lngth, lev2
    branch x2, y2, startr - 1, angD - 10 - 30 * Rnd, .8 * lngth + .2 * Rnd * lngth, lev2
End Sub

Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
    Dim Radius As Long, RadiusError As Long
    Dim X As Long, Y As Long
    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
    If Radius = 0 Then PSet (CX, CY), C: Exit Sub
    Line (CX - X, CY)-(CX + X, CY), C, BF
    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    Wend
End Sub

Function max (x, y)
    If x > y Then max = x Else max = y
End Function

For water reflection pick horizon line across screen, measure from it to top and from it to bottom and scale (fit) the sky into the bottom water section in height (width is 1 to 1). Map!( ) function might be useful. 
Oh heck might try a _PutImage of the sky flipped upside down and crammed into the water section, all I've done is a lakeside view across the whole width but puddles could be made by drawing ground to cover reflected points where you don't want to see them.

The trees have branch widths indirectly proportional to level from trunk. 
   

Oops having trouble with waves BRB
OK hacked a fix, it's been years since I looked at this code.
b = b + ...
Reply


Messages In This Thread
alien skies - by James D Jarvis - 05-05-2022, 01:11 PM
RE: alien skies - by johnno56 - 05-05-2022, 01:23 PM
RE: alien skies - by James D Jarvis - 05-05-2022, 01:45 PM
RE: alien skies - by James D Jarvis - 05-05-2022, 02:20 PM
RE: alien skies - by Dav - 05-05-2022, 03:12 PM
RE: alien skies - by James D Jarvis - 05-05-2022, 03:52 PM
RE: alien skies - by bplus - 05-05-2022, 04:00 PM
RE: alien skies - by James D Jarvis - 05-05-2022, 04:59 PM
RE: alien skies - by johnno56 - 05-05-2022, 07:54 PM
RE: alien skies - by James D Jarvis - 05-05-2022, 09:31 PM
RE: alien skies - by James D Jarvis - 05-06-2022, 01:24 PM
RE: alien skies - by bplus - 05-06-2022, 06:12 PM
RE: alien skies - by bplus - 05-07-2022, 04:52 PM
RE: alien skies - by James D Jarvis - 05-07-2022, 04:55 PM
RE: alien skies - by bplus - 05-07-2022, 05:09 PM
RE: alien skies - by bplus - 05-08-2022, 02:21 AM
RE: alien skies - by James D Jarvis - 05-11-2022, 02:35 PM
RE: alien skies - by James D Jarvis - 06-29-2022, 06:10 PM



Users browsing this thread: 1 Guest(s)