sezenspessa

EMTIME VERSION 2

Dec 23rd, 2019
630
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.       ******************************************************************
  2.       * Author: Sezen
  3.       * Date:   12/23/2019
  4.       * Updated!
  5.       ******************************************************************
  6.       * OUTPUTS:
  7.       * Current Standard Time: 05:15:32
  8.       * Current Emily Time: 11:51:55
  9.       * 15:55:15
  10.       * Emily Time: 35:51:42
  11.       ******************************************************************
  12.       * MORE ON EMILY TIME:
  13.       * http://xahlee.info/kbd/happy_hacking_emily.html
  14.       ******************************************************************
  15.        IDENTIFICATION DIVISION.
  16.        PROGRAM-ID. EMTIME-CONVERTER.
  17.        ENVIRONMENT DIVISION.
  18.        CONFIGURATION SECTION.
  19.        REPOSITORY.
  20.             FUNCTION ALL INTRINSIC.
  21.        DATA DIVISION.
  22.        WORKING-STORAGE SECTION.
  23.        01   WS-STANDARD-TIME.
  24.             05   WS-STANDARD-HOUR   PIC 99.
  25.                  88   HOUR-CHECK    VALUE 00 THRU 24.
  26.             05   COL1               PIC X VALUE ':'.
  27.             05   WS-STANDARD-MINUTE PIC 99.
  28.                  88   MIN-CHECK     VALUE 00 THRU 59.
  29.             05   COL2               PIC X VALUE ':'.
  30.             05   WS-STANDARD-SECOND PIC 99.
  31.                  88   SEC-CHECK     VALUE 00 THRU 59.
  32.        01   WS-CURRENT-DATE.
  33.             05 CURRENT-DATE PIC 9(08).
  34.             05 CURRENT-TIME.
  35.                 10 WS-CURRENT-HOUR  PIC 9(2).
  36.                 10 WS-CURRENT-MIN    PIC 9(2).
  37.                 10 WS-CURRENT-SEC   PIC 9(2).
  38.                 10                  PIC 9(2).
  39.        PROCEDURE DIVISION.
  40.       *    GRAB CURRENT TIME :)
  41.             MOVE CURRENT-DATE TO WS-CURRENT-DATE.
  42.             DISPLAY 'Current Standard Time: ', WS-CURRENT-HOUR, ':', WS-
  43.       -    CURRENT-MIN, ':', WS-CURRENT-SEC.
  44.             CALL 'MAIN-COMP' USING WS-CURRENT-HOUR, WS-CURRENT-MIN, WS-
  45.       -    CURRENT-SEC.
  46.             DISPLAY 'Current Emily Time: ', WS-CURRENT-HOUR, ':', WS-
  47.       -    CURRENT-MIN, ':', WS-CURRENT-SEC.
  48.             DISPLAY '-----------------------------------'
  49.             DISPLAY 'Enter HH:MM:SS: '.
  50.             ACCEPT WS-STANDARD-TIME.
  51.       *    CHECK IF VALID...
  52.             IF NOT (HOUR-CHECK AND MIN-CHECK AND SEC-CHECK AND (
  53.       -    COL1 AND COL2 = ':'))
  54.             THEN
  55.                DISPLAY 'INVALID TIME ENTERED. TRY AGAIN :)'
  56.                STOP RUN
  57.             END-IF.
  58.             CALL 'MAIN-COMP' USING WS-STANDARD-HOUR, WS-STANDARD-MINUTE,
  59.       -    WS-STANDARD-SECOND.
  60.             DISPLAY 'Emily Time: ', WS-STANDARD-TIME.
  61.             STOP RUN.
  62.       *
  63.        IDENTIFICATION DIVISION.
  64.        PROGRAM-ID. MAIN-COMP.
  65.        DATA DIVISION.
  66.        WORKING-STORAGE SECTION.
  67.        01   EM-TIME-TOTAL           PIC 99999 VALUE 46656.
  68.        01   STANDARD-TIME-TOTAL     PIC 99999 VALUE 86400.
  69.        01   DAY-PERCENT             PIC 9V9(25).
  70.        01   EM-DAY-VAL              PIC 99999.
  71.        01   DAY-SECONDS             PIC 9(6).
  72.        LINKAGE SECTION.
  73.        01   LS-HOUR                 PIC 99.
  74.        01   LS-MIN                  PIC 99.
  75.        01   LS-SEC                  PIC 99.
  76.        PROCEDURE DIVISION USING LS-HOUR, LS-MIN, LS-SEC.
  77.             COMPUTE DAY-SECONDS = ((LS-HOUR*60)*60)+(LS-MIN
  78.       -    *60)+LS-SEC.
  79.             COMPUTE DAY-PERCENT =  DAY-SECONDS / STANDARD-TIME-TOTAL.
  80.             COMPUTE EM-DAY-VAL = EM-TIME-TOTAL * DAY-PERCENT.
  81.             COMPUTE LS-HOUR = (EM-DAY-VAL / (36*36)).
  82.             COMPUTE LS-MIN = (EM-DAY-VAL - (LS-HOUR * (36 * 36
  83.       -    ))) / 36.
  84.             MOVE MOD(EM-DAY-VAL, 36) TO LS-SEC.
  85.       *    CONVERT BASE-10 -> BASE-6...
  86.             CALL 'CONV-BASE-6' USING LS-HOUR.
  87.             CALL 'CONV-BASE-6' USING LS-MIN.
  88.             CALL 'CONV-BASE-6' USING LS-SEC.
  89.             EXIT.
  90.       *
  91.        IDENTIFICATION DIVISION.
  92.        PROGRAM-ID. CONV-BASE-6.
  93.        DATA DIVISION.
  94.        WORKING-STORAGE SECTION.
  95.        01   WS-QUO        PIC Z(9) VALUE 1.
  96.        01   WS-REM        PIC Z(9) VALUE 1.
  97.        01   WS-STRING-REM REDEFINES WS-REM PIC X(9).
  98.        01   RETURN-STR    PIC X(20).
  99.        LINKAGE SECTION.
  100.        01   LS-TIME PIC 9(2).
  101.        PROCEDURE DIVISION USING LS-TIME.
  102.             MOVE SPACES TO RETURN-STR.
  103.             MOVE 1 TO WS-QUO.
  104.             PERFORM UNTIL WS-QUO = SPACES
  105.             MOVE 0 TO WS-QUO
  106.             DIVIDE LS-TIME BY 6 GIVING WS-QUO REMAINDER WS-REM
  107.       *    BECAUSE WE ARE USING Z, ZEROES TURN TO SPACES. REPLACE IT!
  108.             IF WS-REM = SPACES THEN
  109.                 STRING '0',RETURN-STR INTO RETURN-STR
  110.             ELSE
  111.                 STRING TRIM(WS-STRING-REM),RETURN-STR INTO RETURN-STR
  112.             END-IF
  113.             MOVE WS-QUO TO LS-TIME
  114.             END-PERFORM.
  115.       *    HERE LIES A BUG, (2:) FIXES DUPING.
  116.             MOVE RETURN-STR(2:) TO RETURN-STR.
  117.             MOVE NUMVAL(RETURN-STR) TO LS-TIME.    
  118.        END PROGRAM MAIN-COMP.
  119.        END PROGRAM CONV-BASE-6.
  120.        END PROGRAM EMTIME-CONVERTER.
RAW Paste Data

Adblocker detected! Please consider disabling it...

We've detected AdBlock Plus or some other adblocking software preventing Pastebin.com from fully loading.

We don't have any obnoxious sound, or popup ads, we actively block these annoying types of ads!

Please add Pastebin.com to your ad blocker whitelist or disable your adblocking software.

×