home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TPPROC19.ZIP / MEMLOOK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-09-06  |  11.3 KB  |  521 lines
  1. {$C+}
  2. program memlook;
  3. type
  4.   register = integer;
  5.   halfregister = byte;
  6.   reglist = record
  7.               ax,bx,cx,dx,bp,di,si,ds,es,flags : register;
  8.             end;
  9.   screen = array[0..3839] of char;
  10.   display_line = string[80];
  11.   memory_segment = array[0..255] of byte;
  12.   ch2 = string[2];
  13.   ch4 = string[4];
  14.  
  15. var
  16.   mono_display : screen absolute $B000:0000;
  17.   color_display : screen absolute $B800:0000;
  18.   scrn : screen;
  19.   video_mode : byte;
  20.   seg_data : memory_segment;
  21.   segment : integer;
  22.   offset : integer;
  23.   quit : boolean;
  24.  
  25. procedure get_key(var key:char;var ekey:boolean);
  26. begin
  27.   while not keypressed do;
  28.   ekey:=false;
  29.   read(kbd,key);
  30.   if (key=#27) and keypressed then
  31.      begin
  32.      ekey:=true;
  33.      read(kbd,key);
  34.      end;
  35. end;
  36.  
  37. function get_video_mode:byte;
  38. var
  39.   regs : reglist;
  40.   ah,al : halfregister;
  41.  
  42. begin
  43.   al:=0;
  44.   ah:=15;
  45.   regs.ax:=ah shl 8 + al;
  46.   intr($10,regs);
  47.   get_video_mode:=regs.ax shl 8 shr 8;
  48. end;
  49.  
  50. procedure set_video_mode(mode:byte);
  51. var
  52.   regs : reglist;
  53.   ah,al : halfregister;
  54.  
  55. begin
  56.   ah:=0;
  57.   if mode <> 2 then
  58.      if mode <> 3 then
  59.         mode:=2;
  60.   al:=mode;
  61.   regs.ax:=ah shl 8 + al;
  62.   intr($10,regs);
  63. end;
  64.  
  65. procedure put_screen(scrn:screen);
  66. begin
  67.   if video_mode = 2 then
  68.      mono_display:=scrn
  69.   else
  70.      color_display:=scrn;
  71. end;
  72.  
  73. procedure clr_screen(var scrn:screen);
  74. var
  75.   counter : integer;
  76.  
  77. begin
  78.   counter:=0;
  79.   while counter <= 3839 do
  80.     begin
  81.     scrn[counter]:=' ';
  82.     scrn[counter+1]:=chr(7);
  83.     counter:=counter+2;
  84.     end;
  85. end;
  86.  
  87. procedure put_char_row_col(var scrn:screen;ch:char;r,c:integer);
  88. begin
  89.   scrn[160*(r-1)+2*(c-1)]:=ch;
  90. end;
  91.  
  92. procedure put_string_row_col(var scrn:screen;st:display_line;r,c:integer);
  93. var
  94.   counter : integer;
  95.  
  96. begin
  97.   counter:=1;
  98.   while counter <= length(st) do
  99.     begin
  100.     put_char_row_col(scrn,st[counter],r,c+counter-1);
  101.     counter:=counter+1;
  102.     end;
  103. end;
  104.  
  105. procedure init_screen(var scrn:screen);
  106. var
  107.   line : display_line;
  108.   counter : integer;
  109.  
  110. begin
  111.   highvideo;
  112.   clr_screen(scrn);
  113.   line:='';
  114.   counter:=1;
  115.   while counter <= 80 do
  116.     begin
  117.     line:=line+chr(205);
  118.     counter:=counter+1;
  119.     end;
  120.   put_string_row_col(scrn,line,1,1);
  121.   put_string_row_col(scrn,line,19,1);
  122.   line:='0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F    0123456789ABCDEF';
  123.   put_string_row_col(scrn,line,2,14);
  124.   counter:=0;
  125.   while counter <= 15 do
  126.     begin
  127.     put_string_row_col(scrn,':',counter+3,5);
  128.     put_char_row_col(scrn,chr(16),counter+3,63);
  129.     put_char_row_col(scrn,chr(17),counter+3,80);
  130.     counter:=counter+1;
  131.     end;
  132.   put_string_row_col(scrn,'MEMLOOK <0.0>',20,1);
  133.   put_string_row_col(scrn,'>0000:0000<  -  Specify starting display address',21,28);
  134.   put_string_row_col(scrn,'Press ? for Help',24,1);
  135. end;
  136.  
  137. procedure init_program(var scrn:screen;var video_mode:byte);
  138. begin
  139.   video_mode:=get_video_mode;
  140.   if video_mode <> 2 then
  141.      if video_mode <> 3 then
  142.         begin
  143.         set_video_mode(3);
  144.         video_mode:=get_video_mode;
  145.         end;
  146.   init_screen(scrn);
  147. end;
  148.  
  149. procedure integer_to_hex(int:integer;var hx:ch4);
  150. var
  151.   nibble1 : integer;
  152.   nibble2 : integer;
  153.   nibble3 : integer;
  154.   nibble4 : integer;
  155.  
  156. begin
  157.   nibble1:=int shr 12;
  158.   nibble2:=int shl 4 shr 12;
  159.   nibble3:=int shl 8 shr 12;
  160.   nibble4:=int shl 12 shr 12;
  161.   if nibble1 > 9 then
  162.      nibble1:=nibble1+55
  163.   else
  164.      nibble1:=nibble1+48;
  165.   if nibble2 > 9 then
  166.      nibble2:=nibble2+55
  167.   else
  168.      nibble2:=nibble2+48;
  169.   if nibble3 > 9 then
  170.      nibble3:=nibble3+55
  171.   else
  172.      nibble3:=nibble3+48;
  173.   if nibble4 > 9 then
  174.      nibble4:=nibble4+55
  175.   else
  176.      nibble4:=nibble4+48;
  177.   hx[1]:=chr(nibble1);
  178.   hx[2]:=chr(nibble2);
  179.   hx[3]:=chr(nibble3);
  180.   hx[4]:=chr(nibble4);
  181. end;
  182.  
  183. procedure byte_to_hex(ch:byte;var hx:ch2);
  184. var
  185.   high : byte;
  186.   low : byte;
  187.  
  188. begin
  189.   high:=ord(ch) shr 4;
  190.   low:=ord(ch) and $F;
  191.   if high > 9 then
  192.      high:=high+55
  193.   else
  194.      high:=high+48;
  195.   if low > 9 then
  196.      low:=low+55
  197.   else
  198.      low:=low+48;
  199.   hx[1]:=chr(high);
  200.   hx[2]:=chr(low);
  201. end;
  202.  
  203. procedure convert_seg(seg_data:memory_segment;var scrn:screen);
  204. var
  205.   para : integer;
  206.   pos : integer;
  207.   hx : ch2;
  208.  
  209. begin
  210.   para:=0;
  211.   while para <= 15 do
  212.     begin
  213.     pos:=0;
  214.     while pos <= 15 do
  215.       begin
  216.       byte_to_hex(seg_data[16*para+pos],hx);
  217.       put_char_row_col(scrn,hx[1],para+3,13+3*pos);
  218.       put_char_row_col(scrn,hx[2],para+3,14+3*pos);
  219.       put_char_row_col(scrn,chr(ord(seg_data[16*para+pos])),para+3,64+pos);
  220.       pos:=pos+1;
  221.       end;
  222.     para:=para+1;
  223.     end;
  224. end;
  225.  
  226. procedure put_address(s,o:integer;var scrn:screen);
  227. var
  228.   seg_hx : ch4;
  229.   ofs_hx : ch4;
  230.   oft : integer;
  231.   counter : integer;
  232.  
  233. begin
  234.   integer_to_hex(s,seg_hx);
  235.   put_char_row_col(scrn,seg_hx[1],21,29);
  236.   put_char_row_col(scrn,seg_hx[2],21,30);
  237.   put_char_row_col(scrn,seg_hx[3],21,31);
  238.   put_char_row_col(scrn,seg_hx[4],21,32);
  239.   integer_to_hex(o,ofs_hx);
  240.   put_char_row_col(scrn,ofs_hx[1],21,34);
  241.   put_char_row_col(scrn,ofs_hx[2],21,35);
  242.   put_char_row_col(scrn,ofs_hx[3],21,36);
  243.   put_char_row_col(scrn,ofs_hx[4],21,37);
  244.   counter:=0;
  245.   while counter <= 15 do
  246.     begin
  247.     put_char_row_col(scrn,seg_hx[1],counter+3,1);
  248.     put_char_row_col(scrn,seg_hx[2],counter+3,2);
  249.     put_char_row_col(scrn,seg_hx[3],counter+3,3);
  250.     put_char_row_col(scrn,seg_hx[4],counter+3,4);
  251.     oft:=o+counter*16;
  252.     integer_to_hex(oft,ofs_hx);
  253.     put_char_row_col(scrn,ofs_hx[1],counter+3,6);
  254.     put_char_row_col(scrn,ofs_hx[2],counter+3,7);
  255.     put_char_row_col(scrn,ofs_hx[3],counter+3,8);
  256.     put_char_row_col(scrn,ofs_hx[4],counter+3,9);
  257.     counter:=counter+1;
  258.     end;
  259. end;
  260.  
  261. procedure get_segment(s,o:integer;var seg_data:memory_segment);
  262. begin
  263.   move(mem[s:o],seg_data,256);
  264. end;
  265.  
  266. procedure remove_dos_cursor;
  267. var
  268.   registers : reglist;
  269.  
  270. begin
  271.   registers.ax:=$100;
  272.   registers.cx:=3598;
  273.   intr($10,registers);
  274. end;
  275.  
  276. procedure wait_for_space;
  277. var
  278.   input : char;
  279.   ekey : boolean;
  280.  
  281. begin
  282.   input:=chr(0);
  283.   while input<>' ' do
  284.     begin
  285.     gotoxy(1,24);
  286.     writeln('Please press the SPACE bar to continue ...');
  287.     while not keypressed do;
  288.     get_key(input,ekey);
  289.     if input<>' ' then
  290.        begin
  291.        clrscr;
  292.        writeln(chr(7));
  293.        highvideo;
  294.        end;
  295.     end;
  296.   clrscr;
  297.   highvideo;
  298. end;
  299.  
  300. procedure restore_dos_cursor;
  301. var
  302.   registers : reglist;
  303.  
  304. begin
  305.   registers.ax:=$100;
  306.   registers.cx:=1802;
  307.   intr($10,registers);
  308. end;
  309.  
  310. procedure help;
  311. begin
  312.   lowvideo;
  313.   clrscr;
  314.   remove_dos_cursor;
  315.   writeln('HELP INFORMATION PANEL  -  MEMLOOK <0.0>  03/17/85');
  316.   writeln('==================================================');
  317.   writeln('');
  318.   writeln('The following functions are currently available:');
  319.   writeln('');
  320.   writeln(chr(24)+' .................... Show previous line of 16 bytes.');
  321.   writeln(chr(25)+' .................... Show next line of 16 bytes.');
  322.   writeln('PgUp ................. Show previous page of 256 bytes.');
  323.   writeln('PgDn ................. Show next page of 256 bytes.');
  324.   writeln('Home ................. Starting display address = 0000:0000.');
  325.   writeln('End .................. Starting display address = FFF0:0000.');
  326.   writeln('? .................... This panel.');
  327.   writeln('Esc .................. Exit program.');
  328.   writeln('');
  329.   writeln('');
  330.   writeln('Comments/Suggestions - Contact  Roger McCarty');
  331.   writeln('                                11534 Breckenridge Dr.');
  332.   writeln('                                Whittier, CA 90604');
  333.   writeln('                                (213) 944-4191');
  334.   wait_for_space;
  335.   restore_dos_cursor;
  336. end;
  337.  
  338. procedure up_key(var s,o:integer);
  339. begin
  340.   if o=0 then
  341.      begin
  342.      s:=s-1;
  343.      o:=0
  344.      end
  345.   else
  346.      begin
  347.      o:=o-16;
  348.      end;
  349. end;
  350.  
  351. procedure down_key(var s,o:integer);
  352. begin
  353.   o:=o+16;
  354. end;
  355.  
  356. procedure home_key(var s,o:integer);
  357. begin
  358.   s:=0;
  359.   o:=0;
  360. end;
  361.  
  362. procedure end_key(var s,o:integer);
  363. begin
  364.   s:=$FFF0;
  365.   o:=0;
  366. end;
  367.  
  368. procedure page_up_key(var s,o:integer);
  369. begin
  370.   s:=s-16;
  371. end;
  372.  
  373. procedure page_down_key(var s,o:integer);
  374. begin
  375.   s:=s+16;
  376. end;
  377.  
  378. function hex_char(ch:char):boolean;
  379. var
  380.   result : boolean;
  381.  
  382. begin
  383.   result:=false;
  384.   if ord(ch) > 47 then
  385.      if ord(ch) < 58 then
  386.         result:=true;
  387.   if ord(ch) > 64 then
  388.      if ord(ch) < 71 then
  389.         result:=true;
  390.   hex_char:=result;
  391. end;
  392.  
  393. function hex_char_to_integer(hx:ch4):integer;
  394. var
  395.   counter : integer;
  396.   nibble1 : integer;
  397.   nibble2 : integer;
  398.   nibble3 : integer;
  399.   nibble4 : integer;
  400.  
  401. begin
  402.   nibble1:=ord(hx[1]);
  403.   nibble2:=ord(hx[2]);
  404.   nibble3:=ord(hx[3]);
  405.   nibble4:=ord(hx[4]);
  406.   if nibble1 > 57 then
  407.      nibble1:=nibble1-55
  408.   else
  409.      nibble1:=nibble1-48;
  410.   if nibble2 > 57 then
  411.      nibble2:=nibble2-55
  412.   else
  413.      nibble2:=nibble2-48;
  414.   if nibble3 > 57 then
  415.      nibble3:=nibble3-55
  416.   else
  417.      nibble3:=nibble3-48;
  418.   if nibble4 > 57 then
  419.      nibble4:=nibble4-55
  420.   else
  421.      nibble4:=nibble4-48;
  422.   hex_char_to_integer:=nibble1*4096+nibble2*256+nibble3*16+nibble4;
  423. end;
  424.  
  425. procedure process_command(var s,o:integer;var quit:boolean);
  426. var
  427.   segx : ch4;
  428.   ofsx : ch4;
  429.   pointer : integer;
  430.   do_again : boolean;
  431.   command : char;
  432.   ekey : boolean;
  433.  
  434. begin
  435.   gotoxy(29,21);
  436.   pointer:=1;
  437.   do_again:=true;
  438.   segx:='';
  439.   ofsx:='';
  440.   while do_again do
  441.     begin
  442.     command:=chr(0);
  443.     while command < #$1A do
  444.       get_key(command,ekey);
  445.     do_again:=false;
  446.     command:=upcase(command);
  447.     if (command=#27) and not ekey then
  448.        begin
  449.        clrscr;
  450.        quit:=true;
  451.        end;
  452.     if hex_char(command) then
  453.        begin
  454.        if pointer < 5 then
  455.           begin
  456.           gotoxy(29+pointer-1,21);
  457.           writeln(command);
  458.           if pointer = 4 then
  459.              gotoxy(30+pointer,21)
  460.           else
  461.              gotoxy(29+pointer,21);
  462.           segx:=segx+command
  463.           end
  464.        else
  465.           begin
  466.           gotoxy(30+pointer-1,21);
  467.           writeln(command);
  468.           gotoxy(30+pointer,21);
  469.           ofsx:=ofsx+command;
  470.           end;
  471.        pointer:=pointer+1;
  472.        if pointer > 8 then
  473.           begin
  474.           s:=hex_char_to_integer(segx);
  475.           o:=hex_char_to_integer(ofsx);
  476.           end
  477.        else
  478.           begin
  479.           do_again:=true;
  480.           end;
  481.        end;
  482.     case command of
  483.       #$48 : begin {Up arrow}
  484.              up_key(s,o);
  485.              end;
  486.       #$50 : begin {Down arrow}
  487.              down_key(s,o);
  488.              end;
  489.       #$47 : begin {Home key}
  490.              home_key(s,o);
  491.              end;
  492.       #$4F : begin {End key}
  493.              end_key(s,o);
  494.              end;
  495.       #$49 : begin {Page up key}
  496.              page_up_key(s,o);
  497.              end;
  498.       #$51 : begin {Page down key}
  499.              page_down_key(s,o);
  500.              end;
  501.       #$3F : begin {Help key}
  502.              help;
  503.              end;
  504.     end;
  505.     end;
  506. end;
  507.  
  508. begin
  509.   init_program(scrn,video_mode);
  510.   segment:=0;
  511.   offset:=0;
  512.   quit:=false;
  513.   while not quit do
  514.     begin
  515.     get_segment(segment,offset,seg_data);
  516.     convert_seg(seg_data,scrn);
  517.     put_address(segment,offset,scrn);
  518.     put_screen(scrn);
  519.     process_command(segment,offset,quit);
  520.     end;
  521. end.