home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 3: The Continuation / 17-Bit_The_Continuation_Disc.iso / files / arug23.dms / arug23.adf / Satellite / tracker9 < prev    next >
Text File  |  1993-12-02  |  16KB  |  606 lines
  1. '         "TRACKER9"       Satellite tracking program with graphics
  2. '         ---------
  3. '
  4. 'Version 1.01 : Last mod 7th May 1990 by ACH
  5. '
  6. '(C) 1988 Mr J R Miller G3RUH
  7. '(C) 1988 Mr A C Hewat  G8NTH
  8. '
  9. 'V 1.00: First version ; original concept with limited graphics etc.
  10. 'V 1.01: Changes to routines to improve acuracy.
  11.  
  12. DEFDBL a-z
  13. CLEAR,55000&,6000&
  14. DIM C1,C2,C3,C4,C5,C6,C7,C8,C9,C10,C11,C12,C13(4),SatName$(4),stepSize(4),ObjectShape$(4)
  15. DIM days&(12)
  16.  
  17. Main:
  18. predictionTime = 0
  19. lastChoise = 1
  20. menuItem = 1
  21. oldSatellite = 1
  22. oldChoise1 = 1
  23. GOSUB ScreenSetup
  24. GOSUB Ephemeris
  25. GOSUB Constants
  26. GOSUB TodayDate
  27. FOR satellite = 1 TO 4
  28.  GOSUB ObjectShape
  29. NEXT satellite
  30. OPEN "scrn:" FOR OUTPUT AS #2
  31. LOCATE 27,1: PRINT SPACE$(78): PRINT SPACE$(78): PRINT SPACE$(78): PRINT SPACE$(78);
  32. LOCATE 28,1
  33. PRINT "Satellite  Lat  Long  Height   MA  EL   AZ  Range  Rate  Mode  Illm  Squint";
  34.                                                                          
  35. Quit = -1
  36. realTimeFlag = -1
  37. WHILE Quit
  38.    FOR satellite = 1 TO 4
  39.       GOSUB DisplayTimePos
  40.       GOSUB SatelliteConstants 
  41.       GOSUB CalcthenDisplay
  42.       GOSUB DisplaySatInfo
  43.    NEXT 
  44. WEND
  45.  
  46. MENU OFF: MOUSE OFF: TIMER OFF
  47. WINDOW CLOSE 2: WINDOW CLOSE 3
  48. SCREEN CLOSE 2
  49. CLOSE #2
  50. MENU RESET 
  51. CLS
  52. END
  53.  
  54. DisplayTimePos:
  55. csrY = CSRLIN: csrX = POS(0)
  56. LOCATE 26,70
  57. PRINT LEFT$(TIME$,5);" UTC";
  58. LOCATE csrY,csrX
  59. RETURN
  60.  
  61. CalcthenDisplay:
  62. GOSUB TimeNow
  63. TN = DY + (hour+minutes/60)/24
  64. GOSUB SatVec
  65. GOSUB RangeVec
  66. GOSUB SunVec
  67. GOSUB Satpos
  68. LOCATE 27,1: PRINT "                                                                   ";
  69. RETURN
  70.  
  71. DisplaySatInfo:  
  72. satLat1 = CINT(satLat1): satLong1 = CINT(satLong1): ssrr = FNRN(ssrr-RE): SQ = FNRN(SQ)
  73. EL = CINT(EL): AZ = CINT(AZ): R = FNRN(R): M = INT(M*128/pi): ILL = FNRN(100*ILL)
  74. IF satellite = 2 THEN
  75.   mode$ = "B"
  76. ELSEIF satellite = 4 THEN
  77.   IF M > 0 AND M < 110 THEN mode$ = "B"
  78.   IF M > 109 AND M < 145 THEN mode$ = "JL"
  79.   IF M > 144 AND M < 150 THEN mode$ = "B Bcn"
  80.   IF M > 144 AND M < 147 THEN mode$ = "S Bcn"
  81.   IF M > 146 AND M < 160 THEN mode$ = "S"
  82.   IF M > 149 AND M < 255 THEN mode$ = "B"
  83.   IF M < 35 OR M > 225 THEN mode$ = "B Omi"
  84. ELSE  
  85.   mode$ = "     "
  86. END IF
  87. LOCATE 29,1
  88. PRINT SatName$(satellite);TAB(12);satLat1;TAB(17);satLong1;TAB(23);
  89. PRINT USING "#####";ssrr;
  90. PRINT TAB(31) USING "###";M;
  91. PRINT " ";
  92.  IF EL > -3 THEN 
  93.    PRINT TAB(35);EL;TAB(39);AZ;TAB(45);
  94.    PRINT USING "#####";R;
  95. '   PRINT TAB(52);RR;
  96.    PRINT TAB(58);mode$;TAB(65);ILL;TAB(70);SQ;
  97.  ELSE 
  98.    PRINT TAB(35)"                                       ";
  99.  END IF
  100. RETURN
  101.  
  102. CheckMenu:
  103. menuId = MENU(0)
  104. menuItem = MENU(1)
  105. ON menuId GOTO Project,SatelliteChoise,Predictions,Display
  106. RETURN
  107.  
  108. Project:
  109. MENU 1,lastChoise,1
  110. IF menuItem = 3 AND echo = 1 THEN Jump
  111. MENU 1,menuItem,2
  112. Jump:
  113. IF menuItem = 3 THEN GOSUB EchoSet
  114. IF menuItem = 4 THEN Quit = 0
  115. lastChoise = menuItem
  116. RETURN
  117.  
  118. SatelliteChoise:
  119. MENU 2,oldSatellite,1
  120. whichSatellite = menuItem
  121. MENU 2,whichSatellite,2
  122. oldSatellite = whichSatellite
  123. RETURN
  124.  
  125.  
  126. SatelliteConstants:
  127. YE = C1(satellite)         'Epoch year
  128. TE = C2(satellite)         'Epoch time
  129. IN = C3(satellite)         'Inclination
  130. RA = C4(satellite)         'R.A.A.N.
  131. EC = C5(satellite)         'Eccentricity
  132. WP = C6(satellite)         'Arg of perigee
  133. MA = C7(satellite)         'Mean anomaly
  134. MM = C8(satellite)         'Mean motion
  135. M2 = C9(satellite)         'Decay rate
  136. RV = C10(satellite)        'Epoch rev
  137. a  = C11(satellite)        'Semi-major axis.  0 if not known
  138. ALAT = C12(satellite)      'Sat att, deg.  0 = in plain, + = below
  139. ALON = C13(satellite)      'Sat att, deg CCW from SMA dir. 180 = Normal
  140.  
  141. IF a = 0 THEN a = (8681668.016000001#/MM)^(2/3)
  142.  
  143. RA = RAD*RA
  144. MA = RAD*MA
  145. IN = RAD*IN
  146. MM = MM*2*pi
  147. WP = RAD*WP
  148. M2 = M2*2*pi
  149. ALAT = RAD*ALAT
  150. ALON = RAD*ALON
  151.                                   
  152. B = a*SQR(1-EC*EC)               
  153. SI = SIN(IN): CI = COS(IN)
  154. PC = RE*a/(B*B): PC = 1.5*J2*PC*PC*MM  
  155. QD = -PC*CI                      
  156. WD = PC*(5*CI*CI-1)/2      
  157. DC = (M2/MM)/3       
  158.               
  159. TEG = FNDO(YE)-FNDO(YG) + TE  
  160. GHAE = RAD*GO + TEG*WE   
  161. MRSE = RAD*GO + TEG*WW + pi  
  162. MASE = RAD*(MASO + MASD*TEG) 
  163. RETURN
  164.  
  165.  
  166. SatVec:
  167. T = (FNDO(YR)-FNDO(YE)) + (TN-TE) 
  168. DT = DC*T/2   
  169. KD = 1-4*DT  
  170. KDP = 1+7*DT    
  171. M = MA + MM*T*(1+3*DT) 
  172. DR = INT(M/(2*pi)) 
  173. M = M - DR*2*pi     
  174. RN = RV + DR   
  175.  
  176. EA = M
  177. Loop:
  178.   C = COS(EA)
  179.   S = SIN(EA)
  180.   DNOM = 1-EC*C
  181.   DE = (EA - EC*S - M)/DNOM    
  182.   EA = EA - DE       
  183. IF ABS(DE) > .002 THEN GOTO Loop   
  184.  
  185. C = COS(EA)
  186. S = SIN(EA)
  187. RGC = a*(1-EC*C)*KD
  188.  
  189. SX = a*(C-EC)*KD:  TA = -COS(ALAT):   XA = TA*COS(ALON)  
  190. SY = B*S*KD:    YA = TA*SIN(ALON):  ZA = -SIN(ALAT)
  191. W = WP + WD*T*KDP:  C = COS(W):   S = SIN(W)
  192. X = SX*C - SY*S:    TA = XA:      XA = TA*C - YA*S
  193. Y = SX*S + SY*C:                  YA = TA*S + YA*C
  194. z = Y*SI: TA = ZA: ZA = YA*SI+TA*CI: ANTZ = ZA
  195. Y = Y*CI:          YA = YA*CI-TA*SI: ANTY = YA
  196.                                      ANTX = XA
  197.  
  198. RAAN = RA + QD*T*KDP
  199. GHAA = GHAE + WE*T   
  200. Q = RAAN - GHAA               
  201. C = COS(Q): S = SIN(Q)
  202. SX = X*C - Y*S:    TA = XA:     XA = TA*C - YA*S
  203. SY = X*S + Y*C:                 YA = TA*S + YA*C
  204. SZ = z
  205.  
  206. C = COS(RAAN): S = SIN(RAAN)
  207. SATX = X*C - Y*S:   TA = ANTX:  ANTX = TA*C - ANTY*S
  208. SATY = X*S + Y*C:               ANTY = TA*S + ANTY*C
  209. SATZ = z
  210. NMX = S*SI: NMY = -C*SI: NMZ = CI
  211. RETURN
  212.  
  213. SunVec:
  214. MAS = MASE + RAD*(MASD*T)  
  215. TAS = MRSE + WW*T + EQC1*SIN(MAS) + EQC2*SIN(2*MAS) + EQC3*SIN(3*MAS)
  216. C = COS(TAS):  S = SIN(TAS)     
  217. SUNX = C:  SUNY = S*CNS:  SUNZ = S*SNS   
  218.  
  219. CSA = ANTX*SUNX + ANTY*SUNY + ANTZ*SUNZ  
  220. ILL = SQR(1-CSA*CSA)   
  221. SATX = SATX/RGC:  SATY = SATY/RGC:  SATZ = SATZ/RGC 
  222. CUA = -(SATX*SUNX + SATY*SUNY + SATZ*SUNZ) 
  223. UMD = RGC*SQR(1-CUA*CUA)/RE    
  224. SEL = (SUNX*NMX + SUNY*NMY + SUNZ*NMZ) 
  225. SEL = ATN(SEL/SQR(-SEL*SEL+1))
  226. IF CUA >= 0 THEN ECL$ = "    +" ELSE ECL$ = "    -"
  227. IF UMD <= 1 AND CUA >= 0 THEN ECL$ = "   ECL"
  228. RETURN
  229.  
  230. RangeVec:
  231. RX = SX - OX:  RY = SY - OY:  RZ = SZ - OZ  
  232. R = SQR(RX*RX + RY*RY + RZ*RZ)   
  233. RX = RX/R: RY = RY/R:  RZ = RZ/R   
  234. U = RX*UX + RY*UY + RZ*UZ   
  235. E = RX*EX + RY*EY + RZ*EZ  
  236. N = RX*NX + RY*NY + RZ*NZ   
  237. AZ = DEG*(ATN(E/N))       
  238. IF N < 0 THEN AZ = AZ + 180              
  239. IF AZ < 0 THEN AZ = AZ + 360
  240. EL = DEG*(ATN(U/SQR(-U*U+1)))
  241. srr = SQR(SX*SX+SY*SY)     
  242. ssrr = SQR(SX*SX+SY*SY+SZ*SZ)    
  243. szrr = SZ/ssrr: syr = SY/srr
  244. satLat1 = DEG*(ATN(szrr/SQR(-szrr*szrr+1))) 
  245. satLong1 = DEG*(ATN(syr/SQR(-syr*syr+1))) 
  246. SQ =  -(XA*RX + YA*RY + ZA*RZ) 
  247. SQ = DEG*(-ATN(SQ/SQR(-SQ*SQ+1))+1.5708)
  248. RETURN
  249.  
  250. Satpos:
  251. IF SX < 0 AND SY > 0 THEN satLong1 = 180 - satLong1 
  252. IF SX < 0 AND SY < 0 THEN satLong1 = -(180+satLong1)
  253. satPsnX = 1.75*satLong1+309       
  254. satPsnY = 117-1.33*satLat1
  255. satPsnX = CINT(satPsnX)
  256. satPsnY = CINT(satPsnY)
  257. OBJECT.OFF satellite
  258. IF predictionTime > 0 THEN IF satLat1 >= -60 THEN PSET(satPsnX+5,satPsnY+5),3
  259. OBJECT.X satellite,satPsnX: OBJECT.Y satellite,satPsnY
  260. IF satLat1 >= -60 THEN OBJECT.ON satellite
  261. RETURN
  262.  
  263. TodayDate:
  264. day = VAL(MID$(DATE$,4,2))
  265. month = VAL(LEFT$(DATE$,2))
  266. YR = VAL(RIGHT$(DATE$,4))  
  267. DY = day + days&(month): IF month > 2 THEN DY = DY + (INT(YR/4)-INT((YR-1)/4))
  268. RETURN
  269.  
  270. TimeNow:
  271. hour = VAL(LEFT$(TIME$,2))
  272. minutes = VAL(MID$(TIME$,4,2))
  273. RETURN
  274.  
  275.  
  276. ScreenSetup:
  277. LOCATE 10,20
  278. PRINT "Setting up map display and arrays, please wait!"
  279. GOSUB MainPicture
  280. MENU
  281. ON MENU GOSUB CheckMenu: MENU ON
  282.  
  283. MENU 1,0,1,"Project "
  284. MENU 1,1,2,"  Map Display "
  285. MENU 1,2,1,"              "
  286. MENU 1,3,1,"  Serial Echo "
  287. MENU 1,4,1,"  Quit        "
  288. MENU 2,0,1,"              "
  289. MENU 3,0,1,"              "
  290. MENU 4,0,1,"    "
  291. MENU 5,0,1,"    "
  292. MENU 6,0,1,"    "
  293. RETURN
  294.  
  295. ObjectShape:
  296. saveId = WINDOW(1)
  297. WINDOW 2
  298. OPEN objShape$(satellite) FOR INPUT AS satellite
  299. OBJECT.SHAPE satellite,INPUT$(LOF(satellite),satellite)
  300. CLOSE satellite
  301. OBJECT.CLIP (0,0)-(631,199)
  302. WINDOW saveId
  303. RETURN
  304.  
  305. Constants:
  306. days&(0)=0:days&(1)=0:days(2)=31:days&(3)=59:days&(4)=90:days&(5)=120:days&(6)=151
  307. days&(7)=181:days&(8)=212:days&(9)=243:days&(10)=273:days&(11)=304:days&(12)=334
  308. LA =  51.268333#           ' Latitude of QTH, + north, - south
  309. LO = -.563333              ' Longitude of QTH, + deg east, - deg west
  310. HT = 35                    ' Height of QTH above mean sea level
  311. pi = 3.141592654#
  312. DEG = 180/pi                           
  313. RAD = 1/DEG               
  314. DEF FNRN(X) = INT(X+.5)
  315. LA = RAD*LA
  316. LO = RAD*LO
  317. HT = HT/1000
  318. CL = COS(LA)
  319. SL = SIN(LA)
  320. CO = COS(LO)
  321. SO = SIN(LO)
  322.  
  323. RE = 6378.14
  324. FL = 1/298.256      
  325. RP = RE*(1-FL)
  326. XX = RE*RE
  327. ZZ = RP*RP
  328. D = SQR(XX*CL*CL + ZZ*SL*SL)
  329. RX = XX/D + HT
  330. RZ = ZZ/D + HT
  331.  
  332. UX = CL*CO:       EX = -SO:       NX = -SL*CO
  333. UY = CL*SO:       EY = CO:        NY = -SL*SO
  334. UZ = SL:          EZ = 0:         NZ = CL
  335. OX = RX*UX:       OY = RX*UY:     OZ = RZ*UZ
  336.  
  337. YG = 1988:    GO = 98.8897   
  338. MASO = 356.1611:   MASD = .9856002671#    
  339. INS = RAD*23.4408:  CNS = COS(INS):   SNS = SIN(INS)  
  340. EQC1 = .03342715297#:  EQC2 = .00034917#:  EQC3 = .00000506#  
  341.  
  342. YM = 365.25        
  343. YT = 365.2421938#         
  344. DEF FNDO(Y) = INT((Y-1)*YM)   
  345. WW = 2*pi/YT                  
  346. WE = 2*pi + WW                    
  347. J2 = .00108263#               
  348. RETURN
  349.  
  350. Ephemeris:
  351.  
  352. SatName$(1)="OSCAR 10s ": SatName$(2)="OSCAR 11  "
  353. stepSize(1)=20:           stepSize(2)=5
  354. objShape$(1)="oscar10":   objShape$(2)="oscar11"
  355. C1(1)=1989:               C1(2)=1990
  356. C2(1)=330.318#:           C2(2)=86.14190031#
  357. C3(1)=25.9:               C3(2)=97.963
  358. C4(1)=232:                C4(2)=141.366
  359. C5(1)=.6:                 C5(2)=.0012026
  360. C6(1)=96:                 C6(2)=141.7015
  361. C7(1)=331:                C7(2)=218.5388
  362. C8(1)=2.0588#:            C8(2)=14.65066797#:      ' AO 10 ALAT,ALONG
  363. C9(1)=0:                  C9(2)=.00002602#:        '
  364. C10(1)=4855:              C10(2)=32395:            ' Jan     Apr
  365. C11(1)=0:                 C11(2)=0:                '
  366. C12(1)=-11:               C12(2)=0:                '-17     -11
  367. C13(1)=28:                C13(2)=180:              ' 38      28
  368.  
  369. SatName$(3)="OSCAR 13s ": SatName$(4)="OSCAR 14  "
  370. stepSize(3)=20:           stepSize(4)=5
  371. objShape$(3)="oscar13":   objShape$(4)="oscar14"
  372. C1(3)=1989:               C1(4)=1990
  373. C2(3)=324.328282#:        C2(4)=29.63555#
  374. C3(3)=57.12:              C3(4)=98.71
  375. C4(3)=181.5:              C4(4)=106.09
  376. C5(3)=.6831:              C5(4)=.0011
  377. C6(3)=215.48:             C6(4)=195.36
  378. C7(3)=0:                  C7(4)=164.31
  379. C8(3)=2.097:              C8(4)=14.28476#
  380. C9(3)=0:                  C9(4)=.000021#
  381. C10(3)=1099:              C10(4)=108
  382. C11(3)=0:                 C11(4)=0
  383. C12(3)=-19.8:             C12(4)=0
  384. C13(3)=319.9:             C13(4)=180
  385.  
  386. 'SatName$(5)="OSCAR 15  ": SatName$(6)="OSCAR 16  "
  387. 'stepSize(5)=5:            stepSize(6)=5
  388. 'objShape$(5)="oscar15":   objShape$(6)="oscar16"
  389. 'C1(5)=1990:               C1(6)=1990
  390. 'C2(5)=38.88408#:          C2(6)=27.74407#
  391. 'C3(5)=98.72:              C3(6)=98.72
  392. 'C4(5)=115.32:             C4(6)=104.21
  393. 'C5(5)=.001#:              C5(6)=.0011
  394. 'C6(5)=115.32:             C6(6)=201.49
  395. 'C7(5)=167.25:             C7(6)=158.44
  396. 'C8(5)=14.28261#:          C8(6)=14.28554#
  397. 'C9(5)=.0000026#:          C9(6)=.00000037#
  398. 'C10(5)=240:               C10(6)=81
  399. 'C11(5)=0:                 C11(6)=0
  400. 'C12(5)=0:                 C12(6)=0
  401. 'C13(5)=180:               C13(6)=180
  402.  
  403. 'SatName$(7)="OSCAR 17  ": SatName$(8)="OSCAR 18  "
  404. 'stepSize(7)=5:            stepSize(8)=5
  405. 'objShape$(7)="oscar17":   objShape$(8)="oscar18"
  406. 'C1(7)=1990:               C1(8)=1990
  407. 'C2(7)=29.63506#:          C2(8)=24.31186#
  408. 'C3(7)=98.72:              C3(8)=98.72
  409. 'C4(7)=106.09:             C4(8)=100.78
  410. 'C5(7)=.0011:              C5(8)=.0011
  411. 'C6(7)=194.93:             C6(8)=214.18
  412. 'C7(7)=165.28:             C7(8)=145.77
  413. 'C8(7)=14.2859#:           C8(8)=14.2870565#
  414. 'C9(7)=.0000088#:          C9(8)=.00013144#
  415. 'C10(7)=108:               C10(8)=32
  416. 'C11(7)=0:                 C11(8)=0
  417. 'C12(7)=0:                 C12(8)=0
  418. 'C13(7)=180:               C13(8)=180
  419.  
  420. 'SatName$(9)="OSCAR 19  ": SatName$(10)="OSCAR 20  "
  421. 'stepSize(9)=5:            stepSize(10)=5
  422. 'objShape$(9)="oscar19":   objShape$(10)="oscar20"
  423. 'C1(9)=1990:               C1(10)=1990
  424. 'C2(9)=30.68451#:          C2(10)=85.20385752#
  425. 'C3(9)=98.72:              C3(10)=99.052
  426. 'C4(9)=107.15:             C4(10)=147.3503
  427. 'C5(9)=.0012:              C5(10)=.0540825
  428. 'C6(9)=193.47:             C6(10)=236.3713
  429. 'C7(9)=166.61:             C7(10)=118.4676
  430. 'C8(9)=14.28775#:          C8(10)=12.83121017#
  431. 'C9(9)=.0000074#:          C9(10)=.00000096#
  432. 'C10(9)=123:               C10(10)=610
  433. 'C11(9)=0:                 C11(10)=0
  434. 'C12(9)=0:                 C12(10)=0
  435. 'C13(9)=180:               C13(10)=180
  436.  
  437. RETURN
  438.  
  439.  
  440. RETURN
  441.  
  442. MainPicture:
  443.  
  444. DIM bPlane&(5), cTabWork%(32), cTabSave%(32)                  
  445. DECLARE FUNCTION xOpen&  LIBRARY
  446. DECLARE FUNCTION xRead&  LIBRARY
  447. DECLARE FUNCTION xWrite& LIBRARY
  448. DECLARE FUNCTION AllocMem&() LIBRARY
  449. LIBRARY "dos.library"
  450. LIBRARY "exec.library"
  451. LIBRARY "graphics.library"
  452.  
  453. GetNames:
  454. ACBMname$  = "World6"       ' World1 for political map
  455. loadError$ = ""
  456. GOSUB LoadACBM
  457. IF loadError$ <> "" THEN GOTO Mcleanup
  458.  
  459. Mcleanup:
  460. Mcleanup2:
  461. LIBRARY CLOSE
  462. IF loadError$ <> "" THEN PRINT loadError$
  463. RETURN   
  464.  
  465. LoadACBM:
  466. f$ = ACBMname$
  467. fHandle& = 0
  468. mybuf& = 0
  469. foundBMHD = 0
  470. foundCMAP = 0
  471. foundCAMG = 0
  472. foundCCRT = 0
  473. foundABIT = 0
  474. filename$ = f$ + CHR$(0)
  475. fHandle& = xOpen&(SADD(filename$),1005)
  476. IF fHandle& = 0 THEN
  477.    loadError$ = "Can't open/find pic file"
  478.    GOTO Lcleanup
  479. END IF
  480. ClearPublic& = 65537&
  481. mybufsize& = 360
  482. mybuf& = AllocMem&(mybufsize&,ClearPublic&)
  483. IF mybuf& = 0 THEN
  484.    loadError$ = "Can't alloc buffer"
  485.    GOTO Lcleanup
  486. END IF
  487. inbuf& = mybuf&
  488. cbuf& = mybuf& + 120
  489. ctab& = mybuf& + 240
  490. rLen& = xRead&(fHandle&,inbuf&,12)
  491. tt$ = ""
  492. FOR kk = 8 TO 11
  493.    tt% = PEEK(inbuf& + kk)
  494.    tt$ = tt$ + CHR$(tt%)
  495. NEXT
  496. IF tt$ <> "ACBM" THEN 
  497.    loadError$ = "Not an ACBM pic file"
  498.    GOTO Lcleanup
  499. END IF
  500.  
  501. ChunkLoop: 
  502.  rLen& = xRead&(fHandle&,inbuf&,8)
  503.  icLen& = PEEKL(inbuf& + 4)
  504.  tt$ = ""
  505.  FOR kk = 0 TO 3
  506.     tt% = PEEK(inbuf& + kk)
  507.     tt$ = tt$ + CHR$(tt%)
  508.  NEXT       
  509. IF tt$ = "BMHD" THEN  
  510.    foundBMHD = 1
  511.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  512.    iWidth%  = PEEKW(inbuf&)
  513.    iHeight% = PEEKW(inbuf& + 2)
  514.    iDepth%  = PEEK(inbuf& + 8)  
  515.    iCompr%  = PEEK(inbuf& + 10)
  516.    scrWidth%  = PEEKW(inbuf& + 16)            
  517.    scrHeight% = PEEKW(inbuf& + 18)   
  518.    iRowBytes% = iWidth% /8
  519.    scrRowBytes% = scrWidth% / 8
  520.    nColors%  = 2^(iDepth%)
  521.    AvailRam& = FRE(-1)
  522.    NeededRam& = ((scrWidth%/8)*scrHeight%*(iDepth%+1))+5000
  523.    WINDOW OUTPUT 1: PRINT "Available ";AvailRam&,"Needed ";NeededRam&
  524.    IF AvailRam& < NeededRam& THEN
  525.       loadError$ = "Not enough free ram."
  526.       GOTO Lcleanup
  527.    END IF
  528.    kk = 1
  529.    IF scrWidth% > 320 THEN kk = kk + 1
  530.    IF scrHeight% > 320  THEN kk = kk + 2
  531.    SCREEN 2,scrWidth%,scrHeight%,iDepth%,kk
  532.    WINDOW 2,"Map Display",,16,2
  533.    WINDOW OUTPUT 2
  534.    GOSUB GetScrAddrs
  535.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  536. ELSEIF tt$ = "CMAP" THEN 
  537.    foundCMAP = 1
  538.    rLen& = xRead&(fHandle&,cbuf&,icLen&)
  539.    ' Build Color Table
  540.    FOR kk = 0 TO nColors% - 1
  541.       red% = PEEK(cbuf&+(kk*3))
  542.       gre% = PEEK(cbuf&+(kk*3)+1)
  543.       blu% = PEEK(cbuf&+(kk*3)+2)
  544.       regTemp% = (red%*16)+(gre%)+(blu%/16)
  545.       POKEW(ctab&+(2*kk)),regTemp%
  546.    NEXT
  547. ELSEIF tt$ = "ABIT" THEN 
  548.    foundABIT = 1    
  549.    plSize& = (scrWidth%/8) * scrHeight%
  550.    FOR pp = 0 TO iDepth% -1
  551.       rLen& = xRead&(fHandle&,bPlane&(pp),plSize&)   
  552.    NEXT
  553. ELSE 
  554.    FOR kk = 1 TO icLen&
  555.       rLen& = xRead&(fHandle&,inbuf&,1)
  556.    NEXT
  557.    IF (icLen& OR 1) = icLen& THEN  
  558.       rLen& = xRead&(fHandle&,inbuf&,1)
  559.    END IF     
  560. END IF
  561. IF foundBMHD AND foundCMAP AND foundABIT THEN
  562.    GOTO GoodLoad
  563. END IF
  564. IF rLen& > 0 THEN GOTO ChunkLoop
  565. IF rLen& < 0 THEN  'Read error
  566.    loadError$ = "Read error"
  567.    GOTO Lcleanup
  568. END IF   
  569. IF (foundBMHD=0) OR (foundABIT=0) OR (foundCMAP=0) THEN
  570.    loadError$ = "Needed ILBM chunks not found"
  571.    GOTO Lcleanup
  572. END IF
  573.  
  574. GoodLoad:
  575. loadError$ =""
  576. IF foundCMAP THEN 
  577.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  578. END IF
  579.  
  580. Lcleanup:
  581. IF fHandle& <> 0 THEN CALL xClose&(fHandle&)
  582. IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&)
  583. ERASE bPlane&,cTabWork%,cTabSave%
  584.  
  585. RETURN
  586.  
  587. GetScrAddrs: 
  588.    sWindow&   = WINDOW(7)
  589.    sScreen&   = PEEKL(sWindow& + 46)
  590.    sViewPort& = sScreen& + 44
  591.    sRastPort& = sScreen& + 84
  592.    sColorMap& = PEEKL(sViewPort& + 4)
  593.    colorTab&  = PEEKL(sColorMap& + 4)
  594.    sBitMap&   = PEEKL(sRastPort& + 4)
  595.    ' Get screen parameters
  596.    scrWidth%  = PEEKW(sScreen& + 12)
  597.    scrHeight% = PEEKW(sScreen& + 14)
  598.    scrDepth%  = PEEK(sBitMap& + 5)
  599.    nColors%   = 2^scrDepth%
  600.    ' Get addresses of Bit Planes 
  601.    FOR kk = 0 TO scrDepth% - 1
  602.       bPlane&(kk) = PEEKL(sBitMap&+8+(kk*4))
  603.    NEXT
  604. RETURN
  605.  
  606.