home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol255 / dpedit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-03-22  |  10.6 KB  |  384 lines
  1. MODULE DPEDIT;  { Edit module for CP/M80 and CP/M86 }
  2. {-------------------------------------------------------------}
  3. {                                                             }
  4. {       Program Title: Floppy Disk  Patch Program             }
  5. {                                                             }
  6. {       Program  file:  DPM.PAS         ... Main control      }
  7. {                       DPEDIT.PAS      ... Edit module       }
  8. {                       DPIO.PAS        ... I/O  module       }
  9. {                       DPL.CMD         ... Linkage parameter }
  10. {                                                             }
  11. {       Last update : 21-Oct-1984 by K.Maeda                  }
  12. {                                                             }
  13. {           Note : This program was originally written by     }
  14. {               Keizo Maeda and checked (and enhanced) by     }
  15. {               Sakurao Nemoto and is a Public Domain Soft-   }
  16. {               ware (JUG-CP/M). If you make revisions, etc.  }
  17. {               please leave the author and modifiers name    }
  18. {               in the source file. Thank you.                }
  19. {                                                             }
  20. {          Ver-Rev :                                          }
  21. {                       0.0 : 7 July, 83       by  K.Maeda    }
  22. {                       2.0 : 28 July,83                      }
  23. {                             ...check sum...  by  S.Nemoto   }
  24. {                       3.0 : 20 September,83                 }
  25. {                             ...8 inch support...            }
  26. {                       5.3 : 6 November, 83                  }
  27. {                             ...Printing Hard Copy...        }
  28. {                       5.5 : 23 December,83                  }
  29. {                             ...Read EBCDIK code...          }
  30. {                       6.0 : 12 May,84                       }
  31. {                             ...Make File...                 }
  32. {                       6.1 : 18 May,84                       }
  33. {                             ...Exclusive Find...            }
  34. {                       6.2 : 17 June,84                      }
  35. {                       6.3 : 21 October,84                   }
  36. {                             ...beep at print_mode...        }
  37. {                                                             }
  38. {-------------------------------------------------------------}
  39.  
  40.  
  41. const
  42.    left_x = 5;
  43.    right_x= 52;
  44.    bound_x=28;
  45.    c_off_x=62;
  46.  
  47.    y_top  = 3;
  48.    y_bot  =18;
  49.  
  50.    ctrl_a = 1;
  51.    ctrl_b = 2;
  52.    ctrl_c = 3;
  53.    ctrl_d = 4;
  54.    ctrl_e = 5;
  55.    ctrl_l =12;
  56.    ctrl_s =19;
  57.    ctrl_x =24;
  58.    bs     = 8;
  59.    esc    =27;
  60.    ctrl_ar=$1e;
  61.  
  62. type
  63.    buffer = array[0..255] of byte;
  64.    iooperation  = (get_disk, put_disk);
  65. var
  66.    px,py:       integer;
  67.    dval:        integer;
  68.  
  69.    ch:          external char;
  70.    str:         external string;
  71.    delimiter:   external char;
  72.    buff:        external array[0..15] of buffer;
  73.  
  74.    in_drive,in_trk,in_trk_num,
  75.    in_sec,in_sec_num,in_skew,
  76.    o_drive, o_trk, o_trk_num,
  77.    o_sec, o_sec_num, o_skew  : external integer;
  78.    ch_drv, ch_drv_o :          external char;
  79.  
  80.    flg_85 : external boolean;
  81.    f_exit ,
  82.    noerr  : external boolean;
  83.    fl_type: external string;
  84.  
  85. external procedure sb_out_ch(ch:char);
  86. external function  sb_get_ch : char;
  87. external function  sb_up_case(ch:char) : char;
  88. external procedure chex( x:byte );
  89. external procedure xygoto(x,y : integer);
  90. external procedure prnt_at(row,col:integer; str:string);
  91. external procedure sb_clr_scrn;
  92. external procedure sb_clr_line;
  93. external procedure wboot;
  94. external function  get_str(var str:string; var delimiter:char):
  95.                         integer;
  96. external function  get_num(var str:string; delimiter:char):integer;
  97.  
  98.  
  99. external procedure dump_buff;
  100. external procedure put_buff (var buff:buffer; var noerr:boolean);
  101. external procedure get_buff (var buff:buffer; var noerr:boolean);
  102. external procedure ioerror( ie : iooperation );
  103. external procedure kind_dsk(drive:integer;var fl_type:string;
  104.            var trk_num,sec_num,skew:integer; var noerr:boolean);
  105. external procedure slip;
  106. external procedure count_up(var trk,sec,sec_num:integer);
  107. external procedure cascii(i:byte);
  108. external function  cval( c:char ) : byte;
  109. external procedure out_d_set;
  110. external procedure in_d_set;
  111. external procedure in_d_rset;
  112.  
  113. (*$E-*)
  114. procedure move_r;   { set right position   to px,py }
  115. var mx : integer;
  116. begin
  117.   px:=px+1;
  118.   mx:=(px-1) mod 3;
  119.   if px >=bound_x then if px=bound_x then px:=bound_x+1
  120.                                      else mx:=(px-2) mod 3;
  121.  
  122.   if mx = 0  then px:=px+1;
  123.   if px > right_x then
  124.   begin
  125.     px:=left_x;
  126.     py:=py+1;
  127.     if py>y_bot   then begin
  128.                     py:=y_bot;
  129.                     px:=right_x
  130.                   end;
  131.   end;
  132. end;
  133.  
  134. procedure move_l;   { set left  position   to px,py }
  135. var mx : integer;
  136. begin
  137.   px:=px-1;
  138.   mx:=(px-1) mod 3;
  139.   if px >=(bound_x+1) then  if px=(bound_x+1) then px:=bound_x-1
  140.                                               else mx:=(px-2) mod 3;
  141.  
  142.   if mx=0  then px:=px-1;
  143.   if px<left_x then
  144.   begin
  145.     px:=right_x;
  146.     py:=py-1;
  147.     if py<y_top  then begin
  148.                    py:=y_top;
  149.                    px:=left_x
  150.                  end;
  151.   end;
  152. end;
  153.  
  154. procedure set_val;   { set value to buff[*]  and display  }
  155. var
  156.   i,n,cx,cy,mx : integer;
  157. begin
  158.     sb_out_ch(ch);
  159.     if px<bound_x then cx:=(px-left_x)   div 3
  160.                   else cx:=(px-left_x-1) div 3;
  161.     cy:=py;
  162.     n:=cx+(py-y_top)*16;
  163.  
  164.     if px<bound_x then mx:=(px-left_x)   mod 3
  165.                   else mx:=(px-left_x-1) mod 3;
  166.     if mx=1 then   { right hand value }
  167.     begin
  168.       i:=buff[0][n] div 16;
  169.       buff[0][n]:=i*16+dval;
  170.     end
  171.     else begin     { left  hand value }
  172.       i:=buff[0][n] mod 16;
  173.       buff[0][n]:=dval*16+i;
  174.     end;
  175.  
  176.     move_r;
  177.  
  178.     cx:=cx+c_off_x;
  179.     xygoto(cx,cy);
  180.     cascii(buff[0][n]);
  181.     xygoto(px,py);
  182. end;
  183.  
  184. procedure edit_char;
  185. var
  186.   i,n,mx,cx,cy : integer;
  187.  
  188.   procedure ch_adr;
  189.   begin
  190.     if px<bound_x then cx:=(px-left_x)   div 3
  191.                   else cx:=(px-left_x-1) div 3;
  192.     cy:=py;
  193.     cx:=cx+c_off_x;
  194.   end;
  195.  
  196.  
  197.  
  198. begin
  199.   px := ( (px+1) div 3 ) * 3 -1;
  200.   if px >=(bound_x-1)  then px:=px+1;
  201.  
  202.   repeat
  203.         ch_adr;
  204.         xygoto(cx,cy);
  205.         ch:=sb_getch;
  206.  
  207.         if (ch<' ') then begin
  208.           case ord(ch) of
  209.  
  210.           ctrl_a : begin ch:=chr(0); exit end;
  211.           ctrl_e : begin
  212.                         py:=py-1;
  213.                         if py<y_top then py:=y_top;
  214.                    end;
  215.           ctrl_x : begin
  216.                         py:=py+1;
  217.                         if py>y_bot then py:=y_bot;
  218.                    end;
  219.           ctrl_d : begin
  220.                         move_r; move_r end;
  221.           ctrl_s : begin
  222.                         move_l; move_l end;
  223.           bs     : begin
  224.                         move_l; move_l end;
  225.           ctrl_b : if px=left_x then px:=right_x-1
  226.                                  else px:=left_x;
  227.           ctrl_ar: if py=y_top  then py:=y_bot
  228.                                  else py:=y_top;
  229.  
  230.         end; { case }
  231.  
  232.         ch_adr;
  233.         xy_goto(cx,cy);
  234.         end; { if }
  235.  
  236.      if (ch>=' ') and (ch<chr($ff))
  237.      then begin
  238.         sb_out_ch( ch );
  239.         n:=cx-c_off_x +(py-y_top) *16;
  240.         buff[0][n] := cval(ch);
  241.         xygoto( px,py ); chex( buff[0][n] );
  242.         move_r; move_r; ch_adr;
  243.      end;
  244.   until ch=chr(esc);
  245. end;
  246.  
  247. (*$E+*)
  248.  
  249.  
  250. procedure edit_buff;   { screen edit buff (use hex code) }
  251. begin
  252.   px:=left_x;  py:=y_top;
  253.   xygoto(1,21);   sb_clr_line;
  254.   prnt_at(21,0,
  255. '^E:up, ^X:down, ^D:right, ^S:left, ^^:top/bot, ^A:hex/char, <esc>:exit     ');
  256.   xygoto(left_x,y_top);
  257.  
  258.   repeat
  259.     ch:=sb_up_case(sb_getch);
  260.  
  261.     if (ord(ch)<31) or (ch=' ') then
  262.     begin
  263.       case ord(ch) of
  264.  
  265.     ctrl_a: edit_char;
  266.  
  267.     ctrl_e: begin
  268.               py:=py-1;
  269.               if py<y_top then py:=y_top;
  270.             end;
  271.     ctrl_x: begin
  272.               py:=py+1;
  273.               if py>y_bot then py:=y_bot;
  274.             end;
  275.     ctrl_d: move_r;
  276.     ctrl_s: move_l;
  277.     bs    : move_l;
  278.     ctrl_b: if px=left_x then px:=right_x else px:=left_x;
  279.     ctrl_ar:if py=y_top  then py:=y_bot   else py:=y_top;
  280.       end;
  281.  
  282.       if ch=' ' then move_r;
  283.       xygoto(px,py)
  284.     end;
  285.  
  286.     if (ch>='0') and (ch<='9') then
  287.     begin
  288.       dval:=ord(ch)-48;
  289.       set_val
  290.     end;
  291.     if (ch>='A') and (ch<='F') then
  292.     begin
  293.       dval:=ord(ch)-55;
  294.       set_val
  295.     end;
  296.  
  297.   until (ch=chr(esc));
  298. end;
  299.  
  300. procedure wr_buff;   { write buff to sector }
  301. var
  302.    ch: char;
  303.    i : integer;
  304. begin
  305.   xygoto(1,21);     sb_clr_line;
  306.   prnt_at(21,0,
  307. 'Command?   W)rite same sector, A)nother sector, C)ancel                    ');
  308.   xygoto(8,21);
  309.   ch:=sb_up_case(sb_getch);
  310.   if ch <> chr(esc) then sb_out_ch(ch);
  311.  
  312.   case ch of
  313.  
  314.   'W': begin
  315.        f_exit:=true;
  316.        put_buff(buff[0],noerr);
  317.        if (not noerr) then ioerror(put_disk);
  318.        count_up(in_trk,in_sec,in_sec_num);
  319.        if in_trk >= in_trk_num then begin
  320.                                     in_trk:=in_trk_num-1;
  321.                                     in_sec:=in_sec_num
  322.                                end;
  323.        end;
  324.   'A': begin
  325.        f_exit:=true;
  326.        sb_clr_line;
  327.        prnt_at(21,0,
  328. 'Drive:   Type:      Track:    Sector:                                      ');
  329.  
  330.        repeat
  331.        repeat
  332.          xygoto(6,21);
  333.          i:=get_str(str,delimiter);
  334.          if i=1 then ch:=sb_up_case(str[1])
  335.                 else ch:=' ';
  336.          o_drive:=ord(ch)-65;
  337.         until (o_drive>=0) and (o_drive<7);
  338.          ch_drv_o:=ch;
  339.          kind_dsk( o_drive,fl_type,o_trk_num,o_sec_num,o_skew,noerr );
  340.         until  noerr ;
  341.        o_skew:=0;
  342.        if o_trk_num > 40 then flg_85:=true;
  343.  
  344.        xygoto(14,21);
  345.        write([addr(sb_out_ch)],fl_type);
  346.  
  347.        repeat
  348.          xygoto(26,21);
  349.          i:=get_str(str,delimiter);
  350.          o_trk:=get_num(str,' ');
  351.          xygoto(26,21);
  352.          write([addr(sb_out_ch)],o_trk,' ');
  353.        until (o_trk < o_trk_num);
  354.  
  355.        repeat
  356.          xygoto(37,21);
  357.          i:=get_str(str,delimiter);
  358.          o_sec:=get_num(str,' ');
  359.          xygoto(37,21);
  360.          write([addr(sb_out_ch)],o_sec,'    ');sb_clr_line;
  361.        until (o_sec <= o_sec_num) and (o_sec > 0);
  362.  
  363.        in_d_rset;  out_d_set;               { parm  in->p,  o->in  }
  364.        slip;
  365.        put_buff( buff[0],noerr );
  366.        if (not noerr) then ioerror(put_disk);
  367.        if flg_85 then get_buff( buff[0],noerr ); { get after put }
  368.        if (not noerr) then ioerror(put_disk);
  369.        in_d_set;                            { parm  p->in }
  370.  
  371.        count_up(in_trk,in_sec,in_sec_num);
  372.        if in_trk >= in_trk_num then begin
  373.                                     in_trk:=in_trk_num-1;
  374.                                     in_sec:=in_sec_num
  375.                                end;
  376.      end;
  377.  
  378.   'C': prnt_at(21,1,'Canceled...');
  379.  
  380.   end;
  381. end;
  382.  
  383. MODEND.
  384.