QuineMcCluskeyProgramme:

  DECLARE SUB WRFUNCTION (SRC$(), SNUM!)
  DECLARE SUB QUINEMCCLUSKEY (SRC$(), SNUM!)
  DECLARE SUB Q0FINDSIMILARITY (SRCA$, SRCB$, TRG$, SIMILARITY!)
  DECLARE SUB Q1FINDDIFFERENCE (SRCA$, SRCB$, TRG$, DIFFERENCE!)
  DECLARE SUB Q2COPYMTRXTOMTRX (SRC$(), SNUM!, TRG$(), TNUM!)
  DECLARE SUB Q3LIMITSRCMATRIX (SRC$(), SNUM!)
  DECLARE SUB Q4MAKEMINTMATRIX (TMIN$(), TNUM!)
  DECLARE SUB Q5COMBINEIMPLICS (SRC$(), SMIN$(), SNUM!, TRG$(), TMIN$(), TNUM!, COMBINED!)
  DECLARE SUB Q6FINDEPRIMPLICS (SRC$(), SMIN$(), SNUM!, TRG$(), TNUM!)
 
START:
  CLS
  CLEAR
  LOCATE 1, 15
  PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
  LOCATE 2, 15
  PRINT "³    Boolean functions' minimisation software     ³"
  LOCATE 3, 15
  PRINT "³        based on Quine-McCluskey method          ³"
  LOCATE 4, 15
  PRINT "³                                                 ³"
  LOCATE 5, 15
  PRINT "³         Software Design & Development           ³"
  LOCATE 6, 15
  PRINT "³                George Vastianos                 ³"
  LOCATE 7, 15
  PRINT "³                                                 ³"
  LOCATE 8, 15
  PRINT "³             Electronics Department,             ³"
  LOCATE 9, 15
  PRINT "³     Faculty of Technological Applications,      ³"
  LOCATE 10, 15
  PRINT "³ Technological Educational Institute of Piraeus, ³"
  LOCATE 11, 15
  PRINT "³                   G R E E C E                   ³"
  LOCATE 12, 15
  PRINT "³                                                 ³"
  LOCATE 13, 15
  PRINT "³            Version 1.0 - April 1998             ³"
  LOCATE 14, 15
  PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"

  ON ERROR GOTO FILEERROR
  LOCATE 16, 1
  PRINT "Minimization"
  INPUT "Input  file : ", INFILE$
  INPUT "Output file : ", OUTFILE$

  OPEN INFILE$ FOR INPUT AS #1

    INPUT #1, M$
      IF LEFT$(M$, 1) = "M" OR LEFT$(M$, 1) = "m" THEN
        MINS = VAL(RIGHT$(M$, LEN(M$) - 1))
        IF MINS > 64 THEN
          MINS = 64
        END IF
      ELSE
        GOTO FORMATERROR
      END IF
   
    INPUT #1, V$
      IF LEFT$(V$, 1) = "V" OR LEFT$(V$, 1) = "v" THEN
        VARS = VAL(RIGHT$(V$, LEN(V$) - 1))
        IF VARS > 64 THEN
          VARS = 64
        END IF
      ELSE
        GOTO FORMATERROR
      END IF
   
    DIM MATRIX$(0 TO MINS - 1)
    FOR COUNT = 0 TO MINS - 1
      MIN$ = ""
      INPUT #1, MIN$
      MATRIX$(COUNT) = LEFT$(MIN$, VARS)
    NEXT COUNT
 
  CLOSE #1

  SRCMINS = MINS
 
  PRINT "Minimization started"
  CALL QUINEMCCLUSKEY(MATRIX$(), MINS)
  PRINT "Minimization finished"
 
  TRGMINS = MINS

  PRINT SRCMINS; "minterms of "; VARS; "varables, minimized to";
  PRINT TRGMINS; "minterms of "; VARS; "varables.";
 
  OPEN OUTFILE$ FOR OUTPUT AS #2
   
    PRINT #2, "M" + STR$(TRGMINS)
    PRINT #2, "V" + STR$(VARS)
   
    FOR COUNT = 0 TO TRGMINS - 1
      PRINT #2, MATRIX$(COUNT)
    NEXT COUNT

  CLOSE #2
 
  GOTO FINISH

FILEERROR:
 
  PRINT "File I/O error"
  GOTO FINISH

FORMATERROR:

  PRINT "File format error"
  GOTO FINISH

FINISH:

  PRINT "Repeat minimization (y/n) ?"
  
WAITFORANSWER:
 
  PRESSEDKEY$ = INKEY$
  IF PRESSEDKEY$ = "Y" OR PRESSEDKEY$ = "y" THEN GOTO START
  IF PRESSEDKEY$ = "N" OR PRESSEDKEY$ = "n" THEN PRINT : END
  GOTO WAITFORANSWER

SUB Q0FINDSIMILARITY (SRCA$, SRCB$, TRG$, SIMILARITY)
 
  TRG$ = ""
  SIMILARITY = 0
 
  LENGTHA = LEN(SRCA$)
  LENGTHB = LEN(SRCB$)
  DIFLENGTH = LENGTHA - LENGTHB
  IF DIFLENGTH < 0 THEN
    LENGTHC = LENGTHB
    SRCA$ = STRING$(-DIFLENGTH, "0") + SRCA$
  ELSEIF DIFLENGTH = 0 THEN
    LENGTHC = LENGTHB
  ELSEIF DIFLENGTH > 0 THEN
    LENGTHC = LENGTHA
    SRCB$ = STRING$(DIFLENGTH, "0") + SRCB$
  END IF

  FOR I = 1 TO LENGTHC
    CHARSRCA$ = LEFT$(RIGHT$(SRCA$, I), 1)
    CHARSRCB$ = LEFT$(RIGHT$(SRCB$, I), 1)
    IF CHARSRCA$ = CHARSRCB$ AND NOT CHARSRCA$ = "0" THEN
      TRG$ = CHARSRCA$ + TRG$
      SIMILARITY = SIMILARITY + 1
    ELSE
      TRG$ = "0" + TRG$
    END IF
  NEXT I
 
END SUB

SUB Q1FINDDIFFERENCE (SRCA$, SRCB$, TRG$, DIFFERENCE)
  
  TRG$ = ""
  DIFFERENCE = 0
  
  LENGTHA = LEN(SRCA$)
  LENGTHB = LEN(SRCB$)
  DIFLENGTH = LENGTHA - LENGTHB
  IF DIFLENGTH < 0 THEN
    LENGTHC = LENGTHB
    SRCA$ = STRING$(-DIFLENGTH, "0") + SRCA$
  ELSEIF DIFLENGTH = 0 THEN
    LENGTHC = LENGTHB
  ELSEIF DIFLENGTH > 0 THEN
    LENGTHC = LENGTHA
    SRCB$ = STRING$(DIFLENGTH, "0") + SRCB$
  END IF

  FOR I = 1 TO LENGTHC
    CHARSRCA$ = LEFT$(RIGHT$(SRCA$, I), 1)
    CHARSRCB$ = LEFT$(RIGHT$(SRCB$, I), 1)
    IF CHARSRCA$ = CHARSRCB$ THEN
      TRG$ = CHARSRCA$ + TRG$
    ELSE
      TRG$ = "X" + TRG$
      DIFFERENCE = DIFFERENCE + 1
    END IF
  NEXT I
END SUB

SUB Q2COPYMTRXTOMTRX (SRC$(), SNUM, TRG$(), TNUM)

  TNUM = SNUM
  FOR I = 0 TO SNUM - 1
    TRG$(I) = SRC$(I)
  NEXT I

END SUB

SUB Q3LIMITSRCMATRIX (SRC$(), SNUM)

  DIM TRG$(SNUM)
  TNUM = 0

  FOR I = 0 TO SNUM - 1
    USEDBEFORE = 0
    FOR J = 0 TO TNUM - 1
      IF TRG$(J) = SRC$(I) THEN
        USEDBEFORE = USEDBEFORE + 1
      END IF
    NEXT J
    IF USEDBEFORE = 0 THEN
      TRG$(TNUM) = SRC$(I)
      TNUM = TNUM + 1
    END IF
  NEXT I
 
  CALL Q2COPYMTRXTOMTRX(TRG$(), TNUM, SRC$(), SNUM)

  IF SNUM > 64 THEN SNUM = 64

END SUB

SUB Q4MAKEMINTMATRIX (TMIN$(), TNUM)

  FOR I = 0 TO TNUM - 1
    TMIN$(I) = STRING$(I, "0") + "X" + STRING$(TNUM - 1 - I, "0")
  NEXT I

END SUB

SUB Q5COMBINEIMPLICS (SRC$(), SMIN$(), SNUM, TRG$(), TMIN$(), TNUM, COMBINED)
    
  COMBINED = 0
  TNUM = 0
  DIM USEDNUM(SNUM)
    
  FOR I = 0 TO SNUM - 1
    FOR J = I + 1 TO SNUM - 1
      CALL Q1FINDDIFFERENCE(SRC$(I), SRC$(J), RESULT$, DIFFERENCE)
      IF DIFFERENCE = 1 THEN
        COMBINED = COMBINED + 1
        USEDNUM(I) = USEDNUM(I) + 1
        USEDNUM(J) = USEDNUM(J) + 1
        USEDBEFORE = 0
        FOR K = 0 TO TNUM - 1
          IF TRG$(K) = RESULT$ THEN
            USEDBEFORE = USEDBEFORE + 1
          END IF
        NEXT K
        IF USEDBEFORE = 0 THEN
          TRG$(TNUM) = RESULT$
          CALL Q1FINDDIFFERENCE(SMIN$(I), SMIN$(J), TMIN$(TNUM), DIFFERENCE)
          TNUM = TNUM + 1
        END IF
      END IF
    NEXT J
  NEXT I
    
  FOR L = 0 TO SNUM - 1
    IF USEDNUM(L) = 0 THEN
      TRG$(TNUM) = SRC$(L)
      TMIN$(TNUM) = SMIN$(L)
      TNUM = TNUM + 1
    END IF
  NEXT L

END SUB

SUB Q6FINDEPRIMPLICS (SRC$(), SMIN$(), SNUM, TRG$(), TNUM)
 
  TNUM = 0
 
  MNUM = LEN(SMIN$(0))
  DIM MSK$(MNUM)
  CALL Q4MAKEMINTMATRIX(MSK$(), MNUM)

  ESMIN$ = ""
  ALLMIN$ = STRING$(MNUM, "X")
  DIM USEDNUM(SNUM)
 
  FOR I = 0 TO MNUM - 1
    NUMMACHED = 0
    LASTMACHED = 0
    FOR J = 0 TO SNUM - 1
      CALL Q0FINDSIMILARITY(MSK$(I), SMIN$(J), RESULT$, SIMILARITY)
      IF SIMILARITY = 1 THEN
        NUMMACHED = NUMMACHED + 1
        LASTMACHED = J
      END IF
    NEXT J
    IF NUMMACHED = 1 THEN
      CALL Q1FINDDIFFERENCE(SMIN$(LASTMACHED), ESMIN$, RESULT$, DIFFERENCE)
      ESMIN$ = RESULT$
      USEDNUM(LASTMACHED) = USEDNUM(LASTMACHED) + 1
      USEDBEFORE = 0
      FOR K = 0 TO TNUM - 1
        IF TRG$(K) = SRC$(LASTMACHED) THEN
          USEDBEFORE = USEDBEFORE + 1
        END IF
      NEXT K
      IF USEDBEFORE = 0 THEN
        TRG$(TNUM) = SRC$(LASTMACHED)
        TNUM = TNUM + 1
      END IF
    END IF
  NEXT I

  DO WHILE (NOT ESMIN$ = ALLMIN$)
    MAXSIMILARITY = 0
    LASTMACHED = 0
    FOR L = 0 TO SNUM - 1
      IF USEDNUM(L) = 0 THEN
        CALL Q1FINDDIFFERENCE(SMIN$(L), ESMIN$, RESULT$, DIFFERENCE)
        CALL Q0FINDSIMILARITY(RESULT$, ALLMIN$, NEWRESULT$, SIMILARITY)
        IF SIMILARITY > MAXSIMILARITY THEN
          MAXSIMILARITY = SIMILARITY
          LASTMACHED = L
          FINALRESULT$ = NEWRESULT$
        END IF
      END IF
    NEXT L
    IF MAXSIMILARITY > 0 THEN
      ESMIN$ = FINALRESULT$
      TRG$(TNUM) = SRC$(LASTMACHED)
      TNUM = TNUM + 1
    END IF
  LOOP

END SUB

SUB QUINEMCCLUSKEY (SRC$(), SNUM)

  COMBINED = 0
  DIM MA$(2 ^ 8)
  DIM MAM$(2 ^ 8)
  DIM MB$(2 ^ 8)
  DIM MBM$(2 ^ 8)
 
  CALL Q3LIMITSRCMATRIX(SRC$(), SNUM)
  CALL Q2COPYMTRXTOMTRX(SRC$(), SNUM, MA$(), ANUM)
  CALL Q4MAKEMINTMATRIX(MAM$(), ANUM)
 
  DO
    CALL Q5COMBINEIMPLICS(MA$(), MAM$(), ANUM, MB$(), MBM$(), BNUM, COMBINED)
    CALL Q2COPYMTRXTOMTRX(MB$(), BNUM, MA$(), ANUM)
    CALL Q2COPYMTRXTOMTRX(MBM$(), BNUM, MAM$(), ANUM)
  LOOP UNTIL COMBINED = 0

  CALL Q6FINDEPRIMPLICS(MA$(), MAM$(), ANUM, MB$(), BNUM)
  CALL Q2COPYMTRXTOMTRX(MB$(), BNUM, SRC$(), SNUM)

END SUB

SUB WRFUNCTION (SRC$(), SNUM)

  VARNUM = LEN(SRC$(0))
  PRINT "F(";
  FOR I = 0 TO VARNUM - 1
    PRINT CHR$(65 + I);
    IF NOT I = VARNUM - 1 THEN
      PRINT ",";
    END IF
  NEXT I
  PRINT ") = ";
  FOR J = 0 TO SNUM - 1
    FOR K = 1 TO VARNUM
      CHARSRC$ = RIGHT$(LEFT$(SRC$(J), K), 1)
      IF CHARSRC$ = "0" THEN
        PRINT CHR$(65 + K - 1) + "'";
      ELSEIF CHARSRC$ = "1" THEN
        PRINT CHR$(65 + K - 1) + " ";
      END IF
    NEXT K
    IF NOT J = SNUM - 1 THEN
      PRINT " + ";
    END IF
  NEXT J
  PRINT

END SUB