Module: Simulate date/time for games or whatever

[DK_PETER]

Code: Select all

;Game date/time Example - Dayname, DayOfWeek, DayOfYear and time (hh:ss).
;By DK_PETER
DeclareModule _Time
  Structure _DateData
    day.i
    hour.i
    mins.i
    sday.s
    sHour.s
    sMins.s
    sDaynum.i
    sDayName.s
  EndStructure
  
  Global hs._DateData
  Declare.i SetStartTime(*hs._DateData)
  Declare.i StartTime()
  Declare.i GetTime(*hs._DateData)
  Declare.i StopTime()
  Declare.i PauseTime()
  Declare.i ChangeSpeedTime(ms.i = 1000)
  Declare.i DayNames(DayList.s = "Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday")
EndDeclareModule

Module _Time
  
  Declare.i Begin(v.i)
  Global  thr.i, BaseSec.i = 1000, PauseTime.i = #False, StopThread.i = #False
  Global Dim Days.s(0)
  
  Procedure.i SetStartTime(*hs._DateData)
    hs\day = *hs\day
    hs\hour = *hs\hour
    hs\mins = *hs\mins
    hs\sday = *hs\sday
    hs\sHour = *hs\sHour
    hs\sMins = *hs\sMins
    hs\sHour = RSet(Str(*hs\Hour), 2,"0")
    hs\sMins = RSet(Str(*hs\mins), 2, "0")
  EndProcedure
  
  Procedure.i ChangeSpeedTime(ms.i = 1000)
    BaseSec = ms
  EndProcedure
  
  Procedure.i DayNames(DayList.s = "Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday")
    Protected x.i, num.i = CountString(DayList,",")
    ReDim Days(num)
    For x = 0 To num
      Days(x) = StringField(DayList, x+1, ",")
    Next x
  EndProcedure
  
  Procedure.i IncTime()
    If hs\mins + 1 > 59
      hs\mins = 0
      If hs\hour + 1 > 23
        hs\hour = 0
        If hs\day + 1 > 365
          hs\day = 1
          If hs\sDaynum + 1 > ArraySize(Days()) : hs\sDaynum = 0 : Else : hs\sDaynum + 1 : EndIf
        Else
          hs\day + 1
          If hs\sDaynum + 1 > ArraySize(Days()) : hs\sDaynum = 0 : Else : hs\sDaynum + 1 : EndIf
        EndIf
      Else
        hs\hour + 1
      EndIf
    Else
      hs\mins + 1
    EndIf
    
    hs\sHour = RSet(Str(hs\Hour), 2,"0")
    hs\sMins = RSet(Str(hs\mins), 2, "0")
  EndProcedure
  
  Procedure.i GetTime(*hs._DateData)
    *hs\day = hs\day
    *hs\hour = hs\hour
    *hs\mins = hs\mins
    *hs\sday = hs\sday
    *hs\sHour = hs\sHour
    *hs\sMins = hs\sMins
    *hs\sDaynum = hs\sDaynum
    *hs\sDayName = Days(hs\sDaynum)
    ProcedureReturn #True
  EndProcedure
  
  Procedure.i StartTime() 
    StopThread = #False
    thr = CreateThread(@Begin(), #False)
  EndProcedure
  
  Procedure.i PauseTime()
    PauseTime ! 1
  EndProcedure
  
  Procedure.i Begin(v.i)
    Protected elap.q = ElapsedMilliseconds()
    StopThread = v
    Repeat
      If PauseTime = #False
        If ElapsedMilliseconds()-elap >= BaseSec
          IncTime()
          elap = ElapsedMilliseconds()
        EndIf
      EndIf
      Delay(1) ;edit...
    Until StopThread = #True
  EndProcedure
  
  Procedure.i StopTime()
    StopThread = #True
  EndProcedure
EndModule

;------Example-------

CompilerIf #PB_Compiler_Thread = 0
  MessageRequester("Threading is off", "Threadsafe must checked!")
  End
CompilerEndIf

Declare.i Pausing()
Declare.i Change()
Global slide, pause, hs._Time::_DateData

OpenWindow(0, 0, 0, 400, 60, "Time simulation", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
CanvasGadget(0, 0, 0, 300, 35)
pause = ButtonGadget(#PB_Any, 301, 0, 99, 60, "Pause")
slide = TrackBarGadget(#PB_Any, 0, 40, 300, 20, 25, 1000)
GadgetToolTip(slide, "Slide to shange date/time speed")
BindGadgetEvent(pause, @Pausing())
BindGadgetEvent(slide, @Change())

hs\day = 100 ; Day of year
hs\hour = 23 ; 
hs\mins = 52
hs\sDaynum = 2 ;Day of week - set as second day (Tuesday)
_Time::DayNames("Elenya,Anarya,Isilya,Aldúya,Menelya,Valanya,Selenia") ;Elvish... :-)
_Time::ChangeSpeedTime(50) ;How fast it runs in ms.
_Time::SetStartTime(hs)
_Time::StartTime()

Repeat
  ev = WindowEvent()
  _Time::GetTime(hs)
  StartDrawing(CanvasOutput(0))
  Box(0, 0, 300, 35, $FFFFFF)
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawText(5, 1, "Day name: " + hs\sDayName + " - Day of year: " + hs\day , $000000)
  DrawText(5, 20, "Day Of Week: " + hs\sDaynum + " - Time " + hs\shour + ":" + hs\sMins, $000000)
  StopDrawing()
Until ev = #PB_Event_CloseWindow

Procedure.i Pausing()
  _Time::PauseTime()  
EndProcedure

Procedure.i Change()
  _Time::ChangeSpeedTime(GetGadgetState(slide))
EndProcedure

[Sicro]

Great idea!

Code: Select all

Repeat
  ev = WindowEvent()
  _Time::GetTime(hs)
  StartDrawing(CanvasOutput(0))
  [...]
  StopDrawing()
Until ev = #PB_Event_CloseWindow

The loop runs too fast, so that the "Pause" button and the slider no longer work under Linux.
In addition, the window can't be closed using the "X" button.

That way you could solve the problem:

Code: Select all

DeclareModule _Time
  #Time_TickEvent = #PB_Event_FirstCustomValue
  [...]
EndDeclareModule

Code: Select all

Procedure.i IncTime()
  [...]
  PostEvent(#Time_TickEvent)
EndProcedure

Code: Select all

Repeat
  ev = WaitWindowEvent()
  If ev = _Time::#Time_TickEvent
    _Time::GetTime(hs)
    StartDrawing(CanvasOutput(0))
    [...]
    StopDrawing()
  EndIf
Until ev = #PB_Event_CloseWindow

Or you use a callback procedure instead of PostEvent.

[Mijikai]

Nice thx for sharing

[davido]

@DK_PETER ,
A very nice example.
Thank you for sharing it.