home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / pascal / EDSCREEN.ZIP / EDSCREEN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-05-30  |  51.7 KB  |  1,725 lines
  1. (*****************************************************************************)
  2. (*                                                                           *)
  3. (*                   F U L L   S C R E E N   E D I T O R                     *)
  4. (*                                                                           *)
  5. (*                                                                           *)
  6. (*                           By Martine Wedlake                              *)
  7. (*                                                                           *)
  8. (*       This  programme  may be copied,  or modified in  any way  for non-  *)
  9. (*  commercial uses.  If you would like to use this programme in a business  *)
  10. (*  environment please write  me for licencing,  and so I can keep track of  *)
  11. (*  its success.   If you like this programme a  donation would  be awfully  *)
  12. (*  nice of you.  Thanks!                                                    *)
  13. (*                                Martine Wedlake                            *)
  14. (*                                4551 N.E. Simpson St.                      *)
  15. (*                                Portland Or                                *)
  16. (*                                97218                                      *)
  17. (*                                                                           *)
  18. (*****************************************************************************)
  19.  
  20. program screen_editor;
  21. {$C-}                       {Turn off user interrupt}
  22. {$U-}
  23. const
  24.   base_screen=$b800;
  25.   configfile='EDSCREEN.CNF';    {The configureation filename}
  26.   helpfile='EDSCREEN.HLP';      {The help screen filename}
  27.   max_levels=19;                {The maximum number of graphic levels}
  28.   version='V1.0';
  29. type
  30.   character_12_array=array[1..12] of char;
  31.   str12=string[12];
  32.   Str20=string[20];
  33.   str64=string[64];
  34.   graph_type=array[1..max_levels,1..8] of char;
  35.   config=record                             {for data file...}
  36.            graphic_letters:graph_type;
  37.            insert_mode:boolean;
  38.            help:boolean;
  39.            forg:integer;
  40.            back:integer;
  41.            help_path:str64;
  42.          end;
  43.  
  44. var
  45.   graphic_level,            {The level of the graphic characters}
  46.   forground,                {colours}
  47.   background:integer;
  48.   insert,                   {if insert on}
  49.   blinking,                    {if blink on}
  50.   help_on_disk:boolean;     {if help found on the disk}
  51.   graphic:graph_type;       {storage for graphic chars}
  52.   helpPath,
  53.   default_path:str64;
  54.  
  55. PROCEDURE Dir(msk:character_12_array;subdir:boolean);
  56. TYPE
  57.   RegRec=record
  58.            AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : INTEGER;
  59.          end;
  60. VAR
  61.   attribute:integer;
  62.   regs:regrec;
  63.   dta:array [1..43] of byte;
  64.   namr:str20;
  65.   mask:character_12_array;
  66.   error,
  67.   i:integer;
  68. BEGIN
  69.   mask:=msk;                             {doesn't seem to work otherwise}
  70.   fillchar(dta,sizeof(dta),0);           {blank out dta and resulting name}
  71.   FillChar(namr,sizeof(namr),0);
  72.   regs.ax := $1A00;                      {Function to set dta address}
  73.   regs.ds := seg(dta);                   {ds:dx is the location of dta}
  74.   Regs.DX := Ofs(DTA);
  75.   msdos(regs);
  76.   error := 0;
  77.   regs.ax := $4E00;                      {function to search for first match}
  78.   regs.ds := seg(mask);                  {ds:dx is the location of filename}
  79.   regs.dx := ofs(mask);
  80.   regs.cx := 22;                         {search for any attribute setting}
  81.   msdos(regs);
  82.   attribute:=mem[seg(dta):ofs(dta)+21];  {get files attribute}
  83.   error := regs.ax and $FF;              {if error returned, ie no file}
  84.   i := 1;
  85.   if (error = 0) then                    {get name from DTA}
  86.   repeat
  87.     namr[i] := chr(mem[seg(dta):ofs(dta)+29+i]);
  88.     i := i + 1;
  89.   until not (namr[I-1] in [' '..'~']) or (i>20);
  90.   namr[0] := chr(i-1);                    {set length of the returning string}
  91.   if ((subdir) and (attribute=16)) or (not subdir) then
  92.     write(NamR:20);                       {write name only if the correct kind of file}
  93.   while (error = 0) do                    {loop until error}
  94.   begin
  95.     Error := 0;
  96.     regs.ax := $4F00;                     {function to search for next match}
  97.     regs.cx := 22;                        {again.. look for any file }
  98.     msdos( regs );
  99.     attribute:=mem[seg(dta):ofs(dta)+21]; {get the attribute of the file}
  100.     error := regs.ax and $FF;             {return error...}
  101.     i := 1;
  102.     REPEAT                                 {create string}
  103.       namr[i] := chr(mem[seg(dta):ofs(dta)+29+i]);
  104.       i := i + 1;
  105.     until not (namr[i-1] in [' '..'~'] ) or (i > 20);
  106.     namr[0] := chr(i-1);
  107.     if (((subdir) and (attribute=16)) or (not subdir)) and (error=0) then
  108.       write(NamR:20);                      {check file}
  109.   end;
  110. end;                                       {end of Dir}
  111.  
  112. procedure video(cond:boolean);{--------------Turns on or off the display}
  113. begin
  114.   repeat until port[$3da] and 8=8;          {wait for video sync}
  115.   if cond then
  116.     port[$3d8]:=mem[$40:$65] or 8           {restore display}
  117.   else
  118.     port[$3d8]:=$25;                        {turn off display by setting regs}
  119. end;                                        {end of video procedure}
  120.  
  121. PROCEDURE cursor(on:BOOLEAN);{---------------This sets the cursor on/off}
  122. CONST
  123.   video_io=$10;                             {this is the interrupt number}
  124. VAR
  125.   regs:RECORD CASE INTEGER OF               {this sets up the registers}
  126.                 1: (AX,BX,CX,DX,BP,DI,SI,DS,ES,Flags: INTEGER);
  127.                 2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  128.               END;
  129. BEGIN
  130.   IF on THEN                                {if the user wants a cursor then}
  131.   BEGIN
  132.     regs.ch:=$06;                           {set the registers up for display}
  133.     regs.cl:=$07;                           {ch = start line, cl = end line}
  134.   END
  135.   ELSE                                      {else, the cursor is not displayed}
  136.   BEGIN
  137.     regs.ch:=$20;                           {set the register up for non-}
  138.     regs.cl:=$00;                           {display, ch=$20 doesn't display}
  139.   END;
  140.   regs.ah:=$01;
  141.   regs.al:=$00;
  142.   Intr(video_io,regs);
  143. END;
  144.  
  145. function exist(filename:str12)    {------tests if a file exists}
  146.                :boolean;
  147. var
  148.   f_test:file;
  149.  
  150. begin
  151.   assign(f_test,filename);
  152.   {$I-}
  153.   reset(f_test);
  154.   {$I+}
  155.   exist:=(ioresult = 0);
  156.   close(f_test);
  157. end;                                        {End of function exist}
  158.  
  159. procedure beep;
  160. begin
  161.   sound(85);
  162.   delay(400);
  163.   nosound;
  164. end;
  165.  
  166. procedure put_status(del:boolean);{-----------Puts status line on line 25}
  167. var
  168.   x,
  169.   y,
  170.   counter:integer;
  171. begin
  172.   cursor(false);
  173.   x:=wherex;
  174.   y:=wherey;
  175.   textcolor(white);                          {Set colour and such}
  176.   textbackground(black);
  177.   gotoxy(1,25);
  178.   if del then clreol;
  179.   gotoxy(10,25);
  180.   write('Forg:     Back:      Graph:');      {Put info on screen, but NO DATA}
  181.   gotoxy(48,25);                             {EXCEPT for graphic chars}
  182.   for counter:=1 to 8 do
  183.   begin
  184.     textcolor(white);
  185.     write(counter);
  186.     textcolor(lightblue);
  187.     write(graphic[graphic_level,counter],' ');
  188.   end;
  189.   textcolor(forground);
  190.   textcolor(background);
  191.   gotoxy(x,y);
  192.   cursor(true);
  193. end;                                        {End of Put_status}
  194.  
  195. procedure show_status;{----------------------Fills in the status line with data}
  196. var
  197.   x,y:integer;
  198. begin
  199.   cursor(false);
  200.   x:=wherex;
  201.   y:=wherey;
  202.   textcolor(white);
  203.   textbackground(black);
  204.   gotoxy(1,25);
  205.   write('[',x:2,',',y:2,']');               {Put in co-ordinates}
  206.   textcolor(forground);
  207.   textbackground(background);
  208.   gotoxy(16,25);
  209.   write(forground:2);                       {Put colours on status line}
  210.   gotoxy(26,25);
  211.   write(background:2);
  212.   textcolor(white);
  213.   textbackground(black);
  214.   gotoxy(38,25);
  215.   write(graphic_level:2);                   {write out the graph level}
  216.   gotoxy(42,25);
  217.   if insert then write('INS') else write('OVR');{Insert or Overstrike}
  218.   textcolor(forground);
  219.   textbackground(background);
  220.   gotoxy(x,y);
  221.   cursor(true);
  222. end;                                        {end of show_status}
  223.  
  224. procedure waitkey;
  225. var
  226.   key:char;
  227. begin
  228.   repeat until keypressed;
  229.   while keypressed do read(kbd,key);
  230. end;
  231.  
  232. procedure fatal_error(error:integer);{-------Called if unexpected happens}
  233. var
  234.   x,
  235.   y:integer;
  236.   key:char;
  237. begin
  238.   x:=wherex;
  239.   y:=wherey;
  240.   textcolor(white);
  241.   textbackground(black);
  242.   gotoxy(1,25);
  243.   clreol;
  244.   beep;
  245.   case error of
  246.     $F0:write('Disk Write Error - Disk full.');
  247.     $F1:write('Disk Directory Full - Too many files on root directory.');
  248.     else write('Unknown Error - The Error number (IOResult) is: ',error:2);
  249.   end;
  250.   write('  << Press a key >>');
  251.   waitkey;
  252.   textcolor(forground);
  253.   textbackground(background);
  254.   put_status(true);
  255.   gotoxy(x,y);
  256. end;                                        {End of procedure fatal_error}
  257.  
  258. procedure initialize_editor(set_screen:boolean);{Initializes the variables}
  259. var
  260.   f_configure:file of config;
  261.   configure:config;
  262.   level,
  263.   letter,
  264.   error:integer;
  265. begin
  266.   if not exist(configfile) then         {if no config file on disk then}
  267.   begin                                     {set defaults...}
  268.     graphic[1,1]:=#205;                     {Graphic character defaults}
  269.     graphic[1,2]:=#186;
  270.     graphic[1,3]:=#187;
  271.     graphic[1,4]:=#201;
  272.     graphic[1,5]:=#188;
  273.     graphic[1,6]:=#200;
  274.     graphic[1,7]:=#206;
  275.     graphic[1,8]:=#215;
  276.     graphic[2,1]:=#196;
  277.     graphic[2,2]:=#179;
  278.     graphic[2,3]:=#191;
  279.     graphic[2,4]:=#218;
  280.     graphic[2,5]:=#217;
  281.     graphic[2,6]:=#192;
  282.     graphic[2,7]:=#197;
  283.     graphic[2,8]:=#216;
  284.     graphic[3,1]:=#180;
  285.     graphic[3,2]:=#195;
  286.     graphic[3,3]:=#194;
  287.     graphic[3,4]:=#193;
  288.     graphic[3,5]:=#185;
  289.     graphic[3,6]:=#204;
  290.     graphic[3,7]:=#203;
  291.     graphic[3,8]:=#202;
  292.     graphic[4,1]:=#184;
  293.     graphic[4,2]:=#213;
  294.     graphic[4,3]:=#190;
  295.     graphic[4,4]:=#212;
  296.     graphic[4,5]:=#183;
  297.     graphic[4,6]:=#214;
  298.     graphic[4,7]:=#189;
  299.     graphic[4,8]:=#211;
  300.     graphic[5,1]:=#181;
  301.     graphic[5,2]:=#198;
  302.     graphic[5,3]:=#208;
  303.     graphic[5,4]:=#210;
  304.     graphic[5,5]:=#182;
  305.     graphic[5,6]:=#199;
  306.     graphic[5,7]:=#207;
  307.     graphic[5,8]:=#209;
  308.     graphic[6,1]:=#219;
  309.     graphic[6,2]:=#220;
  310.     graphic[6,3]:=#221;
  311.     graphic[6,4]:=#222;
  312.     graphic[6,5]:=#223;
  313.     graphic[6,6]:=#176;
  314.     graphic[6,7]:=#177;
  315.     graphic[6,8]:=#178;
  316.     graphic[7,1]:=#142;
  317.     graphic[7,2]:=#143;
  318.     graphic[7,3]:=#146;
  319.     graphic[7,4]:=#128;
  320.     graphic[7,5]:=#144;
  321.     graphic[7,6]:=#153;
  322.     graphic[7,7]:=#154;
  323.     graphic[7,8]:=#165;
  324.     graphic[8,1]:=#131;
  325.     graphic[8,2]:=#132;
  326.     graphic[8,3]:=#133;
  327.     graphic[8,4]:=#134;
  328.     graphic[8,5]:=#145;
  329.     graphic[8,6]:=#160;
  330.     graphic[8,7]:=#166;
  331.     graphic[8,8]:=#032;
  332.     graphic[9,1]:=#130;
  333.     graphic[9,2]:=#136;
  334.     graphic[9,3]:=#137;
  335.     graphic[9,4]:=#138;
  336.     graphic[9,5]:=#139;
  337.     graphic[9,6]:=#140;
  338.     graphic[9,7]:=#141;
  339.     graphic[9,8]:=#161;
  340.     graphic[10,1]:=#147;
  341.     graphic[10,2]:=#148;
  342.     graphic[10,3]:=#149;
  343.     graphic[10,4]:=#162;
  344.     graphic[10,5]:=#167;
  345.     graphic[10,6]:=#032;
  346.     graphic[10,7]:=#032;
  347.     graphic[10,8]:=#032;
  348.     graphic[11,1]:=#129;
  349.     graphic[11,2]:=#150;
  350.     graphic[11,3]:=#151;
  351.     graphic[11,4]:=#163;
  352.     graphic[11,5]:=#032;
  353.     graphic[11,6]:=#032;
  354.     graphic[11,7]:=#032;
  355.     graphic[11,8]:=#032;
  356.     graphic[12,1]:=#135;
  357.     graphic[12,2]:=#152;
  358.     graphic[12,3]:=#164;
  359.     graphic[12,4]:=#168;
  360.     graphic[12,5]:=#159;
  361.     graphic[12,6]:=#158;
  362.     graphic[12,7]:=#157;
  363.     graphic[12,8]:=#173;
  364.     graphic[13,1]:=#155;
  365.     graphic[13,2]:=#156;
  366.     graphic[13,3]:=#171;
  367.     graphic[13,4]:=#172;
  368.     graphic[13,5]:=#174;
  369.     graphic[13,6]:=#175;
  370.     graphic[13,7]:=#169;
  371.     graphic[13,8]:=#170;
  372.     graphic[14,1]:=#226;
  373.     graphic[14,2]:=#127;
  374.     graphic[14,3]:=#233;
  375.     graphic[14,4]:=#240;
  376.     graphic[14,5]:=#228;
  377.     graphic[14,6]:=#232;
  378.     graphic[14,7]:=#234;
  379.     graphic[14,8]:=#032;
  380.     graphic[15,1]:=#224;
  381.     graphic[15,2]:=#225;
  382.     graphic[15,3]:=#227;
  383.     graphic[15,4]:=#229;
  384.     graphic[15,5]:=#230;
  385.     graphic[15,6]:=#231;
  386.     graphic[15,7]:=#233;
  387.     graphic[15,8]:=#236;
  388.     graphic[16,1]:=#237;
  389.     graphic[16,2]:=#238;
  390.     graphic[16,3]:=#239;
  391.     graphic[16,4]:=#241;
  392.     graphic[16,5]:=#242;
  393.     graphic[16,6]:=#243;
  394.     graphic[16,7]:=#244;
  395.     graphic[16,8]:=#245;
  396.     graphic[17,1]:=#246;
  397.     graphic[17,2]:=#247;
  398.     graphic[17,3]:=#248;
  399.     graphic[17,4]:=#249;
  400.     graphic[17,5]:=#250;
  401.     graphic[17,6]:=#251;
  402.     graphic[17,7]:=#252;
  403.     graphic[17,8]:=#253;
  404.     graphic[18,1]:=#003;
  405.     graphic[18,2]:=#004;
  406.     graphic[18,3]:=#005;
  407.     graphic[18,4]:=#006;
  408.     graphic[18,5]:=#024;
  409.     graphic[18,6]:=#025;
  410.     graphic[18,7]:=#026;
  411.     graphic[18,8]:=#027;
  412.     graphic[19,1]:=#001;
  413.     graphic[19,2]:=#002;
  414.     graphic[19,3]:=#016;
  415.     graphic[19,4]:=#017;
  416.     graphic[19,5]:=#018;
  417.     graphic[19,6]:=#023;
  418.     graphic[19,7]:=#019;
  419.     graphic[19,8]:=#020;
  420.     help_on_disk:=true;                     {other defaults..}
  421.     helpPath:='A:\';
  422.     insert:=false;
  423.     forground:=lightgray;
  424.     background:=black;
  425.   end
  426.    else                                     {Config file found so load info}
  427.   begin
  428.     assign(f_configure,configfile);
  429.     {$i-}
  430.     reset(f_configure);
  431.     read(f_configure,configure);
  432.     close(f_configure);
  433.     {$i+}
  434.     error:=ioresult;
  435.     if error<>0 then fatal_error(error);        {Unexpected has happened}
  436.     with configure do
  437.     begin
  438.       help_on_disk:=help;                    {set internal variables}
  439.       helpPath:=Help_path;
  440.       insert:=insert_mode;
  441.       forground:=forg;
  442.       background:=back;
  443.       graphic:=graphic_letters;             {set graphic chars}
  444.     end;
  445.   end;
  446.   blinking:=false;                             {Blink always false at start}
  447.   graphic_level:=1;                         {graph level at 1}
  448.   getdir(0,default_path);
  449.   if set_screen then
  450.   begin
  451.     textbackground(background);               {set colour on scren}
  452.     textcolor(forground);
  453.     clrscr;                                   {after colour change to set background}
  454.     put_status(false);                        {display status line}
  455.   end;
  456. end;                                        {end of initialize_editor}
  457.  
  458.  
  459. procedure quit;{-----------------------------if user wants to exit..}
  460. var
  461.   x,
  462.   y:integer;
  463.   key:char;
  464. begin
  465.   x:=wherex;
  466.   y:=wherey;
  467.   textcolor(white);
  468.   textbackground(black);
  469.   gotoxy(1,25);
  470.   clreol;
  471.   write('Do you really want to quit [Y/N] ? '); {validate purpose}
  472.   repeat
  473.     read(kbd,key);
  474.     key:=upcase(key);
  475.     if (key<>'Y') and (key<>'N') then beep;
  476.   until key in['Y','N'];
  477.   if key='Y' then
  478.   begin
  479.     clrscr;
  480.     chdir(default_path);
  481.     halt;
  482.   end;
  483.   put_status(true);
  484.   gotoxy(x,y);
  485. end;                                        {end of quit}
  486.  
  487. {$i title.pas}
  488.  
  489. procedure put_char(x,y,lett,colour:integer);{Puts char on screen fast}
  490. begin
  491.   mem[base_screen:((y-1)*160)+(x-1)*2]:=lett;       {x,y are normal co-ordinates}
  492.   mem[base_screen:((y-1)*160)+(x-1)*2+1]:=colour;   {colour is NOT turbo it is DOS standard}
  493. end;                                          {end of put_char}
  494.  
  495. function last_pos(y:integer):integer;{---------Find last position on line}
  496. var
  497.   x,
  498.   dummy:integer;
  499.   lett:char;
  500. begin
  501.   x:=80;                                      {loops until character is found}
  502.   repeat
  503.     lett:=chr(mem[base_screen:(y-1)*160+(x-1)*2]);
  504.     x:=x-1;
  505.   until (lett<>' ') or (x=0);
  506.   last_pos:=x+1;
  507. end;                                          {end of last_pos}
  508.  
  509. function first_pos(y:integer):integer;{--------Like above except other way}
  510. var
  511.   x,
  512.   dummy:integer;
  513.   lett:char;
  514. begin
  515.   x:=1;
  516.   repeat
  517.     lett:=chr(mem[base_screen:(y-1)*160+(x-1)*2]);
  518.     x:=x+1;
  519.   until (lett<>' ') or (x=82);
  520.   if x=82 then x:=2;
  521.   first_pos:=x-1;
  522. end;                                          {end of first_pos}
  523.  
  524. procedure do_delete;{--------------------------deletes at cursor}
  525. var
  526.   x,
  527.   tempx,
  528.   tempy,
  529.   colour,
  530.   letter:integer;
  531. begin
  532.   if wherex<=last_pos(wherey) then            {check validity}
  533.   begin
  534.     tempx:=wherex;
  535.     tempy:=wherey;
  536.     for x:=wherex+1 to last_pos(wherey) do
  537.     begin
  538.       letter:=mem[base_screen:((wherey-1)*160)+((x-1)*2)]; {move letters left}
  539.       colour:=mem[base_screen:((wherey-1)*160)+(x-1)*2+1];
  540.       put_char(x-1,wherey,letter,colour);
  541.     end;
  542.     gotoxy(last_pos(wherey),wherey);
  543.     write(' ');
  544.     gotoxy(tempx,tempy);
  545.   end;
  546. end;                                          {end of do_delete}
  547.  
  548. procedure do_backspace;{-----------------------will delete like backspace}
  549. var
  550.   letter,
  551.   dummy,
  552.   tempx,
  553.   tempy,
  554.   x,
  555.   colour:integer;
  556. begin
  557.   tempx:=wherex;
  558.   tempy:=wherey;
  559.   if wherex>1 then
  560.   begin
  561.     if insert then                            {if insert then move line over}
  562.     begin
  563.       if wherex<last_pos(tempy)+2 then
  564.       begin
  565.         for x:=wherex to last_pos(tempy) do
  566.         begin
  567.           letter:=mem[base_screen:((tempy-1)*160)+((x-1)*2)];
  568.           colour:=mem[base_screen:((tempy-1)*160)+(x-1)*2+1];
  569.           put_char(x-1,tempy,letter,colour);
  570.         end;
  571.         gotoxy(last_pos(tempy),tempy);
  572.         write(' ');
  573.         if last_pos(tempy)=80 then
  574.         begin
  575.           gotoxy(tempx,tempy-1);
  576.         end
  577.         else
  578.         begin
  579.           gotoxy(tempx,tempy);
  580.         end;
  581.       end
  582.     end
  583.     else write(^h' ');                        {else..don't worry about it}
  584.     gotoxy(wherex-1,tempy);
  585.   end;
  586. end;                                          {End of backspace}
  587.  
  588. procedure move_right;{-------------------------used for inserting characters}
  589. var
  590.   letter,
  591.   colour,
  592.   x,
  593.   y,
  594.   dummy:integer;
  595. begin
  596.   y:=wherey;
  597.   for x:=last_pos(wherey) downto wherex-1 do  {move right by going thru loop}
  598.   begin
  599.     if x<>80 then                             {check if past margin}
  600.     begin
  601.       letter:=mem[base_screen:((y-1)*160)+(x-1)*2];
  602.       colour:=mem[base_screen:((y-1)*160)+(x-1)*2+1];
  603.       put_char(x+1,y,letter,colour);
  604.     end;
  605.   end;
  606. end;                                          {end of move_right}
  607.  
  608. procedure save;{-------------------------------Saves the screen to disk}
  609. var
  610.   x,
  611.   y,
  612.   counter,
  613.   error:integer;
  614.   screen:array[0..1920] of integer absolute base_screen:0;
  615.   f_screen:file;
  616.   name:string[12];
  617.   do_it:boolean;
  618.   key:char;
  619. begin
  620.   x:=wherex;
  621.   y:=wherey;
  622.   textcolor(white);
  623.   textbackground(black);
  624.   gotoxy(1,25);
  625.   clreol;
  626.   name:='';                                   {input info required}
  627.   do_it:=true;
  628.   write('Enter filename to save [CR = Exit] : ');
  629.   buflen:=12;
  630.   read(name);
  631.   if name='' then do_it:=false;               {check if user wants to exit}
  632.   if pos('.',name)=0 then
  633.     if length(name)>8 then name:=copy(name,1,8)+'.SCR'
  634.      else
  635.        name:=name+'.SCR';
  636.   if do_it then
  637.   begin
  638.     if exist(name) then                       {check if file on disk already}
  639.     begin
  640.       gotoxy(1,25);                           {yes - so ask if delete old}
  641.       clreol;
  642.       write('WARNING - File already exists!   Overwrite [Y/N] ? ');
  643.       repeat
  644.         read(kbd,key);
  645.         key:=upcase(key);
  646.         if (key<>'Y') and (key<>'N') then beep;
  647.       until key in['Y','N'];
  648.       if key='N' then do_it:=false;           {set flag in response}
  649.     end;
  650.     if do_it then                             {if user wants to save it then..}
  651.     begin
  652.       assign(f_screen,name);
  653.       {$i-}
  654.       rewrite(f_screen);
  655.       video(false);
  656.       blockwrite(f_screen,screen,30);         {blockwrite the array which is at}
  657.       close(f_screen);
  658.       {$i+}
  659.       video(true);                            {absolute of the screen memory}
  660.       error:=ioresult;
  661.       if error<>0 then fatal_error(error);        {unexpected happened}
  662.     end;
  663.   end;
  664.   put_status(true);
  665.   gotoxy(x,y);
  666. end;                                          {end of save}
  667.  
  668. procedure load(mode:byte);{--------------loads in picture from disk}
  669. var
  670.   x,
  671.   y,
  672.   counter,
  673.   error:integer;
  674.   screen,
  675.   screen1:array[0..2000] of integer;
  676.   f_screen:file;
  677.   name:string[12];
  678.   use:string[7];
  679.   do_it:boolean;
  680.   key:char;
  681. begin
  682.   case mode of
  683.     1:use:='load';
  684.     2:use:='overlay';
  685.     3:use:='examine';
  686.   end;
  687.   x:=wherex;
  688.   y:=wherey;
  689.   textcolor(white);
  690.   textbackground(black);
  691.   gotoxy(1,25);
  692.   clreol;
  693.   name:='';                                   {ask info}
  694.   do_it:=true;
  695.   write('Enter filename to ',use,' [CR = Exit] : ');
  696.   buflen:=12;
  697.   read(name);
  698.   if name='' then do_it:=false;               {tried to limit disk access}
  699.   if pos('.',name)=0 then
  700.     if length(name)>8 then name:=copy(name,1,8)+'.SCR'
  701.      else
  702.        name:=name+'.SCR';
  703.   if do_it then       {chose not to use "AND" structure so that}
  704.   begin               {exist function would not be called if CR entered}
  705.     if mode=3 then move(mem[base_screen:0],screen1,4000);
  706.     if exist(name) then                       {check if file on disk}
  707.     begin
  708.       assign(f_screen,name);                  {yes so load, similar to save..}
  709.       {$i-}
  710.       reset(f_screen);
  711.       blockread(f_screen,screen,30);
  712.       close(f_screen);
  713.       {$i+}
  714.       error:=ioresult;
  715.       if error<>0 then fatal_error(error)        {unexpected happened}
  716.       else
  717.       begin
  718.         if (mode=2) then
  719.         begin
  720.           for counter:=0 to 1920 do
  721.             if screen[counter]<>$0720 then memw[base_screen:counter*2]:=screen[counter];
  722.         end
  723.          else
  724.           move(screen,mem[base_screen:0],3840);
  725.       end;
  726.     end
  727.      else                                     {file isn't found}
  728.     begin
  729.       gotoxy(1,25);                           {write warning}
  730.       clreol;
  731.       write('WARNING - File not found!  <<< Press A Key >>>');
  732.       waitkey;
  733.     end;
  734.     if (mode=3) and exist(name)then
  735.     begin
  736.       gotoxy(1,25);
  737.       clreol;
  738.       gotoxy(32,25);
  739.       cursor(false);
  740.       write('<<< Press a Key >>>');
  741.       waitkey;
  742.       cursor(true);
  743.       move(screen1,mem[base_screen:0],4000);
  744.     end;
  745.   end;
  746.   put_status(true);
  747.   gotoxy(x,y);
  748. end;                                           {end of load}
  749.  
  750. procedure show_graphic;{------------------------prints all the graphic chars}
  751. var
  752.   screen:array[0..2000] of integer;            {for saving screen}
  753.   x,
  754.   y,
  755.   counter,
  756.   counter1:integer;
  757.   key:char;
  758. begin
  759.   x:=wherex;
  760.   y:=wherey;
  761.   video(false);                                {save screen}
  762.   move(mem[base_screen:0],screen,4000);
  763.   video(true);
  764.   cursor(false);
  765.   textcolor(white);
  766.   textbackground(blue);
  767.   clrscr;
  768.   gotoxy(27,2);
  769.   writeln('The Graphic Character Set');        {write out the array}
  770.   writeln;
  771.   writeln('':8,'Level    Graphic chars at ALT #');
  772.   for counter:=1 to max_levels do
  773.   begin
  774.     textcolor(white);
  775.     textbackground(blue);
  776.     write('':9,counter:2,'   ');
  777.     for counter1:=1 to 8 do
  778.     begin
  779.       textcolor(white);
  780.       write(counter1:4,' ');
  781.       if counter mod 2=0 then
  782.         textcolor(lightred)
  783.        else
  784.          textcolor(yellow);
  785.       write(graphic[counter,counter1]);
  786.     end;
  787.     writeln;
  788.   end;
  789.   textcolor(white);
  790.   textbackground(blue);
  791.   gotoxy(29,wherey);
  792.   write('<<< Press any Key >>>');
  793.   repeat until keypressed;
  794.   read(kbd,key);
  795.   if keypressed then read(kbd,key);
  796.   video(false);                                {restore screen}
  797.   move(screen,mem[base_screen:0],4000);
  798.   video(true);
  799.   cursor(true);
  800.   gotoxy(x,y);
  801. end;                                           {end of show_graphic}
  802.  
  803. procedure help;{--------------------------------displays help screen}
  804. var
  805.   counter,
  806.   x,
  807.   y:integer;
  808.   screen:array[0..2000] of integer;            {for saving screen}
  809.   help:array[0..1920] of integer; {for the blockread}
  810.   f_help:file;
  811.   key:char;
  812. begin
  813.   cursor(false);
  814.   textcolor(white);
  815.   textbackground(black);
  816.   x:=wherex;
  817.   y:=wherey;                {SAVE the SCREEN}
  818.   video(false);
  819.   move(mem[base_screen:0],screen,4000);
  820.   video(true);
  821.   if Help_on_disk then                         {check if help on disk}
  822.   begin
  823.     assign(f_help,helppath+helpfile);
  824.     {$i-}
  825.     reset(f_help);
  826.     blockread(f_help,help,30);
  827.     video(false);
  828.     clrscr;
  829.     move(help,mem[base_screen:0],3840);
  830.     video(true);
  831.     close(f_help);
  832.     {$i-}
  833.     if ioresult<>0 then help_on_disk:=false    {if unexpected then no help on disk}
  834.   end;
  835.   if not help_on_disk then                     {if no help on disk then output internal help}
  836.   begin
  837.     clrscr;               {ACTUAL HELP MESSAGE}
  838.     writeln('                       The keys are defined as...');
  839.     writeln;
  840.     writeln('        Alt - F   = Forground         Alt - B   = Background');
  841.     writeln('        Alt - L   = Load              Alt - S   = Save');
  842.     writeln('        Alt - O   = Overlay           Alt - X   = Examine picture');
  843.     writeln('        Alt - R   = Read directory    Alt - P   = Set path');
  844.     writeln('        Alt - =   = Blink toggle      Alt - ''-'' = Do lines');
  845.     writeln('        Alt - W   = Wipe screen       Alt - H   = This help screen');
  846.     writeln('        Alt - Q   = Quit              Alt - G   = Show graphic');
  847.     writeln('        Alt - Y   = Delete line       Alt - N   = Insert line');
  848.     writeln('        Alt - C   = Center line       Alt - M   = Mark block with colour');
  849.     writeln('        Alt - K   = Copy block        Alt - D   = Delete block');
  850.     writeln('        Alt - V   = Move block        Alt - 1-8 = Out graphic char');
  851.     writeln('        Alt - 9   = Graph level-1     Alt - 0   = Graph level+1');
  852.     writeln;
  853.     writeln('        Alt - A   = Alter configuration on disk');
  854.     writeln;
  855.     gotoxy(29,wherey);
  856.     write('<<< Press a key >>>');
  857.   end;
  858.   waitkey;
  859.   video(false);                                {restore screen}
  860.   move(screen,mem[base_screen:0],4000);
  861.   video(true);
  862.   textcolor(forground);
  863.   textbackground(background);
  864.   gotoxy(x,y);
  865.   cursor(true);
  866. end;                                           {end of help}
  867.  
  868. procedure clear;{-------------------------------clears the screen}
  869. var
  870.   x,
  871.   y:integer;
  872.   key:char;
  873. begin
  874.   textcolor(white);
  875.   textbackground(black);
  876.   x:=wherex;
  877.   y:=wherey;
  878.   gotoxy(1,25);
  879.   clreol;                                      {validate intentions}
  880.   write('Do you really want to clear the screen [Y/N]? ');
  881.   repeat
  882.     read(kbd,key);
  883.     key:=upcase(key);
  884.     if (key <>'Y') and (key<>'N') then beep;
  885.   until key in['Y','N'];
  886.   if key='Y' then
  887.   begin
  888.     textcolor(forground);            {Clear screen with correct colours}
  889.     textbackground(background);
  890.     clrscr;
  891.     x:=1;                           {for homing the cursor}
  892.     y:=1;
  893.   end;
  894.   put_status(true);
  895.   gotoxy(x,y);
  896. end;                                           {end of clear}
  897.  
  898. procedure erase_line;{--------------------------uses internal routine delline}
  899. begin
  900.   window(1,1,80,24);
  901.   delline;
  902.   window(1,1,80,25);
  903. end;                                           {end of erase_line}
  904.  
  905. procedure insertline;{--------------------------Like above}
  906. begin
  907.   window(1,1,80,24);
  908.   insline;
  909.   window(1,1,80,25);
  910. end;                                           {end of insertline}
  911.  
  912. procedure do_graphic(letter:integer);{----------outputs graphic key hit}
  913. begin
  914.   case letter of
  915.     09:  begin
  916.            graphic_level:=graphic_level-1;      {decrement key hit}
  917.            if graphic_level<1 then graphic_level:=max_levels;
  918.            put_status(false);
  919.          end;
  920.     10:  begin
  921.            graphic_level:=graphic_level+1;      {increment key hit}
  922.            if graphic_level>max_levels then graphic_level:=1;
  923.            put_status(false);
  924.          end;
  925.     1..8:begin
  926.            if graphic[graphic_level,letter]<>' ' then  {if space then don't do anything}
  927.            begin
  928.              if insert then move_right;         {check insert mode}
  929.             write(graphic[graphic_level,letter]);{output the character}
  930.            end;
  931.          end;
  932.   end;
  933.   if wherey=25 then gotoxy(80,24);              {check if at last pos on screen}
  934. end;                                            {end of do_graphic}
  935.  
  936. procedure next_word;{----------------------------moves by word}
  937. var
  938.   y,
  939.   x,
  940.   counter:integer;
  941. begin
  942.   y:=wherey;
  943.   counter:=wherex;
  944.   x:=wherex;
  945.   repeat                                        {find position of space}
  946.     counter:=counter+1;
  947.   until (mem[base_screen:(wherey-1)*160+(counter-1)*2]=32) and (mem[base_screen:(wherey-1)*160+counter*2]<> 32) or (counter
  948. = 79);
  949.   if counter>=79 then counter:=x-1;
  950.   gotoxy(counter+1,y);                          {move cursor to position}
  951. end;                                            {end of next_word}
  952.  
  953. procedure Previous_word;{------------------------like above, but in reverse}
  954. var
  955.   y,
  956.   x,
  957.   counter:integer;
  958. begin
  959.   y:=wherey;
  960.   x:=wherex;
  961.   counter:=wherex-1;
  962.   repeat
  963.      counter:=counter-1;
  964.   until ((mem[base_screen:(wherey-1)*160+(counter-1)*2]=32)
  965.         and (mem[base_screen:(wherey-1)*160+counter*2]<>32)) or (counter<=0);
  966.   if counter<=0 then counter:=x-1;
  967.   gotoxy(counter+1,y);
  968. end;                                            {end of previous_word}
  969.  
  970. procedure center_line;{--------------------------centres line on screen}
  971. var
  972.   line:array[1..80] of integer;
  973.   length,
  974.   start,
  975.   x,
  976.   y,
  977.   counter:integer;
  978. begin
  979.   x:=wherex;
  980.   y:=wherey;
  981.   length:=last_pos(y)-first_pos(y)+1;            {find start & end positions}
  982.   start:=((80-length) div 2);
  983.   for counter:=1 to length do                    {read line into array}
  984.     line[counter]:=memw[base_screen:(y-1)*160+(first_pos(y)+counter-2)*2];
  985.   gotoxy(1,y);
  986.   clreol;                                        {erase line}
  987.   for counter:=0 to length-1 do                  {output line to screen}
  988.   begin
  989.     memw[base_screen:(y-1)*160+(start+counter)*2]:=line[counter+1];
  990.   end;
  991.   if y<24 then y:=y+1;
  992.   gotoxy(x,y);
  993. end;                                             {end of center_line}
  994.  
  995. procedure do_lines;{------------------------------does the lines mode}
  996. var
  997.   x,
  998.   y:integer;
  999.   key,
  1000.   key1:char;
  1001. begin
  1002.   repeat                                         {repeat until alt - hit}
  1003.     x:=wherex;
  1004.     y:=wherey;
  1005.     show_status;                                 {show cursor location}
  1006.     gotoxy(73,25);
  1007.     textcolor(black);
  1008.     textbackground(white);
  1009.     write('LINES');                              {inform user of mode}
  1010.     textcolor(forground);
  1011.     textbackground(background);
  1012.     gotoxy(x,y);
  1013.     read(kbd,key);
  1014.     if (key=#27) and keypressed then             {read in char}
  1015.       read(kbd,key1)
  1016.     else
  1017.       key1:=#0;
  1018.     case ord(key1) of                            {do actions ...}
  1019.       35:help;
  1020.       72:if y>1 then                             {cursor Up}
  1021.          begin
  1022.            write(graphic[graphic_level,2]);
  1023.            gotoxy(x,y-1);
  1024.          end;
  1025.       80:if y<24 then                            {Cursor down}
  1026.          begin
  1027.            write(graphic[graphic_level,2]);
  1028.            gotoxy(x,y+1);
  1029.          end;
  1030.       77:if x<80 then write(graphic[graphic_level,1]);{cursor right}
  1031.       75:if x>1 then                             {cursor left}
  1032.          begin
  1033.            write(graphic[graphic_level,1]);
  1034.            gotoxy(x-1,y);
  1035.          end;
  1036.       else if key1<>#130 then beep;
  1037.     end;
  1038.   until key1=#130;                               {alt - is #130}
  1039.   x:=wherex;
  1040.   y:=wherey;
  1041.   gotoxy(73,25);
  1042.   textbackground(black);
  1043.   clreol;
  1044.   textbackground(background);
  1045.   gotoxy(x,y);
  1046. end;                                             {end of do_lines}
  1047.  
  1048. procedure Delete_section(startx,endx,starty,endy:integer); {removes part of screen}
  1049. var
  1050.   x,
  1051.   y:integer;
  1052. begin
  1053.   textcolor(forground);
  1054.   textbackground(background);
  1055.   if (endx-startx>1) and (endy-starty>1) then
  1056.   begin
  1057.     window(startx,starty,endx,endy);
  1058.     clrscr;
  1059.     window(1,1,80,25);
  1060.   end
  1061.   else
  1062.   for x:=startx to endx do
  1063.   begin
  1064.     for y:=starty to endy do
  1065.     begin
  1066.       gotoxy(x,y);
  1067.       write(' ');
  1068.     end;
  1069.   end;
  1070. end;                                             {end of delete_section}
  1071.  
  1072. procedure copy_section(startx,endx,starty,endy,newx,newy:integer;delete:boolean); {copies section of screen}
  1073. var
  1074.   counter1,
  1075.   counter2:integer;
  1076.   screen:array[1..80,1..24] of integer;
  1077. begin
  1078.   for counter1:=startx to endx do                {loop through section and dump to array}
  1079.   begin
  1080.     for counter2:=starty to endy do
  1081.     begin
  1082.       if (counter1-startx+newx<=80) then
  1083.          screen[counter1,counter2]:=memw[base_screen:(counter2-1)*160+(counter1-1)*2];
  1084.     end;
  1085.   end;
  1086.   if delete then delete_section(startx,endx,starty,endy); {delete section if move is used}
  1087.   for counter1:=startx to endx do
  1088.   begin                                          {dump array to screen}
  1089.     for counter2:=starty to endy do
  1090.     begin
  1091.       if (counter1-startx+newx<=80) then
  1092.           memw[base_screen:(counter2-starty-1+newy)*160+(counter1-startx-1+newx)*2]:=screen[counter1,counter2];
  1093.     end;
  1094.   end;
  1095. end;                                             {end of copy_section}
  1096.  
  1097. procedure get_xy(var x,y:integer);
  1098. var
  1099.   key,
  1100.   key1:char;
  1101. begin
  1102.   repeat
  1103.     read(kbd,key);
  1104.     if (key=#27) and keypressed then
  1105.       read(kbd,key1)
  1106.      else
  1107.       key1:=#0;
  1108.     case ord(key1) of
  1109.       71:gotoxy(first_pos(wherey),wherey);            {Home}
  1110.       72:if wherey>1  then gotoxy(wherex,wherey-1);   {Cursor up}
  1111.       73:gotoxy(1,1);                                 {Pg Up}
  1112.       75:if wherex>1  then gotoxy(wherex-1,wherey);   {Cursor Lft}
  1113.       77:if wherex<80 then gotoxy(wherex+1,wherey);   {Cursor Rgt}
  1114.       79:if (last_pos(wherey)<>80) and (last_pos(wherey)<>1) then {End}
  1115.            gotoxy(last_pos(wherey)+1,wherey)
  1116.           else
  1117.            gotoxy(last_pos(wherey),wherey);
  1118.       80:if wherey<24 then gotoxy(wherex,wherey+1);   {Cursor Dn}
  1119.       81:gotoxy(80,24);                               {Pg dn}
  1120.       115:previous_word;                              {CTRL - Left}
  1121.       116:Next_word;                                  {CTRL - Right}
  1122.       else if key<>#13 then beep;
  1123.     end;
  1124.   until key=#13;
  1125.   x:=wherex;
  1126.   y:=wherey;
  1127. end;
  1128.  
  1129. procedure mark_colour;{---------------------------colours a block}
  1130. var
  1131.   x,
  1132.   y,
  1133.   startx,
  1134.   endx,
  1135.   starty,
  1136.   endy,
  1137.   counter1,
  1138.   counter2:integer;
  1139.   orgcolour:byte;
  1140.   key,
  1141.   key1:char;
  1142. begin
  1143.   x:=wherex;
  1144.   y:=wherey;
  1145.   gotoxy(1,25);
  1146.   textcolor(white);
  1147.   textbackground(black);                         {ask for co ordinates}
  1148.   clreol;
  1149.   write('Mark block colour: Put cursor at UPPER LEFT corner of block.  CR when done');
  1150.   gotoxy(x,y);
  1151.   get_xy(startx,starty);
  1152.   orgcolour:=mem[base_screen:(starty-1)*160+(startx-1)*2+1];
  1153.   mem[base_screen:(starty-1)*160+(startx-1)*2+1]:=orgcolour xor 255;
  1154.   gotoxy(1,25);
  1155.   write('Mark block colour: Put cursor at LOWER RIGHT corner of block.');
  1156.   gotoxy(startx,starty);
  1157.   get_xy(endx,endy);
  1158.   put_status(true);
  1159.   show_status;
  1160.   textcolor(white);
  1161.   textbackground(black);
  1162.   if (startx<=endx) and (starty<=endy) then      {if invalid co ordinates then do nothing}
  1163.   begin
  1164.     for counter1:=startx to endx do              {loop thru and colour section}
  1165.     begin
  1166.       for counter2:=starty to endy do
  1167.         mem[base_screen:(counter2-1)*160+(counter1-1)*2+1]:=mem[base_screen:$0f21];
  1168.       end;
  1169.     end
  1170.    else
  1171.     mem[base_screen:(starty-1)*160+(startx-1)*2+1]:=orgcolour; {restore block markers}
  1172.   gotoxy(x,y);
  1173. end;                                             {end of mark_block}
  1174.  
  1175. procedure Delete_block;{--------------------------removes a section of screen}
  1176. var
  1177.   x,
  1178.   y,
  1179.   startx,
  1180.   endx,
  1181.   starty,
  1182.   endy,
  1183.   counter1,
  1184.   counter2:integer;
  1185.   orgcolour,
  1186.   forg:byte;
  1187.   key,
  1188.   key1:char;
  1189. begin
  1190.   x:=wherex;
  1191.   y:=wherey;
  1192.   gotoxy(1,25);
  1193.   textcolor(white);
  1194.   textbackground(black);                         {get co ordinates}
  1195.   clreol;
  1196.   write('Delete block:Put cursor at UPPER LEFT corner of block.  CR when done');
  1197.   gotoxy(x,y);
  1198.   get_xy(startx,starty);
  1199.   orgcolour:=mem[base_screen:(starty-1)*160+(startx-1)*2+1];
  1200.   mem[base_screen:(starty-1)*160+(startx-1)*2+1]:=orgcolour xor 255;
  1201.   gotoxy(1,25);
  1202.   write('Delete block:Put cursor at LOWER RIGHT corner of block.');
  1203.   gotoxy(startx,starty);
  1204.   get_xy(endx,endy);
  1205.   mem[base_screen:(starty-1)*160+(startx-1)*2+1]:=orgcolour;
  1206.   if (startx<=endx) and (starty<=endy) then        {if valid co-ordiantes then do delete}
  1207.     delete_section(startx,endx,starty,endy);
  1208.   put_status(true);
  1209.   gotoxy(x,y);
  1210. end;                                             {end of delete_block}
  1211.  
  1212. procedure copy_block(delete:boolean);{------------copy a block, also move}
  1213. var
  1214.   x,
  1215.   y,
  1216.   startx,
  1217.   endx,
  1218.   starty,
  1219.   endy,
  1220.   newx,
  1221.   newy,
  1222.   counter1,
  1223.   counter2:integer;
  1224.   orgcolour1,
  1225.   orgcolour2:byte;
  1226.   key,
  1227.   key1:char;
  1228.   name:string[4];
  1229. begin
  1230.   if delete then name:='Move' else name:='Copy'; {for screen output}
  1231.   x:=wherex;
  1232.   y:=wherey;
  1233.   gotoxy(1,25);
  1234.   textcolor(white);
  1235.   textbackground(black);
  1236.   clreol;                                        {get co-ordinates}
  1237.   write(Name,' block: Put cursor at UPPER LEFT corner of block.  CR when done');
  1238.   gotoxy(x,y);
  1239.   get_xy(startx,starty);
  1240.   orgcolour1:=mem[base_screen:(starty-1)*160+(startx-1)*2+1];
  1241.   mem[base_screen:(starty-1)*160+(startx-1)*2+1]:=orgcolour1 xor 255;
  1242.   gotoxy(1,25);
  1243.   write(name,' block: Put cursor at LOWER RIGHT corner of block.');
  1244.   gotoxy(startx,starty);
  1245.   get_xy(endx,endy);
  1246.   orgcolour2:=mem[base_screen:(endy-1)*160+(endx-1)*2+1];
  1247.   mem[base_screen:(endy-1)*160+(endx-1)*2+1]:=orgcolour2 xor 255;
  1248.   if (startx<=endx) and (starty<=endy) then
  1249.   begin
  1250.     gotoxy(1,25);
  1251.     write(name,' block: Put cursor at position to copy block.     ');
  1252.     gotoxy(startx,starty);
  1253.     get_xy(newx,newy);
  1254.     mem[base_screen:(endy-1)*160+(endx-1)*2+1]:=orgcolour2;
  1255.     mem[base_screen:(starty-1)*160+(startx-1)*2+1]:=orgcolour1;
  1256.     copy_section(startx,endx,starty,endy,newx,newy,delete);
  1257.   end
  1258.    else
  1259.   begin
  1260.     mem[base_screen:(endy-1)*160+(endx-1)*2+1]:=orgcolour2;
  1261.     mem[base_screen:(starty-1)*160+(startx-1)*2+1]:=orgcolour1;
  1262.   end;
  1263.   put_status(true);
  1264.   gotoxy(x,y);
  1265. end;                                             {end of copy_block}
  1266.  
  1267. procedure read_directory;{------------------------reads in directory}
  1268. var
  1269.   counter,
  1270.   x,
  1271.   y:integer;
  1272.   screen:array [0..2000] of integer;
  1273.   key:char;
  1274. begin
  1275.   x:=wherex;
  1276.   y:=wherey;
  1277.   cursor(false);
  1278.   move(mem[base_screen:0],screen,4000);
  1279.   textcolor(white);
  1280.   textbackground(black);
  1281.   clrscr;
  1282.   gotoxy(32,1);
  1283.   write('Directory of Files');
  1284.   gotoxy(1,4);
  1285.   textbackground(blue);
  1286.   dir('????????.SCR',false);
  1287.   clreol;
  1288.   textbackground(black);
  1289.   gotoxy(32,25);
  1290.   write('<<< Press a key >>>');
  1291.   waitkey;
  1292.   move(screen,mem[base_screen:0],4000);
  1293.   cursor(true);
  1294.   gotoxy(x,y);
  1295. end;                                             {End of read directory}
  1296.  
  1297. procedure do_paths;{------------------------------Will allow you to ChDir}
  1298. var
  1299.   path:string[54];
  1300.   x,
  1301.   y:integer;
  1302.   screen:array [0..2000] of integer;
  1303.   key:char;
  1304. begin
  1305.   x:=wherex;
  1306.   y:=wherey;
  1307.   cursor(false);
  1308.   move(mem[base_screen:0],screen,4000);
  1309.   textcolor(white);
  1310.   textbackground(black);
  1311.   clrscr;
  1312.   gotoxy(26,1);
  1313.   write('Directory of Subdirectories');
  1314.   gotoxy(1,4);
  1315.   textcolor(yellow);
  1316.   getdir(0,path);
  1317.   write('Current SubDir: ',path);
  1318.   gotoxy(1,6);
  1319.   textcolor(white);
  1320.   textbackground(blue);
  1321.   dir('????????.???',true);
  1322.   clreol;
  1323.   textcolor(white);
  1324.   textbackground(black);
  1325.   gotoxy(1,25);
  1326.   clreol;
  1327.   write('Enter path to change to [CR = Exit]: ');
  1328.   path:='';
  1329.   cursor(true);
  1330.   buflen:=42;
  1331.   read(path);
  1332.   cursor(false);
  1333.   if path<>'' then
  1334.   begin
  1335.     {$i-}
  1336.     chdir(path);
  1337.     {$i+}
  1338.     if ioresult<>0 then
  1339.     begin
  1340.       gotoxy(1,25);
  1341.       clreol;
  1342.       write(^G,'[',path,'] Not valid. <<< Press a Key >>>');
  1343.       waitkey;
  1344.     end;
  1345.   end;
  1346.   move(screen,mem[base_screen:0],4000);
  1347.   gotoxy(x,y);
  1348. end;                                             {End of do_paths}
  1349.  
  1350. procedure alter_flags;{---------------------------Change the configuration on disk}
  1351. var
  1352.   screen:array[0..2000] of integer;
  1353.   configure:config;
  1354.   f_configure:file of config;
  1355.   x,
  1356.   y:integer;
  1357.  
  1358. procedure disp_screen;                           {Display the config screen}
  1359. begin
  1360.   textcolor(white);
  1361.   textbackground(blue);
  1362.   clrscr;
  1363.   gotoxy(20,3);
  1364.   write('A L T E R   C O N F I G U R A T I O N');
  1365.   gotoxy(10,5);
  1366.   write('Use arrow keys to position cursor.  Press RETURN to Activate');
  1367.   textcolor(lightgray);
  1368.   gotoxy(5,8);
  1369.   write('Insert Mode At Start  :');
  1370.   gotoxy(5,10);
  1371.   write('Look To Disk For Help :');
  1372.   gotoxy(5,12);
  1373.   write('Path For Help         :');
  1374.   gotoxy(5,14);
  1375.   write('Forground At Start    :');
  1376.   gotoxy(5,16);
  1377.   write('Background At Start   :');
  1378.   gotoxy(5,18);
  1379.   write('The Graphic Letter Set:');
  1380.   gotoxy(5,20);
  1381.   write('Exit Configuration    :');
  1382.   gotoxy(9,22);
  1383.   textcolor(white);
  1384.   write('Press [');
  1385.   textcolor(white + blink);
  1386.   write('+');
  1387.   textcolor(white);
  1388.   write('] to increase Graph Level, [');
  1389.   textcolor(white+blink);
  1390.   write('-');
  1391.   textcolor(white);
  1392.   write('] to decrease Graph Level.');
  1393.   gotoxy(27,24);
  1394.   write('Press <SPACE BAR> to reset.');
  1395. end;
  1396.  
  1397. procedure display_info(y,level,letter:integer);  {Put the info on the screen}
  1398. var
  1399.   counter:integer;
  1400. begin
  1401.   textcolor(lightgray);
  1402.   gotoxy(30,8);
  1403.   if insert then write('ON ') else write('OFF');
  1404.   gotoxy(30,10);
  1405.   if help_on_disk then write('YES') else write('NO ');
  1406.   gotoxy(30,12);
  1407.   clreol;
  1408.   write(HelpPath);
  1409.   gotoxy(30,14);
  1410.   write(forground:2);
  1411.   gotoxy(30,16);
  1412.   write(background:2);
  1413.   gotoxy(45,14);
  1414.   textcolor(forground);
  1415.   textbackground(background);
  1416.   write('Colour');
  1417.   textcolor(white);
  1418.   textbackground(blue);
  1419.   gotoxy(45,16);
  1420.   write('Graph Level: ',level:2);
  1421.   gotoxy(30,18);
  1422.   for counter:=1 to 8 do
  1423.   begin
  1424.     textcolor(white);
  1425.     write(counter);
  1426.     textcolor(lightgray);
  1427.     write(' ',graphic[level,counter],'   ');
  1428.   end;
  1429.   gotoxy(30,20);
  1430.   write('':10);
  1431.   if y<>18 then gotoxy(70,16);
  1432.   clreol;
  1433.   case y of
  1434.     08:begin
  1435.          gotoxy(30,8);
  1436.          textcolor(blue);
  1437.          textbackground(white);
  1438.          if insert then write('ON ') else write('OFF');
  1439.          textcolor(white);
  1440.          textbackground(blue);
  1441.        end;
  1442.     10:begin
  1443.          gotoxy(30,10);
  1444.          textcolor(blue);
  1445.          textbackground(white);
  1446.          if help_on_disk then write('YES') else write('NO');
  1447.          textcolor(white);
  1448.          textbackground(blue);
  1449.        end;
  1450.     12:begin
  1451.          gotoxy(30,12);
  1452.          textcolor(blue);
  1453.          textbackground(white);
  1454.          write(Helppath);
  1455.          textcolor(white);
  1456.          textbackground(blue);
  1457.        end;
  1458.     14:begin
  1459.          gotoxy(30,14);
  1460.          textcolor(blue);
  1461.          textbackground(white);
  1462.          write(forground:2);
  1463.          textcolor(white);
  1464.          textbackground(blue);
  1465.        end;
  1466.     16:begin
  1467.          gotoxy(30,16);
  1468.          textcolor(blue);
  1469.          textbackground(white);
  1470.          write(background:2);
  1471.          textcolor(white);
  1472.          textbackground(blue);
  1473.        end;
  1474.     18:begin
  1475.          gotoxy(70,16);
  1476.          textcolor(white);
  1477.          write('ASCII = ');
  1478.          clreol;
  1479.          write(ord(graphic[level,letter]):3);
  1480.          gotoxy(letter*6+26,18);
  1481.          textbackground(white);
  1482.          textcolor(blue);
  1483.          write(graphic[level,letter]);
  1484.          textcolor(white);
  1485.          textbackground(blue);
  1486.        end;
  1487.     20:begin
  1488.          gotoxy(30,20);
  1489.          textcolor(blue);
  1490.          textbackground(white);
  1491.          write('':10);
  1492.          textcolor(white);
  1493.          textbackground(blue);
  1494.        end;
  1495.   end;
  1496. end;
  1497.  
  1498. procedure do_input;                              {Read in the input and work with it}
  1499. var
  1500.   numstr:string[3];
  1501.   letter,
  1502.   level,
  1503.   num,
  1504.   y,
  1505.   code:integer;
  1506.   saved,
  1507.   leave:boolean;
  1508.   key,
  1509.   key1:char;
  1510. begin
  1511.   leave:=false;
  1512.   level:=1;
  1513.   letter:=1;
  1514.   y:=8;
  1515.   cursor(false);
  1516.   repeat
  1517.     repeat
  1518.       key:=#0;
  1519.       key1:=#0;
  1520.       display_info(y,level,letter);
  1521.       read(kbd,key);
  1522.       if keypressed then read(kbd,key1);
  1523.       case ord(key1) of
  1524.         72:if y>8 then y:=y-2 else y:=20;
  1525.         80:if y<20 then y:=y+2 else y:=8;
  1526.         77:if (y=18) then
  1527.              if letter<8 then letter:=letter+1 else letter:=1;
  1528.         75:if (y=18) then
  1529.              if letter>1 then letter:=letter-1 else letter:=8;
  1530.       end;
  1531.       if key='-' then if level>1 then level:=level-1 else level:=19;
  1532.       if key in['=','+'] then if level<19 then level:=level+1 else level:=1;
  1533.       if key=' ' then initialize_editor(false);
  1534.     until key=#13;
  1535.     case y of
  1536.      8:insert:=not insert;
  1537.      10:Help_on_disk:=not help_on_disk;
  1538.      12:begin
  1539.           gotoxy(40,10);
  1540.           write('Enter NEW Path for EdScreen.HLP');
  1541.           gotoxy(30,12);
  1542.           cursor(true);
  1543.           repeat until keypressed;
  1544.           clreol;
  1545.           read(helppath);
  1546.           cursor(false);
  1547.           gotoxy(40,10);
  1548.           clreol;
  1549.         end;
  1550.      14:if forground<15 then forground:=forground+1 else forground:=0;
  1551.      16:if background<7 then background:=background+1 else background:=0;
  1552.      18:begin
  1553.           gotoxy(20,17);
  1554.           write('Enter ASCII for character to replace:');
  1555.           repeat
  1556.             cursor(true);
  1557.             gotoxy(59,17);
  1558.             clreol;
  1559.             buflen:=3;
  1560.             read(numstr);
  1561.             cursor(false);
  1562.             val(numstr,num,code);
  1563.             if code<>0 then write(^g);
  1564.           until code=0;
  1565.           graphic[level,letter]:=chr(num);
  1566.           gotoxy(20,17);
  1567.           clreol;
  1568.         end;
  1569.      20:begin
  1570.           gotoxy(30,20);
  1571.           write('Do you want the Configuration saved [Y/N] ? ');
  1572.           cursor(true);
  1573.           repeat
  1574.             read(kbd,key);
  1575.             key:=upcase(key);
  1576.           until key in ['Y','N'];
  1577.           leave:=true;
  1578.           saved:=key = 'Y';
  1579.         end;
  1580.     end;
  1581.   until leave;
  1582.   if saved then
  1583.   begin
  1584.     with configure do
  1585.     begin
  1586.       insert_mode:=insert;
  1587.       graphic_letters:=graphic;
  1588.       help:=help_on_disk;
  1589.       help_path:=helpPath;
  1590.       forg:=forground;
  1591.       back:=background;
  1592.     end;
  1593.     assign(f_configure,'EDSCREEN.CNF');
  1594.     rewrite(f_configure);
  1595.     write(f_configure,configure);
  1596.     close(f_configure);
  1597.   end;
  1598.   cursor(true);
  1599. end;
  1600.  
  1601. begin                                       {}{}{MAIN FOR alter_Flags}
  1602.   x:=wherex;
  1603.   y:=wherey;
  1604.   move(mem[base_screen:0],screen,4000);
  1605.   disp_screen;
  1606.   do_input;
  1607.   move(screen,mem[base_screen:0],4000);
  1608.   gotoxy(x,y);
  1609.   textcolor(forground);
  1610.   textbackground(background);
  1611. end;                                        {}{}{End of alter_flags}
  1612.  
  1613. procedure process_key(letter:char);{-------------interprets user input}
  1614.  
  1615. {This procedure processes the one-scan code type keys.  Ie normal.  It
  1616.  will act on the control keys such as ^C and backspace as well as outputting
  1617.  the normal keys}
  1618.  
  1619. begin
  1620.   case letter of
  1621.     ' '..#255:begin                              {normal keys}
  1622.                 if insert then move_right;
  1623.                 write(letter);
  1624.               end;
  1625.     ^C       :quit;
  1626.     ^H       :do_backspace;                       {backspace}
  1627.     ^M       :if wherey<24 then writeln;         {CR}
  1628.     ^J       :if wherey<24 then gotoxy(wherex,wherey+1);{LF}
  1629.     ^I       :if wherex<72 then gotoxy(wherex+8,wherey);{TAB}
  1630.     else      beep;
  1631.   end;
  1632.   if wherey=25 then gotoxy(80,24); {last spot on screen}
  1633. end;                                             {end of process_key}
  1634.  
  1635. procedure process_special(letter:char);{----------interpretes double key codes}
  1636.  
  1637. {This is the procedure that handles all the special commands in the editor.
  1638.  All the alt keys are here.  }
  1639.  
  1640. begin
  1641.   case ord(letter) of
  1642.            {***** =-=-=-=-=-=-=- Commands -=-=-=-=-=-=-=- *******}
  1643.     16:quit;                                        {Alt-Q - Quit}
  1644.     17:clear;                                       {    W - Wipe Screen}
  1645.     19:Read_directory;                              {    R - Read Directory}
  1646.     21:erase_line;                                  {    Y - Delete line}
  1647.     24:load(2);                                     {    O - Overlay}
  1648.     25:Do_paths;                                    {    P - Path stuff}
  1649.     30:Alter_flags;                                 {    A - Alter Flags}
  1650.     31:save;                                        {    S - save picture}
  1651.     32:delete_block;                                {    D - Delete block}
  1652.     33:begin                                        {    F - Forground}
  1653.          forground:=forground+1;
  1654.          if blinking then forground:=forground xor 16;  {turn off blink}
  1655.          if forground>15 then forground:=0;          {for wrap-around}
  1656.          if blinking then forground:=forground xor 16;  {Restore blink}
  1657.        end;
  1658.     34:show_graphic;                                {    G - Show graphics}
  1659.     35:help;                                        {    H - help}
  1660.     37:copy_block(false);                           {    K - Copy block}
  1661.     38:load(1);                                     {    L - load in picture}
  1662.     45:load(3);                                     {    X - examine picture}
  1663.     46:center_line;                                 {    C - Centre line}
  1664.     47:copy_block(true);                            {    V - Move Block}
  1665.     48:begin                                        {    B - Background}
  1666.          background:=background+1;
  1667.          if background>7 then background:=0;
  1668.        end;
  1669.     49:insertline;                                  {    N - insert line}
  1670.     50:mark_colour;                                 {    M - Mark colours}
  1671.     120..129:do_graphic(ord(letter)-119);           {  0-9 - graphic}
  1672.     130:do_lines;                                   {  "-" - lines}
  1673.     131:begin                                       {    = - hilight  eg blink}
  1674.           forground:=forground xor 16;
  1675.           blinking:=not blinking;
  1676.         end;
  1677.           {****** -=-=-=-=-= Editing commands -=-=-=-=-=-=-= *******}
  1678.     15:if wherex>8 then gotoxy(wherex-8,wherey);    {Shift TAB}
  1679.     71:gotoxy(first_pos(wherey),wherey);            {Home}
  1680.     72:if wherey>1  then gotoxy(wherex,wherey-1);   {Cursor up}
  1681.     73:gotoxy(1,1);                                 {Pg Up}
  1682.     75:if wherex>1  then gotoxy(wherex-1,wherey);   {Cursor Lft}
  1683.     77:if wherex<80 then gotoxy(wherex+1,wherey);   {Cursor Rgt}
  1684.     79:if (last_pos(wherey)<>80) and (last_pos(wherey)<>1) then {End}
  1685.          gotoxy(last_pos(wherey)+1,wherey)
  1686.         else
  1687.          gotoxy(last_pos(wherey),wherey);
  1688.     80:if wherey<24 then gotoxy(wherex,wherey+1);   {Cursor Dn}
  1689.     81:gotoxy(80,24);                               {Pg dn}
  1690.     82:insert:=not insert;                          {insert hit}
  1691.     83:do_delete;                                   {delete hit}
  1692.     115:previous_word;                              {CTRL - Left}
  1693.     116:Next_word;                                  {CTRL - Right}
  1694.     117:clreol;                                     {CTRL - END}
  1695.     else beep;
  1696.   end;
  1697. end;                                             {end of process special}
  1698.  
  1699. procedure do_edit;{-------------------------------Main editing procedure}
  1700.  
  1701. {This is the main editing loop of the programme.  It is just an endless loop
  1702.  that accepts keys and processes them}
  1703.  
  1704. var
  1705.   key,
  1706.   special:char;
  1707. begin
  1708.   repeat                                         {endless loop}
  1709.     show_status;
  1710.     read(kbd,key);
  1711.     if (key=#27) and (keypressed) then           {check special key}
  1712.     begin
  1713.       read(kbd,special);
  1714.       process_special(special);
  1715.     end
  1716.     else
  1717.       process_key(key);
  1718.   until false;
  1719. end;                                             {end of do_edit}
  1720.  
  1721. begin{******************************************** MAIN PROGRAMME}
  1722.   titlescreen;                                   {title}
  1723.   do_edit;                                       {editing loop}
  1724. end.                                             {end of programme}
  1725.