Wavey Words

[bplus]

Improved! You can now read the words vertically as well as horizontally!

Code: (Select All)

_Title "Wavy Words 2, press escape to quit..." 'bplus mod 2025-10-08
Screen _NewImage(640, 400, 32): _ScreenMove 300, 150
_PrintMode _KeepBackground
p$ = "H.e.l.l.o...Q.B.6.4.P.E...W.o.r.l.d.!...H.e.l.l.o...Q.B.6.4.P.E...W.o.r.l.d.!.."
For i = 1 To 2
    p$ = p$ + p$
Next
da = .01
Do
    For y = 0 To 400
        Line (0, y)-(640, y), _RGB32(255 - 300 * y / 400, 255 - 300 * y / 400, 255 - 255 * y / 400)
    Next
    For j = 0 To 24
        Color _RGB32(255 - 32 * j, 255 - 32 * j, 255 - 12 * j)
        For l = 1 To Len(p$)
            _PrintString (l * 8 - j * 16, 124 + 32 * Sin(l / 10 + a) + j * 16), Mid$(p$, l, 1)
        Next
    Next
    _Display: _Limit 200: a = a + da
Loop Until _KeyDown(27)

Edit: deepened the ocean or words.

[Unseen Machine]

I think this code shows how long ive been Qb64 coding! its actually the demo for the TAN function in the help file! Love that!

Code: (Select All)

DIM SHARED text AS STRING

text$ = "S P I R A L"

DIM SHARED word(1 TO LEN(text$) * 8, 1 TO 16)



CALL analyse

CLS

CALL redraw



SUB analyse

  CLS

  SCREEN 12

  COLOR 2: LOCATE 1, 1: PRINT text$

  DIM px AS INTEGER, py AS INTEGER, cnt AS INTEGER, ltrcnt AS INTEGER

  px = 1: py = 1

  DO

    word(px, py) = POINT(px, py)

    PSET (px, py), 1

    px = px + 1

    IF px = LEN(text$) * 8 THEN

      px = 1

      py = py + 1

    END IF

  LOOP UNTIL py = 16

END SUB



SUB redraw

  CLS

  DIM row AS INTEGER, cnt AS INTEGER, cstart AS SINGLE, cend AS SINGLE

  DIM xrot AS INTEGER, yrot AS INTEGER, SCALE AS INTEGER, pan AS INTEGER

  cstart = 0: cend = 6.2

  xrot = 6: yrot = 6: SCALE = 3: pan = 30

  OUT &H3C8, 1: OUT &H3C9, 10: OUT &H3C9, 10: OUT &H3C9, 60

  DO

    row = 2

    DO

      DO

        FOR i = cend TO cstart STEP -.03

          x = (SCALE * 60 - (row * xrot / 4)) * TAN(COS(i))

          y = SIN(SCALE * 60 - (row * yrot)) * TAN(SIN(i)) * pan

          cnt = cnt + 1

          IF word(cnt, row) > 0 THEN

            CIRCLE (x + 320, y + 220), SCALE + 1, 1 'circled letters

            'LINE (x + 320, y + 220)-STEP(12, 12), 1, BF  'boxed letters

          END IF

          IF cnt = LEN(text$) * 8 THEN cnt = 0: EXIT DO

        NEXT

      LOOP

      row = row + 1

    LOOP UNTIL row = 16

    cend = cend + .1

    cstart = cstart + .1

    now! = TIMER

    DO

      newnow! = TIMER

    LOOP UNTIL newnow! - now! >= .15

    LINE (1, 100)-(639, 280), 0, BF

  LOOP UNTIL INKEY$ = CHR$(27)

END SUB

A feeling very old Unseen

[bplus]

Out?

maybe this is spiral

Code: (Select All)

_Title "Spiral Words 2, press escape to quit..." 'bplus mod 2025-10-08
Screen _NewImage(640, 400, 32): _ScreenMove 300, 150
_PrintMode _KeepBackground
p$ = "H.e.l.l.o...Q.B.6.4.P.E...W.o.r.l.d.!...H.e.l.l.o...Q.B.6.4.P.E...W.o.r.l.d.!.."
For i = 1 To 2
    p$ = p$ + p$
Next
da = .01
Do
    For y = 0 To 400
        Line (0, y)-(640, y), _RGB32(255 - 300 * y / 400, 255 - 300 * y / 400, 255 - 255 * y / 400)
    Next
    For j = 1 To 8
        Color _RGB32(255 - 32 * j, 255 - 32 * j, 255 - 12 * j)
        For l = 1 To Len(p$)
            _PrintString (l * 8 - j * 16, 124 - 64 * Sin(l / 3 + a) + j * 16), Mid$(p$, l, 1)
        Next
    Next
    _Display: _Limit 200: a = a + da
Loop Until _KeyDown(27)

[Unseen Machine]

OUT! Lol! That is how we used to change/set colours in QBasic! Shows you how old the code(and me) is!

p.s. Your code looks freaking sweet! DAMN! Nice!

Make me sub that renders a graduated background like that on any size screen and from a colour to another...ill die!

[bplus]

Sounds like you are asking for MidInk? 

A double use of midInk to setup ocean view:

Code: (Select All)

Const xmax = 800, ymax = 600
Screen _NewImage(xmax, ymax, 32)
For y = 0 To (ymax - 1) / 2
    Line (0, y)-(xmax - 1, y), midInk~&(50, 0, 200, 200, 200, 255, y / (ymax / 2))
    Line (0, ymax / 2 + y)-(xmax - 1, ymax / 2 + y), midInk~&(0, 255, 255, 0, 80, 0, y / (ymax / 2))
Next

Function midInk~& (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
    midInk~& = _RGB32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
End Function

EDIT: Sorry already modified.

   

[Unseen Machine]

Yep! Exactly that! As im sure you are aware, making a graduated fill is child play for me but yours looked/looks NICE!

Maybe it's me being an old git but games to me were always about the GAME not the environment or GFX level. Yes they added to it to a certain extent but the rush I got from typing Prince /megahit has never been surpassed when loading a new Prince Of Persia game...they look better now yeah, but they dont have the same edge, urgency, charisma! So, things like this that take me back to those days when CPU cycles, memory size/speed and anything else mattered A LOT just makes me smile...

Now the sun is setting though....

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 Sun

  x AS SINGLE

  y AS SINGLE

  radius AS INTEGER

  color AS _UNSIGNED LONG

  alpha AS SINGLE

END TYPE



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



'///////////////////////////////////////////////////////////////////////////////////////



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



  _DISPLAY



  _DEST 0

  _PUTIMAGE , screenBuffer

  _DISPLAY

LOOP UNTIL _KEYDOWN(27)

_FREEIMAGE screenBuffer

SYSTEM



'///////////////////////////////////////////////////////////////////////////////////////





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



'///////////////////////////////////////////////////////////////////////////////////////



'///////////////////////////////////////////////////////////////////////////////////////



'///////////////////////////////////////////////////////////////////////////////////////



'///////////////////////////////////////////////////////////////////////////////////////

John

[bplus]

Nice John! I have special liking of positively radiating suns.

That reminds me, I had posted sun and rainbow demos with MidInk~& Function
https://qb64phoenix.com/forum/showthread...6#pid33816
replies #58 thru #60