Animated Rainbow Clock/Date

Share your advanced PureBasic knowledge/code with the community.
ProphetOfDoom
User
User
Posts: 84
Joined: Mon Jun 30, 2008 4:36 pm
Location: UK

Animated Rainbow Clock/Date

Post by ProphetOfDoom »

Hi, this was originally written in BB. It's based on a Javascript someone sent me once. I couldn't get it to work on Linux because it wouldn't let me change the font size/face for drawing on the screen, so it's windows only. Basically it's a rainbow clock, that follows the mouse (after a slight delay). It's still a bit rough round the edges. Anyway, enjoy. By the way I was "veganisafreak", I changed the name because I decided I didn't want to be defined by my vegan-ness. Hope this works for you. Enjoy.

Code: Select all

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())

;Print CommandLine()

;Select Left(CommandLine(),2)
;Case "/p"
;
;Case "/c"

;Case "/s"

;End Select

  
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()


Repeat
   ExamineKeyboard()
   ExamineMouse()
   
   If KeyboardPushed(#PB_Key_Escape)
      Break
   EndIf

   EventID.l = WaitWindowEvent(2)

   If EventID = #PB_Event_CloseWindow  ; If the user has pressed on the close button
      End
   EndIf

	UpdateClock(*Clock,MouseX(),MouseY())

;   If StartDrawing(WindowOutput(Window))
;      DrawingFont(FontID(*Clock\Font))
;      DrawText(0,0,"Testing",RGB(255,255,255),RGB(0,0,0))
;      StopDrawing()
;   EndIf

	ClearScreen(RGB(0,0,0))

   If StartDrawing(ScreenOutput())
	   DrawClock(*Clock)
	   ;Color 255,255,255
	   ;Text 5,5,"Speed: " + Left(Str(Clock\Speed#),4)
	   ;Text 5,30,"Mouse: " + Str(MouseX()) + "," + Str(MouseY())
	   ;Text 5,50,"Clock: " + Str(Int(Clock\x)) + "," + Str(Int(Clock\y))
	   ;Text 5,70,"1 Pos: " + Str(Int(Clock\Symbol[0]\xp)) + "," + Str(Int(Clock\Symbol[0]\yp))
	   ;Text 5,90,"1 Dest: " + Str(Int(Clock\Symbol[0]\xd)) + "," + Str(Int(Clock\Symbol[0]\yd))
	   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

Procedure.f Atan2(a.f,b.f)
   FLD a
   FLD 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
User avatar
Rook Zimbabwe
Addict
Addict
Posts: 4322
Joined: Tue Jan 02, 2007 8:16 pm
Location: Cypress TX
Contact:

Post by Rook Zimbabwe »

Two comments:

1. This is cool code!

2.
"veganisafreak", I changed the name because I decided I didn't want to be defined by my vegan-ness.
I always thought it should have been Veganism-Freak! :wink:
Binarily speaking... it takes 10 to Tango!!!

Image
http://www.bluemesapc.com/
Marco2007
Enthusiast
Enthusiast
Posts: 648
Joined: Tue Jun 12, 2007 10:30 am
Location: not there...

Post by Marco2007 »

Really good for someone, who doesn`t eat things, which can cast a shadow :D
PureBasic for Windows
ProphetOfDoom
User
User
Posts: 84
Joined: Mon Jun 30, 2008 4:36 pm
Location: UK

Post by ProphetOfDoom »

This is cool code!
YAy it worked on your computer. I always have this background fear when I post something, that there's some dumb error in it that makes it specific to my computer.
I always thought it should have been Veganism-Freak!
Yes that would at least make sense. I just had to register quickly on the forums to ask some questions and thought that name was as good as any but it started to piss me off.

I am becoming more extreme in my old age tho (I'm 25). I just installed Linux. I hope I don't turn to Communism. :shock:
Marco2007 wrote:Really good for someone, who doesn`t eat things, which can cast a shadow :D
LOL that's a Simpsons reference isn't it? YEs the veganism thing isa bit tricky. I'm surviving mostly on cous cous and coca cola at the moment, and I suspect the Coke is not vegan but I'm in denial about it. It fuels my coding.

Thanks for the encouraging comments both of you. :D Really made my evening.
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4791
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Post by Fangbeast »

What is this? I get a syntax error on it? Is this assembler by any chance? (If so, I will test with inline asm turned on)

Procedure.f Atan2(a.f,b.f)
FLD a ; This line, syntax error
FLD b ; This line, syntax error
FPATAN
ProcedureReturn
EndProcedure

EDIT. Never mind, it was ASM. :):)

Looks very nice.
ProphetOfDoom
User
User
Posts: 84
Joined: Mon Jun 30, 2008 4:36 pm
Location: UK

Post by ProphetOfDoom »

Yeah it's sposed to mimic Blitz BAsic's Atan2() function... I copied it off some post on this forum actually
Derek
Addict
Addict
Posts: 2354
Joined: Wed Apr 07, 2004 12:51 am
Location: England

Post by Derek »

8) 8) Nice bit of code.
ProphetOfDoom
User
User
Posts: 84
Joined: Mon Jun 30, 2008 4:36 pm
Location: UK

Post by ProphetOfDoom »

Derek wrote:8) 8) Nice bit of code.
Thanks :) :oops:
User avatar
pdwyer
Addict
Addict
Posts: 2813
Joined: Tue May 08, 2007 1:27 pm
Location: Chiba, Japan

Post by pdwyer »

8)

maybe instead of a second hand the text could go around once a minute
Paul Dwyer

“In nature, it’s not the strongest nor the most intelligent who survives. It’s the most adaptable to change” - Charles Darwin
“If you can't explain it to a six-year old you really don't understand it yourself.” - Albert Einstein
User avatar
bembulak
Enthusiast
Enthusiast
Posts: 575
Joined: Mon Mar 06, 2006 3:53 pm
Location: Austria

Post by bembulak »

Cool.
cheers,

bembulak
DarkDragon
Addict
Addict
Posts: 2345
Joined: Mon Jun 02, 2003 9:16 am
Location: Germany
Contact:

Post by DarkDragon »

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.
bye,
Daniel
yrreti
Enthusiast
Enthusiast
Posts: 546
Joined: Tue Oct 31, 2006 4:34 am

Post by yrreti »

Your program really looks cool, and would make a really nice clock and date
screen saver like program. I would suggest one little change though that
would be more appealing or readable for the eyes though.

Change the following code:

Code: Select all

 
   ;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 
to:

Code: Select all

   ;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
This causes the date to go counter clockwise which is easier to read,
as we read from left to right.

Very nice program though. :D
yrreti
Enthusiast
Enthusiast
Posts: 546
Joined: Tue Oct 31, 2006 4:34 am

Post by yrreti »

For an interesting screen saver approach, try these changes:

Code: Select all

mx=220
my=220
xr = 480
yr = 360
Repeat
    Delay(18)  ;to lower cpu usage
   ExamineKeyboard()
   ExamineMouse()
   
   If KeyboardPushed(#PB_Key_Escape)
      Break
   EndIf

   EventID.l = WaitWindowEvent(2)

   If EventID = #PB_Event_CloseWindow  ; If the user has pressed on the close button
      End
   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)
yrreti
Enthusiast
Enthusiast
Posts: 546
Joined: Tue Oct 31, 2006 4:34 am

Post by yrreti »

ProphetOfDoom, thanks very much for posting this code. I've been using it
as a sort of screen saver, with the added changes I made, and I really like it.
ProphetOfDoom
User
User
Posts: 84
Joined: Mon Jun 30, 2008 4:36 pm
Location: UK

Post by ProphetOfDoom »

Hi all,

Sorry I didn't reply before. I haven't been online much lately and when I do come on, I'm using Linux so I can't test out the changes people have made to my code. It's sooo kewl tho that people are interested enough in my code to hack about with it themselves! Hmm, "sooo kewl", I sound like... hmm...

Anyway thanks and yrreti you're very welcome! You've probably noticed from the commented out bits in my code, it was originally meant to be a screensaver (the Blitz BASIC version) but I gave up on that when I found out BB couldn't draw to the preview window.

Can anyone show how to make this an "official" windows screensaver? One that responds properly to command line options? Is it possible in PB? IIRC Windows kills screensavers when you move the mouse tho, so you'd have to break the link with the mouse position and just move the clock based on randomness or something. I've seen some C tutorials for making screensavers but they look really complicated. :( I have coder low self esteem. That's probably why I use BASIC all the time lol. That and I hate all that strcpy() crap.

Anyway, seeya.
Post Reply