home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / BASIC / PCGRAF.ZIP / PCGRAF.BAS
Encoding:
BASIC Source File  |  1987-11-11  |  3.3 KB  |  93 lines
  1. 10 '             **********************************************
  2. 20 '             *  PCGRAF - Easy 3-D Graphics on the IBM PC  *
  3. 30 '             *                   by                       *
  4. 40 '             *           Henning Mittelbach               *
  5. 50 '             * Copyright 1985, for private non-commercial *
  6. 60 '             *                use only.                   *
  7. 70 '             **********************************************
  8. 80 CLS: SCREEN 1
  9. 90 DIM H (279)
  10. 100 X0=110
  11. 110 Y0=180
  12. 120 PHI=.5
  13. 130 PSI=.4
  14. 140 XL= 0
  15. 150 XR= 170
  16. 160 YL=0
  17. 170 YR=100
  18. 180 D=5
  19. 198 '                       * FUNCTION TO BE PLOTTED *
  20. 199 '
  21. 200 DEF FN Y(X) = SIN (Y/F) * (X-Y) * (X-Y)/150
  22. 210 F=10
  23. 240 '                      * ABBREVIATIONS AND CUTTING THE TOP *
  24. 250 CF= COS (PHI) : SF=SIN(PHI) : CP= COS (PSI) : SP= SIN(PSI)
  25. 260 H=Y0 - XR * SF -YR * SP - 2
  26. 270 INPUT "Do you desire cross-hatching? (Y/N):",OPT$
  27. 280 IF OPT$="Y" OR OPT$="y" THEN CH=2 ELSE CH=1
  28. 300 INPUT "Do you wish to view the axes? (Y/N):",AX$
  29. 310 CLS: IF AX$ = "Y" OR AX$ = "y" THEN 320 ELSE 340
  30. 320 LINE (X0 + XL * CF, Y0 - XL * SF) -(X0 + XR * CF, Y0 - XR * SF)
  31. 330 LINE (X0 - YL * CP, Y0 - YL * SP) -(X0 - YR * CP, Y0 - YR * SP )
  32. 340 LINE (0,0) - (279,189),,B
  33. 350 '
  34. 398 '                      R=1: Y-COORD. LINES
  35. 399 '                      R=2: X-COORD. LINES
  36. 400 FOR R = 1 TO CH
  37. 410 '                      * SETTING MASK ON LOWER BORDER OF WINDOW *
  38. 420 FOR I = 0 TO 279: H(I) = 189: NEXT I
  39. 430 ON R GOSUB 1000, 2000
  40. 440 NEXT R
  41. 499 '                       * GRAPHIC IS FINISHED *
  42. 500 BEEP
  43. 510 LINE (0,0) - (279,189),,B
  44. 520 A$=INKEY$: IF A$="" THEN 520
  45. 600 END
  46. 610 '                       * END OF PROGRAM *
  47. 1000 '                   * Y-COORD. LINES FOR X = CONST. *
  48. 1010 Y = YL: '          * FRONT MASK SETTING *
  49. 1020 FOR X = XL TO XR
  50. 1030 XB = INT (X0 + X * CF - Y * CP + .5)
  51. 1040 Z = FN Y(X) : IF Z > H THEN Z = H
  52. 1050 YB = INT (Y0 - X * SF - Y * SP - Z + .5)
  53. 1060 IF YB < H(XB) THEN H(XB) = YB
  54. 1070 NEXT X
  55. 1090 '                  * ADAPTING THE MASK PER LINE *
  56. 1100 FOR X = XL TO XR STEP D
  57. 1110 U = X0 + X * CF : V = Y0 - X * SF
  58. 1120 FOR Y = YL TO YR
  59. 1130 XB = INT (U - Y * CP + .5)
  60. 1140 Z = FN Y(X) : IF Z > H THEN Z = H
  61. 1150 YB = INT (V - Y * SP - Z + .5)
  62. 1160 IF YB < H(XB) THEN H(XB) = YB
  63. 1170 NEXT Y
  64. 1190 '                  * PLOTTING THE MASK *
  65. 1200 FOR K = INT (U - YR * CP + .5) TO INT (U - YL * CP + .5) - 1
  66. 1210 LINE (K,H(K)) - (K + 1,H(K+1))
  67. 1220 NEXT K
  68. 1230 NEXT X
  69. 1240 RETURN
  70. 2000 '                   * X-COORD. LINES FOR Y = CONST. *
  71. 2010 X = XL: '          * FRONT MASK SETTING *
  72. 2020 FOR Y = YL TO YR
  73. 2030 XB = INT (X0 + X * CF - Y * CP + .5)
  74. 2040 Z = FN Y(X) : IF Z > H THEN Z = H
  75. 2050 YB = INT (Y0 - X * SF - Y * SP - Z + .5)
  76. 2060 IF YB < H(XB) THEN H(XB) = YB
  77. 2070 NEXT Y
  78. 2090 '                  * ADAPTING THE MASK PER LINE *
  79. 2100 FOR Y = YL TO YR STEP D
  80. 2110 U = X0 - Y * CP : V = Y0 - Y * SP
  81. 2120 FOR X = XL TO XR
  82. 2130 XB = INT (U + X * CF + .5)
  83. 2140 Z = FN Y(X) : IF Z > H THEN Z = H
  84. 2150 YB = INT (V - X * SF - Z + .5)
  85. 2160 IF YB < H(XB) THEN H(XB) = YB
  86. 2170 NEXT X
  87. 2190 '                  * PLOTTING THE MASK *
  88. 2200 FOR K = INT (U + XL * CF + .5) TO INT (U + XR * CF) - 1
  89. 2210 LINE (K,H(K)) - (K + 1,H(K+1))
  90. 2220 NEXT K
  91. 2230 NEXT Y
  92. 2240 RETURN
  93.