home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / pascal / EDSCREEN.ZIP / SCRNBAT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1979-12-31  |  6.2 KB  |  230 lines
  1. (*****************************************************************************)
  2. (*                                                                           *)
  3. (*                   F U L L   S C R E E N   E D I T O R                     *)
  4. (*                                                                           *)
  5. (*                           By Martine Wedlake                              *)
  6. (*                                                                           *)
  7. (*       This  programme  may be copied,  or modified in  any way  for non-  *)
  8. (*  commercial uses.  If you would like to use this programme in a business  *)
  9. (*  environment please write  me for licencing,  and so I can keep track of  *)
  10. (*  its success.   If you like this programme a  donation would  be awfully  *)
  11. (*  nice of you.  Thanks!                                                    *)
  12. (*                                Martine Wedlake                            *)
  13. (*                                4551 N.E. Simpson St.                      *)
  14. (*                                Portland Or                                *)
  15. (*                                97218                                      *)
  16. (*                                                                           *)
  17. (*****************************************************************************)
  18.  
  19. program screen_batch;
  20. const
  21.   base_screen=$b800;
  22. type
  23.   str12=string[12];
  24.   str30=string[30];
  25.   str64=string[64];
  26. var
  27.   screen_mem:array[0..2000] of integer;
  28.   clear_screen,
  29.   restore_screen:boolean;
  30.   value:integer;
  31.  
  32. PROCEDURE cursor(on:BOOLEAN);{---------------This sets the cursor on/off}
  33.  
  34. {procedure cursor will set the cursor on or off depending if the argument sent
  35.  is true or false.  If the argument is false the cursor will be turned off,
  36.  if the argument is true the cursor is the cursor is turned on.}
  37.  
  38. CONST
  39.   video_io=$10;                             {this is the interrupt number}
  40. VAR
  41.   regs:RECORD CASE INTEGER OF               {this sets up the registers}
  42.                 1: (AX,BX,CX,DX,BP,DI,SI,DS,ES,Flags: INTEGER);
  43.                 2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  44.               END;
  45. BEGIN
  46.   IF on THEN                                {if the user wants a cursor then}
  47.   BEGIN
  48.     regs.ch:=$06;                           {set the registers up for display}
  49.     regs.cl:=$07;                           {ch = start line, cl = end line}
  50.   END
  51.   ELSE                                      {else, the cursor is not displayed}
  52.   BEGIN
  53.     regs.ch:=$20;                           {set the register up for non-}
  54.     regs.cl:=$00;                           {display, ch=$20 doesn't display}
  55.   END;
  56.   regs.ah:=$01;
  57.   regs.al:=$00;
  58.   Intr(video_io,regs);
  59. END;
  60.  
  61. function get_filename:str64;
  62. begin
  63.   get_filename:=paramstr(1);
  64. end;
  65.  
  66. function get_options:str64;
  67. begin
  68.   get_options:=paramstr(2);
  69. end;
  70.  
  71. procedure replace_screen;
  72. begin
  73.   move(screen_mem,mem[base_screen:0],4000);
  74. end;
  75.  
  76. procedure load_screen;
  77. var
  78.   screen:array[0..4000] of byte;
  79.   f_screen:file;
  80.   filename:str64;
  81. begin
  82.   move(mem[base_screen:0],screen_mem,4000);
  83.   filename:=get_filename;
  84.   if pos('.',filename)=0 then filename:=filename+'.scr';
  85.   assign(f_screen,filename);
  86.   {$i-}
  87.   reset(f_screen);
  88.   blockread(f_screen,screen,30);
  89.   close(f_screen);
  90.   {$i+}
  91.   if ioresult<>0 then
  92.   begin
  93.     replace_screen;
  94.     writeln('Error - Screen filename not found.');
  95.     halt;
  96.   end;
  97.   move(screen,mem[base_screen:0],3840);
  98. end;
  99.  
  100. procedure pause;
  101. var
  102.   key:char;
  103. begin
  104.   cursor(false);
  105.   repeat until keypressed;
  106.   read(kbd,key);
  107.   if keypressed then read(kbd,key);
  108.   cursor(true);
  109. end;
  110.  
  111. procedure Yes_no;       {Note: 1 is yes, 0 is no}
  112. var
  113.   key:char;
  114. begin
  115.   cursor(false);
  116.   repeat
  117.     read(kbd,key);
  118.     key:=upcase(key);
  119.   until key in ['Y','N'];
  120.   if clear_screen then clrscr;
  121.   if restore_screen then replace_screen;
  122.   if key='Y' then value:=1 else value:=0;
  123.   cursor(true);
  124. end;
  125.  
  126. procedure time_delay(parameter:str64);
  127. var
  128.   time,
  129.   code:integer;
  130. begin
  131.   val(copy(parameter,2,length(parameter)-1),time,code);
  132.   if code=0 then
  133.   begin
  134.     cursor(false);
  135.     delay(time*1000);
  136.     cursor(true);
  137.   end
  138.   else
  139.   begin
  140.     write('Error - in Parameter for delay');
  141.     replace_screen;
  142.     halt;
  143.   end;
  144. end;
  145.  
  146. procedure alphabet;
  147. var
  148.   key:char;
  149. begin
  150.   cursor(false);
  151.   repeat
  152.     read(kbd,key);
  153.     key:=upcase(key);
  154.     if keypressed then
  155.     begin
  156.       read(kbd,key);
  157.       key:=#0;
  158.     end;
  159.   until key in['A'..'Z'];
  160.   value:=ord(key)-64;
  161.   cursor(true);
  162. end;
  163.  
  164. procedure number;
  165. var
  166.   key:char;
  167. begin
  168.   cursor(false);
  169.   repeat
  170.     read(kbd,key);
  171.     if keypressed then
  172.     begin
  173.       read(kbd,key);
  174.       key:=#0;
  175.     end;
  176.   until key in['0'..'9'];
  177.   value:=ord(key)-48;
  178.   cursor(true);
  179. end;
  180.  
  181. procedure do_options;
  182. var
  183.   x:integer;
  184. begin
  185.   for x:=2 to paramcount do
  186.   begin
  187.     case copy(paramstr(x),1,1) of
  188.       'p','P':pause;
  189.       'y','Y':Yes_no;
  190.       'd','D':time_delay(paramstr(x));
  191.       'r','R':Restore_Screen:=true;
  192.       'c','C':clear_screen:=true;
  193.       'a','A':alphabet;
  194.       'n','N':number;
  195.       else    begin
  196.                 if restore_screen then replace_screen;
  197.                 write('Error - Command option "',copy(paramstr(x),1,length(paramstr(x))),'" not valid.');
  198.                 halt;
  199.               end;
  200.     end;
  201.   end;
  202. end;
  203.  
  204. begin
  205.   textcolor(lightgray);
  206.   textbackground(black);
  207.   value:=0;
  208.   restore_screen:=false;
  209.   clear_screen:=false;
  210.   if paramcount>0 then
  211.   begin
  212.     load_screen;
  213.     do_options;
  214.   end
  215.    else
  216.   begin
  217.     writeln(^J,'The correct form is:  SCRNBAT filename[.ext] [opt1] [opt2] ...');
  218.     writeln('The options are as follows:');
  219.     writeln('  Y      = Returns an ErrorLevel of 1 if Y hit, 0 if N hit');
  220.     writeln('  A      = Returns position in Alphabet');
  221.     writeln('  N      = Returns number in range of 0-9');
  222.     writeln('  P      = Pause.  Waits for keypress');
  223.     Writeln('  R      = Restore screen after run');
  224.     writeln('  C      = Clears screen at end of run');
  225.     writeln('  Dxxxx  = delays for xxxx seconds');
  226.   end;
  227.   if clear_screen then clrscr;
  228.   if restore_screen then replace_screen;
  229.   if value<>0 then halt(value);
  230. end.