a binary clock

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

a binary clock

Post by dobro »

made by Venom (French forum)
Powered by Dobro (French forum)


; by Venom
; arrangé par Dobro ;

Global Dim tableau.S (6)
Enumeration
         #sprite_bleu
         #sprite_rouge
         #window
EndEnumeration

initsprite ()

If openwindow ( #window , 0, 0, 600, 400, "Binary Clock" , #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered )
         openwindowedscreen ( windowid ( #window ),0,0,600,400,1,0,0)
         setframerate (25)
         fontid = loadfont (8, "Arial Black" , 95, #PB_Font_Bold )
        F2 = loadfont (9, "Arial Black" , 9, #PB_Font_Bold )
        
         ; ********* creation de sprite *************
         createsprite ( #sprite_rouge ,55,55)
         startdrawing ( spriteoutput ( #sprite_rouge ))
                c=1
                 For i=27 To 2 Step -2
                         circle (25, 25, i, rgb (0, c, 0))
                        c=c+10
                 Next i
         stopdrawing ()
        
         createsprite ( #sprite_bleu ,50,50)
         startdrawing ( spriteoutput ( #sprite_bleu ))
                 circle (25, 25, 25, rgb (0, 0, 30))
         stopdrawing ()
         ; ***************************************
         addwindowtimer ( #window , 123,1000)
         Repeat
                Event = waitwindowevent (2)
                 Select Event
                        Case#PB_Event_Gadget
                         Case #PB_Event_Timer
                                 If eventtimer () = 123
                                         If startdrawing ( screenoutput ())
                                                        y=320 : x=580
                                                         drawingfont (F2)
                                                         drawtext (x, y, "1" , rgb (0, 255, 0), rgb (0, 0, 0)) :y-50
                                                         drawtext (x, y, "2" , rgb (0, 255, 0), rgb (0, 0, 0)) :y-50
                                                         drawtext (x, y, "4" , rgb (0, 255, 0), rgb (0, 0, 0)) :y-50
                                                         drawtext (x, y, "8" , rgb (0, 255, 0), rgb (0, 0, 0))
                                                         drawingfont ( fontid )
                                                        date$ = formatdate ( "%hh:%ii:%ss" , date ())
                                                         drawtext (0, -30, date$, rgb (0, 100, 0), rgb (0, 0, 0))
                                                        heure_dizaine$= mid ( bin ( val ( left ( stringfield (date$,1, ":" ),1))),1,2)
                                                        heure_unite$= mid ( bin ( val ( right ( stringfield (date$,1, ":" ),1))),1,4)
                                                        minute_dizaine$= mid ( bin ( val ( left ( stringfield (date$,2, ":" ),1))),1,3)
                                                        minute_unite$= mid ( bin ( val ( right ( stringfield (date$,2, ":" ),1))),1,4)
                                                        seconde_dizaine$= mid ( bin ( val ( left ( stringfield (date$,3, ":" ),1))),1,3)
                                                        seconde_unite$= mid ( bin ( val ( right ( stringfield (date$,3, ":" ),1))),1,4)
                                                        
                                                         ;{ ******** dessine le decors **********************
                                                         Restore sprite_bleu:
                                                         ; ++++++++++ dizaine heur bleu +++++++++
                                                         For o=1 To 6
                                                                 Read n
                                                                 Read p
                                                                y=300
                                                                 For i=1 To n
                                                                         displaysprite ( #sprite_bleu ,p,y)
                                                                        y=y-50
                                                                 Next i
                                                         Next o
                                                         ; ++++++++++++++++++++++++++++++++++++++
                                                         ;}
                                                         ;{ affichage de l'heure
                                                         ; ++++++++++ dizaine heur rouge +++++++++
                                                        tableau.S (1)=heure_dizaine$
                                                        tableau.S (2)=heure_unite$
                                                        tableau.S (3)=minute_dizaine$
                                                        tableau.S (4)=minute_unite$
                                                        tableau.S (5)=seconde_dizaine$
                                                        tableau.S (6)=seconde_unite$
                                                         Restore sprite_rouge
                                                         For o=1 To 6
                                                                 Read y
                                                                 Read n
                                                                 Read p
                                                                var$=tableau.S (o)
                                                                 For i=1 To n
                                                                         If len (var$)<n
                                                                                var$= "0" +var$
                                                                         EndIf
                                                                         If mid (var$,i,1)= "1"
                                                                                 displaytransparentsprite ( #sprite_rouge ,p,y)
                                                                         EndIf
                                                                        y=y+50
                                                                 Next i
                                                         Next o
                                                         ; ++++++++++++++++++++++++++++++++++++++
                                                         ;} ++++++++++++++++++++++++++++++++++++++
                                                 stopdrawing ()
                                         EndIf
                                 EndIf
                                 ; ; ++++++++++++++++++++++++++++++++++++++
                                 flipbuffers ()
                                 clearscreen ( rgb (0,0,0))
                 EndSelect
         Until Event = #PB_Event_CloseWindow
EndIf
        
        

DataSection
        sprite_bleu:
        Data.i 2,50,4,100,3,250,4,300,3,450,4,500
        sprite_rouge:
        Data.i 250,2,50,150,4,100,200,3,250,150,4,300,200,3,450,150,4,500
EndDataSection
Last edited by dobro on Tue Feb 15, 2011 1:21 pm, edited 2 times in total.
Image
Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/
User avatar
dobro
Enthusiast
Enthusiast
Posts: 766
Joined: Sun Oct 31, 2004 10:54 am
Location: France
Contact:

Re: a binary clock

Post by dobro »

and a small Variant


; by Venom
; arrangé par Dobro ;

Global Dim tableau.S (6)
Enumeration
         #sprite_bleu
         #sprite_rouge
         #window
EndEnumeration

initsprite ()

If openwindow ( #window , 0, 0, 350, 180, "Binary Clock" , #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered )
         openwindowedscreen ( windowid ( #window ),0,0,350,180,1,0,0)
         setframerate (25)
         fontid = loadfont (8, "Arial Black" , 95, #PB_Font_Bold )
        F2 = loadfont (9, "Arial Black" , 9, #PB_Font_Bold )
        
         ; ********* creation de sprite *************
         createsprite ( #sprite_rouge ,55,55)
         startdrawing ( spriteoutput ( #sprite_rouge ))
                c=1
                 For i=27 To 2 Step -2
                         circle (25, 25, i, rgb (0, c, 0))
                        c=c+10
                 Next i
         stopdrawing ()
        
         ; ***************************************
         addwindowtimer ( #window , 123,1000)
        
         Repeat
                Event = waitwindowevent (2)
                 Select Event
                        Case#PB_Event_Gadget
                         Case #PB_Event_Timer
                                 If eventtimer () = 123
                                         If startdrawing ( screenoutput ())
                                                        
                                                        y=160 : x=325
                                                         drawingfont (F2)
                                                         drawtext (x, y, "1" , rgb (0, 255, 0), rgb (0, 0, 0)) : x-50
                                                         drawtext (x, y, "2" , rgb (0, 255, 0), rgb (0, 0, 0)) : x-50
                                                         drawtext (x, y, "4" , rgb (0, 255, 0), rgb (0, 0, 0)) : x-50
                                                         drawtext (x, y, "8" , rgb (0, 255, 0), rgb (0, 0, 0)) : x-50
                                                         drawtext (x, y, "16" , rgb (0, 255, 0), rgb (0, 0, 0)) : x-50
                                                         drawtext (x, y, "32" , rgb (0, 255, 0), rgb (0, 0, 0)) : x-50
                                                        
                                                        y=25 : x=10
                                                         drawtext (x, y, "H" , rgb (0, 255, 0), rgb (0, 0, 0)) :y+50
                                                         drawtext (x, y, "M" , rgb (0, 255, 0), rgb (0, 0, 0)) :y+50
                                                         drawtext (x, y, "S" , rgb (0, 255, 0), rgb (0, 0, 0)) :y+50
                                                        
                                                         drawingfont ( fontid )
                                                        date$ = formatdate ( "%hh:%ii:%ss" , date ())
                                                         ; DrawText(0, -30, date$, RGB(150, 0, 0), RGB(0, 0, 0))
                                                         setwindowtitle ( #window , "Binary Clock " +date$)
                                                        
                                                        heure_dizaine$= mid ( bin ( val ( stringfield (date$,1, ":" ))),1,5)
                                                        minute_dizaine$= mid ( bin ( val ( stringfield (date$,2, ":" ))),1,6)
                                                        seconde_dizaine$= mid ( bin ( val ( stringfield (date$,3, ":" ))),1,6)
                                                        
                                                         ; ++++++++++++++++++++++++++++++++++++++
                                                         ;}
                                                         ;{ affichage de l'heure
                                                         ; ++++++++++ dizaine heur rouge +++++++++
                                                        tableau.S (1)=heure_dizaine$
                                                        tableau.S (2)=minute_dizaine$
                                                        tableau.S (3)=seconde_dizaine$
                                                        
                                                         Restore sprite_rouge
                                                         For o=1 To 3 ; heure,minute,seconde
                                                                 Read y ; lis la coordonée de la ligne
                                                                 Read n ; lis le nombre de bit
                                                                 Read x ; lis coordonée x
                                                                var$=tableau.S (o)
                                                                 For i=1 To n
                                                                         If len (var$)<n
                                                                                var$= "0" +var$
                                                                         EndIf
                                                                         If mid (var$,i,1)= "1"
                                                                                 displaytransparentsprite ( #sprite_rouge ,x,y)
                                                                         EndIf
                                                                        x=x+50
                                                                 Next i
                                                         Next o
                                                         ; ++++++++++++++++++++++++++++++++++++++
                                                         ;} ++++++++++++++++++++++++++++++++++++++
                                                 stopdrawing ()
                                         EndIf
                                 EndIf
                                
                                 ; ; ++++++++++++++++++++++++++++++++++++++
                                 flipbuffers ()
                                 clearscreen ( rgb (0,0,0))
                 EndSelect
         Until Event = #PB_Event_CloseWindow
EndIf
        
        

DataSection
        sprite_rouge:
        Data.i 10,5,100,60,6,50,110,6,50
EndDataSection
Last edited by dobro on Tue Feb 15, 2011 1:28 pm, edited 2 times in total.
Image
Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/
Baldrick
Addict
Addict
Posts: 860
Joined: Fri Jul 02, 2004 6:49 pm
Location: Australia

Re: a binary clock

Post by Baldrick »

Quite cool dobro. I like it. :)
infratec
Always Here
Always Here
Posts: 7623
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: a binary clock

Post by infratec »

Nice, but....

why is always this API stuff used for things which can be done by PB itself and as result you get
a crossworking sourcecode.

Use

Code: Select all

AddWindowTimer()
and the #PB_Event_Timer Event :!:

Best regards,

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

Re: a binary clock

Post by dobro »

infratec wrote:Nice, but....

why is always this API stuff used for things which can be done by PB itself and as result you get
a crossworking sourcecode.
You're right :)
the two codes have been updated :)
Image
Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Re: a binary clock

Post by ts-soft »

Thanks, nice code.
infratec wrote:Nice, but....

why is always this API stuff used for things which can be done by PB itself and as result you get
a crossworking sourcecode.

Use

Code: Select all

AddWindowTimer()
and the #PB_Event_Timer Event :!:

Best regards,

Bernd
For me it is better the time is not stopping on window move.
Only with API and Timercallback can you solve this problem.
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
c4s
Addict
Addict
Posts: 1981
Joined: Thu Nov 01, 2007 5:37 pm
Location: Germany

Re: a binary clock

Post by c4s »

ts-soft wrote:For me it is better the time is not stopping on window move.
Only with API and Timercallback can you solve this problem.
...Or with threads.
If any of you native English speakers have any suggestions for the above text, please let me know (via PM). Thanks!
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Re: a binary clock

Post by ts-soft »

c4s wrote:...Or with threads.
shoot with a sledgehammer? :mrgreen:
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
WilliamL
Addict
Addict
Posts: 1252
Joined: Mon Aug 04, 2008 10:56 pm
Location: Seattle, USA

Re: a binary clock

Post by WilliamL »

Hey Dobro,

Run fine on my Mac (makes it cross-platform) but the numbers are the wrong size (first example). Only the top of the large numbers show up... about the thickness of the top of the '5' (maybe 15 pixels) and I would guess, if the whole number was shown, it would be about 20% of the screen height. It seems odd to me that there would be any size difference between platforms so I don't see what the problem is. Oh, and RGB is switched on Mac's to BGR (don't ask me why) so I see green. :)

You may not want to pursue this, and I don't have time right now either, but I just thought I would report my experience.

Oh, and using 'code' tags would make it easier to copy the code.

[later]
Shouldn't it be #PB_Any? Unfortunately after this change there are only small numbers showing up.

Code: Select all

         fontid = LoadFont (#PB_Any, "Arial Black" , 95, #PB_Font_Bold )
        F2 = LoadFont (#PB_Any, "Arial Black" , 9, #PB_Font_Bold )
and this doesn't appear on the screen (+30 does)

Code: Select all

DrawText (0, -30, date$, RGB (0, 100, 0), RGB (0, 0, 0)) 
oh, and is the colon needed below?

Code: Select all

Restore sprite_bleu:
MacBook Pro-M1 (2021), Sequoia 15.4, PB 6.20
User avatar
dobro
Enthusiast
Enthusiast
Posts: 766
Joined: Sun Oct 31, 2004 10:54 am
Location: France
Contact:

Re: a binary clock

Post by dobro »

WilliamL wrote: Oh, and RGB is switched on Mac's to BGR (don't ask me why) so I see green. :)
the 2 programs above have a green display! ;)
Image
Image

Oh, and using 'code' tags would make it easier to copy the code.
press Ctrl and click on the code 1 time
it selects the frame, then Ctrl + C
and go .... Code or Quote is a same .... ;)

[later]
Shouldn't it be #PB_Any? Unfortunately after this change there are only small numbers showing up.

Code: Select all

         fontid = LoadFont (#PB_Any, "Arial Black" , 95, #PB_Font_Bold )
        F2 = LoadFont (#PB_Any, "Arial Black" , 9, #PB_Font_Bold )
and this doesn't appear on the screen (+30 does)

Code: Select all

DrawText (0, -30, date$, RGB (0, 100, 0), RGB (0, 0, 0)) 
I gave the source, so that you can adapt to your liking :)
oh, and is the colon needed below?

Code: Select all

Restore sprite_bleu:
PureBasic is not embarrassed to letting ":"
after Restore Label

Because ":" can also mean that we will write the end of the line, another statement ;)

the main thing is that the code works :)
Image
Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/
WilliamL
Addict
Addict
Posts: 1252
Joined: Mon Aug 04, 2008 10:56 pm
Location: Seattle, USA

Re: a binary clock

Post by WilliamL »

dobro,

Thanks for the picture. I think you pretty much covered it. I thought it was blue or red because of #sprite_bleu and sprite_rouge constants, anyway, I'm not very familiar with sprites. When I get a chance I'll look at it again.

Thanks for the contribution and I will learn from it about sprites. :)

[later]
I just discovered that fonts over 44 are clipped on the Mac (I think this was reported as a bug). Otherwise the clock is running fine. I'm still learning about sprites and I haven't discovered why they are not showing up. Your picture helps a lot. Too bad I'm on vacation 3,000 miles from home right now! (Key West, Florida) Of course, that would seem to indicate that I would rather program than be on vacation! :shock:
MacBook Pro-M1 (2021), Sequoia 15.4, PB 6.20
User avatar
dobro
Enthusiast
Enthusiast
Posts: 766
Joined: Sun Oct 31, 2004 10:54 am
Location: France
Contact:

Re: a binary clock

Post by dobro »

WilliamL wrote: Of course, that would seem to indicate that I would rather program than be on vacation! :shock:
:lol: first vacation, it's better ;)
Image
Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/
WilliamL
Addict
Addict
Posts: 1252
Joined: Mon Aug 04, 2008 10:56 pm
Location: Seattle, USA

Re: a binary clock

Post by WilliamL »

Ok, I've wasted enough vacation time learning about sprites! This works on my Mac. I sorted out the font and got the binary sprites to show but that doesn't mean I did it right. :)

Back to the beach!

Code: Select all

; by Venom 
; arrangé par Dobro ; 

Global Dim tableau.S (6)
Enumeration
     #sprite_bleu 
     #sprite_rouge 
     #window 
EndEnumeration 

InitSprite ()

If OpenWindow ( #window , 0, 0, 600, 400, "Binary Clock" , #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered )
     OpenWindowedScreen ( WindowID ( #window ),0,0,600,400,1,0,0)
     SetFrameRate (25) 
     fontid = LoadFont (#PB_Any, "Arial Black" , 44 , #PB_Font_Bold ) ; orig 95 clip after 44
        If Not fontid : MessageRequester("Font not loaded...",Str(fontid)) : EndIf
     F2 = LoadFont (#PB_Any, "Arial Black" , 9, #PB_Font_Bold )
    
     ; ********* creation de sprite ************* 
     If CreateSprite ( #sprite_rouge ,55,55)
        If StartDrawing ( SpriteOutput ( #sprite_rouge )) 
            c=1
             For i=27 To 2 Step -2
                     Circle (25, 25, i, RGB (0, c, 0))
                    c=c+10
             Next i 
             StopDrawing ()
         Else
             MessageRequester("Stop","")
         EndIf
     Else
         MessageRequester("Stop","")
     EndIf
    
     CreateSprite ( #sprite_bleu ,50,50)
     StartDrawing ( SpriteOutput (#sprite_bleu ))
             Circle (25, 25, 25, RGB (0, 0, 30))
     StopDrawing ()

     AddWindowTimer ( #window , 123,1000)
     Repeat 
         Event = WaitWindowEvent(2)
         Select Event
         Case#PB_Event_Gadget
         Case #PB_Event_Timer 
             If EventTimer() = 123
                 If StartDrawing ( ScreenOutput())
                    y=320 : x=580 
                     DrawingFont (FontID(F2))
                     DrawText (x, y, "1" , RGB (0, 255, 0), RGB (0, 0, 0)) :y-50 
                     DrawText (x, y, "2" , RGB (0, 255, 0), RGB (0, 0, 0)) :y-50 
                     DrawText (x, y, "4" , RGB (0, 255, 0), RGB (0, 0, 0)) :y-50 
                     DrawText (x, y, "8" , RGB (0, 255, 0), RGB (0, 0, 0)) 
                     DrawingFont ( FontID(fontid) )
                    date$ = FormatDate( "%hh:%ii:%ss" , Date())
                    DrawText (0,30, date$, RGB (0, 100, 0), RGB (0, 0, 0))
                    StopDrawing()
                 EndIf
                    heure_dizaine$= Mid ( Bin ( Val ( Left ( StringField (date$,1, ":" ),1))),1,2) 
                    heure_unite$= Mid ( Bin ( Val ( Right ( StringField (date$,1, ":" ),1))),1,4) 
                    minute_dizaine$= Mid ( Bin ( Val ( Left ( StringField (date$,2, ":" ),1))),1,3)
                    minute_unite$= Mid ( Bin ( Val ( Right ( StringField (date$,2, ":" ),1))),1,4)
                    seconde_dizaine$= Mid ( Bin ( Val ( Left ( StringField (date$,3, ":" ),1))),1,3)
                    seconde_unite$= Mid ( Bin ( Val ( Right ( StringField (date$,3, ":" ),1))),1,4)
                    
                     ;{ ******** dessine le decors ********************** 
                     Restore sprite_bleu
                     ; ++++++++++ dizaine heur bleu +++++++++ 
                     For o=1 To 6
                             Read n
                             Read p
                            y=300
                             For i=1 To n
                              DisplaySprite(#sprite_bleu,p,y)
                                    y-50
                             Next
                         Next
                     ; ++++++++++++++++++++++++++++++++++++++ 
                     ;} 
                     ;{ affichage de l'heure 
                     ; ++++++++++ dizaine heur rouge +++++++++ 
                    tableau.S (1)=heure_dizaine$
                    tableau.S (2)=heure_unite$
                    tableau.S (3)=minute_dizaine$
                    tableau.S (4)=minute_unite$
                    tableau.S (5)=seconde_dizaine$
                    tableau.S (6)=seconde_unite$
                     Restore sprite_rouge
                     For o=1 To 6 
                             Read.i y
                             Read n 
                             Read.i p
                            var$=tableau.S(o)
                             For i=1 To n 
                                     If Len (var$)<n
                                            var$= "0" +var$
                                     EndIf 
                                     If Mid (var$,i,1)= "1" 
                                            DisplaySprite(#sprite_rouge ,p,y)  
                                           ;DisplayTransparentSprite ( #sprite_rouge ,55,55) ; ,p,y)
                                     EndIf 
                                    y=y+50
                             Next i
                     Next o
                     ; ++++++++++++++++++++++++++++++++++++++ 
                     ;} ++++++++++++++++++++++++++++++++++++++ 
             EndIf 
             ; ; ++++++++++++++++++++++++++++++++++++++ 
             FlipBuffers ()
             ClearScreen ( RGB (0,0,0)) 
         EndSelect 
     Until Event = #PB_Event_CloseWindow 
EndIf 

DataSection 
        sprite_bleu:
        Data.i 2,50,4,100,3,250,4,300,3,450,4,500 
        sprite_rouge:
        Data.i 250,2,50,150,4,100,200,3,250,150,4,300,200,3,450,150,4,500 
EndDataSection 
MacBook Pro-M1 (2021), Sequoia 15.4, PB 6.20
luciano
Enthusiast
Enthusiast
Posts: 151
Joined: Wed Mar 09, 2011 8:25 pm

Re: a binary clock

Post by luciano »

I liked your binary clock so much, it made me go back to when I programmed in Fortran using punchcards; so little by little I added graphics and a simple game.
Since I am a newbie in PB, every advice is really important to me.
At present I tested this game on different machines and I got no problem, but a friend of mine sees just a white window: he uses Seven 64bit; i could not understand why.

The whole kit (graphics, sounds, etc.) is available at:
http://www.digital.sm/com/Purebasic_Clock_Game.zip

Code: Select all

; by Venom
; arrangé par Dobro ;
; game added by Luciano

Global Dim tableau.S (6)
Enumeration
  #sprite_spento
  #sprite_acceso
  #window
  #sprite_fondo
  
  #pallina
  
  #pallina_N
  #pallina_NE
  #pallina_E
  #pallina_SE
  #pallina_S
  #pallina_SW
  #pallina_W
  #pallina_NW
  #pad
  #punchcard

  ;-----suoni
  #hit
  #miss
  #hop
  #slip
  
EndEnumeration

UsePNGImageDecoder() 

;InitKeyboard()

;InitSprite ()

pall_x=0
pall_y=200
speed_x=4
speed_y=Random(3)+2
pad_x=200
automatic=1
punchcard=0
Punchcard_Position_y=250
Punchcard_Position_x=8
UseSound=0

;If UseSound
 If InitSound()=0 
  MessageRequester("Error","Failed to Initialize Sound Environment"+#CRLF$+"(Use WITHOUT Audio)",#MB_ICONERROR)
    End
  EndIf 
;EndIf
If InitSprite()=0 Or InitKeyboard()=0 
  MessageRequester("Error","Failed to Initialize DirectX "+#CRLF$+"(program unusable)",#MB_ICONERROR)
  End
EndIf

  CatchSound(#hit,?hit)
  CatchSound(#miss,?miss)
  CatchSound(#hop,?hop)
  CatchSound(#slip,?slip)
  

If OpenWindow ( #window,0,0,400,450,"Binary Clock Game ",#PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered )
  If OpenWindowedScreen ( WindowID ( #window ),0,0,400,450,1,0,0)=0: MessageRequester("Error" ,"Windowed screen error!") : EndIf
  
  SetFrameRate (75)
  fontid = LoadFont (#PB_Any, "Arial" , 44 , #PB_Font_Bold )
  If Not fontid : MessageRequester("Font not loaded...",Str(fontid)) : EndIf
  F2 = LoadFont (#PB_Any, "Arial" , 8, #PB_Font_Bold )
  
  CatchSprite(#sprite_acceso, ?acceso)
  CatchSprite(#sprite_spento, ?spento)
  CatchSprite(#sprite_fondo, ?fondo)
  
  CatchSprite(#pallina, ?pallina_N)
  
  CatchSprite(#pallina_N, ?pallina_N)
  CatchSprite(#pallina_NE, ?pallina_NE)
  CatchSprite(#pallina_E, ?pallina_E)
  CatchSprite(#pallina_SE, ?pallina_SE)
  CatchSprite(#pallina_S, ?pallina_S)
  CatchSprite(#pallina_SW, ?pallina_SW)
  CatchSprite(#pallina_W, ?pallina_W)
  CatchSprite(#pallina_NW, ?pallina_NW)
  CatchSprite(#pad, ?pad)
  CatchSprite(#punchcard, ?punchcard)  

  
  Repeat
    
    
    Event = WaitWindowEvent(10)
    If GetWindowState(#Window)=#PB_Window_Minimize: event=WaitWindowEvent(100):EndIf
    
    
    If #True
      If StartDrawing ( ScreenOutput())
        DrawingFont (FontID(F2))      
        DrawText (0, 0, "A:Automatic, S/N:Sound/No sound, P:Play; Move with left/right keys" , RGB (0, 80, 0), RGB (0, 22, 0)) 
        
        y=320 : x=377
        
        DrawText (x, y, "1" , RGB (0, 180, 0), RGB (0, 0, 0)) :y-50
        DrawText (x, y, "2" , RGB (0, 180, 0), RGB (0, 0, 0)) :y-50
        DrawText (x, y, "4" , RGB (0, 180, 0), RGB (0, 0, 0)) :y-50
        DrawText (x, y, "8" , RGB (0, 180, 0), RGB (0, 0, 0)):y-50
        DrawText (x, y, "16" , RGB (0, 180, 0), RGB (0, 0, 0)):y-50
        
        DrawText (x, y, "32" , RGB (0, 180, 0), RGB (0, 0, 0))
        
        DrawingFont ( FontID(fontid) )
        date$ = FormatDate( "%hh:%ii:%ss" , Date())
        DrawText (0,360," ora: "+ date$+"   ", RGB (0, 130, 0), RGB (0, 0, 0))
        ;                     
        heure$ =Bin(Hour(Date()),#PB_Byte   )
        minute$=Bin(Minute(Date()))
        seconde$=Bin(Second(Date()))
        
        
        ;{ ******** dessine le decors **********************
        Restore sprite_off
        ; ++++++++++ dizaine heure  (off) +++++++++
        For o=1 To 3 
          Read n
          Read p
          y=300
          For i=1 To n
            DisplayTransparentSprite(#sprite_spento,p,y+15)
            y-50
          Next
        Next
        ; ++++++++++++++++++++++++++++++++++++++
        ;}
        ;{ affichage de l'heure
        ; ++++++++++ dizaine heure (on) +++++++++
        tableau.S (1)=heure$
        
        tableau.S (2)=minute$
        
        tableau.S (3)=seconde$
        
        Restore sprite_on
        For o=1 To 3 
          Read.i y
          Read n
          Read.i p
          var$=tableau.S(o)
          For i=1 To n
            If Len (var$)<n
              var$= "0" +var$
            EndIf
            If Mid (var$,i,1)= "1"
              DisplayTransparentSprite(#sprite_acceso ,p,y+15) 
              If SpritePixelCollision(#pallina, pall_x, pall_y, #sprite_acceso, p, y+15)
                If UseSound: PlaySound(#hit,0,Random(60)+40):EndIf
                speed_x=-speed_x+Random(2)-1 ;speed_x= speed_x +Random(4):
                
                If pall_x<=p: pall_x-7:EndIf
                If pall_x>=p: pall_x+7:EndIf
                
                speed_y=-speed_y+Random(2)-1
                
                If pall_y<=y+15: pall_y-7:EndIf
                If pall_y>y+15: pall_y+7:EndIf
                
              EndIf
            EndIf
            y=y+50
          Next i
        Next o
        ; ++++++++++++++++++++++++++++++++++++++
        ;} ++++++++++++++++++++++++++++++++++++++
        
        
        ;----------- Punchcard
        If Random(32)>30:punchcard=1:EndIf
        If Random(32)>31:punchcard=0:Punchcard_Position_y=Random(250)+70:Punchcard_Position_x=Random(50):EndIf
        
        
        If punchcard
          DisplayTransparentSprite(#punchcard ,Punchcard_Position_x,Punchcard_Position_y)
        EndIf
        
        
        
        ;---------- pallina
        
        pall_x+speed_x;+speed_x
        pall_y+speed_y;+speed_y
        If pall_x<=0: speed_x=Abs(speed_x):pall_x=0:speed_y+Random(2)-1:EndIf
        If pall_x>384: speed_x=-Abs(speed_x):pall_x=384:speed_y+Random(2)-1:EndIf
        
        If pall_y<=0: speed_y=Abs(speed_y):pall_y=0:speed_x+Random(2)-1:EndIf
        If pall_y>500
          If pall_y<650:EndTime=ElapsedMilliseconds()
          If UseSound: StopSound(-1):PlaySound(#miss,0):EndIf
            
          EndIf
          pall_y=700
          speed_x=4
          speed_y=Random(3)+2
          ;Debug pall_y
          DrawingFont (FontID(F2)) 
          DrawText (0, 16, "MISSED! Press A or P to start again" , RGB (0, 120, 0), RGB (0, 22, 0)) 
          DrawText (0, 32, "POINTS: "+Str((EndTime-StartTime)/100)+".dec = "+RSet(Bin((EndTime-StartTime)/100), 16, "0")+".bin = "+RSet(Hex((EndTime-StartTime)/100), 4, "0")+".hex" ,RGB (100, 120, 0), RGB (0, 22, 0)) 
          
        EndIf
        ExamineKeyboard()
        
        If speed_x>6:speed_x-Random(1):EndIf
        If speed_y>6:speed_y-Random(1):EndIf
        If speed_x<-6:speed_x+Random(1):EndIf
        If speed_y<-6:speed_y+Random(1):EndIf
        
        If speed_x=0:speed_x=Random(4)-2:EndIf
        If speed_y=0:speed_y=Random(4)-2:EndIf
        ;Debug speed_x
        ;Debug speed_y
        CopySprite(#pallina_N, #pallina)
        
        If speed_y>0:CopySprite(#pallina_S,#pallina):EndIf
        
        If speed_x>0
          
          CopySprite(#pallina_E, #pallina)
          If speed_y>0
            CopySprite(#pallina_SE, #pallina)
            If speed_x/speed_y>3:CopySprite(#pallina_E, #pallina):EndIf
            If (speed_x+speed_x)/speed_y=0:CopySprite(#pallina_S, #pallina):EndIf            
          EndIf
          If speed_y<0
            CopySprite(#pallina_NE, #pallina)
            If speed_x/speed_y<-3:CopySprite(#pallina_E, #pallina):EndIf
            If (speed_x+speed_x)/speed_y=0:CopySprite(#pallina_N, #pallina):EndIf 
            
          EndIf
          
        EndIf
        
        
        If speed_x<0 
          
          CopySprite(#pallina_W, #pallina)
          If speed_y>0
            CopySprite(#pallina_SW, #pallina)
            If speed_x/speed_y<-3:CopySprite(#pallina_W, #pallina):EndIf
            If (speed_x+speed_x)/speed_y=0:CopySprite(#pallina_S, #pallina):EndIf            
            
          EndIf
          If speed_y<0
            CopySprite(#pallina_NW, #pallina)
            If speed_x/speed_y>3:CopySprite(#pallina_W, #pallina):EndIf
            If (speed_x+speed_x)/speed_y=0:CopySprite(#pallina_N, #pallina):EndIf           
          EndIf
          
        EndIf
      
        ;------------- Pad
        
        If automatic
          pad_x=pall_x
          
        Else
          If KeyboardPushed(#PB_Key_Left)
            If pad_x>20:pad_x-10:EndIf  
          EndIf
          
          If KeyboardPushed(#PB_Key_Right)
            If pad_x<361:pad_x+10:EndIf  
          EndIf
          
        EndIf
        
        If KeyboardPushed(#PB_Key_A)
          pall_x=0
          pall_y=200
          speed_x=4
          speed_y=Random(3)+2
          pad_x=200
          automatic=1
        EndIf
        
        If KeyboardPushed(#PB_Key_P)
          StartTime = ElapsedMilliseconds() 
          pall_x=0
          pall_y=200
          speed_x=4
          speed_y=Random(3)+2
          pad_x=200
          automatic=0
        EndIf
        If KeyboardPushed(#PB_Key_S)
        UseSound=1  
        EndIf
        If KeyboardPushed(#PB_Key_N)
        UseSound=0  
        EndIf
        
        
        DisplaySprite(#pad ,pad_x-30,440)
        If SpriteCollision(#pallina, pall_x, pall_y, #pad, pad_x-30, 440)
       
          speed_y=-Abs(speed_y):pall_y-4-Random(2):speed_x+Random(2)-1 
          If UseSound:StopSound(-1):PlaySound(#hop,0,Abs(speed_y*10)):EndIf
        EndIf
        
        If punchcard=1 And SpriteCollision(#pallina, pall_x, pall_y, #punchcard, Punchcard_Position_x, Punchcard_Position_y)>0
          If UseSound:PlaySound(#slip,0,Abs(speed_y*10)):EndIf
          If speed_y>3: speed_y=3:EndIf
 
        EndIf
                DisplayTransparentSprite(#pallina ,pall_x,pall_y)
        
        exit:
        StopDrawing()
        FlipBuffers ()
        DisplaySprite(#sprite_fondo ,0,0)   
        
      EndIf
    EndIf
    ; ; ++++++++++++++++++++++++++++++++++++++
    
    ;EndSelect
  Until Event = #PB_Event_CloseWindow
EndIf

DataSection
  sprite_off:
  Data.i 5,150,6,240,6,330
  sprite_on:
  Data.i 100,5,150,50,6,240,50,6,330
EndDataSection 



End

acceso: IncludeBinary "acceso.png"
spento: IncludeBinary "spento.png"
fondo: IncludeBinary "fondo.png"
pallina_N: IncludeBinary "x_n.png" 
pallina_NE: IncludeBinary "x_ne.png"
pallina_E: IncludeBinary "x_e.png"
pallina_SE: IncludeBinary "x_se.png"
pallina_S: IncludeBinary "x_s.png"
pallina_SW: IncludeBinary "x_sw.png"
pallina_W: IncludeBinary "x_w.png"
pallina_NW: IncludeBinary "x_nw.png" 
pad: IncludeBinary "pad.png" 
punchcard: IncludeBinary "punchcard.png"

 hit: IncludeBinary "lightswitch1_mono.wav"
 miss:IncludeBinary "cartoon3.wav"
 hop:IncludeBinary "pop.wav"
 slip:IncludeBinary "ping.wav"
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: a binary clock

Post by Kwai chang caine »

@LUCIANO
Splendid :shock:
ImageThe happiness is a road...
Not a destination
Post Reply