home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MS DOS Archives 1
/
MS-DOS_Archives_Volume_One_Walnut_Creek.iso
/
msdos
/
graphics
/
3dbb.arc
/
3DBB.BAS
next >
Wrap
BASIC Source File
|
1986-03-25
|
5KB
|
114 lines
10 X=0:Y=0:Z=0:EX=0:EY=0:D=5000:ANG=10/57.29578
20 DIM M(500,3):MP=1:VP=1:CS=1:C=10
30 SCREEN 0,0,0:COLOR 2:WIDTH 80:CLS
40 PRINT "3DBB: 3-Dimensional Black Board v1.2 ScAn Software Designs"
50 PRINT " 2105 29th Street"
60 PRINT "Commands: San Diego, CA 92104"
70 PRINT " Arrow Keys = Move Cursor UDRL"
80 PRINT " Home, Pgup, Pgdn, End = Move Cursor Diags"
90 PRINT " Ins = Move Cursor IN (Z)"
100 PRINT " Del = Move Cursor OUT (Z)"
110 PRINT " + - = Change Cursor Move Rate"
120 PRINT " S = Set Point @ Cursor"
130 PRINT " 1, 2, 3 = Draw Line up to Cursor, in Color"
140 PRINT " C = Change Color Set"
150 PRINT " V = Visit Previously Set Points"
160 PRINT " X, Y, Z = Rotate in plane"
170 PRINT " | = Redraw Screen"
180 PRINT " ! = End Program"
190 PRINT " @ = Clear all Points"
200 PRINT " W = Write Shape to Disk"
210 PRINT " R = Read Shape from Disk"
220 PRINT " "+CHR$(17)+"┘ = Lessen distance/skew"
230 PRINT " "+CHR$(17)+"- = Increase distance/skew"
240 PRINT " Esc = RETURN TO THIS MENU"
250 PRINT ""
260 PRINT " Please leave CAPS LOCK on at all times."
270 IF INKEY$="" THEN 270
280 SCREEN 1:COLOR 0,1:GOTO 750
290 GOSUB 680:OP=POINT(XP,YP)
300 PSET (XP,YP),ABS(OP-1)
310 LOCATE 24,1:PRINT USING "+###.##:+###.##:+###.## S=## D=##";X;Y;Z;C;D/1000;
320 A$=INKEY$
330 PSET (XP,YP),OP
340 DEF SEG=0:POKE 1050,PEEK(1052):DEF SEG
350 IF A$="" THEN 290
360 IF LEN(A$)=2 THEN A=ASC(RIGHT$(A$,1)):GOTO 570 ELSE A=ASC(A$)
370 IF A=83 THEN PSET (XP,YP),1:EX=XP:EY=YP:M(MP,0)=0:M(MP,1)=X:M(MP,2)=Y:M(MP,3)=Z:MP=MP+1:GOTO 290 ' Set
380 IF A=67 THEN CS=ABS(CS-1):COLOR 0,CS ' CS Change
390 IF A=64 THEN MP=1:CLS
400 IF A=49 THEN LINE (EX,EY)-(XP,YP),1:EX=XP:EY=YP:M(MP,0)=1:M(MP,1)=X:M(MP,2)=Y:M(MP,3)=Z:MP=MP+1:GOTO 290 ' Line
410 IF A=50 THEN LINE (EX,EY)-(XP,YP),2:EX=XP:EY=YP:M(MP,0)=2:M(MP,1)=X:M(MP,2)=Y:M(MP,3)=Z:MP=MP+1:GOTO 290 ' Line
420 IF A=51 THEN LINE (EX,EY)-(XP,YP),3:EX=XP:EY=YP:M(MP,0)=3:M(MP,1)=X:M(MP,2)=Y:M(MP,3)=Z:MP=MP+1:GOTO 290 ' Line
430 IF A=124 THEN 750 ' | Redraw
440 IF A=27 THEN 30
450 IF A=87 THEN GOSUB 950:GOTO 750 ' W Write
460 IF A=82 THEN GOSUB 1040:GOTO 750 ' R Read
470 IF A=13 THEN D=D-1000:IF D<1000 THEN D=1000:GOTO 750 ELSE 750
480 IF A=8 THEN D=D+1000:IF D>10000 THEN D=10000:GOTO 750 ELSE 750
490 IF A=86 THEN X=M(VP,1):Y=M(VP,2):Z=M(VP,3):VP=VP+1:IF VP>=MP THEN VP=1 'Visit
500 IF A=43 THEN C=C+1:IF C>20 THEN C=20 '+ Step rate
510 IF A=45 THEN C=C-1:IF C<1 THEN C=1 '- Step rate
520 IF A=88 THEN 850: 'X ROTATE
530 IF A=89 THEN 900: 'Y ROTATE
540 IF A=90 THEN 800: 'Z ROTATE
550 IF A=33 THEN SCREEN 0,0,0:WIDTH 80:COLOR 2:CLS:END ' END
560 GOTO 290
570 IF A=72 THEN Y=Y-C:GOTO 670 'UP
580 IF A=75 THEN X=X-C:GOTO 670 'LEFT
590 IF A=80 THEN Y=Y+C:GOTO 670 'DOWN
600 IF A=77 THEN X=X+C:GOTO 670 'RIGHT
610 IF A=71 THEN X=X-C:Y=Y-C:GOTO 670 'Home
620 IF A=79 THEN X=X-C:Y=Y+C:GOTO 670 'End
630 IF A=73 THEN X=X+C:Y=Y-C:GOTO 670 'PgUp
640 IF A=81 THEN X=X+C:Y=Y+C:GOTO 670 'PgDn
650 IF A=82 THEN Z=Z+C:GOTO 670 'Ins (in)
660 IF A=83 THEN Z=Z-C 'Del (out)
670 GOTO 290
680 IF X>159 THEN X=X-320
690 IF X<-160 THEN X=X+320
700 IF Y>99 THEN Y=Y-200
710 IF Y<-100 THEN Y=Y+200
720 XP=((X*D)/(D+Z))+160
730 YP=((Y*D)/(D+Z))+100
740 RETURN
750 CLS
760 FOR I=1 TO MP-1
770 X=M(I,1):Y=M(I,2):Z=M(I,3):GOSUB 720
780 IF M(I,0)=0 THEN LINE (XP,YP)-(XP,YP),1 ELSE LINE -(XP,YP),M(I,0)
790 NEXT I:GOTO 290
800 FOR I=1 TO MP 'Z ROT
810 X=M(I,1):Y=M(I,2)
820 XN=(.9848078*X)+(.1736482*Y)
830 YN=(.9848078*Y)-(.1736482*X)
840 M(I,1)=XN:M(I,2)=YN:NEXT I:GOTO 750
850 FOR I=1 TO MP 'X ROT
860 Y=M(I,2):Z=M(I,3)
870 YN=(.9848078*Y)+(.1736482*Z)
880 ZN=(.9848078*Z)-(.1736482*Y)
890 M(I,2)=YN:M(I,3)=ZN:NEXT I:GOTO 750
900 FOR I=1 TO MP 'Y ROT
910 X=M(I,1):Z=M(I,3)
920 XN=(.9848078*X)+(.1736482*Z)
930 ZN=(.9848078*Z)-(.1736482*X)
940 M(I,1)=XN:M(I,3)=ZN:NEXT I:GOTO 750
950 LOCATE 24,1:PRINT "Sure you want to Write this (Y/N)?";
960 A$=INKEY$:IF A$="" THEN 960
970 IF A$<>"Y" THEN LOCATE 24,1:PRINT STRING$(39,32);:RETURN
980 SCREEN 0,0,0:COLOR 2:WIDTH 80:CLS
990 INPUT "File Name";F$
1000 OPEN "O",1,F$
1010 PRINT #1,MP
1020 FOR I=1 TO MP:PRINT #1,M(I,0);M(I,1);M(I,2);M(I,3):NEXT I:CLOSE
1030 SCREEN 1,0:COLOR 0,CS:RETURN
1040 LOCATE 24,1:PRINT "Sure you want to Read a file (Y/N)?";
1050 A$=INKEY$:IF A$="" THEN 1050
1060 IF A$<>"Y" THEN LOCATE 24,1:PRINT STRING$(39,32);:RETURN
1070 SCREEN 0,0,0:COLOR 2:WIDTH 80:CLS
1075 FILES
1080 INPUT "File Name";F$
1090 OPEN "I",1,F$
1100 INPUT #1,MP
1110 FOR I=1 TO MP:INPUT #1,M(I,0),M(I,1),M(I,2),M(I,3):NEXT I:CLOSE
1120 SCREEN 1,0:COLOR 0,CS:RETURN