Fix my geeky clock!

[firace]

Here's a little fullscreen clock made of random hex numbers.

Questions:
1- how to make it continuously update the display? right now it's static.
2- how to ensure it's properly centered regardless of screen resolution?
3- do you like it? feel free to add cool effects or features.

Sorry for the messy, messy code. It's just an experiment....

Code: Select all

ExamineDesktops() : screenwidth=DesktopWidth(0)  : screenheight=DesktopHeight(0)

Global f$ ;  (79*23)

Procedure.s BuildPixelString(String$, Char$="*", Length.i=0, font.i=#PB_Ignore)   ;;; by infratec 
  Protected Result$, Line$
  Img = CreateImage(#PB_Any, 1, 1)
  StartDrawing(ImageOutput(Img))
  DrawingFont(FontID(font)) 
  StringWidth = TextWidth(String$)
  StringHeight = TextHeight(String$)
  StopDrawing()
  
  Img = CreateImage(#PB_Any, StringWidth, StringHeight)
  StartDrawing(ImageOutput(Img))
  DrawingFont(FontID(font)) 
  DrawText(1, 0, String$, $FFFFFF)
  For y = 0 To StringHeight - 1
    Line$ = ""
    For x = 0 To StringWidth - 1
      If Point(x, y) = 0
        Line$ + " "
      Else
        Line$ + Char$
      EndIf
    Next x
    If Length
      Line$ = LSet(Line$, Length, " ")
    EndIf
    Result$ + Line$ + #CRLF$
  Next y
  StopDrawing()
  ProcedureReturn Result$
EndProcedure

Procedure pixelON(X,Y)
  ProcedureReturn Asc(Mid(f$,Y*79+X,1))
EndProcedure


LoadFont(0, "Consolas", 16)

now$ = " " + FormatDate("%hh:%ii",Date())
f$ = BuildPixelString(now$, "*", 79, 0)  ;;   Disclosure
f$ = RemoveString(f$, #CRLF$)



InitSprite() : OpenCryptRandom()
Define.i DefSize=66*24, C = $52BF52 + $111111, Cellsize = 16, Quit = 0

OpenWindow(0, 0, 0, screenwidth, screenheight, "DigitOcean", #PB_Window_BorderLess | #PB_Window_Invisible )
OpenWindowedScreen(WindowID(0),0,0,screenwidth,screenheight,1,0,0)
CreateSprite(0, screenwidth, screenheight, #PB_Sprite_AlphaBlending)

LoadFont(9,"Consolas",10)
StartDrawing(SpriteOutput(0)) : DrawingFont(FontID(9)) 
DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Gradient | #PB_2DDrawing_Transparent )

For a = 0 To DefSize-Cellsize Step 16
  For b = 0 To DefSize-Cellsize Step 16
    ;       color = random(C)*1.3+(a+b)*3
    color = C*0.8 + Random ((a+b)*8)
    ;       BackColor(RGBA(Red(color)-$23, Green(color)-$23, Blue(color)-$23, 255))
    FrontColor(RGBA(Red(color)-$23, Green(color)-$23, Blue(color)-$23, 190))
    ;       LinearGradient(a, b, a+30, b+30) 
    
    If PixelON(a/16,b/16) = 42 : DrawText(a+1,b+1+132, RSet(Hex(CryptRandom(255)),2,"0") ) : EndIf
    
    
  Next 
Next   
StopDrawing()  : HideWindow(0,0)

Repeat 
  Repeat
    ev = WindowEvent()
    If EventwParam() = #VK_ESCAPE : Quit = 1 : EndIf
    If ev = #PB_Event_CloseWindow : Quit = 1 : EndIf
  Until ev = 0
  
  DisplaySprite(0, 0, -4)
  FlipBuffers()
Until Quit = 1

[ar-s]

You have to use a timer to make a simple clock.
I haven't time to examine your code but i prefere using openscreen with an openwindowscreen inside.

Here is a small examplein a window to use timer. Count 10 to 0 in the windowtitle.
Bindevent is good to not freeze the counter when you move the window

I hope that will help you.

Code: Select all

Global DureeSec = 10

Procedure TimerEvent()
  DureeSec -1
  SetWindowTitle(0, Str(DureeSec))  
  If DureeSec <= 0
    SetWindowTitle(0, "FINISH")
  EndIf
EndProcedure



If OpenWindow(0, 0, 0, 220, 121, "10", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  AddWindowTimer(0,3,1000)
  BindEvent(#PB_Event_Timer, @TimerEvent()) ; Le BindEvent te permet de déplacer ta fenêtre tout en maintenant le comptage, (c'est l’intérêt du callback BindEvent)
EndIf

Repeat
  Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow

UnbindEvent(#PB_Event_Timer, @TimerEvent())

[infratec]

Hi,

Code: Select all

EnableExplicit


Procedure.s BuildPixelString(String$, Char$="*", font.i=#PB_Ignore, *Size.Point=#Null)   ;;; by infratec
  
  Protected Result$, Line$, Img.i, StringWidth.i, StringHeight.i, y.i, x.i
  
  
  Img = CreateImage(#PB_Any, 1, 1)
  If Img
    If StartDrawing(ImageOutput(Img))
      DrawingFont(FontID(font))
      StringWidth = TextWidth(String$)
      StringHeight = TextHeight(String$)
      StopDrawing()
      FreeImage(Img)
      
      If *Size <> #Null
        *Size\x = StringWidth
        *Size\y = StringHeight
      EndIf
      
      Img = CreateImage(#PB_Any, StringWidth, StringHeight)
      If Img
        If StartDrawing(ImageOutput(Img))
          DrawingFont(FontID(font))
          DrawText(0, 0, String$, $FFFFFF)
          For y = 0 To StringHeight - 1
            Line$ = ""
            For x = 0 To StringWidth - 1
              If Point(x, y) = 0
                Line$ + " "
              Else
                Line$ + Char$
              EndIf
            Next x
            Line$ = LSet(Line$, StringWidth, " ")
            Result$ + Line$ + #CRLF$
          Next y
          StopDrawing()
        EndIf
        FreeImage(Img)
      EndIf
    EndIf
  EndIf
  
  ProcedureReturn Result$
  
EndProcedure




Procedure.s pixelON(f$, X, Y)
  
  ProcedureReturn Mid(StringField(f$, Y + 1, #CRLF$), X + 1, 1)
  
EndProcedure



Procedure.i BuildSprite(FillFont.i, ClockFont.i, CreateIt.i=#False)
  
  Protected Now$, f$
  Protected.i DefSize, C, x, y, color, StringWidth, StringHeight, Img
  Protected StringSize.Point
  Static Sprite.i
  Static LastTime$
  
  
  Now$ = FormatDate("%hh:%ii", Date())
  If Now$ <> LastTime$
    
    C = $52BF52 + $111111
    
    f$ = BuildPixelString(now$, "*", ClockFont, @StringSize)  ; Disclosure
    ;Debug f$
    ;Debug Str(StringSize\x) + " " + Str(StringSize\y)
    
    If CreateIt
      Img = CreateImage(#PB_Any, 1, 1)
      If Img
        If StartDrawing(ImageOutput(Img))
          DrawingFont(FontID(FillFont))
          StringWidth = TextWidth("00")
          StringHeight = TextHeight("*")
          StopDrawing()
        EndIf
        FreeImage(Img)
      EndIf
      
      Sprite = CreateSprite(#PB_Any, StringWidth * StringSize\x, StringHeight * StringSize\y, #PB_Sprite_AlphaBlending)
    EndIf
    
    If StartDrawing(SpriteOutput(Sprite))
      Box(0, 0, SpriteWidth(Sprite), SpriteHeight(Sprite), 0)
      DrawingFont(FontID(FillFont))
      
      StringWidth = TextWidth(" ")
      StringHeight = TextHeight(" ")
      
      ;Debug Str(StringWidth) + " " + Str(StringHeight)
      
      DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Gradient | #PB_2DDrawing_Transparent )
      
      For y = 0 To StringSize\y - 1
        For x = 0 To StringSize\x - 1
          color = C*0.8 + Random ((x + y) * 64)
          ;FrontColor(RGBA(Red(color) - $23, Green(color) - $23, Blue(color) - $23, 190))
          ;FrontColor(RGBA(Red(color), Green(color), Blue(color), 190))
          FrontColor(RGBA((Red(color) - $23) & $FF, (Green(color) - $23) & $FF, (Blue(color) - $23) & $FF, 190))
          If PixelON(f$, x, y) = "*"
            DrawText(x * StringWidth * 2, y * StringHeight, RSet(Hex(CryptRandom(255)), 2, "0"))
          EndIf
          
        Next
      Next
      StopDrawing()
    EndIf
    
    LastTime$ = Now$
    
  EndIf
  
  ProcedureReturn Sprite
  
EndProcedure




Define.i ScreenWidth, ScreenHeight, ev, Quit, Sprite

ExamineDesktops()

ScreenWidth = DesktopWidth(0)
ScreenHeight = DesktopHeight(0)

InitSprite()
OpenCryptRandom()

OpenWindow(0, 0, 0, screenwidth, screenheight, "", #PB_Window_BorderLess | #PB_Window_Invisible)
OpenWindowedScreen(WindowID(0), 0, 0, screenwidth, screenheight, 1, 0, 0)

LoadFont(16, "Consolas", 16)
LoadFont(10, "Consolas", 10)

Sprite = BuildSprite(10, 16, #True)

HideWindow(0, #False)

AddWindowTimer(0, 0, 1000)

Repeat
  Repeat
    ev = WindowEvent()
    Select ev
      Case #PB_Event_Timer
        If EventTimer() = 0
          BuildSprite(10, 16)
        EndIf
      Case #PB_Event_CloseWindow
        Quit = #True
    EndSelect
    If EventwParam() = #VK_ESCAPE : Quit = #True : EndIf
  Until ev = 0
  
  DisplaySprite(Sprite, (ScreenWidth - SpriteWidth(Sprite)) / 2, (ScreenHeight - SpriteHeight(Sprite)) / 2)
  FlipBuffers()
Until Quit

Bernd

[firace]

Thanks infratec, that's just fantastic, once again!!

[ar-s]

Much funier with sec :

Code: Select all

;L75
Now$ = FormatDate("%hh:%ii:%ss", Date())

[dige]

@firace: Cool thing!

[ar-s]

If you wanna Add some moves
replace end code by

Code: Select all

  Until ev = 0
  
  XsMin = 0
  XsMax = (ScreenWidth - SpriteWidth(0))
  YsMax = ScreenHeight - SpriteHeight(0)
   
  If Xs > XsMax-1
    ClearScreen(0)
    Ys = Random (YsMax)
    DirXs-3
  ElseIf Xs < Xmin+1
    ClearScreen(0)
    Ys = Random (YsMax)
    DirXs+3
  EndIf
  
    Xs + DirX

  DisplaySprite(0, Xs, Ys)
  FlipBuffers()

[infratec]

Hi,

fixed a few bugs in my code above:

1. Removed the + 1 at the CreateSprite() call (it was a 'bug fix')
2. Added -1 for both For loops in BuildSprite()
3. Added + 1 for X in pixelON()
4. Changed 1 to 0 in Drawtext() at BuildPixelString() which cause a missing pixel at the end.

Now I'm satisfied

Bernd

[dige]

@Bernd: Seems, the coloration does not work correctly with x64.

[infratec]

Hi dige,

I'm not the developer of this peace of code, but ...

Code: Select all

Debug Hex(RGBA(-1, 20, 20, 255))

Returns FFFFFFFFFFFFFFFF with PB x64
and FFFFFFFFFF1413FF with PB x86

looks like a bug for me.

For the clock I removed now the - $23 at the FrontColor line.
So the value can not be negative.

Bernd

[infratec]

Added an other solution to make the color identical to the original code.