10 SCREEN 1 'PC WORLD
20 CLS:KEY OFF 'Karl Koessel
30 PRINT " Perspective Image of Rotated Globe"
40 DEFINT L,R,X-Z
50 CX=CY:CZ=SX:SY=SZ:I=J:R=A:B=C:A1=B2:C1=C2 'Order variables to optimize
60 A3=B3:X=Y:XC=YC:LX=LY:B$=C$:RC=PI:LZ=ZS:Q=DR 'speed,about 3% faster
70 DIM RC(11)
80 FOR X=1 TO 11 'Prepare an array holding the
90 RC(X)=(X-1) MOD 3 +1 'colors of parallels; pattern
100 IF X>6 THEN RC(X)=(5-RC(X))MOD 3 +1 'reverses after equator which
110 NEXT 'is brown or white(palette 0 or 1)
120 PI=3.14159265#
130 CF=PI/180#
140 PRINT
150 INPUT "Want to see a sample run (y/n)";S$
160 S$=LEFT$(S$,1)
170 IF S$="y" OR S$="Y" THEN GOSUB 880:GOTO 380
180 PRINT
190 PRINT "enter screen location of center of globe";
200 INPUT "(e.g. 160,100) ";XC,YC
210 PRINT
220 PRINT "Enter relative coordinates of observer:";
230 PRINT "points left(-)/right(+) of x, below(-)/";
240 PRINT "above(+)y, and distance from the screen ";
250 INPUT "(e.g.-9,0,456) ";XOBS,YOBS,ZOBS
260 PRINT
270 PRINT "Enter parallel, meridian,& images's tilt";
280 INPUT "(e.g. 37,-123,23) ";XROT,YROT,ZROT
290 PRINT
300 PRINT "Enter sphere's radius"
310 INPUT "(e.g.100) ";R
320 PRINT
330 PRINT "Enter background color and palette"
340 INPUT "(e.g.1,1) ";BCK,PAL
350 PRINT
360 PRINT "Enter this screen's aspect ratio"
370 INPUT "(e.g.1.21875) ";ASP
380 CX=COS(CF*XROT+ATN(YOBS/ZOBS)):SX=SIN(CF*XROT+ATN(YOBS/ZOBS))
390 CY=COS(CF*YROT+ATN(XOBS/ZOBS)):SY=SIN(CF*YROT+ATN(XOBS/ZOBS))
400 CZ=COS(CF*ZROT):SZ=SIN(CF*ZROT)
410 ZOBS=SQR(XOBS^2+ZOBS^2) 'Observer's distance from the globe's center
420 ZS=R^2/ZOBS 'Can't see if point's Z coordinate < ZS
430 CLS:COLOR BCK,PAL
440 FOR I=0 TO 3 STEP PI/12 '24 lines of longitude around the poles
450 RC=(I*12/PI+2) MOD 3+1 'Prime meridian color=equator color
460 C$=STR$(RC)
470 FOR J=0 TO 2.0001*PI STEP PI/24 'Step along the meridian circle
480 A=R*SIN(I)*SIN(J)
490 B=R*COS(J)
500 C=R*COS(I)*SIN(J)
510 GOSUB 710
520 GOSUB 810
530 NEXT
540 NEXT
550 FOR I=PI/12 TO 11*PI/12 STEP PI/12 '11 lines of latitude between poles
560 RC=RC(I*12/PI)
570 C$=STR$(RC)
580 FOR J=0 TO 2.0001*PI STEP PI/24 'Step along the parallel circle
590 A=R*SIN(I)*SIN(J)
600 B=R*COS(I)
610 C=R*SIN(I)*COS(J)
620 GOSUB 710
630 GOSUB 810
640 NEXT
650 NEXT
660 LOCATE 1,1:PRINT "PC WORLD"
670 LINE (32,1)-(38,1),0:LINE(32,2)-(38,2),3
680 LINE (32,3)-(38,3),0:LINE (32,4)-(38,4),3
690 LINE (32,5)-(38,5),0
700 GOSUB 1160:GOTO 1190
710 A1=A*CY-C*SY 'Turn requested meridian to observer at 0,0,0
720 C1=A*SY+C*CY '(B1=B, so B is used below for B1)
730 B2=B*CX-C1*SX 'Turn requested parllel to observer at 0,0,0
740 C2=B*SX+C1*CX '(A2=A1, so A1 is used below for A2
750 A3=A1*CZ-B2*SZ 'Turn image on axis perpendicular to screen
760 B3=A1*SZ+B2*CZ '(C3=C2, so C2 is used below for C3)
770 DR=C2/(ZOBS-C2)+1 'Distance ratio for computing perspective
780 X=INT(A3*DR*ASP+XC) 'Screeen's x (with perspective & aspect ratios)
790 Y=INT(B3*-DR+YC) 'Screen's y (with perpspective, direction ratio)
800 RETURN '(z=c3=c2, so c2 is used below for z)
810 IF C2319)+(Y<0)+(Y>199)+(LX<0)+(LX>319) +(LY<0)+(LY>199) 'Off screen?
830 IF Q+(J=0) THEN B$="bc" ELSE B$="c" 'Draw clear if Q or J=0 (new circle
840 'LX=X:LY=Y 'lx,ly,lz are x,y,z of last reference point
850 LZ=C2
860 DRAW B$ + C$ + "M" + STR$(X) + "," + STR$(Y)
870 RETURN
880 XC=160:YC=100 'Data for sample run
890 XOBS=-9:YOBS=0:ZOBS=456
900 XROT=37:YROT=-123:ZROT=23
910 R=100
920 BCK=0:PAL=1
930 ASP=1.21875
940 LOCATE 5,1 'Screen for sample run
950 PRINT"Enter screen location of center of globe";
960 PRINT "(e.g. 160,100) ?";XC","YC
970 PRINT
980 PRINT "Enter relative coordinates of observer:";
990 PRINT "points left(-)/right(+)of x, below(-)/"
1000 PRINT "above(+)y, and distance from the screen";
1010 PRINT "(e.g. -9,0,456) ?";XOBS","YOBS","ZOBS
1020 PRINT
1030 PRINT "ENter parallel, meridian,& image's tilt";
1040 PRINT "(e.g.37,-123,23) ?";XROT","YROT","ZROT
1050 PRINT
1060 PRINT "Enter sphere's radius"
1070 PRINT "(e.g. 100) ?";R
1080 PRINT
1090 PRINT "Enter background color and palette"
1100 PRINT "(e.g.1,1) ?";BCK","PAL
1110 PRINT
1120 PRINT "Enter this screen's aspect ratio"
1130 PRINT "(e.g.1.21875) ?";ASP
1140 LOCATE 25,1
1150 PRINT "hit any key to continue";
1160 IF INKEY$>""THEN 1160
1170 IF INKEY$=""THEN 1170
1180 RETURN
1190 SCREEN 0,0,0,0:KEY ON
1200 END