home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 2 / goldfish_vol2_cd1.bin / files / dev / obero / oberon-a / source / amigautil / wbconsole.mod < prev   
Text File  |  1994-09-03  |  3KB  |  117 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: WbConsole.mod $
  4.   Description: Module to open a console window for programs run from the
  5.                Workbench. Ensures that the program has a standard IO
  6.                environment, with valid Input() and Output() filehandles.
  7.  
  8.    Created by: fjc (Frank Copeland)
  9.     $Revision: 3.2 $
  10.       $Author: fjc $
  11.         $Date: 1994/09/03 16:12:04 $
  12.  
  13.   Copyright © 1994, Frank Copeland.
  14.   This file is part of the Oberon-A Library.
  15.   See Oberon-A.doc for conditions of use and distribution.
  16.  
  17. *************************************************************************)
  18.  
  19. MODULE WbConsole;
  20.  
  21. (*
  22. ** $C= CaseChk       $I= IndexChk  $L= LongAdr   $N- NilChk
  23. ** $P- PortableCode  $R= RangeChk  $S= StackChk  $T= TypeChk
  24. ** $V= OvflChk       $Z= ZeroVars
  25. *)
  26.  
  27. IMPORT
  28.   SYS := SYSTEM,
  29.   Kernel,
  30.   e   := Exec,
  31.   d   := Dos,
  32.   wb  := Workbench,
  33.   i   := Icon;
  34.  
  35. CONST
  36.   DefWbConsole = "CON:40/12/480/150/Oberon-A Console Window";
  37.   maxD = 9;
  38.  
  39. VAR
  40.   wbConsole  : d.FileHandlePtr;
  41.  
  42. (*------------------------------------*)
  43. PROCEDURE* CloseWbConsole (VAR rc : LONGINT);
  44.  
  45. BEGIN (* CloseWbConsole *)
  46.   IF wbConsole # NIL THEN d.base.OldClose (wbConsole) END
  47. END CloseWbConsole;
  48.  
  49. (*------------------------------------*)
  50. PROCEDURE SetupWbConsole ();
  51.  
  52.   VAR
  53.     oldDir    : d.FileLockPtr;
  54.     oldFH     : d.FileHandlePtr;
  55.     console   : e.STRPTR;
  56.     diskObj   : wb.DiskObjectPtr;
  57.     toolTypes : wb.ToolTypePtr;
  58.     process   : d.ProcessPtr;
  59.     conTask   : e.MsgPortPtr;
  60.     wbMsg     : wb.WBStartupPtr;
  61.  
  62. BEGIN (* SetupWbConsole *)
  63.   (* Try to open icon.library *)
  64.   i.OpenLib (FALSE);
  65.  
  66.   IF i.base # NIL THEN (* Check for a WINDOW= tooltype *)
  67.     wbMsg := Kernel.WBenchMsg;
  68.     (* First CD to the app's directory *)
  69.     oldDir := d.base.CurrentDir (wbMsg.argList [0].lock);
  70.     (* Attempt to load the app's icon *)
  71.     diskObj := i.base.GetDiskObject (wbMsg.argList [0].name^);
  72.     IF diskObj # NIL THEN
  73.       console := i.base.FindToolType (diskObj.toolTypes, "WINDOW");
  74.       (* We will free diskObj AFTER we have finished with console. *)
  75.     END;
  76.     (* Back to where we started *)
  77.     oldDir := d.base.CurrentDir (oldDir);
  78.   ELSE
  79.     diskObj := NIL; console := NIL
  80.   END;
  81.  
  82.   (* Open the console window *)
  83.   IF console = NIL THEN console := SYS.ADR (DefWbConsole) END;
  84.   wbConsole := d.base.Open (console^, d.modeNewFile);
  85.   IF diskObj # NIL THEN i.base.FreeDiskObject (diskObj) END;
  86.   ASSERT (wbConsole # NIL);
  87.  
  88.   (* Set the console task and the Input/Output handles. *)
  89.   IF d.base.version >= 37 THEN
  90.     oldFH := d.base.SelectInput (wbConsole);
  91.     IF oldFH # NIL THEN d.base.OldClose (oldFH) END;
  92.     oldFH := d.base.SelectOutput (wbConsole);
  93.     IF oldFH # NIL THEN d.base.OldClose (oldFH) END;
  94.     conTask := wbConsole.type;
  95.     IF conTask # NIL THEN
  96.       conTask := d.base.SetConsoleTask (conTask)
  97.       (* I assume the old one can be ignored. The autodocs are silent
  98.       ** about this.
  99.       *)
  100.     END;
  101.   ELSE
  102.     (* This is from Commodore's startup.asm, for <V37 dos.library. *)
  103.     process := SYS.VAL (d.ProcessPtr, e.base.FindTask (NIL));
  104.     process.cis := wbConsole;
  105.     process.cos := wbConsole;
  106.     conTask := wbConsole.type;
  107.     IF conTask # NIL THEN process.consoleTask := conTask END;
  108.   END;
  109.  
  110.   Kernel.SetCleanup (CloseWbConsole);
  111. END SetupWbConsole;
  112.  
  113. BEGIN (* WbConsole *)
  114.   wbConsole := NIL;
  115.   IF Kernel.fromWorkbench THEN SetupWbConsole () END
  116. END WbConsole.
  117.