Dog pattern + gradient

New to FreeBASIC? Post your questions here.
Post Reply
Löwenherz
Posts: 46
Joined: Aug 27, 2008 6:26
Location: Bad Sooden-Allendorf, Germany

Dog pattern + gradient

Post by Löwenherz »

Hello all

Made Yesterday this example with Gradient Background freebasic Letter and a Kind of Dog pattern... This Dog pattern doesn't Work correct and I wanted to Center this Dog in my Scene

Help is Welcome

Code: Select all

' - dog pattern with gradient background, 22-04-2024
' - freebasic, example with gradient bg and colored letter
'  dog patterns arent correct here
'
ScreenRes 640, 480, 32
Dim As Integer r, g, b
DIM buffer AS ANY PTR

' GRADIENT BACKGROUND -------------------------------------- //
FOR x As Long = 0 TO 639
    FOR y As Long = 0 TO 479
        r = INT((255 * x) / 640)
        g = 0
        b = INT((255 * y) / 480)
        PSET (x, y), RGB(r, g, b)
    NEXT
Next


' TEXT ----------------------------------------------------- //
DIM AS STRING text = "FreeBASIC"
Dim As Integer x = 5 
Dim As Integer y = 20 'x = 20, y = 12

FOR i As Long = 1 TO LEN(text)
    LOCATE y, x
    SELECT CASE i
        CASE 1
            COLOR RGB(255, 0, 0) ' F
        CASE 2
            COLOR RGB(0, 255, 0) ' r
        CASE 3
            COLOR RGB(0, 0, 255) ' e
        CASE 4
            COLOR RGB(255, 255, 0) ' e
        CASE 5
            COLOR RGB(255, 0, 255) ' B
        CASE 6
            COLOR RGB(0, 255, 255) ' A
        CASE 7
            COLOR RGB(255, 0, 255) ' S
        CASE 8
            COLOR RGB(255, 255, 255) ' I
        CASE 9
            COLOR RGB(250, 0, 0) ' C
    END SELECT
    PRINT MID(text, i, 1);
    x = x + 9
Next
Print ""

' DOG SHAPE ------------------------------------------------- //
Locate 30,10
DIM SHARED AS STRING dog(12)
dog(1)="    __\ \ _"
dog(2)="    __ \ \ _"
dog(3)="  / __o o  | \\"
dog(4)="  /_\  | |"
dog(5)="       |  /"
dog(6)="      /___\"
dog(7)="     |     |"
dog(8)="     |  |  |  \\"
dog(9)="     |__|__|   \\"
dog(10)="    /       \__\\__"
dog(11)="   |         ______|"
dog(12)="   |_________|"

 x = 200
 y = 200

FOR i As Long = 1 TO 12
    LOCATE y, x
    PRINT dog(i)
    y = y + 1
NEXT

buffer = IMAGECREATE(400, 400, 1)

DRAW buffer, dog(12)
PUT (10, 10), buffer

Sleep()
paul doe
Moderator
Posts: 1738
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Dog pattern + gradient

Post by paul doe »

Generally speaking, to center something, you'd use:

Code: Select all

p = ( w - l ) / 2
Where:

Code: Select all

p = the resulting centered coordinate
w = the extent where you want to center (in your example, this would be the screen width, in chars)
l = the length you want to center (in your example, this would be the length of the string, in chars)
Example code:

Code: Select all

function center( w as long, l as long ) as long
  return( ( w - l ) / 2 )
end function

var s = "Hello FreeBasic!"

locate _
  center( 25, 1 ), _ '' 1 because it's only 1 line of text
  center( 80, len( s ) )

? s

sleep()
Löwenherz
Posts: 46
Joined: Aug 27, 2008 6:26
Location: Bad Sooden-Allendorf, Germany

Re: Dog pattern + gradient

Post by Löwenherz »

Thank you Paul for your Code example for Center a string

A) I have managed to Center the Dog Figure shape but B) without your function cause that must be 12 lines to Center and I didnt make to run this function unfortunately

Code: Select all

' - freebasic check length of a string, 21/23-04-2024, frank bruebach
' - working example string below, example runs, thx fxm :-)
'
Dim As String my_string = "Screen 13:color 15,3:cls:line(100,100)-(150,150),,bf:line(150,150)-(200,100),,bf:line(200,100)-(180,50),,bf:line(180,50)-(120,50),,bf:line(120,50)-(100,100),,bf:color 2,10:locate 10,20:? "";:color 2,11:locate 20,15:? ""Fr"";:color 2,12:locate 30,20:? ""e"";:color 2,13:locate 40,20:? ""e"";:color 2,14:locate 50,20:? ""B"";:color 2,15:locate 60,20:? ""a"";:color 2,0:locate 70,20:? ""s"";:color 2,1:locate 80,20:? ""iC"";:color 2,2:Sleep"

' Initialize an array to store character counts (assuming ASCII characters)
Dim As Integer char_count(-1 TO 255)

' Iterate over the first 1024 characters of the string
For i As Integer =  0 To Len(my_string)-1 '1 To 1024
    ' Get the character
    'Dim As String current_char = Mid(my_string, i, 1)
    Dim As integer current_char = my_string[i]
    ' Ignore spaces and commas
    '''''If current_char <> " " And current_char <> "," Then
    
    If current_char <> asc(" ") And current_char <> asc(",") Then
    ' Increment the count for the character
        char_count(current_char) += 1
        char_count(-1) += 1
    End If
Next

' Print the character counts
Print "Number of characters in the string"; Len(my_string)
Print
Print "Number of characters counted"; char_count(-1)
For i As Integer = 0 To 255
    If char_count(i) > 0 Then
        Print "   Character "; Chr(i); " occurs "; char_count(i); " times."
    End If
Next
Print "all ok with result" 
sleep
fxm
Moderator
Posts: 12147
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Dog pattern + gradient

Post by fxm »

For example:

Code: Select all

ScreenRes 640, 480, 32
Dim As Integer r, g, b
DIM buffer AS ANY PTR

' GRADIENT BACKGROUND -------------------------------------- //
FOR x As Long = 0 TO 639
    FOR y As Long = 0 TO 479
        r = INT((255 * x) / 640)
        g = 0
        b = INT((255 * y) / 480)
        PSET (x, y), RGB(r, g, b)
    NEXT
Next


' TEXT ----------------------------------------------------- //
DIM AS STRING text = "FreeBASIC"
Dim As Integer x = 5 
Dim As Integer y = 20 'x = 20, y = 12

FOR i As Long = 1 TO LEN(text)
    LOCATE y, x
    SELECT CASE i
        CASE 1
            COLOR RGB(255, 0, 0) ' F
        CASE 2
            COLOR RGB(0, 255, 0) ' r
        CASE 3
            COLOR RGB(0, 0, 255) ' e
        CASE 4
            COLOR RGB(255, 255, 0) ' e
        CASE 5
            COLOR RGB(255, 0, 255) ' B
        CASE 6
            COLOR RGB(0, 255, 255) ' A
        CASE 7
            COLOR RGB(255, 0, 255) ' S
        CASE 8
            COLOR RGB(255, 255, 255) ' I
        CASE 9
            COLOR RGB(250, 0, 0) ' C
    END SELECT
    PRINT MID(text, i, 1);
    x = x + 9
Next
Print ""

' DOG SHAPE ------------------------------------------------- //

Sub printCentered(s() As String)
    Dim As Integer x = (Hiword(Width) - (Ubound(s) - Lbound(s) + 1)) / 2 + 1
    Dim As Integer max
    For I As Integer = Lbound(s) To Ubound(s)
        If Len(s(I)) > max Then
            max = Len(s(I))
        End If
    Next I
    Dim As Integer y = (Loword(Width) - max) / 2 + 1
    For I As Integer = Lbound(s) To Ubound(s)
        Locate x, y
        Print s(I)
        x += 1
    Next I
End Sub
    
DIM SHARED AS STRING dog(12)
dog(1)="    __\ \ _"
dog(2)="    __ \ \ _"
dog(3)="  / __o o  | \\"
dog(4)="  /_\  | |"
dog(5)="       |  /"
dog(6)="      /___\"
dog(7)="     |     |"
dog(8)="     |  |  |  \\"
dog(9)="     |__|__|   \\"
dog(10)="    /       \__\\__"
dog(11)="   |         ______|"
dog(12)="   |_________|"

printCentered(dog())

Sleep
Löwenherz
Posts: 46
Joined: Aug 27, 2008 6:26
Location: Bad Sooden-Allendorf, Germany

Re: Dog pattern + gradient

Post by Löwenherz »

Many thanks fxm your solution is much shorter and more elegant :)

I have still Problems to understand freebasic String s, Array s () and then s (i) and lbound(s) to ubound(s) and Last Not least Dog(12) and Print centered(Dog() )

It's quite new for me I want to say the different Handling for this Case s and s() but its Welcome cause its Working well
Post Reply