Subj : Re: simple globe. To : Jasen Betts From : Scott Adams Date : Sun Feb 02 2003 03:20 am -=> Quoting Jasen Betts to Scott Adams <=- JB> the simplest option, fixed size, equatorial view with no perspective JB> or other features, but the display code is all integer so it goes JB> _fast_. and could be much faster if done in asm. JB> this code doesn't need much to run 486 and VGA should give reasonable JB> performance, (runs ok on my 486/dx4-100 with turbo turned off) Thanks. I'll take a look at it. It might not be toward the end of the week before i can study the code. Things got a bit busy here with the Nasa situation since I do a bit of contract work doing some minor stuff for them. Appreciate. Will check it and study the code line by line later... JB> /---* (MAPGLOBE.PAS) JB> { JB> mapglobe JB> fake a texture mapped rotating globe. JB> } JB> const filename='worldmap.glb'; JB> const maxrows=100; JB> type JB> float=real; JB> row = record JB> len :integer; JB> data:array [0..9999] of byte; JB> end; JB> prow=^row; JB> var JB> mapfile:file; JB> skip: array [0..maxrows] of prow; JB> map: array [0..maxrows] of prow; JB> rows:integer; JB> cols:integer; JB> procedure readmap; JB> var JB> x,y,z:integer; JB> s:longint; JB> basemap,p:pointer; JB> fudge: longint absolute p; JB> f:file; JB> begin JB> rows:=0; JB> cols:=0; JB> assign(f,filename); JB> reset(f,1); JB> s:=filesize(f); JB> if s > 65528 then begin JB> writeln('map file too big!'); JB> halt(1); JB> end; JB> getmem(basemap,s); JB> blockread(F,basemap^,s); JB> p:=basemap; JB> rows:=integer(p^); JB> inc(fudge,2); JB> cols:=integer(p^); JB> inc(fudge,2); JB> if rows > maxrows then begin JB> writeln('maxrows (=',maxrows,') is too small'); JB> halt(1); JB> end; JB> for x:=0 to rows-1 do begin JB> map[x]:=p; JB> inc(fudge,map[x]^.len+sizeof(integer)); JB> if longint(p)-longint(basemap) >s then begin JB> writeln('file corrupted'); JB> halt(1); JB> end; JB> end JB> end; JB> procedure buildskips; JB> var asp,x,y,theta:float; JB> col,wid,pos,pos0,r:integer; JB> a,aa,b,bb,rr,d:longint; JB> begin JB> { asp=float(rows)*rows / cols /cols} JB> asp:=(0.0+cols)*cols / rows/rows ; JB> for r:=0 to rows -1 do begin JB> { first work out how many columns display in this row } JB> wid:=trunc(0.5+sqrt( cols*cols - (asp)*(R*2-rows+1)*(r*2-rows+1) JB> )); JB> {allocate ram} JB> getmem(skip[r],2+wid); JB> skip[r]^.len:=wid; JB> pos0:=0; JB> for col:= 0 to wid-1 do JB> begin JB> x:=1.0-(col*2+1)/(wid); { -1 < x < 1 } JB> y:=sqrt (1.0-x*x); JB> if x=0 then theta:=pi/2 else theta:=arctan(y/x); JB> if theta <0 then theta:=theta+pi; JB> pos:=trunc(0.5+theta*wid/pi); JB> skip[r]^.data[col]:=pos-pos0; JB> pos0:=pos; JB> end; JB> end; JB> end; JB> procedure vidmode(m:byte); assembler; JB> asm xor ax,ax; mov al,m; int $10 end; JB> procedure showglobe(rot:float); {could be much fastter in asm!} JB> var JB> x,y,r,c,m:integer; JB> display:array [0..199,0..319] of byte absolute $a000:0; JB> map0,skip0: prow; JB> mapend,skipend:integer; JB> begin JB> for x:=0 to rows-1 do begin JB> r:=50+x; JB> map0:=map[x]; JB> skip0:=skip[x]; JB> mapend:=map0^.len; JB> skipend:=skip0^.len-1; JB> c:=100-skip0^.len div 2; JB> m:=trunc(mapend*rot) mod mapend; JB> for y:=0 to skipend do begin JB> m:=m+skip0^.data[y]; JB> if m>=mapend then m:=m-mapend; JB> display[r,c+y]:=map0^.data[m]; JB> end JB> end JB> end; JB> procedure setpal(n,r,g,blu:byte); assembler;asm JB> mov ax,$1010 JB> mov bl,n JB> mov dl,0 JB> mov bh,0 JB> mov dh,r JB> mov ch,g JB> mov cl,blu JB> int $10 JB> end; JB> function keypressed:boolean; JB> begin keypressed:=memw[$0:$41a] <> memw[$0:$41c] end; JB> var z:integer; JB> begin JB> write('reading map'); JB> readmap; JB> write(' - computing shape'); JB> buildskips; JB> writeln('- done!'); JB> vidmode($13); JB> setpal(33,0,0,63); {sea/water } JB> setpal(251,0,63,0); {land } JB> setpal(0,10,10,10); {background } JB> writeln('press enter to quit'); JB> while not keypressed do JB> begin JB> z:=z-1; JB> if z<0 then z:=z+1000; JB> showglobe(0.003*z); JB> end; JB> readln; JB> vidmode(3); JB> end.*---/ JB> The "glb" map file is a special format that has more pixels at the JB> equtor here's one I prepared earlier I couldn't find a decent map so JB> it's not real good here's it is zipped and uuencoded. JB> the format can hold 256 colours but I only use 2 of them (33 and 251 JB> as it happens) JB> begin 644 MAP.ZIP JB> M4$L#!!0````(`!=B.R[KO_F]AP<``$9T```,````5T]23$1-05`N1TQ"W5V] JB> MKEQ%#-XIT]'1(5FBHJ))DX:&@H*"`HD""0F!$$("(2"09^`9>`.>@!?(`Z1/ JB> MG39MY(;LW7O.>CSVC.WQG+WPZ>9F[SDS_OG&X_'9\_?MZ=GI\0D($/'\[^WO JB> M`;ZLNMUU/?_L_3<0N0U4)4\;X7#IC_>?D*-J.#1>P9^"VET77'[JC:UZ";5Y M=0]4>/BKM45AD4NVV51;13J;V/M;LHX,_N4C<$N\)A(KD?>__^N>$]S"0A#Q JB> MCV@L%;=%S=5^WL)A,35Z"QL%7`/P87E^(E8(:JB8:NZQ%B/[Y9V;8-T!W;%: JB> MWXM3._;R4%X'=#.+>VOS16JRAPO.X2+M9>N3K6^=8MO]]@G>QM:L:U?9KTZ" JB> M2JN'0'-)L]ON(N)5V!*\U?GZ-&K3#0/8AZ+QH'9JY*SL?ZZOE__>A")7G+C* JB> MJJ;G%&@S!*X"6[O/MI02U+<5.-#D)6VA')>\O\Y[9=O?_HV)5+L[ M7,3N]!;R^`$D7%,N4;S;]$Z)#@1W6XYS&`/%:%T\(YAN8LZ[I MBC$K]:;DV*#50:V<6O1>J1QK4Y^2>A1F]H04`)>+R\"UT@_,^O<+Y5%VV3.? JB> M)!-&O%"UO1IK%45UCI-,_*``R<2LB5-CQXYQ!`$[9'-9D,RMA[X>ENZCX JB> MU-ILT4V$AKGEBU?'&F7GX]+.RQ!G2MH',^KTAOVCX.-8D_<^*?U5R:E>V6S- JB> M["S3'@FX:-<(D"S^J(!U);>7)QGLX6T@SS_4_?BXP'!9\SBCUB/VE0$[0W$8 JB> MB8+%UR\$&GQ2P%,XY::6I4JG9[1HM[SUC$\+K'0+!BO4`^61Y/;NL2W'9P7, JB> M%<90_?\F*@V,JOB\I+FHM((P\&%`#,B^6U\42'2R;;6?N/OO\@I2ZAJ?)BV0 JB> MZB;P[\-[QP,&E;72UH9CR&^LLN&K`JGL;FD8R.'"5-`"+VF8OJIQ.WV2N`>Z JB> MXGO<^;HX&IL,X7Y!'+5DW'VL%8KM(;O&O6IP,@S?E!44TZ8P@=9%J.8'#ZY* JB> M+?^0%,5NB@&^*[DDIU5A+6ET*]E5M5J7GZE)X,?W)1A M-"GK7="K'\H#8EILSB7AH5S3BU?F8AK@QQ(+LD5A+?;0!*&T*F:S38WHFVG! JB> M3\7-QZ%)1'6OWM`S`. MYD2X0?+*\SK`5HP9UWXM*0P<3CG-KL.FR:4)R^A^_%;26%B75OH*D!:+N`Y, JB> M`TS@:4GEX5C6JVR]DO#>Y`KA]Q(E8NPF9`$?"+S?]'7P1PES(=#!+N*!'*`/ JB> M"X<)YD#[/RL0KYV[=LW;&0QWWB-Q(&$:8^4NBZ]FU705R=)YI^D#6L=)\ JB> MIL$DYED\-?NW7T-XI<-5)OZ2!!#PK4R-H8'[23@R`S\4]!/J99Z`MI9RI JB> MF)^AGMJJMSFZIFGZ`3_Z47KU2]?,6FW+-BA<4NUG1]@(D\`8M)Y=N5V%295D JB> M6]O@-DA+ JB> MIEL_D)JGGKLH;UK.O!2]/=$=?;`$P6\.^@31S5L!%!M3C*+IVI M@E^4]1G2BR#P`:-H^W9$:QIY>]5*..A;884CS1=W'E,3;B#<515B\NF,!^0A JB> M<@+$%)Q3@=%+MA[6>RI0-K,6LH;U7PJD0C0X.AEQ`B.:L*TLZ78AQ2AR8/WY JB> M;!M5[$^\!><6T>U9<13G0&(AZ;UBPT4Y=J;P:L;U^V=VR?6&^\WM/LS,+,X+ JB> MDJ9YRI(S&>?R'L26V]0JT7FMW31/.5(2 M]7IV;+?!,=+R-'`E`'Q:_7!?XWR1C!T(\(+8*2I<40T/7 JB> MC2I)C"P0F<`Q5DH MS!S#6V_'[:UV0L$!D53+@E5::*2(2O7=CFWG%,2+2\UD%7I]427CF=+#U JB> MJ0&Y*3%5)FOHDPGU';"[C*BA]J=:W'85-XIQK>M(IOXVV; M+CPM(@+CH^X!?L)1:TD_C9_^K<=GOS&50K_$#3DP*'$Y@@;;H\!/6L.%9U7D_(W4/WCN0N05CV5Z3=*2KC JB> M\G3'PUB;%P668'`ORN.F>X_]V:%'$#8M!Y+8NDHSRT+Z--K57,T*U#)HG JB> M9WM%_/TSC5>S-"D!IAGJ7>?;2UIW#\-^*/0H/7%<*KE,TIN2O\[/3?>G?.>@ JB> MQWI#E6&]9[G#QCPJ)N*B)D0[@ZW^"X:K+/7\BH5023"T(-P58HL16DB0\$9[ JB> MXY"G8@U[SWI""!AT_K7N^FJ_IYV.^?QJTN-Y;R&`@* M`<\@ZABRI;\OY7G,IY`WX`7M-%"HOL(MT8?9X%;6.?E5>>EQX398-%=\ZV#B MD,>,[;R?<6Z)G;!%>$7E7-UG4]N^=M/A]:A%_2I0<[7V+U!+`0(9`!0````( JB> M`!=B.R[KO_F]AP<``$9T```,````````````(`````````!73U),1$U!4"Y' JB> 83$)02P4&``````$``0`Z````L0<````` JB> ` JB> end JB> Here's a prog that'll convert .PGM images of a regular "Mercator JB> projection" world map to files to the GLB format JB> (edit the consts to change it's behavior) JB> program maptrans; JB> {translate map from "mercator"-pgm to globe format} JB> const input_file='c:\world.pgm'; {file names} JB> const outputfile='worldmap.glb'; JB> const screenrows=100; {size of output file} JB> const screencols=120; JB> function readnum( var f: file):integer; JB> var a:byte; JB> n:integer; JB> begin JB> n:=0;a:=13; JB> while a in [8,10,13,32] do JB> blockread(f,a,1); JB> while (a >= ord('0'))and (a <= ord('9')) do begin JB> n:=n*10+a-48; JB> blockread(f,a,1) JB> end; JB> readnum:=n; JB> end; JB> procedure WRITEINT( var f: file; i:integer); JB> begin JB> blockwrite(f,i,sizeof(integer)); JB> end; JB> procedure WRITEbyte( var f: file; b:byte); JB> begin JB> blockwrite(f,b,sizeof(byte)); JB> end; JB> procedure dumprow(var F:file; var buffer :array of JB> byte;buflen,outlen:integer); var JB> m,n{,j}:integer; JB> begin JB> m:=buflen div 2; JB> n:=0; JB> while n <= buflen do JB> begin JB> if m > buflen then begin JB> writebyte(F,buffer[n]); JB> m:=m-buflen; JB> end else begin JB> m:=m+outlen; JB> n:=n+1; JB> end; JB> end; JB> end; JB> var JB> rows,cols,contr:integer; JB> inrow,incol:integer; JB> outrow, outcol:integer; JB> outcols:integer; JB> buffer:^byte; JB> b,c:byte; JB> inf,ouf:file; JB> x,y,theta:real; JB> label quit; JB> begin JB> assign(inf,input_file); JB> assign(ouf,outputfile); JB> reset(inf,1); JB> rewrite(ouf,1); JB> blockread(inf,b,1); JB> writeln('b=',b); JB> blockread(inf,c,1); JB> if(b <> 80) or (c <> 53) then JB> begin JB> writeln('format error!'); JB> goto quit; JB> end; JB> cols:=readnum(inf); JB> rows:=readnum(inf); JB> contr:=readnum(inf); JB> writeln('rows=',rows,' cols=',cols,' contrast=',contr); JB> getmem(buffer,cols); JB> inrow:=0; JB> writeint(ouf,screenrows); JB> writeint(ouf,screencols); JB> for outrow:=1 to screenrows do begin JB> x:=1.0-(outrow*2-1)/(screenrows); JB> y:=sqrt (1.0-x*x); JB> if x=0 then theta:=pi/2 else theta:=arctan(y/x); JB> outcols:=trunc(y*screencols*pi); JB> if theta <0 then theta:=theta+pi; JB> write('R:',outrow:3,' Theta:',theta:8:6,' outcols:',outcols:5); JB> while (0.0+inrow)/rows < theta/pi do begin JB> blockread(inf,buffer^,cols); JB> inc(inrow); JB> end; JB> writeln(' inrow:',inrow:5); JB> writeint(ouf,outcols); JB> dumprow(ouf,buffer^,cols,outcols); JB> end; JB> close(inf); JB> close(ouf); JB> quit: JB> end. JB> enjoy :) JB> Making PGM files? well that's kind of tricky the best way is with the JB> PBM-PLUS / NETPBM package, but that's mainly for unix, but there is an JB> old dos version out there, and I have one I compiled myself... JB> if you can't find that package JB> PGM files are basically I'll keep it in mind... JB> 'P5'+#10+'xxxx yyyy'+#10+'nnnn'+#10+uncompressed binary data JB> xxxx,yyyy,nnnn are numbers in ascii format JB> xxxx is width of image JB> yyyy is height JB> nnnn is the max range of the bytes following JB> The binary data is row by row of one byte per pixel, for xxxx * yyyy JB> bytes JB> I stole the map (in the zip) above from a screenshot of the windows JB> international location screen (which is why antarctica is missing and JB> there are only 2 colours) and then scaled it up 3 times, rounded the JB> edges off, and ran it through maptrans) I see :)...ok..cool. JB> dunno if it quualifies as a derived work or not, you're probably best JB> off finding your own map. Yep. Or just do some random work. .... "It will give us something to discuss on the trail." - Lennier --- Fringe BBS * Origin: EWOG II - The Fringe - 904-733-1721 (1:112/91) .