Category : Databases and related files
Archive   : WOODCUT.ZIP
Filename : WOOD.BAS

100 REM ** WOOD.BAS * WRITTEN BY THE CODEWORKS STAFF **
101 REM ** CODEWORKS, 3838 SOUTH WARNER ST. TACOMA WA, 98409
102 REM ** (206) 475-2219 VOICE (206) 475-2356 MODEM
103 REM ** DO NOT REMOVE THE ABOVE CREDIT LINES PLEASE.
105 CLEAR 1000:REM USE ONLY IF YOU NEED TO CLEAR SPACE **
110 DEFINT I,J,K,N,U
120 DIM R(50,3),S(80,2),O(50,5)
130 GOSUB 160
140 REM ** INPUT AND INSTRUCTION MODULE **
150 GOTO 170
160 PRINT CHR$(12):RETURN:REM CHANGE TO CLS IF NECESSARY **
170 PRINT STRING$(22,"-");" The CodeWorks ";STRING$(23,"-")
180 PRINT" W O O D C U T T I N G G U I D E"
190 PRINT" also known as BalsaCalc to the Editors"
200 PRINT STRING$(60,"-")
210 PRINT "(Enter dimensions in INCHES and decimal fractions.)"
220 PRINT
230 PRINT"You need to enter Length, (0 will terminate entries),"
240 PRINT" then Width,"
250 PRINT" then Grain direction of each required piece."
260 PRINT" Grain = 1 for parallel to length,"
270 PRINT" = 2 for parallel to width."
280 PRINT
290 INPUT"Enter 0 for no Kerf, 1 for 1/16th, 2 for 1/8th inch";SK
300 IF SK=1 THEN SK=.0625 ELSE IF SK=2 THEN SK=.125 ELSE SK=0
310 PRINT
320 LA=96:LB=48
330 FOR I = 1 TO 49
340 PRINT"PIECE #";I;"LENGTH";:INPUT R(I,1)
350 IF R(I,1)=0 THEN GOTO 440
360 PRINT" WIDTH";:INPUT R(I,2)
370 IF R(I,2)=0 THEN PRINT"CAN'T HAVE ZERO WIDTH-TRY AGAIN":GOTO 340
380 PRINT" GRAIN";:INPUT R(I,3)
390 IF R(I,3)>2 OR R(I,3)<1 THEN PRINT"PLEASE ENTER ONLY 1 OR 2":GOTO 380
400 PRINT STRING$(33,"-")
410 IF R(I,1)>LA OR R(I,2)>LB OR (R(I,1)>LB AND R(I,3)=2) THEN PRINT "CAN'T BE DONE - TRY AGAIN":GOTO 340
420 IF R(I,3)=2 THEN T=R(I,1):R(I,1)=R(I,2):R(I,2)=T
430 NEXT I
440 NR=I-1:FL=0:SQ=0:LF=0
450 REM ** FIND THE TOTAL SQ AREA OF REQ. PIECES **
460 FOR I=1 TO NR
470 SQ=SQ+R(I,1)*R(I,2)
480 NEXT I
490 LF=INT((SQ-1)/(LA*LB))+1:REM ** ESTABLISH EXPECTED SHEETS **
500 REM ** SORT REQ PIECES INTO DESCENDING ORDER ***
510 F=0
520 FOR I=1 TO NR-1
530 L=I+1
540 IF FL=1 THEN GOTO 570
550 IF R(I,1)+R(I,2)=>R(L,1)+R(L,2)THEN GOTO 610
560 GOTO 580
570 IF R(I,1)=>R(L,1) THEN GOTO 610
580 T=R(I,1):R(I,1)=R(L,1):R(L,1)=T
590 T=R(I,2):R(I,2)=R(L,2):R(L,2)=T
600 F=1
610 NEXT I
620 IF F=1 THEN GOTO 510
630 REM *** NOW SORT WIDTH WITHIN LENGTH ***
640 F=0
650 FOR I=1 TO NR-1
660 L=I+1
670 IF R(I,1)<>R(L,1) THEN GOTO 710
680 IF R(I,2)=>R(L,2) THEN GOTO 710
690 T=R(I,2):R(I,2)=R(L,2):R(L,2)=T
700 F=1
710 NEXT I
720 IF F=1 THEN GOTO 640
730 IF FL=<1 THEN GOTO 930
740 IF INT(FL/2)-FL/2<>0 THEN GOTO 830
750 REM *** RECIRCULATE THE REQUIRED LIST ROUTINE ***
760 R(0,1)=R(NR,1):R(0,2)=R(NR,2)
770 FOR Q=NR TO 0 STEP -1
780 L=Q-1:IF L<0 THEN GOTO 810
790 R(Q,1)=R(L,1):R(Q,2)=R(L,2)
800 R(L,1)=0:R(L,2)=0
810 NEXT Q
820 REM *** THE OBVIOUS IMPOSSIBLE FIT ROUTINE ****
830 IF FL<>2*NR THEN GOTO 930
840 FT=0
850 FOR I=1 TO NR-1
860 FOR Q=I+1 TO NR
870 IF R(I,1)+R(Q,1)>LA AND R(Q,2)>LB-R(I,2) THEN FT=1:GOTO 910
880 IF R(I,2)+R(Q,2)>LB AND R(I,1)+R(Q,1)+R(Q+1,1)>LA AND R(Q+1,2)>LB-R(I,2) OR R(Q+1,2)>LB-R(Q,2) THEN FT=1:GOTO 910
890 NEXT Q
900 NEXT I
910 IF LF<2 THEN LF=LF+FT
920 REM ** COMPARE REQUIRED PIECES TO STOCK PIECES ***
930 K=1
940 FOR I=1 TO NR
950 J=1
960 REM ** IF THERE IS NO STOCK - PULL IN A NEW SHEET ***
970 IF J>NS THEN S(J,1)=LA:S(J,2)=LB:NP=NP+1:NS=NS+1:V=1:GOTO 950
980 IF NP>LF AND FL<>2*NR THEN GOTO 1710
990 IF V<>1 OR FL=>4 THEN GOTO 1080
1000 REM *** MOVE NEXT 48" PIECE SO IT CUTS FROM A FULL SHEET ***
1010 FOR Q=I TO NR
1020 IF R(Q,2)<>LB THEN GOTO 1060
1030 T=R(I,1):R(I,1)=R(Q,1):R(Q,1)=T
1040 T=R(I,2):R(I,2)=R(Q,2):R(Q,2)=T
1050 GOTO 1080
1060 NEXT Q
1070 REM ** LOOK FOR EXACT FIT IN THE STOCKPILE ***
1080 FOR U=1 TO NS:IF R(I,1)=S(U,1) AND R(I,2)=S(U,2) THEN J=U:GOTO 1210
1090 NEXT U
1100 REM *** LOOK FOR EQUAL LENGTHS ****
1110 FOR U=1 TO NS:IF R(I,1)=S(U,1) AND R(I,2)=< S(U,2)THEN J=U:GOTO 1210
1120 NEXT U
1130 REM *** LOOK FOR EQUAL WIDTHS ****
1140 FOR U=1 TO NS:IF R(I,2)=S(U,2) AND R(I,1)=< S(U,1) THEN J=U:GOTO 1210
1150 NEXT U
1160 REM *** TAKE ANYTHING THAT FITS! ***
1170 FOR U=1 TO NS:IF R(I,1)= 1180 NEXT U
1190 J=J+1:GOTO 970
1200 REM ** STUFF THE CUT BUFFER WITH ALL THE DIMENSIONS ***
1210 O(K,1)=R(I,1):O(K,2)=R(I,2):O(K,3)=S(J,1):O(K,4)=S(J,2)
1220 L=S(J,1):W=S(J,2):LC=R(I,1):WC=R(I,2)
1230 REM *** CHECK FOR SINGLE CUT SITUATIONS *****
1240 IF L=LC AND W=WC THEN S(J,1)=0:S(J,2)=0:C=1:GOTO 1360
1250 IF L=LC THEN S(J,2)=W-WC-SK:C=2:GOTO 1360
1260 IF W=WC THEN S(J,1)=L-LC-SK:C=3:GOTO 1360
1270 REM ** DETERMINE WHETHER 4 OR 5 CUT AND SIZE OF LEFTOVERS ***
1280 IF INT(FL/2)-FL/2<>0 AND V=1 AND I=1 THEN GOTO 1350
1290 IF R(I,1)+R(I+1,1)=S(J,1) AND R(I,2)=R(I+1,2) THEN GOTO 1350
1300 IF R(I+1,1)+R(I+2,1)=S(J,1) AND R(I+1,2)=R(I+2,2) THEN GOTO 1350
1310 IF R(I+1,1)=R(I+2,1) AND R(I,1)=R(I+1,1) AND R(I+1,2)=R(I+2,2) THEN GOTO 1350
1320 IF R(I+1,1)+R(I+2,1)=S(J,1) AND R(I+1,2)+R(I+2,2)= 1330 IF R(I+1,1)+R(I+2,1)>R(I,1) AND R(I+1,2)=R(I+2,2) THEN GOTO 1350
1340 S(J,1)=L-LC-SK:S(J,2)=W:J=NS+1:S(J,1)=LC:S(J,2)=W-WC-SK:NS=NS+1:C=4:GOTO 1360
1350 S(J,1)=L:S(J,2)=W-WC-SK:J=NS+1:S(J,1)=L-LC-SK:S(J,2)=WC:NS=NS+1:C=5
1360 O(K,5)=C:NO=NO+1:REM ** ADD CUT CODE TO CUT BUFFER ***
1370 IF V=1 THEN PRINT TAB(10);"--- New Sheet ---"
1380 PRINT"CUTTING "O(K,1);O(K,2);"from";O(K,3);O(K,4);"cut code";O(K,5)
1390 K=K+1:V=0
1400 REM ** ELIMINATE DEADWOOD FROM STOCKPILE **
1410 F=0
1420 FOR J=1 TO NS-1
1425 IF NS=<1 THEN GOTO 1470
1430 IF S(J,1)=0 THEN S(J,1)=S(NS,1):S(J,2)=S(NS,2):NS=NS-1:F=1
1440 NEXT J
1450 IF F=1 THEN GOTO 1410
1460 REM ** SORT THE STOCKPILE INTO ASCENDING ORDER **
1470 F=0
1480 FOR J=1 TO NS-1
1490 L=J+1
1500 IF S(J,1)+S(J,2)= 1510 T=S(J,1):S(J,1)=S(L,1):S(L,1)=T
1520 T=S(J,2):S(J,2)=S(L,2):S(L,2)=T
1530 F=1
1540 NEXT J
1550 IF F=1 THEN GOTO 1470
1560 NEXT I
1570 GOSUB 160
1580 PRINT TAB(15);"----- R E S U L T S -----"
1590 PRINT"AREA REQUIRED =";SQ;":AREA LEFT OVER = ";NP*(LA*LB)-SQ;"SQ.IN."
1600 PRINT"MINIMUM SHEETS FOR THIS PROJECT BY SQ. AREA = ";INT((SQ-1)/(LA*LB))+1
1610 PRINT"YOU NEED ";NP;" FULL SHEET(S) WITH A TOTAL AREA =";(LA*LB)*NP
1620 PRINT"Kerf =";SK;"Inches"
1630 PRINT"THE CUTTING ORDER FOLLOWS (Grain runs parallel to length)"
1640 PRINT
1650 PRINT"Length";TAB(10);"Width OUT OF";TAB(29);"Length";TAB(40);"Width";TAB(50);"CUT CODE"
1660 PRINT
1670 FOR K=1 TO NO
1680 IF O(K,3)=LA AND O(K,4)=LB THEN D$="New sheet->" ELSE D$=""
1690 PRINT O(K,1);TAB(10);O(K,2);TAB(19);D$;TAB(30);O(K,3);TAB(40);O(K,4);TAB(50);O(K,5)
1700 NEXT K
1710 IF NP>LF AND FL<>2*NR THEN NP=0:NS=0:NO=0:GOTO 1720 ELSE GOTO 1750
1720 PRINT:PRINT"Attempt--> ";FL+2;" of ";2*NR+1
1730 FL=FL+1
1740 IF FL=>2 THEN GOTO 730 ELSE GOTO 510
1750 PRINT
1760 IF SQ=NP*(LA*LB) THEN PRINT "ATTEMPTS =";FL+1;":This is an EXCELLENT solution!":GOTO 1820
1770 IF NP<>LF THEN PRINT"ATTEMPTS =";FL+1;":A POOR solution or IMPOSSIBLE fit or cut"
1780 IF NP<>LF THEN PRINT"I can't tell which, it's up to you."
1790 IF NR>4 AND LF<>NP THEN PRINT"You might try to combine similar pieces and do better.":GOTO 1820
1800 IF LF=NP THEN PRINT"ATTEMPTS =";FL+1;":This is a SATISFACTORY solution."
1810 IF SQ=<(LA*LB)*NP AND FT=1 THEN PRINT"Extra sheet is due to an impossible fit or cut."
1820 PRINT
1830 INPUT"Do you wish to print the cutting diagrams (Y/N)";A$
1840 IF A$="Y" OR A$="y" THEN GOTO 1860 ELSE RUN 100
1850 END
1860 REM *** PRINT CUT LIST ROUTINE ***
1870 INPUT"ENTER THE NAME OF THIS PROJECT";B$
1880 LPRINT "PROJECT ID IS: ";B$
1890 LPRINT" "
1900 LPRINT"GRAIN ALWAYS RUNS PARALLEL TO THIS DIRECTION ----->>>"
1910 LPRINT" "
1920 IF SK<>0 THEN LPRINT"KERF OF ";SK;"INCHES IS REMOVED FROM CUTOFF PIECES."
1930 LPRINT" 1 1 1 INDICATES 1ST CUT, 2 2 2 INDICATES 2ND CUT"
1940 FOR K = 1 TO NO
1950 LPRINT" ":LPRINT" "
1960 LPRINT "PIECE # ";K
1970 L=O(K,3):W=O(K,4):LC=O(K,1):WC=O(K,2):C=O(K,5)
1980 LPRINT"STOCK PIECE IS ";L;"INCHES LONG AND ";W;"INCHES WIDE"
1990 LPRINT"PIECE TO CUT IS ";LC;"INCHES LONG AND ";WC;"INCHES WIDE";" / CUT CODE =";C
2000 LPRINT" "
2010 L=L*.82:LC=LC*.82
2020 W=W*.44:WC=WC*.44
2030 IF LC=<6 THEN LC=6
2040 IF LC > (.94*L) THEN LC=(.94*L)
2050 ON C GOTO 2300,2370,2480,2190,2070
2060 REM *** CODE 5 CUT -2 CUTS REQUIRED 1ST HORIZ 2ND VERT ***
2070 LPRINT STRING$(L,"-")
2080 FOR M=1 TO WC
2090 LPRINT"!";STRING$(LC-2,">");TAB(LC);"2";TAB(L);"!"
2100 NEXT M
2110 LPRINT STRING$(L,"1")
2120 FOR U=WC TO W
2130 LPRINT"!";TAB(L);"!"
2140 NEXT U
2150 LPRINT STRING$(L,"-")
2160 NEXT K
2170 GOTO 2550
2180 REM *** CODE 4 CUT -2 CUTS REQUIRED 1ST VERT 2ND HORIZ ***
2190 LPRINT STRING$(L,"-")
2200 FOR M=1 TO WC
2210 LPRINT "!";STRING$(LC-2,">");TAB(LC);"1";TAB(L);"!"
2220 NEXT M
2230 LPRINT STRING$(LC,"2");TAB(L);"!"
2240 FOR U = WC TO W
2250 LPRINT "!";TAB(LC);"1";TAB(L);"!"
2260 NEXT U
2270 LPRINT STRING$(L,"-")
2280 GOTO 2160
2290 REM *** CODE 1 CUT - NO CUTS REQUIRED ***
2300 LPRINT" "
2310 LPRINT"***********************************"
2320 LPRINT"* *"
2330 LPRINT"* EXACT FIT - NO CUTS REQUIRED *"
2340 LPRINT"* *"
2350 LPRINT"***********************************"
2360 GOTO 2160
2370 REM *** CODE 2 CUT - ONE HORIZ CUT REQUIRED ***
2380 LPRINT STRING$(L,"-")
2390 FOR M=1 TO WC
2400 LPRINT "!";STRING$(L-2,">");TAB(L);"!"
2410 NEXT M
2420 LPRINT STRING$(L,"1")
2430 FOR U=WC TO W
2440 LPRINT "!";TAB(L);"!"
2450 NEXT U
2460 LPRINT STRING$(L,"-")
2470 GOTO 2160
2480 REM *** CODE 3 CUT - ONE VERT CUT REQUIRED ***
2490 LPRINT STRING$(L,"-")
2500 FOR M = 1 TO W
2510 LPRINT"!";STRING$(LC-2,">");TAB(LC);"1";TAB(L);"!"
2520 NEXT M
2530 LPRINT STRING$(L,"-")
2540 GOTO 2160
2550 REM **** PRINT REQUIRED PIECE LIST AND LEFTOVER STOCK ****
2560 LPRINT" "
2570 LPRINT"NUMBER OF FULL SHEETS USED = ";NP
2580 LPRINT"TOTAL SQ INCHES OF REQUIRED PIECES =";SQ
2590 LPRINT" "
2600 LPRINT"LIST OF REQUIRED PIECES"
2610 LPRINT "LENGTH";TAB(15);"WIDTH"
2620 LPRINT STRING$(20,"-")
2630 FOR I=1 TO NR
2640 LPRINT R(I,1);TAB(10);"X";TAB(15);R(I,2)
2650 NEXT I
2660 LPRINT" "
2670 LPRINT"LIST OF LEFTOVER PIECES"
2680 LPRINT"LENGTH";TAB(15);"WIDTH"
2690 LPRINT STRING$(20,"-")
2700 FOR J= 1 TO NS
2710 LPRINT S(J,1);TAB(10);"X";TAB(15);S(J,2)
2720 NEXT J
2730 REM PRINT THE CUT BUFFER ******
2740 LPRINT" "
2750 LPRINT" THE CUTTING ORDER AND CUT CODES ARE:"
2760 LPRINT" "
2770 FOR K=1 TO NO
2780 LPRINT O(K,1);TAB(10);"X";TAB(12);O(K,2);TAB(24)"OUT OF";TAB(30);O(K,3);TAB(40);"X";TAB(42);O(K,4);TAB(55);"CUT CODE";O(K,5)
2790 NEXT K
2800 PRINT"DONE"
2810 END