home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / msdos / graphics / 3dbb.arc / 3DBB.BAS next >
Encoding:
BASIC Source File  |  1986-03-25  |  5.3 KB  |  114 lines
  1. 10 X=0:Y=0:Z=0:EX=0:EY=0:D=5000:ANG=10/57.29578
  2. 20 DIM M(500,3):MP=1:VP=1:CS=1:C=10
  3. 30 SCREEN 0,0,0:COLOR 2:WIDTH 80:CLS
  4. 40 PRINT "3DBB: 3-Dimensional Black Board  v1.2                ScAn Software Designs"
  5. 50 PRINT "                                                     2105 29th Street"
  6. 60 PRINT "Commands:                                            San Diego, CA  92104"
  7. 70 PRINT "              Arrow Keys   =    Move Cursor UDRL"
  8. 80 PRINT "  Home, Pgup, Pgdn, End    =    Move Cursor Diags"
  9. 90 PRINT "                     Ins   =    Move Cursor IN (Z)"
  10. 100 PRINT "                     Del   =    Move Cursor OUT (Z)"
  11. 110 PRINT "                     + -   =    Change Cursor Move Rate"
  12. 120 PRINT "                       S   =    Set Point @ Cursor"
  13. 130 PRINT "                 1, 2, 3   =    Draw Line up to Cursor, in Color"
  14. 140 PRINT "                       C   =    Change Color Set"
  15. 150 PRINT "                       V   =    Visit Previously Set Points"
  16. 160 PRINT "                 X, Y, Z   =    Rotate in plane"
  17. 170 PRINT "                       |   =    Redraw Screen"
  18. 180 PRINT "                       !   =    End Program"
  19. 190 PRINT "                       @   =    Clear all Points"
  20. 200 PRINT "                       W   =    Write Shape to Disk"
  21. 210 PRINT "                       R   =    Read Shape from Disk"
  22. 220 PRINT "                      "+CHR$(17)+"┘   =    Lessen distance/skew"
  23. 230 PRINT "                      "+CHR$(17)+"-   =    Increase distance/skew"
  24. 240 PRINT "                     Esc   =    RETURN TO THIS MENU"
  25. 250 PRINT ""
  26. 260 PRINT " Please leave CAPS LOCK on at all times."
  27. 270 IF INKEY$="" THEN 270
  28. 280 SCREEN 1:COLOR 0,1:GOTO 750
  29. 290 GOSUB 680:OP=POINT(XP,YP)
  30. 300 PSET (XP,YP),ABS(OP-1)
  31. 310 LOCATE 24,1:PRINT USING "+###.##:+###.##:+###.## S=## D=##";X;Y;Z;C;D/1000;
  32. 320 A$=INKEY$
  33. 330 PSET (XP,YP),OP
  34. 340 DEF SEG=0:POKE 1050,PEEK(1052):DEF SEG
  35. 350 IF A$="" THEN 290
  36. 360 IF LEN(A$)=2 THEN A=ASC(RIGHT$(A$,1)):GOTO 570 ELSE A=ASC(A$)
  37. 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
  38. 380 IF A=67 THEN CS=ABS(CS-1):COLOR 0,CS                 ' CS Change
  39. 390 IF A=64 THEN MP=1:CLS
  40. 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
  41. 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
  42. 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
  43. 430 IF A=124 THEN 750             ' | Redraw
  44. 440 IF A=27 THEN 30
  45. 450 IF A=87 THEN GOSUB 950:GOTO 750   ' W  Write
  46. 460 IF A=82 THEN GOSUB 1040:GOTO 750   ' R  Read
  47. 470 IF A=13 THEN D=D-1000:IF D<1000 THEN D=1000:GOTO 750 ELSE 750
  48. 480 IF A=8 THEN D=D+1000:IF D>10000 THEN D=10000:GOTO 750 ELSE 750
  49. 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
  50. 500 IF A=43 THEN C=C+1:IF C>20 THEN C=20      '+ Step rate
  51. 510 IF A=45 THEN C=C-1:IF C<1 THEN C=1        '- Step rate
  52. 520 IF A=88 THEN 850:                        'X ROTATE
  53. 530 IF A=89 THEN 900:                        'Y ROTATE
  54. 540 IF A=90 THEN 800:                        'Z ROTATE
  55. 550 IF A=33 THEN SCREEN 0,0,0:WIDTH 80:COLOR 2:CLS:END                   ' END
  56. 560 GOTO 290
  57. 570 IF A=72 THEN Y=Y-C:GOTO 670   'UP
  58. 580 IF A=75 THEN X=X-C:GOTO 670   'LEFT
  59. 590 IF A=80 THEN Y=Y+C:GOTO 670   'DOWN
  60. 600 IF A=77 THEN X=X+C:GOTO 670   'RIGHT
  61. 610 IF A=71 THEN X=X-C:Y=Y-C:GOTO 670   'Home
  62. 620 IF A=79 THEN X=X-C:Y=Y+C:GOTO 670   'End
  63. 630 IF A=73 THEN X=X+C:Y=Y-C:GOTO 670   'PgUp
  64. 640 IF A=81 THEN X=X+C:Y=Y+C:GOTO 670   'PgDn
  65. 650 IF A=82 THEN Z=Z+C:GOTO 670   'Ins (in)
  66. 660 IF A=83 THEN Z=Z-C            'Del (out)
  67. 670 GOTO 290
  68. 680 IF X>159 THEN X=X-320
  69. 690 IF X<-160 THEN X=X+320
  70. 700 IF Y>99 THEN Y=Y-200
  71. 710 IF Y<-100 THEN Y=Y+200
  72. 720 XP=((X*D)/(D+Z))+160
  73. 730 YP=((Y*D)/(D+Z))+100
  74. 740 RETURN
  75. 750 CLS
  76. 760 FOR I=1 TO MP-1
  77. 770 X=M(I,1):Y=M(I,2):Z=M(I,3):GOSUB 720
  78. 780 IF M(I,0)=0 THEN LINE (XP,YP)-(XP,YP),1 ELSE LINE -(XP,YP),M(I,0)
  79. 790 NEXT I:GOTO 290
  80. 800 FOR I=1 TO MP  'Z ROT
  81. 810 X=M(I,1):Y=M(I,2)
  82. 820 XN=(.9848078*X)+(.1736482*Y)
  83. 830 YN=(.9848078*Y)-(.1736482*X)
  84. 840 M(I,1)=XN:M(I,2)=YN:NEXT I:GOTO 750
  85. 850 FOR I=1 TO MP  'X ROT
  86. 860 Y=M(I,2):Z=M(I,3)
  87. 870 YN=(.9848078*Y)+(.1736482*Z)
  88. 880 ZN=(.9848078*Z)-(.1736482*Y)
  89. 890 M(I,2)=YN:M(I,3)=ZN:NEXT I:GOTO 750
  90. 900 FOR I=1 TO MP  'Y ROT
  91. 910 X=M(I,1):Z=M(I,3)
  92. 920 XN=(.9848078*X)+(.1736482*Z)
  93. 930 ZN=(.9848078*Z)-(.1736482*X)
  94. 940 M(I,1)=XN:M(I,3)=ZN:NEXT I:GOTO 750
  95. 950 LOCATE 24,1:PRINT "Sure you want to Write this (Y/N)?";
  96. 960 A$=INKEY$:IF A$="" THEN 960
  97. 970 IF A$<>"Y" THEN LOCATE 24,1:PRINT STRING$(39,32);:RETURN
  98. 980 SCREEN 0,0,0:COLOR 2:WIDTH 80:CLS
  99. 990 INPUT "File Name";F$
  100. 1000 OPEN "O",1,F$
  101. 1010 PRINT #1,MP
  102. 1020 FOR I=1 TO MP:PRINT #1,M(I,0);M(I,1);M(I,2);M(I,3):NEXT I:CLOSE
  103. 1030 SCREEN 1,0:COLOR 0,CS:RETURN
  104. 1040 LOCATE 24,1:PRINT "Sure you want to Read a file (Y/N)?";
  105. 1050 A$=INKEY$:IF A$="" THEN 1050
  106. 1060 IF A$<>"Y" THEN LOCATE 24,1:PRINT STRING$(39,32);:RETURN
  107. 1070 SCREEN 0,0,0:COLOR 2:WIDTH 80:CLS
  108. 1075 FILES
  109. 1080 INPUT "File Name";F$
  110. 1090 OPEN "I",1,F$
  111. 1100 INPUT #1,MP
  112. 1110 FOR I=1 TO MP:INPUT #1,M(I,0),M(I,1),M(I,2),M(I,3):NEXT I:CLOSE
  113. 1120 SCREEN 1,0:COLOR 0,CS:RETURN
  114.