0010  // Pentomino puzzle
0020
0030 USE UNIGRAPHICS
0040
0050 init // Initialize pentomino board and pieces
0060
0070 start:=timer
0080 place_next(1,0) // Place 1. piece on start of board
0090 PRINT AT 2,45: USING chr$(1)+"Time used: #### min.": (timer-start)/60
0100
0110  // ********** End of main program **************
0120
0130
0140  // ********** Main procedure *******************
0150
0160 PROC place_next(n,free_field)
0170   IF n<=number_of_pieces THEN
0180     WHILE board(free_field)<>0 DO free_field:+1 // Find first free field
0190     FOR piece:=1 TO number_of_pieces DO  // For each piece
0200       IF NOT piece@(piece).used THEN  // .. which is not placed
0210         FOR var_no:=1 TO piece@(piece).number_of_variants DO
0220           IF placeable(piece@(piece),var_no) THEN
0230             place(piece@(piece),var_no)
0240             place_next(n+1,free_field+1)
0250             remove(piece@(piece),var_no)
0260           ENDIF
0270         ENDFOR var_no
0280       ENDIF
0290     ENDFOR piece
0300   ELSE  // all placed
0310     IF NOT symmetric THEN  // Test for symmetri and store
0320       show // Show solution
0330     ENDIF
0340   ENDIF
0350
0360   FUNC placeable(REF piece@,variant) // Test if piece-variant is placeab
0370     FOR i:=1 TO piece_size DO
0380       IF board(free_field+piece@.variant(variant,i)) THEN
0390         RETURN false
0400       ENDIF
0410     ENDFOR i
0420     RETURN true
0430   ENDFUNC placeable
0440
0450   PROC place(REF piece@,var_no) // Place piece on puzzle board
0460     board(free_field):=piece
0470     FOR i:=1 TO piece_size DO
0480       board(free_field+piece@.variant(var_no,i)):=piece
0490     ENDFOR i
0500     piece@.used:=true
0510   ENDPROC place
0520
0530   PROC remove(REF piece@,var_no) // Remove piece from puzzle board
0540     board(free_field):=0
0550     FOR i:=1 TO piece_size DO
0560       board(free_field+piece@.variant(var_no,i)):=0
0570     ENDFOR i
0580     piece@.used:=false
0590   ENDPROC remove
0600
0610 ENDPROC place_next
0620
0630
0640  // *********** Special procedures *****************
0650
0660 PROC show // Show solution graphically
0670   solution_no:+1
0680   PRINT chr$(24),
0690   LOOP 12 TIMES PRINT
0700   PRINT AT 20,3: solution_no,"."
0710   pencolor(2)
0720   moveto(50,20+10*h)
0730   draw(0,-10*h)
0740   draw(20*w,0)
0750   draw(0,10*h)
0760   draw(-20*w,0)
0770   pencolor(1)
0780   fill(52,22)
0790   moveto(50,20+10*h)
0800   pencolor(2)
0810   FOR i:=1 TO h-1 DO
0820     move(0,-10)
0830     FOR j:=0 TO w-1 DO
0840       IF board(j*7+i-1)<>board(j*7+i) THEN
0850         draw(20,0)
0860       ELSE
0870         move(20,0)
0880       ENDIF
0890     ENDFOR j
0900     move(-20*w,0)
0910   ENDFOR i
0920   move(0,10*(h-1))
0930   FOR i:=1 TO w-1 DO
0940     move(20,0)
0950     FOR j:=0 TO h-1 DO
0960       IF board((i-1)*7+j)<>board(i*7+j) THEN
0970         draw(0,-10)
0980       ELSE
0990         move(0,-10)
1000       ENDIF
1010     ENDFOR j
1020     move(0,10*h)
1030   ENDFOR i
1040   move(-20*(w-1),0)
1050   pencolor(1)
1060
1070   PRINT AT 2,45: "Silent please, I am thinking!"
1080
1090 ENDPROC show
1100
1110 FUNC symmetric // Test for symmetri
1120   TRAP
1130     OPEN FILE 2,solution$,READ
1140   HANDLER
1150     OPEN FILE 2,solution$,WRITE
1160     WRITE FILE 2: board()
1170     CLOSE FILE 2
1180     RETURN false
1190   ENDTRAP
1200
1210   WHILE NOT eof(2) DO
1220     READ FILE 2: oldboard()
1230
1240     i:=0 // Test for vertical symmetri
1250     REPEAT
1260       j:=0
1270       REPEAT
1280         equal:=(oldboard(7*i+j)=board(7*i+(h-1-j)))
1290         j:+1
1300       UNTIL j=h OR NOT equal
1310       i:+1
1320     UNTIL i=w OR NOT equal
1330     IF equal THEN
1340       CLOSE FILE 2
1350       RETURN true
1360     ENDIF
1370
1380     i:=0 // Test for horizontal symmetri
1390     REPEAT
1400       j:=0
1410       REPEAT
1420         equal:=(oldboard(7*i+j)=board(7*(w-1-i)+j))
1430         j:+1
1440       UNTIL j=h OR NOT equal
1450       i:+1
1460     UNTIL i=w OR NOT equal
1470     IF equal THEN
1480       CLOSE FILE 2
1490       RETURN true
1500     ENDIF
1510
1520     i:=0 // Test for rotational symmetri
1530     REPEAT
1540       j:=0
1550       REPEAT
1560         equal:=(oldboard(7*i+j)=board(7*(w-1-i)+(h-1-j)))
1570         j:+1
1580       UNTIL (j=h) OR (NOT equal)
1590       i:+1
1600     UNTIL (i=w) OR (NOT equal)
1610     IF equal THEN
1620       CLOSE FILE 2
1630       RETURN true
1640     ENDIF
1650   ENDWHILE
1660
1670   CLOSE FILE 2
1680   OPEN FILE 2,solution$,APPEND
1690   WRITE FILE 2: board()
1700   CLOSE FILE 2
1710   RETURN false
1720 ENDFUNC symmetric
1730
1740
1750  // ************ Initialization section *********
1760
1770 PROC init
1780
1790   page
1800   PRINT AT 4,5: "Pentomino puzzle"
1810   PRINT AT 8,5: "Specify height of puzzle board (3,4,5 or 6): "
1820   REPEAT
1830     INPUT AT 8,50: chr$(1): h
1840   UNTIL h=3 OR h=4 OR h=5 OR h=6
1850   w:=60/h
1860
1870   solution$:="ram:PentoSolution.dat"
1880   DELETE solution$
1890
1900   DIM board(0:7*21-1), oldboard(0:7*21-1)
1910   board():=-1
1920   FOR i:=0 TO w-1 DO
1930     FOR j:=0 TO h-1 DO
1940       board(7*i+j):=0
1950     ENDFOR j
1960   ENDFOR i
1970
1980   number_of_pieces:=12; piece_size:=4 // For Pentomino
1990   solution_no:=0 // No solution yet
2000   RECORD piece_model@
2010     FIELD used // Logical variable
2020     FIELD number_of_variants
2030     FIELD variant(8,piece_size) // Max. 8 variants per piece
2040   ENDRECORD piece_model@
2050   DIM piece@(number_of_pieces) OF piece_model@
2060   FOR i:=1 TO number_of_pieces DO
2070     READ piece@(i).number_of_variants
2080     FOR j:=1 TO piece@(i).number_of_variants DO
2090       FOR k:=1 TO piece_size DO
2100         READ piece@(i).variant(j,k)
2110       ENDFOR k
2120     ENDFOR j
2130   ENDFOR i
2140
2150   graphicscreen(0)
2160   clearscreen
2170
2180   PRINT AT 2,45: "Silent please, I am thinking!"
2190
2200 ENDPROC init
2210
2220
2230  // Specification of pieces and variants
2240
2250 DATA 2 // Number of variants for 1. piece
2260 DATA 1,2,3,4
2270 DATA 7,14,21,28
2280
2290 DATA 8 // Number of variants for 2. piece
2300 DATA 1,2,3,7
2310 DATA 1,8,15,22
2320 DATA 4,5,6,7
2330 DATA 7,14,21,22
2340 DATA 7,8,9,10
2350 DATA 1,7,14,21
2360 DATA 1,2,3,10
2370 DATA 7,14,20,21
2380
2390 DATA 8 // Number of variants for 3. piece
2400 DATA 1,2,3,8
2410 DATA 6,7,14,21
2420 DATA 5,6,7,8
2430 DATA 7,14,15,21
2440 DATA 6,7,8,9
2450 DATA 7,8,14,21
2460 DATA 1,2,3,9
2470 DATA 7,13,14,21
2480
2490 DATA 8 // Number of variants for 4. piece
2500 DATA 1,8,9,10
2510 DATA 6,7,13,20
2520 DATA 1,2,9,10
2530 DATA 7,13,14,20
2540 DATA 1,2,6,7
2550 DATA 7,8,15,22
2560 DATA 1,5,6,7
2570 DATA 7,14,15,22
2580
2590 DATA 4 // Number of variants for 5. piece
2600 DATA 7,14,15,16
2610 DATA 1,2,7,14
2620 DATA 1,2,9,16
2630 DATA 7,12,13,14
2640
2650 DATA 4 // Number of variants for 6. piece
2660 DATA 1,2,8,15
2670 DATA 5,6,7,14
2680 DATA 7,13,14,15
2690 DATA 7,8,9,14
2700
2710 DATA 4 // Number of variants for 7. piece
2720 DATA 1,8,15,16
2730 DATA 5,6,7,12
2740 DATA 1,7,13,14
2750 DATA 7,8,9,16
2760
2770 DATA 4 // Number of variants for 8. piece
2780 DATA 1,7,14,15
2790 DATA 1,2,7,9
2800 DATA 1,8,14,15
2810 DATA 2,7,8,9
2820
2830 DATA 8 // Number of variants for 9. piece
2840 DATA 1,7,8,14
2850 DATA 1,2,8,9
2860 DATA 6,7,13,14
2870 DATA 1,7,8,9
2880 DATA 7,8,14,15
2890 DATA 1,6,7,8
2900 DATA 1,7,8,15
2910 DATA 1,2,7,8
2920
2930 DATA 8 // Number of variants for 10. piece
2940 DATA 1,8,9,15
2950 DATA 5,6,7,13
2960 DATA 6,7,14,15
2970 DATA 6,7,8,13
2980 DATA 7,8,13,14
2990 DATA 6,7,8,15
3000 DATA 1,6,7,14
3010 DATA 7,8,9,15
3020
3030 DATA 4 // Number of variants for 11. piece
3040 DATA 1,8,9,16
3050 DATA 6,7,12,13
3060 DATA 7,8,15,16
3070 DATA 1,6,7,13
3080
3090 DATA 1 // Number of variants for 12. piece
3100 DATA 6,7,8,14
