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