home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1993 #3 / NN_1993_3.iso / spool / rec / video / 16306 < prev    next >
Encoding:
Text File  |  1993-01-24  |  4.5 KB  |  163 lines
  1. Newsgroups: rec.video
  2. Path: sparky!uunet!mcsun!fuug!anon
  3. From: an7689@anon.penet.fi
  4. Subject: VCR Plus+ PlusCodes:  *Here's* the decoder!
  5. Message-ID: <1993Jan23.225724.26050@fuug.fi>
  6. Sender: anon@fuug.fi (The Anon Administrator)
  7. Organization: Anonymous contact service
  8. X-Anonymously-To: rec.video
  9. Date: Sat, 23 Jan 1993 21:46:00 GMT
  10. Lines: 151
  11.  
  12.       IMPLICIT INTEGER (A-Z)
  13.       DIMENSION C1(6), KEY(8), KMAT(6,14), D1(6), B4(10), B5(5),
  14.      *   C(0:5), T(0:8)
  15.       DATA IIN, IOUT / 0, 0 /,  KEYLEN /8/,
  16.      *  KEY(8), KEY(7), KEY(6), KEY(5), KEY(4), KEY(3), KEY(2), KEY(1)
  17.      * /    6,      8,      1,      5,      0,      6,      3,      1 /
  18.  
  19.    10 WRITE (IIN,20)
  20.    20 FORMAT (/' Enter Code, month, year (2 digits):  '$)
  21.       READ (IIN, *) CODE, MONTH, YEAR
  22. C NC, number of digits in CODE
  23.       NC = 1 + IFIX(ALOG10(FLOAT(CODE)))
  24. C C(), digits of CODE
  25. C Lowest order digit goes in (1)
  26.       XCODE = CODE
  27.    40 DO 50 I = 1, NC
  28.       C1(I) = MOD(XCODE, 10)
  29.       XCODE = XCODE / 10
  30.    50 CONTINUE
  31. C ** ** ** Step 1
  32. C No carry multiply
  33.       DO 60 I = 1, NC
  34.       DO 60 J = 1, 14
  35.    60 KMAT(I,J) = 0
  36.       DO 80 I = 1, NC
  37.       DO 80 J = 1, KEYLEN
  38.    80 KMAT(I,J+I-1) = MOD(C1(I)*KEY(J),10)
  39.       DO 90 I = 1, 6
  40.    90 D1(I) = 0
  41.       DO 120 K = 1, NC
  42.       DO 110 KK = 1, NC
  43.   110 D1(K) = D1(K) + KMAT(KK,K)
  44.       D1(K) = MOD (D1(K),10)
  45.   120 CONTINUE
  46.       IF (D1(NC).EQ.0) THEN
  47.          XCODE = D1(NC)
  48.          DO 130 I = NC-1, 1, -1
  49.   130    XCODE = 10 * XCODE + D1(I)
  50.          GOTO 40
  51.       ENDIF
  52. C ** ** ** Steps 2 and 3
  53.       BOTTOM = (D1(3) * 10 + D1(2)) * 10 + D1(1)
  54.       DAY = 1 + (BOTTOM - 1) / 32
  55.       REMAIN = MOD(BOTTOM-1,32)
  56. c ** ** ** Step 4
  57.       TOP = (D1(6) * 10 + D1(5)) * 10 + D1(4)
  58. C
  59.       IF (TOP.GT.1) THEN
  60.          NT = 1 + IFIX(ALOG10(FLOAT(TOP)))
  61.       ELSE
  62.          NT = 0
  63.       ENDIF
  64. C
  65.       IF (NT.EQ.0) THEN
  66.          OFFSET = 0
  67.       ELSE
  68.          OFFSET = OFF(DAY,YEAR,TOP,NT)
  69.       ENDIF
  70.       CALL BINARY(TOP, B4, 10)
  71. C ** ** ** Step 5
  72.       BIN5 = MOD(REMAIN+DAY*(MONTH+1)+OFFSET, 32)
  73.       CALL BINARY(BIN5, B5, 5)
  74. C Construct binaries C, T
  75.       T(0) = B5(1)
  76.       T(1) = B5(3)
  77.       T(2) = B5(5)
  78.       T(3) = B4(1)
  79.       T(4) = B4(4)
  80.       T(5) = B4(5)
  81.       T(6) = B4(6)
  82.       T(7) = B4(8)
  83.       T(8) = B4(10)
  84.       C(0) = B5(2)
  85.       C(1) = B5(4)
  86.       C(2) = B4(2)
  87.       C(3) = B4(3)
  88.       C(4) = B4(7)
  89.       C(5) = B4(9)
  90. C ** ** ** Step 6
  91.       CHNL = C(5)
  92.       DO 200 I = 4, 0, -1
  93.   200 CHNL = 2 * CHNL + C(I)
  94.       CHNL = CHNL + 1
  95. C ** ** ** Step 7
  96.       TABL = T(8)
  97.       DO 210 I = 7, 0, -1
  98.   210 TABL = 2 * TABL + T(I)
  99. C
  100.       WRITE (IOUT,240) DAY, CHNL, TABL
  101.   240 FORMAT (/' Day     ', I4
  102.      *        /' Channel ', I4
  103.      *        /' Table   ', I4)
  104.       GOTO 10
  105.       END
  106. C***********************************************************************
  107.       INTEGER FUNCTION OFF(DAY,YEAR,TOP,NT)
  108.       IMPLICIT INTEGER (A-Z)
  109. C
  110.       OFF = MOD(TOP, 10) + MOD(TOP/10, 10) + MOD(TOP/100, 10)
  111.    40 DO 50 I = 0, MOD(YEAR,16)
  112.    50 OFF = OFF + MOD(MAP(DAY,I,TOP,NT), 10)
  113.       TOP = MAP(DAY,YEAR,TOP,NT)
  114.       IF (TOP.LT.10**(NT-1)) GOTO 40
  115. C
  116.    60 OFF = MOD(OFF,32)
  117.       RETURN
  118.       END
  119. C***********************************************************************
  120.       INTEGER FUNCTION MAP(DAY,YR,TOP,NT)
  121.       IMPLICIT INTEGER (A-Z)
  122.       DIMENSION D(0:2)
  123. C
  124.       YEAR = MOD(YR,16)
  125.       XTOP = TOP
  126.       DO 10 I = 0, 2
  127.       D(I) = MOD(XTOP,10)
  128.       XTOP = XTOP / 10
  129.    10 CONTINUE
  130. C
  131.       F0 = 1
  132.       F1 = MOD(YEAR+1,10)
  133.       F2 = MOD((YEAR+1)*(YEAR+2)/2,10)
  134.       F3 = MOD((YEAR+1)*(YEAR+2)*(YEAR+3)/6,10)
  135.       IF (NT.EQ.1) THEN
  136.          MAP = MOD(D(0)*F0+DAY*F1,10)
  137.       ELSEIF (NT.EQ.2) THEN
  138.          MAP = 10 * MOD(D(1)*F0+DAY*F1,10) + 
  139.      *               MOD(D(0)*F0+D(1)*F1+DAY*F2,10)
  140.       ELSE
  141.          MAP = 100 * MOD(D(2)*F0+DAY*F1,10) + 
  142.      *           10 * MOD(D(1)*F0+D(2)*F1+DAY*F2,10) +
  143.      *                 MOD(D(0)*F0+D(1)*F1+D(2)*F2+DAY*F3,10)
  144.       ENDIF
  145.       RETURN
  146.       END
  147. C***********************************************************************
  148.       SUBROUTINE BINARY(BIN, B, N)
  149.       IMPLICIT INTEGER (A-Z)
  150.       DIMENSION B(N)
  151.       XBIN = BIN
  152.       DO 10 I = 1, N
  153.       B(I) = MOD(XBIN,2)
  154.       XBIN = XBIN / 2
  155.    10 CONTINUE
  156.       RETURN
  157.       END
  158. C***********************************************************************
  159. -------------------------------------------------------------------------
  160. To find out more about the anon service, send mail to help@anon.penet.fi.
  161. Due to the double-blind system, any replies to this message will be anonymized,
  162. and an anonymous id will be allocated automatically. You have been warned.
  163.