Otro programa demo. En este caso el que acompaña al emulador ql2k, que es una versión ampliada de qlay2 pero que precisa registro.
El programa pide una serie de parámetros para dibujar la tierra, y pide tambien que colores usaremos para los meridianos y paralelos y para los continentes.
Código: Seleccionar todo
100 REMark =================================================================
110 DEFine PROCedure Init_Var
120 DIM A$(10)
130 DIM V$(10)
140 R=0
150 A=0
160 B=0
170 F=0
180 G=0
190 P=0
200 V$="":V=0
210 L=0
220 O=0
230 T=0
240 COC=0
250 COQ=0
260 J=0
270 K=0
280 H=0
290 M=0
300 W=0
310 X=0
320 Y=0
330 Z=0
340 XL=0
350 YL=0
360 N=0
370 END DEFine Init_Var
380 REMark ============================================================
390 DEFine PROCedure Init_Scr
400 WINDOW 512,256,0,0
410 PAPER 0
420 CLS
430 SCALE 200,-150,-100
440 END DEFine Init_Scr
450 REMark ============================================================
460 DEFine PROCedure Questions
470 OPEN #2,CON_
480 WINDOW #2,255,128,10,10
490 PAPER #2,7
500 BORDER #2,1,2
510 INK #2,0
520 CLS #2
530 INK #2,2:PRINT #2,"Quelques questions...":INK #2,0
540 INPUT #2,"Rayon (en faux pixel ):";R
550 INPUT #2,"Alpha (en degrs ):";A
560 INPUT #2,"Beta (en degrs ):";B
570 INPUT #2,"Phi (en degrs ):";F
580 INPUT #2,"Quadrillage (en degr):";G
590 INPUT #2,"Pas de prcision :";P
600 INPUT #2,"Transparence (Oui/Non):";V$
610 INPUT #2,"Couleur quadrillage :";COQ
620 INPUT #2,"Couleur continents :";COC
630 IF V$=="o" THEN V=2:ELSE V=1
640 END DEFine Questions
650 REMark ============================================================
660 DEFine PROCedure Contour
670 INK COQ
680 CIRCLE 0,0,R
690 END DEFine Contour
700 REMark ============================================================
710 DEFine PROCedure Meridiens
720 INK COQ
730 T=0
740 J=SIN(RAD(B))
750 K=COS(RAD(B))
760 H=SIN(RAD(A))
770 M=COS(RAD(A))
780 IF G=0 THEN RETurn
790 FOR O=G TO 360 STEP G
800 FOR L=90 TO -90 STEP -P
810 ctrl_affich
820 END FOR L
830 T=0
840 END FOR O
850 END DEFine Meridiens
860 REMark ============================================================
870 DEFine PROCedure paralleles
880 INK COQ
890 T=0
900 FOR L=-90+G TO 90-G STEP G
910 FOR O=0 TO 360 STEP P
920 ctrl_affich
930 END FOR O
940 T=0
950 END FOR L
960 END DEFine paralleles
970 REMark ============================================================
980 DEFine PROCedure Continents
990 RESTORE
1000 REPeat Loop
1010 INK COC:T=0
1020 READ N
1030 IF N=9999 THEN EXIT Loop
1040 T=0
1050 READ L,O
1060 ctrl_affich
1070 FOR i=2 TO N
1080 READ L,O:T=1
1090 ctrl_affich
1100 END FOR i
1110 END REPeat Loop
1120 END DEFine Continents
1130 REMark ===========================================================
1140 DEFine PROCedure ctrl_affich
1150 q=SIN(RAD(O-F))
1160 e=COS(RAD(O-F))
1170 u=COS(RAD(L))
1180 W=SIN(RAD(L))
1190 Z=R*(W*H*K-u*q*J+u*e*M*K)
1200 X=R*(u*q*K+W*H*J+u*e*M*J)
1210 Y=R*(W*M-u*e*H)
1220 IF V=1 AND Z<0 THEN T=0
1230 IF T=0 THEN XL=X:YL=Y:T=1:RETurn
1240 IF T=1 THEN LINE XL,YL TO X,Y:XL=X:YL=Y
1250 END DEFine ctrl_affich
1260 REMark ************************************************************
1270 REMark prog principal
1280 Init_Var
1290 Init_Scr
1300 Titre
1310 Questions
1320 Init_Scr
1330 Contour
1340 Meridiens
1350 paralleles
1360 Continents
1370 A$=INKEY$(-1)
1380 STOP
1390 REMark ======================================================================
1400 DEFine PROCedure Titre
1410 OVER 1:INK 7,0,1
1420 FOR i=0 TO 1 STEP .1
1430 CIRCLE 0,0,80,i,0:CIRCLE 0,0,80,i,PI/2
1440 END FOR i
1450 FOR i=0 TO 3
1460 INK 2+2*(i=3)
1470 CSIZE 3,1
1480 CURSOR 300+i,100+i:PRINT "3D WORLD"
1490 END FOR i
1500 CSIZE 0,0
1510 AT 1,45:PRINT "JVMSOFTWARE et QLCF prsentent:"
1520 AT 12,67:PRINT "Version 2.00"
1530 END DEFine Titre
1540 REMark ========================================================================
1550 REMark _________________________________________________________________________
1560 REMark (Je prcise pour les martiens que c'est la Terre...)
1570 REMark =========================================================================
1580 REMark Premire partie, donnes pour les contours des diffrents continents.
1590 REMark _________________________________________________________________________
1600 REMark
1610 REMark EUROPE
1620 REMark
1630 DATA 217,41,29,42,35,41,38,42.5,42.3,46,37,48,39,46.5,35,46,37,44.3,34,45.5
1640 DATA 32,46.2,33.5,47,31,42.5,27,41,29,40.8,23,38,24,36.5,22.8,40.5,19.5,42,19.5
1650 DATA 45.7,13.7,45.5,12.3,44.4,12.3,43.6,13.6,42.5,14.1,40,18.5,40.5,17,39.7
1660 DATA 16.5,39,17.2,38,15.6,38,12.5,36.6,15,38.9,16.1,40,15.7,41.3,13
1670 DATA 43,10.5,44.3,8.9,43.2,6.2,43.5,4,42.7,3,41.8,3.3,39.5,-.4,38.7,.3,36.6
1680 DATA -2.1,36.5,-4.8,36,-5.4,37.1,-6.7,37,-8.8,38.6,-9.4,41.2,-8.6
1690 DATA 43.1,-9.3,43.7,-7.7,43.3,-1.5
1700 DATA 46.1,-1.2,47.3,-2.5,48,-4.7,48.6,-4.7,48.8,-3.1
1710 DATA 48.7,-1.7,49.8,-2,49.8,-1.3,49.4,-1.1,49.3,-.1,49.7,.2,50.2,1.5,50.9
1720 DATA 1.6,51.4,3.6,53.3,4.7,54,8.3,57,8.1,57.6,10.7,56.4,11.9,54.5,10,54,14.2
1730 DATA 55,20,59,22,60,30,60.6,28,60,22,63,21,65.6,26,66,22,61,17,60,19,56,16
1740 DATA 55.4,13,59,10.3,58,7.6,58.5,6,62.5,5.5,64,10,70.3,19,71.2,27,67.8,41.5
1750 REMark
1760 REMark ASIE
1770 REMark
1780 DATA 66.5,39,67.2,33,64.5,35,64,40,68.2,44,69,67,72,70,77,112,74,110,72,130,70
1790 DATA 175,67,190,66,177,63,180,60,170,60,163,55,162,51,157,57,156,62,163,62
1800 DATA 157,59,153,59,143,55,135,54,141,48,140,39,128,35,129.5,34,126,39,125.5
1810 DATA 41,121,38.5,118,30,122,23,117,21,110,22,108,19,105.5,14.5,109,11.5,109,8
1820 DATA 105,13,100.5,9,99,5,103.5,1,104,4,101,9,98,17,97,23,92,15,80,10,80,8,77
1830 DATA 12,74.5,21,72,25,67,25,56,30,50,29.5,49,24,53,25,56,24,56,23,60,17,56,12.5
1840 REMark
1850 REMark AFRIQUE
1860 REMark
1870 DATA 44,28,35,28,33,15,40,10.5,45,12,51.4,4,47.7,-5,39,-16,41,-20,35,-25,35,-26
1880 DATA 33,-29,32,-34,26,-35,20,-18,12
1890 DATA -11,14,-1,9,3,10,4.6,8.4,4.3,5.9,6.5,4.3,4.8,-2,4.6,-7.7,7.8,-12.9,9.6
1900 DATA -13.4,12.4,-16.7,14.9,-17.6,17.2,-16.1,21.3,-17.2,28,-12.9,30.3,-9.5,31
1910 DATA -9.8,32,-9.8,33.3,-8.3
1920 DATA 33.9,-6.9,35.8,-6,35.9,-5.4,35.2,-4.7,35,-2,36.4,1,37.3,10.2
1930 DATA 36.7,10.4,37,11,36.1,10.5,35.2,11.1,34,10,32.8,12.5,32.94,13.2,32.4,15.3
1940 DATA 31.5,15.6,30,19,31,20,32,19.7,33,22,31
1950 DATA 29,31.6,31,31.2,33.5,37,36,37,28,40,26,41,29
1960 DATA 19,58.5,-5,58.2,-1.8,56,-3.3,56,-2,53,.5,53,1.6
1970 DATA 52.2,1.7,51.3,.8,51.3,1.5,50.9,1,50,-5.8,51.4,-3.7
1980 DATA 51.7,-5,53.3,-4.5,53.3,-3,55,-3.5,54.7,-5,57.5,-6.5,58.5,-5
1990 REMark
2000 REMark LES ILES.
2010 REMark
2020 DATA 5,55.3,-6.5,54.3,-10,51.4,-10,52.2,-6.3,55.3,-6.5
2030 DATA 7,66.5,-22.5,65.4,-24.5,66.6,-16,65,-13.5,63,-19,64,-22,66.5,-22.5
2040 DATA 10,43,9.4,42.4,8.5,41.5,8.8,40.9,9.8,39.1,9.7,38.9,8.4,40.8,8.4,41.3,9.2
2050 DATA 42.1,9.6,43,9.4
2060 DATA 11,40,3.1,39.9,3.1,39.8,3.2,39.9,3.3,39.8,3.5,39.3,3.1,39.4,2.9,39.6,2.8,39.5,2.7,39.4,2.6,40,3.1
2070 DATA 6,40.1,4,40,4.1,39.9,4.1,39.9,3.9,40,3.9,40,4
2080 DATA 5,39.1,1.7,39,1.8,38.9,1.6,39,1.5,39.1,1.7
2090 DATA 6,-13,49,-17,44,-25,44,-25,47,-15,50.5,-13,49
2100 DATA 6,28.2,-15.6,28.2,-15.4,27.8,-15.3,27.6,-15.7,27.9,-15.8,28.2,-15.6,7,29.5,-13.3,29,-13.3,28.8,-14,28,-14.5,28.3,-13.8,29,-13.7,29.5,-13.3
2110 DATA 4,28.6,-16.1,28,-16.7,28.4,-17,28.6,-16.1
2120 DATA 12,60,-44,65,-40,70,-22,82,-15,83.6,-30,78.5,-73,76,-68,75.6,-59,70,-51,66
2130 DATA -53.5,61,-48,60,-44
2140 DATA 5,83,-45,81,-120,78,-105,81,-75,83,-45,6,78,-75,67,-60,60,-60,64,-75,75,-90,78,-75,5,75,-105,73,-90,70,-105,73,-120,75,-105,7,77,70,76,60,71,50,70,51,75,60,76,70,77,70
2150 REMark
2160 REMark AMERIQUE
2170 REMark
2180 DATA 84,63,-77,52,-56,50,-65,46,-64,43.7,-70.4,41.5,-70.7,40.6,-74,37,-76
2190 DATA 35.2,-75.7,31,-81.6,27,-80,25,-80.5,28,-82.7,29,-82.5,30,-84,30.3,-89,29
2200 DATA -90,29.7,-94,27,-97.5,22,-97.7,19,-96,18.4,-94,19,-91,21,-90,21.6,-87,16
2210 DATA -89,15.6,-83,10.5,-83.5,9,-81.5,9.7,-79,8,-77,11,-75,12,-71,10.6,-63,4
2220 DATA -52,0,-50,-6,-34,-12,-39,-22,-41,-25,-48,-28,-48,-41,-63,-51,-69,-55,-65
2230 DATA -55,-70,-50,-76,-37,-74,-18,-70,-6,-81,0,-81,6.6,-77.5,9,-79,7,-81,9.5
2240 DATA -85,13,-88,14,-91.5,16.2,-95,15.7,-96.6,19.6,-106,22,-105.7,29,-112.4
2250 DATA 31.3,-113,31.6,-115,30,-114.6,23,-109.5,25,-112.3,30,-115.9,34,-118.5
2260 DATA 34.5,-120.7,39,-124,43,-124.5,48.5,-124.5,59,-138,61,-148,54,-165,59
2270 DATA -158,62,-166,68,-167,71,-157,68,-110,70,-82,60,-95,54,-80,63,-77
2280 DATA 18,22,-85,23,-83,23,-80.5,20,-74,20,-70,18.5,-68,18.5,-71,17.5,-71.5,18
2290 DATA -72,18.5,-74.5,19,-74.5,19,-72.5,20,-74,20,-77.5,20.5,-77,22.5,-81.5,22
2300 DATA -84,22,-85
2310 DATA 5,18.2,-78.2,18.4,-78,18,-76.2,17.9,-77.8,18.2,-78.2,5,18.5,-67,18.5,-65.5
2320 DATA 18,-65,18,-67,18.5,-67
2330 REMark
2340 REMark PACIFIQUE
2350 REMark
2360 DATA 34,-10.5,142.4,-17.5,141,-15,135.5,-12,137,-11,132,-15,129,-14,127,-17.5,122,-19,122,-20
2370 DATA 120,-22,114,-26,113,-32,116,-34.5,115,-35.2,118,-31.5,130,-32.5,133.5,-35
2380 DATA 135.5,-33,137.8,-35.2,137.5,-38,140.4,-39,143.4,-37.8,145,-39.2,146
2390 DATA -37.5,150,-34,151,-32.7,152.7,-29,153.6,-25.6,153,-20,148.4,-18.8,146.3
2400 DATA -14.5,144.7,-14.7,144,-10.5,142.4
2410 DATA 4,-42,144.9,-42,148,-44,146.5,-42,144.9
2420 DATA 29,-63,-56,-64,-60,-66,-65,-73,-75,-73,-85,-73,-100,-75,-100,-73,-125
2430 DATA -75,-137,-78,-165,-77.6,164,-72,170,-68,155,-66,135,-66,115,-66,90,-69.5
2440 DATA 75,-68,70,-66,55,-69,40,-70,20,-70,0,-71,-10,-74,-20,-78,-35,-75,-60,-67
2450 DATA -61,-64.3,-69,-63,-55
2460 DATA 7,9.7,80,7,82,6.5,81.8,6.3,80.5,6.4,80,8,79.7,9.7,80
2470 DATA 19,21,122,18,122.5,16.5,122.5,15,121.5,14,122,13.5,125,7,126,5,125,7,123,5,122,9,125,8,123,11,121,10,124,13,122,8,117,12,120,18.5,121,18,122.5
2480 DATA 5,25.5,121.5,23.5,120,22,121,25,122,25.5,121.5
2490 DATA 6,20,108.6,20,110.3,19.8,110.3,18.3,109.9,18.8,108,20,108.6
2500 DATA 22,45.5,141.8,43.3,145.7,42,143,42.6,141.6,40.6,140,38.2,139.6,37,136.9
2510 DATA 35.6,135.7,35.6,133,34,130.9,32.9,132,31.4,131.3,31.2,130.2,33.3,129.7
2520 DATA 34,130.9,34.5,135,33.5,135.7,36,140.6,39.8,142,42.5,139.7,43.5,141.4,45.5,141.8
2530 DATA 11,6,95,1.7,98.8,-3.2,101.6,-5.9,105.7,-6.6,114.2,-8.6,127
2540 DATA -7.1,105.6,-2.9,105.9,.4,103.6,5,97.5,6,95
2550 DATA 4,2,128,1.5,129,-1,128,2,128,6,-3,126,-4,131,-3,130.5,-3,128,-4,126.5,-3,126
2560 DATA 13,7,117.5,2.5,111,1.5,111,2,109.5,1,109,-3,110,-4,114.5,-4,116,1,117.5,1,119,4,117.5,5,119,7,117.5
2570 DATA 17,2,125,1,124,1.5,121,0,119.5,-3,118.5,-6,119,-6,120.5,-3,120.5,-5.5,122,-5.5,123,-4,123,-2,121.5,-.5,123.5,-1,121,.5,120.5,.5,124.5,2,125
2580 DATA 12,0,130,-2,134,-2.5,141,-6.5,148,-6.8,146.8,-10.7,151
2590 DATA -7.7,144.3,-9.3,143,-8,138.4,-5.4,138.1,-4,133.1,0,130,14,-34.5,172.7
2600 DATA -36.7,175.9,-37.5,176,-38,177.3,-37.4,178.5,-41.6,175.5,-40.6,172.5
2610 DATA -42.8,171,-46,166.2,-46.7,169.4,-40.2,175.3,-39.3,174,-37.7,174.8,-34.5
2620 DATA 172.7,9999