PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

PureBasic Community: Evolving Code -- [Atleast read it :)]

https://www.purebasic.fr/english/viewtopic.php?t=40836

Page 2 of 3

Re: PureBasic Community: Evolving Code -- [Atleast read it :)]

Posted: Wed Jan 27, 2010 3:34 am
by happer66
Since I'm new at this I'm not going to contribute more than this, nice initiative Nituvious!

Code: Select all

;*********************************************
; PureBasic Community: Evolving code
;    January 26, 2010
;    Nituvious - initial seed
;    Trond - changed textgadget to imagegadget
;    JackWebb - cleanup
;    Nituvious - scrolls the text
;    c4s - cleanup
;    Trond - bug fix
;    citystate - color cycling
;    happer66 - syntax fix
;*********************************************

; EnableExplicit

Enumeration
  #Font
  #Image
  #WindowMain
  #GadgetImage
EndEnumeration

Define iWidth.l = 300
Define iHeight.l = 200 ; Maybe someone can think up something cool to do with this :)
Define Text.s = "The PureBasic Community rocks!"
Define TextX.f, TextY.f
Define I, ColorI, Color, count
Define EventID



LoadFont(#Font, "Verdana", 11, #PB_Font_Bold | #PB_Font_Italic)

If CreateImage(#Image, iWidth, iHeight)
   StartDrawing(ImageOutput(#Image))
      DrawingFont(FontID(#Font))

      Box(0, 0, iWidth, iHeight, RGB(0, 0, 0))

      For I = Len(Text) To 0 Step -1
         ColorI = 255 - (I * 255) / Len(Text)
         Color = RGB(ColorI, 255 - ColorI, ColorI)
         DrawText(10, (iHeight / 2) - 20, Left(Text, I), Color, RGB(0, 0, 0))
      Next
   StopDrawing()
EndIf


OpenWindow(#WindowMain, #PB_Ignore, #PB_Ignore, iWidth, iHeight, "PB Community: Evolving code", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
SetWindowColor(#WindowMain, RGB(0, 0, 0)) ; Give us a black background for our moving text

ImageGadget(#GadgetImage, 0, 0, 0, 0, ImageID(#Image))


Repeat
; cycle the colors
   StartDrawing(ImageOutput(#Image))
      DrawingFont(FontID(#Font))
      Box(0, 0, iWidth, iHeight, RGB(0, 0, 0))
      For I = Len(Text) To 0 Step -1
         ColorI = 255 - ((I + count) * 255) / Len(Text)%256
         Color = RGB(ColorI, 255 - ColorI, ColorI)
         DrawText(10, (iHeight / 2) - 20, Left(Text, I), Color, RGB(0, 0, 0))
      Next: count+1
   StopDrawing(): SetGadgetState(#GadgetImage,ImageId(#Image))


   ; Silly Scrolling Marquee thingy
  EventID = WaitWindowEvent(1)
  If ElapsedMilliseconds() > prevtickcount+10
    prevtickcount = ElapsedMilliseconds()
    y.i = (GetTickCount_() / 30) % (iHeight+40) ; 30 is the inverse speed of the scrolling effect
    ResizeGadget(#GadgetImage, #PB_Ignore, -iHeight/2-20+y, #PB_Ignore, #PB_Ignore)
  EndIf

Until EventID = #PB_Event_CloseWindow
(untested, but I think it should work :P )
Thanks for letting me in! :o

Re: PureBasic Community: Evolving Code -- [Atleast read it :)]

Posted: Wed Jan 27, 2010 2:43 pm
by c4s
I removed the ResizeGadget() thing because it's better to directly draw the text on the wanted y-pos.
Edit: Added plasma too - I hope you don't mind ;)

Code: Select all

 ;*********************************************
; PureBasic Community: Evolving code
;    January 26, 2010 -> January 27, 2010
;    Nituvious - initial seed
;    Trond - changed textgadget to imagegadget
;    JackWebb - cleanup
;    Nituvious - scrolls the text
;    c4s - cleanup
;    Trond - bug fix
;    citystate - color cycling
;    happer66 - syntax fix
;    c4s - removed ResizeGadget(), added plasma background + shake effect
;*********************************************

EnableExplicit

Enumeration
  #Font
  #Image
  #WindowMain
  #GadgetImage
EndEnumeration

Define iWidth.l = 300
Define iHeight.l = 200 ; Must be smaller than iWidth + 3 because of CosTable()
Define WaveMax.l = iWidth / 2 ; Maximum wave count for plasma, must be smaller than iWidth
Define Text.s = "The PureBasic Community rocks!"
Define TextX, TextY
Define I, ColorI, Color, count
Define X, Y, Wave, Pos1, Pos2
Define EventID

Dim CosTable(iWidth * 2): Dim ColorTable(255)


Procedure.f GSin(Angle.f): ProcedureReturn Sin(Angle * (2 * #PI / 360)): EndProcedure



For I = 0 To iWidth * 2: CosTable(I) = GSin(360 * I / WaveMax) * 32 + 32: Next ; Precalculate cosinus
For I = 0 To 255: ColorTable(I) = I << 16: Next ; Precalculate colors -> blueish

LoadFont(#Font, "Verdana", 11, #PB_Font_Bold | #PB_Font_Italic)

CreateImage(#Image, iWidth, iHeight)


OpenWindow(#WindowMain, #PB_Ignore, #PB_Ignore, iWidth, iHeight, "PB Community: Evolving code", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

ImageGadget(#GadgetImage, 0, 0, 0, 0, ImageID(#Image))


Repeat
  StartDrawing(ImageOutput(#Image))
    ; Plasma background - ripped most from example ;)
    If Wave > WaveMax: Wave = 0: Else: Wave + 2: EndIf
    For Y = 0 To iHeight - 1
      Pos1 = CosTable(Y + Wave)
      For X = 0 To iWidth - 1
        Pos2 = (CosTable(X + Wave) + CosTable(X + Y) + Pos1)
        Plot(X, Y, ColorTable(Pos2))
      Next
    Next

    ; Silly shake effect + scrolling marquee thingy
    TextX = 12 + Random(3)
    TextY = (GetTickCount_() / 30) % (iHeight + 40) - 20 ; 30 is the inverse speed of the scrolling effect

    ; Cycle the colors
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawingFont(FontID(#Font))
    For I = Len(Text) To 0 Step -1
       ColorI = 255 - ((I + count) * 255) / Len(Text) % 256
       Color = RGB(ColorI, 255 - ColorI, ColorI)
       DrawText(TextX, TextY, Left(Text, I), Color, RGB(0, 0, 0))
    Next: count + 1
  StopDrawing()
  SetGadgetState(#GadgetImage,ImageID(#Image))

  EventID = WaitWindowEvent(10)
Until EventID = #PB_Event_CloseWindow

Re: PureBasic Community: Evolving Code -- [Atleast read it :)]

Posted: Thu Jan 28, 2010 12:40 am
by citystate
tidied up so the code meets with a couple of the evolution rules

Code: Select all

;*********************************************
; PureBasic Community: Evolving code
;    January 26, 2010 -> January 27, 2010
;    Nituvious - initial seed
;    Trond - changed textgadget to imagegadget
;    JackWebb - cleanup
;    Nituvious - scrolls the text
;    c4s - cleanup
;    Trond - bug fix
;    citystate - color cycling
;    happer66 - syntax fix
;    c4s - removed ResizeGadget(), added plasma background + shake effect
;    citystate - cleanup
;*********************************************

EnableExplicit

Enumeration
  #Font
  #Image
  #WindowMain
  #GadgetImage
EndEnumeration

Define iWidth.l = 300
Define iHeight.l = 200 ; Must be smaller than iWidth + 3 because of CosTable()
Define WaveMax.l = iWidth / 2 ; Maximum wave count for plasma, must be smaller than iWidth
Define Text.s = "The PureBasic Community rocks!"
Define TextX, TextY
Define I, ColorI, Color, count
Define X, Y, Wave, Pos1, Pos2
Define EventID

Dim CosTable(iWidth * 2): Dim ColorTable(255)

Procedure.f GSin(Angle.f): ProcedureReturn Sin(Angle * (2 * #PI / 360))
EndProcedure

For I = 0 To iWidth * 2: CosTable(I) = GSin(360 * I / WaveMax) * 32 + 32
Next ; Precalculate cosinus
For I = 0 To 255: ColorTable(I) = I << 16
Next ; Precalculate colors -> blueish

LoadFont(#Font, "Verdana", 11, #PB_Font_Bold | #PB_Font_Italic)

CreateImage(#Image, iWidth, iHeight)

OpenWindow(#WindowMain, #PB_Ignore, #PB_Ignore, iWidth, iHeight, "PB Community: Evolving code", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

ImageGadget(#GadgetImage, 0, 0, 0, 0, ImageID(#Image))

Repeat
  StartDrawing(ImageOutput(#Image))
    ; Plasma background - ripped most from example ;)
    Wave = (Wave+2)%(WaveMax+4)
    For Y = 0 To iHeight - 1
      Pos1 = CosTable(Y + Wave)
      For X = 0 To iWidth - 1
        Pos2 = (CosTable(X + Wave) + CosTable(X + Y) + Pos1)
        Plot(X, Y, ColorTable(Pos2))
      Next
    Next

    ; Silly shake effect + scrolling marquee thingy
    TextX = 12 + Random(3)
    TextY = (GetTickCount_() / 30) % (iHeight + 40) - 20 ; 30 is the inverse speed of the scrolling effect

    ; Cycle the colors
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawingFont(FontID(#Font))
    For I = Len(Text) To 0 Step -1
       ColorI = 255 - (((I + count) * 255) / Len(Text)) % 256
       Color = RGB(ColorI, 255 - ColorI, ColorI)
       DrawText(TextX, TextY, Left(Text, I), Color, RGB(0, 0, 0))
    Next: count + 1
  StopDrawing()
  SetGadgetState(#GadgetImage,ImageID(#Image))

  EventID = WaitWindowEvent(10)
Until EventID = #PB_Event_CloseWindow

Re: PureBasic Community: Evolving Code -- [Atleast read it :)]

Posted: Thu Jan 28, 2010 12:24 pm
by JackWebb
How awful! :oops:

I hold myself responsible for the next cleanup on my turn. Nituvious you set the bar pretty high with a 10 line limit. Using : is just cheating IMO and makes the code ugly. Plus It's difficult to keep track of line counts. Especially as the code grows, and it's not that big now. Might I suggest a feature limit in it's place, one new feature per turn perhaps?

Code: Select all

;*********************************************
; PureBasic Community: Evolving code
; January 26, 2010
;    Nituvious - initial seed
;    Trond     - changed textgadget to imagegadget
;    JackWebb  - cleanup
;    Nituvious - scrolls the text
;    c4s       - cleanup
;    Trond     - bug fix
;    citystate - color cycling
;
; January 27, 2010
;    happer66  - syntax fix
;    c4s       - removed ResizeGadget(), added plasma background + shake effect
;    citystate - cleanup
;
; January 28, 2010
;    JackWebb  - scrolling credits, reversed scrolling direction
;*********************************************

EnableExplicit

Enumeration
  #Font
  #Image
  #WindowMain
  #GadgetImage
EndEnumeration

Define iWidth.l = 300, iHeight.l = 200 ; Must be smaller than iWidth + 3 because of CosTable()
Define WaveMax.l = iWidth / 2 ; Maximum wave count for plasma, must be smaller than iWidth
Define Text.s, ShakeOn
Define TextX, TextY
Define I, ColorI, Color, count
Define X, Y, Wave, Pos1, Pos2

Dim CosTable(iWidth * 2): Dim ColorTable(255)

Procedure.f GSin(Angle.f): ProcedureReturn Sin(Angle * (2 * #PI / 360))
EndProcedure

For I = 0 To iWidth * 2: CosTable(I) = GSin(360 * I / WaveMax) * 32 + 32
Next ; Precalculate cosinus
For I = 0 To 255: ColorTable(I) = I << 16
Next ; Precalculate colors -> blueish

LoadFont(#Font, "Verdana", 11, #PB_Font_Bold | #PB_Font_Italic)

CreateImage(#Image, iWidth, iHeight)

OpenWindow(#WindowMain, #PB_Ignore, #PB_Ignore, iWidth, iHeight, "PB Community: Evolving code", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

ImageGadget(#GadgetImage, 0, 0, 0, 0, ImageID(#Image))

Repeat
  StartDrawing(ImageOutput(#Image))
  ; Plasma background - ripped most from example ;)
  Wave = (Wave + 2) % (WaveMax + 4)
  For Y = 0 To iHeight - 1
    Pos1 = CosTable(Y + Wave)
    For X = 0 To iWidth - 1
      Pos2 = (CosTable(X + Wave) + CosTable(X + Y) + Pos1)
      Plot(X, Y, ColorTable(Pos2))
    Next
  Next

  TextX = 12
  If TextY = 0 ; Silly scrolling credits
    Read.s Text: ShakeOn = #False
    If FindString(Text, "ROCKS", 1): ShakeOn = #True
      Restore Credits: EndIf
  EndIf

  ; Silly shake effect + scrolling marquee thingy
  If ShakeOn: TextX + Random(3)
  EndIf 
  If TextY = 0:  textY = iHeight
  EndIf
  TextY - 1

  ; Cycle the colors
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawingFont(FontID(#Font))
  For I = Len(Text) To 0 Step -1
    ColorI = 255 - (((I + count) * 255) / Len(Text)) % 256
    Color = RGB(ColorI, 255 - ColorI, ColorI)
    DrawText(TextX, TextY, Left(Text, I), Color, RGB(0, 0, 0))
  Next: count + 1
  StopDrawing()
  SetGadgetState(#GadgetImage,ImageID(#Image))
Until WaitWindowEvent(10) = #PB_Event_CloseWindow

DataSection: Credits:
  Data.s "The PureBasic Community rocks!": Data.s "                     PureBasic"
  Data.s "                      ROCKS!!!": EndDataSection

Re: PureBasic Community: Evolving Code -- [Atleast read it :)]

Posted: Thu Jan 28, 2010 12:37 pm
by blueznl
Follow the rules...

(or simply ignore them when it's worth it :-))

Re: PureBasic Community: Evolving Code -- [Atleast read it :)]

Posted: Thu Jan 28, 2010 1:00 pm
by Nituvious
JackWebb wrote:How awful! :oops:

I hold myself responsible for the next cleanup on my turn. Nituvious you set the bar pretty high with a 10 line limit. Using : is just cheating IMO and makes the code ugly. Plus It's difficult to keep track of line counts. Especially as the code grows, and it's not that big now. Might I suggest a feature limit in it's place, one new feature per turn perhaps?
The idea was to work together to create something great, that's why there was a 10 line limit :mrgreen:. So we work together as one and such :P.
Perhaps we can make some sort of rule adjustment per say, 10 contributions of code? Like, to amend the lines to add +2 extra lines per 10 code contributions or something?

It is starting to look pretty good so far! I wonder what the code will look like around page 5!

Re: PureBasic Community: Evolving Code -- [Atleast read it :)]

Posted: Thu Jan 28, 2010 1:13 pm
by JackWebb
blueznl wrote:Follow the rules...

(or simply ignore them when it's worth it :-))
Yes sir Mr. Blue!

But I only had you in mind when I wrote that. Besides.. How will you ever finish the official survival guide if you become cross eyed from reading my ugly code? :lol:

Re: PureBasic Community: Evolving Code -- [Atleast read it :)]

Posted: Thu Jan 28, 2010 1:18 pm
by JackWebb
Nituvious wrote:The idea was to work together to create something great, that's why there was a 10 line limit :mrgreen:. So we work together as one and such :P.
Perhaps we can make some sort of rule adjustment per say, 10 contributions of code? Like, to amend the lines to add +2 extra lines per 10 code contributions or something?

It is starting to look pretty good so far! I wonder what the code will look like around page 5!
Hmm?

I hope it looks like it can do my taxes or something.. :lol: Good ideas!

Jack

Re: PureBasic Community: Evolving Code -- [Atleast read it :)]

Posted: Thu Jan 28, 2010 3:00 pm
by c4s
Smaller things...
But what I really don't like is the following:

Code: Select all

If A = 1
  B = 2
EndIf

If A = 1: B = 2
EndIf

If A = 1: B = 2: EndIf
I think the last row of code looks best.

Code: Select all

;*********************************************
; PureBasic Community: Evolving code
; January 26, 2010
;    Nituvious - initial seed
;    Trond     - changed textgadget to imagegadget
;    JackWebb  - cleanup
;    Nituvious - scrolls the text
;    c4s       - cleanup
;    Trond     - bug fix
;    citystate - color cycling
;
; January 27, 2010
;    happer66  - syntax fix
;    c4s       - removed ResizeGadget(), added plasma background + shake effect
;    citystate - cleanup
;
; January 28, 2010
;    JackWebb  - scrolling credits, reversed scrolling direction
;    c4s - reduced ugly code a bit, small improvements
;*********************************************

EnableExplicit

Enumeration
  #Font
  #Image
  #WindowMain
  #GadgetImage
EndEnumeration

Define iWidth.l = 300, iHeight.l = 200 ; Must be smaller than iWidth + 3 because of CosTable()
Define WaveMax.l = iWidth / 2 ; Maximum wave count for plasma, must be smaller than iWidth
Define Text.s, ShakeOn.l, TextX, TextY = -20
Define I, ColorI, Color, count
Define X, Y, Wave, Pos1, Pos2

Dim CosTable(iWidth * 2): Dim ColorTable(255)

Procedure.f GSin(Angle.f)
  ProcedureReturn Sin(Angle * (2 * #PI / 360))
EndProcedure

For I = 0 To iWidth * 2
  CosTable(I) = GSin(360 * I / WaveMax) * 32 + 32 ; Precalculate cosinus
Next
For I = 0 To 255
  ColorTable(I) = I << 16 ; Precalculate colors -> blueish
Next

LoadFont(#Font, "Verdana", 11, #PB_Font_Bold | #PB_Font_Italic)

CreateImage(#Image, iWidth, iHeight)

OpenWindow(#WindowMain, #PB_Ignore, #PB_Ignore, iWidth, iHeight, "PB Community: Evolving code", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

ImageGadget(#GadgetImage, 0, 0, 0, 0, ImageID(#Image))

Repeat
  StartDrawing(ImageOutput(#Image))
    ; Plasma background - ripped most from example ;)
    Wave = (Wave + 2) % (WaveMax + 4)
    For Y = 0 To iHeight - 1
      Pos1 = CosTable(Y + Wave)
      For X = 0 To iWidth - 1
        Pos2 = (CosTable(X + Wave) + CosTable(X + Y) + Pos1)
        Plot(X, Y, ColorTable(Pos2))
      Next
    Next

    ; Read strings, settings
    If TextY = -20
      If ShakeOn = 1 ; Better indicator?
        Restore Credits
      EndIf
      Read.s Text: Read.l ShakeOn
    EndIf

    ; Silly shake effect + scrolling marquee thingy
    TextX = (iWidth - TextWidth(Text)) / 2 ; Not really centered?
    If ShakeOn: TextX + Random(3)
    EndIf
    If TextY = -20
      TextY = iHeight
    Else
      TextY - 1
    EndIf

    ; Cycle the colors
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawingFont(FontID(#Font))
    For I = Len(Text) To 0 Step -1
      ColorI = 255 - (((I + count) * 255) / Len(Text)) % 256 ; Gets too fast on short strings
      Color = RGB(ColorI, 255 - ColorI, ColorI)
      DrawText(TextX, TextY, Left(Text, I), Color, RGB(0, 0, 0))
    Next: count + 1
  StopDrawing()
  SetGadgetState(#GadgetImage,ImageID(#Image))
Until WaitWindowEvent(10) = #PB_Event_CloseWindow

DataSection
Credits:
  Data.s "The PureBasic Community rocks!": Data.l 0
  Data.s "PureBasic": Data.l 0
  Data.s "ROCKS!!!": Data.l 1
EndDataSection

Re: PureBasic Community: Evolving Code -- [Atleast read it :)]

Posted: Thu Jan 28, 2010 3:41 pm
by +18
can i have a chanse for a unicode version from this cool code?

Re: PureBasic Community: Evolving Code -- [Atleast read it :)]

Posted: Thu Jan 28, 2010 5:54 pm
by Nituvious
I made another attempt, but it's pretty ugly :oops: I ran out of lines, maybe someone can build upon it? :)

Code: Select all

;*********************************************
; PureBasic Community: Evolving code
; January 26, 2010
;    Nituvious - initial seed
;    Trond     - changed textgadget to imagegadget
;    JackWebb  - cleanup
;    Nituvious - scrolls the text
;    c4s       - cleanup
;    Trond     - bug fix
;    citystate - color cycling
;
; January 27, 2010
;    happer66  - syntax fix
;    c4s       - removed ResizeGadget(), added plasma background + shake effect
;    citystate - cleanup
;
; January 28, 2010
;    JackWebb  - scrolling credits, reversed scrolling direction
;    c4s       - reduced ugly code a bit, small improvements\
;    Nituvious - Made minimal changes to the scroll code, aligned the text up a bit.
;                Modified the Plasma effect for psychedelic colors(it's ugly, ran out of lines!)
;*********************************************

EnableExplicit

Enumeration
  #Font
  #Image
  #WindowMain
  #GadgetImage
EndEnumeration

Define iWidth.l = 300, iHeight.l = 200 ; Must be smaller than iWidth + 3 because of CosTable()
Define WaveMax.l = iWidth / 2 ; Maximum wave count for plasma, must be smaller than iWidth
Define Text.s, ShakeOn.l, TextX, TextY = -20
Define I, ColorI, Color, count
Define X, Y, Wave, Pos1, Pos2
Define ShiftBits.l = 16

Dim CosTable(iWidth * 2): Dim ColorTable(255)

Procedure.f GSin(Angle.f)
  ProcedureReturn Sin(Angle * (2 * #PI / 360))
EndProcedure


LoadFont(#Font, "Verdana", 11, #PB_Font_Bold | #PB_Font_Italic)

CreateImage(#Image, iWidth, iHeight)

OpenWindow(#WindowMain, #PB_Ignore, #PB_Ignore, iWidth, iHeight, "PB Community: Evolving code", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

ImageGadget(#GadgetImage, 0, 0, 0, 0, ImageID(#Image))
For I = 0 To iWidth * 2
  CosTable(I) = GSin(360 * I / WaveMax) * 32 + 32 ; Precalculate cosinus
Next
Repeat
    For I = 0 To 255
      ColorTable(I) = I << ShiftBits.l ; Precalculate colors -> blueish
    Next

  StartDrawing(ImageOutput(#Image))
    ; Plasma background - ripped most from example ;)
    Wave = (Wave + 2) % (WaveMax + 4)
    For Y = 0 To iHeight - 1
      Pos1 = CosTable(Y + Wave)
      For X = 0 To iWidth - 1
        Pos2 = (CosTable(X + Wave) + CosTable(X + Y) + Pos1)
        Plot(X, Y, ColorTable(Pos2))
      Next
    Next
    
    If ShiftBits >= 0 : ShiftBits+1
    ElseIf ShiftBits <= 24 : ShiftBits-1
    EndIf
    Delay(15)
    
    ; Read strings, settings
    If TextY = -20
      If ShakeOn = 1 ; Better indicator?
        Restore Credits
      EndIf
      Read.s Text: Read.l ShakeOn      
    EndIf

    ; Silly shake effect + scrolling marquee thingy
    TextX = (iWidth - TextWidth(Text)) / 6 ; Not really centered?
    If ShakeOn: TextX + Random(2)
    EndIf
    If TextY = -20
      TextY = iHeight
    Else
      TextY - 1
    EndIf

    ; Cycle the colors
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawingFont(FontID(#Font))
    For I = Len(Text) To 0 Step -1
      ColorI = 255 - (((I + count) * 255) / Len(Text)) % 256 ; Gets too fast on short strings
      Color = RGB(ColorI, 255 - ColorI, ColorI)
      DrawText(TextX, TextY, Left(Text, I), Color, RGB(0, 0, 0))
    Next: count + 1
  StopDrawing()
  SetGadgetState(#GadgetImage,ImageID(#Image))
Until WaitWindowEvent(10) = #PB_Event_CloseWindow

DataSection
Credits:
  Data.s "The PureBasic Community rocks!": Data.l 0
  Data.s "               PureBasic": Data.l 0
  Data.s "               ROCKS!!!": Data.l 1
EndDataSection

Re: PureBasic Community: Evolving Code -- [Atleast read it :)]

Posted: Thu Jan 28, 2010 7:33 pm
by c4s
Again some fixes...hm but looks like nearly nobody else is interested in this. :(

Code: Select all

;*********************************************
; PureBasic Community: Evolving code
; January 26, 2010
;    Nituvious - initial seed
;    Trond     - changed textgadget to imagegadget
;    JackWebb  - cleanup
;    Nituvious - scrolls the text
;    c4s       - cleanup
;    Trond     - bug fix
;    citystate - color cycling
;
; January 27, 2010
;    happer66  - syntax fix
;    c4s       - removed ResizeGadget(), added plasma background + shake effect
;    citystate - cleanup
;
; January 28, 2010
;    JackWebb  - scrolling credits, reversed scrolling direction
;    c4s       - reduced ugly code a bit, small improvements
;    Nituvious - Made minimal changes to the scroll code, aligned the text up a bit.
;                Modified the Plasma effect for psychedelic colors
;    c4s       - fixed colors, better restore indicator, fixed text width
;*********************************************

EnableExplicit

Enumeration
  #Font
  #Image
  #WindowMain
  #GadgetImage
EndEnumeration

Define iWidth.l = 300, iHeight.l = 200 ; Must be smaller than iWidth + 3 because of CosTable()
Define WaveMax.l = iWidth / 2 ; Maximum wave count for plasma, must be smaller than iWidth
Define Text.s, ShakeOn.l, TextX, TextY = -20
Define TextCountMax.l, TextCount
Define I, ColorI, Color, count
Define X, Y, Wave, Pos1, Pos2
Define ShiftBits.l, ShiftBitsI

Dim CosTable(iWidth * 2): Dim ColorTable(255)

Procedure.f GSin(Angle.f)
  ProcedureReturn Sin(Angle * (2 * #PI / 360))
EndProcedure


For I = 0 To iWidth * 2
  CosTable(I) = GSin(360 * I / WaveMax) * 32 + 32 ; Precalculate cosinus
Next

Read.l TextCountMax

LoadFont(#Font, "Verdana", 11, #PB_Font_Bold | #PB_Font_Italic)

CreateImage(#Image, iWidth, iHeight)


OpenWindow(#WindowMain, #PB_Ignore, #PB_Ignore, iWidth, iHeight, "PB Community: Evolving code", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

ImageGadget(#GadgetImage, 0, 0, 0, 0, ImageID(#Image))

Repeat
  ; Creating plasma colors
  If ShiftBits = 24
    ShiftBitsI = -1
  ElseIf ShiftBits = 0
    ShiftBitsI = 1
  EndIf
  ShiftBits + ShiftBitsI
  For I = 0 To 255
    ColorTable(I) = I << (ShiftBits & 24)
  Next

  StartDrawing(ImageOutput(#Image))
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawingFont(FontID(#Font))

    ; Plasma background - ripped most from example ;)
    Wave = (Wave + 2) % (WaveMax + 4)
    For Y = 0 To iHeight - 1
      Pos1 = CosTable(Y + Wave)
      For X = 0 To iWidth - 1
        Pos2 = (CosTable(X + Wave) + CosTable(X + Y) + Pos1)
        Plot(X, Y, ColorTable(Pos2))
      Next
    Next

    ; Read strings, settings
    If TextY = -20
      If TextCount = TextCountMax
        TextCount = 1
        Restore Credits
      Else
        TextCount + 1
      EndIf
      Read.s Text: Read.l ShakeOn
    EndIf

    ; Silly shake effect + scrolling marquee thingy
    TextX = (iWidth - TextWidth(Text)) / 2
    If ShakeOn
      TextX + (Random(2) - 1)
    EndIf
    If TextY = -20
      TextY = iHeight
    Else
      TextY - 1
    EndIf

    ; Cycle the colors
    For I = Len(Text) To 0 Step -1
      ColorI = 255 - (((I + count) * 255) / Len(Text)) % 256 ; Gets too fast on short strings
      Color = RGB(ColorI, 255 - ColorI, ColorI)
      DrawText(TextX, TextY, Left(Text, I), Color, RGB(0, 0, 0))
    Next: count + 1
  StopDrawing()
  SetGadgetState(#GadgetImage,ImageID(#Image))

  Delay(10)
Until WaitWindowEvent(10) = #PB_Event_CloseWindow


DataSection
  Data.l 3 ; Count of credit lines
Credits:
  Data.s "The PureBasic Community rocks!": Data.l 0
  Data.s "PureBasic"                     : Data.l 0
  Data.s "ROCKS!!!"                      : Data.l 1
EndDataSection

Re: PureBasic Community: Evolving Code -- [Atleast read it :)]

Posted: Thu Jan 28, 2010 8:04 pm
by Nituvious
I'm sure there will be more people to discover this topic eventually. I was going to post it in Coding Questions, but it didn't belong there.

Re: PureBasic Community: Evolving Code -- [Atleast read it :)]

Posted: Thu Jan 28, 2010 10:11 pm
by LuCiFeR[SD]
Sorry, I have nothing as of yet to contribute (due to lack of time... maybe I'll think of something between now and the weekend :)), apart from a minor bug fix LOL... but interesting stuff guys, don't be disheartened... keep it up! :P

Code: Select all

DataSection
  Data.l 2 ; Count of credit lines  <<< Changed from 3 as it was causing a read error :P
Credits:
  Data.s "The PureBasic Community rocks!": Data.l 0
  Data.s "PureBasic"                     : Data.l 0
  Data.s "ROCKS!!!"                      : Data.l 1
EndDataSection

Re: PureBasic Community: Evolving Code -- [Atleast read it :)]

Posted: Thu Jan 28, 2010 11:28 pm
by JackWebb
My cleanup as promised.

I went slightly over my lines with adding credits. Perhaps that part (adding your name) should not count against the 10 line limit. Sorry If I missed anyone, please add your name.

Jack

Code: Select all

;*********************************************
; PureBasic Community: Evolving code
; January 26, 2010
;    Nituvious - initial seed
;    Trond     - changed textgadget to imagegadget
;    JackWebb  - cleanup
;    Nituvious - scrolls the text
;    c4s       - cleanup
;    Trond     - bug fix
;    citystate - color cycling
;
; January 27, 2010
;    happer66  - syntax fix
;    c4s       - removed ResizeGadget(), added plasma background + shake effect
;    citystate - cleanup
;
; January 28, 2010
;    JackWebb  - scrolling credits, reversed scrolling direction
;    c4s       - reduced ugly code a bit, small improvements\
;    Nituvious - Made minimal changes to the scroll code, aligned the text up a bit.
;                Modified the Plasma effect for psychedelic colors(it's ugly, ran out of lines!)
;    c4s       - fixed colors, better restore indicator, fixed text width
;    JackWebb  - Cleanup, fixed bug in restore indicator, added credits
;*********************************************

EnableExplicit

Enumeration
  #Font
  #Image
  #WindowMain
  #GadgetImage
EndEnumeration

Define iWidth.l = 300, iHeight.l = 200 ; Must be smaller than iWidth + 3 because of CosTable()
Define WaveMax.l = iWidth / 2          ; Maximum wave count for plasma, must be smaller than iWidth
Define Text.s, ShakeOn.l, TextX, TextY = -20
Define TextCountMax, TextCount
Define I, ColorI, Color, count
Define X, Y, Wave, Pos1, Pos2
Define ShiftBits.l, ShiftBitsI

Declare.f GSin(Angle.f)

Dim CosTable(iWidth * 2)
Dim ColorTable(255)

For I = 0 To iWidth * 2
  CosTable(I) = GSin(360 * I / WaveMax) * 32 + 32 ; Precalculate cosinus
Next

Read TextCountMax

LoadFont(#Font, "Verdana", 11, #PB_Font_Bold | #PB_Font_Italic)
CreateImage(#Image, iWidth, iHeight)
OpenWindow(#WindowMain, #PB_Ignore, #PB_Ignore, iWidth, iHeight, "PB Community: Evolving code", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ImageGadget(#GadgetImage, 0, 0, 0, 0, ImageID(#Image))

Repeat
  ; Creating plasma colors
  If ShiftBits = 24
    ShiftBitsI = -1
  ElseIf ShiftBits = 0
    ShiftBitsI = 1
  EndIf
  ShiftBits + ShiftBitsI

  For I = 0 To 255
    ColorTable(I) = I << (ShiftBits & 24)
  Next

  StartDrawing(ImageOutput(#Image))

  DrawingMode(#PB_2DDrawing_Transparent)
  DrawingFont(FontID(#Font))

  ; Plasma background - ripped most from example ;)
  Wave = (Wave + 2) % (WaveMax + 4)
  For Y = 0 To iHeight - 1
    Pos1 = CosTable(Y + Wave)
    For X = 0 To iWidth - 1
      Pos2 = (CosTable(X + Wave) + CosTable(X + Y) + Pos1)
      Plot(X, Y, ColorTable(Pos2))
    Next
  Next

  ; Read strings, settings
  If TextY = -20
    Read.s Text
    Read ShakeOn
    TextCount + 1
    If TextCount = TextCountMax
      TextCount = 0
      Restore Credits
    EndIf
  EndIf

  ; Silly shake effect
  TextX = (iWidth - TextWidth(Text)) / 2
  If ShakeOn
    TextX + (Random(2) - 1)
  EndIf

  ; Silly scrolling marquee thingy
  If TextY = -20
    TextY = iHeight
  EndIf
  TextY - 1

  ; Cycle the colors
  For I = Len(Text) To 0 Step - 1
    ColorI = 255 - (((I + count) * 255) / Len(Text)) % 256 ; Gets too fast on short strings
    Color = RGB(ColorI, 255 - ColorI, ColorI)
    DrawText(TextX, TextY, Left(Text, I), Color, RGB(0, 0, 0))
  Next
  count + 1

  StopDrawing()
  SetGadgetState(#GadgetImage,ImageID(#Image))

  Delay(10)
Until WaitWindowEvent(10) = #PB_Event_CloseWindow

DataSection
  Data.i 12; Count of credit lines

Credits:
  Data.s "The PureBasic Community rocks!": Data.i 0
  Data.s "PB Code Evolution Project"     : Data.i 0
  Data.s "Project Leader - Nituvious"    : Data.i 0
  Data.s "Code Contributors..."          : Data.i 0
  Data.s "Nituvious"                     : Data.i 0
  Data.s "Trond"                         : Data.i 0
  Data.s "JackWebb"                      : Data.i 0
  Data.s "c4s"                           : Data.i 0
  Data.s "CityState"                     : Data.i 0
  Data.s "harper66"                      : Data.i 0
  Data.s "Tanks Guys!"                   : Data.i 0
  Data.s "PureBasic  ROCKS!!!"           : Data.i 1
EndDataSection

Procedure.f GSin(Angle.f)
  ProcedureReturn Sin(Angle * (2 * #PI / 360))
EndProcedure
All times are UTC+01:00
Page 2 of 3

Powered by phpBB® Forum Software © phpBB Limited