Initial data commit

Task/ABC-problem/PowerBASIC/abc-problem.basic

@@ -0,0 +1,155 @@
+#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