clock .... strange ( bug Window openscreen !! )

Share your advanced PureBasic knowledge/code with the community.
Post Reply
User avatar
dobro
Enthusiast
Enthusiast
Posts: 766
Joined: Sun Oct 31, 2004 10:54 am
Location: France
Contact:
Contact dobro

clock .... strange ( bug Window openscreen !! )

Post by dobro »

I was surfing, I came on this site, and on this show:

http://www.tokyoflash.com/fr/watches/ki ... _illusion/

Image

I thought how can I reproduce this effect in PureBasic?

the site can see this image of the watch:
Image

reads 03 51 :) (the numbers, one above the other 03/ 51)
a moiré effect brings up the time when sufficient fixed image
(disturb your view)
Well, it's the principle of this watch :)

I made an approximation in which the following code PureBasic :
(a click on the window brings up the time in clear .. as the watch that does the same thing, because it is touch ;) )

these images of sprites for code

Block:

Image

block2:

Image

le code :

Code: Select all


UsePNGImageDecoder()
global flag_heure=0,flag_min=0
Enumeration
	#window
	#block
	#block2
	#timer
	#timer2
EndEnumeration

InitSprite() : InitSprite3D()
Declare  WindowCallback(WindowID,message,wParam,lParam)
Declare  animation()




if FileSize("illusion.inf")<>-1
	openfile(1,"illusion.inf")
	global xw=readLong(1)
	global yw=readLong(1)
	CloseFile(1)
	Else
	xw=1
	yw=1
endif
global taillex=150
global tailley=221
OpenWindow(#window,xw,yw,taillex,tailley,"Illusion",#PB_Window_BorderLess ) ;#PB_Window_SizeGadget
AddWindowTimer(#window,#timer,1000)
AddWindowTimer(#window,#timer2,2000)
OpenWindowedScreen(windowid(#window),1,1,256,440,1,0,0)

SetWindowCallback(@WindowCallback())


;{ ********** dessin du block de base ************

LoadSprite(#block,"E:\Dobro\PureBasic\dobro\Dobro_creation\montre\blockA.png",#PB_Sprite_Texture)

CreateSprite3D(#block,#block)

; lettre
LoadSprite(#block2,"E:\Dobro\PureBasic\dobro\Dobro_creation\montre\blockA2.png",#PB_Sprite_Texture)
CreateSprite3D(#block2,#block2)

;} *********************************************

dim heure(25,18)
dim minut(25,18)


repeat
	
	StartDrawing(ScreenOutput())
		if Hour(Date()) <10
			DrawText(1,1,"0"+str(Hour(Date())),#green)
			else
			DrawText(1,1,str(Hour(Date())),#green)
		endif
		if minute(Date())<10
			DrawText(20,1,"0"+str(minute(Date())),#green)
			else
			DrawText(20,1,str(minute(Date())),#green)
		endif
		
		:L=0
		for y=0 to 16
			for x=1 to 16
				heure(x,y)=point(x,y)
				minut(x,y)=point(x+20,y)
			next x
		next y
	StopDrawing()
	ClearScreen(0)
	
	;{ *********** Affichage *******************   ²
	L=0
	Start3D()
	for y=3 to 16
		for x=0 to 16 
			if heure(x,y)>0
				DisplaySprite3D(#block2,(x*16)-32,(y*16)-64)
				
				else
				if  flag_heure =0
					DisplaySprite3D(#block,(x*16)-32,(y*16)-64)
				endif
			endif
			
			if minut(x,y)>0
				
				DisplaySprite3D(#block2,(x*16)-32,(y*16)+160)
				
				Else
				if  flag_min=0
					DisplaySprite3D(#block,(x*16)-32,(y*16)+160)
				endif
			endif
		next x
	next y
	Stop3D()
	
	FlipBuffers()
	ClearScreen(0)
	;} ***************************************²
	event= WaitWindowEvent(20)
	select event
		;case #PB_Event_Timer
		
		case #WM_LBUTTONdown
		SendMessage_(WindowID(#Window), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
		
		flag_min=1
		flag_heure=1
		openfile(1,"illusion.inf")
		WriteLong(1,WindowX(#window))
		WriteLong(1,Windowy(#window))
		CloseFile(1)
		
		case #WM_RBUTTONdown
		event=#PB_Event_CloseWindow
	endselect
	
until event=#PB_Event_CloseWindow
end

; 
Procedure WindowCallback(WinID,message,wParam,lParam)
	; by Dobro
	res=#PB_ProcessPureBasicEvents
	Select message
		case #WM_LBUTTONUP
		; 
		flag_min=0
		flag_heure=0
		Case #WM_PAINT
		flag_min=0
		flag_heure=0
		
		Case #WM_TIMER
		
		if EventTimer() = #timer
			flag_min=0
			flag_heure=0
			animation()
			
		endif
		if EventTimer() = #timer2
			; rafraichi l'affichage
			flag_min=0
			flag_heure=0
			ResizeWindow(#window,#pb_ignore,#pb_ignore,taillex,tailley)
		endif
		;EndSelect
	EndSelect
	ProcedureReturn res ; important , laissez passer les autres evenements !!!
EndProcedure




procedure animation()
	
	static pos_block
	static pos_block2
	
	pos_block=pos_block-1
	pos_block2=pos_block2+1
	if  pos_block<0 : pos_block=3:endif
	if  pos_block2>3
		pos_block2=0
		RemoveWindowTimer(#Window,#timer)
		AddWindowTimer(#window,#timer,random(60000)+10000)
	endif
	select pos_block
		case 0
		RotateSprite3D(#block,0,1)
		case 1
		RotateSprite3D(#block,90,1)
		case 2
		RotateSprite3D(#block,180,1)
		case 3
		RotateSprite3D(#block,270,1)
	endselect
	
	select pos_block2
		case 0
		RotateSprite3D(#block2,0,1)
		case 1
		RotateSprite3D(#block2,90,1)
		case 2
		RotateSprite3D(#block2,180,1)
		case 3
		RotateSprite3D(#block2,270,1)
	endselect
	
	
	
EndProcedure

; 
;
; EPb

rendering has13:02

Image
:)
Last edited by dobro on Tue Feb 28, 2012 10:53 am, edited 3 times in total.
Image
■ Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/
Top
DarkDragon
Addict
Addict
Posts: 2345
Joined: Mon Jun 02, 2003 9:16 am
Location: Germany
Contact:
Contact DarkDragon

Re: clock .... strange

Post by DarkDragon »

Cool.
bye,
Daniel
Top
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Re: clock .... strange

Post by rsts »

Good one!

Thanks for sharing with us. :D

cheers
Top
User avatar
dobro
Enthusiast
Enthusiast
Posts: 766
Joined: Sun Oct 31, 2004 10:54 am
Location: France
Contact:
Contact dobro

Re: clock .... strange

Post by dobro »

thanks :)
Change the code
adding save position window , and size (on seven window up Out Screen)
adjustment of the size with :
global taillex=150
global tailley=221
Image
■ Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/
Top
User avatar
idle
Always Here
Always Here
Posts: 5915
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: clock .... strange

Post by idle »

:?: :idea: :shock: 8) :mrgreen:

nice one!
Windows 11, Manjaro, Raspberry Pi OS
Image
Top
User avatar
skywalk
Addict
Addict
Posts: 4220
Joined: Wed Dec 23, 2009 10:14 pm
Location: Boston, MA

Re: clock .... strange

Post by skywalk »

Make it stop!! :shock: I can see the numbers with my eyes closed. :(
Top
User avatar
dobro
Enthusiast
Enthusiast
Posts: 766
Joined: Sun Oct 31, 2004 10:54 am
Location: France
Contact:
Contact dobro

Re: clock .... strange ( Bug window ?? )

Post by dobro »

may be a bug purebasic

with the code of the watch above

if I replace this line works well (loads an image that is 16x16)

Code: Select all

;LoadSprite(#block,"E:\Dobro\PureBasic\dobro\Dobro_creation\montre\blockA.png",#PB_Sprite_Texture)
by:

Code: Select all

CreateSprite(#block,16,16, #PB_Sprite_Texture)
StartDrawing(SpriteOutput(#block))
LineXY(0,0,16,16,#green)
StopDrawing()
(16x16 sprite with oblique line in)

this appears smaller

Image

because in mode is:
OpenWindowedScreen (WindowID (#window), 1, 1,256,440,1,0,0)
sprites are reduced depending on the size of the screen ,reduce 2 times!, but not the image sprite! (Loadsprite ()) reduces 1 time!

there is a difference in treatment between the sprite made ​​(create sprite)
Loaded and sprite (loadsprite ())

may well be a bug OpenWindowedScreen () ?


Test Bug with this :

the image sprite 16x16 : Image

the code Bug évidence :

Code: Select all


UsePNGImageDecoder()
global flag_heure=0,flag_min=0
Enumeration
	#window
	#block_load
	#block_create
EndEnumeration

InitSprite() : InitSprite3D()

global taillex=150
global tailley=221
OpenWindow(#window,xw,yw,taillex,tailley,"Illusion",#PB_Window_BorderLess ) ;#PB_Window_SizeGadget
OpenWindowedScreen(windowid(#window),1 ,1,256,440,1,0,0)

;{ ********** dessin du block de base ************

;
LoadSprite(#block_load,"E:\Dobro\PureBasic\dobro\Dobro_creation\montre\blockA.png",#PB_Sprite_Texture)
;


CreateSprite(#block_create,16,16, #PB_Sprite_Texture)
StartDrawing(SpriteOutput(#block_create))
	LineXY(0,0,16,16,#green)
StopDrawing()

CreateSprite3D(#block_load,#block_load)

CreateSprite3D(#block_create,#block_create)

repeat
	
	;{ *********** Affichage *******************   ²
	L=0
	Start3D()
	DisplaySprite3D(#block_load,(16),(16))
	DisplaySprite3D(#block_create,(16)+32,(16))
	Stop3D()
	
	FlipBuffers()
	ClearScreen(0)
	;} ***************************************²
	event= WaitWindowEvent(20)
	select event
		
		case #WM_RBUTTONdown
		event=#PB_Event_CloseWindow
	endselect
	
until event=#PB_Event_CloseWindow
end

; 









; 
; EPb
Image
■ Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/
Top
User avatar
Michael Vogel
Addict
Addict
Posts: 2808
Joined: Thu Feb 09, 2006 11:27 pm
Contact:
Contact Michael Vogel

Re: clock .... strange ( bug Window openscreen !! )

Post by Michael Vogel »

Cool idea, thanks for the code :wink:

And, what's the reason for using sprites and not just images here? The missing ImageRotate command? Something else?

Code: Select all

Procedure CreateDot(Image,Size,Width,Col1,Col2,Flip=#False)
	
	Protected i
	Protected Ezis,o
	
	CreateImage(Image,Size,Size,32)
	StartDrawing(ImageOutput(Image))
	Box(0,0,Size,Size,Col1)
	
	Size-1
	Ezis=Flip*Size
	Flip=-Flip*2+1
	
	For i=0 To Width
		o=i*Flip
		LineXY(Ezis+o,0,Size-Ezis,Size-i,Col2)
		LineXY(Ezis,0+i,Size-Ezis-o,Size,Col2)
	Next i
	StopDrawing()
	
EndProcedure

OpenWindow(0, 0, 0, 600, 400, "",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)

CreateDot(1,16,2,#Green,#Black)
CreateDot(2,16,2,#Green,#Black,#True)
ImageGadget(1,10,10,0,0,ImageID(1))
ImageGadget(2,50,10,0,0,ImageID(2))

Repeat
	EventID = WaitWindowEvent()
Until EventID = #PB_Event_CloseWindow
Last edited by Michael Vogel on Tue Feb 28, 2012 11:19 pm, edited 1 time in total.
Top
User avatar
dobro
Enthusiast
Enthusiast
Posts: 766
Joined: Sun Oct 31, 2004 10:54 am
Location: France
Contact:
Contact dobro

Re: clock .... strange ( bug Window openscreen !! )

Post by dobro »

I like the sprites ... more it helped me to find a bug ;)


Zaphod on French Forum redid my code without Sprites ;)
it does not remove the bug I reported

ps: I know how to rotate an image ;)

Sprite animations allow easier than with an image :)

Code: Select all


;
Enumeration
  #window
  #imgad
  #im0
  #im1
  #im2
  #im3
  #font1
  #timer
EndEnumeration
;
Global Dim heure.i(25,18)
Global Dim minut.i(25,18)
Global flagh.i,flagm.i
;
Procedure DrawTime()
  Protected x.i,y.i
  CreateImage(#im3,40,20)
  StartDrawing(ImageOutput(#im3))
  DrawingFont(FontID(#font1))
      If Hour(Date()) <10
         DrawText(1,1,"0"+Str(Hour(Date())),#Green)
         Else
         DrawText(1,1,Str(Hour(Date())),#Green)
      EndIf
      If Minute(Date())<10
         DrawText(20,1,"0"+Str(Minute(Date())),#Green)
         Else
         DrawText(20,1,Str(Minute(Date())),#Green)
      EndIf
     
      For y=0 To 16
         For x=1 To 19
            heure(x,y)=Point(x,y)
            minut(x,y)=Point(x+19,y)
         Next x
      Next y
      StopDrawing()
     ;
  FreeImage(#im3)
EndProcedure

Procedure drawmotif()
  Protected x.i,y.i
  ;
  StartDrawing(ImageOutput(#im0))
  Box(0,0,270,350,#Black)
  ;
  For y=3 To 13
      For x=2 To 19
         If heure(x,y)>0
           DrawImage(ImageID(#im2), (x*16)-62,(y*16)-50)
            Else
            If  flagh =0
              DrawImage(ImageID(#im1),(x*16)-62,(y*16)-50)
            EndIf
          EndIf
        Next x
      Next y
;     
      For y=3 To 13
        For x=2 To 19
          If minut(x,y)>0
            DrawImage(ImageID(#im2),(x*16)-62,(y*16)+125)           
            Else
            If  flagm=0
               DrawImage(ImageID(#im1),(x*16)-62,(y*16)+125)
            EndIf
         EndIf
      Next x
    Next y
    ;
    StopDrawing()
    ;
    SetGadgetState(#imgad,ImageID(#im0))
EndProcedure
;
;-debut
;
OpenWindow(#window, 0, 0, 260, 350, "TimeMotif", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
 ImageGadget(#imgad,0,0,270,350,0)
 ;
 CreateImage(#im1,16,16);,32|#PB_Image_Transparent) ; \
 StartDrawing(ImageOutput(#im1))
 Line(0,0,16,16,#Green)
 Line(1,0,16,16,#Green)
 Line(0,1,16,16,#Green)
 StopDrawing()
 ;
 CreateImage(#im2,16,16);,32|#PB_Image_Transparent) ; /
 StartDrawing(ImageOutput(#im2))
 LineXY(0,16,16,0,#Green)
 LineXY(1,16,15,0,#Green)
 LineXY(0,15,16,1,#Green)
 StopDrawing()
 ;
 CreateImage(#im0,270,350)
 ;
 LoadFont(#font1, "Courier", 10,#PB_Font_Bold)
 ;
 Drawtime()
 drawmotif()
 ;
 AddWindowTimer(#window,#timer,1000)
 ;
    Repeat
      Event = WaitWindowEvent()
      Select event
        Case #PB_Event_Gadget
          If EventGadget()=#imgad
          If EventType()=#PB_EventType_LeftClick
            flagh= (Not flagh)
            flagm= (Not flagm)
            drawmotif()
          EndIf
          EndIf
         
        Case #PB_Event_Timer
        If EventTimer() = #timer
          drawtime()
          drawmotif()
        EndIf
        EndSelect
         
Until Event = #PB_Event_CloseWindow
Image
■ Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/
Top
User avatar
Michael Vogel
Addict
Addict
Posts: 2808
Joined: Thu Feb 09, 2006 11:27 pm
Contact:
Contact Michael Vogel

Re: clock .... strange ( bug Window openscreen !! )

Post by Michael Vogel »

Knew you know how to deal with images :mrgreen:

Just have modified your code to have straight lines now...

Code: Select all

; Define

	#Size=16
	#Width=4
	
	#X=16
	#Y=24
	#Gap=1

	Enumeration
		#window
		#imgad
		#im0
		#im1
		#im2
		#im3
		#font1
		#timer
	EndEnumeration

	Global Dim Dots.i(#X,#Y)
	Global Flag

; EndDefine
Procedure CreateDot(Image,Size,Width,Col1,Col2,Flip=#False)

	Protected i
	Protected Ezis,o

	CreateImage(Image,Size,Size,32)
	StartDrawing(ImageOutput(Image))
	Box(0,0,Size,Size,Col1)

	Size-1
	Ezis=Flip*Size
	Flip=-Flip*2+1

	For i=0 To Width
		o=i*Flip
		LineXY(Ezis+o,0,Size-Ezis,Size-i,Col2);	\··
		LineXY(Ezis,0+i,Size-Ezis-o,Size,Col2);	:\
		If i<Width
			LineXY(Size-Ezis-o,0,Size-Ezis,i,Col2);		`
			LineXY(Ezis,Size-i,Ezis+o,Size,Col2);		  ,
		EndIf
	Next i
	StopDrawing()

EndProcedure

Procedure CalcTime()

	Protected x.i,y.i,g.i

	CreateImage(#im3,#X+#Gap,#Y)
	StartDrawing(ImageOutput(#im3))
	DrawingFont(FontID(#font1))
	DrawText(-1,-1,RSet(Str(Hour(Date())),2,"0"),#Green)
	DrawText(-1,11,RSet(Str(Minute(Date())),2,"0"),#Green)

	For y=0 To #Y-1
		For x=0 To #X-1
			g=x/((#X+1)>>1)
			Dots(x,y)=Point(x+g*#Gap,y)
		Next x
	Next y
	StopDrawing()

	FreeImage(#im3)

EndProcedure
Procedure DrawTime()

	Protected x.i,y.i

	StartDrawing(ImageOutput(#im0))
	Box(0,0,#X*#Size,#Y*#Size,#Black)

	For y=0 To #Y-1
		For x=0 To #X-1
			If Dots(x,y)>0
				DrawImage(ImageID(#im2),x*#Size,y*#Size)
			ElseIf Flag=0
				DrawImage(ImageID(#im1),x*#Size,y*#Size)
			EndIf
		Next x
	Next y

	StopDrawing()

	SetGadgetState(#imgad,ImageID(#im0))

EndProcedure

Procedure Main()
	
	OpenWindow(#Window,0,0,#Size*#X,#Size*#Y,"TimeMotif",#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
	ImageGadget(#imgad,0,0,#Size*#X,#Size*#Y,0)

	CreateImage(#im0,#X*#Size,#Y*#Size)
	CreateDot(#im1,#Size,#Width,#Green,#Black,0)
	CreateDot(#im2,#Size,#Width,#Green,#Black,1)
	LoadFont(#font1,"Courier",9,#PB_Font_Bold)

	CalcTime()
	DrawTime()

	AddWindowTimer(#window,#timer,1000)

	Repeat
		Event = WaitWindowEvent()
		Select event
		Case #PB_Event_Gadget
			If EventGadget()=#imgad
				If EventType()=#PB_EventType_LeftClick
					Flag!1
					DrawTime()
				EndIf
			EndIf

		Case #PB_Event_Timer
			If EventTimer() = #timer
				CalcTime()
				DrawTime()
			EndIf
		EndSelect

	Until Event = #PB_Event_CloseWindow
	
EndProcedure
Main()
Top
User avatar
dobro
Enthusiast
Enthusiast
Posts: 766
Joined: Sun Oct 31, 2004 10:54 am
Location: France
Contact:
Contact dobro

Re: clock .... strange ( bug Window openscreen !! )

Post by dobro »

the result of your code, home ... that is why I talk about bug
somewhere

Image

Note the display shift ;)
Image
■ Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/
Top
Post Reply

Return to “Tricks 'n' Tips”