Announcement

Collapse
No announcement yet.

Word Progression Puzzle

Collapse
X
Collapse
 
  • Page of 5
  • Filter
  • Time
  • Show
Clear All
new posts
Previous 1 5 template Next
    #81
    Check this out:
    BRAIN TRAIN TRAIT TRACT TRACK TRICK THICK THINK THINS SHINS SKINS SKINK SKUNK SKULK SKULL

    So I was able to get a mega sequence where the original program came up with:
    "No Chains found! BRAIN to SKULL..." I just went BRAIN to THINK and THINK to SKULL. This technique can overcome the 10 word sequence max find limitation. You can then test for shorter solutions by trying various segments of the above solution, like BRAIN to SKULK for example: SKULK SKUNK STUNK STANK STAND STAID STAIN SLAIN BLAIN BRAIN, then add SKULL and voila! 11 word shortest sequence: SKULL SKULK SKUNK STUNK STANK STAND STAID STAIN SLAIN BLAIN BRAIN

    Comment

      #82
      Originally posted by John Gleason View Post
      Check this out:
      BRAIN TRAIN TRAIT TRACT TRACK TRICK THICK THINK THINS SHINS SKINS SKINK SKUNK SKULK SKULL

      So I was able to get a mega sequence where the original program came up with:
      "No Chains found! BRAIN to SKULL..." I just went BRAIN to THINK and THINK to SKULL. This technique can overcome the 10 word sequence max find limitation. You can then test for shorter solutions by trying various segments of the above solution, like BRAIN to SKULK for example: SKULK SKUNK STUNK STANK STAND STAID STAIN SLAIN BLAIN BRAIN, then add SKULL and voila! 11 word shortest sequence: SKULL SKULK SKUNK STUNK STANK STAND STAID STAIN SLAIN BLAIN BRAIN
      Clever. you must be REALLY intriqued with this sequence stuff {grin}.
      This technique can overcome the 10 word sequence max find limitation.
      Where do you set the 10 word limit? In the Macro calls? is it "seqLenMax"? Maybe I'll fool around and see it it can be raised without causing any aberrant behavior.

      PS. Been meaning to ask. How do you like the Icon? Seems appropriate given the time we are each spending on this. {grin}
      It's a pretty day. I hope you enjoy it.

      Gösta

      JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
      LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

      Comment

        #83
        Maybe I'll fool around and see it it can be raised without causing any aberrant behavior.
        Okay, tried several things but no success. Even GPF'ed when exiting. Enough for me on that subject. Ain't fixin what ain't broke.

        ======================================
        High thoughts must have high language.
        Aristophanes
        ======================================
        It's a pretty day. I hope you enjoy it.

        Gösta

        JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
        LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

        Comment

          #84
          Where do you set the 10 word limit?
          It isn't really a set limit as such, rather the algo just ends after it fails to find a sequence in ten words. It compares start-word five-word sequences to end-word five-word sequences, and if there is no answer, end function.

          I could add a six-word compare to increase the potential sequence length to 12 max, but the comparison array for six words must account for the possibility of an exponentially larger data set than even five, which is already 32000 thirty-byte elements. Six words would probably need 128000 36-byte elements to avoid GPF's, and seven words (14 word max sequence) might need 512K 42-byte elements. For the seven-word array alone, that's at least 21MB of memory needed. Add in the previous six allocated arrays and the program uses, oh, 40 or 50 megs of RAM, and the processing time of that memory (the arrays) increases exponentially too.

          The question one might ask is, "How long of a sequence is long enough?" If it's a computer programming competition, welp, pull out all the stops. I'm going for EIGHTEEN WORD SHORTEST SEQUENCES. It may take a memory upgrade, many minutes/hours per pair, and days/weeks to find a single valid connection, but when your pride is at stake, what's a cool eighty-three hours of cpu time? It's just a li'l blip geologically speaking, right?

          Now if it's a human solving a pair, I'm thinking 90% are seriously challanged by HAND-FOOT, 99.9% by THINK-BRAIN, and a whopping (100 - 10^-8)% by BRAIN-SKULL. (Notice that I haven't even gotten to six-letter words yet).

          btw, the icons are coo, and tho the main icon is ABSOLUTELY appropriate, I think I'd like "the kid" for the main icon too.

          Comment

            #85
            Gösta, there's one other question you might ask about increasing the sequence length: If you can increase it (5-letters for now) to 12-word max in 10 minutes total programming time, what's the big whoop?

            It's so close to being recursive, that's all it took. It took 30 minutes to question if it was worth trying. woof

            Code:
            SKULL SKULK SKUNK SKINK SLINK BLINK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SKINK SLINK BLINK BLIND BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SKINK SLINK BLINK BLIND BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SKINK SLINK BLINK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SLUNK CLUNK CLANK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SLUNK CLUNK CLANK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SLUNK CLUNK CLANK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SLUNK CLUNK CLANK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SKINK SLINK BLINK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SKINK SLINK CLINK CLANK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SLUNK CLUNK CLANK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SLUNK CLUNK CLANK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SLUNK FLUNK FLANK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SLUNK FLUNK FLANK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SLUNK FLUNK FLANK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SLUNK FLUNK FLANK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SLUNK FLUNK FLANK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SLUNK PLUNK PLANK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SLUNK PLUNK PLANK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SLUNK PLUNK PLANK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SLUNK PLUNK PLANK PLANT PLAIT PLAIN BLAIN BRAIN
SKULL SKULK SKUNK SLUNK PLUNK PLANK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SLUNK PLUNK PLANK PLANT PLAIT PLAIN BLAIN BRAIN
SKULL SKULK SKUNK SLUNK PLUNK PLANK PLANT PLAIT PLAIN BLAIN BRAIN
SKULL SKULK SKUNK SLUNK PLUNK PLINK BLINK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SLUNK PLUNK PLANK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SLUNK PLUNK PLANK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK SLUNK PLUNK PLANK BLANK BLAND BRAND BRAID BRAIN
SKULL SKILL SHILL SHALL SHAWL SHAWN SPAWN SPAIN SLAIN BLAIN BRAIN
SKULL SKILL SHILL SHALL SHAWL SHAWN SPAWN SPAIN SLAIN BLAIN BRAIN
SKULL SKILL SHILL SHALL SHAWL SHAWN SPAWN SPAIN SLAIN BLAIN BRAIN
SKULL SKILL SHILL SHALL SHAWL SHAWN SPAWN SPAIN SLAIN BLAIN BRAIN
SKULL SKILL SHILL SHALL SHAWL SHAWS CHAWS CRAWS CRAWL BRAWL BRAIL BRAIN
SKULL SKILL SHILL SHALL SHAWL SHAWN SPAWN SPAIN SLAIN BLAIN BRAIN
SKULL SKULK SKUNK SLUNK SLUNG SLANG SLANT PLANT PLAIT PLAIN BLAIN BRAIN
SKULL SKULK SKUNK SLUNK SLINK BLINK BLANK BLAND BRAND BRAID BRAIN
SKULL SKULK SKUNK STUNK STANK STAND STAID STAIN SLAIN BLAIN BRAIN
SKULL SKULK SKUNK STUNK STANK STAND STAID STAIN SLAIN BLAIN BRAIN
SKULL SKILL STILL STALL STALK STANK STAND STAID STAIN SLAIN BLAIN BRAIN
SKULL SKILL STILL STILE STELE STERE STERN STEIN STAIN SLAIN BLAIN BRAIN

            Comment

              #86
              John, you're the guy doing the solving algos. I just thought it was neat to display all possibilities, even extremely long lists. But given the memory requirements you cite, one has to draw a line somewhere. And I'm quite happy with your line.

              As for the icon, it's "Zero" from Beetle Bailey. I'm not familiar with "the kid". Who would that be?
              It's a pretty day. I hope you enjoy it.

              Gösta

              JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
              LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

              Comment

                #87
                As for the icon, it's "Zero" from Beetle Bailey. I'm not familiar with "the kid". Who would that be?
                The kid I referred to is "Zero". For some reason, my main icon is a blue anchor on a white background. "Zero" is on the little taskbar & explorer icon.

                This code below does up to 14-word sequences for 4,5, and 6 letters. The catch? After a couple searches (occasionally maybe even on the second search) it page faults. But the first search has always worked, so you'll get the answer at least. That's why I call it the Research Only version. :thinking: If ya think about it, what are a couple clicks to restart the program in the big scheme of things? As of a few days ago, finding a 14-word connection would have taken, what, 14 days? weeks? months? hehheh
                '
                Code:
                '5 ltr    ''SWIMS-CRAMP. It produced SWIMS SLIMS SLAMS CLAMS CLAMP CRAMP.
'   Inword = UCASE$("creepy")
'   outWord = UCASE$("shocks")
'    Inword = UCase$("voting")
'    outWord = UCase$("server")


'            Word_Connections.Bas
'
' This project started here:
'http://www.powerbasic.com/support/pbforums/showthread.php?t=36427
'
'   The files are here:
'http://www.SwedesDock.com/powerbasic/Word_Connections.exe
'http://www.SwedesDock.com/powerbasic/z_WC_All_Files_Needed.zip
'
'
' GUI by Gösta H. Lovgren (Feb 2008)
' Solving functions by John Gleason (Feb 2008)
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'
' Changes required for adding new letter connection Functions
'  1) Just add to Select Case in "Sub John_Solver"
'
'  2) Rem these two lines in new Function
'
'  If ii3 < 8 Then ? "Note: Only up to eight sequences will be shown of possibly 100's" & $CrLf & $CrLf & _
'  RTrim$(sTemp)     'there can be hundreds, so ii3 limits it to 8 results
'
'  3) Add these two lines at same place
'
'   ReDim Preserve Sequences$(UBound(Sequences$()) + 1)
'   Sequences$(UBound(Sequences$())) = sTemp
'
'  4) Add these lines at beginning in newly added Functions
'    inWord = First_Word$
'     outWord = Last_Word$
'
'  5) Rem any "inword = " in Function
'     Rem any outWord = " in Function
'
'  6) Search & Replace:
'     "? RTrim$(sTemp)"
'           With
'     "'? RTrim$(sTemp)"
'
' Fingers Crossed, I think that's all that's needed '
'
'Latest replacemts:
'1         at here: (in functions 3, 4 & 5)
'  Local inWord As String * %NUMBofLETTERS3, outWord As String * %NUMBofLETTERS3
  '       add :
  '  inWord = First_Word$
  '   outWord = Last_Word$
'
'2 Rem all "Print #2, inWord, outWord" 's
'     Insert underneath:
'  ReDim Preserve Sequences$(UBound(Sequences$()) + 1)
'    Sequences$(UBound(Sequences$())) = sTemp
'
'------------------------------------------------------------------------------
' Note - you may have to Rem "Call Backup" in PBMain if I forget. {oh well}
'  If so you'll probably get an msgbox or error when exitting.
'------------------------------------------------------------------------------
' This program may be used for any purpose whatsoever;
'  sale, gift, sharing, swapped for dope, ...
'  Only after sending certified checks for an appropriate amount to
'  John and myself.
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------

#COMPILE EXE
#DIM ALL

'------------------------------------------------------------------------------
'   ** My normal Includes **
'------------------------------------------------------------------------------
#INCLUDE "WIN32API.INC"

'#Include "C:\Power Basic\Includes\clipboard.inc"
'#Include "C:\Power Basic\Includes\Common_Constants.inc"
'#Include "c:\Power Basic\Includes\Fonts.inc"
'#Include "c:\Power Basic\Includes\Colors.inc"
'#Include "C:\Power Basic\Includes\Common_Macros.inc"
'#Include "C:\Power Basic\Includes\process_memoryinfo.inc"
'#Include "C:\Power Basic\Includes\Common_Subs_Funcs.inc"
'#Resource "C:\Power Basic\Icons\Icons.pbr"
'#Include "C:\Power Basic\Includes\File_Exist.inc"
'#Include "C:\Power Basic\Includes\Variables_Common_to_All_Programs.inc"
'------- End my "normal Includes" not needed in this progam though ------
'
' Includes specific to this program:
'
'      'my stuff loaded In PB Main
' #Include g_Include_Name$ ' creates g_All_Words$
'
#RESOURCE "Icons.pbr"
'
'
'
 GLOBAL First_Word$, Last_Word$, Sequences$()
'------------------------------------------------------------------------------

TYPE GoodWords
   Wrd AS STRING * 28
   lng AS LONG
   Good AS LONG '
END TYPE


%Box_Height    = 20
%Char_Width    = 5


%Btn_01          = 1002
%Word_Start      = 1003
%Word_Done       = 1004
%Working_Label   = 1005
%Btn_CB_Toggle   = 1006
%ID_EXIT         = 1007
%About           = 1008
%Cb_All          = 1009
%CB_One          = 1010
%Cb_Results_Only = 1011
%Btn_Shortcut    = 1012
%Cb_Show_It      = 1013
%CB_Dialog_Box   = 1014
%CB_Erase_It     = 1015
%Btn_02          = 1016
'------------------------------------------------------------------------------
'
 GLOBAL g_Words$() 'only used to build g_Include_Name$, not used otherwise in prog
 GLOBAL g_CB_All_or_One& '= 2 as default at startup for Clipboard stuff
 GLOBAL g_All_Words$  ' All words in 1 string for data checking, assigned vis the above include
 GLOBAL hMenu AS DWORD
 GLOBAL hdlg AS DWORD
 GLOBAL First_Word$, Last_Word$, Sequences$()
 GLOBAL g_Include_Name$ '= CurDir$ & "Check_Words_5_6.Inc" '5-6 words
 GLOBAL g_Icon_Id$
'------------------------------------------------------------------------------
'   ** Macros **
'------------------------------------------------------------------------------
'
MACRO Common_Locals
  LOCAL Reps&
  LOCAL Number_of_Words&, Words_In_File&, Word_Len&
  LOCAL total_Words_in_File$

  LOCAL W$, w1$, w2$, w3$
    LOCAL WL$(), Word_List$
  LOCAL Used_Words$()
  LOCAL Ttls&(), tb_len&

  LOCAL Chn$, Fw$, Lw$, sw$ 'in Swede_Solver
' Variables_Common_to_All_Programs
  LOCAL a&, a1&, a2&, a3&, a4&, a5&, Ans&, askii&, Askii_Last&

  LOCAL b&, Box_Height&, Box_Width&, Btn_Width&, Btn_Height&
    LOCAL Beep_Freq AS DWORD, Beep_Duration AS DWORD
    LOCAL Beep_Ctr&, Beep_b&

  LOCAL Caption$, chk$
     LOCAL col&, col1&, col2&, col3&, col4&, col5&
     LOCAL ctr&, ctr1&, ctr2&, ctr3&, ctr4&, ctr5&

  LOCAL End_Marked&, Start_Marked&
   LOCAL er$ 'used for error msgs

  LOCAL Flag&, Flag1&, Flag2&, Flag3&, Flag4&, Flag5&
  LOCAL Fle$, Fle1$, Fle2$, Fle3$, Fle4$, Fle5$
    LOCAL Flen&, Flen1&, Flen2&, Flen3&, Flen4&, Flen5&
    LOCAL Fn$, Fn1$, Fn2$, Fn3$, Fn4$, Fn5$
    LOCAL fnum&, fnum1&, fnum2&, fnum3&, fnum4&, fnum5&

  GLOBAL g_Timer#

  LOCAL hght&, hFont&, Highlighted_Word_Flag&

  LOCAL i&, i1&, i2&, i3&, i4&, i5&
    LOCAL Id&, Id1&, Id2&, Id3&, Id4&, Id5&

  LOCAL l$, l1$, l2$, l3$, l4$, l5$
    LOCAL lbl$, Last_i&, lRslt&
    LOCAL ln&, ln1&, ln2&, ln6&, ln4&, ln5&

  LOCAL m$, m1$, m2$, m3$, m4$, m5$

  LOCAL n$, n1$, n2$, n3$, n4$, n5$
    LOCAL nm$, nm1$, nm2$, nm3$, nm4$, nm5$
    LOCAL NumLines&

  LOCAL Row&, Row1&, Row2&, Row3&, Row4&, Row5&
    LOCAL rn&, rn1&

  LOCAL s$, s1$, s2$, s3$, s4$, s5$

  LOCAL Sln&, sp$, Stile&, stp&

  LOCAL t$, t1$, t2$, t3$, t4$, t5$
   LOCAL Tb_Height&, Tgl$
   LOCAL temp$
   LOCAL ttl&, ttl1&, ttl2&, ttl3&, ttl4&, ttl5&
   LOCAL tmp$(), tmp1$(), tmp1$(), tmp2$(), tmp3$(), tmp4$(), tmp5$()

  LOCAL u$, url$

  LOCAL v&, vlu&

  LOCAL Wdth&, Wait&

  LOCAL x1&, x2&, x3&, x4&, x5&

  LOCAL y&, y1&, y2&, y3&, y4&, y5&

  Wait = 20'2000 'for display purposes


  %Top = %MB_TASKMODAL 'keep for older msgbox msgs
'Common RGB Colors from Win32Api.Inc
'  %Black   = &H000000???
'  %Blue    = &HFF0000???
'  %Green   = &H00FF00???
'  %Cyan    = &HFFFF00???
'  %Red     = &H0000FF???
'  %Magenta = &HFF00FF???
'  %Yellow  = &H00FFFF???
'  %White   = &HFFFFFF???
'  %Gray    = &H808080???
'  %LtGray  = &HC0C0C0???
  %Purple = &hFF5588
  %BabyBlue = 167 + (241 * 256) + (252 * 256 * 256)
  %Pink     = 255 + (132 * 256) + (132 * 256 * 256)
  %Cream    = 252 + (241 * 256) + (167 * 256 * 256)
  %BiliousYG = %Cream + 1000 ' Bilious Yellow Green
  %MintGreen = &HD0FFD0
  %Win_Gray = &hEAE9E8

END MACRO
'
MACRO Is_It_Valid = i = INSTR(g_All_Words$, " " & sw$ & " ")
'
MACRO m_Done = DIALOG END hDlg
'
MACRO Label_ClipBoard
   SELECT CASE g_CB_All_or_One
      CASE 0
        lbl$ = "Add All Chains to Clipboard"
      CASE 1
        lbl$ = "Add Only the Current Chain to Clipboard"
      CASE 2
        lbl$ = "Add Only Results to Clipboard"
   END SELECT
   CONTROL SET TEXT CBHNDL, %Btn_CB_Toggle, lbl$
END MACRO
'
'
MACRO m_T_into_Tmp_Array
    ctr = PARSECOUNT(t$, $CRLF)
      DIM tmp$(ctr)
    PARSE t$, tmp$(), $CRLF
END MACRO
'
MACRO Label_Bum_Input
    BEEP
    lbl$ = $CRLF & $CRLF & "! ! ! ! ! ! !" & $CRLF & $CRLF & _
           lbl$ & $CRLF & $CRLF & "! ! ! ! ! ! !"
    CONTROL SET COLOR hDlg, %Working_Label, %YELLOW, %Purple
    CONTROL SET TEXT hDlg, %Working_Label, lbl$
    EXIT SUB
END MACRO
'
MACRO Label_Set_Main
    CONTROL SET COLOR hDlg, %Working_Label, -1, %Win_Gray
    lbl$ =  $CRLF & _
           "Solving Algorithm " & $CRLF & _
           "   Courtesy of:   " & $CRLF & $CRLF & _
           "   John Gleason   " & $CRLF & $CRLF & _
           "       and        " & $CRLF & _
           " PowerBASIC Forums"
    CONTROL SET TEXT hDlg, %Working_Label, lbl$
END MACRO
'
MACRO Label_Set_Working
    CONTROL SET COLOR hDlg, %Working_Label, -1, %YELLOW
    lbl$ = $CRLF & _
           "Working" & $CRLF & _
           "on" & $CRLF & _
           "Algorithm" & $CRLF & _
           "for" & $CRLF & _
           MCASE$(First_Word$) & " " & MCASE$(Last_Word$)
    CONTROL SET TEXT hDlg, %Working_Label, lbl$
    SLEEP Wait
END MACRO
'
MACRO Label_Set_No_Answer
    CONTROL SET COLOR hDlg, %Working_Label, %WHITE, %Pink
    lbl$   =  $CRLF & $CRLF & "No Chains found!" & _
            $CRLF & $CRLF &  _
            First_Word$ & " to " & Last_Word$ & $CRLF & $CRLF & _
            "Solved in " & $CRLF & _
            USING$(".## Seconds ", TIMER - g_Timer)
    CONTROL SET TEXT hDlg, %Working_Label, lbl$
    REPLACE  $CRLF WITH " " IN lbl$
    t$ = lbl$
    Set_Clipboard
    SLEEP Wait
    SLEEP Wait
END MACRO
'
MACRO Label_Set_Done
    CONTROL SET COLOR hDlg, %Working_Label, -1, %BabyBlue
    lbl$ =   $CRLF & _
             MCASE$(First_Word$) & $CRLF & _
             "to " & $CRLF & _
             MCASE$(Last_Word$) & $CRLF & $CRLF & _
             USING$("# Answer Chains", Flag) & $CRLF & _
            "(in the Clipboard)" & $CRLF & $CRLF &  _
            "Solved in" &  $CRLF & _
            USING$(" .## Seconds", TIMER - g_Timer)
    CONTROL SET TEXT hDlg, %Working_Label, lbl$
    SLEEP Wait
    SLEEP Wait
END MACRO
'
MACRO m_Input_Open
 fnum = FREEFILE
 OPEN fn$ FOR INPUT AS #fnum
    m$ = fn$ 'for err msg
    m1$ = "m_Input_Open"
    m_Err_Msg
END MACRO
'
MACRO m_Output_Open
  fnum = FREEFILE
  OPEN fn$ FOR OUTPUT AS #fnum
    m$ = fn$ 'for err msg
    m1$ = "m_Output_Open"
    m_Err_Msg
END MACRO
'
MACRO pf = PRINT #fnum,
'
MACRO pf1 = PRINT #fnum1,
'
MACRO pf2 = PRINT #fnum2,
'
MACRO m_Binary_Open
   fnum = FREEFILE
    OPEN fn$ FOR BINARY AS fnum
     flen = LOF(fnum)

   Fle$ = SPACE$(flen)'create a space to put the file
   GET fnum,,fle$  'put the file in the space
   CLOSE fnum
   m$ = fn$
   m1$ = "m_Binary_Open"
   m_Err_Msg 'Msgbox if an error
END MACRO
'
MACRO m_Err_Msg
 IF ERR THEN
    Stile = %MB_SYSTEMMODAL   OR _
            %MB_ICONERROR  OR _
            %MB_ICONWARNING

   ? m$ & $CRLF & $CRLF & _
     m1$ & $CRLF & $CRLF & _
     USING$("# ", ERR) & ERROR$(ERR),_
     Stile, _
     " In " & FUNCNAME$
 END IF
 RESET m$, m1$
END MACRO
'
MACRO mb
  MSGBOX m$ & $CRLF & $CRLF & m1$, _
        %MB_TASKMODAL, _
        " In " & FUNCNAME$
  RESET m$, m1$
END MACRO
'
MACRO mb_Alert
  MSGBOX m$ & $CRLF & $CRLF & m1$, _
        %MB_TASKMODAL OR %MB_ICONWARNING, _
        " In " & FUNCNAME$
  RESET m$, m1$
END MACRO
'
MACRO Only_The_Results
END MACRO
'

'------------------------------------------------------------------------------
'
'John's stuff
'------------------------------------------------------------------------------
'
'------------------------------------------------------------------------------
'
'------------------------------------------------------------------------------
'
'------------------------------------------------------------------------------
'
$NULL3          = CHR$(0,0,0,32)
$NULL4          = CHR$(0,0,0,0,32)
$NULL5          = CHR$(0,0,0,0,0,32)
$NULL6          = CHR$(0,0,0,0,0,0,32)
%NUMBofLETTERS3 = 3
%NUMBofLETTERS4 = 4
%NUMBofLETTERS5 = 5
%NUMBofLETTERS6 = 6
%NUMBERofWORDS3 = 853
%NUMBERofWORDS4 = 3130
%NUMBERofWORDS5 = 6919
%NUMBERofWORDS6 = 11492
%ARRAYsIZE1  = 100             'if there is a GPF, try making one or more of these array size equates larger
%ARRAYsIZE2  = 2000            '                                   "
%ARRAYsIZE3  = 8000            '                                   "
%ARRAYsIZE4  = 32000           '                                   "
%ARRAYsIZE5  = 48000           '                                   "
%ARRAYsIZE6  = 96000           '                                   "
%RDTSC       = &h310f

#INCLUDE "fiveLetterWordsCompresAsm.inc" 'contains function fiveLetterWords() which is all 5-letter words compressed
#INCLUDE "sixLetterWordsCompresAsm.inc"  'contains function sixLetterWords() which is all 6-letter words compressed
#INCLUDE "fourLetterWordsCompresAsm.inc"  'contains function fourLetterWords() which is all 4-letter words compressed
#INCLUDE "threeLetterWordsCompresAsm.inc"  'contains function threeLetterWords() which is all 3-letter words compressed

MACRO J_mFirstMatchForDifference(mNUMBERofWORDS, mNUMBofLETTERS)
    index = 0
    FOR ii3 = 0 TO mNUMBERofWORDS                  'starting with inWord, test it for any 1-letter-different matches
       IF wordOrig6(ii3) = inWord THEN
       FOR ii2 = 1 TO mNUMBofLETTERS
          acacia(ii2) = word6(ii3) AND blank(ii2)
          FOR ii = 0 TO mNUMBERofWORDS
             IF (word6(ii) AND blank(ii2)) = acacia(ii2) THEN
                IF ii <> ii3 THEN                     'eliminate match with itself
                   a1(index) = word6(ii)
                   as1(index) = wordOrig6(ii) & inWord
                   INCR index
                END IF
             END IF
          NEXT
       NEXT
       END IF
    NEXT

   index2 = 0
    FOR ii3 = 0 TO mNUMBERofWORDS                  'starting with outWord, test it for any 1-letter-different matches
       IF wordOrig6(ii3) = outWord THEN
       FOR ii2 = 1 TO mNUMBofLETTERS
          acacia(ii2) = word6(ii3) AND blank(ii2)
          FOR ii = 0 TO mNUMBERofWORDS
             IF (word6(ii) AND blank(ii2)) = acacia(ii2) THEN
                IF ii <> ii3 THEN                     'eliminate match with itself
                   b1(index2) = word6(ii)
                   bs1(index2) = wordOrig6(ii) & outWord
                   INCR index2
                END IF
             END IF
          NEXT
       NEXT
       END IF
    NEXT
END MACRO

MACRO J_mMatchAndRemoveDupes(index, index2, index3, index4, a1, a2, b1, b2, as1, as2, bs1, bs2, mLASTaRRAYsIZE, mNUMBERofWORDS, mNUMBofLETTERS)
    FOR ii4 = 0 TO index - 1
    FOR ii3 = 0 TO mNUMBERofWORDS                  'starting with a1(), test it for any 1-letter-different matches
       IF word6(ii3) = a1(ii4) THEN
       FOR ii2 = 1 TO mNUMBofLETTERS
          acacia(ii2) = word6(ii3) AND blank(ii2)
          FOR ii = 0 TO mNUMBERofWORDS
             IF (word6(ii) AND blank(ii2)) = acacia(ii2) THEN
                IF ii <> ii3 THEN                     'eliminate match with itself
                   a2(index3) = word6(ii)
                   as2(index3) = wordOrig6(ii) & as1(ii4)
                   INCR index3
                END IF
             END IF
          NEXT
       NEXT
       END IF
    NEXT
    NEXT

    FOR ii4 = 0 TO index2 - 1
    FOR ii3 = 0 TO mNUMBERofWORDS                  'starting with b(1), test it for any 1-letter-different matches
       IF word6(ii3) = b1(ii4) THEN
       FOR ii2 = 1 TO mNUMBofLETTERS
          acacia(ii2) = word6(ii3) AND blank(ii2)
          FOR ii = 0 TO mNUMBERofWORDS
             IF (word6(ii) AND blank(ii2)) = acacia(ii2) THEN
                IF ii <> ii3 THEN                     'eliminate match with itself
                   b2(index4) = word6(ii)
                   bs2(index4) = wordOrig6(ii) & bs1(ii4)
                   INCR index4
                END IF
             END IF
          NEXT
       NEXT
       END IF
    NEXT
    NEXT

'eliminate duplicates in a2() and as2() < this is the human readable version of a2()
    ARRAY SORT a2(), TAGARRAY as2()
    ii2 = 0
    FOR ii = 0 TO mLASTaRRAYsIZE - 1
       IF a2(ii) = 0 THEN ITERATE FOR
       IF a2(ii) = a2(ii + 1) THEN
          ITERATE FOR
       ELSE
          a2(ii2) = a2(ii)
          as2(ii2) = as2(ii)
          INCR ii2
       END IF
    NEXT
    IF a2(mLASTaRRAYsIZE - 1) <> a2(mLASTaRRAYsIZE) THEN 'handle last element
       a2(ii2) = a2(mLASTaRRAYsIZE)
       as2(ii2) = as2(mLASTaRRAYsIZE)
       INCR ii2
    END IF
    FOR ii = ii2 TO mLASTaRRAYsIZE
       a2(ii) = 0
       as2(ii) = ""
    NEXT
'eliminate duplicates in b2() and bs2() < this is the human readable version of b2()
    ARRAY SORT b2(), TAGARRAY bs2()
    ii2 = 0
    FOR ii = 0 TO mLASTaRRAYsIZE - 1
       IF b2(ii) = 0 THEN ITERATE FOR
       IF b2(ii) = b2(ii + 1) THEN
          ITERATE FOR
       ELSE
          b2(ii2) = b2(ii)
          bs2(ii2) = bs2(ii)
          INCR ii2
       END IF
    NEXT
    IF b2(mLASTaRRAYsIZE - 1) <> b2(mLASTaRRAYsIZE) THEN 'handle last element (mLASTaRRAYsIZE)
       b2(ii2) = b2(mLASTaRRAYsIZE)
       bs2(ii2) = bs2(mLASTaRRAYsIZE)
       INCR ii2
    END IF
    FOR ii = ii2 TO mLASTaRRAYsIZE
       b2(ii) = 0
       bs2(ii) = ""
    NEXT
END MACRO

MACRO J_mFindSolution3letters(as1, bs1, seqLenMax)
IF ASC(bs1(ii2)) < 65 THEN EXIT FOR
IF ASC(as1(ii), 1) = ASC(bs1(ii2), 1) AND ASC(as1(ii), 2) = ASC(bs1(ii2), 2) OR _
   ASC(as1(ii), 2) = ASC(bs1(ii2), 2) AND ASC(as1(ii), 3) = ASC(bs1(ii2), 3) OR _
   ASC(as1(ii), 1) = ASC(bs1(ii2), 1) AND ASC(as1(ii), 3) = ASC(bs1(ii2), 3) THEN

  maxSeqLen = seqLenMax
  FOR ii4 = 1 TO maxSeqLen
     q4(ii4)             = CVQ(MID$(as1(ii),  (maxSeqLen - ii4) * %NUMBofLETTERS3 + 1, %NUMBofLETTERS3))
     q4(ii4 + maxSeqLen) = CVQ(MID$(bs1(ii2), (ii4 - 1)         * %NUMBofLETTERS3 + 1, %NUMBofLETTERS3))
  NEXT


  FOR ii5 = 1 TO maxSeqLen + maxSeqLen - 2
     FOR ii4 = 1 TO %NUMBofLETTERS3
        FOR ii6 = ii5 + 2 TO maxSeqLen + maxSeqLen
           IF (q4(ii5) AND blankq(ii4)) = (q4(ii6) AND blankq(ii4)) AND q4(ii5) > 0 THEN
              IF extend < ii6 THEN extend = ii6
           END IF
        NEXT
     NEXT
     FOR ii6 = ii5 + 1 TO extend - 1
        q4(ii6) = 0
     NEXT
     extend = 0
  NEXT

  sTemp = SPACE$(maxSeqLen * (%NUMBofLETTERS3 + 1) * 2 - 1)


  FOR ii4 = 1 TO maxSeqLen * 2
     MID$(sTemp, (ii4 - 1) * (%NUMBofLETTERS3 + 1) + 1, %NUMBofLETTERS3) = MKQ$(q4(ii4))
  NEXT

  INCR ii3
  REPLACE $NULL3 WITH "" IN sTemp
'  Print #2, sTemp
  REDIM PRESERVE Sequences$(UBOUND(Sequences$()) + 1)
    Sequences$(UBOUND(Sequences$())) = sTemp
'  m$ = stemp:mb
END IF
END MACRO

MACRO J_mFindSolution4letters(as1, bs1, seqLenMax)
IF ASC(bs1(ii2)) < 65 THEN EXIT FOR
IF ASC(as1(ii), 1) = ASC(bs1(ii2), 1) AND ASC(as1(ii), 2) = ASC(bs1(ii2), 2) _
   AND ASC(as1(ii), 3) = ASC(bs1(ii2), 3) OR _
   ASC(as1(ii), 2) = ASC(bs1(ii2), 2) AND ASC(as1(ii), 3) = ASC(bs1(ii2), 3) _
   AND ASC(as1(ii), 4) = ASC(bs1(ii2), 4) OR _
   ASC(as1(ii), 1) = ASC(bs1(ii2), 1) AND ASC(as1(ii), 3) = ASC(bs1(ii2), 3) _
   AND ASC(as1(ii), 4) = ASC(bs1(ii2), 4) OR _
   ASC(as1(ii), 1) = ASC(bs1(ii2), 1) AND ASC(as1(ii), 2) = ASC(bs1(ii2), 2) _
   AND ASC(as1(ii), 4) = ASC(bs1(ii2), 4) THEN

 maxSeqLen = seqLenMax
 FOR ii4 = 1 TO maxSeqLen
    q4(ii4)             = CVQ(MID$(as1(ii),  (maxSeqLen - ii4) * %NUMBofLETTERS4 + 1, %NUMBofLETTERS4))
    q4(ii4 + maxSeqLen) = CVQ(MID$(bs1(ii2), (ii4 - 1)         * %NUMBofLETTERS4 + 1, %NUMBofLETTERS4))
 NEXT


 FOR ii5 = 1 TO maxSeqLen + maxSeqLen - 2
    FOR ii4 = 1 TO %NUMBofLETTERS4
       FOR ii6 = ii5 + 2 TO maxSeqLen + maxSeqLen
          IF (q4(ii5) AND blankq(ii4)) = (q4(ii6) AND blankq(ii4)) AND q4(ii5) > 0 THEN
             IF extend < ii6 THEN extend = ii6
          END IF
       NEXT
    NEXT
    FOR ii6 = ii5 + 1 TO extend - 1
       q4(ii6) = 0
    NEXT
    extend = 0
 NEXT

 sTemp = SPACE$(maxSeqLen * (%NUMBofLETTERS4 + 1) * 2 - 1)


 FOR ii4 = 1 TO maxSeqLen * 2
    MID$(sTemp, (ii4 - 1) * (%NUMBofLETTERS4 + 1) + 1, %NUMBofLETTERS4) = MKQ$(q4(ii4))
 NEXT

 INCR ii3
 REPLACE $NULL4 WITH "" IN sTemp
' Print #2, sTemp
  REDIM PRESERVE Sequences$(UBOUND(Sequences$()) + 1)
    Sequences$(UBOUND(Sequences$())) = sTemp

END IF
END MACRO

MACRO J_mFindSolution5letters(as1, bs1, seqLenMax)
IF ASC(bs1(ii2)) < 65 THEN EXIT FOR
IF ASC(as1(ii), 1) = ASC(bs1(ii2), 1) AND ASC(as1(ii), 2) = ASC(bs1(ii2), 2) AND ASC(as1(ii), 3) = ASC(bs1(ii2), 3) _
   AND ASC(as1(ii), 4) = ASC(bs1(ii2), 4) OR _
   ASC(as1(ii), 2) = ASC(bs1(ii2), 2) AND ASC(as1(ii), 3) = ASC(bs1(ii2), 3) AND ASC(as1(ii), 4) = ASC(bs1(ii2), 4) _
   AND ASC(as1(ii), 5) = ASC(bs1(ii2), 5) OR _
   ASC(as1(ii), 1) = ASC(bs1(ii2), 1) AND ASC(as1(ii), 3) = ASC(bs1(ii2), 3) AND ASC(as1(ii), 4) = ASC(bs1(ii2), 4) _
   AND ASC(as1(ii), 5) = ASC(bs1(ii2), 5) OR _
   ASC(as1(ii), 1) = ASC(bs1(ii2), 1) AND ASC(as1(ii), 2) = ASC(bs1(ii2), 2) AND ASC(as1(ii), 4) = ASC(bs1(ii2), 4) _
   AND ASC(as1(ii), 5) = ASC(bs1(ii2), 5) OR _
   ASC(as1(ii), 1) = ASC(bs1(ii2), 1) AND ASC(as1(ii), 2) = ASC(bs1(ii2), 2) AND ASC(as1(ii), 3) = ASC(bs1(ii2), 3) _
   AND ASC(as1(ii), 5) = ASC(bs1(ii2), 5) THEN

 maxSeqLen = seqLenMax
 FOR ii4 = 1 TO maxSeqLen
    q4(ii4)             = CVQ(MID$(as1(ii),  (maxSeqLen - ii4) * %NUMBofLETTERS5 + 1, %NUMBofLETTERS5))
    q4(ii4 + maxSeqLen) = CVQ(MID$(bs1(ii2), (ii4 - 1)         * %NUMBofLETTERS5 + 1, %NUMBofLETTERS5))
 NEXT

 FOR ii5 = 1 TO maxSeqLen + maxSeqLen - 2
    FOR ii4 = 1 TO %NUMBofLETTERS5
       FOR ii6 = ii5 + 2 TO maxSeqLen + maxSeqLen
          IF (q4(ii5) AND blankq(ii4)) = (q4(ii6) AND blankq(ii4)) AND q4(ii5) > 0 THEN
             IF extend < ii6 THEN extend = ii6
          END IF
       NEXT
    NEXT
    FOR ii6 = ii5 + 1 TO extend - 1
       q4(ii6) = 0
    NEXT
    extend = 0
 NEXT

 sTemp = SPACE$(maxSeqLen * (%NUMBofLETTERS5 + 1) * 2 - 1)


 FOR ii4 = 1 TO maxSeqLen * 2
    MID$(sTemp, (ii4 - 1) * (%NUMBofLETTERS5 + 1) + 1, %NUMBofLETTERS5) = MKQ$(q4(ii4))
 NEXT

 INCR ii3
 REPLACE $NULL5 WITH "" IN sTemp
' Print #2, sTemp
  REDIM PRESERVE Sequences$(UBOUND(Sequences$()) + 1)
    Sequences$(UBOUND(Sequences$())) = sTemp

END IF
END MACRO

MACRO J_mFindSolution6letters(as1, bs1, seqLenMax)
IF ASC(bs1(ii2)) < 65 THEN EXIT FOR
IF ASC(as1(ii), 1) = ASC(bs1(ii2), 1) AND ASC(as1(ii), 2) = ASC(bs1(ii2), 2) AND ASC(as1(ii), 3) = ASC(bs1(ii2), 3) _
   AND ASC(as1(ii), 4) = ASC(bs1(ii2), 4) AND ASC(as1(ii), 5) = ASC(bs1(ii2), 5) OR _
   ASC(as1(ii), 2) = ASC(bs1(ii2), 2) AND ASC(as1(ii), 3) = ASC(bs1(ii2), 3) AND ASC(as1(ii), 4) = ASC(bs1(ii2), 4) _
   AND ASC(as1(ii), 5) = ASC(bs1(ii2), 5) AND ASC(as1(ii), 6) = ASC(bs1(ii2), 6) OR _
   ASC(as1(ii), 1) = ASC(bs1(ii2), 1) AND ASC(as1(ii), 3) = ASC(bs1(ii2), 3) AND ASC(as1(ii), 4) = ASC(bs1(ii2), 4) _
   AND ASC(as1(ii), 5) = ASC(bs1(ii2), 5) AND ASC(as1(ii), 6) = ASC(bs1(ii2), 6) OR _
   ASC(as1(ii), 1) = ASC(bs1(ii2), 1) AND ASC(as1(ii), 2) = ASC(bs1(ii2), 2) AND ASC(as1(ii), 4) = ASC(bs1(ii2), 4) _
   AND ASC(as1(ii), 5) = ASC(bs1(ii2), 5) AND ASC(as1(ii), 6) = ASC(bs1(ii2), 6)  OR _
   ASC(as1(ii), 1) = ASC(bs1(ii2), 1) AND ASC(as1(ii), 2) = ASC(bs1(ii2), 2) AND ASC(as1(ii), 3) = ASC(bs1(ii2), 3) _
   AND ASC(as1(ii), 5) = ASC(bs1(ii2), 5) AND ASC(as1(ii), 6) = ASC(bs1(ii2), 6) THEN

 'make SURE it is shortest possible sequence...
 maxSeqLen = seqLenMax     'this is per side, eg. PINS PANS PARS is three long max at this point
 FOR ii4 = 1 TO maxSeqLen  'this loop splits up string into quads to make comparison easier
    q4(ii4)             = CVQ(MID$(as1(ii),  (maxSeqLen - ii4) * %NUMBofLETTERS6 + 1, %NUMBofLETTERS6))
    q4(ii4 + maxSeqLen) = CVQ(MID$(bs1(ii2), (ii4 - 1)         * %NUMBofLETTERS6 + 1, %NUMBofLETTERS6))
 NEXT
 __ __ __ __ __   __ __ __ __ __

 FOR ii5 = 1 TO maxSeqLen + maxSeqLen - 2   'eg. this loop removes "PANS" from this: PINS PANS PUNS
    FOR ii4 = 1 TO %NUMBofLETTERS6          'it also removes "split dupes" eg. POLE DOLE POLE becomes POLE
       FOR ii6 = ii5 + 2 TO maxSeqLen + maxSeqLen
          IF (q4(ii5) AND blankq(ii4)) = (q4(ii6) AND blankq(ii4)) AND q4(ii5) > 0 THEN
             IF extend < ii6 THEN extend = ii6
          END IF
       NEXT
    NEXT
    FOR ii6 = ii5 + 1 TO extend - 1
       q4(ii6) = 0
    NEXT
    extend = 0
 NEXT

 sTemp = SPACE$(maxSeqLen * (%NUMBofLETTERS6 + 1) * 2 - 1)'+ 1 is for space separator, - 1 eliminates
                                                          'trailing space

 FOR ii4 = 1 TO maxSeqLen * 2                             'convert quads back to string
    MID$(sTemp, (ii4 - 1) * (%NUMBofLETTERS6 + 1) + 1, %NUMBofLETTERS6) = MKQ$(q4(ii4))
 NEXT

 INCR ii3
 REPLACE $NULL6 WITH "" IN sTemp                          'get rid of dupes
' Print #2, sTemp
  REDIM PRESERVE Sequences$(UBOUND(Sequences$()) + 1)
    Sequences$(UBOUND(Sequences$())) = sTemp

END IF
END MACRO

MACRO FUNCTION superRandom
 MACROTEMP superR
   LOCAL superR AS DWORD
    !dw %RDTSC
    !Xor eax, edx
    !mov superR, eax
END MACRO = superR

DECLARE FUNCTION twoSixLetterWords()  AS LONG
DECLARE FUNCTION twoFiveLetterWords() AS LONG
DECLARE FUNCTION twoFourLetterWords() AS LONG
DECLARE FUNCTION twoThreeLetterWords() AS LONG


'FUNCTION twoFourLetterWords(inWord AS STRING * %NUMBofLETTERS4, outWord AS STRING * %NUMBofLETTERS4) AS LONG
FUNCTION J_twoFourLetterWords() AS LONG
   Common_Locals
  LOCAL lineo AS STRING, ii, ii2, ii3, ii4, ii5, ii6, extend, index, index2, index3, index4 AS LONG
  LOCAL index5, index6, index7, index8, index9, index10, index11, index12, endLoop, maxSeqLen AS LONG
  LOCAL sTemp, allFourLetterWords AS STRING, wo6ptr AS BYTE PTR
  DIM q4(10) AS QUAD, acacia(6) AS LONG, blank(6) AS LONG, blankq(8) AS QUAD
  DIM wordOrig6(%NUMBERofWORDS4) AS STRING * %NUMBofLETTERS4
  DIM a1(%ARRAYsIZE1) AS LONG, a2(%ARRAYsIZE2) AS LONG, a3(%ARRAYsIZE3) AS LONG, a4(%ARRAYsIZE4) AS LONG, a5(%ARRAYsIZE5) AS LONG, a6(%ARRAYsIZE6) AS LONG
  DIM b1(%ARRAYsIZE1) AS LONG, b2(%ARRAYsIZE2) AS LONG, b3(%ARRAYsIZE3) AS LONG, b4(%ARRAYsIZE4) AS LONG, b5(%ARRAYsIZE5) AS LONG, b6(%ARRAYsIZE6) AS LONG
  DIM as1(%ARRAYsIZE1) AS STRING, as2(%ARRAYsIZE2) AS STRING, as3(%ARRAYsIZE3) AS STRING, as4(%ARRAYsIZE4) AS STRING, as5(%ARRAYsIZE5) AS STRING, as6(%ARRAYsIZE6) AS STRING
  DIM bs1(%ARRAYsIZE1) AS STRING, bs2(%ARRAYsIZE2) AS STRING, bs3(%ARRAYsIZE3) AS STRING, bs4(%ARRAYsIZE4) AS STRING, bs5(%ARRAYsIZE5) AS STRING, bs6(%ARRAYsIZE6) AS STRING
  LOCAL inWord AS STRING * %NUMBofLETTERS4, outWord AS STRING * %NUMBofLETTERS4
    inWord = First_Word$
     outWord = Last_Word$


    '-----------------------------------------------------------
    'put words in a fast to use LONG format and store in word6() array. 6 is max letters for this technique, 4 used here.
    'if 7 or more needed (12 max), the algo would need to go to QUAD/8.
    '-----------------------------------------------------------
    allFourLetterWords = fourLetterWords()
    DIM word6(%NUMBERofWORDS4) AS LONG AT STRPTR(allFourLetterWords)
    wo6ptr = VARPTR(wordOrig6(0))

    FOR ii = 0 TO %NUMBERofWORDS4          'create human readable 4-letter word list
           ii2 = word6(ii) AND &b00000000000011111000000000000000
           SHIFT RIGHT ii2, 15
           @wo6ptr = ii2 + &h40
           INCR wo6ptr
           ii2 = word6(ii) AND &b00000000000000000111110000000000
           SHIFT RIGHT ii2, 10
           @wo6ptr = ii2 + &h40
           INCR wo6ptr
           ii2 = word6(ii) AND &b00000000000000000000001111100000
           SHIFT RIGHT ii2, 05
           @wo6ptr = ii2 + &h40
           INCR wo6ptr
           ii2 = word6(ii) AND &b00000000000000000000000000011111
           @wo6ptr = ii2 + &h40
           INCR wo6ptr
    NEXT
    '-----------------------------------------------------------
    'Array is now filled with all 4 letter words.
    'Next, find words that are 1 letter different...
    '-----------------------------------------------------------
    blank(1) = &b11111111111111111111111111100000  'first make blanks mask to test each of 4 1-letter differences
    blank(2) = &b11111111111111111111110000011111
    blank(3) = &b11111111111111111000001111111111
    blank(4) = &b11111111111100000111111111111111

    blankq(1) = &b11111111111111111111111100000000  'make blanks mask for quad comparison testing, ie. CVQ
    blankq(2) = &b11111111111111110000000011111111
    blankq(3) = &b11111111000000001111111111111111
    blankq(4) = &b00000000111111111111111111111111

'---------------------------------------------------------------------------
'this code creates 2 random words to try for a solution sequence
'---------------------------------------------------------------------------
  '      Inword = wordOrig6(((Rnd * &h10000 + Rnd * &h100000000) Xor superRandom) Mod %NUMBERofWORDS4)
  '      outWord = wordOrig6(((Rnd * &h10000 + Rnd * &h100000000) Xor superRandom) Mod %NUMBERofWORDS4)
'        Print #2, inWord, outWord
'----------------------end random words-------------------------------------

'   Ready to go...
    J_mFirstMatchForDifference(%NUMBERofWORDS4, %NUMBofLETTERS4)

ii3 = 0
    FOR ii = 0 TO %ARRAYsIZE1                  'solution logic here after all possible matches found
       IF ASC(as1(ii)) < 65 THEN EXIT FOR
       FOR ii2 = 0 TO %ARRAYsIZE1
       J_mFindSolution4letters(as1, bs1, 2)
       NEXT
    NEXT
    IF ii3 > 0 THEN FUNCTION = 1: EXIT FUNCTION 'ii3 is number of solutions found

    '-----------------------------------------------------------
    'Now get second arrays of words that are 1 letter different from the previously found arrays...
    '-----------------------------------------------------------
    J_mMatchAndRemoveDupes(index, index2, index3, index4, a1, a2, b1, b2, as1, as2, bs1, bs2, %ARRAYsIZE2, %NUMBERofWORDS4, %NUMBofLETTERS4)

     ii3 = 0
    FOR ii = 0 TO %ARRAYsIZE2                 'solution logic here after all possible matches found
       IF ASC(as2(ii)) < 65 THEN EXIT FOR
       FOR ii2 =  0 TO %ARRAYsIZE2
       j_mFindSolution4letters(as2, bs2, 3)
       NEXT
    NEXT
    IF ii3 > 0 THEN FUNCTION = 1: EXIT FUNCTION 'ii3 is number of solutions found
    '-----------------------------------------------------------
    'Now get third arrays of words that are 1 letter different from the last found arrays...
    '-----------------------------------------------------------
    J_mMatchAndRemoveDupes(index3, index4, index5, index6, a2, a3, b2, b3, as2, as3, bs2, bs3, %ARRAYsIZE3, %NUMBERofWORDS4, %NUMBofLETTERS4)

     ii3 = 0
    FOR ii = 0 TO %ARRAYsIZE3 - 1   'solution logic here after all possible matches found
       IF ASC(as3(ii)) < 65 THEN EXIT FOR
       FOR ii2 = 0 TO %ARRAYsIZE3 - 1
       J_mFindSolution4letters(as3, bs3, 4)
       NEXT
    NEXT
    IF ii3 > 0 THEN FUNCTION = 1: EXIT FUNCTION 'ii3 is number of solutions found

    '-----------------------------------------------------------
    'Now get fourth arrays of words that are 1 letter different from the last found arrays...
    '-----------------------------------------------------------
    J_mMatchAndRemoveDupes(index5, index6, index7, index8, a3, a4, b3, b4, as3, as4, bs3, bs4, %ARRAYsIZE4, %NUMBERofWORDS4, %NUMBofLETTERS4)

    ii3 = 0
    FOR ii = 0 TO %ARRAYsIZE4 - 1  'solution logic here after all possible matches found
       IF ASC(as4(ii)) < 65 THEN EXIT FOR
       FOR ii2 = 0 TO %ARRAYsIZE4 - 1
       J_mFindSolution4letters(as4, bs4, 5)
       NEXT
    NEXT
    IF ii3 > 0 THEN FUNCTION = 1:EXIT FUNCTION       'ii3 is number of solutions found
    '-----------------------------------------------------------
    'Now get fifth arrays of words that are 1 letter different from the last found arrays...
    '-----------------------------------------------------------
    J_mMatchAndRemoveDupes(index7, index8, index9, index10, a4, a5, b4, b5, as4, as5, bs4, bs5, %ARRAYsIZE5, %NUMBERofWORDS4, %NUMBofLETTERS4)
'
    ii3 = 0
    FOR ii = 0 TO %ARRAYsIZE5 - 1  'solution logic here after all possible matches found
       IF ASC(as5(ii)) < 65 THEN EXIT FOR
       FOR ii2 = 0 TO %ARRAYsIZE5 - 1
       J_mFindSolution4letters(as5, bs5, 6)
       NEXT
    NEXT
    IF ii3 > 0 THEN FUNCTION = 1:EXIT FUNCTION       'ii3 is number of solutions found

    '-----------------------------------------------------------
    'Now get sixth arrays of words that are 1 letter different from the last found arrays...
    '-----------------------------------------------------------
    J_mMatchAndRemoveDupes(index9, index10, index11, index12, a5, a6, b5, b6, as5, as6, bs5, bs6, %ARRAYsIZE6, %NUMBERofWORDS4, %NUMBofLETTERS4)
'
    ii3 = 0
    FOR ii = 0 TO %ARRAYsIZE6 - 1  'solution logic here after all possible matches found
       IF ASC(as6(ii)) < 65 THEN EXIT FOR
       FOR ii2 = 0 TO %ARRAYsIZE6 - 1
       J_mFindSolution4letters(as6, bs6, 7)
       NEXT
    NEXT
    IF ii3 > 0 THEN FUNCTION = 1                     'ii3 is number of solutions found
END FUNCTION

'FUNCTION twoFiveLetterWords(inWord AS STRING * %NUMBofLETTERS5, outWord AS STRING * %NUMBofLETTERS5) AS LONG
FUNCTION J_twoFiveLetterWords() AS LONG
   Common_Locals
  LOCAL lineo AS STRING, ii, ii2, ii3, ii4, ii5, ii6, index, index2, index3, index4 AS LONG
  LOCAL index5, index6, index7, index8, index9, index10, index11, index12, endLoop, maxSeqLen AS LONG
  LOCAL sTemp, allFiveLetterWords AS STRING, wo6ptr AS BYTE PTR
  DIM q4(10) AS QUAD, acacia(6) AS LONG, blank(6) AS LONG, blankq(8) AS QUAD
  DIM wordOrig6(%NUMBERofWORDS5) AS STRING * %NUMBofLETTERS5
  DIM a1(%ARRAYsIZE1) AS LONG, a2(%ARRAYsIZE2) AS LONG, a3(%ARRAYsIZE3) AS LONG, a4(%ARRAYsIZE4) AS LONG, a5(%ARRAYsIZE5) AS LONG, a6(%ARRAYsIZE6) AS LONG
  DIM b1(%ARRAYsIZE1) AS LONG, b2(%ARRAYsIZE2) AS LONG, b3(%ARRAYsIZE3) AS LONG, b4(%ARRAYsIZE4) AS LONG, b5(%ARRAYsIZE5) AS LONG, b6(%ARRAYsIZE6) AS LONG
  DIM as1(%ARRAYsIZE1) AS STRING, as2(%ARRAYsIZE2) AS STRING, as3(%ARRAYsIZE3) AS STRING, as4(%ARRAYsIZE4) AS STRING, as5(%ARRAYsIZE5) AS STRING, as6(%ARRAYsIZE6) AS STRING
  DIM bs1(%ARRAYsIZE1) AS STRING, bs2(%ARRAYsIZE2) AS STRING, bs3(%ARRAYsIZE3) AS STRING, bs4(%ARRAYsIZE4) AS STRING, bs5(%ARRAYsIZE5) AS STRING, bs6(%ARRAYsIZE6) AS STRING
  LOCAL x AS STRING,     q1, q2 AS QUAD 'remove
  LOCAL extend AS LONG
  LOCAL inWord AS STRING * %NUMBofLETTERS5, outWord AS STRING * %NUMBofLETTERS5
    inWord = First_Word$
     outWord = Last_Word$


    '-----------------------------------------------------------
    'put words in a fast to use LONG format and store in word6() array. 6 is max letters for this technique, 4 used here.
    'if 7 or more needed (12 max), the algo would need to go to QUAD/8.
    '-----------------------------------------------------------
    allFiveLetterWords = fiveLetterWords()
    DIM word6(%NUMBERofWORDS5) AS LONG AT STRPTR(allFiveLetterWords)
    wo6ptr = VARPTR(wordOrig6(0))

    FOR ii = 0 TO %NUMBERofWORDS5          'create human readable 5-letter word list
           ii2 = word6(ii) AND &b00000001111100000000000000000000
           SHIFT RIGHT ii2, 20
           @wo6ptr = ii2 + &h40
           INCR wo6ptr
           ii2 = word6(ii) AND &b00000000000011111000000000000000
           SHIFT RIGHT ii2, 15
           @wo6ptr = ii2 + &h40
           INCR wo6ptr
           ii2 = word6(ii) AND &b00000000000000000111110000000000
           SHIFT RIGHT ii2, 10
           @wo6ptr = ii2 + &h40
           INCR wo6ptr
           ii2 = word6(ii) AND &b00000000000000000000001111100000
           SHIFT RIGHT ii2, 05
           @wo6ptr = ii2 + &h40
           INCR wo6ptr
           ii2 = word6(ii) AND &b00000000000000000000000000011111
           @wo6ptr = ii2 + &h40
           INCR wo6ptr
    NEXT
    '-----------------------------------------------------------
    'Array is now filled with all 6 letter words.
    'Next, find words that are 1 letter different...
    '-----------------------------------------------------------
    blank(1) = &b11111111111111111111111111100000  'first make blanks mask to test each of 5 1-letter differences
    blank(2) = &b11111111111111111111110000011111
    blank(3) = &b11111111111111111000001111111111
    blank(4) = &b11111111111100000111111111111111
    blank(5) = &b11111110000011111111111111111111

    blankq(1) = &h0ffffffff00                       'make blanks mask for quad comparison testing, ie. CVQ
    blankq(2) = &h0ffffff00ff
    blankq(3) = &h0ffff00ffff
    blankq(4) = &h0ff00ffffff
    blankq(5) = &h000ffffffff

'---------------------------------------------------------------------------
'this code creates 2 random words to try for a solution sequence
'---------------------------------------------------------------------------
        'Inword = wordOrig6(((Rnd * &h10000 + Rnd * &h100000000) Xor superRandom) Mod %NUMBERofWORDS5)
        'outWord = wordOrig6(((Rnd * &h10000 + Rnd * &h100000000) Xor superRandom) Mod %NUMBERofWORDS5)
'        Print #2, inWord, outWord
'----------------------end random words-------------------------------------

'   Ready to go...
    J_mFirstMatchForDifference(%NUMBERofWORDS5, %NUMBofLETTERS5)

    '-----------------------------------------------------------
    'Now get second arrays of words that are 1 letter different from the previously found arrays...
    '-----------------------------------------------------------
    J_mMatchAndRemoveDupes(index, index2, index3, index4, a1, a2, b1, b2, as1, as2, bs1, bs2, %ARRAYsIZE2, %NUMBERofWORDS5, %NUMBofLETTERS5)

     ii3 = 0
    FOR ii = 0 TO %ARRAYsIZE2 - 1   'solution logic here after all possible matches found
       IF ASC(as2(ii)) < 65 THEN EXIT FOR
       FOR ii2 = 0 TO %ARRAYsIZE2 - 1
       J_mFindSolution5letters(as2, bs2, 3)
       NEXT
    NEXT
    IF ii3 > 0 THEN FUNCTION = 1: EXIT FUNCTION      'ii3 is number of solutions found

    '-----------------------------------------------------------
    'Now get third arrays of words that are 1 letter different from the last found arrays...
    '-----------------------------------------------------------
    J_mMatchAndRemoveDupes(index3, index4, index5, index6, a2, a3, b2, b3, as2, as3, bs2, bs3, %ARRAYsIZE3, %NUMBERofWORDS5, %NUMBofLETTERS5)

     ii3 = 0
    FOR ii = 0 TO %ARRAYsIZE3 - 1   'solution logic here after all possible matches found
       IF ASC(as3(ii)) < 65 THEN EXIT FOR
       FOR ii2 = 0 TO %ARRAYsIZE3 - 1
       J_mFindSolution5letters(as3, bs3, 4)
       NEXT
    NEXT
    IF ii3 > 0 THEN FUNCTION = 1: EXIT FUNCTION      'ii3 is number of solutions found

    '-----------------------------------------------------------
    'Now get fourth arrays of words that are 1 letter different from the last found arrays...
    '-----------------------------------------------------------
    J_mMatchAndRemoveDupes(index5, index6, index7, index8, a3, a4, b3, b4, as3, as4, bs3, bs4, %ARRAYsIZE4, %NUMBERofWORDS5, %NUMBofLETTERS5)
'    ? JOIN$(as4(), "  ")
'    ? JOIN$(bs4(), "  ")
'
    ii3 = 0
    FOR ii = 0 TO %ARRAYsIZE4 - 1  'solution logic here after all possible matches found
       IF ASC(as4(ii)) < 65 THEN EXIT FOR
       FOR ii2 = 0 TO %ARRAYsIZE4 - 1
       J_mFindSolution5letters(as4, bs4, 5)
       NEXT
    NEXT
    IF ii3 > 0 THEN FUNCTION = 1:EXIT FUNCTION       'ii3 is number of solutions found
    '-----------------------------------------------------------
    'Now get fifth arrays of words that are 1 letter different from the last found arrays...
    '-----------------------------------------------------------
    J_mMatchAndRemoveDupes(index7, index8, index9, index10, a4, a5, b4, b5, as4, as5, bs4, bs5, %ARRAYsIZE5, %NUMBERofWORDS5, %NUMBofLETTERS5)
'
    ii3 = 0
    FOR ii = 0 TO %ARRAYsIZE5 - 1  'solution logic here after all possible matches found
       IF ASC(as5(ii)) < 65 THEN EXIT FOR
       FOR ii2 = 0 TO %ARRAYsIZE5 - 1
       J_mFindSolution5letters(as5, bs5, 6)
       NEXT
    NEXT
    IF ii3 > 0 THEN FUNCTION = 1:EXIT FUNCTION       'ii3 is number of solutions found

    '-----------------------------------------------------------
    'Now get sixth arrays of words that are 1 letter different from the last found arrays...
    '-----------------------------------------------------------
    J_mMatchAndRemoveDupes(index9, index10, index11, index12, a5, a6, b5, b6, as5, as6, bs5, bs6, %ARRAYsIZE6, %NUMBERofWORDS5, %NUMBofLETTERS5)
'
    ii3 = 0
    FOR ii = 0 TO %ARRAYsIZE6 - 1  'solution logic here after all possible matches found
       IF ASC(as6(ii)) < 65 THEN EXIT FOR
       FOR ii2 = 0 TO %ARRAYsIZE6 - 1
       J_mFindSolution5letters(as6, bs6, 7)
       NEXT
    NEXT
    IF ii3 > 0 THEN FUNCTION = 1                     'ii3 is number of solutions found
END FUNCTION

'FUNCTION twoSixLetterWords(inWord AS STRING * %NUMBofLETTERS6, outWord AS STRING * %NUMBofLETTERS6) AS LONG
FUNCTION J_twoSixLetterWords() AS LONG
   Common_Locals
  LOCAL lineo AS STRING, ii, ii2, ii3, ii4, ii5, ii6, index, index2, index3, index4 AS LONG
  LOCAL index5, index6, index7, index8, index9, index10, index11, index12, endLoop, maxSeqLen AS LONG
  LOCAL sTemp, allSixLetterWords AS STRING, wo6ptr AS BYTE PTR
  DIM q4(10) AS QUAD, acacia(6) AS LONG, blank(6) AS LONG, blankq(8) AS QUAD
  DIM wordOrig6(%NUMBERofWORDS6) AS STRING * %NUMBofLETTERS6
  DIM a1(%ARRAYsIZE1) AS LONG, a2(%ARRAYsIZE2) AS LONG, a3(%ARRAYsIZE3) AS LONG, a4(%ARRAYsIZE4) AS LONG, a5(%ARRAYsIZE5) AS LONG, a6(%ARRAYsIZE6) AS LONG
  DIM b1(%ARRAYsIZE1) AS LONG, b2(%ARRAYsIZE2) AS LONG, b3(%ARRAYsIZE3) AS LONG, b4(%ARRAYsIZE4) AS LONG, b5(%ARRAYsIZE5) AS LONG, b6(%ARRAYsIZE6) AS LONG
  DIM as1(%ARRAYsIZE1) AS STRING, as2(%ARRAYsIZE2) AS STRING, as3(%ARRAYsIZE3) AS STRING, as4(%ARRAYsIZE4) AS STRING, as5(%ARRAYsIZE5) AS STRING, as6(%ARRAYsIZE6) AS STRING
  DIM bs1(%ARRAYsIZE1) AS STRING, bs2(%ARRAYsIZE2) AS STRING, bs3(%ARRAYsIZE3) AS STRING, bs4(%ARRAYsIZE4) AS STRING, bs5(%ARRAYsIZE5) AS STRING, bs6(%ARRAYsIZE6) AS STRING
  LOCAL extend AS LONG, inWord AS STRING * %NUMBofLETTERS6, outWord AS STRING * %NUMBofLETTERS6
    '-----------------------------------------------------------
    'put words in a fast to use LONG format and store in word6() array. 6 is max letters for this technique, 4 used here.
    'if 7 or more needed (12 max), the algo would need to go to QUAD/8.
    '-----------------------------------------------------------
    allSixLetterWords = sixLetterWords()
    DIM word6(%NUMBERofWORDS6) AS LONG AT STRPTR(allSixLetterWords)
    wo6ptr = VARPTR(wordOrig6(0))

    FOR ii = 0 TO %NUMBERofWORDS6          'create human readable 5-letter word list
           ii2 = word6(ii) AND &b00111110000000000000000000000000
           SHIFT RIGHT ii2, 25
           @wo6ptr = ii2 + &h40
           INCR wo6ptr
           ii2 = word6(ii) AND &b00000001111100000000000000000000
           SHIFT RIGHT ii2, 20
           @wo6ptr = ii2 + &h40
           INCR wo6ptr
           ii2 = word6(ii) AND &b00000000000011111000000000000000
           SHIFT RIGHT ii2, 15
           @wo6ptr = ii2 + &h40
           INCR wo6ptr
           ii2 = word6(ii) AND &b00000000000000000111110000000000
           SHIFT RIGHT ii2, 10
           @wo6ptr = ii2 + &h40
           INCR wo6ptr
           ii2 = word6(ii) AND &b00000000000000000000001111100000
           SHIFT RIGHT ii2, 05
           @wo6ptr = ii2 + &h40
           INCR wo6ptr
           ii2 = word6(ii) AND &b00000000000000000000000000011111
           @wo6ptr = ii2 + &h40
           INCR wo6ptr
    NEXT
    '-----------------------------------------------------------
    'Array is now filled with all 6 letter words.
    'Next, find words that are 1 letter different...
    '-----------------------------------------------------------
    blank(1) = &b11111111111111111111111111100000  'first make blanks mask to test each of 6 1-letter differences
    blank(2) = &b11111111111111111111110000011111
    blank(3) = &b11111111111111111000001111111111
    blank(4) = &b11111111111100000111111111111111
    blank(5) = &b11111110000011111111111111111111
    blank(6) = &b11000001111111111111111111111111

    blankq(1) = &h0ffffffffff00                     'make blanks mask for quad comparison testing, ie. CVQ
    blankq(2) = &h0ffffffff00ff
    blankq(3) = &h0ffffff00ffff
    blankq(4) = &h0ffff00ffffff
    blankq(5) = &h0ff00ffffffff
    blankq(6) = &h000ffffffffff

'---------------------------------------------------------------------------
'this code creates 2 random words to try for a solution sequence
'---------------------------------------------------------------------------
        'Inword = wordOrig6(((Rnd * &h10000 + Rnd * &h100000000) Xor superRandom) Mod %NUMBERofWORDS6)
        'outWord = wordOrig6(((Rnd * &h10000 + Rnd * &h100000000) Xor superRandom) Mod %NUMBERofWORDS6)
     inword = First_Word$
     OutWord = Last_Word$
'        Print #2, inWord, outWord
'----------------------end random words-------------------------------------

'   Inword = UCASE$("heydey") 'you can try your own 2 words here
'   outWord = UCASE$("mayday")
'   Ready to go...
    J_mFirstMatchForDifference(%NUMBERofWORDS6, %NUMBofLETTERS6)

    '-----------------------------------------------------------
    'Now get second arrays of words that are 1 letter different from the last found arrays...
    '-----------------------------------------------------------
    J_mMatchAndRemoveDupes(index, index2, index3, index4, a1, a2, b1, b2, as1, as2, bs1, bs2, %ARRAYsIZE2, %NUMBERofWORDS6, %NUMBofLETTERS6)
    '-----------------------------------------------------------
    'Now get third arrays of words that are 1 letter different from the last found arrays...
    '-----------------------------------------------------------
    J_mMatchAndRemoveDupes(index3, index4, index5, index6, a2, a3, b2, b3, as2, as3, bs2, bs3, %ARRAYsIZE3, %NUMBERofWORDS6, %NUMBofLETTERS6)

     ii3 = 0
    FOR ii = 0 TO %ARRAYsIZE3 - 1   'solution logic here after all possible matches found
       IF ASC(as3(ii)) < 65 THEN EXIT FOR
       FOR ii2 = 0 TO %ARRAYsIZE3 - 1
       J_mFindSolution6letters(as3, bs3, 4)
       NEXT
    NEXT
    IF ii3 > 0 THEN FUNCTION = 1: EXIT FUNCTION      'ii3 is number of solutions found

    '-----------------------------------------------------------
    'Now get fourth arrays of words that are 1 letter different from the last found arrays...
    '-----------------------------------------------------------
    J_mMatchAndRemoveDupes(index5, index6, index7, index8, a3, a4, b3, b4, as3, as4, bs3, bs4, %ARRAYsIZE4, %NUMBERofWORDS6, %NUMBofLETTERS6)
'    ? JOIN$(as4(), "  ")
'    ? JOIN$(bs4(), "  ")
    ii3 = 0
    FOR ii = 0 TO %ARRAYsIZE4 - 1   'solution logic here after all possible matches found
       IF ASC(as4(ii)) < 65 THEN EXIT FOR
       FOR ii2 = 0 TO %ARRAYsIZE4 - 1
       J_mFindSolution6letters(as4, bs4, 5)
       NEXT
    NEXT
    IF ii3 > 0 THEN FUNCTION = 1:EXIT FUNCTION       'ii3 is number of solutions found
    '-----------------------------------------------------------
    'Now get fifth arrays of words that are 1 letter different from the last found arrays...
    '-----------------------------------------------------------
    J_mMatchAndRemoveDupes(index7, index8, index9, index10, a4, a5, b4, b5, as4, as5, bs4, bs5, %ARRAYsIZE5, %NUMBERofWORDS6, %NUMBofLETTERS6)
'
    ii3 = 0
    FOR ii = 0 TO %ARRAYsIZE5 - 1  'solution logic here after all possible matches found
       IF ASC(as5(ii)) < 65 THEN EXIT FOR
       FOR ii2 = 0 TO %ARRAYsIZE5 - 1
       J_mFindSolution6letters(as5, bs5, 6)
       NEXT
    NEXT
    IF ii3 > 0 THEN FUNCTION = 1:EXIT FUNCTION       'ii3 is number of solutions found

    '-----------------------------------------------------------
    'Now get sixth arrays of words that are 1 letter different from the last found arrays...
    '-----------------------------------------------------------
    J_mMatchAndRemoveDupes(index9, index10, index11, index12, a5, a6, b5, b6, as5, as6, bs5, bs6, %ARRAYsIZE6, %NUMBERofWORDS6, %NUMBofLETTERS6)
'
    ii3 = 0
    FOR ii = 0 TO %ARRAYsIZE6 - 1  'solution logic here after all possible matches found
       IF ASC(as6(ii)) < 65 THEN EXIT FOR
       FOR ii2 = 0 TO %ARRAYsIZE6 - 1
       J_mFindSolution6letters(as6, bs6, 7)
       NEXT
    NEXT
    IF ii3 > 0 THEN FUNCTION = 1                     'ii3 is number of solutions found
END FUNCTION

'FUNCTION twoThreeLetterWords(inWord AS STRING * %NUMBofLETTERS4, outWord AS STRING * %NUMBofLETTERS4) AS LONG
FUNCTION J_twoThreeLetterWords() AS LONG
   Common_Locals
  LOCAL lineo AS STRING, ii, ii2, ii3, ii4, ii5, ii6, extend, index, index2, index3, index4 AS LONG
  LOCAL index5, index6, index7, index8, endLoop, maxSeqLen AS LONG
  LOCAL sTemp, allThreeLetterWords AS STRING, wo6ptr AS BYTE PTR
  DIM q4(10) AS QUAD, acacia(6) AS LONG, blank(6) AS LONG, blankq(8) AS QUAD
  DIM wordOrig6(%NUMBERofWORDS3) AS STRING * %NUMBofLETTERS3
  DIM a1(%ARRAYsIZE1) AS LONG, a2(%ARRAYsIZE2) AS LONG, a3(%ARRAYsIZE3) AS LONG, a4(%ARRAYsIZE4) AS LONG
  DIM b1(%ARRAYsIZE1) AS LONG, b2(%ARRAYsIZE2) AS LONG, b3(%ARRAYsIZE3) AS LONG, b4(%ARRAYsIZE4) AS LONG
  DIM as1(%ARRAYsIZE1) AS STRING, as2(%ARRAYsIZE2) AS STRING, as3(%ARRAYsIZE3) AS STRING, as4(%ARRAYsIZE4) AS STRING
  DIM bs1(%ARRAYsIZE1) AS STRING, bs2(%ARRAYsIZE2) AS STRING, bs3(%ARRAYsIZE3) AS STRING, bs4(%ARRAYsIZE4) AS STRING
  LOCAL inWord AS STRING * %NUMBofLETTERS3, outWord AS STRING * %NUMBofLETTERS3
    inWord = First_Word$
     outWord = Last_Word$


    '-----------------------------------------------------------
    'put words in a fast to use LONG format and store in word6() array. 6 is max letters for this technique, 4 used here.
    'if 7 or more needed (12 max), the algo would need to go to QUAD/8.
    '-----------------------------------------------------------
    allThreeLetterWords = threeLetterWords()
    DIM word6(%NUMBERofWORDS3) AS LONG AT STRPTR(allThreeLetterWords)
    wo6ptr = VARPTR(wordOrig6(0))

    FOR ii = 0 TO %NUMBERofWORDS3          'create human readable 4-letter word list
           ii2 = word6(ii) AND &b00000000000000000111110000000000
           SHIFT RIGHT ii2, 10
           @wo6ptr = ii2 + &h40
           INCR wo6ptr
           ii2 = word6(ii) AND &b00000000000000000000001111100000
           SHIFT RIGHT ii2, 05
           @wo6ptr = ii2 + &h40
           INCR wo6ptr
           ii2 = word6(ii) AND &b00000000000000000000000000011111
           @wo6ptr = ii2 + &h40
           INCR wo6ptr
    NEXT
    '-----------------------------------------------------------
    'Array is now filled with all 4 letter words.
    'Next, find words that are 1 letter different...
    '-----------------------------------------------------------
    blank(1) = &b11111111111111111111111111100000  'first make blanks mask to test each of 4 1-letter differences
    blank(2) = &b11111111111111111111110000011111
    blank(3) = &b11111111111111111000001111111111

    blankq(1) = &b11111111111111111111111100000000  'make blanks mask for quad comparison testing, ie. CVQ
    blankq(2) = &b11111111111111110000000011111111
    blankq(3) = &b11111111000000001111111111111111

'---------------------------------------------------------------------------
'this code creates 2 random words to try for a solution sequence
'---------------------------------------------------------------------------
        'Inword = wordOrig6(((Rnd * &h10000 + Rnd * &h100000000) Xor superRandom) Mod %NUMBERofWORDS3)
        'outWord = wordOrig6(((Rnd * &h10000 + Rnd * &h100000000) Xor superRandom) Mod %NUMBERofWORDS3)
'        Print #2, inWord, outWord
'----------------------end random words-------------------------------------

'   Ready to go...
    J_mFirstMatchForDifference(%NUMBERofWORDS3, %NUMBofLETTERS3)

ii3 = 0
    FOR ii = 0 TO %ARRAYsIZE1                  'solution logic here after all possible matches found
       IF ASC(as1(ii)) < 65 THEN EXIT FOR
       FOR ii2 = 0 TO %ARRAYsIZE1
       J_mFindSolution3letters(as1, bs1, 2)
       NEXT
    NEXT
    IF ii3 > 0 THEN FUNCTION = 1: EXIT FUNCTION 'ii3 is number of solutions found

    '-----------------------------------------------------------
    'Now get second arrays of words that are 1 letter different from the previously found arrays...
    '-----------------------------------------------------------
    J_mMatchAndRemoveDupes(index, index2, index3, index4, a1, a2, b1, b2, as1, as2, bs1, bs2, %ARRAYsIZE2, %NUMBERofWORDS3, %NUMBofLETTERS3)

     ii3 = 0
    FOR ii = 0 TO %ARRAYsIZE2                 'solution logic here after all possible matches found
       IF ASC(as2(ii)) < 65 THEN EXIT FOR
       FOR ii2 =  0 TO %ARRAYsIZE2
       J_mFindSolution3letters(as2, bs2, 3)
       NEXT
    NEXT
    IF ii3 > 0 THEN FUNCTION = 1: EXIT FUNCTION 'ii3 is number of solutions found
    '-----------------------------------------------------------
    'Now get third arrays of words that are 1 letter different from the last found arrays...
    '-----------------------------------------------------------
    J_mMatchAndRemoveDupes(index3, index4, index5, index6, a2, a3, b2, b3, as2, as3, bs2, bs3, %ARRAYsIZE3, %NUMBERofWORDS3, %NUMBofLETTERS3)

     ii3 = 0
    FOR ii = 0 TO %ARRAYsIZE3 - 1   'solution logic here after all possible matches found
       IF ASC(as3(ii)) < 65 THEN EXIT FOR
       FOR ii2 = 0 TO %ARRAYsIZE3 - 1
       J_mFindSolution3letters(as3, bs3, 4)
       NEXT
    NEXT
    IF ii3 > 0 THEN FUNCTION = 1: EXIT FUNCTION 'ii3 is number of solutions found

    '-----------------------------------------------------------
    'Now get fourth arrays of words that are 1 letter different from the last found arrays...
    '-----------------------------------------------------------
    J_mMatchAndRemoveDupes(index5, index6, index7, index8, a3, a4, b3, b4, as3, as4, bs3, bs4, %ARRAYsIZE4, %NUMBERofWORDS3, %NUMBofLETTERS3)

    ii3 = 0
    FOR ii = 0 TO %ARRAYsIZE4 - 1  'solution logic here after all possible matches found
       IF ASC(as4(ii)) < 65 THEN EXIT FOR
       FOR ii2 = 0 TO %ARRAYsIZE4 - 1
       J_mFindSolution3letters(as4, bs4, 5)
       NEXT
    NEXT
    IF ii3 > 0 THEN FUNCTION = 1       'ii3 is number of solutions found
END FUNCTION

'End John's stuff
'
'------------------------------------------------------------------------------
'
'------------------------------------------------------------------------------
'
'------------------------------------------------------------------------------
'
'------------------------------------------------------------------------------
'
'------------------------------------------------------------------------------

'****************************************************************************
'****************************************************************************
SUB Good_Words_Only
  'only load words that can be expanded

'   Wrd As String * 28
'   lng As Long
'   Good As Long '

   common_Locals
   g_timer = TIMER
   fn$ = CURDIR$ & "\Data_Words.txt"
     m_Input_open
   LOCAL gw() AS GoodWords
   DIM gw(110000)
   RESET ctr
   WHILE fn$ <> "End Words" 'Not Eof(fnum)
      INPUT #fnum, flen, fn$
      INCR ctr4
      IF flen > 4 AND flen < 7 THEN ' 5& 6 ltrs only
         fn$ = UCASE$(fn$)
         sw$ = fn$
         a = ASC(fn$)
         i = 0 'valid return
         FOR ctr1 = 1 TO LEN(fn$)
           FOR ctr2 = 65 TO 90'A-Z
              LSET sw$ = fn$ 'faster
              MID$ (sw$, ctr1) = CHR$(ctr2)'replace letter
              IF sw$ <> fn$ THEN 'case of same letter being replaced
                Is_It_Valid
                IF i THEN EXIT FOR 'got a match so exit
              END IF
           NEXT ctr2
           IF i THEN EXIT FOR 'got a match so exit
         NEXT ctr1
         gw(ctr).Wrd = fn$
         gw(ctr).lng = flen
         gw(ctr).Good = i
         INCR ctr
      END IF
   WEND
   CLOSE
    'Is_It_Valid

   m$ = USING$("#, Good Words out of #,  .## secs to read", ctr, ctr4, TIMER - g_timer): mb)
END SUB
'------------------------------------------------------------------
FUNCTION MakeFontEx(BYVAL FontName AS STRING, _
                    BYVAL PointSize AS LONG, _
                    BYVAL fBold AS LONG, _
                    BYVAL fItalic AS LONG, _
                    BYVAL fUnderline AS LONG) AS LONG

  ' Borrowed from Borje Hagsten
  ' MakeFontEx(FontName, PointSize, fBold, fItalic, fUnderline)

  LOCAL hDC AS LONG, CyPixels AS LONG

  hDC = GetDC(%HWND_DESKTOP)
  CyPixels  = GetDeviceCaps(hDC, %LOGPIXELSY)
  ReleaseDC %HWND_DESKTOP, hDC
  PointSize = 0 - (PointSize * CyPixels) \ 72

  FUNCTION = CreateFont( _
             PointSize, 0, _        'height, width(default=0)
             0, 0, _                'escapement(angle), orientation
             fBold, _               'weight (%FW_DONTCARE = 0, %FW_NORMAL = 400, %FW_BOLD = 700)
             fItalic, _             'Italic
             fUnderline, _          'Underline
             %FALSE, _              'StrikeThru - who needs it?
             %ANSI_CHARSET, %OUT_TT_PRECIS, _
             %CLIP_DEFAULT_PRECIS, %DEFAULT_QUALITY, _
             %FF_DONTCARE , BYCOPY FontName)

 'Put below in Common_Locals code
'     Local hFont_Arial As Dword
'     Local hFont_Comic As Dword
'     Local hFont_Courier As Dword
'
'       Examples:
'  hFont_Courier = MakefontEx("Courier New", 12, %FW_NORMAL, %FALSE, %FALSE)
'  hFont_Arial = MakefontEx("Arial", 10, %FW_Normal, %FALSE, %FALSE)
'  hFont_Comic = MakefontEx("Comic MS Sans", 10, %FW_Normal, %TRUE,  %FALSE)
'
'       Change font in any control (textbox, label, etc.)
'  Control Send hDlg, %IDC_TextBox1, %WM_SETFONT, hFont_Comic, 0

' Different Font Weights
'%FW_DONTCARE   = 0
'%FW_THIN       = 100
'%FW_EXTRALIGHT = 200
'%FW_LIGHT      = 300
'%FW_NORMAL     = 400
'%FW_MEDIUM     = 500
'%FW_SEMIBOLD   = 600
'%FW_BOLD       = 700
'%FW_EXTRABOLD  = 800
'%FW_HEAVY      = 900
'
'%FW_ULTRALIGHT = %FW_EXTRALIGHT
'%FW_REGULAR    = %FW_NORMAL
'%FW_DEMIBOLD   = %FW_SEMIBOLD
'%FW_ULTRABOLD  = %FW_EXTRABOLD
'%FW_BLACK      = %FW_HEAVY

END FUNCTION
'------------------------------------------------------------------

'****************************************************************************
'Shortcut code below here
' all C&P'ed from POFFS - dunno who to credit. Wayne Diamond?
'-Note shortcut functions begin with "z_sc_" to group together
' =======================================================================================
' IIDs for shortcut creator
' =======================================================================================
$CLSID_ShellLink = GUID$("{00021401-0000-0000-C000-000000000046}")
$IID_IShellLink = GUID$("{000214EE-0000-0000-C000-000000000046}")
$IID_IPersistFile = GUID$("{0000010B-0000-0000-C000-000000000046}")
%CLSCTX_INPROC_SERVER = &H1    ' Component is allowed in the same process space.
' =======================================================================================

' =======================================================================================
' Returns a pointer to a specified interface on an object to which a client currently
' holds an interface pointer.
' =======================================================================================
FUNCTION z_sc_IUnknown_QueryInterface _
    (BYVAL pthis AS DWORD PTR, BYREF riid AS GUID, BYREF ppvObj AS DWORD) AS LONG
  LOCAL HRESULT AS LONG
  CALL DWORD @@pthis[0] USING z_sc_IUnknown_QueryInterface (pthis, riid, ppvObj) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Decrements the reference count for the calling interface on a object. If the reference
' count on the object falls to 0, the object is freed from memory.
' =======================================================================================
FUNCTION z_sc_IUnknown_Release _
        (BYVAL pthis AS DWORD PTR) AS DWORD
  LOCAL DWRESULT AS DWORD
  CALL DWORD @@pthis[2] USING z_sc_IUnknown_Release (pthis) TO   DWRESULT
  FUNCTION = DWRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Retrieves the description string for a Shell link object.
' =======================================================================================
FUNCTION z_sc_IShellLink_SetDescription _
         (BYVAL pthis AS DWORD PTR, BYREF pszName AS ASCIIZ) AS LONG
  LOCAL HRESULT AS LONG
  CALL DWORD @@pthis[7] USING z_sc_IShellLink_SetDescription (pthis, pszName) _
          TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Sets the name of the working directory for a Shell link object.
' =======================================================================================
FUNCTION z_sc_IShellLink_SetWorkingDirectory (BYVAL pthis AS DWORD PTR, BYREF pszDir AS ASCIIZ) AS LONG
  LOCAL HRESULT AS LONG
  CALL DWORD @@pthis[9] USING z_sc_IShellLink_SetWorkingDirectory (pthis, pszDir)_
          TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Sets the command-line arguments for a Shell link object.
' =======================================================================================
FUNCTION z_sc_IShellLink_SetArguments _
         (BYVAL pthis AS DWORD PTR, BYREF pszArgs AS ASCIIZ) AS LONG
  LOCAL HRESULT AS LONG
  CALL DWORD @@pthis[11] USING z_sc_IShellLink_SetArguments (pthis, pszArgs) _
          TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Sets the show command for a Shell link object. The show command sets the initial show
' state of the window.
' =======================================================================================
FUNCTION z_sc_IShellLink_SetShowCmd _
        (BYVAL pthis AS DWORD PTR, BYVAL iShowCmd AS LONG) AS LONG
  LOCAL HRESULT AS LONG
  CALL DWORD @@pthis[15] USING z_sc_IShellLink_SetShowCmd (pthis, iShowCmd) _
          TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Sets the path and file name of a Shell link object.
' =======================================================================================
FUNCTION z_sc_IShellLink_SetPath (BYVAL pthis AS DWORD PTR, BYREF pszFile AS ASCIIZ) _
       AS LONG
  LOCAL HRESULT AS LONG
  CALL DWORD @@pthis[20] USING z_sc_IShellLink_SetPath (pthis, pszFile) _
          TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================

' =======================================================================================
' Saves the object into the specified file.
' =======================================================================================
DECLARE FUNCTION z_sc_Proto_IPersistFile_Save _
       (BYVAL pthis AS DWORD PTR, _
        BYVAL pszFileName AS DWORD, _
        BYVAL fRemember AS LONG) AS LONG
' =======================================================================================
FUNCTION z_sc_IPersistFile_Save _
        (BYVAL pthis AS DWORD PTR, _
         BYVAL strFileName AS STRING, _
         BYVAL fRemember AS LONG) AS LONG
  LOCAL HRESULT AS LONG
  LOCAL pszFileName AS DWORD
  IF LEN(strFileName) THEN
     strFileName = UCODE$(strFileName) & $NUL
     pszFileName = STRPTR(strFileName)
  END IF
  CALL DWORD @@pthis[6] USING z_sc_Proto_IPersistFile_Save _
       (pthis, pszFileName, fRemember) TO HRESULT
  FUNCTION = HRESULT
END FUNCTION
' =======================================================================================


'// Prototypes
DECLARE FUNCTION z_sc_IShellLink_Call0( BYVAL pUnk AS LONG ) AS LONG
DECLARE FUNCTION z_sc_IShellLink_Call1( BYVAL pUnk AS LONG, BYVAL p1 AS LONG ) AS LONG
DECLARE FUNCTION z_sc_IShellLink_Call2( BYVAL pUnk AS LONG, BYVAL p1 AS LONG, BYVAL p2 AS LONG ) AS LONG

FUNCTION z_sc_SpecialFolder(pidl AS DWORD) AS STRING
' by Wayne Diamond 12-03-01
' [URL=http://www.powerbasic.com/support/forums/Forum7/HTML/001233.html]http://www.powerbasic.com/support/forums/Forum7/HTML/001233.html[/URL]
   LOCAL TmpAsciiz AS ASCIIZ * %MAX_PATH
   CoInitialize BYVAL 0
   IF ISFALSE(SHGetSpecialFolderLocation(BYVAL %HWND_DESKTOP, BYVAL pidl, BYVAL VARPTR(pidl))) THEN
      SHGetPathFromIDList BYVAL pidl, TmpAsciiz
      CoTaskMemFree BYVAL pidl
   END IF
   CoUninitialize
   FUNCTION = TmpAsciiz
END FUNCTION

FUNCTION z_sc_createShortcut(CSIDL AS DWORD, link AS STRING, source AS STRING, workDir AS STRING) AS LONG
' adapted from Edwin Knoppert's code 07-10-03
' [URL=http://www.powerbasic.com/support/forums/Forum7/HTML/001980.html]http://www.powerbasic.com/support/forums/Forum7/HTML/001980.html[/URL]
    'CSIDL   - CSIDL_DESKTOP, CSIDL_PROGRAMS, CSIDL_STARTUP, etc
    'link    - link file to be created like "My calc.lnk"
    'source  - file/document where the shortcut should point to like "c:\windows\calc.exe".
    'workDir - folder where the executable document/file should start in, best not to leave empty.

    LOCAL CLSID_ShellLink AS STRING * 16
    LOCAL IID_IShellLink  AS STRING * 16
    LOCAL IID_Persist     AS STRING * 16
    LOCAL nResult AS LONG, pShellLnk AS DWORD PTR, pPersist AS DWORD PTR
    LOCAL sTarget AS STRING, szUniLnkName AS ASCIIZ * (2 * %MAX_PATH)
    LOCAL sArguments AS STRING, sComment AS STRING

    CLSID_ShellLink = MKL$(&H00021401) & CHR$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
    IID_IShellLink  = MKL$(&H000214EE) & CHR$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
    IID_Persist     = MKL$(&H0000010B) & CHR$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
    sArguments = "": sComment = ""
    CoInitialize BYVAL 0&

    IF CoCreateInstance(BYVAL VARPTR(CLSID_ShellLink), BYVAL 0&, 1, BYVAL VARPTR(IID_IShellLink), pShellLnk) = 0 THEN
        '// IShellLink::SetPath
        CALL DWORD @@pShellLnk[20] USING z_sc_IShellLink_Call1(pShellLnk, STRPTR(source))
        '// IShellLink::SetsArguments
        CALL DWORD @@pShellLnk[11] USING z_sc_IShellLink_Call1(pShellLnk, STRPTR(sArguments))
        '// IShellLink::SetWorkingDirectory
        CALL DWORD @@pShellLnk[9] USING z_sc_IShellLink_Call1(pShellLnk, STRPTR(workDir))
        '// IShellLink::SetnShowCmd
        CALL DWORD @@pShellLnk[15] USING z_sc_IShellLink_Call1(pShellLnk, %SW_SHOW)
        '// IShellLink::SetDescription
        CALL DWORD @@pShellLnk[7] USING z_sc_IShellLink_Call1(pShellLnk, STRPTR(sComment))
        '// Obtain persist interface (QueryInterface)
        CALL DWORD @@pShellLnk[0] USING z_sc_IShellLink_Call2(pShellLnk, VARPTR(IID_Persist), VARPTR(pPersist))

        IF nResult = %S_OK THEN
            '// Convert to unicode
            sTarget = z_sc_SpecialFolder(CSIDL) + "\" + link
            MultiByteToWideChar %CP_ACP, 0, BYVAL STRPTR(sTarget), LEN(sTarget), BYVAL VARPTR(szUniLnkName), %MAX_PATH * 2
            '// IPersistFile::Save
            CALL DWORD @@pPersist[6] USING z_sc_IShellLink_Call2(pPersist, VARPTR(szUniLnkName), 1)
            '// Release
            CALL DWORD @@pPersist[2] USING z_sc_IShellLink_Call0(pPersist)
        END IF
         '// Release
        CALL DWORD @@pShellLnk[2] USING z_sc_IShellLink_Call0(pShellLnk)
        FUNCTION = -1
    END IF
    CoUninitialize
END FUNCTION
'
' =======================================================================================
' Creates a shortcut
' =======================================================================================
FUNCTION z_sc_CreateLink ( _
   BYVAL csidl AS LONG _         ' // Value specifying the folder for which to retrieve the location.
 , szLinkName AS ASCIIZ _        ' // Name of the shortcut
 , szExePath AS ASCIIZ _         ' // Path of the executable file
 , szArguments AS ASCIIZ _       ' // Arguments
 , szWorkingDir AS ASCIIZ _      ' // Working directory
 , BYVAL nShowCmd AS DWORD _     ' // Show command flag
 , szComment AS ASCIIZ _         ' // Comment
 ) AS LONG

   LOCAL hr AS LONG                         ' // HRESULT
   LOCAL psl AS DWORD                       ' // IShellLink interface reference
   LOCAL ppf AS DWORD                       ' // IPersistFile interrace reference
   LOCAL CLSID_ShellLink AS GUID            ' // ShellLink class identifier
   LOCAL IID_IShellLink AS GUID             ' // IShellLink interface identifier
   LOCAL IID_IPersistFile AS GUID           ' // IPersistFile interface identifier
   LOCAL pidl AS DWORD                      ' // Item identifier list specifying the folder location
   LOCAL szFileName AS ASCIIZ * %MAX_PATH   ' // Name of the .LNK file

   ' // Fills the guids
   CLSID_ShellLink = $CLSID_ShellLink
   IID_IShellLink = $IID_IShellLink
   IID_IPersistFile = $IID_IPersistFile

   ' // Creates an instance of the IShellLink interface
   hr = CoCreateInstance(CLSID_ShellLink, BYVAL %Null, %CLSCTX_INPROC_SERVER, IID_IShellLink, psl)
   IF hr <> %S_OK THEN EXIT FUNCTION

   ' // Sets the properties of the shortcut
   hr = z_sc_IShellLink_SetPath(psl, szExePath)
   hr = z_sc_IShellLink_SetArguments(psl, szArguments)
   hr = z_sc_IShellLink_SetWorkingDirectory(psl, szWorkingDir)
   hr = z_sc_IShellLink_SetShowCmd(psl, nShowCmd)
   hr = z_sc_IShellLink_SetDescription(psl, szComment)

   ' // Retrieves a pointer to the IPersistFile interface
   hr = z_sc_IUnknown_QueryInterface(psl, IID_IPersistFile, ppf)
   IF hr = %S_OK THEN
      ' // Retrieves an item identifier list specifying the desktop folder location
      hr = SHGetSpecialFolderLocation(%HWND_DESKTOP, csidl, pidl)
      IF hr = %NOERROR THEN
         ' // Retrieves the path from the item identifier list
         hr = SHGetPathFromIDList(BYVAL pidl, szFileName)
         ' // Frees the memory allocated for the item identifier list
         CoTaskMemFree pidl
         IF ISTRUE(hr) THEN
            ' // Full path
            szFileName = szFileName & "\" & szLinkName & ".LNK"
            ' // Saves the shortcut file
            hr = z_sc_IPersistFile_Save(ppf, szFileName, %TRUE)
         END IF
         FUNCTION = %TRUE
      END IF
      ' // Releases the IPersistFile interface
      z_sc_IUnknown_Release(ppf)
   END IF

   ' // Releases the IShellLink interface
   z_sc_IUnknown_Release psl

END FUNCTION
' =======================================================================================
'-Note shortcut functions begin with "z_sc_"
'
SUB Create_Shortcut
   LOCAL hr AS LONG,  _
  csidl        AS LONG  , _
  szLinkName   AS ASCIIZ * %Max_Path, _  ' // Name of the shortcut
  szExePath    AS ASCIIZ * %Max_Path, _  ' // Path of the executable file
  szArguments  AS ASCIIZ * %Max_Path, _  ' // Arguments
  szWorkingDir AS ASCIIZ * %Max_Path, _  ' // Working directory
  nShowCmd     AS DWORD , _              ' // Show command flag
  szComment    AS ASCIIZ * %Max_Path      ' // Comment

   csidl        = %CSIDL_DESKTOP
   szLinkName   = "Swede's & John's Connections"
   szExePath    = CURDIR$ & "\Word_Connections.exe"
   szArguments  = ""
   szWorkingDir = CURDIR$
   szComment    = "Wonnerful Wunnerful Program"

   hr = z_sc_CreateLink(csidl, szLinkName, szExePath, _
                   szArguments, szWorkingDir, %SW_NORMAL, szComment)
   IF ISTRUE (hr)THEN
     LOCAL m$, m1$
      m$ = "See Desktop":
      m1$ = "Shortcut Created"
      mb_Alert
   ELSE
      m$ = "CreateLink failed":mb_Alert
   END IF
END SUB
'End shortcut code
'****************************************************************************
'****************************************************************************
'****************************************************************************

'------------------------------------------------------------------------------
'<== Start of Clipboard as an Include ==>
'Clipboard stuff gotten from Poffs but I forget from whom
'
'Note t$ must be initialized - Local t$

FUNCTION Clipboard_Set_Text ALIAS "Clipboard_Set_Text" _
              (BYVAL sText AS STRING) EXPORT AS LONG
  LOCAL hData AS LONG, hGlob AS LONG

' ** Create a global memory object and copy the data into it
  hData = GlobalAlloc(%GMEM_MOVEABLE OR %GMEM_DDESHARE, LEN(sText) + 1)
  hGlob = GlobalLock(hData)
  POKE$ hGlob, sText + CHR$(0)
  GlobalUnlock hData

' ** Open the clipboard
  IF ISFALSE(OpenClipboard(%Null)) THEN
    GlobalFree hData
    EXIT FUNCTION
  END IF

' ** Paste the data into the clipboard
  EmptyClipboard  'WinAPI
  FUNCTION = SetClipboardData(%CF_TEXT, hData) 'WinAPI
  CloseClipboard  'WinAPI
END FUNCTION
'
FUNCTION Clipboard_Get_Text ALIAS "Clipboard_Get_Text"() EXPORT AS STRING
    LOCAL zPtr AS ASCIIZ PTR
    OpenClipboard 0 'WinAPI
    zPtr = GetClipboardData(%CF_TEXT)
    IF zPtr <> 0 THEN FUNCTION = @zPtr
    CloseClipboard   'WinAPI
END FUNCTION
'

'
MACRO Get_Clipboard =  t$ = Clipboard_Get_Text 'put cb in tb at program start
'
MACRO Set_Clipboard = Clipboard_Set_Text(t$)
'

'<== End of Clipboard as an Include ==>
'
MACRO Check_Words_Validity
  CONTROL GET TEXT hDlg, %Word_Start TO First_Word$
    First_Word$ =UCASE$(First_Word$)
  CONTROL GET TEXT hDlg, %Word_Done  TO Last_Word$
    Last_Word$ = UCASE$(Last_Word$)

  RESET lbl$
     'data tests
  IF LEN(First_Word$) <> LEN(Last_Word$) THEN
     m$ = "Words must be the Same Length": 'mb_Alert: Exit Sub
      lbl$ = m$
    ELSEIF  LEN(First_Word$) < 2 THEN
     m$ = "Words must be longer than 1 letter": 'mb_Alert: Exit Sub
      lbl$ = m$
    ELSEIF  LEN(First_Word$) > 10 THEN
     m$ = "Words must be 10 letters or less long": 'mb_Alert: Exit Sub
      lbl$ = m$
    ELSEIF  First_Word$ = Last_Word$ THEN
     m$ = "Words must different": 'mb_Alert: Exit Sub
      lbl$ = m$
    ELSE
     'm$="Okay": mb
  END IF

  IF lbl$ > "A" THEN
     Label_Bum_Input
     BEEP
     EXIT SUB
  END IF

  Word_Len = LEN(First_Word$)


  'check to make sure words are in array
  Flag = INSTR(g_All_Words$, " " & First_Word$ & " ")

  IF Flag = 0 THEN
     m$ = First_Word$ & " is not an eligible word"
      lbl$ = m$
     Label_Bum_Input
     BEEP
     EXIT SUB
  END IF

  Flag = INSTR(g_All_Words$, " " & Last_Word$ & " ")

    IF Flag = 0 THEN
      m$ = Last_Word$ & " is not an eligible word"
      lbl$ = m$
     Label_Bum_Input
     BEEP
      EXIT SUB
    END IF

  Number_of_Words = UBOUND(g_Words)

END MACRO
'


'------------------------------------------------------------------------------
'   ** Globals **
'------------------------------------------------------------------------------
'
MACRO Top_of_John_Solver
  Common_Locals

   Check_Words_Validity  'returns Word_len & g_Words$()
                           '   First_Word$, Last_Word$
   Label_Set_Working
    g_Timer = TIMER

'     m$ = Using$("#, #, array elements ", %NUMBERofWORDS, UBound(g_Words$())): mb

'  Erase Sequences$ 'array to hold answers
   REDIM Sequences$(0)
END MACRO
'
MACRO m_Count_Uniques
  RESET flag
  FOR ctr = LBOUND(Sequences$) TO UBOUND(Sequences$)
     IF Ctr > LBOUND(Sequences$) THEN 'in case of duplicate strings
        IF Sequences$(ctr) <> Sequences$(ctr - 1) THEN
           INCR flag
        END IF
     END IF
  NEXT ctr
END MACRO
'
MACRO Bottom_of_John_Solver
    IF UBOUND(Sequences$) > 0 THEN 'solution found
       ARRAY SORT Sequences$()    '
       m_Count_Uniques'count uniques first

       t2$ = MCASE$(First_Word$) & " to " & MCASE$(Last_Word$) & _
            USING$(" has # Answer Sequences ",  Flag) & _
             USING$("(.## Seconds)", TIMER - g_Timer) & $CRLF
        t3$ = t2$ 'Case CB Answers only

       FOR ctr = LBOUND(Sequences$) TO UBOUND(Sequences$)
          t1$ = "  "   'indent
          IF Ctr > LBOUND(Sequences$) THEN 'in case of duplicate strings
             IF Sequences$(ctr) = Sequences$(ctr - 1) THEN
                ITERATE FOR
                t1$ =  "  (Duplicate)"
             END IF
          END IF

          t2$ = t2$ & Sequences$(ctr) & t1$ & $CRLF
       NEXT ctr

       Get_Clipboard
       IF t$ = "No Word Progression Chain yet." THEN
          RESET t$ 'start new - first time through
       END IF

       SELECT CASE g_CB_All_or_One
         CASE 0 'add chain
           t$ = t$ & $CRLF & t2$
         CASE 1' only this chain
           t$ = t2$
         CASE 2' Only the Results
           t$ = t$ & t3$
       END SELECT
       Set_Clipboard
       Label_Set_Done
      '
      ELSE
        t$ = t$ & t3$
         Set_Clipboard
        Label_Set_No_Answer
    END IF
'    Label_Set_Main

END MACRO
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
FUNCTION CB_Show(Pass_Hndl AS DWORD) AS LONG

'   Common_Locals
   'Locals used in macros
'  Local Start_Marked As Long, End_Marked As Long
'  Local Highlighted_Word_Flag As Long
   LOCAL m$, m1$
  LOCAL Beep_Freq AS DWORD, Beep_Duration AS DWORD, Beep_Ctr&, Beep_b&
'   m$ = Using$("# # ", Start_Marked, Start_Marked):mb


  LOCAL wd&, ht&, stile&, t$, tmp$(), ctr&, dlg1 AS DWORD
  LOCAL NewDialogHandle AS DWORD

  t$ = Clipboard_Get_Text
  m_T_into_Tmp_Array

  wd = 500
  ht = 300
  stile = %WS_CAPTION   OR _
          %WS_SYSMENU
  DIALOG NEW dlg1, "Clipboard Contents (Alt F4 to close)", _
        ,, wd, ht, _
        stile _
     TO NewDialogHandle

'  Dialog Set Color NewDialogHandle, -1&, %Blue
  Stile = %ES_MULTILINE    OR _
          %ES_READONLY  OR _
          %WS_HSCROLL    OR _
          %WS_VSCROLL

  CONTROL ADD TEXTBOX, NewDialogHandle, %CB_Dialog_Box, _
          t$, _
          1, 1, wd-3, ht, _
          Stile

  LOCAL hfont&, fnt$, fw&
   fnt$ ="Comic Sans MS"
   fw = %FW_Normal
  hFont = MakefontEx(fnt$, 14, fw, %FALSE, %FALSE)

  CONTROL SEND NewDialogHandle, %CB_Dialog_Box, _
              %WM_SETFONT, hFont, 0


  DIALOG SHOW MODAL NewDialogHandle', Call GHL_Spelling_CB
END FUNCTION
'

'------------------------------------------------------------------------------
'
'
'





'------------------------------------------------------------------------------
SUB John_Solver
  Top_of_John_Solver ' returns  First_Word$, Last_Word$
    ln = LEN(First_Word$)

    SELECT CASE ln
       CASE 3
         J_twothreeLetterWords
       CASE 4
         J_twoFourLetterWords
       CASE 5
         J_twoFiveLetterWords
       CASE 6
         J_twoSixLetterWords
    END SELECT

   CLOSE
   Bottom_of_John_Solver

END SUB
'------------------------------------------------------------------------------
SUB Testing
  common_locals
   m$ = "Testing":mb
END SUB
'
'Macro Is_It_Valid = i = InStr(g_All_Words$, " " & sw$ & " ")
'
SUB Solver_Swede
  Top_of_John_Solver
 '  The Macro Top_of_John_Solver has Common_Locals called and
 ' returns  First_Word$, Last_Word$

  ln = LEN(First_Word$)

 fw$ = UCASE$(First_Word$) 'working
 lw$ = UCASE$(Last_Word$)  'working
  'testing
 fw$ = UCASE$("snoop")
 lw$ = UCASE$("utter")
 chn$ = fw$ & " "
 RESET flag
 WHILE Flag = 0
   RESET Flag
   Chn$ = FW$ & " - " 'start of chain
   sw$ = fw$
    ln1 = 1
  FOR ctr1 = 1 TO ln 'word length
   FOR ctr = 65 TO 90 'A-Z
      MID$(sw$, ctr1) = CHR$(ctr)
      Is_It_Valid 'returns i&

       IF i THEN  'yes
         i = INSTR(Chn$, sw$) 'is it in the chain already?
         IF i = 0 THEN  'no
           chn$ = chn$ & sw$ & " " 'add to chain if good
          INCR flag
         END IF
       END IF
     sw$ = fw$ 'check next letter
   NEXT ctr
  NEXT ctr1
  Flag = 1
 WEND

 m$ = USING$(" Matched in .## Seconds", TIMER - g_timer)
   m1$ = chn$: mb
   t$ = chn$: Set_Clipboard
 m_Done 'close program now instead of returning to GUI
' Call Testing
'   Bottom_of_John_Solver 'Macro sets Clipboard & Labels
                         'checks Sequences$() for answers

END SUB
'THINK CHINK CLINK BLINK BLIND BLAND BRAND BRAID BRAIL BRAIN
'THINK CHINK CLINK BLINK BLIND BLAND BRAND BRAID BRAIN
'THINK CHINK CLINK BLINK BLIND BLEND BLAND BRAND BRAID BRAIN
'THINK CHINK CLINK BLINK BLIND BLOND BLAND BRAND BRAID BRAIN
'THINK CHINK CLINK CLANK BLANK BLANC BLAND BRAND BRAID BRAIN
'THINK CHINK CLINK CLANK BLANK BLAND BRAND BRAID BRAIL BRAIN
'THINK CHINK CLINK CLANK BLANK BLAND BRAND BRAID BRAIN
'THINK CHINK CLINK PLINK PLANK PLANT PLAIT PLAIN BLAIN BRAIN
'THINK THANK SHANK STANK STAND STAID STAIN SLAIN BLAIN BRAIN
'THINK THICK CHICK CRICK CRACK TRACK TRACT TRAIT TRAIN BRAIN
'THINK THICK TRICK TRACK TRACT BRACT TRACT TRAIT TRAIN BRAIN
'THINK THICK TRICK TRACK TRACT TRAIT TRACT TRAIT TRAIN BRAIN
'THINK THICK TRICK TRACK TRACT TRAIT TRAIN BRAIN
'THINK THICK TRICK TRACK TRACT TRAIT TRAIN GRAIN BRAIN
'THINK THICK TRICK TRACK TRACT TRAPT TRACT TRAIT TRAIN BRAIN
'THINK THICK TRICK TRICE Trace TRACK TRACT TRAIT TRAIN BRAIN
'THINK THICK TRICK TRICE Trace TRACT TRAIT TRAIN BRAIN
'THINK THICK TRICK TRICE Trace TRACT TRAIT TRAIN GRAIN BRAIN
'THINK THICK TRICK TRUCK TRACK TRACT TRAIT TRAIN BRAIN
'THINK THICK TRICK TRUCK TRACK TRACT TRAIT TRAIN GRAIN BRAIN
'THINK THINE TRINE TRIPE TRIPS TRAPS TRAPT TRAIT TRAIN BRAIN
'THINK THINS THENS THEWS TREWS BREWS BROWS BROWN BRAWN BRAIN
'THINK THINS THENS THEWS TREWS TROWS BROWS BROWN BRAWN BRAIN

'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------


'------------------------------------------------------------------------------
'   ** CallBacks **
'------------------------------------------------------------------------------
CALLBACK FUNCTION CB_Dialog_Processor()
    Common_Locals

    SELECT CASE AS LONG CBMSG
        CASE %WM_INITDIALOG
           t$ = "No Word Progression Chain yet."
           Set_Clipboard
        '
        CASE %WM_COMMAND
            ' Process control notifications
            SELECT CASE AS LONG CBCTL
                '
                CASE %ID_EXIT
                   DIALOG END CBHNDL
                '
                CASE %Btn_01
                  'Call WP_Answer 'Word_Progression_Puzzle
                  CALL John_Solver
                  'Call Solver_Swede
                '
                '
                CASE  %Cb_All
                    g_CB_All_or_One = 0
                    Label_Clipboard
                '
                CASE %Cb_One
                    g_CB_All_or_One = 1
                    Label_Clipboard
                '
                CASE %Cb_Results_Only
                    g_CB_All_or_One = 2
                    'Reset t$
                    'Set_Clipboard 'empty it
                    Label_Clipboard
                '
                CASE %Cb_Show_It, %Btn_02
                    CB_Show(CBHNDL)
                '
                CASE %CB_Erase_It
                    RESET t$
                    Set_Clipboard 'empty it
                    Label_Clipboard
                '
                CASE %Btn_Shortcut
                   CALL Create_Shortcut
                '
            END SELECT
    END SELECT
END FUNCTION
'------------------------------------------------------------------------------
'
MACRO Fill_G_Words_Array
 'g_Words$(ctr) = "ASCII_Value Word"
 ' ie " 2099 ANTIDISESTABLISHMENTARIANISM"
 ' or "  131 AB"
 '     fnum = FreeFile
     fn$ = CURDIR$ & "\Words.txt" '<-- file created beforehand
     OPEN fn$ FOR BINARY AS #fnum
      m$ = "Fill_G_Words_Array":m_Err_Msg

     ctr = LOF(#fnum)
     IF ctr = 0 THEN
 '      m_beep
       m$ = fn$:m1$ = "File not found": mb
       CLOSE
       EXIT SUB
     END IF
     temp$ = SPACE$(ctr) 'make big string
     GET #fnum, 1, temp$
     CLOSE #fnum
     ctr = PARSECOUNT(temp$, $CRLF)
     REDIM  g_Words$(ctr)
     PARSE temp$,  g_Words$(), $CRLF
END MACRO
'

'****************************************************************************

'****************************************************************************
MACRO w_Build_Word_List
   RESET Word_List$
   FOR ctr = LBOUND(g_Words$) TO UBOUND(g_Words$)
      Word_List$ = Word_List$ & g_Words$(ctr) & " "
   NEXT ctr
   W1$ = Word_List$
END MACRO
'
SUB WP_Answer
'THINK CHINK CLINK BLINK BLIND BLAND BRAND BRAID BRAIL BRAIN
'THINK CHINK CLINK BLINK BLIND BLAND BRAND BRAID BRAIN
'THINK CHINK CLINK BLINK BLIND BLEND BLAND BRAND BRAID BRAIN
'THINK CHINK CLINK BLINK BLIND BLOND BLAND BRAND BRAID BRAIN
'THINK CHINK CLINK CLANK BLANK BLANC BLAND BRAND BRAID BRAIN
'THINK CHINK CLINK CLANK BLANK BLAND BRAND BRAID BRAIL BRAIN
'THINK CHINK CLINK CLANK BLANK BLAND BRAND BRAID BRAIN
'THINK CHINK CLINK PLINK PLANK PLANT PLAIT PLAIN BLAIN BRAIN
'THINK THANK SHANK STANK STAND STAID STAIN SLAIN BLAIN BRAIN
'THINK THICK CHICK CRICK CRACK TRACK TRACT TRAIT TRAIN BRAIN
'THINK THICK TRICK TRACK TRACT BRACT TRACT TRAIT TRAIN BRAIN
'THINK THICK TRICK TRACK TRACT TRAIT TRACT TRAIT TRAIN BRAIN
'THINK THICK TRICK TRACK TRACT TRAIT TRAIN BRAIN
'THINK THICK TRICK TRACK TRACT TRAIT TRAIN GRAIN BRAIN
'THINK THICK TRICK TRACK TRACT TRAPT TRACT TRAIT TRAIN BRAIN
'THINK THICK TRICK TRICE Trace TRACK TRACT TRAIT TRAIN BRAIN
'THINK THICK TRICK TRICE Trace TRACT TRAIT TRAIN BRAIN
'THINK THICK TRICK TRICE Trace TRACT TRAIT TRAIN GRAIN BRAIN
'THINK THICK TRICK TRUCK TRACK TRACT TRAIT TRAIN BRAIN
'THINK THICK TRICK TRUCK TRACK TRACT TRAIT TRAIN GRAIN BRAIN
'THINK THINE TRINE TRIPE TRIPS TRAPS TRAPT TRAIT TRAIN BRAIN
'THINK THINS THENS THEWS TREWS BREWS BROWS BROWN BRAWN BRAIN
'THINK THINS THENS THEWS TREWS TROWS BROWS BROWN BRAWN BRAIN


'THINK =  CHINK THANK THICK THINE THING THINS
'     CHINK = CLINK CHUNK CHICK CHIRK CHINA CHINE CHINO CHINS
'     THANK = SHANK THANE
'     THICK = TRICK
'     THINE = RHINE SHINE WHINE TRINE TWINE
'     THING = OHING TYING THONG
'     THINS = SHINS TWINS THENS
'SWIMS-CRAMP. It produced SWIMS SLIMS SLAMS CLAMS CLAMP CRAMP.

   Common_Locals
    g_Timer = TIMER
   Label_Set_Working

   Check_Words_Validity  'returns Word_len & g_Words$()
                         '   First_Word$, Last_Word$
   w_Build_Word_List       'returns Word_List$, w1$

   w$ = First_Word$
   Flag = 0
   'Maybe Do Loop
   WHILE w$ <> Last_Word$
    w$ = Last_Word$


   '  W1$ = Word_List$
   '  While  'what?
   '
   '  wend
   WEND

  m$ = USING$("Done #, # letter Words", UBOUND(g_Words$), Word_Len)
   m1$ = USING$("Took .## seconds ", TIMER - g_timer)
    mb
  Label_Set_Main
END SUB
'*************************************************************

'------------------------------------------------------------------------------
'   ** Dialogs **
'------------------------------------------------------------------------------
'
MACRO m_Add_Option =  MENU ADD STRING, pu, m$, id, Stile
'
MACRO m_Add_Bar = MENU ADD STRING, pu, "-",      0, 0 ' bar
'

SUB Setup_Menus
  'common_Locals - can't use, 2 many conflicts with C&P'ed code
 'Locals for attaching a top menu bar menu
   'Global hMenu As Dword
    LOCAL pu AS DWORD
    LOCAL hPopup1, _
          hPopup2, _
          hPopup3, _
          hPopup4, _
          hPopup5, _
          hPopup6, _
          hPopup7, _
          hPopup8, _
         hPopup10 AS DWORD
        ' hPopup9, _

   LOCAL u$, ctr&, ln&, Stile&, id&, m$, m1$, n$, s$, sz$

    u$ = SPACE$(30)'creates equal spacing on bar
    Stile = %MF_ENABLED
    ' ** First create a top-level menu:
  MENU NEW BAR TO hMenu

  ' ** Add a top-level menu item with a popup menu:
  MENU NEW POPUP TO hPopup1 'assign a popup value
    pu = hPopup1 'easier to C&P when adding menus
                 'also allows easy moving of menus & menu items around
  RSET u$ = "&F  File "
    MENU ADD POPUP,  hMenu, u$, pu, Stile 'assign to popup handle
        M$ = "&X  Exit": id = %ID_EXIT: m_Add_Option
      m_Add_Bar 'Menu Add String, pu, "-",      0, 0 ' bar

        M$ = "&A  Add Link to Word Connections on Desktop": id = %Btn_Shortcut: m_Add_Option
      m_Add_Bar 'Menu Add String, pu, "-",      0, 0 ' bar


  ' ** Add a top-level menu item with a popup menu:
  MENU NEW POPUP TO hPopup2 'assign a popup value
    pu = hPopup2 'easier to C&P when adding menus
   RSET u$ = "&L  Clipboard "
    MENU ADD POPUP,  hMenu, u$, pu, Stile 'assign to popup handle
           M$ = "&A  All Chains to Clipboard - Every Connection found.  (Starting default setting)"
          id = %Cb_All: m_Add_Option
      m_Add_Bar
        m$ = "&R  Results Only to Clipboard - No Connections"
          id = %Cb_Results_Only: m_Add_Option
      m_Add_Bar
        m$ = "&K  Keep only the Current Connection to Clipboard"
          id = %CB_One: m_Add_Option
      m_Add_Bar
        m$ = "&S  Show Clipboard Contents"
          id = %CB_Show_It: m_Add_Option
      m_Add_Bar
        m$ = "&E  Empty Clipboard"
          id = %CB_Erase_It: m_Add_Option
'
  MENU ATTACH hMenu, hDlg 'now add it to the dialog

END SUB
'
FUNCTION Setup_Main_Dialog(BYVAL hParent AS DWORD) AS LONG
   Common_Locals
   'Local Row&, Col&, col1&, Wdth&, Hght&, tb_Len&, lbl$, m$, m1$
     Wdth = 300
     Hght = (%Box_Height * 9) - 5 '160

    DIALOG NEW PIXELS, hDlg, "Word Connection Solver Research Only", _
           250, 200, Wdth, Hght, _
           %WS_SYSMENU, _
           TO hDlg
    DIALOG SET ICON hDlg, g_Icon_Id$ '"Zero"
    DIALOG SET COLOR hDlg, -1&, %Cream



    Row = 1
    Col = 185
    Box_Width = 108
    Stile = %SS_CENTER
    CONTROL ADD LABEL, hDlg, %Working_Label, lbl$, _
         Col, Row + 10, _
         Box_Width, %Box_Height * 7, _
         Stile

    x1 = 2 ' frame size
    CONTROL ADD FRAME, hDlg, -1, "", _
         Col - x1 - 1, Row, _
         Box_Width + (4 * x1), (%Box_Height * 7) + (7 * x1)


    Label_Set_Main

'5 ltr    ''SWIMS-CRAMP. It produced SWIMS SLIMS SLAMS CLAMS CLAMP CRAMP.
'   Inword = UCASE$("creepy")
'   outWord = UCASE$("shocks")
'    Inword = UCase$("voting")
'    outWord = UCase$("server")

  Row = 12
  Col = 10

  t1$ = "Snoop"
  t2$ = "Utter"

    lbl$ = "  Starting Word:"
      tb_len = LEN(lbl$) * 5

    CONTROL ADD LABEL, hDlg, 131, lbl$, _
         Col, Row, tb_len, %Box_Height
    CONTROL SET COLOR hDlg, 131, -1, %Cream
      CONTROL ADD TEXTBOX, hDlg, %Word_Start, t1$, _
          Col + tb_len + 5, Row, tb_len, %Box_Height

    RSET lbl$ = "Finishing Word:"
     Row = Row + (%Box_Height * 2)
     CONTROL ADD LABEL, hDlg, 132, lbl$, _
         Col, Row, tb_len, %Box_Height
    CONTROL SET COLOR hDlg, 132, -1, %Cream
      CONTROL ADD TEXTBOX, hDlg, %Word_Done, t2$, _
          Col + tb_len + 5, Row, tb_len, %Box_Height

'
     lbl$ = "All Chains in Clipboard"
      tb_len = LEN(lbl$) * 7
'     Row = Row + (%Box_Height * 2)
'     Control Add Button, hDlg, %Btn_CB_Toggle, lbl$, _
'        Col, Row, _
'        tb_len,  %Box_Height * 1.8
    LOCAL Sz#
      sz = 1.5
    lbl$ = "&S  Solve Word Connection"
     Row = Row + (%Box_Height * 2) - 12
     CONTROL ADD BUTTON,  hDlg, %Btn_01, lbl$, _
        Col, Row, _
        tb_len,  %Box_Height * Sz

    lbl$ = "&C Show the Clipboard"
     Row = Row + (%Box_Height * 2 )
     CONTROL ADD BUTTON,  hDlg, %Btn_02, lbl$, _
        Col, Row, _
        tb_len,  %Box_Height * Sz

 CALL Setup_Menus

    DIALOG SHOW MODAL hDlg, CALL CB_Dialog_Processor TO lRslt


    FUNCTION = lRslt
END FUNCTION
'------------------------------------------------------------------------------
SUB Back_Up  'use while working
  Common_locals
  t$ = "\Word_Connections.bas"
  fn$ = CURDIR$ & t$
    fle$ =  "h:" & t$ '\Z-Post.bas"
    FILECOPY fn$, fle$
      M$ = "Copied " & fn$  & $CRLF & _
         "to     " & fle$
         t1$ = m$
         m_Err_Msg

  t$ = "\Word_Connections.exe" 'to test it as standalone
  fn$ = CURDIR$ & t$
    fle$ =  "h:" & t$ '\Z-Post.bas"
    FILECOPY fn$, fle$
      M$ = "Copied " & fn$  & $CRLF & _
         "to     " & fle$
         t2$ = m$
         m_Err_Msg


      't1$ =  $CrLf  & String$(Len(m$), "*") & $CrLf
'      m$ = t1$ & $CrLf & t$
       m$ = t1$
       m1$ = t2$
       mb_Alert

END SUB

'------------------------------------------------------------------------------
SUB Hex_Test
  Common_Locals
  ' part of first line of John's Function fiveLetterWords() As String
  '&h00208C61,&h002084A4,&h00110469,&h00208961,&h00408D01
'  hex$
DIM d_a AS DWORD, s_b AS STRING, q_c AS QUAD 'don't conflict with Common_Locals
DIM d_a1 AS DWORD, s_b1 AS STRING, q_c1 AS QUAD 'don't conflict with Common_Locals

'Hex$ examples
'a = &H0FFFFFFFF    ' Unsigned literal
'b = Hex$(a)        ' "FFFFFFFF"
'c = a              ' 4294967295
'b = Hex$(c)        ' "FFFFFFFF"
'c = Val("&H" + b)  ' -1&& (signed conversion)
'b = Hex$(c)        ' "FFFFFFFF"
'c = Val("&H0" + b) ' 4294967295&&
'b = Hex$(c)        ' "FFFFFFFF"

 d_a = &h00208C61 'first letter? or a Quad?

  t$ = STR$(d_a)
  'a$ = ACODE$(UnicodeStrExpression)

  'a$ = UCODE$(AnsiStrExpression)

  m$ = USING$(" da = #, ", d_a):mb

END SUB

SUB All_Words_in_1_string
   Common_Locals

   IF g_All_Words$ > "A" THEN
     m$ = "g_All_Words$ Done":mb
    ' Exit Sub ' done already
   END IF
'   m$ = "at array 1":mb
               '  3 ltr 4ltr   5ltr    6ltr   wiggle room
   REDIM g_Words$(853 + 3130 + 6918 + 11492 + 100) 'num words possible 110,000
   g_timer = TIMER
   g_All_Words$ = SPACE$(1045000)'actually need 1,044,750 bytes
   x1 = 2 'place to put word - 1st space blank

  fn$ = CURDIR$ & "\Data_Words.txt"
   m_Input_Open
   WHILE NOT EOF(fnum)   '110,000 lines
     INPUT #fnum, flen, fn$ 'flen = word length
       IF flen < 3 THEN ITERATE LOOP '4-6 length only
       IF flen > 6 THEN EXIT LOOP
       IF INSTR(fn$, "End Word") THEN EXIT LOOP

        g_Words$(ctr)= fn$  'array to build All_Word.inc file with
          INCR ctr

'      g_All_Words$ = g_All_Words$ & " " & UCase$(fn$)'<-- takes 107.1 seconds
       MID$(g_All_Words$, x1) = UCASE$(fn$) & " "      '<-- takes .2 seconds
       x1 = x1 + LEN(fn$) + 1'+1 to put space in between

   WEND
   CLOSE #fnum
   ARRAY SORT g_Words$()

   'now make Include file
   ln = 210 'shorten lines to avoid "Source Line too long error msg (255? max)"
   RESET ctr1
   fn$ = g_Include_Name$ 'CurDir$ & "\Words_5_6_len.inc"
     m_OutPut_Open

   pf "g_All_Words$ = " & $DQ;
    FOR ctr = LBOUND(g_Words$()) TO UBOUND(g_Words$())
        IF ASC(g_Words$(ctr)) > 63 THEN
            pf " " & g_Words$(ctr);
            ctr1 = ctr1 + LEN(g_Words$(ctr)) + 1
            IF ctr1 > ln THEN 'make another line
               RESET ctr1
               pf " " & $DQ 'end this line
               pf "g_All_Words$ = g_All_Words$ & " & $DQ ;'new line
            END IF

        END IF
    NEXT ctr
       pf " " & $DQ 'last line
    CLOSE #fnum


   m$ = USING$("#, gAllWords long   took  .# Exiting now.", LEN(TRIM$(g_All_Words$)), TIMER-g_timer): mb
'   m$ = Right$(g_All_Words$, 500):mb
  CLOSE
END SUB
'
SUB Data_Words_into_Array(Word_Length&)
  Common_Locals

  g_timer = TIMER
  fn$ = CURDIR$ & "\Data_Words.txt"
   m_Input_Open

' Exit Sub
'  If UBound(g_Words$()) > 1000 Then
'    Close
'    Exit Sub 'already loaded
'  End If
  ERASE g_Words$  'jic
   WHILE NOT EOF(fnum)
     INPUT #fnum, flen, fn$ 'variables already declared so use them again
      IF flen = Word_Length& THEN
        REDIM PRESERVE g_Words$(UBOUND(g_Words$) + 1)
        g_Words$(UBOUND(g_Words$)) = fn$
      END IF
   WEND
   CLOSE #fnum                                         '+1 as array is 0 bound
'   m$ = Using$(" ##,### ## letter Words", UBound(g_Words$) + 1, Word_Length&)
'   m1$ = Using$("Took .## seconds to build the array", Timer - g_timer)
'   mb

END SUB
'Create data statements for use later
SUB Data_Words_Create_File
  Common_Locals

  Fill_G_Words_Array
   REDIM tmp(LBOUND(g_words) TO UBOUND(g_Words))' As String * 30 'longest word

  'strip words of ascii values
  FOR ctr = LBOUND(g_words) TO UBOUND(g_Words)
     RSET tmp$(Ctr)= MID$(g_Words$(ctr), 7)
  NEXT ctr
  ARRAY SORT tmp$() 'now sort according to string length

  fn$ = CURDIR$ & "\Data_Words.txt"
   m_Output_Open
   REDIM Ttls&(2 TO 30) 'largest word size

  FOR ctr = LBOUND(g_words) TO UBOUND(g_Words)
     t$ = TRIM$(tmp$(ctr)) 'convenience
     IF ASC(t$) > 64 THEN 'case of blank lines
        INCR ctr1
        INCR Ttls&(LEN(t$))
        pf USING$(" ##", LEN(t$)) & ", " & _
           TRIM$(tmp$(ctr))
     END IF
  NEXT ctr
  pf USING$(" ##", -1) & ", " & "End Words"
  pf 'blank line
  pf  USING$("#, elements #, Data Words", UBOUND(g_Words), ctr1)
   'mb
  pf
   'now put word count
  FOR ctr = LBOUND(ttls) TO UBOUND (ttls)
     pf USING$("   ##,###  ## letter words ", ttls(ctr), ctr)
  NEXT ctr


  CLOSE
  ERASE tmp$ 'don't need it any more
END SUB



'------------------------------------------------------------------------------
'   ** Main Application Entry Point **
'------------------------------------------------------------------------------
FUNCTION PBMAIN()
''''''   Call Data_Words_Create_File 'not needed anymore
'   Call Hex_Test:Exit Function

    Common_Locals

'  Call Back_Up 'while working
'   Call Good_Words_Only

   g_CB_All_or_One = 0' Chains as default for Clipboard
   g_Icon_Id$ = "Zero"
   g_timer = TIMER

  g_Include_Name$ = CURDIR$ & "\Check_Words_3_4_5_6.Inc" '4-6 word lengths

'     All_Words_in_1_String only builds the Include.Inc
'     Must Rem "#Include" below to run All_Words_in_1_String
'   Call All_Words_in_1_String: Exit Function
'local q2, q1 as quad
'    queryPerformanceCounter q1
#INCLUDE  "Check_Words_3_4_5_6b.Inc" 'Words put in g_All_Words$
'    queryPerformanceCounter q2
'    ? str$(q2 - q1)
'? str$(len(g_All_Words$)):exit function

' m$ = Using$("#, gAllwords$ took .## secs to load", _
'       Len(G_All_Words$), Timer-g_timer):mb_Alert



    Setup_Main_Dialog %HWND_DESKTOP


END FUNCTION
'------------------------------------------------------------------------------
'****************************************************************
'****************************************************************
'****************************************************************
'****************************************************************
'****************************************************************

'

                Comment

                  #88
                  Originally posted by John Gleason View Post
                  The kid I referred to is "Zero". For some reason, my main icon is a blue anchor on a white background. "Zero" is on the little taskbar & explorer icon.
                  Never noticed. The anchor is an icon I use sometimes in my stuff. I'll correct it. Probably never changed in the Desktop icon code.
                  Last edited by Gösta H. Lovgren-2; 8 Mar 2008, 12:29 PM.
                  It's a pretty day. I hope you enjoy it.

                  Gösta

                  JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                  LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                  Comment

                    #89
                    Re the Icon, to reset the icon on the desktop you'll have to do that via Properties/Set Icon (right click on the shortcut). I looked in the Sub Create_Shortcut code (which is nearly all C&P'ed from POFFS) but could find no reference to which Icon is used. The OpSys may use a number something, wheras I refence by name in the PBR.

                    Note I made a couple minor changes in the GUI (chgd Font in Textboxes, ...):

                    http://www.swedesdock.com/powerbasic/WC_3456.exe


                    http://www.swedesdock.com/powerbasic/WC_3456.bas


                    =========================================
                    "We are not retreating
                    we are advancing in another Direction."
                    General Douglas MacArthur (1880-1964)
                    =========================================
                    It's a pretty day. I hope you enjoy it.

                    Gösta

                    JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                    LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                    Comment

                      #90
                      From what I have noticed in POFFS and some other un-archived forums is that Windows will use the 1st icon alphanumerically declared in your resource file. So in this case (assuming the icons are "Anchor.ico" and "Zero.ico" then your program shows "Zero.ico" but the icon in Windows explorer will show "Anchor.ico" even though you declared your small icon to be "Zero.ico"
                      Engineer's Motto: If it aint broke take it apart and fix it

                      "If at 1st you don't succeed... call it version 1.0"

                      "Half of Programming is coding"....."The other 90% is DEBUGGING"

                      "Document my code????" .... "WHYYY??? do you think they call it CODE? "

                      Comment

                        #91
                        The way John packed these strings into longs and dwords got me to thinking about an early computer game for the TRS 80's. It was a tricky logic game. 3 rows of robots, each of an odd number (5, 7 & 9 IIRC). The TRS 80's were character oriented only (about zero graphics capabilities) and advanced programmers would use packed strings to create little blocky characters that could "dance". (Using an upper ASCCI set that could be put together to make "graphics")

                        In this particular two player game, either player could pick as many robots from a row as he wanted as long as he left at least 1. The game would go until one player had to pick the last robot from a row.

                        What made this particular game so neat (other than its clever simplicity) was the really clunky nature of the guiding robot who would either eagerly nod "yes" or shake his head sadly for "no" when player made a choice. Just had to make you chuckle. Every once in a while it will pop into my mind and I will do a lazy half hearted search for it but never could find it. (Probably help if I recalled the name.)

                        I wonder if any here recall the game and/or if there is a Windows version avl.
                        ============================================================
                        "Anything that is too stupid to be spoken is sung."
                        Voltaire (1694-1778)
                        ============================================================
                        It's a pretty day. I hope you enjoy it.

                        Gösta

                        JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                        LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                        Comment

                          #92
                          Hey there Gösta, I remember a game/puzzle like that--tho I never saw a computer version of it. It was three lines of 1's and, alternating turns, you cross off any number of 1's in only one row per turn, the object being to force the opponent to cross off the last 1. I don't remember the exact 1-count per line either, but it was three odd numbers almost for sure.
                          Code:
                          111111111
  11111
   111
                          I've been looking for it but can't find anything about it either. There is some trick where you can always win by, like, keeping two rows even and one odd or whatever. Clearly, I didn't memorize the trick. Suffice it to say that against anyone who knew the method, I always lost. At least I never played it for any (significant) bucks.

                          Comment

                            #93
                            Ahhhh the ole' "Trash-80"
                            Back when "Hard-Drive" meant "Cassette-Tape"

                            GAWWWWD....I loved that machine.....(It is probably what 1st got me programming even before a friend of mine got this "Whizzy-Bang" Commodore-64, that you could even play games on, and better than Atari???)

                            I wish I could remember the name of the game, but maybe a google for 80's computer games, TRS-80 may pull something up...(pretty sure some of the sites dedicated to the old games and emulators, but not sure on source code, so it would take some doing)

                            If I had the time, I would be interested in file size of the original, vs a PB port, vs (a more sadistic idea of .NET languages, and M$ 6 languages) to see how an original idea can grow and grow for the same concept of the game (code MUST stay as close to the original as possible though for a true test)

                            (Hey is it me? or is there no "Devil" / "Evil" icon to be used for the word "Sadistic"?????)

                            Gosta...if you can think of the name, I am sure we can find it....(hmmmmm...I wonder if that ole' beater of mine is still sitting in my parents basement? and even more if it still works????)
                            Engineer's Motto: If it aint broke take it apart and fix it

                            "If at 1st you don't succeed... call it version 1.0"

                            "Half of Programming is coding"....."The other 90% is DEBUGGING"

                            "Document my code????" .... "WHYYY??? do you think they call it CODE? "

                            Comment

                              #94
                              Probably it was Android Nim.

                              A video from the PET version:
                              YouTube - ANDROID NIM - Game for the Commodore PET

                              Windows version by the original author and some info:
                              Leo Christopher Son
                              http://www.leochristopherson.com/android_nim.htm


                              Bye!
                              Last edited by Marco Pontello; 22 Apr 2008, 07:58 PM.
                              -- The universe tends toward maximum irony. Don't push it.

                              File Extension Seeker - Metasearch engine for file extensions / file types
                              Online TrID file identifier | TrIDLib - Identify thousands of file formats

                              Comment

                                #95
                                Bingo

                                Right On The Money, Marco. Good job. That was it. I even remember the name of the author - Leo Christopher. I think he used to write articles in the TRS 80 Mags of the time (there were two or three) teaching programming techniques. They were the only source (pretty much) for those who had no experience with computers and had to write our own software.

                                The Win version (Android Nim) is the same game but I recall the TRS 80 version as being hipper and more cheeky. This one (logic aside) just seems sophomoric. (Not that 30 yro memories could have dulled the edges. Wasn't everything just, ah .., better in the old days?) The logic is still cool though.

                                I tried the DOS version (a C version written 12+ years later - not the the original in Basic which would have been cool to try) but it wouldn't run. It closes immediately as soon as the program ran.
                                It's a pretty day. I hope you enjoy it.

                                Gösta

                                JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                                LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                                Comment

                                  #96
                                  Yes, the interface is kinda chees... minimal, there aren't any chatting robots here, but maybe test it out for the logic accuracy. I was thinking about going to four rows too, 9 7 5 & 3.

                                  Code:
                                  #COMPILE EXE
#DIM ALL
DECLARE FUNCTION robotLogic(r() AS LONG) AS LONG
DECLARE FUNCTION rndGuess(bArr() AS LONG) AS LONG

FUNCTION PBMAIN () AS LONG

    LOCAL ii, hTurn, robLog AS LONG
    LOCAL si, mistake, rn, iPrompt AS STRING
    DIM botArr(1 TO 3) AS LONG
    ARRAY ASSIGN botArr() = 7,5,3
    RANDOMIZE
    ? "The object of the game is to make your opponent remove the last robot ® from the three rows of robots. " & _
      "You can remove any number of robots, even all in the chosen row, but only from one row at a time. Good luck." _
      ,,"Robot Nom"
    
    DO
          IF mistake = "" THEN
             IF hTurn = 0 THEN
                hTurn = 1
                rn = "Robot Nom: Human, Your Turn"
                iPrompt = "Choose row, then how many robots to remove:  eg. " & FORMAT$(rndGuess(botArr()))
                IF botArr(1) + botArr(2) + botArr(3) = 0 THEN
                   ? "Oof, my perfect moves were not enough to beat a humaaaan!" & $CRLF & $CRLF & _
                     "                     But anyway, thanks for the lesson.",,"Robot Nom"
                    EXIT FUNCTION
                END IF
             ELSE
                hTurn = 0
                rn = "Robot Nom: Superior Robot Turn"
                iPrompt = "My perfect robot move is entered below. Simply click OK to continue.
                robLog = robotLogic(botArr())
                IF robLog = 999 THEN EXIT FUNCTION
             END IF
          END IF
          IF robLog > 0 THEN
             mistake = FORMAT$(robLog)
             robLog = 0
          END IF
          
          si = INPUTBOX$(iPrompt & $CRLF & $CRLF & _
          "1" & SPACE$((7 - botArr(1)) + 3 + (7 - botArr(1)) \ 2) & REPEAT$(botArr(1), CHR$(&hae) & $SPC) & $CRLF & _
          "2" & SPACE$((5 - botArr(2)) + 6 + (5 - botArr(2)) \ 2) & REPEAT$(botArr(2), CHR$(&hae) & $SPC) & $CRLF & _
          "3" & SPACE$((3 - botArr(3)) + 9 + (3 - botArr(3)) \ 2) & REPEAT$(botArr(3), CHR$(&hae) & $SPC) & $CRLF   _
           ,rn,mistake)
          IF si = "" THEN EXIT DO
          mistake = ""
          si = RETAIN$(si, ANY "1234567")
          IF LEN(si) <> 2 THEN
             mistake = "Please re-enter last move"
             ITERATE DO
          END IF
          IF VAL(LEFT$(si, 1)) <= 3 AND VAL(LEFT$(si, 1)) > 0 AND VAL(RIGHT$(si, 1)) > 0 THEN
             botArr(VAL(LEFT$(si, 1))) = botArr(VAL(LEFT$(si, 1))) - VAL(RIGHT$(si, 1))
             IF botArr(VAL(LEFT$(si, 1))) < 0 THEN
                botArr(VAL(LEFT$(si, 1))) = botArr(VAL(LEFT$(si, 1))) + VAL(RIGHT$(si, 1))
                mistake = "Please re-enter last move"
             END IF
          ELSE
             mistake = "Please re-enter last move"
          END IF
    LOOP

END FUNCTION

FUNCTION robotLogic(r() AS LONG) AS LONG
  LOCAL s,sr AS STRING
  LOCAL x, s1,s2,s3, si1,si2,si3, ii, robAns, rChoice, rndCnt AS LONG
  DIM youLose(753) AS LONG, isValid(753) AS LONG, rb(1 TO 3) AS LONG
  IF r(1) + r(2) + r(3) = 0 THEN ? "Game over. Thanks for the match!",,"Robot Nom": FUNCTION = 999: EXIT FUNCTION
  FOR x = 1 TO 3: rb(x) = r(x): NEXT

  'leaving any two rows = 1 and other row > 1
  IF (rb(1) = 1 AND (rb(2) = 1 OR rb(3) = 1) OR _
      rb(2) = 1 AND rb(3) = 1) AND rb(1) + rb(2) + rb(3) > 3 THEN
     IF rb(1) <> 1 THEN rb(1) = 1
     IF rb(2) <> 1 THEN rb(2) = 1
     IF rb(3) <> 1 THEN rb(3) = 1
     robAns = rb(1) * 100 + rb(2) * 10 + rb(3)
     GOTO convertAns

  'two rows equal
  ELSEIF rb(1) = rb(2) OR rb(1) = rb(3) OR rb(2) = rb(3) THEN
     IF rb(1) = rb(2) THEN
        IF rb(1) = 0 THEN rb(3) = 1 ELSE rb(3) = 0
     ELSEIF rb(1) = rb(3) THEN
        IF rb(1) = 0 THEN rb(2) = 1 ELSE rb(2) = 0
     ELSEIF rb(3) = rb(2) THEN
        IF rb(3) = 0 THEN rb(1) = 1 ELSE rb(1) = 0
     END IF
     robAns = rb(1) * 100 + rb(2) * 10 + rb(3)
     GOTO convertAns

  'one row is 0
  ELSEIF rb(1) = 0 OR rb(2) = 0 OR rb(3) = 0 THEN
     'see if any row is 1
     IF rb(1) = 1 OR rb(2) = 1 OR rb(3) = 1 THEN
        IF rb(1) <> 1 THEN  rb(1) = 0
        IF rb(2) <> 1 THEN  rb(2) = 0
        IF rb(3) <> 1 THEN  rb(3) = 0
        robAns = rb(1) * 100 + rb(2) * 10 + rb(3)
        GOTO convertAns
     END IF
     'make rows even
     IF rb(1) = 0 THEN
        IF rb(2) > rb(3) THEN rb(2) = rb(3) ELSE rb(3) = rb(2)
     ELSEIF rb(2) = 0 THEN
        IF rb(1) > rb(3) THEN rb(1) = rb(3) ELSE rb(3) = rb(1)
     ELSE
        IF rb(1) > rb(2) THEN rb(1) = rb(2) ELSE rb(2) = rb(1)
     END IF
     'handle very end play
     IF rb(1) = 1 OR rb(2) = 1 THEN
        IF rb(1) = 1 THEN rb(1) = 0 ELSE rb(3) = 0
     END IF
     robAns = rb(1) * 100 + rb(2) * 10 + rb(3)
     GOTO convertAns
  END IF
  x = rb(1) * 100 + rb(2) * 10 + rb(3)

'make validation array
isValid(123) = 1
isValid(132) = 1
isValid(142) = 1
isValid(143) = 1
isValid(152) = 1
isValid(153) = 1
isValid(213) = 1
isValid(231) = 1
isValid(241) = 1
isValid(243) = 1
isValid(251) = 1
isValid(253) = 1
isValid(312) = 1
isValid(321) = 1
isValid(341) = 1
isValid(342) = 1
isValid(351) = 1
isValid(352) = 1
isValid(412) = 1
isValid(413) = 1
isValid(421) = 1
isValid(423) = 1
isValid(431) = 1
isValid(432) = 1
isValid(451) = 1
isValid(452) = 1
isValid(453) = 1
isValid(512) = 1
isValid(513) = 1
isValid(521) = 1
isValid(523) = 1
isValid(531) = 1
isValid(532) = 1
isValid(541) = 1
isValid(542) = 1
isValid(543) = 1
isValid(612) = 1
isValid(613) = 1
isValid(621) = 1
isValid(623) = 1
isValid(631) = 1
isValid(632) = 1
isValid(641) = 1
isValid(642) = 1
isValid(643) = 1
isValid(651) = 1
isValid(652) = 1
isValid(653) = 1
isValid(712) = 1
isValid(713) = 1
isValid(721) = 1
isValid(723) = 1
isValid(731) = 1
isValid(732) = 1
isValid(741) = 1
isValid(742) = 1
isValid(743) = 1
isValid(751) = 1
isValid(752) = 1
isValid(753) = 1

'possible win array. If = 1 then human loses
youLose(123) = 0
youLose(132) = 0
youLose(142) = 1
youLose(143) = 1
youLose(152) = 1
youLose(153) = 1
youLose(213) = 0
youLose(231) = 0
youLose(241) = 1
youLose(243) = 1
youLose(251) = 1
youLose(253) = 1
youLose(312) = 0
youLose(321) = 0
youLose(341) = 1
youLose(342) = 1
youLose(351) = 1
youLose(352) = 1
youLose(412) = 1
youLose(413) = 1
youLose(421) = 1
youLose(423) = 1
youLose(431) = 1
youLose(432) = 1
youLose(451) = 0
youLose(452) = 1
youLose(453) = 1
youLose(512) = 1
youLose(513) = 1
youLose(521) = 1
youLose(523) = 1
youLose(531) = 1
youLose(532) = 1
youLose(541) = 0
youLose(542) = 1
youLose(543) = 1
youLose(612) = 1
youLose(613) = 1
youLose(621) = 1
youLose(623) = 1
youLose(631) = 1
youLose(632) = 1
youLose(641) = 1
youLose(642) = 0
youLose(643) = 1
youLose(651) = 1
youLose(652) = 1
youLose(653) = 0
youLose(712) = 1
youLose(713) = 1
youLose(721) = 1
youLose(723) = 1
youLose(731) = 1
youLose(732) = 1
youLose(741) = 1
youLose(742) = 1
youLose(743) = 0
youLose(751) = 1
youLose(752) = 0
youLose(753) = 1

 IF youLose(x) = 1 THEN
    FOR ii = 752 TO 123 STEP -1
       IF isValid(ii) = 1 THEN
          IF youLose(ii) = 0 THEN
             IF ii < x THEN
                s1 = x \ 100
                s2 = (x - s1 * 100) \ 10
                s3 = x MOD 10
                si1 = ii \ 100
                si2 = (ii - si1 * 100) \ 10
                si3 = ii MOD 10
                IF s1 = si1 AND s2 = si2 OR _
                   s1 = si1 AND s3 = si3 OR _
                   s2 = si2 AND s3 = si3 THEN
                   robAns = ii: GOTO convertAns
                END IF
             END IF
          END IF
       END IF
    NEXT
    ? "I found no win! error somewhere."
 ELSE
    s1 = x \ 100
    s2 = (x - s1 * 100) \ 10
    s3 = x MOD 10
    si1 = s1: si2 = s2: si3 = s3
    
   reRand:
    rChoice = RND(1, 3)                                   'I got no good move
    
    IF s1 - s2 <> 1 AND s1 - s3 <> 1 AND s1 > 1 AND rChoice = 1 THEN
       DECR s1                                            'one off top row
    ELSEIF s2 - s1 <> 1 AND s2 - s3 <> 1 AND s2 > 1 AND rChoice = 2 THEN
       DECR s2                                            'one off mid row
    ELSEIF s3 - s1 <> 1 AND s3 - s2 <> 1 AND s3 > 1 AND rChoice = 3 THEN
       DECR s3                                            'one off low row
    ELSE
       INCR rndCnt
       IF rndCnt < 3 GOTO reRand                          'try the above more competitive method 3x
       IF s1 >= s2 AND s1 >= s3 AND rChoice = 1 THEN
          DECR s1
       ELSEIF s2 >= s1 AND s2 >= s3 AND rChoice = 2 THEN
          DECR s2
       ELSEIF rChoice = 3 THEN
          DECR s3
       END IF
    END IF
    IF s1 = si1 AND s2 = si2 AND s3 = si3 GOTO reRand
    robAns = s1 * 100 + s2 * 10 +  s3
 END IF

 convertAns:
     s1 = robAns \ 100
     s2 = (robAns - s1 * 100) \ 10
     s3 = robAns MOD 10
     IF r(1) <> s1 THEN
        FUNCTION = 10 + r(1) - s1
     ELSEIF r(2) <> s2 THEN
        FUNCTION = 20 + r(2) - s2
     ELSEIF r(3) <> s3 THEN
        FUNCTION = 30 + r(3) - s3
     ELSE
        IF s1 >= s2 AND s1 >= s3 THEN
           FUNCTION = 11
        ELSEIF s2 >= s1 AND s2 >= s3 THEN
           FUNCTION = 21
        ELSE
           FUNCTION = 31
        END IF
     END IF

END FUNCTION

FUNCTION rndGuess(bArr() AS LONG) AS LONG
   LOCAL x AS LONG
      IF bArr(1) + bArr(2) + bArr(3) > 0 THEN
         DO: x = RND(1, 3): LOOP WHILE bArr(x) = 0
      END IF   
      IF x = 1 THEN FUNCTION = x * 10 + RND(1, bArr(1))
      IF x = 2 THEN FUNCTION = x * 10 + RND(1, bArr(2))
      IF x = 3 THEN FUNCTION = x * 10 + RND(1, bArr(3))
   
END FUNCTION

                                  Comment

                                    #97
                                    Nice simple interface, John. Makes a good starting point I think. What I might suggest is not requiring any clicks on the User part. As soon as two numbers are entered the computer analzes and acts accordingly. Then when it's the computer's turn, have him display his response for say (2-5 secs), then go ahead.

                                    Just a thought. If someone would like to play with sprites (I think that's what they are called), this would be a good starting point.

                                    And while we're on the subject of Logic Games, I'd advise anyone to try Genius Move. A penguin pushes ice blocks around. Sound Silly? It is, but it'll keep you up at night, that's for sure. Dunno how many levels there are but I've been stuck at 38 for over a year. And still keep trying - when I (unfortunately) think about it.

                                    It's $20 after a free trial but plenty worth it. At least for my money.
                                    It's a pretty day. I hope you enjoy it.

                                    Gösta

                                    JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                                    LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                                    Comment

                                    Previous 1 5 template Next
                                    Working...
                                    X
                                    😀
                                    🥰
                                    🤢
                                    😎
                                    😡
                                    👍
                                    👎

                                    We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.

                                    By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.

                                    I Agree