Starting a clock collection...

Share your advanced PureBasic knowledge/code with the community.
Post Reply
User avatar
Michael Vogel
Addict
Addict
Posts: 2806
Joined: Thu Feb 09, 2006 11:27 pm
Contact:
Contact Michael Vogel

Starting a clock collection...

Post by Michael Vogel »

Hi,

just had one hour free time today, so I coded a simple clock (not sure if this should stay here in this thread :oops: )

Michael

Code: Select all

; Define

	#Phases=10
	#Halftime=#Phases>>1

	#Delay=60
	#BorderColor=#Gray

	Enumeration
		#Never
		;
		#Hours=0
		#Minutes
		#Seconds
		#OldValue
		#NewValue
		#Drawboard
		#Plate
		;
		#WinID
		#Numbers
		;
		#Now
		#Undefined=-1
	EndEnumeration

	Global WinID
	Global WX=590
	Global WY=200

	Global GX=190
	Global GY=190
	Global G_X=GX-1
	Global G_Y=GY-1
	Global G_M=G_Y>>1

	Global OX=5
	Global OY=5
	Global OZ=5

	Global Later=#Never

	Global HourLast=#Undefined
	Global MinuteLast=#Undefined
	Global SecondLast=#Undefined

	Global Font
	Global Dim Image(#Plate)
	Global Text.s

	Global Dim Size(#Phases)

; EndDefine

Procedure.l Greyscale(n,x)
	n=x-n
	n<<6
	n/x
	ProcedureReturn n*$10101
EndProcedure
Procedure.l QuickEvent(n)

	n+ElapsedMilliseconds()

	While n>ElapsedMilliseconds()

		Select WaitWindowEvent(10)
		Case #PB_Event_CloseWindow
			ProcedureReturn #True
		Case #WM_CHAR
			If EventwParam()=27
				ProcedureReturn #True
			EndIf
		EndSelect

	Wend

	ProcedureReturn #False

EndProcedure

Procedure Plate(index,old,new,phase)


	Image(#NewValue)=CopyImage(#Plate,#NewValue)
	StartDrawing(ImageOutput(#NewValue))
	DrawingMode(#PB_2DDrawing_Transparent)
	DrawingFont(Font)
	Text=RSet(Str(new),2,"0")
	DrawText((GX-TextWidth(Text))>>1,(GY-TextHeight(Text))>>1,Text,#White)
	StopDrawing()

	Image(#OldValue)=CopyImage(#Plate,#OldValue)
	StartDrawing(ImageOutput(#OldValue))
	DrawingMode(#PB_2DDrawing_Transparent)
	DrawingFont(Font)
	Text=RSet(Str(old),2,"0")
	DrawText((GX-TextWidth(Text))>>1,(GY-TextHeight(Text))>>1,Text,#White)
	StopDrawing()

	StartDrawing(ImageOutput(index))
	If phase<>#Phases

		Image(#Drawboard)=GrabImage(#NewValue,#Drawboard,0,0,GX,G_M)
		DrawImage(Image(#Drawboard),0,0)

		Image(#Drawboard)=GrabImage(#OldValue,#Drawboard,0,G_M,GX,G_M)
		DrawImage(Image(#Drawboard),0,G_M)


		If phase<#Halftime
			Image(#Drawboard)=GrabImage(#OldValue,#Drawboard,0,0,GX,G_M)
			Image(#Drawboard)=ResizeImage(#Drawboard,GX,Size(phase))
			DrawImage(Image(#Drawboard),0,G_M-Size(phase))
			LineXY(0,G_M-Size(phase),GX,G_M-Size(phase),#BorderColor)
		ElseIf phase>#Halftime
			Image(#Drawboard)=GrabImage(#NewValue,#Drawboard,0,G_M,GX,G_M)
			Image(#Drawboard)=ResizeImage(#Drawboard,GX,Size(phase))
			DrawImage(Image(#Drawboard),0,G_M)
			LineXY(0,G_M+Size(phase),GX,G_M+Size(phase),#BorderColor)
		EndIf


	Else
		Image(index)=CopyImage(#NewValue,index)
	EndIf

	StopDrawing()


EndProcedure
Procedure Flip(Hour,Minute,Second)

	Protected n

	For n=1 To #Phases
		If Hour<>#Undefined
			Plate(#Hours,HourLast,Hour,n)
			SetGadgetState(#Hours,Image(#Hours))
		EndIf
		If Minute<>#Undefined
			Plate(#Minutes,MinuteLast,Minute,n)
			SetGadgetState(#Minutes,Image(#Minutes))
		EndIf
		If Second<>#Undefined
			Plate(#Seconds,SecondLast,Second,n)
			SetGadgetState(#Seconds,Image(#Seconds))
		EndIf

		If QuickEvent(#Delay)
			Later=#Now
			Break
		EndIf

	Next n

	If Hour<>#Undefined
		HourLast=Hour
	EndIf
	If Minute<>#Undefined
		MinuteLast=Minute
	EndIf
	If Second<>#Undefined
		SecondLast=Second
	EndIf

EndProcedure
Procedure UpdateClock()

	Protected HourNow,MinuteNow,SecondNow
	Protected Clock=Date()

	HourNow=Hour(Clock)
	MinuteNow=Minute(Clock)
	SecondNow=Second(Clock)

	If HourLast=HourNow
		HourNow=#Undefined
	EndIf
	If MinuteLast=MinuteNow
		MinuteNow=#Undefined
	EndIf
	If SecondLast=SecondNow
		SecondNow=#Undefined
	EndIf

	Flip(HourNow,MinuteNow,SecondNow)

EndProcedure

Procedure Init()

	Protected i

	WinID=OpenWindow(#WinID,0,0,WX,WY,"Flip Flop",#PB_Window_Invisible|#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
	SetWindowColor(#WinID,$200000)

	For i=#Hours To #Seconds
		ImageGadget(i,OX+(GX+OZ)*i,OY,GX,GY,0)
	Next i
	For i=#Hours To #Plate
		Image(i)=CreateImage(i,GX,GY)
	Next i
	Font=LoadFont(#Numbers,"MS Trebuchet",GY*0.65,#PB_Font_Bold)

	StartDrawing(ImageOutput(#Plate))
	Box(0,0,G_X,G_Y,#Black)

	For i=0 To G_M/3
		c=GreyScale(i,G_M/3)
		LineXY(0,i,G_X,i,c)
		LineXY(0,i+G_M,G_X,i+G_M,c)
	Next i
	StopDrawing()

	For i=1 To #Phases
		Size(i)=Abs(Cos(i*#PI/#Phases)*G_M)
	Next i

	UpdateClock()
	SetTimer_(WinID,0,1000,0)

	HideWindow(#WinID,0)

EndProcedure
Procedure Main()
	Init()

	Repeat

		Select WaitWindowEvent(100)

		Case #PB_Event_CloseWindow
			Later=#Now

		Case #WM_TIMER
			;If Second(Date())&1=0
				UpdateClock()
			;EndIf

		EndSelect

	Until Later

EndProcedure

Main()
Last edited by Michael Vogel on Wed Mar 18, 2009 7:14 pm, edited 1 time in total.
Top
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Post by Kwai chang caine »

One word

SPLENDID !!

When i was young...i had exactly this type of clock.

I love it :D

Thanks for sharing
Good day
ImageThe happiness is a road...
Not a destination
Top
Micko
Enthusiast
Enthusiast
Posts: 244
Joined: Thu May 24, 2007 7:36 pm
Location: Senegal
Contact:
Contact Micko

Post by Micko »

very nice :D
Top
infratec
Always Here
Always Here
Posts: 7618
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Post by infratec »

Hi Michael,

with a few additions it also works in Linux:

Code: Select all

CompilerIf #PB_Compiler_OS = #PB_OS_Linux
    #Gray=$808080
    #White=$FFFFFF
    #Black=$000000
CompilerEndIf

Code: Select all

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
      Case #WM_CHAR
         If EventwParam()=27
            ProcedureReturn #True
         EndIf
CompilerEndIf

Code: Select all

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
   SetTimer_(WinID,0,1000,0)
CompilerEndIf

Code: Select all

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
      Case #WM_TIMER
         ;If Second(Date())&1=0
            UpdateClock()
         ;EndIf
CompilerEndIf
      EndSelect

CompilerIf #PB_Compiler_OS = #PB_OS_Linux
      NewSecond = Second(Date())
      If NewSecond <> OldSecond
        UpdateClock()
        OldSecond = NewSecond
      EndIf
CompilerEndIf

   Until Later
It looks nice :D

Bernd

P.S.: in general: with my changes it works also in Windows.
So why did you use this special windows stuff?
Top
User avatar
Michael Vogel
Addict
Addict
Posts: 2806
Joined: Thu Feb 09, 2006 11:27 pm
Contact:
Contact Michael Vogel

Post by Michael Vogel »

infratec wrote:So why did you use this special windows stuff?
Hi Bernd,

there are some reasons for that...
• I had just one hour to do the whole stuff (50 minutes, to be exact :wink:)
• I do not know linux very well (thats no excuse, I know)
• I also thought, that the timer uses less CPU power :roll:

There should be a lot of potential for optimizing the image part, which takes quite long on my small netbook...

Michael
Top
User avatar
idle
Always Here
Always Here
Posts: 5897
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Post by idle »

I like it, looks good!
Top
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Post by rsts »

Very nice. reminds me of one I used to have too.

cheers
Top
User avatar
luis
Addict
Addict
Posts: 3895
Joined: Wed Aug 31, 2005 11:09 pm
Location: Italy

Post by luis »

Really really nice, I will stea... I will incorporate your drawing routines in something of mine sooner or later, thank you!
Top
User avatar
Michael Vogel
Addict
Addict
Posts: 2806
Joined: Thu Feb 09, 2006 11:27 pm
Contact:
Contact Michael Vogel

Post by Michael Vogel »

luis wrote:Really really nice, I will stea... I will incorporate your drawing routines in something of mine sooner or later, thank you!
Va be - forse c'e un posto per un piccolo messaggio col mio nome :lol:

Ciao,
Michael
Top
SCRJ
User
User
Posts: 93
Joined: Sun Jan 15, 2006 1:36 pm

Post by SCRJ »

Really cool, thanks for sharing :D
Top
Tranquil
Addict
Addict
Posts: 952
Joined: Mon Apr 28, 2003 2:22 pm
Location: Europe

Post by Tranquil »

Good Work, thanks for posting it!
Tranquil
Top
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4789
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Post by Fangbeast »

We all had clocks like this when we were younger I think. Some of them made a swishing sound as the flat number leaves changed and all our airports, train terminals etc used to use the same system. They were fun to watch.

Love it, good job. I am going to keep it running for nostalgia.
Amateur Radio/VK3HAF, (D-STAR/DMR and more), Arduino, ESP32, Coding, Crochet
Top
User avatar
bembulak
Enthusiast
Enthusiast
Posts: 575
Joined: Mon Mar 06, 2006 3:53 pm
Location: Austria

Post by bembulak »

First of all:
thanks for the cool code.
It looks very nice, I love the clock!

Second,
look what time I had today:

Image

:D
cheers,

bembulak
Top
WilliamL
Addict
Addict
Posts: 1252
Joined: Mon Aug 04, 2008 10:56 pm
Location: Seattle, USA

Post by WilliamL »

Works on Mac in x86. I messed up the code but the final result runs fine. Maybe somebody else can figure out why the Image(array) doesn't work in line 111/117.

Code: Select all

; see Mac code below with ebs' additions
[took out this code to reduce clutter]
Last edited by WilliamL on Wed Mar 25, 2009 9:56 pm, edited 2 times in total.
MacBook Pro-M1 (2021), Sequoia 15.4, PB 6.20
Top
User avatar
Michael Vogel
Addict
Addict
Posts: 2806
Joined: Thu Feb 09, 2006 11:27 pm
Contact:
Contact Michael Vogel

Post by Michael Vogel »

WilliamL wrote:Works on Mac in x86. I messed up the code but the final result runs fine. Maybe somebody else can figure out why the Image(array) doesn't work in line 111/117.
Hm,
not sure, but perhaps the ResizeImage function does not return the handle of the new image in the Mac version of PB. The help file does not show a return value of this function (I just tried it and hoped it works like all other bitmap functions)...

Michael
Top
Post Reply

Return to “Tricks 'n' Tips”