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