|
| 1 | + |
| 2 | +'#sec:Main |
| 3 | +10 DIM x(1000) |
| 4 | +11 DIM y(1000) |
| 5 | +12 DIM z(1000) |
| 6 | +20 d = 150: t = .7: p = 2 |
| 7 | +22 poc = 1: PEN ON |
| 8 | +24 po = 1: drau = 0: modo = 0 |
| 9 | +25 CY = 0: CX = 0: CZ = 0 |
| 10 | +60 GOSUB 100: GOTO 500 |
| 11 | + |
| 12 | +100 CLS : GOSUB 851: GOSUB 200: RETURN |
| 13 | + |
| 14 | +150 REM calcula y dibuja un punto |
| 15 | +152 xe = -px * st + py * ct |
| 16 | +154 ye = -px * ct * cp - py * st * cp + pz * sp |
| 17 | +156 ze = -px * sp * ct - py * st * sp - pz * cp + 4 |
| 18 | +158 sx = d * xe / ze + 80 |
| 19 | +160 sy = d * ye / ze + 80 |
| 20 | +161 pset sx,sy |
| 21 | +162 RETURN |
| 22 | + |
| 23 | +200 REM redibuja |
| 24 | +202 st = SIN(t): ct = COS(t) |
| 25 | +204 sp = SIN(p): cp = COS(p) |
| 26 | +210 FOR i = 1 TO po |
| 27 | +220 px = x(i) / 10: py = y(i) / 10: pz = z(i) / 10 |
| 28 | +230 GOSUB 150 |
| 29 | +240 NEXT i |
| 30 | +250 RETURN |
| 31 | + |
| 32 | +430 INPUT "cuantos valores desea BorRAR? ?"; BO |
| 33 | +435 po = po - BO |
| 34 | +440 GOSUB 100: GOTO 500 |
| 35 | + |
| 36 | +500 a$ = INKEY$: GOSUB 1200: IF a$ = "" AND pecom = 0 THEN GOTO 500 |
| 37 | +501 a = ASC(a$): IF pecom <> 0 THEN GOTO 532 |
| 38 | +502 IF a$ = "s" THEN GOSUB 1400: GOSUB 851: REM modo ver o dibujar |
| 39 | +503 IF a$ = "k" THEN GOSUB 1000: REM graba data |
| 40 | +504 IF a$ = "o" THEN GOSUB 1100: REM lee data |
| 41 | +505 IF a$ = "a" THEN GOSUB 2600: REM angulo hor |
| 42 | +506 IF a$ = "b" THEN GOSUB 2700: REM angulo ver |
| 43 | +507 IF a$ = "e" THEN GOSUB 1500: REM esfera |
| 44 | +508 IF a$ = "l" THEN GOSUB 1600: REM linea |
| 45 | +509 IF a$ = "c" THEN GOSUB 1800: REM circulo |
| 46 | +512 IF a$ = "m" THEN GOSUB 2400: REM mover |
| 47 | +513 IF a$ = "f" THEN GOSUB 2500: REM grafica funcion |
| 48 | +514 IF a$ = "z" THEN GOSUB 2800: REM zoom |
| 49 | +519 IF a$ = "h" THEN GOSUB 5000: GOSUB 851: GOTO 500: REM home |
| 50 | +521 IF a$ = "u" THEN CLS : GOSUB 100: REM redraw |
| 51 | +522 IF a$ = "l" THEN po = 1: GOTO 20: REM borrar puntos |
| 52 | +524 IF a$ = "g" THEN CX = 0: CY = 0: CZ = 0: GOSUB 851: GOTO 500: REM cero |
| 53 | +526 IF a$ = "p" THEN CLS : GOTO 430: REM borrar puntos |
| 54 | +528 IF ((drau = 0) AND (a$ = "i")) THEN drau = 1: GOSUB 851 |
| 55 | +530 IF ((drau = 1) AND (a$ = "i")) THEN drau = 0: GOSUB 851 |
| 56 | +532 IF modo = 1 AND pecom = 1 THEN CZ = CZ - 1: GOSUB 610 |
| 57 | +534 IF modo = 1 AND pecom = 9 THEN CZ = CZ + 1: GOSUB 610 |
| 58 | +536 IF modo = 1 AND pecom = 4 THEN CY = CY - 1: GOSUB 610 |
| 59 | +538 IF modo = 1 AND pecom = 6 THEN CY = CY + 1: GOSUB 610 |
| 60 | +540 IF modo = 1 AND pecom = 3 THEN CX = CX - 1: GOSUB 610 |
| 61 | +542 IF modo = 1 AND pecom = 7 THEN CX = CX + 1: GOSUB 610 |
| 62 | +543 IF pecom = 2 THEN d = d + 10: GOSUB 100 |
| 63 | +544 IF pecom = 8 THEN d = d - 10: GOSUB 100 |
| 64 | +545 IF modo = 0 AND pecom = 4 THEN t = t - .1: GOSUB 100 |
| 65 | +546 IF modo = 0 AND pecom = 6 THEN t = t + .1: GOSUB 100 |
| 66 | +547 IF modo = 0 AND pecom = 1 THEN p = p + .1: GOSUB 100 |
| 67 | +548 IF modo = 0 AND pecom = 9 THEN p = p - .1: GOSUB 100 |
| 68 | +599 GOTO 500 |
| 69 | +610 IF drau = 1 THEN GOSUB 700 |
| 70 | +605 IF drau = 0 THEN GOSUB 750 |
| 71 | +620 RETURN |
| 72 | + |
| 73 | + |
| 74 | +700 x(po) = CX: y(po) = CY |
| 75 | +705 z(po) = CZ |
| 76 | +710 po = po + 1: i = 1: x(i) = CX |
| 77 | +715 y(i) = CY: z(i) = CZ |
| 78 | +720 px = CX / 10: py = CY / 10: pz = CZ / 10: GOSUB 150 |
| 79 | +725 GOSUB 851 |
| 80 | +730 RETURN |
| 81 | + |
| 82 | +750 px = CX / 10: py = CY / 10: pz = CZ / 10: COLOR 9: GOSUB 150: COLOR 15: GOSUB 150 |
| 83 | +760 COLOR 0: GOSUB 851 |
| 84 | +770 RETURN |
| 85 | + |
| 86 | +851 at 0, 0: a$ = "Dibujo Tridimensional": COLOR 9 |
| 87 | +852 PRINT a$: COLOR 10 |
| 88 | +857 a$ = "MOD=" + STR$(modo) + " " |
| 89 | +858 a$ = a$ + "PNTR=" |
| 90 | +859 a$ = a$ + STR$(po) + " " |
| 91 | +860 PRINT a$: COLOR 12 |
| 92 | +861 a$ = "STAT: cx=" + STR$(CX) |
| 93 | +862 a$ = a$ + " cy=" + STR$(CY) |
| 94 | +863 a$ = a$ + " cz=" + STR$(CZ) + " " |
| 95 | +864 PRINT a$: COLOR 13 |
| 96 | +865 a$ = "Draw=" |
| 97 | +866 IF (drau = 1) THEN a$ = a$ + "ON " |
| 98 | +867 IF (drau = 0) THEN a$ = a$ + "OFF" |
| 99 | +876 PRINT a$: COLOR 0 |
| 100 | +880 RETURN |
| 101 | +910 IF ((vx = 0) AND (vy = 0) AND (vz = 0)) THEN GOTO 930 |
| 102 | +920 RETURN |
| 103 | +930 vx = OVX: vy = OVY: vz = OVZ |
| 104 | +940 RETURN |
| 105 | + |
| 106 | +1000 REM graba en disco |
| 107 | +1001 INPUT "Nombre del archivo a grabar? "; ar$: ar$ = ar$ + ".dat" |
| 108 | +1010 OPEN ar$ FOR OUTPUT AS #1 |
| 109 | +1020 FOR i = 1 TO po |
| 110 | +1030 PRINT #1, x(i) |
| 111 | +1040 PRINT #1, y(i) |
| 112 | +1050 PRINT #1, z(i) |
| 113 | +1060 NEXT i |
| 114 | +1065 CLOSE #1 |
| 115 | +1066 GOSUB 100 |
| 116 | +1070 RETURN |
| 117 | + |
| 118 | +1100 REM lee del disco |
| 119 | +1101 INPUT "Nombre del archivo a leer? "; ar$: ar$ = ar$ + ".dat" |
| 120 | +1110 OPEN ar$ FOR INPUT AS #1: po = 1 |
| 121 | +1130 INPUT #1, x(po) |
| 122 | +1140 INPUT #1, y(po) |
| 123 | +1150 INPUT #1, z(po): po = po + 1 |
| 124 | +1160 IF NOT EOF(1) THEN 1130 |
| 125 | +1165 CLOSE #1 |
| 126 | +1166 GOSUB 100 |
| 127 | +1170 RETURN |
| 128 | + |
| 129 | +1200 REM deteccion de pen |
| 130 | +1210 IF PEN(0) THEN 1230 |
| 131 | +1220 pecom = 0: RETURN |
| 132 | +1230 px = PEN(4): py = PEN(5) |
| 133 | +1270 IF px < 50 THEN pecom = 1: GOTO 1300 |
| 134 | +1280 IF px < 110 THEN pecom = 2: GOTO 1300 |
| 135 | +1290 pecom = 3 |
| 136 | +1300 IF py < 50 THEN GOTO 1330 |
| 137 | +1310 IF py < 110 THEN pecom = pecom + 3: GOTO 1330 |
| 138 | +1320 pecom = pecom + 6 |
| 139 | +1330 RETURN |
| 140 | + |
| 141 | +1400 REM modo ver o dibujar |
| 142 | +1410 IF modo = 0 THEN modo = 1: RETURN |
| 143 | +1420 IF modo = 1 THEN modo = 0 |
| 144 | +1430 RETURN |
| 145 | + |
| 146 | +1500 REM ESFERA |
| 147 | +1501 CLS |
| 148 | +1502 INPUT "radio=(10)? "; RA |
| 149 | +1503 IF (RA = 0) THEN RA = 10 |
| 150 | +1504 INPUT "<z desde (0)? "; PHIA |
| 151 | +1506 INPUT "<z hasta (360)? "; PHIB |
| 152 | +1507 IF (PHIB = 0) THEN PHIB = 360 |
| 153 | +1508 INPUT "<x desde (0)? "; TETA |
| 154 | +1510 INPUT "<x hasta (360)? "; TETB: IF (TETA = 0) THEN LET TETA = 1 |
| 155 | +1511 IF (PHIA = 0) THEN PHIA = 1 |
| 156 | +1512 IF (TETB = 0) THEN TETB = 360 |
| 157 | +1513 TETA = TETA / 57.32 |
| 158 | +1514 TETB = TETB / 57.32 |
| 159 | +1516 PHIA = PHIA / 57.32 |
| 160 | +1518 PHIB = PHIB / 57.32 |
| 161 | +1520 SI = 1 / (RA * 6.28) |
| 162 | +1522 IF (PHIA > 6.28) THEN PHIA = 6.28 |
| 163 | +1524 IF (TETA > 6.28) THEN TETA = 6.28 |
| 164 | +1526 FOR i = PHIA TO PHIB STEP SI |
| 165 | +1528 sja = RA * SIN(90) * SIN(i) |
| 166 | +1530 SJ = (1 * TETB) / (sja * 6.28) |
| 167 | +1532 FOR J = TETA TO TETB STEP SJ |
| 168 | +1540 x(po) = RA * COS(J) * SIN(i) |
| 169 | +1542 y(po) = RA * SIN(J) * SIN(i) |
| 170 | +1544 z(po) = RA * COS(i) |
| 171 | +1546 x(i) = x(i) + CX |
| 172 | +1548 y(i) = y(i) + CY: z(i) = z(i) + CZ |
| 173 | +1550 po = po + 1 |
| 174 | +1560 NEXT J: NEXT i |
| 175 | +1575 GOSUB 100 |
| 176 | +1580 RETURN |
| 177 | + |
| 178 | +1600 REM LINEA |
| 179 | +1601 CLS |
| 180 | +1602 INPUT "origen x=? "; OX |
| 181 | +1604 INPUT "origen y=? "; OY |
| 182 | +1610 INPUT "origen z=? "; OZ |
| 183 | +1620 INPUT "destino x=? "; DX |
| 184 | +1625 INPUT "destino y=? "; DY |
| 185 | +1630 INPUT "destino z=? "; DZ |
| 186 | +1635 GOSUB 1700 |
| 187 | +1650 FOR i = 0 TO 10 STEP (10 / t) |
| 188 | +1660 x(po) = OX + i * ((DX - OX) / 10) |
| 189 | +1662 y(po) = OY + i * ((DY - OY) / 10) |
| 190 | +1663 z(po) = OZ + i * ((DZ - OZ) / 10) |
| 191 | +1664 po = po + 1 |
| 192 | +1670 NEXT i |
| 193 | +1675 IF AU = 1 THEN RETURN |
| 194 | +1684 GOSUB 100 |
| 195 | +1690 RETURN |
| 196 | + |
| 197 | +1700 REM USADO X LINEA |
| 198 | +1701 ta = ((DX - OX) ^ 2) |
| 199 | +1702 tb = ((DY - OY) ^ 2) |
| 200 | +1704 tc = ((DZ - OZ) ^ 2) |
| 201 | +1706 t = SQR(ta + tb + tc) |
| 202 | +1720 RETURN |
| 203 | + |
| 204 | +1800 REM CIRCULO |
| 205 | +1810 INPUT "radio (10)? "; RA |
| 206 | +1813 IF (RA = 0) THEN RA = 10 |
| 207 | +1814 INPUT "<x desde=(0)? "; TETA |
| 208 | +1820 INPUT "<x hasta=(360)? "; TETB |
| 209 | +1821 IF TETB = 0 THEN TETB = 360 |
| 210 | +1822 INPUT "cantidad=(1)"; ZZ: ES = 1 |
| 211 | +1823 IF (ZZ = 0) THEN ZZ = 1 |
| 212 | +1824 IF (ZZ > 1) THEN INPUT "espaciadas en=(2)? "; ES |
| 213 | +1825 IF ((ZZ > 1) AND (ES = 0)) THEN ES = 2 |
| 214 | +1830 INPUT "0=xy 1=xz 2=zy ? "; pl |
| 215 | +1834 TETA = TETA / 57.32 |
| 216 | +1835 TETB = TETB / 57.32 |
| 217 | +1836 SI = 1 / (RA * 6.28) |
| 218 | +1838 EZ = 0: ZZ = ZZ * ES |
| 219 | +1840 FOR i = TETA TO TETB STEP SI |
| 220 | +1850 a = RA * COS(i) |
| 221 | +1852 B = RA * SIN(i): C = EZ |
| 222 | +1860 IF (pl = 0) THEN GOTO 1900 |
| 223 | +1870 IF (pl= 1) THEN GOTO 1903 |
| 224 | +1880 IF (pl= 2) THEN GOTO 1906 |
| 225 | +1890 NEXT i |
| 226 | +1892 EZ = EZ + ES |
| 227 | +1893 IF (EZ < ZZ) THEN GOTO 1840 |
| 228 | +1895 GOSUB 100 |
| 229 | +1896 RETURN |
| 230 | +1900 x(po) = a + CX: y(po) = B + CY |
| 231 | +1901 z(po) = C + CZ |
| 232 | +1902 po = po + 1: GOTO 1890 |
| 233 | +1903 x(po) = a + CZ |
| 234 | +1904 z(po) = B + CZ: y(po) = C + CZ |
| 235 | +1905 po = po + 1: GOTO 1890 |
| 236 | +1906 z(po) = a + CZ |
| 237 | +1907 y(po) = B + CY: x(po) = C + CX |
| 238 | +1908 po = po + 1: GOTO 1890 |
| 239 | + |
| 240 | +2400 REM mover dibujo todo |
| 241 | +2405 CLS |
| 242 | +2410 INPUT "Eje ? "; e$ |
| 243 | +2420 INPUT "valor=? "; VA |
| 244 | +2430 FOR i = 1 TO po - 1 |
| 245 | +2440 IF (e$ = "x") THEN x(i) = x(i) + VA |
| 246 | +2450 IF (e$ = "y") THEN y(i) = y(i) + VA |
| 247 | +2460 IF (e$ = "z") THEN z(i) = z(i) + VA |
| 248 | +2470 NEXT i |
| 249 | +2480 GOSUB 100 |
| 250 | +2490 RETURN |
| 251 | + |
| 252 | +2500 REM FUNCION |
| 253 | +2505 po = 1: a = 1: B = 2: C = 2 |
| 254 | +2510 FOR x = -5 TO 5 STEP .2 |
| 255 | +2520 FOR y = -10 TO 10 STEP .2 |
| 256 | +2530 az = (x ^ 2) / (a ^ 2) |
| 257 | +2532 bz = (y ^ 2) / (B ^ 2) |
| 258 | +2534 z = (1 / C) * (az - bz) |
| 259 | +2540 x(po) = x: y(po) = y |
| 260 | +2542 z(po) = z: po = po + 1 |
| 261 | +2550 NEXT y: NEXT x |
| 262 | +2560 GOSUB 100 |
| 263 | +2570 RETURN |
| 264 | + |
| 265 | +2600 REM angulo hor t |
| 266 | +2610 INPUT "Angulo hor? "; t |
| 267 | +2620 t = t / 57.29 |
| 268 | +2630 GOSUB 100 |
| 269 | +2640 RETURN |
| 270 | + |
| 271 | +2700 REM angulo ver p |
| 272 | +2710 INPUT "Angulo ver? "; p |
| 273 | +2720 p = p / 57.29 |
| 274 | +2730 GOSUB 100 |
| 275 | +2740 RETURN |
| 276 | + |
| 277 | +2800 REM zoom |
| 278 | +2810 INPUT "Ingrese zoom? ", d |
| 279 | +2820 GOSUB 100 |
| 280 | +2830 RETURN |
| 281 | + |
| 282 | +5000 PRINT : PRINT "Ayuda programa Tridim (jmv 25.08.2001)" |
| 283 | +5010 PRINT "E=esfera L=linea C=circulo" |
| 284 | +5015 PRINT "N=distancia de vista (valor xyz+/-) " |
| 285 | +5020 PRINT "M=mover todo el dibujo F=grafica funcion " |
| 286 | +5030 PRINT "S=Modo mover o dibuja" |
| 287 | +5032 PRINT "A=angulo hor, B=angulo ver" |
| 288 | +5036 PRINT "O=lee data K=graba data" |
| 289 | +5035 PRINT "A=angulo de vision V=vantage " |
| 290 | +5040 PRINT "U=redraw B=borrar H=home " |
| 291 | +5050 PRINT "L=borrar puntos I=draw on/off" |
| 292 | +5065 pause |
| 293 | +5066 GOSUB 100 |
| 294 | +5100 RETURN |
| 295 | + |
| 296 | + |
| 297 | +' |
0 commit comments