home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
games
/
globe.zip
/
GLOBE.BAS
next >
Wrap
BASIC Source File
|
1983-08-26
|
4KB
|
113 lines
10 ''Real Time Perspective Image of Rotated Globe
20 '
30 'Original program by: Karl Koessel
40 '
50 'Animation by: Andrew Tuline
60 '
70 'This program has been modified from the original submitted to
80 'PCWORLD magazine. The initialization draws 5 different images
90 'and stores the array for each image to disk. This process requires
100 'about 15 minutes. The data file GLOBE.DAT is stored to disk.
110 'The program checks for this data file, and if not available, will
120 'create one. Once this file has been created, the program will load
130 'it into the corresponding arrays, and will display a realtime rotating
140 'globe in the Screen 2 mode. The globe occupies a small section of the
150 'screen and shows best results when used with an RGB monitor. This seems
160 'a good example of non-flickering graphics in Basic.
170 '
180 '
190 SCREEN 2:CLS:KEY OFF:DEFINT L,R,X-Z
200 DIM RC(11),A%(380),B%(380),C%(380),D%(380),E%(380)
210 ON ERROR GOTO 1100
220 OPEN "GLOBE.DAT" FOR INPUT AS #1
230 FOR I=0 TO 380:INPUT #1,A%(I):NEXT
240 FOR I=0 TO 380:INPUT #1,B%(I):NEXT
250 FOR I=0 TO 380:INPUT #1,C%(I):NEXT
260 FOR I=0 TO 380:INPUT #1,D%(I):NEXT
270 FOR I=0 TO 380:INPUT #1,E%(I):NEXT
275 CLS
280 PUT (320,100),A%,PSET
290 PUT (320,100),B%,PSET
300 PUT (320,100),C%,PSET
310 PUT (320,100),D%,PSET
320 PUT (320,100),E%,PSET
330 A$=INKEY$:IF A$="" THEN 280 ELSE END
340 OPEN "GLOBE.DAT" FOR OUTPUT AS #1
350 CX=CY:CZ=SX:SY=SZ:I=J:R=A:B=C:A1=B2:C1=C2
360 A3=B3:X=Y:XC=YC:LX=LY:B$=C$:RC=PI:LZ=ZS:Q=DR
370 FOR X=1 TO 11
380 RC(X)=(X-1)MOD 3+1
390 IF X>6 THEN RC(X)=(5-RC(X))MOD 3+1
400 NEXT
410 PI=3.14159265#
420 CF=PI/180#
430 GOSUB 1030
440 FOR YROT=120 TO 132 STEP 3
450 GOSUB 530
460 GET (265,73)-(373,126),A%
470 FOR I=0 TO 380:PRINT #1,A%(I):NEXT
480 NEXT
490 BEEP:SOUND 32000,1:BEEP:SOUND 32000,1:BEEP:SOUND 32000,1:BEEP:SOUND 32000,1:BEEP
500 CLOSE #1
510 A$=INKEY$:IF A$<>"" THEN 510
520 GOTO 220
530 CX=COS(CF*XROT+ATN(YOBS/ZOBS)):SX=SIN(CF*XROT+ATN(YOBS/ZOBS))
540 CY=COS(CF*YROT+ATN(XOBS/ZOBS)):SY=SIN(CF*YROT+ATN(XOBS/ZOBS))
550 CZ=COS(CF*ZROT):SZ=SIN(CF*ZROT)
560 ZOBS=SQR(XOBS^2+YOBS^2+ZOBS^2)
570 ZS=R^2/ZOBS
580 CLS
590 LOCATE 1,1:PRINT"Initializing GLOBE.DAT. 5 beeps will sound upon completion"
600 LOCATE 5,5:PRINT USING "Picture # of 5";(YROT-117)/3
610 FOR I=0 TO 3 STEP PI/12
620 RC=(I*12/PI+2)MOD 3+1
630 C$=STR$(RC)
640 C$="3"
650 FOR J=0 TO 2.0001*PI STEP PI/24
660 A=R*SIN(I)*SIN(J)
670 B=R*COS(J)
680 C=R*COS(I)*SIN(J)
690 GOSUB 860
700 GOSUB 960
710 NEXT
720 NEXT
730 FOR I=PI/12 TO 11*PI/12 STEP PI/12
740 RC=RC(I*12/PI)
750 C$=STR$(RC)
760 C$="3"
770 FOR J=0 TO 2.0001*PI STEP PI/24
780 A=R*SIN(I)*SIN(J)
790 B=R*COS(I)
800 C=R*SIN(I)*COS(J)
810 GOSUB 860
820 GOSUB 960
830 NEXT
840 NEXT
850 RETURN
860 A1=A*CY-C*SY
870 C1=A*SY+C*CY
880 B2=B*CX-C1*SX
890 C2=B*SX+C1*CX
900 A3=A1*CZ-B2*SZ
910 B3=A1*SZ+B2*CZ
920 DR=C2/(ZOBS-C2)+1
930 X=INT(A3*DR*ASP+XC)
940 Y=INT(B3*-DR+YC)
950 RETURN
960 IF C2<ZS OR LZ<ZS THEN B$="BC":GOTO 990
970 Q=(X<0)+(X>639)+(Y<0)+(Y>199)+(LX<0)+(LX>639)+(LY<0)+(LY>199)
980 IF Q+(J=0) THEN B$="BC" ELSE B$="C"
990 LX=X:LY=Y
1000 LZ=C2
1010 DRAW B$+C$+"M"+STR$(X)+","+STR$(Y)
1020 RETURN
1030 XC=320:YC=100
1040 XOBS=-9:YOBS=0:ZOBS=456
1050 XROT=37:ZROT=23:'YROT=-123
1060 R=25
1070 BCK=1:PAL=1
1080 ASP=2
1090 RETURN
1100 IF ERR<>53 THEN PRINT"error":END
1110 RESUME 340