Challenges

[dbox]

Aw man, sorry to hear you’ve been having a rough time, @bplus.  I hope you can heal quickly and get to feeling better real soon!

[madscijr]

@bplus Wishing you a speedy recovery and good luck with the thermostat.

[bplus]

Thanks guys, just had another take on the title of this thread

[Unseen Machine]

I figured it was important after my little b*tch moment recently that i participate so I made AI write this!!! It took longer to correct it than if id done it myself and still its not what i wanted....but its close! It's inspired by the arecibo disk...I hope it's okay...I'm not sorry i used AI as its something im very much into to expand/improve my coding.

Code: (Select All)

' Main program

SCREEN _NEWIMAGE(1024, 768, 32) ' Create a high-resolution window

COLOR _RGB32(255, 255, 255) ' Set default text color to white

CLS



DIM message AS STRING



' Get user input

LOCATE 1, 1

PRINT "Enter your message to convert into a binary crop circle:"

INPUT message



' Clear screen for graphics

CLS





' Draw the alien face and the main encompassing circle

CALL DrawAlienFace(300, 384)

CIRCLE (750, 384), 250, _RGB(250, 0, 0) ' The main circle boundary



' Draw the text as binary blocks inside the large circle

CALL TextToBinaryBlocks(message)



' Keep the program running until a key is pressed

DO: LOOP UNTIL INKEY$ <> ""



END











SUB TextToBinaryBlocks (message$)

  DIM binaryString AS STRING

  DIM totalBits AS INTEGER

  DIM i AS INTEGER

  DIM j AS INTEGER

  DIM centerX AS INTEGER, centerY AS INTEGER

  DIM lineCount AS INTEGER

  DIM lineBits AS INTEGER

  DIM radiusStep AS SINGLE

  DIM bitAngleStep AS DOUBLE

  DIM lineRadius AS SINGLE

  DIM angle AS DOUBLE

  DIM colorCode AS LONG

  DIM blockSize AS INTEGER

  DIM blockAngularWidth AS DOUBLE



  centerX = 750

  centerY = _HEIGHT / 2



  ' Concatenate the binary representations of all characters

  FOR i = 1 TO LEN(message$)

    binaryString = binaryString + GetBinary(MID$(message$, i, 1))

  NEXT i



  totalBits = LEN(binaryString)

  lineCount = 5

  lineBits = INT(totalBits / lineCount) ' Number of bits per circle line

  IF totalBits MOD lineCount > 0 THEN lineBits = lineBits + 1



  radiusStep = 20 ' Distance between concentric circles



  ' Loop through the number of lines

  FOR i = 1 TO lineCount

    lineRadius = 100 + (i - 1) * radiusStep ' Start with an inner radius and step out

    angle = 0



    ' Adjust the block size (radial height) based on the radius

    blockSize = 5 + (i - 1) * 3



    ' The desired angular width of each block in radians (assuming constant size at a reference radius)

    blockAngularWidth = .05 ' Adjust this constant for desired width



    ' Calculate the angular step needed to fit all blocks without overlapping

    bitAngleStep = (2 * 3.14159) / lineBits



    ' Loop through the bits for the current line

    FOR j = 1 TO lineBits

      IF (i - 1) * lineBits + j <= totalBits THEN

        ' Set the color based on the binary digit

        IF MID$(binaryString, (i - 1) * lineBits + j, 1) = "1" THEN

          colorCode = _RGB(255, 0, 0) ' Solid Red

        ELSE

          colorCode = _RGB(255, 70, 70) ' Light Red

        END IF



        ' Draw a filled, rotated block at the calculated position

        CALL DrawFilledRotatedBlock(centerX, centerY, lineRadius, angle, blockSize, blockAngularWidth, colorCode)

      END IF



      angle = angle + bitAngleStep ' Increment angle for the next bit

    NEXT j

  NEXT i

END SUB



' ==========================================================

' Subroutine to draw a filled, rotated block

SUB DrawFilledRotatedBlock (centerX AS INTEGER, centerY AS INTEGER, radius AS SINGLE, angle AS DOUBLE, blockSize AS INTEGER, blockAngleWidth AS DOUBLE, colorCode AS LONG)

  DIM x1 AS INTEGER, y1 AS INTEGER

  DIM x2 AS INTEGER, y2 AS INTEGER



  ' Use a loop to draw lines from the inner radius to the outer radius, filling the segment

  FOR i = 0 TO blockSize - 1 STEP 1

    x1 = centerX + ((radius + i) * COS(angle - blockAngleWidth))

    y1 = centerY + ((radius + i) * SIN(angle - blockAngleWidth))

    x2 = centerX + ((radius + i) * COS(angle + blockAngleWidth))

    y2 = centerY + ((radius + i) * SIN(angle + blockAngleWidth))

    LINE (x1, y1)-(x2, y2), colorCode

  NEXT i

END SUB





' ==========================================================

' Function to convert a single character to its 8-bit binary string

FUNCTION GetBinary$ (char AS STRING)

  DIM ascValue AS INTEGER

  DIM binaryResult AS STRING

  DIM i AS INTEGER



  ascValue = ASC(char)

  binaryResult = ""



  FOR i = 7 TO 0 STEP -1

    IF (ascValue AND (2 ^ i)) THEN

      binaryResult = binaryResult + "1"

    ELSE

      binaryResult = binaryResult + "0"

    END IF

  NEXT i



  GetBinary = binaryResult

END FUNCTION



' ==========================================================

' Subroutine to draw a basic alien face

SUB DrawAlienFace (centerX AS INTEGER, centerY AS INTEGER)

  ' Head (ellipse)

  CIRCLE (centerX, centerY - 50), 100, _RGB(0, 100, 0), , , 1.5

  PAINT (centerX, centerY - 50), _RGB(0, 100, 0)



  ' Eyes (black ellipses with white glints)

  CIRCLE (centerX - 40, centerY - 60), 20, _RGB(0, 0, 0), , , 0.5

  PAINT (centerX - 40, centerY - 60), _RGB(0, 0, 0)

  CIRCLE (centerX + 40, centerY - 60), 20, _RGB(0, 0, 0), , , 0.5

  PAINT (centerX + 40, centerY - 60), _RGB(0, 0, 0)



  ' Glints

  CIRCLE (centerX - 35, centerY - 65), 3, _RGB(255, 255, 255)

  PAINT (centerX - 35, centerY - 65), _RGB(255, 255, 255)

  CIRCLE (centerX + 45, centerY - 65), 3, _RGB(255, 255, 255)

  PAINT (centerX + 45, centerY - 65), _RGB(255, 255, 255)



  ' Mouth (simple line)

  LINE (centerX - 20, centerY + 30)-(centerX + 20, centerY + 30), _RGB(0, 0, 0)



  ' Neck (shaded rectangle)

  LINE (centerX - 25, centerY + 50)-(centerX + 25, centerY + 80), _RGB(0, 100, 0), BF

END SUB

As always, Happy coding!

Unseen

[bplus]

Thanks @Unseen Machine!  I tried the old "Hello World" for my message. Binary kinda hard to read

[Unseen Machine]

Its all alien to me! Glad you approve though! i've got more ideas in me head so give me a while and ill be sure to post some more...also its actually a cool challenge...so i enjoy it...next one may have actual wheatsheaves in gl though just cause im me....

[bplus]

also its actually a cool challenge...so i enjoy it...

Yes Crop Circles is a subject that fascinates me and challenges....

https://qb64phoenix.com/forum/showthread...162&page=9

see post #83 and #86 happened kinda spontneously and a favorite

[bplus]

Doyle Spirals are a bit like crop circles except I made mine more colorful.

I tried a similar thing with crop circles in Proggies some time ago using the Golden Angle 137.5 degrees but the spirals going in opposite directions did not show nearly as clean as here:

   

Can anyone come close to duplicating this graphic?

[2112]

Doyle Spirals are a bit like crop circles except I made mine more colorful.

I tried a similar thing with crop circles in Proggies some time ago using the Golden Angle 137.5 degrees but the spirals going in opposite directions did not show nearly as clean as here:



Can anyone come close to duplicating this graphic?

Code: (Select All)

handle& = _NewImage(620, 630, 32)

Screen handle&

stars = 360

Dim sr(stars + 1) As Integer 'radius of stars

Dim ss(stars + 1) As Integer 'step speed of stars

Dim sd(stars + 1) As Integer 'degrees of stars

Dim sx(stars + 1) As Single 'x position of stars

Dim sy(stars + 1) As Single 'y position of stars

Dim sxf, syf As Integer 'x,y final position of stars



Dim pi As Single

pi = 360 ' 3.14159

For i = 1 To stars

    ss(i) = 1 'step

    sr(i) = i / 2 '100'radius

    sd(i) = 360 'degrees

    sx(i) = i * (360 / stars) 'x pos

    sy(i) = i * (360 / stars) 'y pos

Next i

Do

    Cls

    For i = stars To 1 Step -1

        If sx(i) < 360 Then sx(i) = sx(i) + ss(i) Else sx(i) = sx(i) - 360

        If sy(i) < 360 Then sy(i) = sy(i) + ss(i) Else sy(i) = sy(i) - 360

        sxf = Sin(pi * sx(i) / sd(i)) * (sr(i) / 1)

        syf = Cos(pi * sy(i) / sd(i)) * (sr(i) / 2) - (360 - i)

        syf2 = Cos(pi * sy(i) / sd(i)) * (sr(i) / 1)

        Line (300 + sxf, 500 + syf)-(302 + sxf, 502 + syf), _RGB(Rnd * 200, 220, 0), BF ' TREE

        Line (300 + sxf / 3, 70 + syf2 / 3)-(301 + sxf / 3, 71 + syf2 / 3), _RGB(150 + Rnd * 100, 150 + Rnd * 100, 0), BF 'STAR

    Next i

    _Delay .01

    _Display

Loop Until InKey$ = Chr$(27)

_AutoDisplay

End

[bplus]

@2112 +1 thats a nice animated Xmas tree and really nice star that does look Doyle Spirals like. Still working out how you managed the star...
   

I was looking for more contrast of the 2 spirals that go in opposite direction.. I have updated Doyle Spirals 2 to show what circles are underneath the Doyle Spirals by modifying the radii of the spirals:
   

I think it makes for more interesting graphic.