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

Share your advanced PureBasic knowledge/code with the community.
Post Reply
User avatar
blueznl
PureBasic Expert
PureBasic Expert
Posts: 6166
Joined: Sat May 17, 2003 11:31 am
Contact:
Contact blueznl

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

Post by blueznl »

JackWebb wrote:
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:
Honestly, officer, I did not read that code! I was merely, euh, glancing at it, serious!
( PB6.00 LTS Win11 x64 Asrock AB350 Pro4 Ryzen 5 3600 32GB GTX1060 6GB)
( The path to enlightenment and the PureBasic Survival Guide right here... )
Top
c4s
Addict
Addict
Posts: 1981
Joined: Thu Nov 01, 2007 5:37 pm
Location: Germany

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

Post by c4s »

I introduced a "third line" in the datasection...in my opinion it should be allowed there ;)

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
;
; January 29, 2010
;    c4s       - added new setting for scrolling: speed
;*********************************************

EnableExplicit

Enumeration
  #Font
  #Image
  #WindowMain
  #GadgetImage
EndEnumeration

Define iWidth = 300, iHeight = 200  ; Must be smaller than iWidth + 3 because of CosTable()
Define WaveMax = iWidth / 2         ; Maximum wave count for plasma, must be smaller than iWidth
Define TextX, TextY = -20
Define Text.s, TextShake, TextSpeed
Define TextCountMax, TextCount
Define I, ColorI, Color, count
Define X, Y, Wave, Pos1, Pos2
Define ShiftBits, 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
  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 string, settings, check for reset
  If TextY <= -20
    Read.s Text
    Read TextShake
    Read TextSpeed
    TextCount + 1
    If TextCount = TextCountMax
      TextCount = 0
      Restore Credits
    EndIf
  EndIf

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

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

  ; 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:
  ;      Text                              Shake?    Speed
  Data.s "The PureBasic Community rocks!": Data.i 0: Data.i 1
  Data.s "PB Code Evolution Project"     : Data.i 0: Data.i 1
  Data.s "Project Leader - Nituvious"    : Data.i 0: Data.i 2
  Data.s "Code Contributors..."          : Data.i 0: Data.i 2
  Data.s "Nituvious"                     : Data.i 0: Data.i 3
  Data.s "Trond"                         : Data.i 0: Data.i 3
  Data.s "JackWebb"                      : Data.i 0: Data.i 3
  Data.s "c4s"                           : Data.i 0: Data.i 3
  Data.s "CityState"                     : Data.i 0: Data.i 3
  Data.s "harper66"                      : Data.i 0: Data.i 3
  Data.s "Thanks Guys!"                  : Data.i 0: Data.i 2
  Data.s "PureBasic  ROCKS!!!"           : Data.i 1: Data.i 4
EndDataSection

Procedure.f GSin(Angle.f)
  ProcedureReturn Sin(Angle * (2 * #PI / 360))
EndProcedure
If any of you native English speakers have any suggestions for the above text, please let me know (via PM). Thanks!
Top
citystate
Enthusiast
Enthusiast
Posts: 638
Joined: Sun Feb 12, 2006 10:06 pm

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

Post by citystate »

Tweaked your plasma color code a little, Nituvious, still not 100% happy with it, though - anyone else want to improve on 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!)
;    c4s       - fixed colors, better restore indicator, fixed text width
;    JackWebb  - Cleanup, fixed bug in restore indicator, added credits
;
; January 29, 2010
;    c4s       - added new setting for scrolling: speed
;
; January 31, 2010
;    CityState - regulated color cycling speed and smoothed the Plasma colors a little
;*********************************************

EnableExplicit

Enumeration
  #Font
  #Image
  #WindowMain
  #GadgetImage
EndEnumeration

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

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 = 20
    ShiftBitsI = -1
  ElseIf ShiftBits < 5
    ShiftBitsI = 1
  EndIf
  ShiftBits + ShiftBitsI
  If (ShiftBits & 24) <> (OldShiftBits & 24)
    For I = 0 To 255
      ColorTable(I) ! (I << (ShiftBits & 24))
    Next
  EndIf
  OldShiftBits = ShiftBits
  
  StartDrawing(ImageOutput(#Image))

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

  ; Plasma background
  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 string, settings, check for reset
  If TextY <= -20
    Read.s Text
    Read TextShake
    Read TextSpeed
    TextCount + 1
    If TextCount = TextCountMax
      TextCount = 0
      Restore Credits
    EndIf
  EndIf

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

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

  ; Cycle the colors
  For I = Len(Text) To 0 Step - 1
    ColorI = 255 - (((I + Int(count)) * 255) / Len(Text)) % 256 
    Color = RGB(ColorI, 255 - ColorI, ColorI)
    DrawText(TextX, TextY, Left(Text, I), Color, RGB(0, 0, 0))
  Next
  count + Len(text)/30

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

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

DataSection
  Data.i 12 ; Count of credit lines

Credits:
  ;      Text                              Shake?    Speed
  Data.s "The PureBasic Community rocks!": Data.i 0: Data.i 1
  Data.s "PB Code Evolution Project"     : Data.i 0: Data.i 1
  Data.s "Project Leader - Nituvious"    : Data.i 0: Data.i 2
  Data.s "Code Contributors..."          : Data.i 0: Data.i 2
  Data.s "Nituvious"                     : Data.i 0: Data.i 3
  Data.s "Trond"                         : Data.i 0: Data.i 3
  Data.s "JackWebb"                      : Data.i 0: Data.i 3
  Data.s "c4s"                           : Data.i 0: Data.i 3
  Data.s "CityState"                     : Data.i 0: Data.i 3
  Data.s "harper66"                      : Data.i 0: Data.i 3
  Data.s "Thanks Guys!"                  : Data.i 0: Data.i 2
  Data.s "PureBasic  ROCKS!!!"           : Data.i 1: Data.i 4
EndDataSection

Procedure.f GSin(Angle.f)
  ProcedureReturn Sin(Angle * (2 * #PI / 360))
EndProcedure
there is no sig, only zuul (and the following disclaimer)

WARNING: may be talking out of his hat
Top
Nituvious
Addict
Addict
Posts: 1027
Joined: Sat Jul 11, 2009 4:57 am
Location: United States

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

Post by Nituvious »

Added a new procedure but ran out of lines :[

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
;
; January 29, 2010
;    c4s       - added new setting for scrolling: speed
;
; January 31, 2010
;    CityState - regulated color cycling speed and smoothed the Plasma colors a little
;
; February 10, 2010
;    Nituvious - Started a "ship" thingy and ran out of lines, maybe someone can build upon it?
;
;*********************************************

EnableExplicit

Enumeration
  #Font
  #Image
  #WindowMain
  #GadgetImage
EndEnumeration

Define iWidth = 300, iHeight = 200  ; Must be smaller than iWidth + 3 because of CosTable()
Define WaveMax = iWidth / 2         ; Maximum wave count for plasma, must be smaller than iWidth
Define TextX, TextY = -20
Define Text.s, TextShake, TextSpeed
Define TextCountMax, TextCount
Define I, ColorI, Color, count.f
Define X, Y, Wave, Pos1, Pos2
Define ShiftBits, ShiftBitsI, OldShiftBits
Define ShipX.l,ShipY.l,ShipShape.l,ShipR.l,ShipG.l,ShipB.l
Global ForStuff.l
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))

Procedure MakeShip(ShipX,ShipY,ShipShape,ShipR,ShipG,ShipB)
  StartDrawing(ImageOutput(#Image))
  For ForStuff.l = 0 To 1
  Box(ShipX+4,ShipY+4,ShipShape+3,ShipShape+3,RGB(ShipR,ShipG,ShipB))
  Next
  StopDrawing()
EndProcedure

Repeat

  ; Creating plasma colors
  If ShiftBits = 20
    ShiftBitsI = -1
  ElseIf ShiftBits < 5
    ShiftBitsI = 1
  EndIf
  ShiftBits + ShiftBitsI
  If (ShiftBits & 24) <> (OldShiftBits & 24)
    For I = 0 To 255
      ColorTable(I) ! (I << (ShiftBits & 24))
    Next
  EndIf
  OldShiftBits = ShiftBits
 
  StartDrawing(ImageOutput(#Image))

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

  ; Plasma background
  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 string, settings, check for reset
  If TextY <= -20
    Read.s Text
    Read TextShake
    Read TextSpeed
    TextCount + 1
    If TextCount = TextCountMax
      TextCount = 0
      Restore Credits
    EndIf
  EndIf

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

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

  ; Cycle the colors
  For I = Len(Text) To 0 Step - 1
    ColorI = 255 - (((I + Int(count)) * 255) / Len(Text)) % 256
    Color = RGB(ColorI, 255 - ColorI, ColorI)
    DrawText(TextX, TextY, Left(Text, I), Color, RGB(0, 0, 0))
  Next
  count + Len(text)/30

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

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

DataSection
  Data.i 12 ; Count of credit lines

Credits:
  ;      Text                              Shake?    Speed
  Data.s "The PureBasic Community rocks!": Data.i 0: Data.i 1
  Data.s "PB Code Evolution Project"     : Data.i 0: Data.i 1
  Data.s "Project Leader - Nituvious"    : Data.i 0: Data.i 2
  Data.s "Code Contributors..."          : Data.i 0: Data.i 2
  Data.s "Nituvious"                     : Data.i 0: Data.i 3
  Data.s "Trond"                         : Data.i 0: Data.i 3
  Data.s "JackWebb"                      : Data.i 0: Data.i 3
  Data.s "c4s"                           : Data.i 0: Data.i 3
  Data.s "CityState"                     : Data.i 0: Data.i 3
  Data.s "harper66"                      : Data.i 0: Data.i 3
  Data.s "Thanks Guys!"                  : Data.i 0: Data.i 2
  Data.s "PureBasic  ROCKS!!!"           : Data.i 1: Data.i 4
EndDataSection

Procedure.f GSin(Angle.f)
  ProcedureReturn Sin(Angle * (2 * #PI / 360))
EndProcedure
▓▓▓▓▓▒▒▒▒▒░░░░░
Top
Nituvious
Addict
Addict
Posts: 1027
Joined: Sat Jul 11, 2009 4:57 am
Location: United States

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

Post by Nituvious »

I hate to see that interest has been lost in this :(
▓▓▓▓▓▒▒▒▒▒░░░░░
Top
citystate
Enthusiast
Enthusiast
Posts: 638
Joined: Sun Feb 12, 2006 10:06 pm

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

Post by citystate »

perhaps we call it a dead end and start a new seed?
there is no sig, only zuul (and the following disclaimer)

WARNING: may be talking out of his hat
Top
Post Reply

Return to “Tricks 'n' Tips”