PureBasic Forums - English

Posted: **Mon Jun 30, 2008 4:46 pm**

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

Posted: **Mon Jun 30, 2008 6:21 pm**

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!

Posted: **Mon Jun 30, 2008 6:46 pm**

Really good for someone, who doesn`t eat things, which can cast a shadow

Posted: **Tue Jul 01, 2008 12:18 am**

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.

Marco2007 wrote:Really good for someone, who doesn`t eat things, which can cast a shadow

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.

Really made my evening.

Posted: **Tue Jul 01, 2008 5:29 am**

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.

Posted: **Tue Jul 01, 2008 2:34 pm**

Yeah it's sposed to mimic Blitz BAsic's Atan2() function... I copied it off some post on this forum actually

Posted: **Tue Jul 01, 2008 2:43 pm**

Nice bit of code.

Posted: **Tue Jul 01, 2008 2:58 pm**

Derek wrote: Nice bit of code.

Thanks

Posted: **Tue Jul 01, 2008 3:07 pm**

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

Posted: **Tue Jul 01, 2008 3:28 pm**

Cool.

Posted: **Tue Jul 01, 2008 3:34 pm**

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.

Posted: **Wed Jul 02, 2008 12:37 am**

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.

Posted: **Wed Jul 02, 2008 2:04 am**

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)

Posted: **Sun Jul 13, 2008 3:30 am**

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.

Posted: **Sun Jul 13, 2008 8:47 pm**

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.

PureBasic Forums - English

Animated Rainbow Clock/Date

Animated Rainbow Clock/Date