home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / turbopas / turbscr.lbr / SCREEN.PQS / SCREEN.PAS
Pascal/Delphi Source File  |  1986-06-21  |  9KB  |  388 lines
  1. program screen_gen;
  2.  
  3. type
  4.   anystring = string[255];
  5.   Scr       = array[1..79] of array[1..23] of char;
  6.  
  7. var
  8.   S                   : Scr;
  9.   x,y,col,row         : integer;
  10.   ch,FileType,ProgCode: char;
  11.   Filename            : string[8];
  12.   OutFile             : text;
  13.   SaveFile            : file of Scr;
  14.   FileSaved           : boolean;
  15.  
  16.  
  17.  
  18. { *** FUNCTION TO CHECK FOR EXISTING FILE RETURNS TRUE OR FALSE ***}
  19.  
  20. function Exist(FileN: Anystring): boolean;
  21.    var F: file;
  22.    begin
  23.       {$I-}
  24.       assign(F,FileN);
  25.       reset(F);
  26.       {$I+}
  27.       if IOResult <> 0 then Exist:=false
  28.       else Exist:=true;
  29.    end;
  30.  
  31. procedure status_line;
  32. begin
  33.   gotoXY(1,24);
  34.   ClrEOL;
  35. end;
  36.  
  37. procedure GetFileName;
  38.    begin
  39.       Filename:='';
  40.       repeat
  41.          read(kbd,ch);
  42.          if Upcase(ch) in ['A'..'Z','0'..'9',^M] then
  43.          begin
  44.             write(Upcase(ch));
  45.             Filename:=Filename+upcase(ch);
  46.          end;
  47.       UNTIL(Ch=^M) or (length(Filename)=8);
  48.       if Ch=^M then Delete(Filename,Length(Filename),1);
  49.    end;
  50.  
  51. procedure display_screen;
  52. begin
  53.   ClrScr;
  54.   for y:=1 to 23 do
  55.   begin
  56.     for x:=1 to 79 do write(s[x,y]);
  57.     if y < 23 then writeln;
  58.   end;
  59. end; {display_screen}
  60.  
  61. procedure alpha_in;
  62. begin
  63.   write(ch);
  64.   S[col,row]:=ch;
  65.   col:=col+1;
  66.   if col > 79 then
  67.   begin
  68.     row:=row+1;
  69.     if row > 23 then row:=1;
  70.     col:=1;
  71.   end;
  72.   gotoXY(col,row);
  73. end;
  74.  
  75. procedure carriage_return;
  76. begin
  77.   if col > 1 then
  78.   begin
  79.     col:=1;
  80.     repeat
  81.      if s[col,row]=' ' then col:= col+1;
  82.     until s[col,row] <> ' ';
  83.   end;
  84.   row:=row+1;
  85.   gotoXY(col,row);
  86. end;
  87.  
  88. procedure up_arrow;
  89. begin
  90.   if row > 1 then row:=row-1;
  91.   gotoXY(col,row);
  92. end;
  93.  
  94. procedure right_arrow;
  95. begin
  96.   col:=col+1;
  97.   if col > 79 then
  98.   begin
  99.     row:=row+1;
  100.     if row > 23 then row:=1;
  101.     col:=1;
  102.   end;
  103.   gotoXY(col,row);
  104. end;  (* right_arrow *)
  105.  
  106. procedure down_arrow;
  107. begin
  108.   row:=row+1;
  109.   if row > 23 then row:=1;
  110.   gotoXY(col,row);
  111. end;  (* down_arrow *)
  112.  
  113. procedure back_space;
  114. begin
  115.   col:=col-1;
  116.   if (col < 1) and (row > 1)  then
  117.    begin
  118.      col:=79;
  119.      row:=row-1;
  120.    end
  121.    else
  122.    if (col < 1) and (row = 1) then
  123.    begin
  124.      col:=1;
  125.      row:=1;
  126.    end;
  127.    gotoXY(col,row);
  128. end; (* back_space *)
  129.  
  130. procedure delete_char;
  131. begin
  132.   col:=col-1;
  133.   if (col < 1) and (row > 1)  then
  134.   begin
  135.     col:=79;
  136.     row:=row-1;
  137.   end
  138.   else
  139.   if (col < 1) and (row = 1) then
  140.   begin
  141.     col:=1;
  142.     row:=1;
  143.   end;
  144.   gotoXY(col,row);
  145.   s[col,row]:=' ';
  146.   write(s[col,row]);
  147. end;
  148.  
  149. procedure Prog_Code_in;
  150. begin
  151.   status_line;
  152.   write('<H>orz line <V>ert line <Q>uit drawing screen ');
  153.   read(kbd,ProgCode);
  154.   ProgCode:=UpCase(ProgCode);
  155.   write(ProgCode);
  156.   case ProgCode of
  157.   'H' : begin (* Horz Line *)
  158.           for x:=col to 79 do
  159.           begin
  160.             gotoXY(x,row);
  161.             if S[x,row]='|' then S[x,row]:='+' else S[x,row]:='-';
  162.             write(S[x,row]);
  163.           end;
  164.           row:=row+1;
  165.           if row > 23 then row:=1;
  166.           col:=1;
  167.           gotoXY(col,row);
  168.         end; (* case H *)
  169.  
  170.   'V' : begin (*Vert Line *)
  171.           for x:=row to 23 do
  172.           begin
  173.             gotoXY(col,x);
  174.             if S[col,x]='-' then S[col,x]:='+' else S[col,x]:='|';
  175.             write(S[col,x]);
  176.           end;
  177.           row:=1;
  178.           col:=col+1;
  179.           gotoXY(col,row);
  180.         end; (* case V *)
  181.   end;   (* case   *)
  182.   gotoXY(1,24);
  183.   ClrEOL;
  184.   write('Press \  for options');
  185.   gotoXY(col,row);
  186. end;         (* Prog_code_in *)
  187.  
  188. Procedure draw_screen;
  189. begin
  190.   FileSaved:=false;
  191.   Progcode:=' ';
  192.   if FileType='O' then display_screen;
  193.   status_line; write('Press \ for options');
  194.   col:=1;
  195.   row:=1;
  196.   gotoXY(col,row);
  197.   repeat
  198.     gotoXY(66,24); write('Col ',col:2,' Row ',row:2); gotoXY(col,row);
  199.     read(kbd,ch);
  200.     case ch of
  201.      #32..#91,#93..#126            : alpha_in;
  202.      ^M                            : carriage_return;
  203.      ^K                            : up_arrow;
  204.      ^L                            : right_arrow;
  205.      ^J                            : down_arrow;
  206.      ^H                            : back_space;
  207.      '\'                           : Prog_Code_in;
  208.      #127                          : delete_char;
  209.     end; {case}
  210.   until ProgCode ='Q';
  211. end; {draw_screen}
  212.  
  213. procedure old_new;
  214. label stop;
  215. begin
  216.   status_line;
  217.   write('<O>ld or <N>ew file : ');
  218.   repeat
  219.     read(kbd,ch);
  220.   until ch in ['O','o','N','n'];
  221.   FileType:=Upcase(ch);
  222.   status_line;
  223.   write('Enter file name (no ext) :');
  224.   GetFileName;
  225.   case FileType of
  226.   'N':begin
  227.         if not exist(filename+'.SCR') then
  228.         begin
  229.           assign(outfile,filename+'.INC');
  230.           assign(savefile,filename+'.SCR');
  231.         end
  232.         else
  233.         begin
  234.           status_line;
  235.           write('File ',FileName,' exists. Erase Y/N ? ');
  236.           read(kbd,ch);
  237.           if ch in['Y','y'] then
  238.           begin
  239.             assign(outfile,filename+'.INC');
  240.             assign(savefile,filename+'.SCR');
  241.             rewrite(outfile);
  242.             rewrite(savefile);
  243.           end;
  244.         end;
  245.       end;
  246.   'O':begin
  247.         if exist(Filename+'.SCR') then
  248.         begin
  249.           reset(savefile);
  250.           read(savefile,S);
  251.         end
  252.         else
  253.         begin
  254.           status_line;
  255.           write(Filename+'.SCR does not exist. Press <RETURN> ');
  256.           read(kbd,ch);
  257.         end;
  258.       end;
  259.   end;(* case *)
  260. end;
  261.  
  262. procedure save_outfile;
  263. var
  264.   varout:boolean;
  265. begin
  266.   FileSaved:=true;
  267.   varout:=false;
  268.   status_line;
  269.   write('saving file ',FileName+'.INC');
  270.   rewrite(outfile);
  271.   writeln(outfile,'Procedure ',FileName,';');
  272.   writeln(outfile,'begin');
  273.   for y:=1 to 23 do
  274.   begin
  275.     x:=1;
  276.     write(outfile,'  gotoXY(',x:2,',',y:2,'); ');  (*start position*)
  277.     write(outfile,'  write(''');
  278.  
  279.     for x:=1 to 40 do (* eliminate var from print screen *)
  280.     begin
  281.       if (s[x,y]='@') or (s[x,y]='#') then varout:=true;
  282.       if varout then write(outfile,' ') else write(outfile,s[x,y]);
  283.       if (varout) and (s[x,y]=' ') then varout:=false;
  284.     end;
  285.  
  286.     writeln(outfile,''');');
  287.  
  288.     x:=41;
  289.     write(outfile,'  gotoXY(',x:2,',',y:2,'); ');  (*start position*)
  290.     write(outfile,'  write(''');
  291.  
  292.     (* note if we were in the middle of a variable then the next *)
  293.     (* for x loop will continue to write spaces i.e. varout true *)
  294.  
  295.     for x:=41 to 79 do (* eliminate var from print screen *)
  296.     begin
  297.       if (s[x,y]='@') or (s[x,y]='#') then varout:=true;
  298.       if varout then write(outfile,' ') else write(outfile,s[x,y]);
  299.       if (varout) and (s[x,y]=' ') then varout:=false;
  300.     end;
  301.  
  302.     writeln(outfile,''');');
  303.   end;
  304.  
  305.   (* write var*)
  306.   varout:=false;
  307.   for y:= 1 to 23 do
  308.   begin
  309.     for x:=1 to 79 do
  310.     begin
  311.       if (varout) and (s[x,y]=' ') then
  312.       begin
  313.         varout:=false;
  314.         writeln(outfile,');');
  315.       end;
  316.  
  317.       if (varout) and (s[x,y]<>' ') then write(outfile,s[x,y]);
  318.  
  319.       if s[x,y]='@' then
  320.       begin
  321.         varout:=true;
  322.         write(outfile,'  gotoXY(',x:2,',',y:2,'); ');  (*start position*)
  323.         write(outfile,'  write(')
  324.       end;
  325.     end;
  326.   end;
  327.  
  328.   (* read var *)
  329.   varout:=false;
  330.   for y:= 1 to 23 do
  331.   begin
  332.     for x:=1 to 79 do
  333.     begin
  334.       if (varout) and (s[x,y]=' ') then
  335.       begin
  336.         varout:=false;
  337.         writeln(outfile,');');
  338.       end;
  339.  
  340.       if (varout) and (s[x,y]<>' ') then write(outfile,s[x,y]);
  341.  
  342.       if s[x,y]='#' then
  343.       begin
  344.         varout:=true;
  345.         write(outfile,'  gotoXY(',x:2,',',y:2,'); ');  (*start position*)
  346.         write(outfile,'  read(');
  347.       end;
  348.     end;
  349.   end;
  350.  
  351.  
  352.   writeln(outfile,'end;');
  353.   close(outfile);
  354.   status_line;
  355.   write('saving file ',FileName+'.SCR');
  356.   rewrite(savefile);
  357.   write(savefile,S);
  358.   close(savefile);
  359. end; {save_outfile}
  360.  
  361. begin
  362.   FileSaved:=true;
  363.   ClrScr;
  364.   (* initialize array *)
  365.   FillChar(S,79*23,' ');
  366.   repeat
  367.     status_line;
  368.     LowVideo;
  369.     write('<1>Select file <2>Draw screen <3>Display screen ');
  370.     write('<4>Save screen <5>Quit :');
  371.     HighVideo;
  372.     read(kbd,ch);
  373.     case ch of
  374.     '1':  old_new;
  375.     '2':  draw_screen;
  376.     '3':  display_screen;
  377.     '4':  save_outfile;
  378.     end; {case}
  379.   until ch = '5';
  380.   if not FileSaved then
  381.   begin
  382.     status_line;
  383.     write('You have not saved the edited file ',FileName,' Save now ?');
  384.     read(kbd,ch);
  385.     if ch in['Y','y'] then save_outfile;
  386.   end;
  387. end.
  388.