DECLARE FUNCTION Match% (mask$, expr$)
DECLARE SUB strXOR (sFrom$, sTo$)
DECLARE FUNCTION TotWords% ()
DECLARE SUB DisplayWords (nnn%)
DEFINT A-Z
CLS
PRINT "Cruzadox 1.0 á"
PRINT "Jogador automatico de Cruzadox"
PRINT "Copyright (c) WendelSoft, 1997-2001"
PRINT
DIM SHARED MaxL, MaxC
INPUT "# de linhas,colunas : ", MaxL, MaxC
DIM SHARED Tela(1 TO MaxL, 1 TO MaxC) AS STRING * 1
DIM SHARED Word(2 TO 15, 1 TO 40) AS STRING, nWord(2 TO 15)
DIM SHARED ok(2 TO 15, 1 TO 40)
FOR i = 1 TO MaxL: FOR j = 1 TO MaxC: Tela(i, j) = " ": NEXT j, i
PRINT "Digite palavras entre 2 e 15 letras, ou <ENTER> para terminar:"
readmode = 0
DO
   IF NOT readmode THEN LINE INPUT p$
   IF p$ = "*" THEN readmode = -1: RESTORE Letras
   IF p$ = "#" THEN readmode = -1: RESTORE Numeros
   IF readmode THEN READ p$: PRINT p$; " "; : t! = TIMER: DO: LOOP UNTIL TIMER - t! >= .01
   i = LEN(p$)
   p$ = UCASE$(p$)
   IF i = 0 THEN EXIT DO
   nWord(i) = nWord(i) + 1
   Word(i, nWord(i)) = p$
LOOP
PRINT
PRINT "Na proxima tela, tecle:"
PRINT "  <espa‡o> para marcar/apagar blocos"
PRINT "  <Enter>  para definir primeira palavra"
PRINT "  <ESC>    para terminar"
PRINT
PRINT "Pressione alguma tecla..."
a$ = INPUT$(1)
CLS
WIDTH 40
LOCATE 1, 1: PRINT STRING$(MaxC + 2, "Û");
FOR i = 2 TO MaxL + 1
   LOCATE i, 1: PRINT "Û";
   LOCATE , MaxC + 2: PRINT "Û";
NEXT
LOCATE MaxL + 2, 1: PRINT STRING$(MaxC + 2, "Û");
lin = MaxL \ 2 + 1
col = MaxC \ 2 + 1
k$ = Tela(lin, col)
LOCATE lin + 1, col + 1: PRINT "+";
HaveWord = 0
DO
   al = lin: ac = col
   ak$ = k$
   kb$ = INKEY$
   SELECT CASE kb$
      CASE CHR$(0) + "H": lin = lin - 1: IF lin < 1 THEN lin = MaxL
      CASE CHR$(0) + "P": lin = lin + 1: IF lin > MaxL THEN lin = 1
      CASE CHR$(0) + "K": col = col - 1: IF col < 1 THEN col = MaxC
      CASE CHR$(0) + "M": col = col + 1: IF col > MaxC THEN col = 1
      CASE CHR$(27): LOCATE lin + 1, col + 1: PRINT Tela(lin, col); : EXIT DO
      CASE "A" TO "Z", "a" TO "z", "0" TO "9": k$ = UCASE$(kb$)
      CASE " "
         IF NOT HaveWord THEN
            IF k$ = " " THEN k$ = "Û" ELSE k$ = " "
         END IF
      CASE CHR$(13)
         IF NOT HaveWord THEN
            ct = 0
            IF lin > 1 THEN IF Tela(lin - 1, col) <> " " THEN ct = ct OR 2
            IF lin = 1 THEN ct = ct OR 2
            IF col > 1 THEN IF Tela(lin, col - 1) <> " " THEN ct = ct OR 1
            IF col = 1 THEN ct = ct OR 1
            IF ct = 0 THEN GOTO Continue
            maxh = 0
            maxv = 0
            IF ct AND 2 THEN
               FOR i = lin TO MaxL
                  IF Tela(i, col) <> " " THEN EXIT FOR
                  maxv = maxv + 1
               NEXT
            END IF
            IF ct AND 1 THEN
               FOR i = col TO MaxC
                  IF Tela(lin, i) <> " " THEN EXIT FOR
                  maxh = maxh + 1
               NEXT
            END IF
            IF maxh < 2 AND maxv < 2 THEN GOTO Continue
            IF maxh < 2 AND maxv >= 2 THEN
               IF nWord(maxv) = 0 THEN GOTO Continue
            ELSEIF maxh >= 2 AND maxv < 2 THEN
               IF nWord(maxh) = 0 THEN GOTO Continue
            ELSEIF maxh >= 2 AND max >= 2 THEN
               IF nWord(maxh) = 0 AND nWord(maxv) = 0 THEN GOTO Continue
            END IF
            HaveWord = -1
            item = 1
            page = maxh
            IF page < 2 THEN page = maxv
            DisplayWords page
            LOCATE item + 1, 24: PRINT ">";
            DO
               aitem = item
               apage = page
               SELECT CASE INKEY$
                  CASE CHR$(0) + "H"
                     item = item - 1
                     IF item < 1 THEN item = nWord(page)
                  CASE CHR$(0) + "P"
                     item = item + 1
                     IF item > nWord(page) THEN item = 1
                  CASE CHR$(0) + "M", CHR$(0) + "K"
                     page = maxh + maxv - page
                     IF page < 2 THEN page = apage
                  CASE CHR$(27): HaveWord = 0: EXIT DO
                  CASE CHR$(13)
                     IF maxh <> maxv THEN
                        IF page = maxh THEN Dire = 1 ELSE Dire = 2
                        EXIT DO
                     ELSE
                        DO: k$ = INKEY$: LOOP UNTIL k$ = CHR$(0) + "M" OR k$ = CHR$(0) + "P"
                        IF k$ = CHR$(0) + "M" THEN Dire = 1 ELSE Dire = 2
                        EXIT DO
                     END IF
               END SELECT
               IF page <> apage THEN
                  item = 1
                  DisplayWords page
               END IF
               IF aitem <> item THEN
                  LOCATE (aitem - 1) MOD 20 + 2, ((aitem - 1) \ 20) * (page + 1) + 24: PRINT " ";
                  LOCATE (item - 1) MOD 20 + 2, ((item - 1) \ 20) * (page + 1) + 24: PRINT ">";
               END IF
            LOOP
            IF HaveWord THEN
               kl = lin: kc = col
               vl = -(Dire = 2): vc = -(Dire = 1)
               COLOR 15, 0
               ok(page, item) = -1
               FOR i = 1 TO page
                  LOCATE kl + 1, kc + 1: PRINT MID$(Word(page, item), i, 1);
                  Tela(kl, kc) = MID$(Word(page, item), i, 1)
                  kl = kl + vl: kc = kc + vc
               NEXT
               COLOR 7, 0
               EXIT DO
            END IF
         END IF
   END SELECT
   IF al <> lin OR ac <> col OR k$ <> ak$ THEN
      LOCATE al + 1, ac + 1: PRINT ak$;
      Tela(al, ac) = k$
      k$ = Tela(lin, col)
      IF k$ = " " THEN COLOR 7, 0 ELSE COLOR 0, 7
      LOCATE lin + 1, col + 1: PRINT "+";
      COLOR 7, 0
   END IF
Continue:
LOOP
BEEP
k$ = INPUT$(1)
DIM StartP(1 TO MaxL * MaxC * 2)
MaxS = 0
FOR i = 1 TO MaxL
   FOR j = 1 TO MaxC
      IF Tela(i, j) <> "Û" THEN
         IF i = 1 THEN
            MaxS = MaxS + 1
            StartP(MaxS) = 100 * i + j
         ELSE
            IF Tela(i - 1, j) = "Û" THEN
               MaxS = MaxS + 1
               StartP(MaxS) = 100 * i + j
            END IF
         END IF
         IF j = 1 THEN
            MaxS = MaxS + 1
            StartP(MaxS) = -100 * i - j
         ELSE
            IF Tela(i, j - 1) = "Û" THEN
               MaxS = MaxS + 1
               StartP(MaxS) = -100 * i - j
            END IF
         END IF
      END IF
   NEXT
NEXT
kick! = TIMER
Dire = 2
DO WHILE TotWords > 0 AND INKEY$ = ""
   Dire = 3 - Dire
   vl = -(Dire = 2): vc = -(Dire = 1)
   p = 1
   DO WHILE p <= MaxS
      posit = StartP(p)
      IF (Dire = 1 EQV posit < 0) THEN
         posit = ABS(posit)
         li = posit \ 100: co = posit MOD 100
         kl = li: kc = co
         size = 0
         mask$ = ""
         DO WHILE Tela(kl, kc) <> "Û"
            size = size + 1
            mask$ = mask$ + Tela(kl, kc)
            kl = kl + vl: kc = kc + vc
            IF kl > MaxL OR kc > MaxC THEN EXIT DO
         LOOP
         IF size < 2 THEN
            StartP(p) = StartP(MaxS): MaxS = MaxS - 1
            p = p - 1
         ELSE
            IF nWord(size) > 0 THEN
               nw$ = ""
               FOR i = 1 TO nWord(size)
                  IF NOT ok(size, i) THEN
                     IF Match(mask$, Word(size, i)) THEN
                        IF nw$ = "" THEN nw$ = Word(size, i) ELSE strXOR Word(size, i), nw$
                     END IF
                  END IF
               NEXT
               IF RTRIM$(nw$) <> "" THEN
                  aTotWords = TotWords
                  IF INSTR(nw$, " ") = 0 THEN
                     FOR i = 1 TO nWord(size)
                        IF Word(size, i) = nw$ AND NOT ok(size, i) THEN ok(size, i) = -1: EXIT FOR
                     NEXT
                     DisplayWords size
                     kick! = TIMER
                  END IF
                  kl = li: kc = co
                  DO WHILE Tela(kl, kc) <> "Û"
                     Tela(kl, kc) = LEFT$(nw$, 1)
                     nw$ = MID$(nw$, 2)
                     IF SCREEN(kl + 1, kc + 1) = 32 THEN LOCATE kl + 1, kc + 1: PRINT Tela(kl, kc);
                     kl = kl + vl: kc = kc + vc
                     IF kl > MaxL OR kc > MaxC THEN EXIT DO
                  LOOP
                  IF aTotWords <> TotWords THEN BEEP
               END IF
            END IF
         END IF
      END IF
      p = p + 1
   LOOP
   IF TIMER - kick! > 5 THEN
      PLAY "MBo4l64cdefgab"
      kick! = TIMER
      FOR l = 1 TO MaxL
         FOR c = 1 TO MaxC
            IF Tela(l, c) = " " THEN
               Hsize = 1
               Vsize = 1
               Hposit = 100 * l + c
               Hrelat = 1
               Hmask$ = " "
               Vposit = 100 * l + c
               Vrelat = 1
               Vmask$ = " "
               FOR i = l + 1 TO MaxL
                  IF Tela(i, c) = "Û" THEN EXIT FOR
                  Vmask$ = Vmask$ + Tela(i, c)
                  Vsize = Vsize + 1
               NEXT
               FOR i = l - 1 TO 1 STEP -1
                  IF Tela(i, c) = "Û" THEN EXIT FOR
                  Vmask$ = Tela(i, c) + Vmask$
                  Vposit = 100 * i + c
                  Vrelat = Vrelat + 1
                  Vsize = Vsize + 1
               NEXT
               FOR i = c + 1 TO MaxC
                  IF Tela(l, i) = "Û" THEN EXIT FOR
                  Hmask$ = Hmask$ + Tela(l, i)
                  Hsize = Hsize + 1
               NEXT
               FOR i = c - 1 TO 1 STEP -1
                  IF Tela(l, i) = "Û" THEN EXIT FOR
                  Hmask$ = Tela(l, i) + Hmask$
                  Hposit = 100 * l + i
                  Hrelat = Hrelat + 1
                  Hsize = Hsize + 1
               NEXT
               IF Vsize >= 2 AND Hsize >= 2 THEN
                  vList$ = ""
                  FOR i = 1 TO nWord(Vsize)
                     IF NOT ok(Vsize, i) THEN
                        IF Match(Vmask$, Word(Vsize, i)) THEN
                           char$ = MID$(Word(Vsize, i), Vrelat, 1)
                           IF INSTR(vList$, char$) = 0 THEN vList$ = vList$ + char$
                        END IF
                     END IF
                  NEXT
                  hList$ = ""
                  FOR i = 1 TO nWord(Hsize)
                     IF NOT ok(Hsize, i) THEN
                        IF Match(Hmask$, Word(Hsize, i)) THEN
                           char$ = MID$(Word(Hsize, i), Hrelat, 1)
                           IF INSTR(hList$, char$) = 0 THEN hList$ = hList$ + char$
                        END IF
                     END IF
                  NEXT
                  inter$ = ""
                  FOR i = 1 TO LEN(hList$)
                     c$ = MID$(hList$, i, 1)
                     IF INSTR(vList$, c$) > 0 THEN inter$ = inter$ + c$
                  NEXT
                  IF LEN(inter$) = 1 THEN
                     Tela(l, c) = inter$: LOCATE l + 1, c + 1: PRINT inter$;
                  END IF
               END IF
            END IF
         NEXT
      NEXT
   END IF
LOOP
SYSTEM
Letras:
DATA BA,EC,IL,VA
DATA ACA,AMO,APA,ARA,ARE,ASA,ATO,AVE,ECO,ELA,ERA,ERI,ETA,IBC,ITA,ITU,OCA,OCO
DATA  OLA,OLE,ONO,ORA
DATA ELAR,IBIS,POPA,TOCA
DATA ABANO,ACARI,APELO,APITO,APODE,ASILO,CLARA,EPOCA,GRAMA,ITALA,LIDAR,NATAL
DATA  OCASO,PAPEL,TUNEL
DATA DILATAR,OPERETA,ORADORA,
Numeros:
DATA 31415926,53589793,23846264,33832795,02884197,16939937,51027182,81828459
DATA 35230158,13332611,45888908,18438322,59624978,97271914,29699385,63457729,

SUB DisplayWords (nnn)
LOCATE 1, 25: PRINT nnn; "Letras";
FOR i = 1 TO 20
   LOCATE i + 1, 25: PRINT SPACE$(15);
NEXT
lin = 2: col = 25
FOR i = 1 TO nWord(nnn)
   IF ok(nnn, i) THEN COLOR 15, 0
   LOCATE lin, col: PRINT Word(nnn, i);
   lin = lin + 1
   IF lin = 22 THEN
      lin = 2: col = col + nnn + 1
   END IF
   COLOR 7, 0
NEXT
END SUB

FUNCTION Match (mask$, expr$)
FOR i = 1 TO LEN(mask$)
   IF MID$(mask$, i, 1) <> " " AND MID$(mask$, i, 1) <> MID$(expr$, i, 1) THEN Match = 0: EXIT FUNCTION
NEXT
Match = -1
END FUNCTION

SUB strXOR (sFrom$, sTo$)
FOR i = 1 TO LEN(sFrom$)
   IF MID$(sTo$, i, 1) <> " " THEN
      IF MID$(sTo$, i, 1) <> MID$(sFrom$, i, 1) THEN
         MID$(sTo$, i, 1) = " "
      END IF
   END IF
NEXT
END SUB

FUNCTION TotWords
s = 0
FOR i = 2 TO 15
   FOR j = 1 TO nWord(i)
      s = s + 1 + ok(i, j)
   NEXT
NEXT
TotWords = s
END FUNCTION