home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol270 / sed.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-05-22  |  3.5 KB  |  115 lines
  1. {  Small editor                            }
  2. {     by K.Nakazato  Ver. 1.00 10-Feb-1984 }
  3. {                         1.12  2-Jun-1984 }
  4.  
  5. const
  6.     maxtext   =$7FFF;
  7.     newline   =#$0D;
  8.     mark      =#$87;
  9.     startblock=#$E7;
  10.     endblock  =#$E4;
  11. type
  12.     linetype=string[30];
  13.     frtype=(nosym,findsym,replacesym);
  14. var
  15.     vram   :integer absolute $EDD0;
  16.     vram1  :integer absolute $EDD2;
  17.     ptop   :integer absolute $EDD4;
  18.     pbotm  :integer absolute $EDD6;
  19.     len    :integer absolute $EDD8;
  20.     address:integer absolute $EDDA;
  21.     width  :byte    absolute $EDDC;
  22.  
  23.     numbuf :byte                  absolute $EDE0;
  24.     sbuffer:string[80]            absolute $EDE0;
  25.     buffer :array [1..80] of char absolute $EDE1;
  26.  
  27.     insert:boolean;
  28.     r:char;
  29.     x,y,i,slength,halflength:byte;
  30.     startaddress,endaddress,n:integer;
  31.     textbuf:array [0..maxtext] of char;
  32.     filename,line1,line2:linetype;
  33.     wordset :set of char;
  34.     vramaddr:array [0..24] of integer;
  35.     fr:frtype;
  36.  
  37. {$I SED1.INC}
  38. {$I SED2.INC}
  39. {$I SED3.INC}
  40. {$I SED4.INC}
  41. {$I SED5.INC}
  42. {$I SED6.INC}
  43.  
  44. begin
  45.   wordset:=['0'..'9','A'..'Z','a'..'z'];
  46.   slength:=23; width:=80; halflength:=slength div 2; fr:=nosym;
  47.   crtinit; setvramaddr; settext; dispinsert; newscreen;
  48.   repeat
  49.     checkbuf; pline(y); numbuf:=width;
  50.     gotoxy(x,y+1); read(kbd,r);
  51.     case chr(ord(r)+ord('@')) of
  52.       'G':deletechar;
  53.       'S','H':if x>1 then x:=x-1;
  54.       'V':begin insert:=not insert; dispinsert end;
  55.       'I':begin x:=8*((x-1) div 8)+9; if x>width then x:=width end;
  56.       'D':if x<width then x:=x+1;
  57.       'T':begin
  58.             setnumbuf;
  59.             if x<=numbuf then deleteword
  60.             else begin connectline; newscreen end
  61.           end;
  62.       'N':begin replaceline(x,0,newline); i:=getline(0,1); newscreen end;
  63.       'R':begin i:=getline(0,slength); newscreen end;
  64.       'C':begin i:=getline(slength,0); newscreen end;
  65.       'L':begin
  66.             if fr=findsym then find1(n)
  67.             else if fr=replacesym then replace1(n);
  68.             newscreen
  69.           end;
  70.       'X':linedown;
  71.       '^':begin x:=1; y:=getline(1,y) end;
  72.       'E':lineup;
  73.       'M':begin linedown; mostleft end;
  74.       'B':begin mostleft; pushbottom; numbuf:=0; rolldown(y,slength) end;
  75.       'Y':begin
  76.             rollup(y,slength); popbottom;
  77.             pline(getline(slength,y)); y:=getline(y,slength)
  78.           end;
  79.       'A':wordleft;
  80.       'F':wordright;
  81.       'Z':screenup;
  82.       'W':screendown;
  83.       #$BF:if x>1 then begin x:=x-1; deletechar end;
  84.       'Q':case getnextc('Q') of
  85.             'Y':numbuf:=x-1;
  86.             'S':mostleft;
  87.             'D':mostright;
  88.             'R':begin x:=1; y:=1; texttop; newscreen end;
  89.             'C':begin y:=halflength; textbottom; x:=numbuf; newscreen end;
  90.             'F':begin find; newscreen; dispinsert end;
  91.             'A':begin replace; newscreen; dispinsert end;
  92.           else;
  93.           end;
  94.       'K':case getnextc('K') of
  95.             'B':insertchar(startblock);
  96.             'K':insertchar(endblock);
  97.             'W':begin writeblock; dispinsert end;
  98.             'D':begin outtext; newscreen; dispinsert end;
  99.             'C':begin cmblock(true); newscreen end;
  100.             'V':begin cmblock(false); newscreen end;
  101.             'Y':begin eraseblock; newscreen end;
  102.             'R':begin readblock; newscreen; dispinsert end;
  103.             'X':begin erasemark; newscreen end;
  104.           else;
  105.           end;
  106.     else
  107.       if r>=' ' then
  108.         begin
  109.           if insert then insertchar(r) else buffer[x]:=r;
  110.           if x<width then x:=x+1
  111.         end
  112.     end;
  113. until false
  114. end.
  115.