' "TRACKER9" Satellite tracking program with graphics ' --------- ' 'Version 1.01 : Last mod 7th May 1990 by ACH ' '(C) 1988 Mr J R Miller G3RUH '(C) 1988 Mr A C Hewat G8NTH ' 'V 1.00: First version ; original concept with limited graphics etc. 'V 1.01: Changes to routines to improve acuracy. DEFDBL a-z CLEAR,55000&,6000& DIM C1,C2,C3,C4,C5,C6,C7,C8,C9,C10,C11,C12,C13(4),SatName$(4),stepSize(4),ObjectShape$(4) DIM days&(12) Main: predictionTime = 0 lastChoise = 1 menuItem = 1 oldSatellite = 1 oldChoise1 = 1 GOSUB ScreenSetup GOSUB Ephemeris GOSUB Constants GOSUB TodayDate FOR satellite = 1 TO 4 GOSUB ObjectShape NEXT satellite OPEN "scrn:" FOR OUTPUT AS #2 LOCATE 27,1: PRINT SPACE$(78): PRINT SPACE$(78): PRINT SPACE$(78): PRINT SPACE$(78); LOCATE 28,1 PRINT "Satellite Lat Long Height MA EL AZ Range Rate Mode Illm Squint"; Quit = -1 realTimeFlag = -1 WHILE Quit FOR satellite = 1 TO 4 GOSUB DisplayTimePos GOSUB SatelliteConstants GOSUB CalcthenDisplay GOSUB DisplaySatInfo NEXT WEND MENU OFF: MOUSE OFF: TIMER OFF WINDOW CLOSE 2: WINDOW CLOSE 3 SCREEN CLOSE 2 CLOSE #2 MENU RESET CLS END DisplayTimePos: csrY = CSRLIN: csrX = POS(0) LOCATE 26,70 PRINT LEFT$(TIME$,5);" UTC"; LOCATE csrY,csrX RETURN CalcthenDisplay: GOSUB TimeNow TN = DY + (hour+minutes/60)/24 GOSUB SatVec GOSUB RangeVec GOSUB SunVec GOSUB Satpos LOCATE 27,1: PRINT " "; RETURN DisplaySatInfo: satLat1 = CINT(satLat1): satLong1 = CINT(satLong1): ssrr = FNRN(ssrr-RE): SQ = FNRN(SQ) EL = CINT(EL): AZ = CINT(AZ): R = FNRN(R): M = INT(M*128/pi): ILL = FNRN(100*ILL) IF satellite = 2 THEN mode$ = "B" ELSEIF satellite = 4 THEN IF M > 0 AND M < 110 THEN mode$ = "B" IF M > 109 AND M < 145 THEN mode$ = "JL" IF M > 144 AND M < 150 THEN mode$ = "B Bcn" IF M > 144 AND M < 147 THEN mode$ = "S Bcn" IF M > 146 AND M < 160 THEN mode$ = "S" IF M > 149 AND M < 255 THEN mode$ = "B" IF M < 35 OR M > 225 THEN mode$ = "B Omi" ELSE mode$ = " " END IF LOCATE 29,1 PRINT SatName$(satellite);TAB(12);satLat1;TAB(17);satLong1;TAB(23); PRINT USING "#####";ssrr; PRINT TAB(31) USING "###";M; PRINT " "; IF EL > -3 THEN PRINT TAB(35);EL;TAB(39);AZ;TAB(45); PRINT USING "#####";R; ' PRINT TAB(52);RR; PRINT TAB(58);mode$;TAB(65);ILL;TAB(70);SQ; ELSE PRINT TAB(35)" "; END IF RETURN CheckMenu: menuId = MENU(0) menuItem = MENU(1) ON menuId GOTO Project,SatelliteChoise,Predictions,Display RETURN Project: MENU 1,lastChoise,1 IF menuItem = 3 AND echo = 1 THEN Jump MENU 1,menuItem,2 Jump: IF menuItem = 3 THEN GOSUB EchoSet IF menuItem = 4 THEN Quit = 0 lastChoise = menuItem RETURN SatelliteChoise: MENU 2,oldSatellite,1 whichSatellite = menuItem MENU 2,whichSatellite,2 oldSatellite = whichSatellite RETURN SatelliteConstants: YE = C1(satellite) 'Epoch year TE = C2(satellite) 'Epoch time IN = C3(satellite) 'Inclination RA = C4(satellite) 'R.A.A.N. EC = C5(satellite) 'Eccentricity WP = C6(satellite) 'Arg of perigee MA = C7(satellite) 'Mean anomaly MM = C8(satellite) 'Mean motion M2 = C9(satellite) 'Decay rate RV = C10(satellite) 'Epoch rev a = C11(satellite) 'Semi-major axis. 0 if not known ALAT = C12(satellite) 'Sat att, deg. 0 = in plain, + = below ALON = C13(satellite) 'Sat att, deg CCW from SMA dir. 180 = Normal IF a = 0 THEN a = (8681668.016000001#/MM)^(2/3) RA = RAD*RA MA = RAD*MA IN = RAD*IN MM = MM*2*pi WP = RAD*WP M2 = M2*2*pi ALAT = RAD*ALAT ALON = RAD*ALON B = a*SQR(1-EC*EC) SI = SIN(IN): CI = COS(IN) PC = RE*a/(B*B): PC = 1.5*J2*PC*PC*MM QD = -PC*CI WD = PC*(5*CI*CI-1)/2 DC = (M2/MM)/3 TEG = FNDO(YE)-FNDO(YG) + TE GHAE = RAD*GO + TEG*WE MRSE = RAD*GO + TEG*WW + pi MASE = RAD*(MASO + MASD*TEG) RETURN SatVec: T = (FNDO(YR)-FNDO(YE)) + (TN-TE) DT = DC*T/2 KD = 1-4*DT KDP = 1+7*DT M = MA + MM*T*(1+3*DT) DR = INT(M/(2*pi)) M = M - DR*2*pi RN = RV + DR EA = M Loop: C = COS(EA) S = SIN(EA) DNOM = 1-EC*C DE = (EA - EC*S - M)/DNOM EA = EA - DE IF ABS(DE) > .002 THEN GOTO Loop C = COS(EA) S = SIN(EA) RGC = a*(1-EC*C)*KD SX = a*(C-EC)*KD: TA = -COS(ALAT): XA = TA*COS(ALON) SY = B*S*KD: YA = TA*SIN(ALON): ZA = -SIN(ALAT) W = WP + WD*T*KDP: C = COS(W): S = SIN(W) X = SX*C - SY*S: TA = XA: XA = TA*C - YA*S Y = SX*S + SY*C: YA = TA*S + YA*C z = Y*SI: TA = ZA: ZA = YA*SI+TA*CI: ANTZ = ZA Y = Y*CI: YA = YA*CI-TA*SI: ANTY = YA ANTX = XA RAAN = RA + QD*T*KDP GHAA = GHAE + WE*T Q = RAAN - GHAA C = COS(Q): S = SIN(Q) SX = X*C - Y*S: TA = XA: XA = TA*C - YA*S SY = X*S + Y*C: YA = TA*S + YA*C SZ = z C = COS(RAAN): S = SIN(RAAN) SATX = X*C - Y*S: TA = ANTX: ANTX = TA*C - ANTY*S SATY = X*S + Y*C: ANTY = TA*S + ANTY*C SATZ = z NMX = S*SI: NMY = -C*SI: NMZ = CI RETURN SunVec: MAS = MASE + RAD*(MASD*T) TAS = MRSE + WW*T + EQC1*SIN(MAS) + EQC2*SIN(2*MAS) + EQC3*SIN(3*MAS) C = COS(TAS): S = SIN(TAS) SUNX = C: SUNY = S*CNS: SUNZ = S*SNS CSA = ANTX*SUNX + ANTY*SUNY + ANTZ*SUNZ ILL = SQR(1-CSA*CSA) SATX = SATX/RGC: SATY = SATY/RGC: SATZ = SATZ/RGC CUA = -(SATX*SUNX + SATY*SUNY + SATZ*SUNZ) UMD = RGC*SQR(1-CUA*CUA)/RE SEL = (SUNX*NMX + SUNY*NMY + SUNZ*NMZ) SEL = ATN(SEL/SQR(-SEL*SEL+1)) IF CUA >= 0 THEN ECL$ = " +" ELSE ECL$ = " -" IF UMD <= 1 AND CUA >= 0 THEN ECL$ = " ECL" RETURN RangeVec: RX = SX - OX: RY = SY - OY: RZ = SZ - OZ R = SQR(RX*RX + RY*RY + RZ*RZ) RX = RX/R: RY = RY/R: RZ = RZ/R U = RX*UX + RY*UY + RZ*UZ E = RX*EX + RY*EY + RZ*EZ N = RX*NX + RY*NY + RZ*NZ AZ = DEG*(ATN(E/N)) IF N < 0 THEN AZ = AZ + 180 IF AZ < 0 THEN AZ = AZ + 360 EL = DEG*(ATN(U/SQR(-U*U+1))) srr = SQR(SX*SX+SY*SY) ssrr = SQR(SX*SX+SY*SY+SZ*SZ) szrr = SZ/ssrr: syr = SY/srr satLat1 = DEG*(ATN(szrr/SQR(-szrr*szrr+1))) satLong1 = DEG*(ATN(syr/SQR(-syr*syr+1))) SQ = -(XA*RX + YA*RY + ZA*RZ) SQ = DEG*(-ATN(SQ/SQR(-SQ*SQ+1))+1.5708) RETURN Satpos: IF SX < 0 AND SY > 0 THEN satLong1 = 180 - satLong1 IF SX < 0 AND SY < 0 THEN satLong1 = -(180+satLong1) satPsnX = 1.75*satLong1+309 satPsnY = 117-1.33*satLat1 satPsnX = CINT(satPsnX) satPsnY = CINT(satPsnY) OBJECT.OFF satellite IF predictionTime > 0 THEN IF satLat1 >= -60 THEN PSET(satPsnX+5,satPsnY+5),3 OBJECT.X satellite,satPsnX: OBJECT.Y satellite,satPsnY IF satLat1 >= -60 THEN OBJECT.ON satellite RETURN TodayDate: day = VAL(MID$(DATE$,4,2)) month = VAL(LEFT$(DATE$,2)) YR = VAL(RIGHT$(DATE$,4)) DY = day + days&(month): IF month > 2 THEN DY = DY + (INT(YR/4)-INT((YR-1)/4)) RETURN TimeNow: hour = VAL(LEFT$(TIME$,2)) minutes = VAL(MID$(TIME$,4,2)) RETURN ScreenSetup: LOCATE 10,20 PRINT "Setting up map display and arrays, please wait!" GOSUB MainPicture MENU ON MENU GOSUB CheckMenu: MENU ON MENU 1,0,1,"Project " MENU 1,1,2," Map Display " MENU 1,2,1," " MENU 1,3,1," Serial Echo " MENU 1,4,1," Quit " MENU 2,0,1," " MENU 3,0,1," " MENU 4,0,1," " MENU 5,0,1," " MENU 6,0,1," " RETURN ObjectShape: saveId = WINDOW(1) WINDOW 2 OPEN objShape$(satellite) FOR INPUT AS satellite OBJECT.SHAPE satellite,INPUT$(LOF(satellite),satellite) CLOSE satellite OBJECT.CLIP (0,0)-(631,199) WINDOW saveId RETURN Constants: days&(0)=0:days&(1)=0:days(2)=31:days&(3)=59:days&(4)=90:days&(5)=120:days&(6)=151 days&(7)=181:days&(8)=212:days&(9)=243:days&(10)=273:days&(11)=304:days&(12)=334 LA = 51.268333# ' Latitude of QTH, + north, - south LO = -.563333 ' Longitude of QTH, + deg east, - deg west HT = 35 ' Height of QTH above mean sea level pi = 3.141592654# DEG = 180/pi RAD = 1/DEG DEF FNRN(X) = INT(X+.5) LA = RAD*LA LO = RAD*LO HT = HT/1000 CL = COS(LA) SL = SIN(LA) CO = COS(LO) SO = SIN(LO) RE = 6378.14 FL = 1/298.256 RP = RE*(1-FL) XX = RE*RE ZZ = RP*RP D = SQR(XX*CL*CL + ZZ*SL*SL) RX = XX/D + HT RZ = ZZ/D + HT UX = CL*CO: EX = -SO: NX = -SL*CO UY = CL*SO: EY = CO: NY = -SL*SO UZ = SL: EZ = 0: NZ = CL OX = RX*UX: OY = RX*UY: OZ = RZ*UZ YG = 1988: GO = 98.8897 MASO = 356.1611: MASD = .9856002671# INS = RAD*23.4408: CNS = COS(INS): SNS = SIN(INS) EQC1 = .03342715297#: EQC2 = .00034917#: EQC3 = .00000506# YM = 365.25 YT = 365.2421938# DEF FNDO(Y) = INT((Y-1)*YM) WW = 2*pi/YT WE = 2*pi + WW J2 = .00108263# RETURN Ephemeris: SatName$(1)="OSCAR 10s ": SatName$(2)="OSCAR 11 " stepSize(1)=20: stepSize(2)=5 objShape$(1)="oscar10": objShape$(2)="oscar11" C1(1)=1989: C1(2)=1990 C2(1)=330.318#: C2(2)=86.14190031# C3(1)=25.9: C3(2)=97.963 C4(1)=232: C4(2)=141.366 C5(1)=.6: C5(2)=.0012026 C6(1)=96: C6(2)=141.7015 C7(1)=331: C7(2)=218.5388 C8(1)=2.0588#: C8(2)=14.65066797#: ' AO 10 ALAT,ALONG C9(1)=0: C9(2)=.00002602#: ' C10(1)=4855: C10(2)=32395: ' Jan Apr C11(1)=0: C11(2)=0: ' C12(1)=-11: C12(2)=0: '-17 -11 C13(1)=28: C13(2)=180: ' 38 28 SatName$(3)="OSCAR 13s ": SatName$(4)="OSCAR 14 " stepSize(3)=20: stepSize(4)=5 objShape$(3)="oscar13": objShape$(4)="oscar14" C1(3)=1989: C1(4)=1990 C2(3)=324.328282#: C2(4)=29.63555# C3(3)=57.12: C3(4)=98.71 C4(3)=181.5: C4(4)=106.09 C5(3)=.6831: C5(4)=.0011 C6(3)=215.48: C6(4)=195.36 C7(3)=0: C7(4)=164.31 C8(3)=2.097: C8(4)=14.28476# C9(3)=0: C9(4)=.000021# C10(3)=1099: C10(4)=108 C11(3)=0: C11(4)=0 C12(3)=-19.8: C12(4)=0 C13(3)=319.9: C13(4)=180 'SatName$(5)="OSCAR 15 ": SatName$(6)="OSCAR 16 " 'stepSize(5)=5: stepSize(6)=5 'objShape$(5)="oscar15": objShape$(6)="oscar16" 'C1(5)=1990: C1(6)=1990 'C2(5)=38.88408#: C2(6)=27.74407# 'C3(5)=98.72: C3(6)=98.72 'C4(5)=115.32: C4(6)=104.21 'C5(5)=.001#: C5(6)=.0011 'C6(5)=115.32: C6(6)=201.49 'C7(5)=167.25: C7(6)=158.44 'C8(5)=14.28261#: C8(6)=14.28554# 'C9(5)=.0000026#: C9(6)=.00000037# 'C10(5)=240: C10(6)=81 'C11(5)=0: C11(6)=0 'C12(5)=0: C12(6)=0 'C13(5)=180: C13(6)=180 'SatName$(7)="OSCAR 17 ": SatName$(8)="OSCAR 18 " 'stepSize(7)=5: stepSize(8)=5 'objShape$(7)="oscar17": objShape$(8)="oscar18" 'C1(7)=1990: C1(8)=1990 'C2(7)=29.63506#: C2(8)=24.31186# 'C3(7)=98.72: C3(8)=98.72 'C4(7)=106.09: C4(8)=100.78 'C5(7)=.0011: C5(8)=.0011 'C6(7)=194.93: C6(8)=214.18 'C7(7)=165.28: C7(8)=145.77 'C8(7)=14.2859#: C8(8)=14.2870565# 'C9(7)=.0000088#: C9(8)=.00013144# 'C10(7)=108: C10(8)=32 'C11(7)=0: C11(8)=0 'C12(7)=0: C12(8)=0 'C13(7)=180: C13(8)=180 'SatName$(9)="OSCAR 19 ": SatName$(10)="OSCAR 20 " 'stepSize(9)=5: stepSize(10)=5 'objShape$(9)="oscar19": objShape$(10)="oscar20" 'C1(9)=1990: C1(10)=1990 'C2(9)=30.68451#: C2(10)=85.20385752# 'C3(9)=98.72: C3(10)=99.052 'C4(9)=107.15: C4(10)=147.3503 'C5(9)=.0012: C5(10)=.0540825 'C6(9)=193.47: C6(10)=236.3713 'C7(9)=166.61: C7(10)=118.4676 'C8(9)=14.28775#: C8(10)=12.83121017# 'C9(9)=.0000074#: C9(10)=.00000096# 'C10(9)=123: C10(10)=610 'C11(9)=0: C11(10)=0 'C12(9)=0: C12(10)=0 'C13(9)=180: C13(10)=180 RETURN RETURN MainPicture: DIM bPlane&(5), cTabWork%(32), cTabSave%(32) DECLARE FUNCTION xOpen& LIBRARY DECLARE FUNCTION xRead& LIBRARY DECLARE FUNCTION xWrite& LIBRARY DECLARE FUNCTION AllocMem&() LIBRARY LIBRARY "dos.library" LIBRARY "exec.library" LIBRARY "graphics.library" GetNames: ACBMname$ = "World6" ' World1 for political map loadError$ = "" GOSUB LoadACBM IF loadError$ <> "" THEN GOTO Mcleanup Mcleanup: Mcleanup2: LIBRARY CLOSE IF loadError$ <> "" THEN PRINT loadError$ RETURN LoadACBM: f$ = ACBMname$ fHandle& = 0 mybuf& = 0 foundBMHD = 0 foundCMAP = 0 foundCAMG = 0 foundCCRT = 0 foundABIT = 0 filename$ = f$ + CHR$(0) fHandle& = xOpen&(SADD(filename$),1005) IF fHandle& = 0 THEN loadError$ = "Can't open/find pic file" GOTO Lcleanup END IF ClearPublic& = 65537& mybufsize& = 360 mybuf& = AllocMem&(mybufsize&,ClearPublic&) IF mybuf& = 0 THEN loadError$ = "Can't alloc buffer" GOTO Lcleanup END IF inbuf& = mybuf& cbuf& = mybuf& + 120 ctab& = mybuf& + 240 rLen& = xRead&(fHandle&,inbuf&,12) tt$ = "" FOR kk = 8 TO 11 tt% = PEEK(inbuf& + kk) tt$ = tt$ + CHR$(tt%) NEXT IF tt$ <> "ACBM" THEN loadError$ = "Not an ACBM pic file" GOTO Lcleanup END IF ChunkLoop: rLen& = xRead&(fHandle&,inbuf&,8) icLen& = PEEKL(inbuf& + 4) tt$ = "" FOR kk = 0 TO 3 tt% = PEEK(inbuf& + kk) tt$ = tt$ + CHR$(tt%) NEXT IF tt$ = "BMHD" THEN foundBMHD = 1 rLen& = xRead&(fHandle&,inbuf&,icLen&) iWidth% = PEEKW(inbuf&) iHeight% = PEEKW(inbuf& + 2) iDepth% = PEEK(inbuf& + 8) iCompr% = PEEK(inbuf& + 10) scrWidth% = PEEKW(inbuf& + 16) scrHeight% = PEEKW(inbuf& + 18) iRowBytes% = iWidth% /8 scrRowBytes% = scrWidth% / 8 nColors% = 2^(iDepth%) AvailRam& = FRE(-1) NeededRam& = ((scrWidth%/8)*scrHeight%*(iDepth%+1))+5000 WINDOW OUTPUT 1: PRINT "Available ";AvailRam&,"Needed ";NeededRam& IF AvailRam& < NeededRam& THEN loadError$ = "Not enough free ram." GOTO Lcleanup END IF kk = 1 IF scrWidth% > 320 THEN kk = kk + 1 IF scrHeight% > 320 THEN kk = kk + 2 SCREEN 2,scrWidth%,scrHeight%,iDepth%,kk WINDOW 2,"Map Display",,16,2 WINDOW OUTPUT 2 GOSUB GetScrAddrs CALL LoadRGB4&(sViewPort&,ctab&,nColors%) ELSEIF tt$ = "CMAP" THEN foundCMAP = 1 rLen& = xRead&(fHandle&,cbuf&,icLen&) ' Build Color Table FOR kk = 0 TO nColors% - 1 red% = PEEK(cbuf&+(kk*3)) gre% = PEEK(cbuf&+(kk*3)+1) blu% = PEEK(cbuf&+(kk*3)+2) regTemp% = (red%*16)+(gre%)+(blu%/16) POKEW(ctab&+(2*kk)),regTemp% NEXT ELSEIF tt$ = "ABIT" THEN foundABIT = 1 plSize& = (scrWidth%/8) * scrHeight% FOR pp = 0 TO iDepth% -1 rLen& = xRead&(fHandle&,bPlane&(pp),plSize&) NEXT ELSE FOR kk = 1 TO icLen& rLen& = xRead&(fHandle&,inbuf&,1) NEXT IF (icLen& OR 1) = icLen& THEN rLen& = xRead&(fHandle&,inbuf&,1) END IF END IF IF foundBMHD AND foundCMAP AND foundABIT THEN GOTO GoodLoad END IF IF rLen& > 0 THEN GOTO ChunkLoop IF rLen& < 0 THEN 'Read error loadError$ = "Read error" GOTO Lcleanup END IF IF (foundBMHD=0) OR (foundABIT=0) OR (foundCMAP=0) THEN loadError$ = "Needed ILBM chunks not found" GOTO Lcleanup END IF GoodLoad: loadError$ ="" IF foundCMAP THEN CALL LoadRGB4&(sViewPort&,ctab&,nColors%) END IF Lcleanup: IF fHandle& <> 0 THEN CALL xClose&(fHandle&) IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&) ERASE bPlane&,cTabWork%,cTabSave% RETURN GetScrAddrs: sWindow& = WINDOW(7) sScreen& = PEEKL(sWindow& + 46) sViewPort& = sScreen& + 44 sRastPort& = sScreen& + 84 sColorMap& = PEEKL(sViewPort& + 4) colorTab& = PEEKL(sColorMap& + 4) sBitMap& = PEEKL(sRastPort& + 4) ' Get screen parameters scrWidth% = PEEKW(sScreen& + 12) scrHeight% = PEEKW(sScreen& + 14) scrDepth% = PEEK(sBitMap& + 5) nColors% = 2^scrDepth% ' Get addresses of Bit Planes FOR kk = 0 TO scrDepth% - 1 bPlane&(kk) = PEEKL(sBitMap&+8+(kk*4)) NEXT RETURN