Binary Clock

[Cecil]

I saw this http://www.thinkgeek.com/homeoffice/lights/59e0/ so I thought it would be nice to write one in Progress. It nothing fancy it just for fun.

Copy and past the following code into a Procedure Editor and run it.

DEFINE VARIABLE i       AS INTEGER     NO-UNDO.
DEFINE VARIABLE j       AS INTEGER     NO-UNDO.
DEFINE VARIABLE iBinary AS INTEGER     NO-UNDO.
DEFINE VARIABLE iByte   AS INTEGER     NO-UNDO.
DEFINE VARIABLE cTime   AS CHARACTER   NO-UNDO.

DEFINE TEMP-TABLE gttBINARYTIME NO-UNDO
  FIELD id          AS INTEGER 
  FIELD binaryvalue AS LOGICAL EXTENT 6.

REPEAT:
  
  cTime = STRING(TIME, "HH:MM:SS AM").
  cTime = REPLACE(cTime,":","").

  EMPTY TEMP-TABLE gttBINARYTIME.
  
  DO i = 1 TO 4:
  
    CREATE gttBINARYTIME.
  
    ASSIGN
      id = i.
  
    DO j = 1 TO 6:
  
      iByte = INTEGER(SUBSTRING(cTime, j, 1)).
  
      ASSIGN
        gttBINARYTIME.binaryvalue[j] = LOGICAL(GET-BITS(iByte,i,1)).
    END.
  END.                                                                   
  
  DISPLAY cTime FORMAT "x(20)".

  iBinary = 0.

  FOR EACH gttBINARYTIME                          
    BY gttBINARYTIME.id DESCENDING:
    
    CASE gttBINARYTIME.id:
      WHEN 1 THEN
        iBinary = 1.
      WHEN 2 THEN
        iBinary = 2.
      WHEN 3 THEN
        iBinary = 4.
      WHEN 4 THEN
        iBinary = 8.
    END CASE.

    DISPLAY 
      iBinary LABEL "BINARY"
      "[#]" WHEN gttBINARYTIME.binaryvalue[1] EQ TRUE LABEL "H"           
      "[#]" WHEN gttBINARYTIME.binaryvalue[2] EQ TRUE LABEL "H"
      "[#]" WHEN gttBINARYTIME.binaryvalue[3] EQ TRUE LABEL "M"
      "[#]" WHEN gttBINARYTIME.binaryvalue[4] EQ TRUE LABEL "M"
      "[#]" WHEN gttBINARYTIME.binaryvalue[5] EQ TRUE LABEL "S"
      "[#]" WHEN gttBINARYTIME.binaryvalue[6] EQ TRUE LABEL "S"
      .
  END.
  PAUSE 1.
END.

 

[dayv2005]

haha good work man i like it