home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 06 / shell.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-05-18  |  27.3 KB  |  685 lines
  1. (*   Mit diesem Programm soll versucht werden einen Nachteil des *)
  2. (*   Prospero Pascals zu beseitigen.                             *)                  
  3. (*   Diese Shell soll zeigen, wie man einen Compiler mit einer   *)
  4. (*   benutzerfreundlichen Oberfläche ausstatten kann.            *)
  5.  
  6. (*   Geschrieben von : Peter Stöhr                               *)
  7. (*                                                               *)
  8. (*                          Verison 2.6                          *)
  9. (*                                                               *)
  10.  
  11. PROGRAM shell (input,output,datei);
  12.  
  13. CONST
  14. {$I SHELL.I}                                  (* Includefile des RSC *)
  15.  
  16. TYPE
  17.   STRING136 = STRING[136];                    (* Datenstruktur für execprog *)
  18. {$I GEMTYPES.INC}
  19.  
  20.  
  21. VAR 
  22. {$I VDICOMM.INC}                              (* Standart GEM-Variable *)
  23.   work_in : work_in_type;                     (* Variable für v_opnwk *)
  24.   work_out : work_out_type;
  25.   gem_handle : handle_type;                   (* Handle für GEM-Routinen *)
  26.   menue_addr : tree_ptr_type;                 (* Zeiger auf das Menü im RSC-File *)
  27.   info_addr : tree_ptr_type;                  (* Zeiger auf Infobild in RSC-File *)
  28.   aes_antwort : word;                         (* Antwort von AES-Proceduren *)
  29.   i : INTEGER;                                (* Laufvariable *)
  30.   gemprog : BOOLEAN;                          (* Flag ob GEM-Programm *)
  31.   map : BOOLEAN;                              (* Flag ob Linkmap oder nicht *)
  32.   leer_filename : filename_type;              (* Leerer String für GEM-Routinen *)
  33.   path_rename,                                (* Pfad für Rename-Funktion *)
  34.   path_erase,                                 (* Pfad für Datei löschen *)
  35.   path_start,                                 (* Pfad für Datei starten *)
  36.   path_compiler,                              (* Pfad für compilieren und crossref *)
  37.   path_link,                                  (* Pfad für linken *)
  38.   path_editor : filename_type;                (* Pfad für Editor *)
  39.   namen : ARRAY[1..5] OF STRING136;           (* Namen von Compiler,Linker, ...*)
  40.                                               (* 1 -> Compiler
  41.                                                  2 -> Linker
  42.                                                  3 -> Editor
  43.                                                  4 -> Xref Programm
  44.                                                  5 -> Pconfig
  45.                                               *)
  46.   externes_prg : ARRAY[1..5] OF STRING136;    (* Compiler,Linker, ... *)
  47.   vorhanden : ARRAY[1..5] OF BOOLEAN;
  48.   
  49. {$I TOSFUNCS.INC}
  50. {$I VDIPROCS.INC}                             (* VDI-Routinen *)
  51. {$I AESPROCS.INC}                             (* AES-Routinen *)
  52.  
  53.  
  54. PROCEDURE EXECPROG(command : STRING136;var ret:INTEGER); external;
  55.  
  56.  
  57. PROCEDURE open_v_work;                        (* GEM-Programm starten *)
  58. VAR i : INTEGER;                              (* Laufvariable *)
  59.     dummy : coord_type;
  60. BEGIN
  61.   APPL_INIT;                                  (* Applikation anmelden *)
  62.   
  63.   GRAF_HANDLE(dummy,dummy,dummy,dummy);       (* Handle feststellen *)
  64.   gem_handle := AESret;                       (* Ergebnis von graf_gem_handle holen *)
  65.   
  66.   FOR i := 0 TO 9 DO
  67.   BEGIN
  68.     work_in[i] := 1;
  69.   END;
  70.   work_in[7] := 0;
  71.   work_in[10] := 2;
  72.   V_OPNVWK(work_in,gem_handle,work_out);
  73. END;
  74.  
  75.  
  76. PROCEDURE close_v_work;                       (* GEM-Programm beenden *)
  77. VAR
  78.   dummy : INTEGER;
  79. BEGIN
  80.   V_CLSVWK(gem_handle);                       (* Bildschirm schlie₧en *)
  81.   APPL_EXIT;                                  (* Applikation ist beendet *)
  82.   dummy := SYS0(0);                           (* Warmstart *)                    
  83. END;
  84.  
  85.  
  86. (* Wandelt GEM-String in PROSPERO-String um *)
  87. PROCEDURE convert_pack_string(ein : filename_type;VAR aus:STRING136);
  88. VAR 
  89.   i : INTEGER;
  90. BEGIN
  91.   i := 1;
  92.   aus := '';
  93.   WHILE ((i <> 81) AND (ein[i] <> CHR(0))) DO
  94.   BEGIN
  95.     aus := CONCAT(aus,ein[i]);
  96.     i := i + 1;
  97.   END;
  98. END;
  99.  
  100.  
  101. (* Und jetzt umgekehrt *)
  102. PROCEDURE convert_string_pack (ein : STRING136;VAR aus : filename_type);
  103. VAR 
  104.   i : INTEGER;
  105. BEGIN
  106.   aus := leer_filename;
  107.   FOR i := 1 TO LENGTH(ein) DO
  108.     aus[i] := ein[i];
  109. END;
  110.  
  111.  
  112. PROCEDURE set_path;                           (* Initalisiert die Path-Variablen *)
  113. VAR
  114.   laufwerk : CHAR;                            (* Welches Laufwerk ist aktuelles Lw *)
  115.   zwsp : STRING136;
  116. BEGIN
  117.   laufwerk := CHR(ORD('A')+SYS0(19H));        (* Welches Lw ist aktuelles *)
  118.  
  119.   zwsp := CONCAT(laufwerk,':\*.*');
  120.   convert_string_pack(zwsp,path_rename);      (* Alle Dateiarten sind erlaubt *)
  121.   path_erase := path_rename;
  122.   path_start := path_rename;  
  123.   path_editor := path_rename;
  124.   zwsp := CONCAT(laufwerk,':\*.PAS');         (* Nur '.PAS' Dateien werden compiliert *)
  125.   convert_string_pack(zwsp,path_compiler);
  126.   zwsp := CONCAT(laufwerk,':\*.BIN');         (* Nur '.BIN' Dateien werden gelinkt *)
  127.   convert_string_pack(zwsp,path_link);
  128.   
  129. END;
  130.  
  131.  
  132. PROCEDURE lade_namen;                         (* Die Namen werden geladen *)
  133. VAR
  134.   datei : TEXT;
  135.   alert : STRING136;
  136.   i : INTEGER;
  137.   
  138. BEGIN
  139.   IF FSTAT('SHELL.CFG')
  140.   THEN BEGIN                                  (* Datei ist vorhanden *)
  141.     ASSIGN(datei,'SHELL.CFG');
  142.     RESET(datei);
  143.     i := 1;
  144.     WHILE (NOT EOF(datei) AND (i <= 5)) DO    (* Namen einlesen *)
  145.     BEGIN
  146.       READLN(datei,namen[i]);
  147.       IF namen[1][LENGTH(namen[i])] <> ' '    (* Ist letztes Zeichen Blank ? *)
  148.       THEN namen[i] := CONCAT(namen[i],' ');  (* Blank anhängen *)
  149.       
  150.       vorhanden[i] := FSTAT(namen[i]);        (* Ist diese Datei vorhanden ? *)
  151.       i := i + 1;                             (* Nächste Zeile holen *)
  152.     END;
  153.   END
  154.   ELSE BEGIN
  155.     alert := CONCAT('[3][Datei "SHELL.CFG" fehlt ! |  ][Ende]',CHR(0));
  156.     FORM_ALERT(1,alert[1]);
  157.     RSRC_FREE;                                (* Speicher des RSC-Files freigeben *)
  158.     close_v_work;                             (* GEM-Programm schlie₧en *)
  159.   END;
  160.   
  161.   externes_prg[1] := 'Compiler';              (* Namen für Fehlermeldungen *)
  162.   externes_prg[2] := 'Linker';
  163.   externes_prg[3] := 'Editor';
  164.   externes_prg[4] := 'Crossref';
  165.   externes_prg[5] := 'PCONFIG';
  166. END;
  167.  
  168.  
  169. PROCEDURE fehlende_dateien(welche:INTEGER);   (* Welches File fehlt *)
  170. VAR 
  171.   alert : STRING136;
  172. BEGIN
  173.   alert := CONCAT('[3][Achtung ! |',externes_prg[welche],' |fehlt !][Okay]',CHR(0));
  174.   FORM_ALERT(1,alert[1]);
  175. END;
  176.  
  177.   
  178. PROCEDURE lade_resource;                      (* Resource-File laden *)
  179. VAR 
  180.   file_name : filename_type;                  (* Name des RSC-File *)
  181.   alert : STRING136;                          (* String für Alert-Box *)
  182.   i : INTEGER;  
  183.   
  184. BEGIN
  185.   convert_string_pack('SHELL.RSC',file_name); (* Namen in packed Array umwandeln *)
  186.   RSRC_LOAD(file_name);                       (* RSC-File laden *)
  187.   aes_antwort := AESret;                      (* Antwort von rsrc_load *)
  188.   IF (aes_antwort = 0)                        (* Welches Ergebnis ? *)
  189.   THEN BEGIN
  190.     alert := CONCAT('[3][Achtung,da₧ RSC-File fehlt !|     Programmabruch !][ Ende ]',CHR(0));
  191.     FORM_ALERT(1,alert[1]);                   (* Alert-Box ausgeben *)
  192.     close_v_work;                             (* Programm abbrechen *)
  193.   END;
  194.   
  195.   RSRC_GADDR(0,MENUE,menue_addr);             (* Adresse des Menübaums holen *)
  196.   MENU_BAR(menue_addr,TRUE);                  (* Menüleiste sichtbar *)
  197.   RSRC_GADDR(0,UEBER,info_addr);              (* Adresse des Infobildchens *)
  198. END;
  199.  
  200.  
  201. PROCEDURE bildschirm;                         (* Desktop nach TOS-Prg. wieder aufbauen *)
  202. VAR
  203.   koordinaten : rect_type;
  204.   dummy : word;
  205. BEGIN
  206.   koordinaten.corner.x := 0;                  (* Koordinaten für v_bar *)
  207.   koordinaten.corner.y := 0;                  (*           "           *)
  208.   koordinaten.width := 639;                   (*           "           *)
  209.   koordinaten.height := 399;                  (*           "           *)
  210.   dummy := VSF_INTERIOR(gem_handle,2);        (* Fülltyp wie Desktop *)
  211.   dummy := VSF_STYLE(gem_handle,4);           (*          "          *)
  212.   dummy := VSF_PERIMETER(gem_handle,FALSE);   (* Keine Umrandung *)
  213.   GRAF_MOUSE(256,0);                          (* Mouse weg *)
  214.   V_BAR(gem_handle,koordinaten);              (* Rechteck ausgeben *)
  215.   GRAF_MOUSE(257,0);                          (* Mouse wieder her *)
  216.   MENU_BAR(menue_addr,TRUE);                  (* Menüleiste sichtbar *)
  217. END;
  218.  
  219.  
  220. (* Aufgabe der Procedure : 
  221.    Ausgeben der Fileselctorbox,
  222.    Sucht in dem mit path vorgegebenen Teil nach Dateien, path wird anschlie₧end auf den 
  223.    aktuellen Wert gesetzt
  224.    File liefert Namen der Datei mit Path
  225.    Erfolg : TRUE -> OK angeklickt
  226.             FALSE -> CANCEL angeklickt *)
  227.             
  228. PROCEDURE get_filename(VAR path : filename_type;  (* Transienter Parameter *)
  229.                        VAR erg : STRING136;   (* Ausgabeparameter *)
  230.                        VAR erfolg : BOOLEAN); (* Ausgabeparameter *)
  231. VAR
  232.   filename,zwsp,path_zwsp : filename_type;    (* Zwischenspeicher für Filenamen *)
  233.   i : INTEGER;                                (* Laufvariable *)
  234.   ende_zwsp,ende_path : INTEGER;
  235.   
  236. BEGIN
  237.   path_zwsp := path;
  238.   zwsp := leer_filename;
  239.   FSEL_INPUT(path,zwsp,erfolg);               (* Box ausgeben *)
  240.   
  241.   IF erfolg
  242.   THEN BEGIN                                  (* 'OK' angeklickt *)
  243.     i := 1;                                   (* Ende des Dateinamen suchen *)
  244.     WHILE ((i <> 81) AND (zwsp[i] <> CHR(0))) DO
  245.       i := i +  1;
  246.     ende_zwsp := i;                           (* Abspeichern *)
  247.     
  248.     i := 80;                                  (* Letztes '\' im Path suchen *)
  249.     WHILE ((i <> 0) AND (path[i] <> '\')) DO
  250.      i := i - 1;
  251.     ende_path := i;                           (* Markieren *)
  252.     
  253.     filename := path;                         (* Dateiname besteht aus Path *)
  254.     FOR i := 1 TO ende_zwsp DO
  255.       filename[ende_path+i] := zwsp[i];       (* Plus Datei *)
  256.     convert_pack_string(filename,erg);        (* In String umwandeln *)
  257.   END
  258.   ELSE BEGIN                                  (* Cancelbox angeglickt *)
  259.     path := path_zwsp;                        (* Alten Path rückspeichern *)
  260.     erg := '';                                (* Kein Ergebnis *)
  261.   END;
  262. END;
  263.  
  264.     
  265. (* ------------------------------------------------------------------------------------- *)
  266. (*                        Routinen für Menüleiste                                        *)
  267. (* ------------------------------------------------------------------------------------- *)
  268.  
  269. PROCEDURE info_zeigen;                        (* Gibt kleines Info aus *)
  270. VAR 
  271.   x,y,w,h : coord_type;                       (* Grö₧e des Bildes *)
  272.   koordinaten : rect_type;                    (* Variable für v_bar *)
  273.   dummy : word;
  274. BEGIN
  275.   FORM_CENTER(info_addr,x,y,w,h);             (* Feld für Infobild berechnen *)
  276.   FORM_DIAL(1,1,1,1,1,x,y,w,h);               (* Wachsendes Rechteck *)
  277.   
  278.   OBJC_DRAW(info_addr,0,5,0,0,x+w+1,y+h+1);   (* Feld ausgeben *)
  279.   
  280.   FORM_DO(info_addr,0);                       (* Warten bis Exitfeld angeklickt *)
  281.   
  282.   FORM_DIAL(2,1,1,1,1,x,y,w,h);               (* Schrumpfendes Rechteck *)
  283.   OBJC_CHANGE(info_addr,SCHLUSS,0,0,0,x+w,y+h,0,FALSE);
  284.                                               (* Exitfeld Normal darstellen *)
  285.   koordinaten.corner.x := x;                  (* Koordinaten für v_bar *)
  286.   koordinaten.corner.y := y;                  (*           "           *)
  287.   koordinaten.width := x+w;                   (*           "           *)
  288.   koordinaten.height := y+h;                  (*           "           *)
  289.   
  290.   dummy := VSF_INTERIOR(gem_handle,2);        (* Fülltyp wie Desktop *)
  291.   dummy := VSF_STYLE(gem_handle,4);           (*          "          *)
  292.   dummy := VSF_PERIMETER(gem_handle,FALSE);   (* Keine Umrandung *)
  293.   GRAF_MOUSE(256,0);                          (* Mouse weg *)
  294.   V_BAR(gem_handle,koordinaten);              (* Rechteck ausgeben *)
  295.   GRAF_MOUSE(257,0);                          (* Mouse wieder her *)
  296.  
  297. END;
  298.  
  299.  
  300. PROCEDURE umbenennen;                          (* Datei umbenennen *)
  301. VAR
  302.   alt,neu : STRING136;                        (* Alter und neuer Filename *)
  303.   titel,alert : STRING136;
  304.   datei : TEXT;
  305.   koordinaten : rect_type;                    (* Koordinaten für Rechteck *)
  306.   geklappt : BOOLEAN;
  307.   dummy : word;
  308. BEGIN
  309.   get_filename(path_rename,alt,geklappt);      (* Welche Datei *)
  310.   IF geklappt
  311.   THEN BEGIN
  312.     koordinaten.corner.x := 150;              (* Weises Rechteck *)
  313.     koordinaten.corner.y := 150;
  314.     koordinaten.width := 500;
  315.     koordinaten.height := 235;
  316.     dummy := VSF_INTERIOR(gem_handle,0);
  317.     dummy := VSF_STYLE(gem_handle,1);         (* Weis *)
  318.     dummy := VSF_PERIMETER(gem_handle,TRUE);  (* Umrandung *)
  319.     GRAF_MOUSE(256,0);                        (* Mouse weg *)
  320.     V_BAR(gem_handle,koordinaten);            (* Rechteck ausgeben *)
  321.     alt := CONCAT(alt,CHR(0));                (* Ende für v_gtext markieren *)
  322.     titel := CONCAT('Datei umbenennen : ',CHR(0));
  323.     dummy := VST_EFFECTS(gem_handle,8);       (* Unterstreichen an *)
  324.     V_GTEXT(gem_handle,160,170,titel[1]);
  325.     dummy := vst_effects(gem_handle,0);       (* Normale Schrift *)
  326.     V_GTEXT(gem_handle,160,200,alt[1]);
  327.     WRITELN(chr(27),'e');                     (* Cursor zeigen *)
  328.     VS_CURADDRESS(gem_handle,14,21);
  329.     READLN(neu);                              (* Neuen Namen einlesen *)
  330.     WRITELN(chr(27),'f');                     (* Cursor weg *)
  331.     GRAF_MOUSE(257,0);                        (* Mouse wieder her *)
  332.     IF (CHECKFN(neu) AND (NOT FSTAT(neu)))    (* Name korrekt und noch nicht vergeben *)
  333.     THEN BEGIN
  334.       ASSIGN(datei,alt);
  335.       RENAME(datei,neu);                      (* Datei wurde umbenannt *)
  336.     END
  337.     ELSE BEGIN
  338.       alert := CONCAT('[3][Fehler bei "R E N A M E"][Okay]',CHR(0));
  339.       FORM_ALERT(1,alert[1]);
  340.     END;
  341.     bildschirm;
  342.   END;
  343. END;
  344.     
  345.   
  346. PROCEDURE datei_loeschen;                    (* Procedure zum löschen einer Datei *)
  347. VAR 
  348.   zu_loeschen,alert : STRING136;
  349.   antwort : INTEGER;
  350.   geklappt : BOOLEAN;
  351.   datei : TEXT;
  352. BEGIN
  353.   get_filename(path_erase,zu_loeschen,geklappt);  (* Filename holen *)
  354.   IF geklappt                                 (* Es soll etwas gelöscht werden *)
  355.   THEN BEGIN
  356.     alert := CONCAT('[3][Wollen Sie die Datei |',zu_loeschen,' |wirklich löschen ? ][ Ja |Nein]',CHR(0));
  357.     FORM_ALERT(1,alert[1]);                   (* Sicherheitsabfrage ob Datei gelöscht werden soll *)
  358.     antwort := AESret;
  359.     IF antwort = 1                            (* Wirklich löschen *)
  360.     THEN BEGIN
  361.       ASSIGN(datei,zu_loeschen);              (* Wenn 'Ja' dann löschen *)
  362.       ERASE(datei);
  363.     END;
  364.   END;
  365. END;
  366.  
  367.  
  368. PROCEDURE starten;                            (* Externes Programm starten *)
  369. VAR
  370.   start_file : STRING136;
  371.   fehler : STRING136;
  372.   alert : STRING136;
  373.   geklappt : BOOLEAN;
  374.   datei : TEXT;
  375.   return_code : INTEGER;
  376. BEGIN
  377.   get_filename(path_start,start_file,geklappt);
  378.   IF geklappt
  379.   THEN BEGIN
  380.     V_CLRWK(gem_handle);                      (* Bildschirm löschen *)
  381.     V_CURHOME(gem_handle);                    (* Cursor Home *)
  382.     EXECPROG(start_file,return_code);         (* Programm starten *)
  383.     IF return_code <> 0                       (* Fehlercode *)
  384.     THEN BEGIN
  385.       STR(return_code,fehler);
  386.       alert := CONCAT('[3][Fehlercode ',fehler,' | in ',start_file,' ][ OK ]',CHR(0));
  387.       FORM_ALERT(1,alert[1]);                 (* Meldung ausgeben *)
  388.     END;
  389.     bildschirm;
  390.   END;
  391. END;
  392.     
  393.  
  394. PROCEDURE desktop;                            (* Abfrage ob Programm beendet *)
  395. VAR
  396.   alert : STRING;                             (* Für Alert-Box *)
  397.   i : INTEGER;
  398. BEGIN
  399.   alert := CONCAT('[3][Wollen Sie das Programm| |   verlassen ?][ Ja |Nein]',CHR(0));
  400.   FORM_ALERT(1,alert[1]);                     (* Alert-Box ausgeben *)
  401.   aes_antwort := AESret;                      (* Antwort der Alert-Box holen *)
  402.   
  403.   IF (aes_antwort = 1)                        (* Programm beenden wurde gewählt *)
  404.   THEN BEGIN
  405.     RSRC_FREE;                                (* Speicher des RSC-Files freigeben *)
  406.     close_v_work;                             (* GEM-Programm schlie₧en *)
  407.   END;
  408. END;
  409.  
  410.  
  411. PROCEDURE mache_programm(compilieren,         (* Flag für Compilierung *)
  412.                          linken : BOOLEAN);   (* Flag für Linken *)
  413. VAR
  414.   start_datei,befehl,alert : STRING136;
  415.   alt,neu : STRING136;
  416.   datei : TEXT;
  417.   geklappt : BOOLEAN;
  418.   return_code,zwsp : INTEGER;
  419.   i,laenge : INTEGER;
  420.   
  421. BEGIN
  422.   return_code := 0;
  423.   geklappt := TRUE;
  424.   
  425.   IF compilieren AND vorhanden[1]
  426.   THEN BEGIN                                  (* Datei compilieren *)
  427.     get_filename(path_compiler,start_datei,geklappt);
  428.     IF geklappt
  429.     THEN BEGIN
  430.       GRAF_MOUSE(256,0);                      (* Hide mouse *)
  431.       befehl := CONCAT(namen[1],start_datei);
  432.       laenge := LENGTH(befehl);
  433.       DELETE(befehl,laenge-3,4);              (* '.PAS' löschen *)
  434.       befehl := CONCAT(befehl,' .');
  435.       V_CLRWK(gem_handle);                    (* Bildschirm löschen *)
  436.       V_CURHOME(gem_handle);                  (* Cursor Home *)
  437.       EXECPROG(befehl,return_code);           (* Compiler starten *)
  438.       IF return_code <> 0                     (* Fehler aufgetreten *)
  439.       THEN BEGIN
  440.         GRAF_MOUSE(257,0);                    (* Show mouse *)
  441.         bildschirm;                           (* Bildschirm wieder herrichten *)
  442.         alert := CONCAT('[3][Fehler beim Compilieren !][Okay]',CHR(0));
  443.         FORM_ALERT(1,alert[1]);               (* Alert-Box ausgeben *)
  444.         IF vorhanden[3]
  445.         THEN BEGIN
  446.           befehl := CONCAT(namen[3],start_datei);
  447.           EXECPROG(befehl,zwsp);              (* Editor aufrufen *)
  448.         END
  449.         ELSE fehlende_dateien(3);
  450.         GRAF_MOUSE(256,0);                    (* Hide mouse *)
  451.       END;
  452.       GRAF_MOUSE(257,0);                      (* Show mouse *)
  453.       bildschirm;                             (* Bildschirm wieder herrichten *)
  454.     END;
  455.   END
  456.   ELSE BEGIN
  457.     IF compilieren AND NOT vorhanden[1]
  458.     THEN BEGIN
  459.       fehlende_dateien(1);
  460.       return_code := 127;
  461.     END;
  462.   END;
  463.                                               (* Compilerteil beendet *)
  464.  
  465.   IF (linken AND geklappt AND (return_code = 0)
  466.       AND vorhanden[2])                       (* Datei linken *)
  467.   THEN BEGIN
  468.     IF not compilieren                        (* Neue Datei linken *)
  469.     THEN BEGIN                                
  470.       get_filename(path_link,start_datei,geklappt);  (* Welche Datei denn ? *)
  471.     END;
  472.     IF geklappt
  473.     THEN BEGIN
  474.       GRAF_MOUSE(256,0);                      (* Hide mouse *)
  475.       laenge := LENGTH(start_datei);
  476.       DELETE(start_datei,laenge-3,4);         (* '.BIN' entfernen *)
  477.       
  478.       IF gemprog                              (* Bei GEM-Programmen mit PASGEM linken *)
  479.       THEN befehl := CONCAT(namen[2],start_datei,' PASGEM')
  480.       ELSE befehl := CONCAT(namen[2],start_datei,' PAS');
  481.       
  482.       IF not map                              (* Keine Linkmap *)
  483.       THEN befehl := CONCAT(befehl,' -NOLIST');
  484.       
  485.       V_CLRWK(gem_handle);                    (* Bildschirm löschen *)
  486.       V_CURHOME(gem_handle);                  (* Cursor Home *)
  487.       EXECPROG(befehl,return_code);           (* Linker starten *)
  488.       
  489.       IF return_code <> 0                     (* Fehler aufgetreten *)
  490.       THEN BEGIN
  491.         GRAF_MOUSE(257,0);                    (* Show mouse *)
  492.         befehl := CONCAT('[3][Achtung Fehler beim Linken !| ][Okay]',CHR(0));
  493.         FORM_ALERT(1,befehl[1]);
  494.         GRAF_MOUSE(256,0);                    (* Hide mouse *)
  495.       END
  496.       ELSE BEGIN
  497.         IF not gemprog                        (* Aus GEM-Prg. ein TOS-Prg. machen *)
  498.         THEN BEGIN
  499.           alt := CONCAT(start_datei,'.PRG');
  500.           neu := CONCAT(start_datei,'.TOS');  
  501.           ASSIGN(datei,alt);
  502.           RENAME(datei,neu);                  (* Umbenennen *)
  503.         END;
  504.       END;
  505.           
  506.       GRAF_MOUSE(257,0);                      (* Show mouse *)
  507.       bildschirm;
  508.     END;
  509.   END
  510.   ELSE BEGIN
  511.     IF linken AND NOT vorhanden[2]
  512.     THEN fehlende_dateien(2);
  513.   END;
  514. END;
  515.  
  516.  
  517. PROCEDURE edit;                               (* Editor aufrufen *)
  518. VAR
  519.   geklappt : BOOLEAN;
  520.   name : STRING136;
  521.   dummy : INTEGER;
  522. BEGIN
  523.   get_filename(path_editor,name,geklappt);    (* Namen holen *)
  524.   IF geklappt
  525.   THEN BEGIN
  526.     IF vorhanden[3]
  527.     THEN BEGIN
  528.       name := CONCAT(namen[3],name);          (* Editor aufrufen *)
  529.       EXECPROG(name,dummy);
  530.       bildschirm;                             (* Bildschirm restaurieren *)
  531.     END
  532.     ELSE fehlende_dateien(3);
  533.   END;
  534. END;
  535.  
  536.  
  537. PROCEDURE crossref;                           (* Crossreferenzlisting *)
  538. VAR
  539.   geklappt : BOOLEAN;
  540.   name,befehl : STRING136;
  541.   dummy : INTEGER;
  542. BEGIN
  543.   get_filename(path_compiler,name,geklappt);  (* Namen holen *)
  544.   IF geklappt
  545.   THEN BEGIN
  546.     IF vorhanden[4]
  547.     THEN BEGIN
  548.       GRAF_MOUSE(256,0);                      (* Hide Mouse *)
  549.       V_CLRWK(gem_handle);                    (* Bildschirm löschen *)
  550.       V_CURHOME(gem_handle);                  (* Cursor Home *)
  551.       ASSIGN(output,'CROSS.OUT');             (* Output nach 'CROSS.OUT' *)
  552.       REWRITE(output);
  553.       ECHO(output,TRUE);                      (* Ausgabe nach 'CROSS.OUT' und Console *)
  554.       befehl := CONCAT(namen[4],name);        (* Befehlsstring für XREF.PRG *)
  555.       EXECPROG(befehl,dummy);                 (* Programm aufrufen *)
  556.       ECHO(output,FALSE);                     (* Ausgabe nur noch nach 'output' *)
  557.       ASSIGN(output,'CON:');                  (* Ausgabe zur Konsole *)
  558.       REWRITE(output);
  559.       GRAF_MOUSE(257,0);                      (* Zeige Mouse *)
  560.       bildschirm;                             (* Bildschirm wieder herstellen *)
  561.     END
  562.     ELSE fehlende_dateien(4);
  563.   END;
  564. END;
  565.  
  566.  
  567. (* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *)
  568. (*                              Menüleiste überwachen                                   *)
  569. (* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *)
  570.                             
  571. PROCEDURE arbeiten;                           (* Auf Mouseclick warten und Aufgaben verteilen *)
  572. VAR 
  573.   msg_buf : ARRAY[0..7] OF message_buffer_type;  (* Buffer für Mouseclick *)
  574.   ok : BOOLEAN;
  575.   dummy : INTEGER;
  576. BEGIN
  577.   evnt_mesag(msg_buf[0]);                     (* Auf Mouseclick warten *)
  578.  
  579.   IF (msg_buf[0] = 10)                        (* Click in Menüleiste *)
  580.   THEN BEGIN  
  581.     CASE (msg_buf[3]) OF                      (* Was wurde gewählt ? *)
  582.       M1:  BEGIN                              (* Menüpkt 1 *)
  583.             info_zeigen;                      (* Infotext ausgeben *)
  584.           END;
  585.       
  586.       M2: BEGIN                               (* Menüpkt 2 *)
  587.             CASE (msg_buf[4]) OF              (* Weitere Unterscheidungen *)
  588.               NEU_NAME: BEGIN                 (* Datei umbenennen *)
  589.                           umbenennen;
  590.                         END;
  591.                         
  592.               LOESCHEN: BEGIN                 (* Datei löschen *)
  593.                           datei_loeschen;
  594.                         END;
  595.                         
  596.               START: BEGIN                    (* Programm starten *)
  597.                        starten;
  598.                       END;
  599.                      
  600.               EXIT : desktop;                 (* Shell verlassen *)
  601.             END;                              (* CASE msg_buf[4] *)
  602.           END;                                (* Ende von Menüpkt 2 *)
  603.   
  604.       M3: BEGIN                               (* Menüpkt 3 *)
  605.             CASE (msg_buf[4]) OF
  606.               COMPILER : BEGIN                (* Übersetzen *)
  607.                             mache_programm(TRUE,FALSE);
  608.                                               (* Datei übersetzen, aber nicht linken *)
  609.                          END;
  610.                          
  611.               LINKER : BEGIN
  612.                           mache_programm(FALSE,TRUE);
  613.                                               (* Datei linken, aber nicht übersetzen *)
  614.                        END;
  615.                        
  616.               EDITOR : BEGIN
  617.                          edit;                (* Editor aufrufen *)
  618.                        END;
  619.                        
  620.               CROSS : BEGIN
  621.                         crossref;             (* Jetzt Crossrefernzlisting *)
  622.                       END;
  623.                       
  624.               MAKE : BEGIN
  625.                        mache_programm(TRUE,TRUE);
  626.                                               (* Datei übersetzen und compilieren *)
  627.                      END;
  628.             END;                              (* CASE msg_buf[4] *)
  629.           END;                                (* Ende von Menüpkt 3 *)
  630.           
  631.       M4: BEGIN                               (* Menüpkt 4 *)
  632.             CASE (msg_buf[4]) OF
  633.               GEM_PRG : BEGIN
  634.                           gemprog := not gemprog;
  635.                           MENU_ICHECK(menue_addr,GEM_PRG,gemprog);
  636.                         END;
  637.                         
  638.               COMP_OP : BEGIN
  639.                           V_CLRWK(gem_handle);      (* Bildschirm löschen *)
  640.                           GRAF_MOUSE(256,0);
  641.                           V_ENTER_CUR(gem_handle);  (* Textmodus *)
  642.                           V_CURHOME(gem_handle);    (* Cursor Home *)
  643.                           IF vorhanden[5]
  644.                           THEN EXECPROG(namen[5],dummy)
  645.                           ELSE fehlende_dateien(5);
  646.                           V_EXIT_CUR(gem_handle);    (* Grafikmodus *)
  647.                           GRAF_MOUSE(257,0);
  648.                           bildschirm;
  649.                         END;
  650.                         
  651.               LINKMAP : BEGIN
  652.                           map := not map;
  653.                           MENU_ICHECK(menue_addr,LINKMAP,map);
  654.                         END;
  655.             END;                              (* CASE msg_buf[4] *)
  656.           END;                                (* Ende von M4 *)
  657.     END;
  658.   END;                                        
  659.   MENU_TNORMAL(menue_addr,msg_buf[3],TRUE);   (* Menüleiste normal darstellen *)
  660. END;
  661.  
  662.  
  663. (* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *)
  664. (*                                  Hauptprogramm                                       *)
  665. (* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *)
  666. BEGIN
  667.   open_v_work;                                (* Startup für GEM-Programme *)
  668.   lade_resource;                              (* Resourcefile laden,Adressen berechnen *)
  669.   GRAF_MOUSE(0,0);                            (* Mouse als Pfeil *)
  670.   set_path;                                   (* Pathvariablen initalisieren *)
  671.   lade_namen;                                 (* Namen der Programme initalisieren *)
  672.   gemprog := TRUE;                            (* Default ist GEM-Programm *)
  673.   map := FALSE;                               (* Default ist keine Linkmap *)
  674.   
  675.   FOR i := 1 TO 80 DO
  676.     leer_filename[i] := CHR(0);               (* Leerer String für GEM *)
  677.  
  678.   
  679.   WHILE(TRUE) DO                              (* Ende nur mit 'DESKTOP' *)
  680.   BEGIN
  681.     arbeiten;                                 (* Menüleiste überwachen *)
  682.   END;
  683.   
  684. END.
  685.