Subj : simple globe.
To   : Scott Adams
From : Jasen Betts
Date : Mon Jan 27 2003 04:41 pm

here's a really simple globe...

the simplest option, fixed size, equatorial view with no perspective
or other features, but the display code is all integer so it goes _fast_.
and could be much faster if done in asm.

this code doesn't need much to run  486 and VGA should give reasonable
performance, (runs ok on my 486/dx4-100 with turbo turned off)

/---* (MAPGLOBE.PAS)
{
 mapglobe
 fake a texture mapped rotating globe.
}


const filename='worldmap.glb';
const maxrows=100;

type

 float=real;

 row = record
          len :integer;
          data:array [0..9999] of byte;
       end;

 prow=^row;

var
 mapfile:file;
 skip: array [0..maxrows] of prow;
 map: array [0..maxrows] of prow;
 rows:integer;
 cols:integer;

procedure readmap;
var
  x,y,z:integer;
  s:longint;
  basemap,p:pointer;
  fudge: longint absolute p;
  f:file;
begin
  rows:=0;
  cols:=0;
  assign(f,filename);
  reset(f,1);
  s:=filesize(f);
  if s > 65528 then begin
    writeln('map file too big!');
    halt(1);
  end;
  getmem(basemap,s);
  blockread(F,basemap^,s);
  p:=basemap;
  rows:=integer(p^);
  inc(fudge,2);
  cols:=integer(p^);
  inc(fudge,2);
  if rows > maxrows then begin
    writeln('maxrows (=',maxrows,') is too small');
    halt(1);
  end;

  for x:=0 to rows-1 do begin
    map[x]:=p;
    inc(fudge,map[x]^.len+sizeof(integer));
    if longint(p)-longint(basemap) >s then begin
      writeln('file corrupted');
      halt(1);
    end;
  end

end;


procedure buildskips;
var asp,x,y,theta:float;
col,wid,pos,pos0,r:integer;

a,aa,b,bb,rr,d:longint;
begin

{   asp=float(rows)*rows / cols /cols}
   asp:=(0.0+cols)*cols / rows/rows ;
  for r:=0 to rows -1 do begin

    { first work out how many columns display in this row }

    wid:=trunc(0.5+sqrt( cols*cols - (asp)*(R*2-rows+1)*(r*2-rows+1)  ));

    {allocate ram}

    getmem(skip[r],2+wid);


    skip[r]^.len:=wid;
    pos0:=0;

    for col:= 0 to wid-1 do
    begin
      x:=1.0-(col*2+1)/(wid);  { -1 < x < 1 }
      y:=sqrt (1.0-x*x);
      if x=0 then theta:=pi/2 else theta:=arctan(y/x);
      if theta <0 then theta:=theta+pi;
      pos:=trunc(0.5+theta*wid/pi);
      skip[r]^.data[col]:=pos-pos0;
      pos0:=pos;

    end;

  end;

end;

procedure vidmode(m:byte); assembler;
asm xor ax,ax; mov al,m; int $10 end;


procedure showglobe(rot:float);  {could be much fastter in asm!}
var
  x,y,r,c,m:integer;
  display:array [0..199,0..319] of byte absolute $a000:0;
  map0,skip0: prow;
  mapend,skipend:integer;
begin
  for x:=0 to rows-1 do begin
    r:=50+x;
    map0:=map[x];
    skip0:=skip[x];
    mapend:=map0^.len;
    skipend:=skip0^.len-1;

    c:=100-skip0^.len div 2;
    m:=trunc(mapend*rot) mod mapend;

    for y:=0 to skipend do begin
        m:=m+skip0^.data[y];
        if m>=mapend then m:=m-mapend;
        display[r,c+y]:=map0^.data[m];
    end
  end
end;

procedure setpal(n,r,g,blu:byte); assembler;asm
mov ax,$1010
mov bl,n
mov dl,0
mov bh,0
mov dh,r
mov ch,g
mov cl,blu
int $10
end;


function keypressed:boolean;
begin keypressed:=memw[$0:$41a] <> memw[$0:$41c] end;

 var z:integer;
 begin
 write('reading map');
 readmap;
 write(' - computing shape');
 buildskips;
 writeln('- done!');
 vidmode($13);
 setpal(33,0,0,63);   {sea/water  }
 setpal(251,0,63,0);  {land       }
 setpal(0,10,10,10);  {background }
 writeln('press enter to quit');

 while not keypressed do
   begin
     z:=z-1;
     if z<0 then z:=z+1000;
     showglobe(0.003*z);
   end;
 readln;
 vidmode(3);
 end.*---/

The "glb" map file is a special format that has more pixels at the equtor
here's one I prepared earlier I couldn't find a decent map so it's not real
good here's it is zipped and uuencoded.

the format can hold 256 colours but I only use 2 of them (33 and 251 as it
happens)

begin 644 MAP.ZIP
M4$L#!!0````(`!=B.R[KO_F]AP<``$9T```,````5T]23$1-05`N1TQ"W5V]
MKEQ%#-XIT]'1(5FBHJ))DX:&@H*"`HD""0F!$$("(2"09^`9>`.>@!?(`Z1/
MG39MY(;LW7O.>CSVC.WQG+WPZ>9F[SDS_OG&X_'9\_?MZ=GI\0D($/'\[^WO
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
MCV@L%;=%S=5^WL)A,35Z"QL%7`/P87E^(E8(:JB8:NZQ%B/[Y9V;8-T!W;%:
MWXM3._;R4%X'=#.+>VOS16JRAPO.X2+M9>N3K6^=8MO]]@G>QM:L:U?9KTZ"
M2JN'0'-)L]ON(N)5V!*\U?GZ-&K3#0/8AZ+QH'9JY*SL?ZZOE__>A")7G+C*
MJJ;G%&@S!*X"6[O/MI02U+<5.-#D)6V`A4A')>\O\Y[9=O?_HV)5+L[<?6%O
M7,3N]!;R^`$D7%,N4;S;]$Z)#@1W6XYS&`/%:%T\(YAN8LZ[I<UA9MG2C##,
MBC$K]:;DV*#50:V<6O1>J1QK4Y^2>A1F]H04`)>+R\"UT@_,^O<+Y5%VV3.?
M)!-&O%"UO1IK%45UCI-,_*``R<2LB5-CQXYQ!`$[9'-9D,`4CRMA[X>ENZCX
MU-ILT4V$AKGEBU?'&F7GX]+.RQ!G2MH',^KTAOVCX.-8D_<^*?U5R:E>V6S-
M["S3'@FX:-<(D"S^J(!U);>7)QGLX6T@SS_4_?BXP'!9\SBCUB/VE0$[0W$8
MB8+%UR\$&GQ2P%,XY::6I4JG9[1HM[SUC$\+K'0+!BO4`^61Y/;NL2W'9P7,
M%<90_?\F*@V,JOB\I+FHM((P\&%`#,B^6U\42'2R;;6?N/OO\@I2ZAJ?)BV0
MZB;P[\-[QP,&E;72UH9CR&^LLN&K`JGL;FD8R.'"5-`"+VF8OJIQ.WV2N`>Z
MXGO<^;HX&IL,X7Y!'+5DW'VL%8KM(;O&O6IP,@S?E!44TZ8P@=9%J.8'#ZY*
M+?^0%,5NB@&^*[DDIU5A+6ET*]E5M5J7GZE)X,?W)1A<ZSFN-=81A$BO0##7
M-"GK7="K'\H#8EILSB7AH5S3BU?F8AK@QQ(+LD5A+?;0!*&T*F:S38WHFVG!
M3\7-QZ%)1'6OWM`S`.<!]:!CW+6?B]_U&Q`^SD"$E!6+))!1QRG7?BEN_[R&
MYD2X0?+*\SK`5HP9UWXM*0P<3CG-KL.FR:4)R^A^_%;26%B75OH*D!:+N`Y,
M`TS@:4GEX5C6JVR]DO#>Y`KA]Q(E8NPF9`$?"+S?]'7P1PES(=#!+N*!'*`/
M"X<)YD#[/RL0KYV[=LW;&0QWWB-Q(&`61$:8^4NBZ]FU705R=)YI^D#6L=)\
MIL$DYED\-?NW7T<G>-XI<-5)OZ2!!#PK4R-H8'[23@R`S\4]!/J99Z`MI9RI
MF)^AGMJJMSFZIFGZ`3_Z47KU2]?,6FW+-BA<4NUG1]@(D\`8M)Y=N5V%295D
M6]O@-D<C,KA?]W9R;X\LXSO<=IGO1OH2YBO.PO0`&44V"!`#AB%U[5WEJ>A+
MIEL_D)JGGKLH;UK.O!2]/=$=?;`$P6\.^@31S5L!%!M3C*+IVI<L;ZX#,74$
M@E^4]1G2BR#P`:-H^W9$:QIY>]5*..A;884CS1=W'E,3;B#<515B\NF,!^0A
M<@+$%)Q3@=%+MA[6>RI0-K,6LH;U7PJD0C0X.AEQ`B.:L*TLZ78AQ2AR8/WY
M;!M5[$^\!><6T>U9<13G0&(AZ;UBPT4Y=J;P:L;U^V=VR?6&^\WM/LS,+,X+
MDJ9YRI(S&>?R'L26V]0JT7FMW31/.5(2<HJP6[OJ:21JT16DTU1-"\BCNBD+
M]7IV;+?!,=<UT0<SS<L$=&`D>+R-'`E`'Q:_7!?XWR1C!T(\(+8*2I<40T/7
MC2I)C"P0F<`Q5DH<W5/OM7(HRV/`QW!(*BE+9VV<N5'0,6%2&;#S&Q-*JHE-
MS!S#6V_'[:UV<A>0L$!D53+@E5::*2(2O7=CFWG%,2+2\UD%7I]427CF=+#U
MJ0&Y*3%5)FOHDPGU';"[C*BA]J=:W'85-XIQK>M(IOXVV;<S04RZ6:[M:2LW
M+CPM(@+CH^X!?L)1:TD_C9_^<W,BYR5T9CFK"FE08K\P1;)Z#1]"M83$!($P
M@>K<=GOS&50K_$#3DP*'$Y@@;;H\!/6L.%9U7D_(W4/WCN0N05CV5Z3=*2KC
M\G3'PUB;%P668'`ORN.F>X_]V:%'$#8M!Y+8NDHSRT+Z--K57,T*`64U#)HG
M9WM%_/TSC5>S-"D!IAGJ7>?;2UIW#\-^*/0H/7%<*KE,TIN2O\[/3?>G?.>@
MQWI#E6&]9[G#QCPJ)N*B)D0[@ZW^"X:K+/7\BH5023"T(-P58HL16DB0\$9[
MXY"G8@U[SWI""!AT_K7N^FJ_IYV.^?QJTN-Y;R&`@*<O9QP-.;G"0[7]B[![
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````(
M`!=B.R[KO_F]AP<``$9T```,````````````(`````````!73U),1$U!4"Y'
83$)02P4&``````$``0`Z````L0<`````
`
end


Here's a prog that'll convert .PGM images of a regular "Mercator
projection" world map to files to the GLB format

(edit the consts to change it's behavior)




program maptrans;

{translate map from "mercator"-pgm to globe format}

const input_file='c:\world.pgm';  {file names}
const outputfile='worldmap.glb';
const screenrows=100;             {size of output file}
const screencols=120;

function readnum( var f: file):integer;
var a:byte;
n:integer;
begin
 n:=0;a:=13;
 while a in [8,10,13,32] do
   blockread(f,a,1);

 while (a >= ord('0'))and (a <= ord('9')) do begin
   n:=n*10+a-48;
   blockread(f,a,1)
   end;
   readnum:=n;
end;

procedure WRITEINT( var f: file; i:integer);
begin
   blockwrite(f,i,sizeof(integer));
end;

procedure WRITEbyte( var f: file; b:byte);
begin
   blockwrite(f,b,sizeof(byte));
end;


procedure dumprow(var F:file; var buffer :array of byte;buflen,outlen:integer);
var
 m,n{,j}:integer;
begin
 m:=buflen div 2;
 n:=0;

while n <= buflen do
 begin
   if m > buflen then begin
     writebyte(F,buffer[n]);
     m:=m-buflen;
   end else begin
     m:=m+outlen;
     n:=n+1;
   end;
 end;
end;


var
rows,cols,contr:integer;
inrow,incol:integer;
outrow, outcol:integer;
outcols:integer;
buffer:^byte;

b,c:byte;
inf,ouf:file;
x,y,theta:real;

label quit;
begin
assign(inf,input_file);
assign(ouf,outputfile);
reset(inf,1);
rewrite(ouf,1);
blockread(inf,b,1);
writeln('b=',b);
blockread(inf,c,1);
if(b <> 80) or (c <> 53) then
  begin
  writeln('format error!');
  goto quit;
  end;
cols:=readnum(inf);
rows:=readnum(inf);
contr:=readnum(inf);

writeln('rows=',rows,'  cols=',cols,'  contrast=',contr);

getmem(buffer,cols);

inrow:=0;
writeint(ouf,screenrows);
writeint(ouf,screencols);


for outrow:=1 to screenrows do begin
  x:=1.0-(outrow*2-1)/(screenrows);
  y:=sqrt (1.0-x*x);
  if x=0 then theta:=pi/2 else theta:=arctan(y/x);
  outcols:=trunc(y*screencols*pi);
  if theta <0 then theta:=theta+pi;
  write('R:',outrow:3,'  Theta:',theta:8:6,'  outcols:',outcols:5);

  while (0.0+inrow)/rows < theta/pi do begin
  blockread(inf,buffer^,cols);
  inc(inrow);
  end;
  writeln('  inrow:',inrow:5);

  writeint(ouf,outcols);
  dumprow(ouf,buffer^,cols,outcols);

 end;

 close(inf);
 close(ouf);

quit:
end.

enjoy :)

Making PGM files? well that's kind of tricky the best way is with the
PBM-PLUS / NETPBM package, but that's mainly for unix, but there is an old dos
version out there, and I have one I compiled myself...

if you can't find that package

PGM files are basically

 'P5'+#10+'xxxx yyyy'+#10+'nnnn'+#10+uncompressed binary data
xxxx,yyyy,nnnn are numbers in ascii format
xxxx is width of image
yyyy is height
nnnn is the max range of the bytes following

The binary data is row by row of one byte per pixel, for xxxx * yyyy bytes

I stole the map (in the zip) above from a screenshot of the windows
international location screen (which is why antarctica is missing and there
are only 2 colours) and then scaled it up 3 times, rounded the edges off,
and ran it through maptrans)

dunno if it quualifies as a derived work or not, you're probably best off
finding your own map.

 -=> Bye <=-

---
 * Origin: Black Holes were created when God divided by zero! (3:640/1042)

.