Animated Rainbow Clock/Date

Share your advanced PureBasic knowledge/code with the community.
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Post by ts-soft »

DarkDragon wrote:Cool :-) .

If you want the others to let it start without inline-asm turned on:

Code: Select all

Procedure.f Atan2(a.f,b.f)
   !FLD dword [p.v_a]
   !FLD dword [p.v_b]
   !FPATAN
   ProcedureReturn
EndProcedure
This way it is direct asm.
or in this way:

Code: Select all

Procedure.f Atan2(a.f,b.f)
   EnableASM
   FLD a
   FLD b
   FPATAN
   DisableASM
   ProcedureReturn
EndProcedure
:wink:
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
yrreti
Enthusiast
Enthusiast
Posts: 546
Joined: Tue Oct 31, 2006 4:34 am

Post by yrreti »

I have been running your program just as an exe, but I did a quick search using "screensaver"
Check out these links, as they may help you get to the right person to talk to in regards to
creating a real screen saver. (scr type program)

FontSoup Screensaver
http://www.purebasic.fr/english/viewtop ... creensaver

Another screensaver (Psychophanta)
http://www.purebasic.fr/english/viewtop ... er&start=0

...and yet Another Screensaver (r_hyde)
http://www.purebasic.fr/english/viewtop ... er&start=0


Alternately, with the changes I've added, you really don't need to move the clock with the mouse as it
moves by itself. The problem though, is that unlike a true screen saver, you always have to start this program
manually each time you want to use it. But that's okay too, and has certain advantages over a normal scr screen saver.
citystate
Enthusiast
Enthusiast
Posts: 638
Joined: Sun Feb 12, 2006 10:06 pm

Post by citystate »

changing and existing pb source code into a windows screensaver isn't too difficult... IIRC, the only difference is the switches/arguments the screensaver manager sends to the exe, which must be renamed to a scr, but the principle is the same - try it out yourself, display the arguments received by the program in message boxes and then just create the logic to deal with the various switches (I think there are seperate switches for selecting it in the listbox, clicking the preview button, clicking the settings button and it running in general) of course the program needs to cater for exit via a keypress or mouse movement (or however you prefer, but remember it's not automatic)
there is no sig, only zuul (and the following disclaimer)

WARNING: may be talking out of his hat
ProphetOfDoom
User
User
Posts: 84
Joined: Mon Jun 30, 2008 4:36 pm
Location: UK

Post by ProphetOfDoom »

Okay I'll get onto it when I have time. Shame those examples don't have source. Why does everything have to become a trade secret when it exceeds 500 lines or so...?
yrreti
Enthusiast
Enthusiast
Posts: 546
Joined: Tue Oct 31, 2006 4:34 am

Post by yrreti »

:D:D An Animated Rainbow Clock/Date Screen Saver :D:D

Well I've figured it out some what. At least the following code does run like a screen saver. See Note at start of code for more info.
(compile program as Animated_Rainbow_Clock.exe and then rename to Animated_Rainbow_Clock.scr)

Code: Select all

;Animated Rainbow Clock/Date  Screen Saver
;Note:  see ;**************************************************************************************
;       lines below.
;       compile this as an exe and rename suffix to .scr
;       Place this program into the System32 dir of Windows.
;       Right click an open area on your screen and select Properties, and then Screen Saver.
;       Then select Animated_Rainbow_Clock from the list.  You will see it act a little borky 
;       and run right away until you move the mouse or press a key.  But that's because there are
;       no settings to it and I don't know how to add any.  But just select the Wait time and click
;       OK and your all set. Program will now run like an scr does at the end of the set wait time.
;       Pressing any key or moving the mouse will turn it off again until the next wait time is passed.


Structure MyPoint
    Symbol$
    Col.l
    Timer.l
    Speed.f
    Angle.f
    Displacement.f
    Timeout.l
    Moving.l
    cx.f
    cy.f
    xp.f
    yp.f
    xd.f
    yd.f
EndStructure

Structure Clock
    x.f
    y.f
    Radius.f
    Speed.f
    Timer.l
    Timeout.l
    LastEvent.l
    Font.l
    Symbol.MyPoint[39]
    Date$
    Hours.l
    Minutes.l
    Seconds.l
    DateLength.l
    HandBaseCol.l
EndStructure



Structure ColorType
    R.l
    G.l
    B.l
EndStructure


Declare UpdateClock(*Clock.Clock,NewX.f,NewY.f)
Declare DrawClock(*Clock.Clock)
Declare.l CreateClock(Radius.f,Speed.f,Font$,FontSize.l)

Declare.f SinDeg(f.f)
Declare.f CosDeg(f.f)
Declare.f ATan2(a.f,b.f)
Declare.f ATan2Deg(a.f,b.f)
Declare.f FMod(a.f,b.f)


; GLOBALS

Global Dim RAINBOW(6,2)

RAINBOW(0,0) = 255
RAINBOW(0,1) = 13
RAINBOW(0,2) = 13

RAINBOW(1,0) = 255
RAINBOW(1,1) = 113
RAINBOW(1,2) = 45

RAINBOW(2,0) = 255
RAINBOW(2,1) = 255
RAINBOW(2,2) = 9

RAINBOW(3,0) = 74
RAINBOW(3,1) = 255
RAINBOW(3,2) = 74

RAINBOW(4,0) = 9
RAINBOW(4,1) = 40
RAINBOW(4,2) = 255

RAINBOW(5,0) = 135
RAINBOW(5,1) = 32
RAINBOW(5,2) = 147

RAINBOW(6,0) = 255
RAINBOW(6,1) = 34
RAINBOW(6,2) = 255

Global Dim DAYS.s(6)

DAYS(0) = "Sunday"
DAYS(1) = "Monday"
DAYS(2) = "Tuesday"
DAYS(3) = "Wednesday"
DAYS(4) = "Thursday"
DAYS(5) = "Friday"
DAYS(6) = "Saturday"

Global Dim MONTHS.s(12)

MONTHS(1) = "January"
MONTHS(2) = "February"
MONTHS(3) = "March"
MONTHS(4) = "April"
MONTHS(5) = "May"
MONTHS(6) = "June"
MONTHS(7) = "July"
MONTHS(8) = "August"
MONTHS(9) = "September"
MONTHS(10) = "October"
MONTHS(11) = "November"
MONTHS(12) = "December"


Global APP_WINDOWED = 0

Global DESKTOP_WIDTH = 0
Global DESKTOP_HEIGHT = 0
Global DESKTOP_DEPTH = 0

RandomSeed(ElapsedMilliseconds())


Window = OpenWindow(#PB_Any,0,0,800,600,"My Window")

If Not Window
  MessageRequester("OOPS!","Sorry, could not open window.")
  End
EndIf

If Not APP_WINDOWED
   If Not ExamineDesktops()
      MessageRequester("OOPS!","Sorry, could not get desktop information.")
   Else
    DESKTOP_WIDTH = DesktopWidth(0)
    DESKTOP_HEIGHT = DesktopHeight(0)
    DESKTOP_DEPTH = DesktopDepth(0)
   EndIf 
EndIf



If Not InitSprite()
   MessageRequester("OOPS!","Sorry, could not initialise graphics environment.")
   End
EndIf

If APP_WINDOWED = 1
  If Not OpenWindowedScreen(WindowID(Window),0,0,800,600,0,0,0)
     MessageRequester("OOPS!","Sorry, could not set graphics mode.")
     End
  EndIf
Else
  If Not OpenScreen(DESKTOP_WIDTH,DESKTOP_HEIGHT,DESKTOP_DEPTH,"My Screen")
     MessageRequester("OOPS!","Sorry, could not set graphics mode.")
     End
  EndIf
EndIf

If Not InitMouse()
   CloseScreen()
   MessageRequester("OOPS!","Sorry, could not initialise mouse.")
   End
EndIf

If Not InitKeyboard()
   CloseScreen()
   MessageRequester("OOPS!","Sorry, could not initialise keyboard.")
   End
EndIf




*Clock.Clock

*Clock = CreateClock(200,0.6,"comic sans ms",30)


Timer.l = ElapsedMilliseconds()

mx=220
my=220
xr = 480
yr = 360

;**************************************************************************************
;Use this to get last mouse x y positions and last key pressed.
wmx=MouseX()
wmy=MouseY() 
ExamineKeyboard()
kb$ = KeyboardInkey()
;**************************************************************************************


Repeat
    Delay(18)
   ExamineKeyboard()
   ExamineMouse()
   
   
   ;**************************************************************************************
   ;Use this to detect for mouse movement or if any key is pressed to exit this program
   If KeyboardInkey()<>kb$
      Break
   EndIf

   If MouseX()<>wmx
      Break
   EndIf

   If MouseY()<>wmy
      Break
   EndIf
   ;**************************************************************************************   
   
   
   mc=mc+1 
   If mc=400
      mc=0
      xr = Random(5)*120
      yr = Random(5)*120
   EndIf 
   ;UpdateClock(*Clock,MouseX(),MouseY())
    UpdateClock(*Clock,mx+xr,my+yr)

   ClearScreen(RGB(0,0,0))

   If StartDrawing(ScreenOutput())
      DrawClock(*Clock)
      StopDrawing()
      FlipBuffers()
     EndIf
ForEver


End

Procedure UpdateClock(*Clock.Clock,NewX.f,NewY.f)
   Protected AngleAdjust.f
   Protected xDiff.f,yDiff.f
   Protected i.l,Points.l
   Protected TIme.l
   
   Protected Date
   Protected Date$
   
   Protected DayOfWeek$
   Protected DayOfMonth$
   Protected Month$
   Protected Year$

   If Int(NewX) <> Int(*Clock\x) Or Int(NewY) <> Int(*Clock\y)
      *Clock\LastEvent = ElapsedMilliseconds()
      *Clock\x = NewX ;+ Clock\Radius# + 20
      *Clock\y = NewY ;+ Clock\Radius# + 20
      Time = ElapsedMilliseconds()
      For i = 0 To 38
         *Clock\Symbol[i]\Timer = Time
      Next
   EndIf

   ; Refresh date and time

   Date = Date()
   
   DayOfWeek$ = DAYS(DayOfWeek(Date))
   DayOfMonth$ = Str(Day(Date))
   Month$ = MONTHS(Month(Date))
   Year$ = Str(Year(Date))
   
   Date$ = DayOfWeek$ + " " + DayOfMonth$ + " " + Month$ + " " + Year$
   
   If Not Date$ = *Clock\Date$      
      *Clock\Date$ = Date$
      *Clock\DateLength = Len(Date$)
      
      For i = 1 To *Clock\DateLength
         *Clock\Symbol[i+11]\Symbol$ = Mid(*Clock\Date$,i,1)
      Next
   
   EndIf

  *Clock\Hours = Hour(Date) % 12
  *Clock\Minutes = Minute(Date)
  *Clock\Seconds = Second(Date)


   ; UPDATE COLORS

   If ElapsedMilliseconds() - *Clock\Timer >= *Clock\Timeout
      *Clock\Timer = ElapsedMilliseconds()
      *Clock\HandBaseCol = (*Clock\HandBaseCol + 1) % 7
      For i = 0 To 38
         *Clock\Symbol[i]\Col = (*Clock\Symbol[i]\Col + 1) % 7
      Next
   EndIf


   ;Text 0,580,Clock\Date$

   For i = 0 To 38
      
      If *Clock\Symbol[i]\Moving
         *Clock\Symbol[i]\Angle = FMod((*Clock\Symbol[i]\Angle - *Clock\Speed),359.0)
      EndIf

      If (ElapsedMilliseconds() - *Clock\Symbol[i]\Timer) >= (*Clock\Symbol[i]\Timeout * *Clock\Speed)
         *Clock\Symbol[i]\Timer = 0
         *Clock\Symbol[i]\cx = *Clock\x
         *Clock\Symbol[i]\cy = *Clock\y
      EndIf


      *Clock\Symbol[i]\xd = *Clock\Symbol[i]\cx + *Clock\Symbol[i]\Displacement * CosDeg(*Clock\Symbol[i]\Angle)
      *Clock\Symbol[i]\yd = *Clock\Symbol[i]\cy + *Clock\Symbol[i]\Displacement * SinDeg(*Clock\Symbol[i]\Angle)


      yDiff = *Clock\Symbol[i]\yd - *Clock\Symbol[i]\yp
      xDiff = *Clock\Symbol[i]\xd - *Clock\Symbol[i]\xp

      AngleAdjust = ATan2Deg(yDiff,xDiff)

      If AngleAdjust < 0
         AngleAdjust = AngleAdjust + 360
      EndIf

      *Clock\Symbol[i]\xp = *Clock\Symbol[i]\xp + *Clock\Speed * Abs(xDiff) * CosDeg(AngleAdjust) ;* Clock\Symbol[i]\Speed#;((Float(i + 2) / (1.1 * i)))
      *Clock\Symbol[i]\yp = *Clock\Symbol[i]\yp + *Clock\Speed * Abs(yDiff) * SinDeg(AngleAdjust) ;* Clock\Symbol[i]\Speed#;((Float(i + 2) / (1.1 * i)))
   Next

EndProcedure

Procedure DrawClock(*Clock.Clock)
  DrawingMode(#PB_2DDrawing_Transparent)
   DrawingFont(FontID(*Clock\Font))

   For i = 0 To 38
      FrontColor(RGB(RAINBOW(*Clock\Symbol[i]\Col,0),RAINBOW(*Clock\Symbol[i]\Col,1),RAINBOW(*Clock\Symbol[i]\Col,2)))
      BackColor(RGB(0,0,0))
      DrawText(*Clock\Symbol[i]\xp - 0.5 * TextWidth(*Clock\Symbol[i]\Symbol$),*Clock\Symbol[i]\yp - 0.5 * TextHeight(*Clock\Symbol[i]\Symbol$),*Clock\Symbol[i]\Symbol$)
   Next
   
   FrontColor(RGB(RAINBOW(*Clock\HandBaseCol,0),RAINBOW(*Clock\HandBaseCol,1),RAINBOW(*Clock\HandBaseCol,2)))
   Line(*Clock\x,*Clock\y,0.5 * *Clock\Radius * CosDeg(360.0 * (*Clock\Seconds / 60.0) - 90),0.5 * *Clock\Radius * SinDeg(360.0 * (*Clock\Seconds / 60.0) - 90))

   FrontColor(RGB(RAINBOW((*Clock\HandBaseCol + 1) % 7,0),RAINBOW((*Clock\HandBaseCol + 1) % 7,1),RAINBOW((*Clock\HandBaseCol + 1) % 7,2)))
   Line(*Clock\x,*Clock\y,0.35 * *Clock\Radius * CosDeg(360.0 * (*Clock\Hours / 12.0) - 90 + (30.0 * *Clock\Minutes / 60.0)),0.35 * *Clock\Radius * SinDeg(360.0 * (*Clock\Hours / 12.0) - 90) + (30.0 * *Clock\Minutes / 60.0))

;   FrontColor(RGB(RAINBOW((*Clock\HandBaseCol + 1) % 7,0),RAINBOW((*Clock\HandBaseCol + 1) % 7,1),RAINBOW((*Clock\HandBaseCol + 1) % 7,2)))
;   Line(*Clock\x,*Clock\y,0.35 * *Clock\Radius * CosDeg(360.0 * (*Clock\Hours / 12.0) - 90),0.35 * *Clock\Radius * SinDeg(360.0 * (*Clock\Hours / 12.0) - 90))

   FrontColor(RGB(RAINBOW((*Clock\HandBaseCol + 2) % 7,0),RAINBOW((*Clock\HandBaseCol + 2) % 7,1),RAINBOW((*Clock\HandBaseCol + 2) % 7,2)))
   Line(*Clock\x,*Clock\y,0.5 * *Clock\Radius * CosDeg(360.0 * (*Clock\Minutes / 60.0) - 90),0.5 * *Clock\Radius * SinDeg(360.0 * (*Clock\Minutes / 60.0) - 90))

  Circle(*Clock\x,*Clock\y,0.05 * *Clock\Radius,RGB(RAINBOW((*Clock\HandBaseCol + 3) % 7,0),RAINBOW((*Clock\HandBaseCol + 3) % 7,1),RAINBOW((*Clock\HandBaseCol + 3) % 7,2)))

EndProcedure

Procedure.l CreateClock(Radius.f,Speed.f,Font$,FontSize.l)
   Protected *Clock.Clock
   Protected Time.l
   Protected i.l

   Time = ElapsedMilliseconds()

   *Clock = AllocateMemory(SizeOf(Clock))
   *Clock\Radius = Radius
   *Clock\Speed = Speed   
   *Clock\Font = LoadFont(#PB_Any,Font$,FontSize)
   *Clock\Timer = ElapsedMilliseconds()
   *Clock\Timeout = 125
   *Clock\HandBaseCol = 0

   
   If Not *Clock\Font
      FreeMemory(*Clock)
      MessageRequester("OOPS!","Unable To load font " + Chr(34) + Font$ + Chr(34))
      End
   EndIf
   


   For i = 0 To 11
      *Clock\Symbol[i]\Symbol$ = Str(i+1)
      *Clock\Symbol[i]\Angle = 30 * (i+1) - 90
      *Clock\Symbol[i]\Displacement = 0.6 * *Clock\Radius
      *Clock\Symbol[i]\Moving = 0
      *Clock\Symbol[i]\Timer= Time
      *Clock\Symbol[i]\Timeout = i * (5000 / 39.0)

      *Clock\Symbol[i]\Col = i % 7

   Next
   
   For i = 12 To 38
      *Clock\Symbol[i]\Angle = (i - 12) * 13;.8
      *Clock\Symbol[i]\Displacement = *Clock\Radius
      *Clock\Symbol[i]\Moving = 1
      *Clock\Symbol[i]\Timer= Time
      *Clock\Symbol[i]\Timeout = i * (5000 / 39.0)

      *Clock\Symbol[i]\Col = i % 7

   Next

   ProcedureReturn *Clock
EndProcedure

Procedure.f SinDeg(f.f)
ProcedureReturn Sin((f/360.0) * 6.283184)
EndProcedure

Procedure.f CosDeg(f.f)
  ProcedureReturn Cos((f/360.0) * 6.283184)
EndProcedure

Procedure.f Atan2Deg(a.f,b.f)
   ProcedureReturn (Atan2(a.f,b.f) / 6.283184) * 360.0
EndProcedure


;To let it start without inline-asm turned on, do as in next procedure.
;This way it is direct asm. 
Procedure.f Atan2(a.f,b.f)
   !FLD dword [p.v_a]
   !FLD dword [p.v_b]
   !FPATAN
   ProcedureReturn
EndProcedure

Procedure.f FMod(a.f,b.f)
n.f = a/b

If n >= 0
   n = Round(n,#PB_Round_Down)
Else
   n = Round(n,#PB_Round_Up)
EndIf

ProcedureReturn a - n * b

EndProcedure 
Post Reply