The CIA World Factbook 1992

home *** CD-ROM | disk | FTP | other *** search

/ The CIA World Factbook 1992 / k3bimage.iso / sel / 12 / 0103 / decorate.bas (.txt) < prev next >

Wrap

GW-BASIC | 1991-12-02 | 31.5 KB | 786 lines

3 COMMON ADDR.%, CLOCK.ON% 4 KEY OFF:KEY(8) ON:ON KEY(8) GOSUB 60000 5 DEF SEG = 0: IF (PEEK(&H410) AND &H30) <> &H30 THEN GRAPH.ICS=1 6 IF GRAPH.ICS THEN FC=3: BC=0 ELSE GOSUB 28000 7 DEF SEG:IF PEEK(3)<>195 AND PEEK(6)<>0 THEN IBMPC=0 ELSE IBMPC=1 8 SCREEN 2:CLS 10 DIM FU$(100,8),PA(4000),UL(20),UR(20),LL(20),LR(20),DO#(12,5),PF#(12,5),WD#(12,5) 90 METRIC=0 91 PI=3.14159 92 RADFAC=180/PI 94 GOSUB 7800 100 ' 110 SCREEN 2 120 CLS 130 GOSUB 10000 300 ' 301 IF IBMPC THEN DEF SEG:OUT &H3D9,2 302 ON ERROR GOTO 390 303 LOCATE 12,25:PRINT "Loading furniture from disk..." 305 OPEN "i",#2,"DECOFURN.FRN" 310 FURNNO=1 312 IF EOF(2)=0 THEN 315 ELSE 379 315 FOR SUBLOOP= 1 TO 8:INPUT #2,FU$(FURNNO,SUBLOOP):NEXT SUBLOOP 316 LOCATE 14,29:PRINT "Furniture number : ";FURNNO 320 FURNNO=FURNNO+1:GOTO 312 379 CLOSE #2:FURNNO=FURNNO-1 380 ON ERROR GOTO 40000:GOTO 400 390 ' 391 IF ERL=305 AND ERR=53 THEN CLOSE #2:OPEN "O",#2,"DECOFURN.FRN":CLOSE #2:RESUME 380 400 ' 500 ' 501 IF IBMPC THEN DEF SEG:OUT &H3D9,2 505 CLS 506 X=140:Y=40:GOSUB 10010 507 LOCATE 10,35:PRINT "MAIN MENU"; 508 LINE(264,68)-(272+78,82),1,B 510 LOCATE 13,26:PRINT "1. Design a room." 520 LOCATE 14,26:PRINT "2. Create, delete, or view furniture." 530 LOCATE 15,26:PRINT "3. Work in a room." 532 LOCATE 16,26:PRINT "4. Change to ";:IF METRIC THEN PRINT "feet and inches."; ELSE PRINT "metric. "; 533 LOCATE 17,26:PRINT "5. Remove furniture from all rooms." 535 LOCATE 18,26:PRINT "6. Exit to ";:IF ADDR.% THEN PRINT "the Magazette."; ELSE PRINT "BASIC."; 540 GOSUB 8000 550 IF VAL(I$)<1 OR VAL(I$)>6 THEN 540 560 CLS:ON VAL(I$) GOTO 1000,2000,3000,4000,4100,60000 1000 ' 1001 RFN$="":PERMFIXNO=0:DOORNO=0:WINDNO=0 1002 CLS 1004 X=20:Y=20:GOSUB 12000 1005 LOCATE 1,57:PRINT "ROOM DESIGN"; 1006 LOCATE 3,48:PRINT "Press ESC to return to the";:LOCATE 4,48:PRINT "main menu or any other key";:LOCATE 5,48:PRINT "to design a room."; 1007 DEF SEG=0:POKE &H41A,PEEK(&H41C) 1008 I$=INKEY$:IF I$="" THEN 1008 ELSE IF I$=CHR$(27) THEN 500 1010 LOCATE 7,48:PRINT "Please enter the room dim-" 1012 LOCATE 8,48:PRINT "ensions in ";:IF METRIC THEN PRINT "meters."; ELSE PRINT "feet and inches."; 1020 LOCATE 10,50:PRINT "width: ";:GOSUB 7000:WDTH#=NUM:LOCATE 11,50:PRINT "length: ";:GOSUB 7000:LENGTH#=NUM 1030 IF WDTH#>LENGTH# THEN SCALE#=360/WDTH# ELSE SCALE#=360/LENGTH# 1040 CLS:LINE(0,0)-(INT(WDTH#*SCALE#),INT(LENGTH#*SCALE#/2)),1,B 1042 LINE(1,1)-(INT(WDTH#*SCALE#)-1,INT(LENGTH#*SCALE#/2)-1),1,B 1043 LINE(2,1)-(INT(WDTH#*SCALE#)-2,INT(LENGTH#*SCALE#/2)-1),1,B 1045 GOSUB 7100 1090 LOCATE 20,WDTH#*SCALE#\8+2:NUM=LENGTH#:GOSUB 7075:LOCATE (LENGTH#*SCALE#/2)\8+2,(WDTH#*SCALE#/2)\8+1:NUM=WDTH#:GOSUB 7075 1095 RTN$="" 1100 ' 1101 LOCATE 14,1:GOSUB 7100 1105 LOCATE 1,48:PRINT " WORKING IN ";LEFT$(RFN$,8);" ROOM " 1110 IF DOORNO<12 THEN LOCATE 3,48:PRINT "1. Add a door "; 1111 IF WINDNO<12 THEN LOCATE 4,48:PRINT "2. Add a window "; 1112 IF PERMFIXNO <12 THEN LOCATE 5,48:PRINT "3. Add a permanent fixture "; 1113 LOCATE 6,48:PRINT "4. Save this room and continue "; 1114 LOCATE 7,48:PRINT "5. Work with furniture "; 1115 LOCATE 8,48:PRINT "6. Remove all furniture "; 1116 LOCATE 9,48:PRINT "7. View the furniture "; 1117 LOCATE 10,48:PRINT "8. Return to main menu "; 1119 IF PERMFIXNO=0 AND DOORNO=0 AND WINDOWNO=0 THEN LOCATE 11,48:PRINT "9. Redo room size. ";:ABLETOREDO=1 1120 GOSUB 8050 1122 IF VAL(I$)<1 OR VAL(I$)>9 THEN LOCATE CSRLIN-3,40:GOTO 1116 ELSE IF I$="9" AND ABLETOREDO=0 THEN 1116 1130 GOSUB 7100:ON VAL(I$) GOTO 1300,1400,1500,1600,3100,4200,2500,500,1000 1300 IF DOORNO>11 THEN GOTO 1100 1301 HINGEDONE=0:DOINGDOOR=1:DOORNO=DOORNO+1:LOCATE 3,48:PRINT "Point to the point where the";: LOCATE 4,48:PRINT "HINGE should be, then press" ;:LOCATE 5,48:PRINT "ENTER."; 1302 XP#=0:YP#=0 1304 GOSUB 7200 1305 DEX1#=XP#:DEY1#=YP# 1306 HINGEDONE=1:GOSUB 7900:DO#(DOORNO,1)=XP#/SCALE#:DO#(DOORNO,2)=YP#/SCALE#*2 1307 GOSUB 7100:LOCATE 3,48:PRINT "Now move the arrow to the";: LOCATE 4,48:PRINT "opening edge of the door";: LOCATE 5,48:PRINT "then press ENTER. "; 1310 IF XP#=0 OR YP#=0 THEN DRAW "D4U4R8L8" ELSE DRAW "U4D4L8R8" 1317 GOSUB 7200: DO#(DOORNO,3)=XP#/SCALE#:DO#(DOORNO,4)=YP#/SCALE#*2:DEX2#=XP#:DEY2#=YP# 1318 IF XP#=0 OR YP#=0 THEN DRAW "D4U4R8L8" ELSE DRAW "U4D4L8R8" 1319 GOSUB 7900:LOCATE 16,50:GOSUB 7100 1320 IF XP#=0 THEN WALL=4 1321 IF YP#=0 THEN WALL=1 1322 IF XP#=WDTH#*SCALE# THEN WALL=2 1323 IF YP#=LENGTH#*SCALE#/2 THEN WALL=3 1325 LOCATE 3,48:PRINT "Does the door open in or out?";:LOCATE 4,48:PRINT "(I or O) ";:GOSUB 8000 1326 IF I$<>"O" AND I$<>"I" THEN 1325 1327 IF I$="O" THEN DO#(DOORNO,5)=1:GOTO 1380 1330 IF WALL=1 AND DO#(DOORNO,1) < DO#(DOORNO,3) THEN SP=3*PI/2:EP=2*PI 1331 IF WALL=1 AND DO#(DOORNO,1) > DO#(DOORNO,3) THEN SP=PI:EP=3*PI/2 1332 IF WALL=2 AND DO#(DOORNO,2) < DO#(DOORNO,4) THEN SP=PI:EP=3*PI/2 1333 IF WALL=2 AND DO#(DOORNO,2) > DO#(DOORNO,4) THEN SP=PI/2:EP=PI 1334 IF WALL=3 AND DO#(DOORNO,1) < DO#(DOORNO,3) THEN SP=2*PI:EP=PI/2 1335 IF WALL=3 AND DO#(DOORNO,1) > DO#(DOORNO,3) THEN SP=PI/2:EP=PI 1336 IF WALL=4 AND DO#(DOORNO,2) < DO#(DOORNO,4) THEN SP=3*PI/2:EP=2*PI 1337 IF WALL=4 AND DO#(DOORNO,2) > DO#(DOORNO,4) THEN SP=2*PI:EP=PI/2 1340 CIRCLE(INT(DO#(DOORNO,1)*SCALE#),INT(DO#(DOORNO,2)*SCALE#/2)),INT(DOORWDTH*SCALE#),1,SP*(-1),EP*(-1),0.5 1345 DO#(DOORNO,5)=-1 1380 ' 1381 IF WALL=1 THEN LINE(DEX1#,DEY1#)-(DEX2#,DEY2#+1),0,BF 1382 IF WALL=2 THEN LINE(DEX1#,DEY1#)-(DEX2#-2,DEY2#),0,BF 1383 IF WALL=3 THEN LINE(DEX1#,DEY1#)-(DEX2#,DEY2#-1),0,BF 1384 IF WALL=4 THEN LINE(DEX1#,DEY1#)-(DEX2#+2,DEY2#),0,BF 1390 GOSUB 7100 1399 HINGEDONE=0:DOINGDOOR=0:GOTO 1100 1400 IF WINDNO>11 THEN GOTO 1100 1401 DOINGWIND=1:DOINGDOOR=1:WINDNO=WINDNO+1:LOCATE 3,48:PRINT "Move the arrow to one end of";: LOCATE 4,48:PRINT "the window and press ENTER."; 1402 XP#=0:YP#=0 1404 GOSUB 7200 1406 HINGEDONE=1:GOSUB 7900:WD#(WINDNO,1)=XP#/SCALE#:WD#(WINDNO,2)=YP#/SCALE#*2 1407 GOSUB 7100:LOCATE 3,48:PRINT "Now move the arrow to the";: LOCATE 4,48:PRINT "other end of the window.";: LOCATE 5,48:PRINT "then press ENTER. "; 1410 IF XP#=0 THEN DRAW "C0R3L3" ELSE IF YP#=0 THEN DRAW "C0D2U2" ELSE IF XP#=WDTH#*SCALE# THEN DRAW "C0L2R2" ELSE DRAW "C0U2D2" 1417 GOSUB 7200:WD#(WINDNO,3)=XP#/SCALE#:WD#(WINDNO,4)=YP#/SCALE#*2 1418 ' 1419 GOSUB 7900:LOCATE 16,50:GOSUB 7100 1420 X1=INT(WD#(WINDNO,1)*SCALE#):Y1=INT(WD#(WINDNO,2)*SCALE#/2):X2=INT(WD#(WINDNO,3)*SCALE#):Y2=INT(WD#(WINDNO,4)*SCALE#/2) 1430 IF XP#=0 THEN LINE(X1+1,Y1)-(X2+1,Y2),0:LINE(X1+2,Y1)-(X2+2,Y2),0 1431 IF YP#=0 THEN LINE(X1,Y1+1)-(X2,Y2+1),0 1432 IF XP#=WDTH#*SCALE# THEN LINE(X1-1,Y1)-(X2-1,Y2),0:LINE(X1-2,Y1)-(X2-2,Y2),0 1433 IF YP#=LENGTH#*SCALE#/2 THEN LINE(X1,Y1-1)-(X2,Y2-1),0 1435 DOINGWIND=0:HINGEDONE=0:DOINGDOOR=0 1440 GOTO 1100 1500 IF PERMFIXNO>11 THEN GOTO 1100 1510 PERMFIXNO=PERMFIXNO+1 1515 ' 1520 LOCATE 3,50:PRINT "Is this fixture..."; 1522 LOCATE 5,50:PRINT "1. square or rectangular" 1524 LOCATE 6,50:PRINT "2. round" 1525 LOCATE 7,50:PRINT "3. a diagonal wall" 1530 GOSUB 8050 1532 IF VAL(I$)<1 OR VAL(I$)>3 THEN 1525 1534 ON VAL(I$) GOTO 1540,1560,1580 1540 ' 1541 PF#(PERMFIXNO,1)=1:GOSUB 7100:LOCATE 3,48:PRINT "move the arrow to the upper";: LOCATE 4,48:PRINT "left corner of the fixture";:LOCATE 5,48:PRINT "then press ENTER."; 1542 XP#=0:YP#=0 1544 GOSUB 7200 1546 GOSUB 7900:PF#(PERMFIXNO,2)=XP#/SCALE#:PF#(PERMFIXNO,3)=YP#/SCALE#*2 1547 DRAW "r4l4d2u2":GOSUB 7100:LOCATE 3,48:PRINT "Now move the arrow to the lower";: LOCATE 4,48:PRINT "right corner of the fixture and";: LOCATE 5,48:PRINT "press ENTER. "; 1548 GOSUB 7200:PF#(PERMFIXNO,4)=XP#/SCALE#:PF#(PERMFIXNO,5)=YP#/SCALE#*2:LINE(INT(PF#(PERMFIXNO,2)*SCALE#),INT(PF#(PERMFIXNO,3)*SCALE#/2))-(INT(XP#),INT(YP#)),1,B 1549 GOSUB 7900:LOCATE 16,50 1550 GOTO 1100 1560 ' 1561 PF#(PERMFIXNO,1)=2:GOSUB 7100:LOCATE 3,48:PRINT "What is the diameter of the";:LOCATE 4,48:PRINT "fixture in ";:IF METRIC THEN PRINT "meters? ";: ELSE PRINT "feet and inches? "; 1562 LOCATE 5,48:GOSUB 7000 1564 PF#(PERMFIXNO,2)=NUM/2 1566 GOSUB 7100:LOCATE 3,48:PRINT "Move the arrow to the point";:LOCATE 4,48:PRINT "where the CENTER of the";:LOCATE 5,48:PRINT "fixture will be and press ";:LOCATE 6,48:PRINT "ENTER."; 1568 GOSUB 7200 1570 PF#(PERMFIXNO,3)=XP#/SCALE#:PF#(PERMFIXNO,4)=YP#/SCALE#*2:GOSUB 7900:CIRCLE(XP#,YP#),PF#(PERMFIXNO,2)*SCALE#,1,,,0.5 1572 LOCATE 16,48:GOTO 1100 1580 ' 1581 PF#(PERMFIXNO,1)=3:GOSUB 7100:LOCATE 3,48:PRINT "move the arrow to one end";: LOCATE 4,48:PRINT "of the wall and press ";:LOCATE 5,48:PRINT "ENTER."; 1582 XP#=0:YP#=0 1584 GOSUB 7200 1586 GOSUB 7900:PF#(PERMFIXNO,2)=XP#/SCALE#:PF#(PERMFIXNO,3)=YP#/SCALE#*2 1587 DRAW "r1l1":GOSUB 7100:LOCATE 3,48:PRINT "Now move the arrow to the other";: LOCATE 4,48:PRINT "end and press ENTER."; 1588 GOSUB 7200: PF#(PERMFIXNO,4)=XP#/SCALE#:PF#(PERMFIXNO,5)=YP#/SCALE#*2:LINE(INT(PF#(PERMFIXNO,2)*SCALE#),INT(PF#(PERMFIXNO,3)*SCALE#/2))-(INT(XP#),INT(YP#)),1 1589 GOSUB 7900:LOCATE 16,50 1590 GOTO 1100 1600 ' 1601 CLOSE 1605 GOSUB 7100:LOCATE 3,48:PRINT "Are you sure you're finished?";:GOSUB 8000:IF I$<>"Y" THEN 1100 1606 KEY(8) OFF 1610 GOSUB 7100:IF RFN$="" THEN LOCATE 3,48:PRINT "What room is this? Use 8";:LOCATE 4,48:PRINT "characters or less.";:ALLEN%=8:LOCATE 5,48:GOSUB 9500 ELSE NTRY$=LEFT$(RFN$,INSTR(RFN$,".")-1) 1611 IF NTRY$="" OR INSTR(NTRY$," ")<>0 THEN 1610 ELSE RFN$=NTRY$+".roo" 1612 ON ERROR GOTO 1680 1614 NAME RFN$ AS RFN$ 1620 OPEN "O",#1,RFN$ 1630 PRINT #1,WDTH# 1632 PRINT #1,LENGTH# 1634 PRINT #1,DOORNO:FOR LCV=1 TO DOORNO:FOR SUBLOOP=1 TO 5 1636 PRINT #1,DO#(LCV,SUBLOOP) 1638 NEXT SUBLOOP,LCV 1640 PRINT #1,WINDNO:FOR LCV=1 TO WINDNO:FOR SUBLOOP=1 TO 5 1642 PRINT #1,WD#(LCV,SUBLOOP) 1644 NEXT SUBLOOP,LCV 1646 PRINT #1,PERMFIXNO:FOR LCV=1 TO PERMFIXNO:FOR SUBLOOP=1 TO 5 1647 PRINT #1,PF#(LCV,SUBLOOP) 1648 NEXT SUBLOOP,LCV 1649 CLOSE:GOSUB 1650:GOTO 500 1650 ' 1651 KEY(8) OFF 1652 CLOSE:OPEN "O",#1,"DECOFURN.FRN" 1654 FOR LCV=1 TO FURNNO:FOR SUBLOOP=1 TO 8:PRINT #1,FU$(LCV,SUBLOOP):NEXT SUBLOOP,LCV 1678 CLOSE:KEY(8) ON:ON KEY(8) GOSUB 60000:ON ERROR GOTO 30000 1679 RETURN 1680 '==== specialized error trap for files check ======= 1682 CLOSE:RESUME 1620 1684 IF ERR=53 THEN RESUME NEXT 1686 ON ERROR GOTO 0 1998 GOSUB 8000 1999 STOP 2000 ' 2001 CLS:LOCATE 1,52:PRINT "CREATE OR DELETE FURNITURE"; 2002 X=20:Y=50:GOSUB 11000 2005 GOSUB 7100 2010 LOCATE 3,48:PRINT "You have";FURNNO;" pieces of furniture";:LOCATE 4,48:PRINT "stored. Do you want to..."; 2012 LOCATE 6,50:PRINT "1. Add a piece of furniture." 2014 LOCATE 7,50:PRINT "2. Delete furniture." 2016 LOCATE 8,50:PRINT "3. View a piece of furniture." 2017 LOCATE 9,50:PRINT "4. Return to main menu." 2018 LOCATE 10,50:IF RFN$>"" THEN PRINT "5. Return to the room." 2020 GOSUB 8050 2022 IF (VAL(I$)>0 AND VAL(I$)<5) OR (I$="5" AND RFN$>"") THEN ON VAL(I$) GOTO 2100,3300,2500,500,3030 ELSE 2018 2100 ' 2101 OPEN "a",#2,"DECOFURN.FRN" 2102 FURNNO=FURNNO+1 2105 GOSUB 7100 2110 LOCATE 1,50:PRINT " ADDING FURNITURE "; 2120 LOCATE 3,48:PRINT "Is this piece of furniture"; 2122 LOCATE 5,50:PRINT "1. Rectangular"; 2124 LOCATE 6,50:PRINT "2. Circular."; 2130 GOSUB 8050:IF I$="1" THEN 2200 ELSE IF I$="2" THEN 2300 ELSE 2124 2140 FOR SUBLOOP=1 TO 8:PRINT #2,FU$(FURNNO,SUBLOOP):NEXT SUBLOOP 2142 CLOSE #2 2150 GOTO 2005 2200 ' 2202 FU$(FURNNO,1)="R" 2203 CLS 2210 LOCATE 3,48:PRINT "Enter the size of the item";:LOCATE 4,48:PRINT "in ";:IF METRIC THEN PRINT "meters."; ELSE PRINT "feet and inches."; 2212 LOCATE 6,50:PRINT "WIDTH: ";:GOSUB 7000:IF NUM>3 THEN BEEP:GOTO 2212 ELSE FU$(FURNNO,7)=STR$(NUM):FWDTH=NUM 2214 LOCATE 8,50:PRINT "LENGTH: ";:GOSUB 7000:IF NUM>3 THEN BEEP:GOTO 2214 ELSE FU$(FURNNO,8)=STR$(NUM):FLENGTH=NUM 2240 LINE(180-VAL(FU$(FURNNO,7))*100/2,0)-(180+VAL(FU$(FURNNO,7))*100/2,VAL(FU$(FURNNO,8))*100/2),1,B 2245 LOCATE (FLENGTH*50)\8+3,(180-FWDTH*50)\8+2:NUM=FWDTH:GOSUB 7075:LOCATE (FLENGTH*25)\8+2,(180+FWDTH*50)\8+2:NUM=FLENGTH:GOSUB 7075 2250 LOCATE 10,48:PRINT "What do you want to call this";:LOCATE 11,48:PRINT "piece of furniture?";:LOCATE 13,52:ALLEN%=12:GOSUB 9500:FU$(FURNNO,3)=NTRY$ 2260 IF NTRY$="" OR MID$(NTRY$,1,1)=" " THEN 2250 ELSE LOCATE (FLENGTH*50)\8+5,23-LEN(FU$(FURNNO,3))\2:PRINT FU$(FURNNO,3); 2261 LOCATE 16 2262 GOTO 2140 2295 GOSUB 8000 2300 ' 2305 FU$(FURNNO,1)="C" 2307 CLS 2310 LOCATE 3,48:PRINT "Enter the DIAMETER of the ";:LOCATE 4,48:PRINT "item in ";:IF METRIC THEN PRINT "meters."; ELSE PRINT "feet and inches."; 2312 LOCATE 6,50:PRINT "DIAMETER: ";:GOSUB 7000:IF NUM>3 THEN BEEP:GOTO 2312 ELSE FU$(FURNNO,7)=STR$(NUM):FDIA=NUM 2340 CIRCLE(180,FDIA*25),FDIA*100/2,1,,,0.5 2350 LOCATE 8,48:PRINT "What do you want to call this";:LOCATE 9,48:PRINT "piece of furniture?";:LOCATE 11,52:ALLEN%=12:GOSUB 9500:FU$(FURNNO,3)=NTRY$ 2360 LOCATE FDIA*25/8+3,23-(LEN(FU$(FURNNO,3)))\2:PRINT FU$(FURNNO,3); 2365 LOCATE 16 2370 GOTO 2140 2500 ' 2510 LOCATE 17,1:GOSUB 7100:GOSUB 16000:IF FUWORK=0 THEN 2000 2520 CLS 2521 X=VAL(FU$(FUWORK,7)):Y=VAL(FU$(FUWORK,8)) 2530 IF FU$(FUWORK,1)="C" THEN CIRCLE(180,VAL(FU$(FUWORK,7))*25),VAL(FU$(FUWORK,7))*50,1,,,0.5 ELSE LINE(180-VAL(FU$(FUWORK,7))*50,0)-(180+VAL(FU$(FUWORK,7))*50,VAL(FU$(FUWORK,8))*50),1,B 2531 IF FU$(FUWORK,1)="C" THEN LOCATE X*50\8+3,20:NUM=X:GOSUB 7075:LOCATE X*50\8+5,23-LEN(FU$(FUWORK,3))\2:PRINT FU$(FUWORK,3); ELSE LOCATE Y*50\8+3,16:PRINT "WIDTH: ";:NUM=X:GOSUB 7075:LOCATE Y*50\8+4,16:PRINT "LENGTH: ";:NUM=Y:GOSUB 7075 2532 IF FU$(FUWORK,1)="R" THEN LOCATE Y*50\8+6,23-LEN(FU$(FUWORK,3))\2:PRINT FU$(FUWORK,3); 2550 GOTO 2005 2999 STOP 3000 ' 3001 CLOSE 3010 CLS:GOSUB 14000 3020 GOSUB 13000 3030 GOSUB 13500 3040 GOTO 1100 3100 ' 3110 LOCATE 15 3115 GOSUB 16000 3116 IF FUWORK=0 THEN 1100 3117 LOCATE 20:GOSUB 7100 3200 ' 3201 IF FU$(FUWORK,2)<>RFN$ THEN 3210 3202 ' 3204 CLS:FU$(FUWORK,2)="":RTFU=FUWORK:GOSUB 13500:FUWORK=RTFU:FX#=VAL(FU$(FUWORK,4)):FY#=VAL(FU$(FUWORK,5)):GOTO 3215 3210 FX#=WDTH#/2:FY#=LENGTH#/2 3215 ANGLE=VAL(FU$(FUWORK,6)):FW=VAL(FU$(FUWORK,7)):FL=VAL(FU$(FUWORK,8)) 3221 IF FU$(FUWORK,1)="R" THEN RADIUS =SQR((FW/2)^2 + (FL/2)^2) ELSE RADIUS=FW/2 3222 A1#=ATN((FL/2)/(FW/2))*RADFAC 3224 A2#=180-A1# 3226 A3#=180+A1# 3228 A4#=360-A1# 3230 LOCATE 1,48:PRINT " MOVING FURNITURE "; 3232 LOCATE 3,48:PRINT "Use arrow keys and SHIFT+arrows" 3234 LOCATE 4,48:PRINT "to move the furniture. " 3236 LOCATE 6,48:PRINT "The + and - keys will rotate " 3238 LOCATE 7,48:PRINT "the item around its center. " 3240 LOCATE 9,48:PRINT "Press ENTER to set item down" 3242 LOCATE 10,48:PRINT "and return to the WORK menu." 3244 LOCATE 12,48:PRINT "Press ESC to return this " 3246 LOCATE 13,48:PRINT "item to the list and return" 3248 LOCATE 14,48:PRINT "to the WORK menu." 3299 GOTO 3500 3300 ' 3310 GOSUB 7100:GOSUB 16000 3320 LOCATE 21,1:GOSUB 7100:LOCATE 3,48:PRINT "Are you sure you want to";:LOCATE 4,48:PRINT "delete this furniture? (Y or N)"; 3330 DEF SEG=0:POKE &H41A,PEEK(&H41C) 3335 I$=INKEY$:IF I$="" THEN 3335 ELSE IF I$="Y" OR I$="y" THEN 3340 ELSE 3350 3340 LOCATE 6,52:PRINT "DELETING THIS ITEM"; 3345 FOR LCV=FUWORK TO FURNNO-1:FOR SUBLOOP = 1 TO 8:FU$(LCV,SUBLOOP)=FU$(LCV+1,SUBLOOP):NEXT SUBLOOP,LCV:FU$(FURNNO,3)=" ":FURNNO=FURNNO-1:GOTO 3360 3350 LOCATE 6,52:PRINT "DELETE ABORTED"; 3360 FOR DELAY= 1 TO 1000:NEXT DELAY 3370 LOCATE 17,1:GOSUB 7100:GOTO 2010 3500 ' 3501 '========= given a1,a2,a3,a4,radius,angle,fx#,yx# ====== 3502 IF METRIC THEN UNIT#=0.01 ELSE UNIT#=0.0254 3503 DEF SEG=0:POKE &H41A,PEEK(&H41C):POKE &H417,(PEEK(&H417) OR &H40) 3504 IF METRIC THEN UNIT2=10 ELSE UNIT2=12 3505 DEF SEG=0:POKE &H417,(PEEK(&H417) AND &HDF) 3506 INC=UNIT# 3507 IF FU$(FUWORK,1)="R" THEN GOSUB 7400 ELSE AC1=(FX#-RADIUS)*SCALE#-1:AC2=(FY#-RADIUS)*SCALE#/2-1:AC3=(FX#+RADIUS)*SCALE#+1:AC4=(FY#+RADIUS)*SCALE#/2+1 3508 IF AC1<0 THEN AC1=0 3509 IF AC2<0 THEN AC2=0 3510 IF AC3>639 THEN AC3=639 3511 IF AC4>199 THEN AC4=199 3514 ON ERROR GOTO 29000 3515 GET(AC1,AC2)-(AC3,AC4),PA 3520 IF FU$(FUWORK,1)="R" THEN GOSUB 7484 ELSE CIRCLE(FX#*SCALE#,FY#*SCALE#/2),SCALE#*RADIUS,1,,,0.5:DRAW "BM"+STR$(INT(FX#*SCALE#)-4)+","+STR$(INT(FY#*SCALE#/2)+4)+N$(FUWORK\10)+N$(FUWORK MOD 10) 3521 ON ERROR GOTO 30000 3522 DEF SEG=0:POKE &H41A,PEEK(&H41C) 3523 I$=INKEY$:IF I$="" THEN 3523 3524 OX=(FX#):OY=(FY#) 3525 IF I$=CHR$(13) THEN 3600 3526 IF I$=CHR$(27) THEN PUT(AC1,AC2),PA,PSET:GOTO 1100 3528 IF I$="+" THEN ANGLE=ANGLE-10/RADFAC:GOTO 3570 3529 IF I$="-" THEN ANGLE=ANGLE+10/RADFAC:GOTO 3570 3534 I=ASC(RIGHT$(I$,1)) 3538 IF I=72 THEN FY#=FY#-INC 3540 IF I=56 THEN FY#=FY#-INC*UNIT2 3542 IF I=80 THEN FY#=FY#+INC 3544 IF I=50 THEN FY#=FY#+INC*UNIT2 3546 IF I=75 THEN FX#=FX#-INC 3548 IF I=52 THEN FX#=FX#-INC*UNIT2 3550 IF I=77 THEN FX#=FX#+INC 3552 IF I=54 THEN FX#=FX#+INC*UNIT2 3570 PUT(AC1,AC2),PA,PSET 3580 GOTO 3507 3599 STOP 3600 ' 3610 FU$(FUWORK,2)=RFN$:FU$(FUWORK,4)=STR$(FX#):FU$(FUWORK,5)=STR$(FY#):FU$(FUWORK,6)=STR$(ANGLE) 3620 SOUND 100,1:SOUND 75,1:SOUND 50,1:SOUND 100,0 3630 GOTO 1100 3999 STOP 4000 ' 4010 IF METRIC THEN METRIC=0 ELSE METRIC=1 4020 GOTO 500 4100 IF IBMPC THEN DEF SEG:OUT &H3D9,12 4110 CLS:LOCATE 12,5:BEEP:PRINT "This will take all furniture from all rooms and return it to the list.";:LOCATE 13,19:PRINT "Are you sure you want to do this? (Y or N)" 4112 DEF SEG=0:POKE &H41A,PEEK(&H41C) 4114 I$=INKEY$:IF I$="" THEN 4114 ELSE IF I$="Y" OR I$="y" THEN LOCATE 14,38:PRINT "YES";:GOTO 4120 ELSE LOCATE 14,33:PRINT "ACTION ABORTED";:GOTO 4125 4120 FOR LCV=1 TO FURNNO:FU$(LCV,2)="":FU$(LCV,6)="":NEXT LCV 4122 LOCATE 15,28:PRINT "Moving furniture back to list."; 4125 FOR DELAY= 1 TO 500:NEXT DELAY 4130 GOTO 500 4200 IF IBMPC THEN DEF SEG:OUT &H3D9,12 4210 GOSUB 7100:LOCATE 5,48:PRINT "This action will remove all";:LOCATE 6,48:PRINT "furniture from this room";:LOCATE 7,48:PRINT "and return it to the list.";:LOCATE 8,48:PRINT "Are you sure you want to"; 4212 LOCATE 9,48:PRINT "do this? (Y or N) "; 4215 DEF SEG=0:POKE &H41A,PEEK(&H41C) 4216 I$=INKEY$:IF I$="Y" OR I$="y" THEN LOCATE 11,52:PRINT "FURNITURE REMOVED" ELSE IF I$="N" OR I$="n" THEN 4230 ELSE 4216 4220 FOR LCV=1 TO FURNNO:IF FU$(LCV,2)=RFN$ THEN FU$(LCV,2)="":FU$(LCV,6)="" 4222 NEXT LCV:GOSUB 13500 4224 GOTO 4235 4230 LOCATE 11,52:PRINT "ACTION ABORTED"; 4235 FOR DELAY=1 TO 1000:NEXT DELAY:IF IBMPC THEN DEF SEG:OUT &H3D9,2 4240 GOTO 1100 7000 ' 7005 ROW=CSRLIN:COL=POS(0) 7010 IF METRIC THEN 7020 ELSE 7030 7020 INLEN%=6:GOSUB 9000:NUM=VAL(NTRY$) 7022 GOTO 7050 7030 PRINT" '";CHR$(29);CHR$(29);CHR$(29);:INLEN%=2:GOSUB 9000:FEET=VAL(NTRY$) 7032 LOCATE ROW,COL+4:PRINT" "+CHR$(34);CHR$(29);CHR$(29);CHR$(29);:INLEN%=2:GOSUB 9000:INCHES=VAL(NTRY$) 7034 INCHES=FEET*12+INCHES 7036 NUM=INCHES*0.0254 7050 IF NUM=0 THEN BEEP:LOCATE ROW,COL:PRINT STRING$(10," ");:LOCATE ROW,COL:GOTO 7010 ELSE RETURN 7075 ' 7076 ROW=CSRLIN:COL=POS(0) 7080 IF METRIC THEN PRINT USING "##.###";NUM;:RETURN 7085 INCHES=NUM*39.37:FEET=INCHES\12:INCHES=INCHES MOD 12 7086 PRINT FEET;CHR$(29);"'";INCHES;CHR$(29);CHR$(34);" "; 7087 RETURN 7100 ' 7110 BOTROW=CSRLIN+1:FOR CROW = 2 TO BOTROW:LOCATE CROW,48:PRINT STRING$(33," ");:NEXT CROW 7120 RETURN 7200 ' 7201 IF METRIC THEN UNIT#=SCALE#/100 ELSE UNIT#=SCALE#/39.37 7202 DEF SEG=0:POKE &H41A,PEEK(&H41C):POKE &H417,(PEEK(&H417) OR &H40) 7203 IF METRIC THEN UNIT2=10 ELSE UNIT2=12 7204 DEF SEG=0:POKE &H417,(PEEK(&H417) AND &HDF) 7205 ABORT=0:LINE (400,58)-(608,116),1,B 7206 DRAW "bm500,88m+14,+0m-5,+2m+5,+3m-5,+3m-5,-3m-4,+2m+0,-7" 7208 INC=UNIT#:DEF SEG=0:POKE &H41A,PEEK(&H41C) 7210 GET(INT(XP#),INT(YP#))-(INT(XP#+14),INT(YP#+8)),PA 7211 DRAW "bm"+STR$(INT(XP#))+","+STR$(INT(YP#))+"m+14,+0m-5,+2m+5,+3m-5,+3m-5,-3m-4,+2m+0,-7" 7212 I$=INKEY$:IF I$="" THEN 7212 7213 ' 7216 IF I$=CHR$(13) THEN PUT(INT(XP#),INT(YP#)),PA,PSET:RETURN 7220 I=ASC(RIGHT$(I$,1)) 7221 OX=INT(XP#):OY=INT(YP#):IF DOINGDOOR THEN GOTO 7300 7222 IF I=72 THEN YP#=YP#-INC/2 :GOSUB 7280:GOTO 7230 7223 IF I=56 THEN YP#=YP#-INC/2*UNIT2:GOSUB 7280:GOTO 7230 7224 IF I=80 THEN YP#=YP#+INC/2 :GOSUB 7280:GOTO 7230 7225 IF I=50 THEN YP#=YP#+INC/2*UNIT2:GOSUB 7280:GOTO 7230 7226 IF I=75 THEN XP#=XP#-INC: GOSUB 7290:GOTO 7230 7227 IF I=52 THEN XP#=XP#-INC*UNIT2 :GOSUB 7290:GOTO 7230 7228 IF I=77 THEN XP#=XP#+INC :GOSUB 7290:GOTO 7230 7229 IF I=54 THEN XP#=XP#+INC*UNIT2 :GOSUB 7290 7230 ' 7231 IF XP#<0 THEN XP#=0:GOSUB 7290 7232 IF XP#>WDTH#*SCALE# THEN XP#=WDTH#*SCALE#:GOSUB 7290 7234 IF YP#<0 THEN YP#=0:GOSUB 7280 7236 IF YP#>LENGTH#*SCALE#/2 THEN YP#=LENGTH#*SCALE#/2:GOSUB 7280 7249 PUT(OX,OY),PA,PSET 7250 GOTO 7208 7280 ' 7281 LOCATE 9,60:NUM=YP#/SCALE#*2:GOSUB 7075 7282 LOCATE 14,60:NUM=(LENGTH#)-(YP#/SCALE#*2):GOSUB 7075 7284 RETURN 7290 ' 7291 LOCATE 11,52:NUM=XP#/SCALE#:GOSUB 7075 7292 LOCATE 11,68:NUM=(WDTH#)-(XP#/SCALE#):GOSUB 7075 7294 RETURN 7299 STOP 7300 ' 7322 IF I=72 AND (XP#=0 OR XP#=WDTH#*SCALE#) THEN YP#=YP#-INC/2 :GOSUB 7280:GOTO 7330 7323 IF I=56 AND (XP#=0 OR XP#=WDTH#*SCALE#) THEN YP#=YP#-INC/2*UNIT2:GOSUB 7280:GOTO 7330 7324 IF I=80 AND (XP#=0 OR XP#=SCALE#*WDTH#) THEN YP#=YP#+INC/2 :GOSUB 7280:GOTO 7330 7325 IF I=50 AND (XP#=0 OR XP#=SCALE#*WDTH#) THEN YP#=YP#+INC/2*UNIT2:GOSUB 7280:GOTO 7330 7326 IF I=75 AND (YP#=0 OR YP#=LENGTH#*SCALE#/2) THEN XP#=XP#-INC: GOSUB 7290:GOTO 7330 7327 IF I=52 AND (YP#=0 OR YP#=LENGTH#*SCALE#/2) THEN XP#=XP#-INC*UNIT2: GOSUB 7290:GOTO 7330 7328 IF I=77 AND (YP#=0 OR YP#=LENGTH#*SCALE#/2) THEN XP#=XP#+INC :GOSUB 7290:GOTO 7330 7329 IF I=54 AND (YP#=0 OR YP#=LENGTH#*SCALE#/2) THEN XP#=XP#+INC*UNIT2 :GOSUB 7290:GOTO 7330 7330 IF HINGEDONE THEN 7332 ELSE 7340 7332 IF DOINGWIND=0 THEN DW1#=ABS(DO#(DOORNO,1)-XP#/SCALE#):DW2#=ABS(DO#(DOORNO,2)-YP#/SCALE#*2):IF DW1#>DW2# THEN DOORWDTH=DW1# ELSE DOORWDTH=DW2# 7333 IF DOINGWIND=1 THEN DW1#=ABS(WD#(WINDNO,1)-XP#/SCALE#):DW2#=ABS(WD#(WINDNO,2)-YP#/SCALE#*2):IF DW1#>DW2# THEN DOORWDTH=DW1# ELSE DOORWDTH=DW2# 7334 LOCATE 16,53:IF DOINGWIND=0 THEN PRINT "DOOR WIDTH ="; ELSE PRINT "WINDOW WIDTH ="; 7336 NUM=DOORWDTH:GOSUB 7075 7340 GOTO 7230 7400 ' 7410 X1=(FX#+RADIUS*COS(ANGLE+A1#/RADFAC)): Y1=(FY#-RADIUS*SIN(ANGLE+A1#/RADFAC)) 7420 X2=(FX#+RADIUS*COS(ANGLE+A2#/RADFAC)): Y2=(FY#-RADIUS*SIN(ANGLE+A2#/RADFAC)) 7430 X3=(FX#+RADIUS*COS(ANGLE+A3#/RADFAC)): Y3=(FY#-RADIUS*SIN(ANGLE+A3#/RADFAC)) 7440 X4=(FX#+RADIUS*COS(ANGLE+A4#/RADFAC)): Y4=(FY#-RADIUS*SIN(ANGLE+A4#/RADFAC)) 7460 AC1=X1:IF X2<X1 THEN AC1=X2 7461 IF X3<AC1 THEN AC1=X3 7462 IF X4<AC1 THEN AC1=X4 7463 AC1=AC1*SCALE#-1 7464 IF FX#-AC1<8/SCALE# THEN AC1=AC1-8/SCALE# 7475 AC2=Y1:IF Y2<AC2 THEN AC2=Y2 7476 IF Y3<AC2 THEN AC2=Y3 7477 IF Y4<AC2 THEN AC2=Y4 7478 IF FY#-AC2<4/SCALE# THEN AC2=AC2-4/SCALE# 7479 AC2=AC2*SCALE#/2-1 7480 AC3=(FX#*SCALE#-AC1)+FX#*SCALE# 7482 AC4=(FY#*SCALE#/2-AC2)+FY#*SCALE#/2 7483 RETURN 7484 ' 7485 LINE(X1*SCALE#,Y1*SCALE#/2)-(X2*SCALE#,Y2*SCALE#/2),1 7486 LINE(X2*SCALE#,Y2*SCALE#/2)-(X3*SCALE#,Y3*SCALE#/2),1 7487 LINE(X3*SCALE#,Y3*SCALE#/2)-(X4*SCALE#,Y4*SCALE#/2),1 7488 LINE(X4*SCALE#,Y4*SCALE#/2)-(X1*SCALE#,Y1*SCALE#/2),1 7490 DRAW "BM"+STR$(INT(FX#*SCALE#)-4)+","+STR$(INT(FY#*SCALE#/2)+4)+N$(FUWORK\10)+N$(FUWORK MOD 10) 7499 RETURN 7800 ' 7802 N$(0)="R3U4L3D4BR7":N$(1)="U4D4BR4":N$(2)="BU4R3D2L3D2R3BR4":N$(4)="BU4D2R2U1D1R1L1D2BR5":N$(5)="R3U2L3U2R3BD4BR4":N$(6)="U4D4U2R3D2L3BR7":N$(3)="R3U2L2R2U2L3R3D4BR4":N$(7)="BU4R3D4BR4":N$(8)="U2R3L3U2R3D4L3BR7":N$(9)="BR3U4L3D2R3D2BR4" 7810 RETURN 7900 ' 7905 PLAY "MB" 7910 FOR TONE=1000 TO 1100 STEP 20:SOUND TONE,0.2:NEXT TONE 7915 RETURN 7990 ' 8000 '********** pause until keypress *************** 8010 DEF SEG=0:POKE &H41A,PEEK(&H41C) 8030 I$=INKEY$:IF I$="" THEN 8030 8031 IF ASC(I$)<123 AND ASC(I$)>96 THEN I$=CHR$(ASC(I$)-32) 8032 SOUND 500,0.02:SOUND 100,0:RETURN 8050 '********** wait for selection ********* 8055 DEF SEG=0:POKE &H41A,PEEK(&H41C) 8060 LOCATE CSRLIN+2,48:PRINT "Press selection to continue,";:LOCATE CSRLIN+1,48:PRINT "or F8 to exit."; 8065 I$=INKEY$:IF I$="" THEN 8030 ELSE SOUND 500,0.51:SOUND 100,0 8066 IF ASC(I$)>96 AND ASC(I$)<123 THEN I$=CHR$(ASC(I$)-32) 8067 RETURN 8099 STOP 9000 ' 9005 '* NUMERIC INPUT ROUTINE * 9010 '******************************************************** 9015 PRINT STRING$(INLEN%,CHR$(35));:FOR AZX=1 TO INLEN%:PRINT CHR$(29);:NEXT AZX 9020 DEF FNO.DECIMAL=INSTR(NTRY$,".")=0 9025 NTRY$="" 9030 KK$=INKEY$: IF KK$="" THEN 9030 ELSE KK%=ASC(KK$) 9035 IF KK%=13 THEN GOTO 9095 'End of entry 9040 IF KK%=8 THEN GOTO 9070 'Backspace 9045 IF KK%=45 AND LEN(NTRY$)=0 AND INLEN%>1 THEN PRINT KK$;: NTRY$=KK$: GOTO 9060 9050 IF KK%=46 AND FNO.DECIMAL THEN PRINT KK$;: NTRY$=NTRY$+KK$: GOTO 9060 9055 IF KK%>47 AND KK%<58 THEN PRINT KK$;:NTRY$=NTRY$ + KK$ 9060 IF LEN(NTRY$)=INLEN% THEN 9095 9065 GOTO 9030 'Get another character 9070 '**** Backspace 9075 IF LEN(NTRY$)=0 THEN 9030 'Not if entry is empty 9080 PRINT CHR$(29); CHR$(35); CHR$(29); 'Redisplay box 9085 NTRY$=LEFT$(NTRY$,LEN(NTRY$)-1) 'Delete last character 9090 GOTO 9030 'Get next character 9095 PRINT SPACE$(INLEN% - LEN(NTRY$)) 9100 RETURN 9500 ' 9505 '* ALPHABETIC INPUT ROUTINE * 9510 ' 9515 LOCATE ,,1:PRINT STRING$(ALLEN%,CHR$(95));:FOR AZX= 1 TO ALLEN%:PRINT CHR$(29);:NEXT AZX 9520 NTRY$="" 9525 KK$=INKEY$: IF KK$="" THEN 9525 9526 KK%=ASC(KK$): IF LEN(KK$)>1 AND RIGHT$(KK$,1)=CHR$(75) THEN 9555 9527 IF KK%>96 AND KK%<123 THEN KK%=KK%-32:KK$=CHR$(KK%) 9530 IF KK%=13 THEN GOTO 9580 'End of entry 9535 IF KK%=8 THEN GOTO 9555 'Backspace 9540 IF (KK%>47 AND KK%<58) OR (KK%>64 AND KK%<91) OR KK%=32 THEN PRINT KK$;: NTRY$=NTRY$+KK$ 'Echo keystroke and add to entry 9545 IF LEN(NTRY$) = ALLEN% THEN 9580 'Entry full 9550 GOTO 9525 'Get another character 9555 '**** Backspace 9560 IF LEN(NTRY$)=0 THEN 9525 'Not if entry is empty 9565 PRINT CHR$(29);STRING$(1,95);CHR$(29); 'Redisplay box 9570 NTRY$=LEFT$(NTRY$,LEN(NTRY$)-1) 'Delete last character 9575 GOTO 9525 'Get next character 9580 LOCATE ,,0:PRINT SPACE$(ALLEN% - LEN(NTRY$)); 9585 RETURN 10000 IF IBMPC THEN DEF SEG=0:OUT &H3D9,0 10001 X=180:Y=20:GOSUB 11000 10003 X=145 10005 Y=130 10006 GOSUB 10010:GOTO 10400 10010 CIRCLE(X+140,Y),16,1,,,0.5 10020 CIRCLE(X+140,Y),12,1,,,0.5:PAINT(X+127,Y),1,1 10100 GET(X+140-16,Y-8)-(X+140,Y),UL 10110 GET(X+140-16,Y)-(X+140,Y+8),LL 10120 GET(X+140,Y-8)-(X+140+16,Y),UR 10130 GET(X+140,Y)-(X+140+16,Y+8),LR 10200 PUT(X+100,Y-8),UL,PSET:PUT(X+100,Y),LL,PSET 10210 PUT(X+73,Y-8),UL,PSET :PUT(X+73,Y),LL,PSET 10220 GET(X+140-16,Y-8)-(X+140+16,Y+8),PA:PUT(X+30,Y-8),PA,PSET 10230 PUT(X+165,Y-8),UL,PSET 10240 PUT(X+190,Y-8),PA,PSET 10300 LINE(X+234,Y-16)-(X+238,Y+8),1,BF 10310 PUT(X+255,Y-8),PA,PSET 10320 PUT(X+295,Y-8),UL,PSET 10330 GET(X+230,Y)-(X+240,Y+8),PA 10332 PUT(X+214,Y),PA,PSET 10334 PUT(X+161,Y),PA,PSET 10335 PUT(X+291,Y),PA,PSET 10336 GET(X+230,Y-16)-(X+240,Y),PA 10338 PUT(X+54,Y-16),PA,PSET 10340 PUT(X+234,Y),LL,PSET 10350 LINE(X+234,Y-8)-(X+250,Y-6),1,BF 10352 GET(X+234,Y-8)-(X+250,Y-6),PA 10354 PUT(X+73,Y-1),PA,PSET 10360 RETURN 10400 LOCATE Y\8+3,(X+180)\8-7 10410 LOCATE Y\8+4,(X+180)\8-13 10420 LOCATE Y/8+5,(X+180)\8-7 10500 GET(X+16,154-16)-(X+312,187),PA 10510 'LINE(140,65)-(490,130),1,B 10600 DEF SEG:FOR DELAY = 1 TO 2850:IF IBMPC THEN OUT &H3D9,DELAY \ 133 +1 10610 IF INKEY$="" THEN NEXT 10620 CLS:RETURN 10999 RETURN 11000 ' 11015 LINE(X+105,66+Y)-(X+192,73+Y),1:LINE-(X+192,79+Y),1:LINE-(X+200,80+Y),1:LINE-(X+200,10+Y),1:LINE-(X+0,6+Y),1 11020 LINE(X+0,7+Y)-(X+0,60+Y),1 11025 LINE -(X+5,61+Y),1:LINE-(X+5,16+Y),1:LINE -(X+100,20+Y),1:LINE -(X+100,70+Y),1:LINE-(X+105,71+Y),1:LINE -(X+105,66+Y),1 11030 LINE(X+200,80+Y)-(X+208,78+Y),1:LINE-(X+208,72+Y),1:LINE-(X+268,60+Y),1:LINE-(X+268,63+Y),1:LINE-(X+271,62+Y),1:LINE-(X+271,6+Y),1:LINE-(X+106,4+Y),1:LINE-(X+0,6+Y),1 11035 LINE(X+200,10+Y)-(X+271,6+Y),1:LINE(X+5,61+Y)-(X+10,60+Y),1:LINE-(X+10,17+Y),1:LINE(X+105,71+Y)-(X+111,70+Y),1:LINE-(X+111,68+Y),1:LINE(X+268,63+Y)-(X+264,61+Y),1 11040 LINE(X+107,21+Y)-(X+107,41+Y),1:LINE-(X+194,46+Y),1:LINE-(X+194,24+Y),1:LINE-(X+107,21+Y),1 11045 LINE(X+107,44+Y)-(X+107,64+Y),1:LINE-(X+194,70+Y),1:LINE-(X+194,49+Y),1:LINE-(X+107,44+Y),1 11050 LINE(X+140,25+Y)-(X+155,26+Y),1 11055 LINE(X+140,52+Y)-(X+155,53+Y),1 11060 LINE(X+90,19+Y)-(X+90,47+Y),1:LINE-(X+93,48+Y),1:LINE-(X+96,47+Y),1:LINE-(X+96,20+Y),1 11065 LINE(X+0,8+Y)-(X+200,14+Y),1:LINE-(X+270,8+Y),1 11070 LOCATE 12,1 11090 RETURN 12000 ' 12005 LINE(X+0,6+Y)-(X+120,10+Y),1:LINE-(X+320,5+Y),1:LINE(X+120,10+Y)-(X+120,81+Y),1:LINE(X+300,101+Y)-(X+320,102+Y),1:LINE(X+0,104+Y)-(X+107,92+Y),1 12010 LINE(X+10,18+Y)-(X+60,19+Y),1:LINE-(X+60,70+Y),1:LINE-(X+10,73+Y),1:LINE-(X+10,18+Y),1 12015 LINE(X+35,19+Y)-(X+35,72+Y),1:LINE(X+10,47+Y)-(X+60,45+Y),1 12020 LINE(X+107,100+Y)-(X+107,83+Y),1:LINE-(X+117,84+Y),1:LINE-(X+117,91+Y),1:LINE-(X+236,97+Y),1 12025 LINE-(X+236,88+Y),1:LINE-(X+250,89+Y),1:LINE-(X+250,110+Y),1:LINE-(X+107,100+Y),1 12030 LINE(X+250,110+Y)-(X+300,100+Y),1:LINE-(X+300,70+Y),1:LINE-(X+286,72+Y),1:LINE-(X+286,85+Y),1:LINE-(X+250,89+Y),1 12035 LINE(X+236,88+Y)-(X+272,84+Y),1:LINE-(X+286,85+Y),1 12040 LINE(X+147,66+Y)-(X+286,72+Y),1 12045 LINE(X+107,83+Y)-(X+147,78+Y),1:LINE-(X+147,66+Y),1:LINE-(X+160,65+Y),1:LINE-(X+300,70+Y),1 12050 LINE(X+117,91+Y)-(X+154,86+Y),1:LINE-(X+236,90+Y),1 12055 LINE(X+117,84+Y)-(X+154,79+Y),1:LINE-(X+147,78+Y),1 12060 LINE(X+154,79+Y)-(X+154,86+Y),1 12065 LINE(X+12,83+Y)-(X+60,78+Y),1:LINE-(X+84,80+Y),1:LINE-(X+35,85+Y),1:LINE-(X+12,83+Y),1 12070 LINE(X+12,85+Y)-(X+35,87+Y),1:LINE-(X+84,82+Y),1:LINE-(X+84,80+Y),1 12075 LINE(X+35,87+Y)-(X+35,85+Y),1:LINE(X+12,85+Y)-(X+12,83+Y),1:LINE-(X+12,102+Y),1 12080 LINE(X+35,87+Y)-(X+35,105+Y),1:LINE(X+84,80+Y)-(X+84,99+Y),1:LINE(X+60,84+Y)-(X+60,97+Y),1 12085 RETURN 13000 ' 13001 CLOSE 13002 LOCATE 25,28:PRINT " Loading room info... "; 13005 RFN$=F$ 13010 OPEN "I",#1,RFN$ 13015 INPUT #1, WDTH# 13020 INPUT #1, LENGTH# 13030 INPUT #1, DOORNO:FOR LCV= 1 TO DOORNO:FOR SUBLOOP = 1 TO 5 13032 INPUT #1, DO#(LCV,SUBLOOP) 13034 NEXT SUBLOOP,LCV 13040 INPUT #1, WINDNO:FOR LCV= 1 TO WINDNO:FOR SUBLOOP = 1 TO 5 13042 INPUT #1, WD#(LCV,SUBLOOP) 13044 NEXT SUBLOOP,LCV 13050 INPUT #1, PERMFIXNO:FOR LCV=1 TO PERMFIXNO:FOR SUBLOOP = 1 TO 5 13052 INPUT #1, PF#(LCV,SUBLOOP) 13054 NEXT SUBLOOP,LCV 13060 RETURN 13500 ' 13502 SCREEN 2:CLS:IF IBMPC THEN DEF SEG:OUT &H3D9,2 13503 LOCATE 3,54:PRINT "Drawing room..." 13509 IF WDTH#>LENGTH# THEN SCALE#=360/WDTH# ELSE SCALE#=360/LENGTH# 13510 LINE(0,0)-(INT(WDTH#*SCALE#),INT(LENGTH#*SCALE#/2)),1,B 13511 LINE(1,1)-(INT(WDTH#*SCALE#)-1,INT(LENGTH#*SCALE#/2)-1),1,B 13512 LINE(2,1)-(INT(WDTH#*SCALE#)-2,INT(LENGTH#*SCALE#/2)-1),1,B 13520 LOCATE 20,WDTH#*SCALE#\8+2:NUM=LENGTH#:GOSUB 7075:LOCATE (LENGTH#*SCALE#/2)\8+2,(WDTH#*SCALE#/2)\8:NUM=WDTH#:GOSUB 7075 13550 '====== DRAW DOORS ========= 13552 FOR LCV=1 TO DOORNO 13553 DEX1#=DO#(LCV,1)*SCALE#:DEY1#=DO#(LCV,2)*SCALE#/2:DEX2#=DO#(LCV,3)*SCALE#:DEY2#=DO#(LCV,4)*SCALE#/2 13554 PSET(INT(SCALE#*DO#(LCV,1)),INT(SCALE#*DO#(LCV,2)/2)),1:IF DO#(LCV,1)=0 OR DO#(LCV,2)=0 THEN DRAW "D4U4R8L8" ELSE DRAW "U4D4L8R8" 13555 PSET(INT(SCALE#*DO#(LCV,3)),INT(SCALE#*DO#(LCV,4)/2)),1:IF DO#(LCV,3)=0 OR DO#(LCV,4)=0 THEN DRAW "D4U4R8L8" ELSE DRAW "U4D4L8R8" 13556 XP#=SCALE#*DO#(LCV,3):YP#=DO#(LCV,4)*SCALE#/2 13558 IF XP#=0 THEN WALL=4 13560 IF YP#=0 THEN WALL=1 13562 IF XP#=WDTH#*SCALE# THEN WALL=2 13564 IF YP#=LENGTH#*SCALE#/2 THEN WALL=3 13566 IF DO#(LCV,5)=1 THEN 13586 13570 IF WALL=1 AND DO#(LCV ,1) < DO#(LCV ,3) THEN SP=3*PI/2:EP=2*PI 13572 IF WALL=1 AND DO#(LCV ,1) > DO#(LCV ,3) THEN SP=PI:EP=3*PI/2 13574 IF WALL=2 AND DO#(LCV ,2) < DO#(LCV ,4) THEN SP=PI:EP=3*PI/2 13575 IF WALL=2 AND DO#(LCV ,2) > DO#(LCV ,4) THEN SP=PI/2:EP=PI 13576 IF WALL=3 AND DO#(LCV ,1) < DO#(LCV ,3) THEN SP=2*PI:EP=PI/2 13577 IF WALL=3 AND DO#(LCV ,1) > DO#(LCV ,3) THEN SP=PI/2:EP=PI 13578 IF WALL=4 AND DO#(LCV ,2) < DO#(LCV ,4) THEN SP=3*PI/2:EP=2*PI 13579 IF WALL=4 AND DO#(LCV ,2) > DO#(LCV ,4) THEN SP=2*PI:EP=PI/2 13580 W1=ABS(DO#(LCV,1)-DO#(LCV,3)):W2=ABS(DO#(LCV,2)-DO#(LCV,4)):IF W1>W2 THEN DOORWDTH=W1 ELSE DOORWDTH=W2 13585 CIRCLE(INT(DO#(LCV,1)*SCALE#),INT(DO#(LCV,2)*SCALE#/2)),INT(DOORWDTH*SCALE#),1,SP*(-1),EP*(-1),0.5 13586 IF WALL=1 THEN LINE(DEX1#,DEY1#)-(DEX2#,DEY2#+1),0,BF 13587 IF WALL=2 THEN LINE(DEX1#,DEY1#)-(DEX2#-2,DEY2#),0,BF 13588 IF WALL=3 THEN LINE(DEX1#,DEY1#)-(DEX2#,DEY2#-1),0,BF 13589 IF WALL=4 THEN LINE(DEX1#,DEY1#)-(DEX2#+2,DEY2#),0,BF 13590 NEXT LCV 13600 ' 13610 FOR LCV=1 TO WINDNO 13615 XP#=WD#(LCV,3)*SCALE#:YP#=WD#(LCV,4)*SCALE#/2 13617 X1=INT(WD#(LCV,1)*SCALE#):Y1=INT(WD#(LCV,2)*SCALE#/2):X2=INT(WD#(LCV,3)*SCALE#):Y2=INT(WD#(LCV,4)*SCALE#/2) 13619 IF XP#=0 THEN LINE(X1+1,Y1)-(X2+1,Y2),0:LINE(X1+2,Y1)-(X2+2,Y2),0 13621 IF YP#=0 THEN LINE(X1,Y1+1)-(X2,Y2+1),0 13623 IF XP#=WDTH#*SCALE# THEN LINE(X1-1,Y1)-(X2-1,Y2),0:LINE(X1-2,Y1)-(X2-2,Y2),0 13625 IF YP#=LENGTH#*SCALE#/2 THEN LINE(X1,Y1-1)-(X2,Y2-1),0 13627 NEXT LCV 13700 '========= PUT PERMANENT FIXTURES ON SCREEN =============== 13710 FOR LCV= 1 TO PERMFIXNO 13715 ON PF#(LCV,1) GOSUB 13750,13800,13850 13720 NEXT LCV 13725 GOSUB 13900:LOCATE 3,54:PRINT STRING$(20," ");:RETURN 13750 '=========== DRAW RECTANGLE FIXTURE ======= 13752 LINE(INT(SCALE#*PF#(LCV,2)),INT(PF#(LCV,3)*SCALE#/2))-(INT(PF#(LCV,4)*SCALE#),INT(PF#(LCV,5)*SCALE#/2)),1,B 13760 RETURN 13800 '======== DRAW CIRCULAR FIXTURE ============ 13810 CIRCLE(INT(PF#(LCV,3)*SCALE#),INT(PF#(LCV,4)*SCALE#/2)),INT(PF#(LCV,2)*SCALE#),1,,,0.5 13820 RETURN 13850 '======== DRAW DIAGONAL WALL =========== 13852 LINE(INT(SCALE#*PF#(LCV,2)),INT(PF#(LCV,3)*SCALE#/2))-(INT(PF#(LCV,4)*SCALE#),INT(PF#(LCV,5)*SCALE#/2)),1 13860 RETURN 13900 ' 13910 FOR FUWORK= 1 TO FURNNO:IF FU$(FUWORK,2)=RFN$ THEN 13920 ELSE 13990 13920 FW=VAL(FU$(FUWORK,7)):FL=VAL(FU$(FUWORK,8)) 13921 IF FU$(FUWORK,1)="R" THEN RADIUS =SQR((FW/2)^2 + (FL/2)^2) ELSE RADIUS=FW/2 13922 A1#=ATN((FL/2)/(FW/2))*RADFAC 13924 A2#=180-A1# 13926 A3#=180+A1# 13928 A4#=360-A1# 13929 FX#=VAL(FU$(FUWORK,4)):FY#=VAL(FU$(FUWORK,5)):ANGLE=VAL(FU$(FUWORK,6)) 13930 IF FU$(FUWORK,1)="R" THEN GOSUB 7400:GOSUB 7484 ELSE CIRCLE(FX#*SCALE#,FY#*SCALE#/2),SCALE#*RADIUS,1,,,0.5:DRAW "BM"+STR$(INT(FX#*SCALE#)-4)+","+STR$(INT(FY#*SCALE#/2)+4)+N$(FUWORK\10)+N$(FUWORK MOD 10) 13990 NEXT FUWORK 13999 RETURN 14000 ' 14005 SCREEN 0,0,0:WIDTH 80 14010 ON KEY(8) GOSUB 60000 14020 GOSUB 15000 14025 IF FI.CO =1 THEN F$=FI.FI$(1):RETURN 14030 COLOR 7,0:CLS 14040 BASELOC=12-(FI.CO\2) 14070 FOR SELECTION = 1 TO FI.CO:LOCATE BASELOC+SELECTION,33:PRINT LEFT$(FI.FI$(SELECTION),8);:NEXT SELECTION 14080 LOCATE BASELOC+FI.CO+4,25:COLOR 7,0:PRINT "Use ";CHR$(24);" and ";CHR$(25);" to select." 14090 LOCATE ,25:PRINT "Press ";CHR$(17);"SOUND' to continue." 14100 LOCATE ,25:PRINT "F8 will exit this program." 14110 POINTER=1 14120 LOCATE BASELOC+POINTER,33:COLOR 0,7:PRINT LEFT$(FI.FI$(POINTER),8); 14130 DEF SEG=0:POKE &H41A,PEEK(&H41C) 14140 I$=INKEY$:IF LEN(I$)<2 AND I$<>CHR$(13) THEN 14140 14150 IF I$=CHR$(13) THEN F$=FI.FI$(POINTER):COLOR 7,0:SCREEN 2:RETURN 14160 LOCATE BASELOC+POINTER,33:COLOR 7,0:PRINT LEFT$(FI.FI$(POINTER),8); 14170 I=ASC(RIGHT$(I$,1)) 14180 IF I=72 AND POINTER>1 THEN POINTER=POINTER-1 14190 IF I=80 AND POINTER<FI.CO THEN POINTER=POINTER+1 14200 LOCATE BASELOC+POINTER,33:COLOR 0,7:PRINT LEFT$(FI.FI$(POINTER),8); 14210 GOTO 14140 14620 CLS:SCREEN 2:RETURN 500 15000 ' 15010 CLS:LOCATE 25,28:COLOR 0,7:PRINT " Examining directory... "; 15011 FI.CO=0 15020 LOCATE 1,1,0 15021 ON ERROR GOTO 15200 15030 COLOR 0,0:FILES "*.ROO" 15032 ON ERROR GOTO 30000 15040 FI.LA=CSRLIN 15050 FOR FI.RO=2 TO FI.LA-2 15060 FOR FI.NA=1 TO 18*4 STEP 18 15070 IF SCREEN(FI.RO,FI.NA)<>SCREEN(1,70) THEN FI.CO=FI.CO+1:FI.FI$(FI.CO)="":FOR FI.P=1 TO 12:FI.FI$(FI.CO)=FI.FI$(FI.CO)+CHR$(SCREEN(FI.RO,FI.NA-1+FI.P)):NEXT FI.P: ELSE 15090 15080 NEXT FI.NA,FI.RO 15090 FI.RO$="":FOR FI.CL=2 TO 7:FI.RO$=FI.RO$+CHR$(SCREEN(FI.LA-2,FI.CL)):NEXT FI.CL 15100 COLOR 7,0 15110 RETURN 15200 SCREEN 2:CLS:ON ERROR GOTO 30000:RESUME 500 16000 ' 16005 LOCATE 1,48:PRINT " SELECT FURNITURE "; 16006 LOCATE 19,48:PRINT "Use arrow keys to select item.";:LOCATE 20,48:PRINT "Press ENTER to continue.";:LOCATE 21,48:PRINT "ESC will abort."; 16010 PG=0 16100 'LOCATE 17,50:GOSUB 7100 16110 FOR LCV= 1 TO 15:LOCATE 2+LCV,48:PRINT PG*30+LCV;FU$(PG*30+LCV,3);:LOCATE 2+LCV,64:PRINT PG*30+LCV+15;FU$(PG*30+LCV+15,3);:NEXT LCV 16120 POINTER=1 16200 IF POINTER >15 THEN LOCATE 2+POINTER-15,64 ELSE LOCATE 2+POINTER,48 16210 PRINT ">";CHR$(29); 16300 I$=INKEY$:IF I$="" THEN 16300 16310 IF I$=CHR$(13) THEN FUWORK=PG*30+POINTER:GOTO 16900 16312 IF I$=CHR$(27) THEN FUWORK=0:GOTO 16900 16320 IF LEN(I$)<2 THEN 16300 16322 PRINT " ";CHR$(29); 16324 I=ASC(RIGHT$(I$,1)) 16330 IF I=72 AND POINTER>1 THEN POINTER=POINTER-1 16332 IF I=80 AND FU$(1+POINTER+30*PG,3)<>"" AND POINTER<30 THEN POINTER=POINTER+1 16334 IF I=77 AND POINTER+15+30*PG<=FURNNO THEN POINTER=POINTER+15 16336 IF I=75 AND POINTER>15 THEN POINTER=POINTER-15 16340 IF I=73 AND PG>0 THEN PG=PG-1:LOCATE 17,1:GOSUB 7100:GOTO 16100 16342 IF I=81 AND PG<FURNNO\30+1 THEN PG=PG+1:LOCATE 17,1:GOSUB 7100:GOTO 16100 16350 GOTO 16200 16900 LOCATE 16,48:RETURN 16999 GOSUB 8000:STOP 19999 RETURN 28000 ' 28010 CLS:LOCATE 12,12:PRINT "This program uses the graphics card. If you do not have":LOCATE 13,12:PRINT "graphics capabilities, proceeding past this screen may create":LOCATE 14,12:PRINT "errors. Press F8 to exit or C to continue." 28020 DEF SEG=0:POKE &H41A,PEEK(&H41C) 28030 I$=INKEY$:IF I$<>"C" AND I$<>"c" THEN 28030 ELSE RETURN 29000 '========== graphic function call errors =========== 29010 IF ERR=5 THEN FX#=WDTH#/2:FY#=LENGTH#/2:BEEP:RESUME 3507 30000 '========== SPECIALIZED ERROR TRAPPING =========== 40000 '========== ERROR TRAPPING ROUTINE ================ 40005 CLOSE 40010 IF ERR=24 OR ERR=25 OR ERR=27 OR ERR=68 THEN MSG$="ARE YOU SURE THE PRINTER IS READY?":GOSUB 50000:RESUME 40020 IF ERR=71 OR ERR=70 THEN MSG$="ARE YOU SURE THE DISK IS READY?":GOSUB 50000:CLOSE:RESUME 40900 ON ERROR GOTO 0 50000 '========= display msg routine ============== 50010 SM.L=LEN(MSG$) 50020 SM.ST$="":SM.OC=0 50030 SM.CL=POS(0):SM.RW=CSRLIN 50040 BEEP 50050 SM.SL=40-(SM.L\2+1) 50060 FOR SM.LCV=SM.SL TO SM.SL+SM.L+2 50070 SM.NC=SCREEN(12,SM.LCV,1) 50080 IF SM.NC<>SM.OC THEN SM.ST$=SM.ST$+CHR$(255)+CHR$(SM.NC):SM.OC=SM.NC 50090 SM.ST$=SM.ST$+CHR$(SCREEN(12,SM.LCV)) 50100 NEXT SM.LCV 50110 LOCATE 12,40:PRINT CHR$(219); 50120 SM.V=SCREEN(12,40,1):SM.RF=(SM.V MOD 16):SM.RB=(((SM.V-SM.RF)/16) MOD 128) 50130 COLOR 15,4 50140 LOCATE 12,SM.SL+1:PRINT " ";MSG$;" " 50150 SM.I$=INKEY$:IF SM.I$="" THEN 50150 50160 SM.SP=1 50170 LOCATE 12,SM.SL 50180 COLOR SM.RF,SM.RB 50190 FOR SM.LCV=1 TO LEN(SM.ST$) 50200 IF MID$(SM.ST$,SM.LCV,1)=CHR$(255) THEN SM.V=ASC(MID$(SM.ST$,SM.LCV+1,1)):SM.F=(SM.V MOD 16):SM.B=(((SM.V-SM.F)/16) MOD 128):COLOR SM.F,SM.B:SM.LCV=SM.LCV+2 50210 PRINT MID$(SM.ST$,SM.LCV,1); 50220 NEXT SM.LCV 50230 LOCATE SM.RW,SM.CL:COLOR SM.RF,SM.RB 50240 RETURN 60000 '======= RESAVE FURNITURE AND CLOSE FILES ========== 60001 BEEP 60005 GOSUB 1650:CLOSE 65010 CLOSE:SCREEN 0: WIDTH 80: COLOR 14,0 65015 ON ERROR GOTO 0 65020 IF ADDR.%<>0 THEN LOCATE 25,1,0: PRINT SPACE$(28) 65030 CLS: LOCATE 12,35: PRINT"Good-bye!": COLOR 3 65040 END