From: an7689@anon.penet.fi
Subject: VCR Plus+ PlusCodes:  *Here's* the decoder!
Organization: Anonymous contact service
X-Anonymously-To: rec.video
Date: Sat, 23 Jan 1993 21:46:00 GMT

      IMPLICIT INTEGER (A-Z)
      DIMENSION C1(6), KEY(8), KMAT(6,14), D1(6), B4(10), B5(5),
     *   C(0:5), T(0:8)
      DATA IIN, IOUT / 0, 0 /,  KEYLEN /8/,
     *  KEY(8), KEY(7), KEY(6), KEY(5), KEY(4), KEY(3), KEY(2), KEY(1)
     * /    6,      8,      1,      5,      0,      6,      3,      1 /

   10 WRITE (IIN,20)
   20 FORMAT (/' Enter Code, month, year (2 digits):  '$)
      READ (IIN, *) CODE, MONTH, YEAR
C NC, number of digits in CODE
      NC = 1 + IFIX(ALOG10(FLOAT(CODE)))
C C(), digits of CODE
C Lowest order digit goes in (1)
      XCODE = CODE
   40 DO 50 I = 1, NC
      C1(I) = MOD(XCODE, 10)
      XCODE = XCODE / 10
   50 CONTINUE
C ** ** ** Step 1
C No carry multiply
      DO 60 I = 1, NC
      DO 60 J = 1, 14
   60 KMAT(I,J) = 0
      DO 80 I = 1, NC
      DO 80 J = 1, KEYLEN
   80 KMAT(I,J+I-1) = MOD(C1(I)*KEY(J),10)
      DO 90 I = 1, 6
   90 D1(I) = 0
      DO 120 K = 1, NC
      DO 110 KK = 1, NC
  110 D1(K) = D1(K) + KMAT(KK,K)
      D1(K) = MOD (D1(K),10)
  120 CONTINUE
      IF (D1(NC).EQ.0) THEN
         XCODE = D1(NC)
         DO 130 I = NC-1, 1, -1
  130    XCODE = 10 * XCODE + D1(I)
         GOTO 40
      ENDIF
C ** ** ** Steps 2 and 3
      BOTTOM = (D1(3) * 10 + D1(2)) * 10 + D1(1)
      DAY = 1 + (BOTTOM - 1) / 32
      REMAIN = MOD(BOTTOM-1,32)
c ** ** ** Step 4
      TOP = (D1(6) * 10 + D1(5)) * 10 + D1(4)
C
      IF (TOP.GT.1) THEN
         NT = 1 + IFIX(ALOG10(FLOAT(TOP)))
      ELSE
         NT = 0
      ENDIF
C
      IF (NT.EQ.0) THEN
         OFFSET = 0
      ELSE
         OFFSET = OFF(DAY,YEAR,TOP,NT)
      ENDIF
      CALL BINARY(TOP, B4, 10)
C ** ** ** Step 5
      BIN5 = MOD(REMAIN+DAY*(MONTH+1)+OFFSET, 32)
      CALL BINARY(BIN5, B5, 5)
C Construct binaries C, T
      T(0) = B5(1)
      T(1) = B5(3)
      T(2) = B5(5)
      T(3) = B4(1)
      T(4) = B4(4)
      T(5) = B4(5)
      T(6) = B4(6)
      T(7) = B4(8)
      T(8) = B4(10)
      C(0) = B5(2)
      C(1) = B5(4)
      C(2) = B4(2)
      C(3) = B4(3)
      C(4) = B4(7)
      C(5) = B4(9)
C ** ** ** Step 6
      CHNL = C(5)
      DO 200 I = 4, 0, -1
  200 CHNL = 2 * CHNL + C(I)
      CHNL = CHNL + 1
C ** ** ** Step 7
      TABL = T(8)
      DO 210 I = 7, 0, -1
  210 TABL = 2 * TABL + T(I)
C
      WRITE (IOUT,240) DAY, CHNL, TABL
  240 FORMAT (/' Day     ', I4
     *        /' Channel ', I4
     *        /' Table   ', I4)
      GOTO 10
      END
C***********************************************************************
      INTEGER FUNCTION OFF(DAY,YEAR,TOP,NT)
      IMPLICIT INTEGER (A-Z)
C
      OFF = MOD(TOP, 10) + MOD(TOP/10, 10) + MOD(TOP/100, 10)
   40 DO 50 I = 0, MOD(YEAR,16)
   50 OFF = OFF + MOD(MAP(DAY,I,TOP,NT), 10)
      TOP = MAP(DAY,YEAR,TOP,NT)
      IF (TOP.LT.10**(NT-1)) GOTO 40
C
   60 OFF = MOD(OFF,32)
      RETURN
      END
C***********************************************************************
      INTEGER FUNCTION MAP(DAY,YR,TOP,NT)
      IMPLICIT INTEGER (A-Z)
      DIMENSION D(0:2)
C
      YEAR = MOD(YR,16)
      XTOP = TOP
      DO 10 I = 0, 2
      D(I) = MOD(XTOP,10)
      XTOP = XTOP / 10
   10 CONTINUE
C
      F0 = 1
      F1 = MOD(YEAR+1,10)
      F2 = MOD((YEAR+1)*(YEAR+2)/2,10)
      F3 = MOD((YEAR+1)*(YEAR+2)*(YEAR+3)/6,10)
      IF (NT.EQ.1) THEN
         MAP = MOD(D(0)*F0+DAY*F1,10)
      ELSEIF (NT.EQ.2) THEN
         MAP = 10 * MOD(D(1)*F0+DAY*F1,10) + 
     *               MOD(D(0)*F0+D(1)*F1+DAY*F2,10)
      ELSE
         MAP = 100 * MOD(D(2)*F0+DAY*F1,10) + 
     *           10 * MOD(D(1)*F0+D(2)*F1+DAY*F2,10) +
     *                 MOD(D(0)*F0+D(1)*F1+D(2)*F2+DAY*F3,10)
      ENDIF
      RETURN
      END
C***********************************************************************
      SUBROUTINE BINARY(BIN, B, N)
      IMPLICIT INTEGER (A-Z)
      DIMENSION B(N)
      XBIN = BIN
      DO 10 I = 1, N
      B(I) = MOD(XBIN,2)
      XBIN = XBIN / 2
   10 CONTINUE
      RETURN
      END
C***********************************************************************
-------------------------------------------------------------------------
To find out more about the anon service, send mail to help@anon.penet.fi.
Due to the double-blind system, any replies to this message will be anonymized,
and an anonymous id will be allocated automatically. You have been warned.
Newsgroups: rec.video