home *** CD-ROM | disk | FTP | other *** search
/ Xentax forum attachments archive / xentax.7z / 7077 / MAPSC.ZIP / MAPSCROL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-29  |  7.9 KB  |  299 lines
  1. {This Program was Coded By M.W.Zuurman SadCom Ltd. Jan 28 1997
  2.  It uses RAW Picture Processing (TST-Files: Totally Sane Textures)
  3.  The VESA Unit Was Coded By
  4.  
  5.  MEM : Total  MAP : 160 x 160      = 25600  bytes
  6.        Visual Map : 13  x 12       = 156    bytes
  7.        TSTPictures: 32  x 32 x 256 = 262144 bytes
  8. }
  9.  
  10. Program Map_Scroller;
  11.  
  12. Uses Vesaun, Crt, Dos;
  13.  
  14. Const
  15.   TotalPics = 3;        {+1 , e.g.: 0 is one too!}
  16.   MapSize   = 25599;    {as above                }
  17.   MaxMapX   = 159;      {as above                }
  18.   MaxMapY   = 159;      {as above                }
  19. Type
  20.   MAPPICM = array[0..1023] of byte;
  21.   MapP    = ^MAPPICM;
  22.   VMapM   = array[0..156] of byte;
  23.   TMapM   = array[0..MapSize] of byte;
  24. Var
  25.   P       : array[0..TotalPics] of MaPP;
  26.   Pall    : array[0..255, 0..2] of word;
  27.   VMap    : ^VmapM;
  28.   TMap    : ^TMapM;
  29.   MX, MY  : byte;
  30.   PalFile : text;
  31.   ByteCnt : longint;
  32.   QuitLoad: Boolean;
  33.   i, s    : word;
  34.   Ch      : char;
  35.  
  36. Procedure LoadPal(PalFileName: string);
  37.  
  38. var I : word;
  39.     D : char;
  40. Begin
  41.   Writeln('Loading Palette : ', PalFileName);
  42.  
  43.   assign(PalFile, PalFileNAme);
  44.   {$I-}
  45.   reset(PalFile);
  46.   {$I+}
  47.   If Ioresult<>0 then QuitLoad:=true;
  48.   If QuitLoad then Exit;
  49.   for i:=0 to 18 do read(palfile, d);
  50.  
  51.   For i:=0 to 255 do Begin
  52.     read(PalFile, Pall[i, 0]);
  53.     read(PalFile, Pall[i, 1]);
  54.     read(PalFile, Pall[i, 2]);
  55.   end;
  56.   Close(PalFile);
  57.   GotoXY(60, WhereY-1); writeln(I*3+3);
  58.   ByteCnt:=Bytecnt+(I*3+3);
  59. end;
  60.  
  61. Procedure SetPalette;
  62.  
  63. var i: word;
  64.  
  65. Begin
  66.   for i:=0 to 255 do SetColor(i, Pall[i, 0], Pall[i, 1], Pall[i, 2]);
  67. end;
  68.  
  69. Procedure LoadTSTMEM(FileName: string; K: word);
  70.  
  71. var i,j   : word;
  72.     F     : File OF BYTE;
  73.     D     : BYTE;
  74. BEGIN
  75.   writeln('Loading TST     : ',  FileName);
  76.   GetMEm(P[k], SizeOF(MapPIcm));
  77.   Assign(F, FileName);
  78.   {$I-}
  79.   reset(F);
  80.   {$I+}
  81.   If Ioresult<>0 then QuitLoad:=true;
  82.   If QuitLoad then Exit;
  83.   For j:=0 to 1023 do begin
  84.     read(F, P[k]^[j]);
  85.   END;
  86.   I:=FileSize(F);
  87.   Close(f);
  88.   GotoXY(60, WhereY-1); writeln(I);
  89.   ByteCnt:=Bytecnt+i;
  90. END;
  91.  
  92. Procedure PutTST(P: word; x, y: word; Le:byte); Assembler;
  93.  
  94. ASM
  95.   cli                     {Clear Interupts                }
  96.   Mov SI, $0000           {Wipe SI                        }
  97.   Mov Cl, Le              {Store X-width of TST           }
  98.   Mov Ch, Le              {Store Y-width of TST           }
  99.   DEC Word Ptr X          {IMPORTANT for CORRECT LOOPING! }
  100. {  inc ch}
  101. @GoOn:
  102.   cmp Cl, $00             {Compare X-count With 0         }
  103.   je @InCP                {If Equal Jump to InCp          }
  104.   dec Cl                  {If not Decrease X-count        }
  105.   inc Word Ptr X          {Increase X                     }
  106.   inc SI                  {Increase SI                    }
  107.   Mov  AX, Ymax           {Store MaxY                     }
  108.   Mul  pp                 {Multiply                       }
  109.   Add  Ax, Y              {Ad Y to Ax                     }
  110.   Mov  Bx, AX             {Store New Ax into BX           }
  111.   Mov  Ax, Xmax           {Store MaxX now into Ax         }
  112.   Mul  Bx                 {Multiply AX with BX            }
  113.   Add  Ax, X              {Ad X to Ax                     }
  114.   Adc  Dx, 0              {                               }
  115.   Mov  Di, Ax             {Store Ax into DI               }
  116.   Cmp  Dl, Current_bank   {Compare DI with Current Bank   }
  117.   Je   @skip              {If equal skip setting it again!}
  118.   Mov  Current_bank, Dl   {Not equal so set the new Bank  }
  119.   Mov  Ax, 4F05h          {                               }
  120.   Xor  Bx, Bx             {Wipe BX                        }
  121.   Int  10h                {Call Interrupt 10              }
  122.   @Skip:                  {                               }
  123.   Mov  ES, Word Ptr P     {Store Segment of P into ES     }
  124.   Mov  Al, ES:[Si]        {Store the color at segES:ofsSI }
  125.   Mov  ES, SegA000        {Set ES to video Mem            }
  126.   Mov  Es:[Di], Al        {Store the Color at A000:ofsDI  }
  127.   jmp @GoOn               {And Return to go on            }
  128.   @InCP:                  {                               }
  129.   cmp Ch, $00             {Compare Y-count with 0         }
  130.   je @exit                {If equal->TST drawn-->exit     }
  131.   dec Ch                  {Else decrease Y-Count          }
  132.   inc Word Ptr Y          {Increase Y                     }
  133.   mov Cl, le              {Store X-width again at Cl      }
  134. @ResetX:
  135.   dec Word ptr X          {Decrease X,                    }
  136.   dec Cl                  {while counting X-count,        }
  137.   cmp Cl, $00             {until X-count is 0:            }
  138.   jne @ResetX             {Now X is again at it's startpos}
  139.   mov cl, le              {Store X-width to Cl to         }
  140.   jmp @GoOn               {GoOn drawing!                  }
  141. @Exit:                    {                               }
  142.   sti                     {Set Interrupts Back            }
  143. end;
  144.  
  145. Procedure LoadTESTMap(FileName: string);
  146.  
  147. Var
  148.     k   : word;
  149.     F   : FIle of Byte;
  150. Begin
  151.   Writeln('Loading Map     : ', FileName);
  152.   Randomize;
  153.   k:=0;
  154.   GetMem(TMap, SizeOf(TMapM));
  155.   Assign(F, FileName);
  156.   {$I-}
  157.   reset(F);
  158.   {$I+}
  159.   If Ioresult<>0 then QuitLoad:=true;
  160.   If QuitLoad then Exit;
  161.   Repeat
  162.     read(F, Tmap^[k]);
  163.     inc(k);
  164.   until k=MapSize+1;
  165.   K:=FileSize(F);
  166.   Close(f);
  167.   GotoXY(60, WhereY-1); writeln(K);
  168.   ByteCnt:=Bytecnt+k;
  169. end;
  170.  
  171. Procedure GETVisualMap(MX, MY: byte);
  172.  
  173. Var k, l   : word;
  174.  
  175. BEGIN
  176.   k:=0; l:=0;
  177.   Repeat
  178.     Vmap^[l*13+k]:=Tmap^[(MX+k)+((my+l)*160)];
  179.     inc(k);
  180.     if k=13 then Begin K:=0; inc(l); end;
  181.   until l=12;
  182. end;
  183.  
  184. Procedure PUTVisualMap;
  185.  
  186. Var i, j     : byte;
  187.     Pad, k   : word;
  188.  
  189. BEGIN
  190.   k:=0;
  191.   For j:=0 to 11 do begin
  192.     k:=j*13;
  193.     for i:=0 to 12 do begin
  194.       Pad:=seg(P[Vmap^[k+i]]^)+ofs(p[Vmap^[K+i]]^);
  195.       PutTST(Pad, 32+i*32, 64+j*32, 32);
  196.     end;
  197.   end;
  198. END;
  199.  
  200. Procedure MemInit;
  201.  
  202. Begin
  203.   QUitLoad:=false;
  204.   GetMem(Vmap, SizeOf(VmapM));
  205. END;
  206.  
  207. Procedure FreeAllMem;
  208.  
  209. var i: word;
  210.  
  211. Begin
  212. Write('Freeing Memory...');
  213. Freemem(Vmap , SizeOf(VmapM));
  214. Freemem(Tmap , SizeOf(TmapM));
  215. Writeln('Done.');
  216. writeln('END OF SADCOM TEST');
  217. End;
  218.  
  219. Procedure StuffLoad;
  220.  
  221. var B: byte;
  222.  
  223. Begin
  224. writeln('-* Test-Program 1 for WarDice SadCom Ltd M.W.Zuurman *-');
  225. writeln;
  226. writeln('Action            Filename                                 Bytes');
  227. writeln('------------------------------------------------------------------');
  228. ByteCnt:=0;
  229. LoadTSTMEM('grass.tst', 0);
  230. If QuitLoad then Exit;
  231. LoadTSTMEM('water.tst', 1);
  232. If QuitLoad then Exit;
  233. LoadTSTMEM('mount.tst', 2);
  234. If QuitLoad then Exit;
  235. LoadTSTMEM('none.tst', 3);
  236. If QuitLoad then Exit;
  237. LoadTESTMap('testmap.tst');
  238. If QuitLoad then Exit;
  239. LoadPal('testp.pal');
  240. If QuitLoad then Exit;
  241. writeln('------------------------------------------------------------------');
  242. Gotoxy(45, WhereY); writeln('Total Amount : ', ByteCnt);
  243.  
  244. Writeln('-- Press a key to Start MapScroller --');
  245. Writeln('   Keys: Arrows : Scroll Map ');
  246. Writeln('         X      : Exit       ');
  247.  
  248. Readkey;
  249. end;
  250.  
  251. Procedure DrawRec;
  252.  
  253. Begin
  254.   HLine(30, 62, 450, 215);
  255.   HLine(30, 450, 450, 215);
  256.   VLine(30, 62, 450, 215);
  257.   VLine(450, 62, 450,215);{}
  258. end;
  259.  
  260. Procedure MapToVisual;
  261.  
  262. Begin
  263.   GETVisualMap(MX, MY);
  264.   PUTVisualMap;
  265. end;
  266.  
  267. (* MAIN PROGRAM *)
  268.  
  269. BEGIN
  270.   ClrScr;
  271.   xmax:=640; ymax:=480;
  272.   MemInit;
  273.   StuffLoad;
  274.   If QuitLoad then
  275.     Begin Writeln('One or More Files Missing...Terminating'); Exit; End;
  276.   MX:=0; MY:=0;
  277.   SetMode(_640x480x256);{}
  278.   SetPalette;
  279.   DrawRec;
  280.   MapToVisual;
  281.   Repeat
  282.   if keypressed then begin
  283.     ch:=readkey;
  284.     case ch of
  285.       #72 : if my>0 then begin
  286.               Dec(MY); MapToVisual; end;
  287.       #80 : if my+11<MaxMapY then begin
  288.               inc(MY); MapToVisual; end;
  289.       #75 : if mx>0 then begin
  290.               Dec(Mx); MapToVisual; end;
  291.       #77 : if mx+12<MaxMapX then begin
  292.               inc(Mx); MapToVisual; end;
  293.     end;
  294.   end;
  295.   until ch='x';
  296.   SetMode(_80x25t);
  297.   FreeAllMem;
  298. END.
  299.