#COMPILE EXE
#DIM ALL
'
' A B C p r o b l e m . b a s
'
' by  Geary Chopoff
' for Chopoff Consulting and RosettaCode.org
' on  2014Jul23
'
'2014Jul23
'
'You are given a collection of ABC blocks. Just like the ones you had when you were a kid.
'There are twenty blocks with two letters on each block. You are guaranteed to have a complete
'alphabet amongst all sides of the blocks. The sample blocks are:
'((B O) (X K) (D Q) (C P) (N A) (G T) (R E) (T G) (Q D) (F S) (J W) (H U) (V I) (A N) (O B) (E R) (F S) (L Y) (P C) (Z M))
'The goal of this task is to write a function that takes a string and can determine whether
'you can spell the word with the given collection of blocks.
'
'The rules are simple:
'1.Once a letter on a block is used that block cannot be used again
'2.The function should be case-insensitive
'3. Show your output on this page for the following words:
'	A, BARK, BOOK, TREAT, COMMON, SQUAD, CONFUSE
'-----------------------------------------------------------------------------
' G l o b a l   C o n s t a n t s
'
%Verbose = 0                'make this 1 to have a lot of feedback
%MAX_BLOCKS = 20            'total number of blocks
%MAX_SIDES = 2              'total number of sides containing a unique letter per block

%MAX_ASC = 255
%FALSE = 0                  'this is correct because there is ONLY ONE value for FALSE
%TRUE  = (NOT %FALSE)       'this is one of MANY values of TRUE!
$FLAG_TRUE = "1"
$FLAG_FALSE = "0"
'-----------------------------------------------------------------------------
' G l o b a l   V a r i a b l e s
'
GLOBAL blk() AS STRING
'-----------------------------------------------------------------------------
'i n i t B l o c k s
'
' as we will use this array only once we build it each time program is run
'
SUB initBlocks
 LOCAL j AS INTEGER
    j=1
    blk(j)="BO"
    j=j+1
    blk(j)="XK"
    j=j+1
    blk(j)="DQ"
    j=j+1
    blk(j)="CP"
    j=j+1
    blk(j)="NA"
    j=j+1
    blk(j)="GT"
    j=j+1
    blk(j)="RE"
    j=j+1
    blk(j)="TG"
    j=j+1
    blk(j)="QD"
    j=j+1
    blk(j)="FS"
    j=j+1
    blk(j)="JW"
    j=j+1
    blk(j)="HU"
    j=j+1
    blk(j)="VI"
    j=j+1
    blk(j)="AN"
    j=j+1
    blk(j)="OB"
    j=j+1
    blk(j)="ER"
    j=j+1
    blk(j)="FS"
    j=j+1
    blk(j)="LY"
    j=j+1
    blk(j)="PC"
    j=j+1
    blk(j)="ZM"
    IF j <> %MAX_BLOCKS THEN
        STDOUT "initBlocks:Error: j is not same as MAX_BLOCKS!",j,%MAX_BLOCKS
    END IF
END SUB
'-----------------------------------------------------------------------------
' m a k e W o r d
'
FUNCTION makeWord(tryWord AS STRING) AS BYTE
 LOCAL retTF AS BYTE
 LOCAL j AS INTEGER
 LOCAL s AS INTEGER         'which side of block we are looking at
 LOCAL k AS INTEGER
 LOCAL c AS STRING          'character in tryWord we are looking for


    FOR j = 1 TO LEN(tryWord)
        c = UCASE$(MID$(tryWord,j,1))   'character we want to show with block

        retTF = %FALSE                  'we assume this will fail

        FOR k = 1 TO %MAX_BLOCKS
            IF LEN(blk(k)) = %MAX_SIDES THEN
                FOR s = 1 TO %MAX_SIDES
                    IF c = MID$(blk(k),s,1) THEN
                        retTF = %TRUE   'this block has letter we want
                        blk(k) = ""     'remove this block from further consideration
                        EXIT FOR
                    END IF
                NEXT s
            END IF
            IF retTF THEN EXIT FOR      'can go on to next character in word
        NEXT k
        IF ISFALSE retTF THEN EXIT FOR  'if character not found then all is done
    NEXT j

    FUNCTION = retTF
END FUNCTION
'-----------------------------------------------------------------------------
' P B M A I N
'
FUNCTION PBMAIN () AS LONG
 DIM blk(1 TO %MAX_BLOCKS, 1 TO %MAX_SIDES) AS STRING
 LOCAL cmdLine AS STRING

    initBlocks              'setup global array of blocks

    cmdLine=COMMAND$
    IF LEN(cmdLine)= 0 THEN
        STDOUT "Useage for ABCproblem Version 1.00:"
        STDOUT ""
        STDOUT "     >ABCproblem tryThisWord"
        STDOUT ""
        STDOUT "Where tryThisWord is a word you want to see if"+STR$(%MAX_BLOCKS)+" blocks can make."
        STDOUT "If word can be made TRUE is returned."
        STDOUT "Otherwise FALSE is returned."
        EXIT FUNCTION
    END IF

    IF INSTR(TRIM$(cmdLine)," ") = 0 THEN
        IF makeWord(cmdLine) THEN
            STDOUT "TRUE"
        ELSE
            STDOUT "FALSE"
        END IF
    ELSE
        STDOUT "Error:Missing word to try to make with blocks!  <" & cmdLine & ">"
        EXIT FUNCTION
    END IF
END FUNCTION