Kind of cycle manager udt

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
Tourist Trap
Posts: 2768
Joined: Jun 02, 2015 16:24

Kind of cycle manager udt

Postby Tourist Trap » Dec 20, 2016 0:17

It's simply something like dodicat's regulate function but in a more customizable way in my opinion, because a udt keeps track of as much data as necessary (like here the whole average time the cycles take time over the whole execution).
Maybe it comes with bugs but I've tested it on xp win32 and found nothing wrong.

Important for any people who doesn't know, a property like CurrentCycleEllapsedTime can be accessed as if it was static (not from an instance but from the shared generic object) if accessed from a null pointer to the udt (at least in 1.05 and previous versions). This pointer is provided as a static member itself here. Ok, its just in case.

Code: Select all

'*********************************************
'**** kind of cycle regulator/manager udt ****
'*********************************************

'comment/uncomment next define to turn OFF/ON debug macros
'#define      _debug
#ifDef      _debug
   #define      _dbg
   #macro      _PS(debugStringInfo)
      ? "dbg>";
      _INVERTCOLORDURINGINSTRUCTION(? #debugStringInfo)
   #endMacro
   #macro      _PSC(colourName, debugStringInfo ...)
      ? "dbg>";
      _RECOLOREDINVERTINSTRUCTION(colourName, ? #debugStringInfo)
   #endMacro
   #macro      _PV(variableString)
      ? "dbg>";
      _INVERTCOLORDURINGINSTRUCTION(? #variableString &"= "; variableString)
   #endMacro
#else
   #define      _dbg
   #define      _PS(debugStringInfo)
   #define      _PSC(colourName, debugStringInfo ...)
   #define      _PV(variableString)
#endIf
#macro _INVERTCOLORDURINGINSTRUCTION(singleLineInstruction)
   scope
      scope
         dim as ulong   initialScreenForegroundColor   => any
         dim as ulong   initialScreenBackgroundColor   => any
         select case screenPtr()
            case 0
               var c   => color()
               initialScreenForegroundColor = loWord(c)
               initialScreenBackgroundColor = hiWord(c)
            case else
               screenControl 13, _
                           initialScreenForegroundColor, _
                           initialScreenBackgroundColor
         end select
         color initialScreenBackgroundColor, initialScreenForegroundColor
         singleLineInstruction
         color initialScreenForegroundColor, initialScreenBackgroundColor
      end scope
   end scope
#endMacro
#macro _RECOLOREDINVERTINSTRUCTION(colourName, singleLineInstruction ...)
   scope
      scope
         dim as ulong   initialScreenForegroundColor   => any
         dim as ulong   initialScreenBackgroundColor   => any
         var colourDepth   => -1
         select case screenPtr()
            case 0
               var c   => color()
               initialScreenForegroundColor = loWord(c)
               initialScreenBackgroundColor = hiWord(c)
            case else
               screenControl 13, _
                           initialScreenForegroundColor, _
                           initialScreenBackgroundColor
               screenInfo , , colourDepth
         end select
         var colourId   => #colourName
         var foreColour   => initialScreenForegroundColor
         var backColour   => initialScreenBackgroundColor
         select case trim(lCase(colourId))
            case "green"
               select case colourDepth
                  case 8
                     foreColour   = 10
                     backColour   = 02
                  case 16
                     foreColour   = rgb(000,255,000)
                     backColour   = rgb(000,000,125)
                  case 24
                     foreColour   = rgb(000,255,000)
                     backColour   = rgb(000,125,000)
                  case 32
                     foreColour   = rgb(000,255,000)
                     backColour   = rgb(000,125,000)
               end select
            case "red"
               select case colourDepth
                  case 8
                     foreColour   = 12
                     backColour   = 04
                  case 16
                     foreColour   = rgb(255,000,000)
                     backColour   = rgb(125,000,000)
                  case 24
                     foreColour   = rgb(255,000,000)
                     backColour   = rgb(125,000,000)
                  case 32
                     foreColour   = rgb(255,000,000)
                     backColour   = rgb(125,000,000)
               end select
            case "blue"
               select case colourDepth
                  case 8
                     foreColour   = 11
                     backColour   = 03
                  case 16
                     foreColour   = rgb(000,255,255)
                     backColour   = rgb(000,125,125)
                  case 24
                     foreColour   = rgb(000,255,255)
                     backColour   = rgb(000,125,125)
                  case 32
                     foreColour   = rgb(000,255,255)
                     backColour   = rgb(000,125,125)
               end select
            case else
               '
         end select
         '
         color foreColour, backColour
         singleLineInstruction
         color initialScreenForegroundColor, initialScreenBackgroundColor
      end scope
   end scope
#endMacro

'--------------------------------------------------------------------CYCLEMANAGER
type CYCLEMANAGER extends OBJECT
   declare property CurrentCycleEllapsedTime() as double
   declare static function StartCycle() as uinteger
   declare static function EndCycle() as uinteger
   declare static function GetCycleEllapsedTime() as uinteger
   static as CYCLEMANAGER ptr   nullObjectStaticPropertyAccessor
   static as uinteger<64>      currentCycleIndex
   static as uinteger<64>      cycleCountMaxvalue
   static as boolean         hasCycleStarted
   static as boolean         hasCycleEnded
   static as boolean         hasReachedMaxvalue
   static as double         cycleStartTime
   static as double         cycleEndTime
   static as double         endedCycleEllapsedTime
   static as double         lastCycleDuration
   static as double         meanCycleDuration
end type
type CYCMAN      as CYCLEMANAGER
dim as CYCMAN ptr      CYCMAN.nullObjectStaticPropertyAccessor   => 0
dim as uinteger<64>      CYCMAN.currentCycleIndex      => 0
dim as uinteger<64>      CYCMAN.cycleCountMaxvalue      => &hFFFFFFFFFFFFFFFF
dim as boolean         CYCMAN.hasCycleStarted         => FALSE
dim as boolean         CYCMAN.hasCycleEnded         => FALSE
dim as boolean         CYCMAN.hasReachedMaxvalue      => FALSE
dim as double         CYCMAN.cycleStartTime         => -1
dim as double         CYCMAN.cycleEndTime            => -1
dim as double         CYCMAN.endedCycleEllapsedTime   => 0
dim as double         CYCMAN.lastCycleDuration      => -1
dim as double         CYCMAN.meanCycleDuration      => 0
property CYCMAN.CurrentCycleEllapsedTime() as double
   select case  CYCMAN.hasCycleStarted
      case TRUE
         return TIMER - CYCMAN.cycleStartTime
      case FALSE
         return -1
   end select
end property
function CYCMAN.StartCycle() as uinteger
   if ((not CYCMAN.hasCycleStarted) andAlso CYCMAN.hasCycleEnded)   orElse _
      cBool(CYCMAN.lastCycleDuration=-1)                     then
      _dbg:_PSC(green, cycle has started)
      CYCMAN.hasCycleStarted   = TRUE
      CYCMAN.cycleStartTime   = TIMER
      '
      CYCMAN.hasCycleEnded         = FALSE
      CYCMAN.cycleEndTime            = -1
      '
      if CYCMAN.currentCycleIndex>=CYCMAN.cycleCountMaxvalue   then
         CYCMAN.hasReachedMaxvalue = TRUE
      elseIf CYCMAN.hasReachedMaxvalue then
         CYCMAN.hasReachedMaxvalue = FALSE
      end if
      '
      select case CYCMAN.hasReachedMaxvalue
         case TRUE
            CYCMAN.currentCycleIndex = +1
         case else
            CYCMAN.currentCycleIndex += 1
      end select
   end if
   '
   _dbg:_PV(CYCMAN.hasCycleStarted)
   _dbg:_PV(CYCMAN.hasCycleEnded)
   _dbg:_PV(CYCMAN.cycleStartTime)
   _dbg:_PV(CYCMAN.cycleEndTime)
   _dbg:_PV(CYCMAN.hasReachedMaxvalue)
   _dbg:_PV(CYCMAN.currentCycleIndex)
   _dbg:_PV(CYCMAN.endedCycleEllapsedTime)
   '
   return CYCMAN.currentCycleIndex
end function
function CYCMAN.EndCycle() as uinteger
   if (CYCMAN.hasCycleStarted andAlso (not CYCMAN.hasCycleEnded))   then
      _dbg:_PSC(red, cycle has ended)
      CYCMAN.hasCycleStarted         = FALSE
      CYCMAN.hasCycleEnded         = TRUE
      CYCMAN.cycleEndTime            = TIMER
      CYCMAN.lastCycleDuration       = CYCMAN.endedCycleEllapsedTime
      CYCMAN.endedCycleEllapsedTime   = CYCMAN.cycleEndTime - CYCMAN.cycleStartTime
      '
      CYCMAN.meanCycleDuration      = _
               ( _
                  ( _
                     CYCMAN.endedCycleEllapsedTime +  _
                     (CYCMAN.currentCycleIndex - 1)*CYCMAN.meanCycleDuration _
                  )/ _
                  (CYCMAN.currentCycleIndex) _
               )
   end if
   '
   _dbg:_PV(CYCMAN.hasCycleStarted)
   _dbg:_PV(CYCMAN.hasCycleEnded)
   _dbg:_PV(CYCMAN.cycleStartTime)
   _dbg:_PV(CYCMAN.cycleEndTime)
   _dbg:_PV(CYCMAN.hasReachedMaxvalue)
   _dbg:_PV(CYCMAN.currentCycleIndex)
   _dbg:_PV(CYCMAN.endedCycleEllapsedTime)
   _dbg:_PV(CYCMAN.lastCycleDuration)
   _dbg:_PV(CYCMAN.meanCycleDuration)
   '
   return CYCMAN.currentCycleIndex
end function


'------------------------------------------------------------------------
screenRes 480, 520, 32


dim as string   keyPressed
dim as double   expectedCycleDuration   => .41
dim as double   cycleDurationResidue   => any
do
   '
   CYCMAN.StartCycle()
      ? CYCMAN.currentCycleIndex
      ? CYCMAN.lastCycleDuration
      ? CYCMAN.meanCycleDuration
      sleep cInt(.4*1e+3)
   CYCMAN.EndCycle()
   '
   cycleDurationResidue = (expectedCycleDuration - CYCMAN.endedCycleEllapsedTime)
   ? CYCMAN.endedCycleEllapsedTime
   ? "res=";cycleDurationResidue
   if cycleDurationResidue<0 then
      ? "this cycle is taking more time than expected"
   else
      sleep cInt(cycleDurationResidue*1e+3)
   end if
   '
   keyPressed = inkey()
loop until keyPressed=chr(27)


'------------------------------------------------------------------------
getKey()
'(eof)
Tourist Trap
Posts: 2768
Joined: Jun 02, 2015 16:24

Re: Kind of cycle manager udt

Postby Tourist Trap » Dec 20, 2016 0:48

Update, just for this affair of property, and its equivalent as function. Nothing really crucial but one may be annoyed by details like this if not clarified.

Code: Select all

 '*********************************************
'**** kind of cycle regulator/manager udt ****
'*********************************************

'comment/uncomment next define to turn OFF/ON debug macros
'#define      _debug
#ifDef      _debug
   #define      _dbg
   #macro      _PS(debugStringInfo)
      ? "dbg>";
      _INVERTCOLORDURINGINSTRUCTION(? #debugStringInfo)
   #endMacro
   #macro      _PSC(colourName, debugStringInfo ...)
      ? "dbg>";
      _RECOLOREDINVERTINSTRUCTION(colourName, ? #debugStringInfo)
   #endMacro
   #macro      _PV(variableString)
      ? "dbg>";
      _INVERTCOLORDURINGINSTRUCTION(? #variableString &"= "; variableString)
   #endMacro
#else
   #define      _dbg
   #define      _PS(debugStringInfo)
   #define      _PSC(colourName, debugStringInfo ...)
   #define      _PV(variableString)
#endIf
#macro _INVERTCOLORDURINGINSTRUCTION(singleLineInstruction)
   scope
      scope
         dim as ulong   initialScreenForegroundColor   => any
         dim as ulong   initialScreenBackgroundColor   => any
         select case screenPtr()
            case 0
               var c   => color()
               initialScreenForegroundColor = loWord(c)
               initialScreenBackgroundColor = hiWord(c)
            case else
               screenControl 13, _
                           initialScreenForegroundColor, _
                           initialScreenBackgroundColor
         end select
         color initialScreenBackgroundColor, initialScreenForegroundColor
         singleLineInstruction
         color initialScreenForegroundColor, initialScreenBackgroundColor
      end scope
   end scope
#endMacro
#macro _RECOLOREDINVERTINSTRUCTION(colourName, singleLineInstruction ...)
   scope
      scope
         dim as ulong   initialScreenForegroundColor   => any
         dim as ulong   initialScreenBackgroundColor   => any
         var colourDepth   => -1
         select case screenPtr()
            case 0
               var c   => color()
               initialScreenForegroundColor = loWord(c)
               initialScreenBackgroundColor = hiWord(c)
            case else
               screenControl 13, _
                           initialScreenForegroundColor, _
                           initialScreenBackgroundColor
               screenInfo , , colourDepth
         end select
         var colourId   => #colourName
         var foreColour   => initialScreenForegroundColor
         var backColour   => initialScreenBackgroundColor
         select case trim(lCase(colourId))
            case "green"
               select case colourDepth
                  case 8
                     foreColour   = 10
                     backColour   = 02
                  case 16
                     foreColour   = rgb(000,255,000)
                     backColour   = rgb(000,000,125)
                  case 24
                     foreColour   = rgb(000,255,000)
                     backColour   = rgb(000,125,000)
                  case 32
                     foreColour   = rgb(000,255,000)
                     backColour   = rgb(000,125,000)
               end select
            case "red"
               select case colourDepth
                  case 8
                     foreColour   = 12
                     backColour   = 04
                  case 16
                     foreColour   = rgb(255,000,000)
                     backColour   = rgb(125,000,000)
                  case 24
                     foreColour   = rgb(255,000,000)
                     backColour   = rgb(125,000,000)
                  case 32
                     foreColour   = rgb(255,000,000)
                     backColour   = rgb(125,000,000)
               end select
            case "blue"
               select case colourDepth
                  case 8
                     foreColour   = 11
                     backColour   = 03
                  case 16
                     foreColour   = rgb(000,255,255)
                     backColour   = rgb(000,125,125)
                  case 24
                     foreColour   = rgb(000,255,255)
                     backColour   = rgb(000,125,125)
                  case 32
                     foreColour   = rgb(000,255,255)
                     backColour   = rgb(000,125,125)
               end select
            case else
               '
         end select
         '
         color foreColour, backColour
         singleLineInstruction
         color initialScreenForegroundColor, initialScreenBackgroundColor
      end scope
   end scope
#endMacro

'--------------------------------------------------------------------CYCLEMANAGER
type CYCLEMANAGER extends OBJECT
   declare property CurrentCycleEllapsedTime() as double
   declare static function GetCycleEllapsedTime() as double
   declare static function StartCycle() as uinteger
   declare static function EndCycle() as uinteger
   static as CYCLEMANAGER ptr   nullObjectStaticPropertyAccessor
   static as uinteger<64>      currentCycleIndex
   static as uinteger<64>      cycleCountMaxvalue
   static as boolean         hasCycleStarted
   static as boolean         hasCycleEnded
   static as boolean         hasReachedMaxvalue
   static as double         cycleStartTime
   static as double         cycleEndTime
   static as double         endedCycleEllapsedTime
   static as double         lastCycleDuration
   static as double         meanCycleDuration
end type
type CYCMAN      as CYCLEMANAGER
dim as CYCMAN ptr      CYCMAN.nullObjectStaticPropertyAccessor   => 0
dim as uinteger<64>      CYCMAN.currentCycleIndex      => 0
dim as uinteger<64>      CYCMAN.cycleCountMaxvalue      => &hFFFFFFFFFFFFFFFF
dim as boolean         CYCMAN.hasCycleStarted         => FALSE
dim as boolean         CYCMAN.hasCycleEnded         => FALSE
dim as boolean         CYCMAN.hasReachedMaxvalue      => FALSE
dim as double         CYCMAN.cycleStartTime         => -1
dim as double         CYCMAN.cycleEndTime            => -1
dim as double         CYCMAN.endedCycleEllapsedTime   => 0
dim as double         CYCMAN.lastCycleDuration      => -1
dim as double         CYCMAN.meanCycleDuration      => 0
property CYCMAN.CurrentCycleEllapsedTime() as double
   select case  CYCMAN.hasCycleStarted
      case TRUE
         return TIMER - CYCMAN.cycleStartTime
      case FALSE
         return -1
   end select
end property
function CYCMAN.GetCycleEllapsedTime() as double
   select case  CYCMAN.hasCycleStarted
      case TRUE
         return TIMER - CYCMAN.cycleStartTime
      case FALSE
         return -1
   end select
end function
function CYCMAN.StartCycle() as uinteger
   if ((not CYCMAN.hasCycleStarted) andAlso CYCMAN.hasCycleEnded)   orElse _
      cBool(CYCMAN.lastCycleDuration=-1)                     then
      _dbg:_PSC(green, cycle has started)
      CYCMAN.hasCycleStarted   = TRUE
      CYCMAN.cycleStartTime   = TIMER
      '
      CYCMAN.hasCycleEnded         = FALSE
      CYCMAN.cycleEndTime            = -1
      '
      if CYCMAN.currentCycleIndex>=CYCMAN.cycleCountMaxvalue   then
         CYCMAN.hasReachedMaxvalue = TRUE
      elseIf CYCMAN.hasReachedMaxvalue then
         CYCMAN.hasReachedMaxvalue = FALSE
      end if
      '
      select case CYCMAN.hasReachedMaxvalue
         case TRUE
            CYCMAN.currentCycleIndex = +1
         case else
            CYCMAN.currentCycleIndex += 1
      end select
   end if
   '
   _dbg:_PV(CYCMAN.hasCycleStarted)
   _dbg:_PV(CYCMAN.hasCycleEnded)
   _dbg:_PV(CYCMAN.cycleStartTime)
   _dbg:_PV(CYCMAN.cycleEndTime)
   _dbg:_PV(CYCMAN.hasReachedMaxvalue)
   _dbg:_PV(CYCMAN.currentCycleIndex)
   _dbg:_PV(CYCMAN.endedCycleEllapsedTime)
   '
   return CYCMAN.currentCycleIndex
end function
function CYCMAN.EndCycle() as uinteger
   if (CYCMAN.hasCycleStarted andAlso (not CYCMAN.hasCycleEnded))   then
      _dbg:_PSC(red, cycle has ended)
      CYCMAN.hasCycleStarted         = FALSE
      CYCMAN.hasCycleEnded         = TRUE
      CYCMAN.cycleEndTime            = TIMER
      CYCMAN.lastCycleDuration       = CYCMAN.endedCycleEllapsedTime
      CYCMAN.endedCycleEllapsedTime   = CYCMAN.cycleEndTime - CYCMAN.cycleStartTime
      '
      CYCMAN.meanCycleDuration      = _
               ( _
                  ( _
                     CYCMAN.endedCycleEllapsedTime +  _
                     (CYCMAN.currentCycleIndex - 1)*CYCMAN.meanCycleDuration _
                  )/ _
                  (CYCMAN.currentCycleIndex) _
               )
   end if
   '
   _dbg:_PV(CYCMAN.hasCycleStarted)
   _dbg:_PV(CYCMAN.hasCycleEnded)
   _dbg:_PV(CYCMAN.cycleStartTime)
   _dbg:_PV(CYCMAN.cycleEndTime)
   _dbg:_PV(CYCMAN.hasReachedMaxvalue)
   _dbg:_PV(CYCMAN.currentCycleIndex)
   _dbg:_PV(CYCMAN.endedCycleEllapsedTime)
   _dbg:_PV(CYCMAN.lastCycleDuration)
   _dbg:_PV(CYCMAN.meanCycleDuration)
   '
   return CYCMAN.currentCycleIndex
end function


'------------------------------------------------------------------------
screenRes 480, 520, 32


dim as string   keyPressed
dim as double   expectedCycleDuration   => .41
dim as double   cycleDurationResidue   => any
do
   '
   CYCMAN.StartCycle()
      ? CYCMAN.currentCycleIndex
      ? CYCMAN.lastCycleDuration
      ? CYCMAN.meanCycleDuration
      '
      'access to property or function
      ? CYCMAN.GetCycleEllapsedTime()
      ? CYCMAN.nullObjectStaticPropertyAccessor->CurrentCycleEllapsedTime
      '
      sleep cInt(.4*1e+3)
   CYCMAN.EndCycle()
   '
   cycleDurationResidue = (expectedCycleDuration - CYCMAN.endedCycleEllapsedTime)
   ? CYCMAN.endedCycleEllapsedTime
   ? "res=";cycleDurationResidue
   if cycleDurationResidue<0 then
      ? "this cycle is taking more time than expected"
   else
      sleep cInt(cycleDurationResidue*1e+3)
   end if
   '
   keyPressed = inkey()
loop until keyPressed=chr(27)


'------------------------------------------------------------------------
getKey()
'(eof)

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 2 guests