home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / program / 221 / pascal / pascalm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-02-17  |  37.1 KB  |  1,277 lines
  1. {$S40,P+,T+}
  2. PROGRAM Pas_Main ;
  3.  
  4. (* Program:     PASCALM.PAS
  5.    By:          Jinfu Chen, based on OSS' PASCAL 1.x source code
  6.    Rev:         0.80, 1/1/87
  7.                   A beta version. Most of the functions work. Info_Window
  8.                   is taken out because of reentrant problem. Replaced by
  9.                   dialog box, Info_Msg, for temporary fix.
  10. *)
  11.  
  12. (*$I auxsubs.pas*)
  13.  
  14.   CONST
  15.     {$I gemconst.pas}
  16.     {$I pascalm.i}           (* resource file definition *)
  17.     max_option = 30 ;       { Maximum number of options in one dialog }
  18.     chunk = 1024 ;           (* size to be copy at one time *)
  19.     HIDE = TRUE;             (* just name them for the ease of reading *)
  20.     NOHIDE = FALSE;
  21.     GEM_O = 1 ;
  22.     TOS_O = 2 ;
  23.     TTP_O = 3 ;
  24.     ACC_O = 4 ;
  25.  
  26.   TYPE
  27.     {$I gemtype.pas}
  28.     opt_range = 1..max_option ;
  29.     opt_array = PACKED ARRAY [ opt_range ] OF boolean ;
  30. (*    opt_set = SET OF opt_range ; *)
  31.     environment = C_String ;
  32.     env_ptr = ^environment ;
  33.     buf_type = Packed Array [1..chunk] OF BYTE ;
  34.     drive_array = PACKED ARRAY[1..4] OF Long_INTEGER ;
  35.     C_Path_Type = Packed Array [1..80] OF CHAR ;
  36.  
  37.   VAR
  38.     envp : env_ptr ;
  39.     rez  : integer ;                (* screen resolution *)
  40. (*  never used
  41.     zero_word : integer ;
  42. *)
  43.     menu : Menu_Ptr ;
  44.     info_dial : Dialog_Ptr ;
  45.     dummy : integer ;
  46.     for_gem : Integer ;        (* 1 for gem, 2 for tos, 3 for acc *)
  47.     cmp_opts : opt_array ;
  48.     bad_res,
  49.     temp_path,
  50.     backup_path,
  51.     addl_files,
  52.     addl_libs : Str255 ;
  53.     work_path,                  (* path for FILE menu *)
  54.     file_path,                  (* path for SPECIALS menu *)
  55.     compiler_name,
  56.     linker_name,
  57.     editor_name,
  58.     paslib_name,
  59.     pasgem_name,
  60.     printer_name,
  61.     src_name,                   (* source filename for COPY *)
  62.     des_name,                   (* destination filename for COPY *)
  63.     cmp_name,
  64.     link_name,
  65.     edit_name,
  66.     run_name : Path_Name ;
  67. {    wind_title : Window_Title ; }     { window title, not used }
  68. {    window_id : INTEGER ;       }     { window id }
  69. (*    fullx, fully, fullw, fullh : integer ; *)
  70.  
  71.   {$I gemsubs.pas}
  72.  
  73. FUNCTION Dsetdrv( drive : INTEGER ) : Long_INTEGER ;
  74.   GEMDOS($0E) ;
  75. (* Set Default Drive *)
  76.  
  77. FUNCTION Dgetdrv : integer ;
  78.   GEMDOS( $19 ) ;
  79.  
  80. FUNCTION FCreate( VAR fname : C_Path_Type ; mode : INTEGER ) : INTEGER ;
  81.   GEMDOS( $3C ) ;
  82.  
  83. PROCEDURE Dfree( VAR buf : DRIVE_ARRAY ; driveno : INTEGER ) ;
  84.   GEMDOS($36) ;
  85. (* Get Drive Free Space *)
  86. (* Some Information :
  87.   buf[1] : number of free clusters ;
  88.   buf[2] : total number of clusters ;
  89.   buf[3] : sector size in bytes ;
  90.   buf[4] : cluster size in bytes.
  91. *)
  92.  
  93. FUNCTION Ddelete( VAR pathname : C_Path_Type ) : INTEGER ;
  94.   GEMDOS($3A) ;
  95. (* Delete Directory *)
  96.  
  97. FUNCTION FOpen( VAR fname : C_Path_Type ; mode : INTEGER ) : INTEGER ;
  98.   GEMDOS( $3D ) ;
  99.  
  100. PROCEDURE FClose( fhandle : INTEGER ) ;
  101.   GEMDOS( $3E ) ;
  102.  
  103. FUNCTION FRead( fhandle : INTEGER ; n_bytes : Long_INTEGER ;
  104.                  VAR buf : buf_type ) : Long_Integer ;
  105.   GEMDOS( $3F ) ;
  106.  
  107. FUNCTION FWrite( fhandle : INTEGER ; n_bytes : Long_INTEGER ;
  108.                  VAR buf : buf_type ) : Long_Integer ;
  109.   GEMDOS( $40 ) ;
  110.  
  111. FUNCTION FDelete( VAR fname : C_Path_Type ) : INTEGER ;
  112.   GEMDOS($41) ;
  113. (* Delete File *)
  114.  
  115. PROCEDURE Dgetpath( VAR path_buf : C_Path_Type ; drive : integer ) ;
  116.   GEMDOS( $47 ) ;
  117.  
  118. FUNCTION Frename( zero : INTEGER; VAR oldname,
  119.                   newname : C_Path_TYPE ) : INTEGER ;
  120.   GEMDOS($56) ;
  121. (* Rename File *)
  122.  
  123. FUNCTION get_rez : integer ;
  124.   XBIOS( 4 ) ;
  125.  
  126. PROCEDURE bconin( dev : integer ) ;     { Really a function! }
  127.   BIOS( 2 ) ;
  128.  
  129. PROCEDURE bconout( dev, c : integer ) ;
  130.   BIOS( 3 ) ;
  131.  
  132.  
  133. PROCEDURE P_To_CPath( P_Path : Path_Name ; VAR C_Path : C_Path_Type ) ;
  134. (* convert Pascal string to C string, the built-in routines only work for
  135.    long string *)
  136. VAR
  137.   i     : INTEGER;
  138.  
  139. BEGIN
  140.   FOR i := 1 TO Length( p_path ) DO
  141.     c_path[i] := p_path[i] ;
  142.   c_path[ i + 1 ] := chr(0) ;
  143. END ;
  144.  
  145. PROCEDURE C_To_PPath( C_Path : C_Path_Type ; VAR P_Path : Path_Name ) ;
  146. (* convert C string to Pascal string *)
  147. VAR
  148.   i     : INTEGER;
  149.  
  150. BEGIN
  151.   i := 1 ;
  152.   While (C_Path[i] <> CHR(0)) AND (C_Path[i] <> ' ') AND ( i <= 80 ) DO BEGIN
  153.     P_Path[i] := C_Path[i] ;
  154.     i := i + 1 ;
  155.   END ;
  156.   P_Path[0] := Chr( i - 1 ) ;
  157. END ;
  158.  
  159.  
  160. FUNCTION Is_Gem_Name( fname : Path_Name ) : boolean ;
  161. (* check if the program is a GEM program *)
  162. VAR
  163.   i : integer ;
  164.  
  165. BEGIN
  166.   Is_Gem_Name := false ;
  167.   IF length( fname ) > 3 THEN  BEGIN
  168.     i := length( fname ) - 3 ;
  169.     IF ( fname[i]='.') AND (fname[i+1]='P') AND (fname[i+2]='R')
  170.       AND (fname[i+3]='G') THEN
  171.         Is_Gem_name := true ;
  172.   END
  173. END ;
  174.  
  175. FUNCTION Is_TTP_Name( fname : Path_Name ) : boolean ;
  176. (* check if the program is a TTP program *)
  177. VAR
  178.   i : integer ;
  179.  
  180. BEGIN
  181.   Is_TTP_Name := false ;
  182.   IF length( fname ) > 3 THEN  BEGIN
  183.     i := length( fname ) - 3 ;
  184.     IF ( fname[i]='.') AND (fname[i+1]='T') AND (fname[i+2]='T')
  185.       AND (fname[i+3]='P') THEN
  186.         Is_TTP_name := true ;
  187.   END
  188. END ;
  189.  
  190.  
  191. FUNCTION Get_CMD( fname : Path_Name; VAR  cmd_line : Str255 ) : BOOLEAN ;
  192. (* get the command line for TTP program, the box looks exactly the same as
  193.    the one in DESKTOP *)
  194. VAR
  195.   i : integer ;
  196.   btn : Integer ;
  197.   t_box : Dialog_Ptr ;
  198.   name : Str255 ;
  199.  
  200. BEGIN
  201.   cmd_line[0] := chr(0) ;              (* zero length the cmd_line *)
  202.   Get_CMD := TRUE ;
  203.   Find_Dialog( TTPBOX, t_box ) ;
  204.   Center_Dialog( t_box ) ;
  205.   i := length( fname ) ;
  206.   WHILE (fname[i] <> '\') DO
  207.     i := i - 1 ;                       (* backwardly hunt the backslash *)
  208.   name := Copy( fname, i + 1, length( fname ) - i - 4 ) ;
  209.   Set_DText( t_box, TTPNAME, name, System_Font, TE_LEFT ) ;
  210.   Set_DText( t_box, CMDLINE, cmd_line, System_Font, TE_LEFT ) ;
  211.   btn := Do_Dialog( t_box, CMDLINE ) ;
  212.   Obj_SetState( t_box, btn, NORMAL, TRUE ) ;
  213.   IF btn = TTPCAN THEN
  214.     Get_CMD := FALSE ;
  215.   Get_DEdit( t_box, CMDLINE, cmd_line ) ;
  216.   End_Dialog( t_box ) ;
  217.   Delete_Dialog( t_box ) ;
  218. END ;
  219.  
  220. PROCEDURE Wait(waittime : Long_Integer);
  221. (* just wait for  n seconds. Note that TOS clock is in 2 second interval *)
  222. VAR
  223.   starttime : Long_Integer;
  224. BEGIN
  225.   starttime := Clock;
  226.   WHILE ((Clock - starttime) < waittime ) DO
  227.     ;
  228. END;
  229.  
  230.  
  231. PROCEDURE info_msg( msg : Str255) ;
  232. (* put up a message box on top of the Item Selector. Using window is better
  233.    but for some reason text does not show up after p_exec a program. *)
  234. VAR
  235.   x, y, w, h : integer ;
  236.   item,
  237.   dial_ind : Tree_Index ;
  238.  
  239. BEGIN
  240.   info_dial := New_Dialog( 2, 20, 1, 40, 3 ) ;
  241.   item := Add_Ditem( info_dial, G_String, None, 1, 1, 38, 1,
  242.           0, D_Color( Black, Black, True, 0, 0 ) ) ;
  243.   Obj_Size( info_dial, Root, x, y, w, h ) ;
  244.   Set_Dtext( info_dial, item, msg, System_Font, TE_Left ) ;
  245. (*  x := 155; y := 12*rez ; *)
  246.   Obj_Draw( info_dial, Root, max_depth, x, y, w, h ) ;
  247. (*
  248.   Show_Dialog( info_dial, 0 ) ;
  249. *)
  250. END ;
  251.  
  252. PROCEDURE formdo(index : INTEGER; hide_item : INTEGER; hide : BOOLEAN) ;
  253. (* put a zoom box to screen, button can be hiden *)
  254. VAR
  255.   x, y, w, h    : Short_Integer;
  256.   dia_obj       : Dialog_Ptr;
  257.  
  258. BEGIN (* formdo *)
  259.   Find_Dialog(index, dia_obj);
  260.   Center_Dialog(dia_obj);
  261.   Obj_Size(dia_obj, Root, x, y, w, h);  (* get some size info about the obj*)
  262.   Form_Dial(0, 0, 0, 0, 0, x, y, w, h);  (* reserve space for the box *)
  263.   Form_Dial(1, 0, 0, 0, 0, x, y, w, h);  (* expanding box -- zoom out *)
  264.   IF hide THEN BEGIN
  265.     Obj_Setflags(dia_obj, hide_item, HIDE_TREE); (* hide the button *)
  266.     Show_Dialog(dia_obj, Root);          (* no interaction *)
  267.     Wait(2);                             (* 2 seconds later close down *)
  268.     Obj_Setflags(dia_obj, hide_item, EXIT_BTN|DEFAULT|SELECTABLE);
  269.                                          (* put the button back *)
  270.   END
  271.   ELSE
  272.     dummy := Do_Dialog(dia_obj, 0);      (* no need to hide the buttom *)
  273.   Form_Dial(2, 0, 0, 0, 0, x, y, w, h);  (* shrinking box -- zoom in *)
  274.   Form_Dial(3, 0, 0, 0, 0, x, y, w, h);  (* close the box *)
  275.   Obj_Setstate(dia_obj, dummy, NORMAL, FALSE);
  276.   End_Dialog(dia_obj);
  277.   Delete_Dialog(dia_obj);
  278. END;  (* formdo *)
  279.  
  280.  
  281. PROCEDURE Set_Defaults ;
  282. (* initialize some variables *)
  283.   VAR
  284.     opt : opt_range ;
  285.     path : c_path_type ;
  286.     p_path : Path_Name ;
  287.  
  288.   BEGIN
  289.     FOR opt := 1 TO max_option DO
  290.       IF opt IN [ ERRPAUSE,CHNLINK,DBGOPT,STKOPT,RNGOPT ]
  291.         THEN cmp_opts[ opt ] := true ;
  292.     work_path[1] := chr( ord('A') + Dgetdrv ) ;
  293.     work_path[2] := ':' ;
  294.     work_path[0] := chr(2) ;
  295.  
  296.     Dgetpath( path, 0 ) ;      { Get default path } ;
  297. (*  original OSS code:
  298.     i := 1 ;
  299.     WHILE (path[i] <> chr(0)) AND (path[i] <> ' ') AND (i <= 64 ) DO
  300.       BEGIN
  301.         work_path[i+2] := path[i] ;
  302.         i := i + 1 ;
  303.       END ;
  304.     i := i + 1 ;
  305.     work_path[0] := chr(i) ;
  306. *)
  307.     C_To_PPath(path, p_path);     (* convert C string to Pas string *)
  308.  
  309.     work_path := concat( work_path, p_path, '\' ) ; (* used by FILE *)
  310.     file_path := concat( work_path, '*.*' ) ;       (* used by SPECIALS *)
  311.     editor_name := concat( work_path, 'EDITOR.PRG  ') ;
  312.     compiler_name  := concat( work_path, 'COMPILER.PRG  ' ) ;
  313.     linker_name := concat( work_path, 'LINKER.PRG  ' ) ;
  314.     paslib_name := concat ( work_path, 'PASLIB' ) ;
  315.     pasgem_name := concat ( work_path, 'GEMLIB' ) ;
  316.     printer_name := concat( work_path, 'PRINTER.PRG  ' ) ;
  317.     backup_path := work_path ;
  318.     work_path := concat( work_path, '*.PAS' ) ;
  319.     for_gem := GEM_O ;
  320.  
  321. (*  uncomment following if trying to do window
  322.     wind_title := ' ';
  323.     window_id := New_Window(None, wind_title,0 ,0, 0, 0);
  324. *)
  325.  
  326.   END ;
  327.  
  328. PROCEDURE Copy_Files( src_file, des_file : Path_Name ) ;
  329. (* a generic routine to copy file *)
  330. VAR
  331.   i,
  332.   infile,                      (* file handle for input file *)
  333.   outfile       : INTEGER ;    (* file handle for output file *)
  334.   n_bytes       : Long_INTEGER ; (* number of bytes for read/wirte *)
  335.   write_error   : BOOLEAN ;
  336.   cnvrt_str     : C_Path_Type ;
  337.   buf           : buf_type ;
  338.  
  339. BEGIN
  340.   write_error := FALSE ;
  341.   P_To_CPath(src_file, cnvrt_str) ;      (* convert to C string *)
  342.   infile := FOpen( cnvrt_str, 0 ) ;      (* open file to read *)
  343.   IF infile >= 0 THEN BEGIN              (* open success *)
  344.     P_To_CPath(des_file, cnvrt_str) ;
  345.     outfile := FCreate( cnvrt_str, 0 ) ; (* open a file regardless existence *)
  346.     IF outfile >= 0 THEN BEGIN           (* open success *)
  347.       Set_Mouse( M_BEE ) ;               (* busy copying file *)
  348.       REPEAT
  349.         n_bytes := FRead( infile, chunk, buf ) ;
  350.         IF n_bytes > 0 THEN BEGIN        (* we read something *)
  351.           IF FWrite( outfile, n_bytes, buf ) <> n_bytes THEN BEGIN
  352.             write_error := TRUE ;        (* write error *)
  353.             i := Do_Alert('[3][Error in writing|Disk is full?][ Abort ]',1) ;
  354.           END ; (* write *)
  355.         END ; (* read *)
  356.       UNTIL ((n_bytes = 0) OR write_error ) ;
  357.       FClose( outfile ) ;
  358.       Set_Mouse( M_ARROW ) ;             (* copy is done *)
  359.     END   (* outfile *)
  360.     ELSE
  361.     i := Do_Alert('[3][Error to open file|Too many file opened?][ Abort ]',1) ;
  362.     FClose( infile ) ;
  363.   END  (* infile *)
  364.   ELSE
  365.     i := Do_Alert('[3][Error to open file|File not existed?][ Abort ]',1) ;
  366. END ;
  367.  
  368.  
  369. PROCEDURE Do_Copy;
  370. (* get source and destination names and call copy_file routine *)
  371.  
  372. BEGIN
  373. (* uncomment all the routines relate to window if want to try window
  374.   Info_Window('Select File To Be Copied From...') ;
  375. *)
  376.   Info_Msg('Select File To Be Copied FROM...') ;
  377.   IF Get_In_File( file_path, src_name ) AND (length(src_name) <> 0)
  378.     THEN BEGIN
  379. (*
  380.       Close_Window( window_id ) ;
  381. *)
  382.       End_Dialog( info_dial ) ;
  383. (*
  384.       Info_Window('Select File To Be Copied To...') ;
  385. *)
  386.       Info_Msg('Select File To Be Copied TO...') ;
  387.       IF ( Get_In_File( file_path, des_name ) AND (length(des_name) <> 0)
  388.       AND (src_name <> des_name) ) THEN BEGIN    (* don't copy to itself! *)
  389. (*
  390.         Close_Window( window_id ) ;
  391. *)
  392.         End_Dialog( info_dial ) ;
  393.         Copy_Files( src_name, des_name ) ;
  394.       END
  395.       ELSE
  396. (*
  397.         Close_Window( window_id ) ;
  398. *)
  399.         End_Dialog( info_dial ) ;
  400.  
  401.     END
  402.     ELSE
  403. (*
  404.       Close_Window( window_id ) ;
  405. *)
  406.       End_Dialog( info_dial ) ;
  407.   Draw_Menu( menu ) ;
  408. END;
  409.  
  410.  
  411. PROCEDURE Disk_Space ;
  412. (* check free space of a drive *)
  413. VAR
  414.   space_box     : Dialog_Ptr ;
  415.   btn           : INTEGER ;
  416.   drive_char,
  417.   byte_used,
  418.   byte_available : Str255 ;
  419.   temp,
  420.   drive_map     : Long_INTEGER ;      (* an array with all available drives *)
  421.   drive_id      : INTEGER ;
  422.   drive_buf     : DRIVE_ARRAY ;
  423.  
  424. BEGIN
  425.   byte_used := '';
  426.   byte_available := '' ;
  427.   drive_id := Dgetdrv ;                        (* used current drv first *)
  428.   drive_char[1] := CHR(ORD('A') + drive_id) ;  (* convert to char *)
  429.   drive_char[0] := CHR(1) ;                    (* force string length to 1 *)
  430.  
  431.   Find_Dialog( DISKSP, space_box ) ;
  432.   Center_Dialog( space_box ) ;
  433.   Set_DText( space_box, DISKID, drive_char, System_Font, TE_LEFT ) ;
  434.   btn := Do_Dialog( space_box, DISKID ) ;
  435.  
  436.   Set_Mouse(M_BEE) ;    (* it takes a while for disk-free routine *)
  437.   Get_DEdit( space_box, DISKID, drive_char ) ;
  438.  
  439.   drive_id := ORD(drive_char[1]) - ORD('A') ;  (* get the drive user wants *)
  440.  
  441. (* check if the requested drive in system *)
  442.   drive_map := ShR( Dsetdrv(drive_id), drive_id ) & $0001; (* check the bit *)
  443.  
  444.   Obj_SetState( space_box, btn, Normal, true ) ;
  445.   IF ( (drive_map * drive_id) = drive_id) THEN BEGIN
  446.     Dfree(drive_buf, drive_id + 1 ) ;                (* it's a valid drive *)
  447.     temp := drive_buf[3] * drive_buf[4];             (* bytes per cluster *)
  448.     WriteV( byte_available, (drive_buf[1] * temp) : 8 ) ;
  449.     WriteV( byte_used, ((drive_buf[2] - drive_buf[1])* temp) : 8 ) ;
  450.     Set_DText( space_box, BYTEAVL, byte_available, System_Font, TE_RIGHT ) ;
  451.     Set_DText( space_box, BYTEUSED, byte_used, System_Font, TE_RIGHT ) ;
  452.     Obj_SetFlags( space_box, DISKID, NONE) ;        (* don't edit the id now *)
  453.     Set_Mouse(M_Arrow) ;
  454.     btn := Do_Dialog( space_box, 0 ) ;
  455.     Obj_SetFlags( space_box, DISKID, EDITABLE) ;     (* resume the editable *)
  456.     Obj_SetState( space_box, btn, Normal, true ) ;
  457.     Set_Mouse(M_ARROW) ;
  458.   END
  459.   ELSE BEGIN
  460.     Set_Mouse(M_ARROW) ;
  461.     End_Dialog( space_box ) ;
  462.     byte_used:=Concat('[2][ |Drive ',drive_char,'|does not existed][ Abort ]');
  463.     btn := Do_Alert(byte_used, 1 ) ;
  464.   END ;
  465.   End_Dialog( space_box ) ;
  466.   Delete_Dialog( space_box ) ;
  467. END ;
  468.  
  469.  
  470. PROCEDURE Rename_File ;
  471. (* renaming file *)
  472. VAR
  473.   old, new      : C_Path_Type ;
  474.   i             : INTEGER ;
  475.  
  476. BEGIN
  477. (*
  478.   Info_Window('Select File To Be Renamed From...') ;
  479. *)
  480.   info_msg( 'Select file to be renamed FROM...') ;
  481.   IF Get_In_File( file_path, src_name ) AND (length(src_name) <> 0)
  482.     THEN BEGIN
  483. (*
  484.       Close_Window( window_id ) ;
  485. *)
  486.       End_Dialog( info_dial ) ;
  487. (*
  488.       Info_Window('Select File To Be Renamed To...') ;
  489. *)
  490.       info_msg( 'Select file to be rename TO...' ) ;
  491.       IF ( Get_In_File( file_path, des_name ) AND (length(des_name) <> 0)
  492.       AND (src_name <> des_name) ) THEN BEGIN    (* don't rename to itself! *)
  493. (*        Close_Window( window_id ) ; *)
  494.         End_Dialog( info_dial ) ;
  495.         P_To_CPath( src_name, old ) ;
  496.         P_To_CPath( des_name, new ) ;
  497.         IF src_name[1] <> des_name[1] THEN
  498.           i := Do_Alert('[3][Cannot rename to|a different drive][ Abort ]',
  499.                         1 )
  500.         ELSE
  501.           CASE FRename( 0, old, new ) OF
  502.             -34 :
  503.           i := Do_Alert('[3][Cannot rename to an|existent file][ Abort ]',
  504.                    1 ) ;
  505.             -36 :
  506.           i := Do_Alert('[3][Error in renaming file|File not found][ Abort ]',
  507.                    1 ) ;
  508.           END ; (* case *)
  509.       END (* outfile *)
  510.       ELSE
  511. (*        Close_Window( window_id ) ; *)
  512.         End_Dialog( info_dial ) ;
  513.     END (* infile *)
  514.     ELSE
  515. (*      Close_Window( window_id ) ; *)
  516.       End_Dialog( info_dial ) ;
  517.     Draw_Menu( menu ) ;      (* kludgy way to repain the menu bar *)
  518. END ;
  519.  
  520. PROCEDURE Delete_File ;
  521. VAR
  522.   c_str : C_Path_Type ;
  523.   i     : INTEGER ;
  524.  
  525. BEGIN
  526. (*
  527.   Info_Window('Select File To Be Deleted...') ;
  528. *)
  529.   Info_Msg('Select File To Be Deleted...') ;
  530.   IF Get_In_File( file_path, src_name ) AND (length(src_name) <> 0)
  531.     THEN BEGIN
  532. (*
  533.       Close_Window( window_id ) ;
  534. *)
  535.       End_Dialog( info_dial ) ;
  536.       P_To_CPath(src_name, c_str) ;
  537.       IF FDelete(c_str) < 0 THEN
  538.        i := Do_Alert('[2][Error in deleting file|Non-existent file?][ Abort ]',
  539.                        1 ) ;
  540.     END
  541.     ELSE
  542. (*
  543.       Close_Window( window_id ) ;
  544. *)
  545.       End_Dialog( info_dial ) ;
  546.   Draw_Menu( menu ) ;
  547. END ;
  548.  
  549. PROCEDURE Print_File ;
  550. (* to be completed. Will have some codes to check printer status and call up
  551.    the printer.prg program *)
  552. BEGIN
  553.   ;
  554. END ;
  555.  
  556.  
  557. PROCEDURE Locate_Programs ;
  558. (* local filenames, similar to Pascal version 2. *)
  559. VAR
  560.   fpath,
  561.   fname : Path_Name ;
  562.   msg : Str255 ;
  563.   l_box : Dialog_Ptr ;
  564.   btn : Integer ;
  565.  
  566. BEGIN
  567.   Find_Dialog( LOCATE, l_box ) ;
  568.   Center_Dialog( l_box ) ;
  569.   REPEAT
  570.     btn := Do_Dialog( l_box, 0 ) ;
  571.     CASE btn OF
  572.       LEDIT   : BEGIN
  573.                   msg := 'Select the EDITOR filename...' ;
  574.                   fname := 'EDITOR.' ;
  575.                 END ;
  576.       LCMP    : BEGIN
  577.                   msg := 'Select the COMPILER filename...' ;
  578.                   fname := 'COMPILER.PRG' ;
  579.                 END ;
  580.       LLINK   : BEGIN
  581.                   msg := 'Select the LINKER filename...' ;
  582.                   fname := 'LINKER.PRG' ;
  583.                 END ;
  584.       LPASGEM : BEGIN
  585.                   msg := 'Select the PASGEM filename...' ;
  586.                   fname := 'PASGEM' ;
  587.                 END ;
  588.       LPASLIB : BEGIN
  589.                   msg := 'Select the PASLIB filename...' ;
  590.                   fname := 'PASLIB' ;
  591.                 END ;
  592.       LPRT    : BEGIN
  593.                   msg := 'Select the PRINTER filename...' ;
  594.                   fname := 'PRINTER.PRG' ;
  595.                 END ;
  596.     END ;
  597.     IF btn <> LOKBTN THEN BEGIN
  598. (*
  599.       info_window( msg ) ;
  600. *)
  601.       Info_Msg( msg ) ;
  602.       IF Get_In_File( file_path, fname ) AND (length(fname) <> 0) THEN BEGIN
  603. (*
  604.         Close_Window( window_id ) ;
  605. *)
  606.         End_Dialog( info_dial ) ;
  607.         Draw_Menu( menu ) ;
  608.         CASE btn OF
  609.           LEDIT   : editor_name := fname ;
  610.           LCMP    : compiler_name := fname ;
  611.           LLINK   : linker_name := fname ;
  612.           LPASGEM : pasgem_name := fname ;
  613.           LPASLIB : paslib_name := fname ;
  614.           LPRT    : printer_name := fname ;
  615.         END ;
  616.       END
  617.       ELSE
  618. (*
  619.         Close_Window( window_id ) ;
  620. *)
  621.         End_Dialog( info_dial ) ;
  622.         Draw_Menu( menu ) ;
  623.     END ;
  624.     Obj_SetState( l_box, btn, Normal, TRUE ) ;
  625.   UNTIL btn = LOKBTN ;
  626.   End_Dialog( l_box ) ;
  627.   Delete_Dialog( l_box ) ;
  628. END ;
  629.  
  630.  
  631. PROCEDURE Read_Options ;
  632. (* read options from the .INF file *)
  633.   VAR
  634.     f : text ;
  635.     version : integer ;
  636.     temp : integer ;
  637.     opt : opt_range ;
  638.  
  639.   BEGIN
  640.     IO_Check( false ) ;
  641.     reset( f, 'PASCALM.INF' ) ;
  642.     IO_Check( true ) ;
  643.     IF IO_Result = 0 THEN
  644.       BEGIN
  645.         readln( f, version ) ;
  646.         FOR opt := 1 TO max_option DO
  647.           IF opt IN [ ERRPAUSE,CHNLINK,DBGOPT,
  648.                       STKOPT,RNGOPT,CLROPT,BAKOPT,NOCODE ]
  649.            THEN
  650.             BEGIN
  651.               readln( f, temp ) ;
  652.               cmp_opts[ opt ] := temp <> 0 ;
  653.             END ;
  654.         readln( f, for_gem ) ; (* 1 for GEM, 2 for TOS, 3 for TTP, 4 for ACC *)
  655.         readln( f, addl_files ) ;
  656.         readln( f, addl_libs ) ;
  657.         readln( f, backup_path ) ;
  658.         readln( f, editor_name ) ;
  659.         readln( f, compiler_name ) ;
  660.         readln( f, linker_name ) ;
  661.         readln( f, pasgem_name ) ;
  662.         readln( f, paslib_name ) ;
  663.         readln( f, printer_name ) ;
  664.         close( f ) ;
  665.       END
  666.   END ;
  667.  
  668. PROCEDURE Save_Options ;
  669. (* sace options to the .INF file *)
  670.   VAR
  671.     f : text ;
  672.     junk : integer ;
  673.     alert : Str255 ;
  674.     opt : opt_range ;
  675.  
  676.   BEGIN
  677.     IO_Check( false ) ;
  678.     rewrite( f, 'PASCALM.INF' ) ;
  679.     IO_Check( true ) ;
  680.     IF IO_Result <> 0 THEN
  681.       BEGIN
  682.         alert := '[2][Error occurred while trying|to write the options';
  683.         alert := ConCat(alert, 'file.][  OK  ]');
  684.         junk:=Do_Alert(alert, 1 ) ;
  685.       END
  686.     ELSE
  687.       BEGIN
  688.         Set_Mouse( M_BEE ) ;         (* busy saving file *)
  689.         writeln( f, $100:1 ) ;  { Version 1.00 }
  690.         FOR opt := 1 TO max_option DO
  691.           IF opt IN [ ERRPAUSE,CHNLINK,DBGOPT,STKOPT,RNGOPT,CLROPT,
  692.                       BAKOPT,NOCODE ]
  693.            THEN
  694.             writeln( f, ord( cmp_opts[opt] ):1 ) ;
  695.         writeln( f, for_gem ) ;
  696.         writeln( f, addl_files ) ;
  697.         writeln( f, addl_libs ) ;
  698.         writeln( f, backup_path ) ;
  699.         writeln( f, editor_name ) ;
  700.         writeln( f, compiler_name ) ;
  701.         writeln( f, linker_name ) ;
  702.         writeln( f, pasgem_name ) ;
  703.         writeln( f, paslib_name ) ;
  704.         writeln( f, printer_name ) ;
  705.         close( f ) ;
  706.         Set_Mouse( M_ARROW ) ;
  707.       END
  708.   END ;
  709.  
  710.  
  711. PROCEDURE out_esc( c : char ) ;
  712.  
  713.   BEGIN
  714.     bconout( 2, 27 ) ;
  715.     bconout( 2, ord(c) ) ;
  716.   END ;
  717.  
  718. PROCEDURE Tos_Screen ;
  719.  
  720.   BEGIN
  721.     Hide_Mouse ;
  722.     out_esc( 'E' ) ;        { Clear screen }
  723.     out_esc( 'e' ) ;        { and cursor on }
  724.   END ;
  725.  
  726. PROCEDURE Redraw_Screen ;
  727. VAR
  728.   x, y, w, h : integer;
  729.  
  730. BEGIN
  731.   Work_Rect( 0, x, y, w, h ) ;
  732.   Form_Dial( 3, 0, 0, 0, 0, x, y, w, h ) ;  (* a dirty and quick way *)
  733. END ;
  734.  
  735.  
  736.  
  737. PROCEDURE Gem_Screen ;
  738.  
  739.   BEGIN
  740.     out_esc( 'f' ) ;        { Cursor off }
  741.     Show_Mouse ;
  742.   END ;
  743.  
  744. FUNCTION Call_Overlay( prog : Path_Name ; VAR cmd_line : Str255 ;
  745.                             tos : boolean ) : integer ;
  746. (* call editor, compiler, linker *)
  747.   VAR
  748.     i : integer ;
  749.     prog_name : C_Path_Type ;
  750.     tail : C_String ;
  751.  
  752.   FUNCTION p_exec( load : integer ; VAR name : C_Path_Type;
  753.                    VAR tail : C_String ; VAR envp : env_ptr ) : integer ;
  754.     GEMDOS( $4B ) ;
  755.  
  756.   BEGIN
  757.     FOR i := 1 TO length( cmd_line ) DO
  758.       tail[i] := cmd_line[i] ;
  759.     tail[ length(cmd_line)+1 ] := chr(0) ;
  760.     tail[0] := chr( length(cmd_line) ) ;
  761.  
  762.     P_To_CPath( prog, prog_name ) ;
  763.     Erase_Menu( menu ) ;
  764.     IF tos THEN
  765.       Tos_Screen ;
  766.     Call_Overlay := p_exec( 0, prog_name, tail, envp ) ;
  767.     IF tos THEN
  768.       Gem_Screen ;
  769.     Redraw_Screen ;
  770.     Draw_Menu( menu ) ;
  771. (*
  772.     window_id := New_Window(None, wind_title, 0 ,0, 0, 0);
  773. *)
  774.   END ;
  775.  
  776.  
  777. PROCEDURE Strip_Extension( VAR fn : Path_Name ) ;
  778. { Strip_Extension - Remove the extension from a Path_Name variable. }
  779.  
  780.   VAR
  781.     i : integer ;
  782.     done : boolean ;
  783.  
  784.   BEGIN
  785.     i := length( fn ) ;
  786.     done := false ;
  787.     WHILE NOT done DO
  788.       BEGIN
  789.         IF i < 1 THEN
  790.           done := true
  791.         ELSE IF (fn[i] = ':') OR (fn[i] = '\') THEN
  792.           done := true
  793.         ELSE IF fn[i] = '.' THEN
  794.           BEGIN
  795.             fn[0] := chr(i-1) ;
  796.             done := true ;
  797.           END
  798.         ELSE
  799.           i := i - 1 ;
  800.       END ;
  801.   END ;
  802.  
  803. PROCEDURE Do_Link( name : Path_Name ; for_gem : integer ) ;
  804. { Do_Link - Call the linker with a desired file as input. }
  805.  
  806.   VAR
  807.     junk : integer ;
  808.     extension : STRING [ 5 ] ;
  809.     libs,
  810.     cmd_line : Str255 ;
  811.     x, y, w, h : integer ;
  812.     dial : Dialog_Ptr ;
  813.  
  814.   BEGIN
  815.     Strip_Extension( name ) ;
  816.     cmd_line := name ;
  817.     CASE for_gem OF
  818.       GEM_O : extension := '.PRG=' ;
  819.       ACC_O : extension := '.ACC=' ;
  820.       TOS_O : extension := '.TOS=' ;
  821.       TTP_O : extension := '.TTP=' ;
  822.     END ;
  823.     CASE for_gem OF
  824.       GEM_O, ACC_O : libs := concat(',', pasgem_name, ',', paslib_name) ;
  825.       TOS_O, TTP_O : libs := concat(',', paslib_name) ;
  826.     END ;
  827.     cmd_line := concat( '! ', name, extension, name ) ;
  828.     IF length(addl_files) > 0 THEN
  829.       cmd_line := concat( cmd_line, ',', addl_files ) ;
  830.     IF length(addl_libs) > 0 THEN
  831.       cmd_line := concat( cmd_line, ',', addl_libs ) ;
  832.     cmd_line := concat( cmd_line, libs ) ;
  833.     Find_Dialog( LOADING, dial ) ;
  834.     Set_DText( dial, LOADNAME, 'LINKER.PRG', System_Font, TE_Left ) ;
  835.     Center_Dialog( dial ) ;
  836.     Obj_Size( dial, Root, x, y, w, h ) ;
  837.     Obj_Draw( dial, Root, Max_Depth, x, y, w, h ) ;
  838.     junk := Call_Overlay( linker_name, cmd_line, false ) ;
  839.   END ;
  840.  
  841. FUNCTION Do_Compile : integer ;
  842. { Do_Compile - Call the compiler with a desired file as input. }
  843.  
  844.   VAR
  845.     cmp_code : integer ;
  846.     cmd_line : Str255 ;
  847.     src,
  848.     des,
  849.     name : Path_Name ;
  850.     x, y, w, h,
  851.     i : integer ;
  852.     dial : Dialog_Ptr ;
  853.  
  854.   BEGIN
  855.     name := edit_name ;
  856.     Strip_Extension( name ) ;
  857.     cmd_line := concat( name, ' ', temp_path, ' /UGEM' ) ;
  858.     CASE for_gem OF
  859.       GEM_O : cmd_line := concat( cmd_line, ' /GEM' ) ;
  860.       ACC_O : cmd_line := concat( cmd_line, ' /ACC' ) ;
  861.     END ;
  862.     IF cmp_opts[ ERRPAUSE ] THEN
  863.       cmd_line := concat( cmd_line, ' /PAUSE' ) ;
  864.     IF cmp_opts[ DBGOPT ] THEN
  865.       cmd_line := concat( cmd_line, ' /DEBUG' ) ;
  866.     IF NOT cmp_opts[ STKOPT ] THEN
  867.       cmd_line := concat( cmd_line, ' /NOCHECK' ) ;
  868.     IF cmp_opts[ RNGOPT ] THEN
  869.       cmd_line := concat( cmd_line, ' /CHECK' ) ;
  870.     IF cmp_opts[ CLROPT ] THEN
  871.       cmd_line := concat( cmd_line, ' /CLEAR' ) ;
  872.     IF cmp_opts[ NOCODE ] THEN
  873.       cmd_line := concat( cmd_line, ' /NOCODE' ) ;
  874.     Find_Dialog( LOADING, dial ) ;
  875.     Set_DText( dial, LOADNAME, 'COMPILER.PRG', System_Font, TE_Left ) ;
  876.     Center_Dialog( dial ) ;
  877.     Obj_Size( dial, Root, x, y, w, h ) ;
  878.     Obj_Draw( dial, Root, Max_Depth, x, y, w, h ) ;
  879.     cmp_code := Call_Overlay( compiler_name, cmd_line, false ) ;
  880.     Do_Compile := 0 ;
  881.     IF cmp_code = 2 THEN        { User wants to edit! }
  882.       BEGIN
  883.         Do_Compile := 1 ;
  884.         i := 0 ;
  885.         WHILE envp^[i] <> chr(0) DO
  886.           BEGIN
  887.             edit_name[i+1] := envp^[i] ;
  888.             i := i + 1 ;
  889.           END ;
  890.         edit_name[0] := chr(i) ;
  891.       END
  892.     ELSE BEGIN
  893.       IF (cmp_code = 0) AND (cmp_opts[ BAKOPT ]) THEN BEGIN
  894.         src := edit_name ;
  895.         i := length(src) ;
  896.         WHILE src[i] <> '\' DO    (* backwardly hunt the backslash *)
  897.           i := i - 1 ;
  898.         des := COPY( src, i + 1, length(src) - i ) ;
  899.         des := concat( backup_path, des ) ;
  900.         Copy_Files( src, des ) ;
  901.       END ;
  902.       IF (cmp_code = 0) AND (cmp_opts[ CHNLINK ]) THEN
  903.         Do_Link( name, for_gem ) ;
  904.     END ;
  905.   END ;
  906.  
  907. FUNCTION Do_Edit : integer ;
  908. { Do_Edit - Pass control to the Lohse editor. }
  909.  
  910.   VAR
  911.     cmd_line : Str255 ;
  912.     i : integer ;
  913.     is_tos : boolean ;
  914.  
  915.   BEGIN
  916.     cmd_line := edit_name ;
  917.     is_tos := Is_TTP_Name( editor_name ) ;  (* allow using different type of
  918.                                                editors *)
  919.     IF Call_Overlay( editor_name, cmd_line, is_tos ) = 1 THEN
  920.       Do_Edit := 2
  921.     ELSE
  922.       Do_Edit := 0
  923.   END ;
  924.  
  925. PROCEDURE Compile_Edit( which : integer ) ;
  926. { Compile_Edit - Loop for "compile-edit-link" process. }
  927. (* which : 1   Editor
  928.            2   Compiler
  929. *)
  930.   VAR
  931.     i : integer ;
  932.  
  933.   BEGIN
  934.     Strip_Extension( work_path ) ;
  935.     work_path := concat( work_path, '.PAS' ) ;
  936.  
  937. (*
  938.     IF which = 1 THEN
  939.       Info_Window('Select File To Be Edit...') ;
  940.     IF which = 2 THEN
  941.       Info_Window('Select File To Be Compiled...') ;
  942. *)
  943.  
  944.     IF Get_In_File( work_path, edit_name ) AND (length(edit_name) <> 0)
  945.     THEN BEGIN
  946. (*
  947.       Close_Window( window_id ) ;
  948. *)
  949.       WHILE which <> 0 DO
  950.         BEGIN
  951.           IF which = 1 THEN     { Editor phase! }
  952.             BEGIN
  953.               which := Do_Edit ;
  954.               FOR i := length( edit_name ) DOWNTO 1 DO
  955.                 IF edit_name[i] = ' ' THEN
  956.                   edit_name[0] := chr( i-1 ) ;
  957.             END (* IF *)
  958.           ELSE
  959.             which := Do_Compile ;
  960.         END ; (* WHILE *)
  961.     END  (* IF *)
  962.     ELSE
  963. (*
  964.       Close_Window( window_id ) ;
  965. *)
  966.   END ;
  967.  
  968.  
  969. PROCEDURE Call_Linker ;
  970.  
  971.   BEGIN
  972.     Strip_Extension( work_path ) ;
  973.     work_path := concat( work_path, '.O' ) ;
  974. (*
  975.     Info_Window('Select File To Be Linked...') ;
  976. *)
  977.     IF Get_In_File( work_path, link_name ) AND (length(link_name) <> 0)
  978.     THEN BEGIN
  979. (*
  980.       Close_Window( window_id ) ;
  981. *)
  982.       Do_Link( link_name, for_gem ) ;
  983.     END  (* IF *)
  984.     ELSE
  985. (*
  986.       Close_Window( window_id ) ;
  987. *)
  988.   END ;
  989.  
  990.  
  991. PROCEDURE Call_Program ;
  992.  
  993.   TYPE
  994.     environment = PACKED ARRAY [ 1..9 ] OF char ;
  995.  
  996.   VAR
  997.     skip : boolean ;
  998.     i : integer ;
  999.     name : C_Path_Type ;
  1000.     tail : C_String ;
  1001.     cmd_line : Str255 ;
  1002.     env : environment ;
  1003.     run_gem : boolean ;
  1004.     ttp_box : Dialog_Ptr ;
  1005.  
  1006.   PROCEDURE p_exec( load : integer ; VAR name : C_Path_Type ;
  1007.                     VAR tail : C_String ; VAR env : environment ) ;
  1008.     GEMDOS( $4B ) ;
  1009.  
  1010.  
  1011.   BEGIN
  1012.     skip := FALSE ;
  1013.     Strip_Extension( work_path ) ;
  1014.     CASE for_gem OF
  1015.       GEM_O :  work_path := concat( work_path, '.PRG' ) ;
  1016.       TOS_O :  work_path := concat( work_path, '.TOS' ) ;
  1017.       TTP_O :  work_path := concat( work_path, '.TTP' ) ;
  1018.     END ;
  1019. (*
  1020.     Info_Window('Select File To Be Run...') ;
  1021. *)
  1022.     IF Get_In_File( work_path, run_name ) AND (length(run_name) <> 0) THEN
  1023.       BEGIN
  1024. (*
  1025.         Close_Window( window_id ) ;
  1026. *)
  1027.         P_To_CPath( run_name, name ) ;
  1028.         env := 'PATH=A:\ ' ;
  1029.         env[9] := chr(0) ;
  1030.         run_gem := Is_Gem_Name( run_name ) ;
  1031.         IF Is_TTP_Name( run_name ) THEN BEGIN
  1032.           IF Get_CMD( run_name, cmd_line ) THEN BEGIN ; (* get command line *)
  1033.             FOR i := 1 TO length( cmd_line ) DO
  1034.               tail[i] := cmd_line[i] ;
  1035.             tail[ length(cmd_line)+1 ] := chr(0) ;
  1036.             tail[0] := chr( length(cmd_line) ) ;
  1037.           END
  1038.           ELSE
  1039.             skip := TRUE ;
  1040. (*
  1041.           P_To_Cstr( cmd_line, tail ) ;
  1042.           tail[0] := chr(length( cmd_line )) ;
  1043.           tail[ length( cmd_line ) + 1 ] := chr(0) ;
  1044. *)
  1045.         END
  1046.         ELSE BEGIN
  1047.           tail[0] := chr(0) ;
  1048.           tail[1] := chr(0) ;
  1049.         END ;
  1050.         IF NOT skip THEN BEGIN
  1051.           Erase_Menu( menu ) ;
  1052. (*
  1053.           Delete_Window( window_id ) ;
  1054. *)
  1055.           IF NOT run_gem THEN
  1056.             Tos_Screen ;
  1057.           p_exec( 0, name, tail, env ) ;
  1058.           IF NOT run_gem THEN
  1059.             BEGIN
  1060.               writeln( 'Hit any key to continue...' ) ;
  1061.               bconin( 2 ) ;       { Get a key from the BIOS! }
  1062.               Gem_Screen ;
  1063.             END ;
  1064.           Redraw_Screen ;
  1065.           Draw_Menu( menu ) ;
  1066.         END (* not skip *)
  1067.       END (* get filename *)
  1068.     ELSE
  1069. (*
  1070.       Close_Window( window_id ) ;
  1071. *)
  1072.   END ;
  1073.  
  1074.  
  1075. PROCEDURE Link_Options ;
  1076.  
  1077.   VAR
  1078.     dial : Dialog_Ptr ;
  1079.     opt,
  1080.     button : integer ;
  1081.  
  1082.   BEGIN
  1083.     Find_Dialog( LNKOPTS, dial ) ;
  1084.     Center_Dialog( dial ) ;
  1085.     FOR opt := 1 TO max_option DO
  1086.       IF opt IN [ LFORGEM,LFORTOS,LFORTTP,LFORACC ] THEN
  1087.         Obj_SetState( dial, opt, Normal, false ) ; (* reset every buttons *)
  1088.     CASE for_gem OF
  1089.       GEM_O :  Obj_SetState( dial, LFORGEM, Selected, false ) ;
  1090.       TOS_O :  Obj_SetState( dial, LFORTOS, Selected, false ) ;
  1091.       TTP_O :  Obj_SetState( dial, LFORTTP, Selected, false ) ;
  1092.       ACC_O :  Obj_SetState( dial, LFORACC, Selected, false ) ;
  1093.     END ;
  1094.     Set_DText( dial, LNKADDL, addl_files, System_Font, TE_Left ) ;
  1095.     Set_DText( dial, LNKLIBS, addl_libs, System_Font, TE_Left ) ;
  1096.     button := Do_Dialog( dial, LNKADDL ) ;
  1097.     Obj_SetState( dial, button, Normal, true ) ;
  1098.     End_Dialog( dial ) ;
  1099.     IF button = LNKOK THEN
  1100.       BEGIN
  1101.         IF Obj_State( dial, LFORGEM ) = Selected THEN
  1102.           for_gem := GEM_O ;
  1103.         IF Obj_State( dial, LFORTOS ) = Selected THEN
  1104.           for_gem := TOS_O ;
  1105.         IF Obj_State( dial, LFORTTP ) = Selected THEN
  1106.           for_gem := TTP_O ;
  1107.         IF Obj_State( dial, LFORACC ) = Selected THEN
  1108.           for_gem := ACC_O ;
  1109.         Get_DEdit( dial, LNKADDL, addl_files ) ;
  1110.         Get_DEdit( dial, LNKLIBS, addl_libs ) ;
  1111.       END ;
  1112.     Delete_Dialog( dial ) ;
  1113.   END ;
  1114.  
  1115.  
  1116. { Compiler_Options - Allow the user to change various options within the
  1117.     compiler by activating the "Personal Pascal Compiler Options" dialog. }
  1118.  
  1119. PROCEDURE Compiler_Options ;
  1120.  
  1121.   VAR
  1122.     dial : Dialog_Ptr ;
  1123.     button : integer ;
  1124.     opt : opt_range ;
  1125.  
  1126.   BEGIN
  1127.     Find_Dialog( CMPOPTS, dial ) ;
  1128.     Center_Dialog( dial ) ;
  1129.     { First, we need to ensure that the state of various dialog objects
  1130.       matches the state of our internal variables! }
  1131.     FOR opt := 1 TO max_option DO
  1132.       IF opt IN [ FORGEM,FORTOS,FORACC,ERRPAUSE, DBGOPT,
  1133.                   STKOPT,RNGOPT,CLROPT,BAKOPT,NOCODE ] THEN
  1134.         Obj_SetState( dial, opt, Normal, false ) ;
  1135.     CASE for_gem OF
  1136.       GEM_O        :  Obj_SetState( dial, FORGEM, Selected, false ) ;
  1137.       TOS_O, TTP_O :  Obj_SetState( dial, FORTOS, Selected, false ) ;
  1138.       ACC_O        :  Obj_SetState( dial, FORACC, Selected, false ) ;
  1139.     END ;
  1140.     FOR opt := 1 TO max_option DO
  1141.       IF opt IN [ ERRPAUSE, DBGOPT,STKOPT,RNGOPT,CLROPT,BAKOPT, NOCODE ] THEN
  1142.         IF cmp_opts[ opt ] THEN
  1143.           Obj_SetState( dial, opt, Checked, false ) ;
  1144.     IF cmp_opts[ NOCODE ] THEN BEGIN  (* no object code, so no link *)
  1145.       cmp_opts[ CHNLINK ] := FALSE ;
  1146.       Obj_SetState( dial, CHNLINK, Normal, false ) ;
  1147.     END
  1148.     ELSE
  1149.       Obj_SetState( dial, CHNLINK, Checked, false ) ;
  1150.     Set_DText( dial, BACKPATH, backup_path, System_Font, TE_Left ) ;
  1151.     button := Do_Dialog( dial, BACKPATH ) ;
  1152.     WHILE (button <> CMPOK) AND (button <> CMPCAN) DO
  1153.       BEGIN
  1154.         IF Obj_State(dial, button) = Normal THEN
  1155.           Obj_SetState( dial, button, Checked, true )
  1156.         ELSE
  1157.           Obj_SetState( dial, button, Normal, true ) ;
  1158.         IF Obj_State(dial, NOCODE) = Checked THEN
  1159.           Obj_SetState( dial, CHNLINK, Normal, true ) ;
  1160.         button := Redo_Dialog( dial, BACKPATH ) ;
  1161.       END ;
  1162.     Obj_SetState( dial, button, Normal, true ) ;
  1163.     End_Dialog( dial ) ;
  1164.     IF button = CMPOK THEN
  1165.       BEGIN
  1166.         FOR opt := 1 TO max_option DO
  1167.           IF opt IN [ ERRPAUSE,CHNLINK,DBGOPT,STKOPT,RNGOPT,CLROPT,
  1168.                       BAKOPT,NOCODE ] THEN
  1169.             cmp_opts[ opt ] := Obj_State( dial, opt ) = Checked ;
  1170.         IF Obj_State( dial, FORGEM ) = Selected THEN
  1171.           for_gem := GEM_O ;
  1172.         IF Obj_State( dial, FORTOS ) = Selected THEN
  1173.           for_gem := TOS_O ;
  1174.         IF Obj_State( dial, FORACC ) = Selected THEN
  1175.           for_gem := ACC_O ;
  1176.         Get_DEdit( dial, BACKPATH, backup_path ) ;
  1177.       END ;
  1178.    Delete_Dialog( dial ) ;
  1179.   END ;
  1180.  
  1181.  
  1182.  
  1183. { Do_Menu - Perform a menu operation which was selected by the user with the
  1184.     mouse.  The chosen menu title and item are passed in the parameters
  1185.     'title' and 'item', respectively. }
  1186.  
  1187.   FUNCTION Do_Menu( title, item : integer ) : boolean ;
  1188.  
  1189.     VAR
  1190.       done : boolean ;
  1191.  
  1192.     BEGIN
  1193.       done := false ;
  1194.       CASE item OF
  1195.         MIINFO    : Formdo(PASINFO, INFOBTN, NOHIDE);
  1196.         MIEDIT    : Compile_Edit( 1 ) ;
  1197.         MICOMPIL  : Compile_Edit( 2 ) ;
  1198.         MILINK    : Call_Linker ;
  1199.         MIRUN     : Call_Program ;
  1200.         MICMPOPT  : Compiler_Options ;
  1201.         MILNKOPT  : Link_Options ;
  1202.         MISAVOPT  : Save_Options ;
  1203.         MILOCATE  : Locate_programs ;
  1204.         MICOPY    : Do_Copy ;
  1205.         MIDLF     : Delete_File ;
  1206.         MICHN     : Rename_File ;
  1207.         MIPRF     : Print_File ;
  1208.         MIDF      : Disk_Space ;
  1209.         MIQUIT    : done := true ;
  1210.       END ;
  1211.       Menu_Normal( menu, title ) ;
  1212.       Redraw_Screen ;
  1213.       Do_Menu := done ;
  1214.     END ;
  1215.  
  1216.   PROCEDURE Event_Loop ;
  1217.  
  1218.     VAR
  1219.       which : integer ;
  1220.       done : boolean ;
  1221.       msg : Message_Buffer ;
  1222.  
  1223.     BEGIN
  1224.       REPEAT
  1225.         which := Get_Event( E_Message, 0, 0, 0, 0,
  1226.                     false, 0, 0, 0, 0, false, 0, 0, 0, 0,
  1227.                     msg, dummy, dummy, dummy, dummy, dummy, dummy ) ;
  1228.         IF which & E_Message <> 0 THEN
  1229.           done := Do_Menu( msg[3], msg[4] ) ;
  1230.       UNTIL done ;
  1231.     END ;
  1232.  
  1233.  
  1234. FUNCTION Low_Resolution : boolean ;
  1235.  
  1236. BEGIN
  1237.   rez := get_rez ;                (* need to remember screen resolution *)
  1238.   Low_Resolution := (rez = 0) ;
  1239. END ;
  1240.  
  1241. (* main *)
  1242.   BEGIN
  1243.     IF Init_Gem <> -1 THEN
  1244.       BEGIN
  1245.         IF NOT Load_Resource( 'pascalm.rsc' ) THEN
  1246.           dummy := Do_Alert( '[3][PASCALM.RSC not found!][ Cancel ]', 0 )
  1247.         ELSE IF Low_Resolution THEN
  1248.           BEGIN
  1249.             bad_res := '[3][You must use medium or|high resolution to use|';
  1250.             bad_res := ConCat(bad_res, 'Personal Pascal.][ Cancel ]');
  1251.             dummy := Do_Alert(bad_res, 0);
  1252.           END
  1253.         ELSE
  1254.           BEGIN
  1255.             Set_Defaults ;
  1256.             Read_Options ;
  1257.             new( envp ) ;
  1258.             envp^[0] := chr(0) ;
  1259. (*            zero_word := 0 ; *)
  1260.             Find_Menu( PASMENU, menu ) ;
  1261.             Draw_Menu( menu ) ;
  1262. (*            Border_Rect( 0, fullx, fully, fullw, fullh ) ; *)
  1263.             Init_Mouse;
  1264.             Set_Mouse( M_Arrow ) ;
  1265.             Formdo(PASINFO, INFOBTN, HIDE);
  1266.             Event_Loop ;
  1267.             Erase_Menu( menu ) ;
  1268. (*
  1269.             Delete_Window( window_id );
  1270. *)
  1271.           END ;
  1272.         Exit_Gem ;
  1273.       END ;
  1274.   END.
  1275.  
  1276. { End of pascalm.pas }
  1277.