-> ShellScr v1.6 by Kyzer/CSG -> Creates a fullscreen shell with it's own public screen -> $VER: ShellScr.e 1.6 (15.09.99) OPT PREPROCESS,OSVERSION=37 MODULE 'asl', 'diskfont', 'dos/dos', 'dos/dosextens', 'dos/dostags', 'exec/lists', 'exec/nodes', 'graphics/displayinfo', 'graphics/modeid', 'graphics/text', 'intuition/intuition', 'intuition/screens', 'libraries/asl', 'locale', 'utility/tagitem', 'workbench/startup', '*args', '*clr', '*defarg', '*locale', '*paths' DEF aslbase=NIL -> make shortcut to getting locale strings #define c(x) get_str(catalog, x) #define DEF_CONSPEC \ 'CON:\s//BACKDROP/NOBORDER/NOSIZE/NODRAG/NODEPTH/NOCLOSE/SCREEN\s' #define DEF_CONSPEC_LEN 71 #define TEMPLATE \ 'PUBNAME=NAME,MODEID=ID,DEPTH/N,FONT/K,AUTOSCROLL/S,'+\ 'SHANGHAI/S,SCREENTITLE=TITLE,NOTITLE=HIDETITLE/S,'+\ 'CONSPEC=WINDOW,COMMANDFILE=FROM,STACKSIZE=STACK/N' OBJECT myargs pubname -> chosen public screen name or NIL modeid -> string referencing mode-id or NIL depth -> ptr to LONG number or NIL: depth of screen font -> ptr to font description ('fontname/size') or NIL autoscroll -> boolean, true (default) = AUTOSCROLL screen shanghai -> boolean, true = SHANGHAI mode enabled title -> string: name of titlebar or NIL notitle -> boolean, zero = show titlebar, non-zero = hide titlebar conspec -> WINDOW parameter of NewShell cmdfile -> FROM parameter of NewShell stacksize -> ptr to LONG number or NIL: size of stack ENDOBJECT DEF args:myargs, sig=-1, pubname[32]:STRING, catalog=NIL RAISE "MEM" IF String()=NIL RAISE "SYS" IF SystemTagList()<>0 RAISE "def" IF LockPubScreen()=NIL RAISE "sig" IF AllocSignal()=-1 ->----------------------------------------------------------------------------- PROC main() HANDLE DEF wbmsg:PTR TO wbstartup, rdargs=NIL, olddir, dir=NIL, screen=NIL, command, depth=2, stack -> choose reasonable start directory when launched from Workbench IF wbmsg := wbmessage IF dir := DupLock( IF wbmsg.numargs > 1 THEN wbmsg.arglist[1].lock ELSE GetProgramDir() ) THEN olddir := CurrentDir(dir) ENDIF -> initialise localization IF localebase := OpenLibrary('locale.library', 38) catalog := OpenCatalogA(NIL, 'shellscr.catalog', NIL) ENDIF -> initialise argarray clr(args, SIZEOF myargs) args.pubname := StringF(pubname, c(MSG_DEF_PUBNAME), FindTask(NIL)) args.depth := {depth} -> read arguments with fabulous wb-friendly readargs() IF (rdargs := readargs(TEMPLATE, args, wbmsg)) = NIL THEN Raise("args") -> open the screen, and construct the required arguments command := makecmd(screen := openscr()) -> run the NewShell command to open a new command. stack := Max(1600, IF args.stacksize THEN Long(args.stacksize) ELSE 4096) SystemTagList(command, NEW [ NP_PATH, getpath(), NP_STACKSIZE, stack + 3 AND -4, SYS_USERSHELL, TRUE, SYS_ASYNCH, FALSE, TAG_DONE ]) REPEAT Wait(Shl(1, sig) OR SIGBREAKF_CTRL_C) UNTIL CloseScreen(screen) screen := NIL EXCEPT DO -> Errors that deserve an error message to the user are processed here SELECT exception -> couldn't allocate memory for strings or such CASE "MEM"; msg(error(ERROR_NO_FREE_STORE)) -> System() failed CASE "SYS"; msg(error(0, c(MSG_NEWSHELL_FAILED))) -> ReadArgs() failed CASE "args"; msg(error(0, c(MSG_BAD_ARGS))) -> LockPubScreen() failed CASE "def"; msg(c(MSG_NO_DEF_SCREEN)) -> OpenScreen() failed CASE "scr"; exceptioninfo := c(IF (exceptioninfo < 0) OR (exceptioninfo > 7) THEN MSG_UNKNOWN_ERROR ELSE MSG_SCREENERROR + exceptioninfo) msg(c(MSG_SCREEN_ERROR), {exceptioninfo}) ENDSELECT -> cleanup IF screen REPEAT; UNTIL CloseScreen(screen) SetDefaultPubScreen(NIL) ENDIF IF dir THEN UnLock(CurrentDir(olddir)) IF rdargs THEN FreeArgs(rdargs) IF sig <> -1 THEN FreeSignal(sig) IF localebase THEN CloseCatalog(catalog) CloseLibrary(localebase) ENDPROC (IF exception THEN 10 ELSE 0) ->----------------------------------------------------------------------------- PROC makecmd(s:PTR TO screen) -> create the 'NewShell' command required to open the shell DEF cmd, cmdformat, sizes, top -> window-size calculation (see guide) top := IF args.notitle THEN 0 ELSE IF args.conspec THEN s.barheight+1 ELSE 3 sizes := StringF(String(24), '\d/\d/\d/\d', 0, top, s.width, s.height-top) -> generate command formatter : 'NewShell [conspec] [FROM cmdfile]' -> conspec contains two '%s' ('\s') formatters for windowsize and screenname cmdformat := StringF( String( 9 + (IF args.conspec THEN StrLen(args.conspec) ELSE DEF_CONSPEC_LEN) + (IF args.cmdfile THEN StrLen(args.cmdfile)+6 ELSE 0) ), 'NewShell \s\s\s', defarg(args.conspec, DEF_CONSPEC), IF args.cmdfile THEN ' FROM ' ELSE '', defarg(args.cmdfile, '') ) -> create final command from format template cmd := StringF( String(EstrLen(cmdformat) + EstrLen(sizes) + StrLen(args.pubname)), cmdformat, sizes, args.pubname ) ENDPROC cmd ->----------------------------------------------------------------------------- PROC openscr() HANDLE -> opens the screen as requested by the user DEF screen=NIL:PTR TO screen, defscreen=NIL:PTR TO screen, drawinfo=NIL:PTR TO drawinfo, errorcode, fontdesc, font -> Find a default screen to read default information about drawinfo := GetScreenDrawInfo(defscreen := LockPubScreen(NIL)) -> get the required font - or copy the default screen's fontdesc, font := openfont(defscreen.font) screen := OpenScreenTagList(NIL, NEW [ SA_ERRORCODE, {errorcode}, -> tags defining the public nature of our screen SA_PUBNAME, args.pubname, SA_PUBSIG, sig := AllocSignal(-1), SA_PUBTASK, FindTask(NIL), SA_TYPE, PUBLICSCREEN, SA_DISPLAYID, getmode(args.modeid, GetVPModeID(defscreen.viewport)), SA_DEPTH, Long(args.depth), SA_FONT, fontdesc, SA_AUTOSCROLL, args.autoscroll, SA_TITLE, defarg(args.title, c(MSG_DEF_TITLE)), SA_SHOWTITLE, (args.notitle = FALSE), SA_PENS, IF drawinfo THEN drawinfo.pens ELSE [-1]:INT, SA_FULLPALETTE, TRUE, TAG_DONE ]) IF screen = NIL THEN Throw("scr", errorcode) -> make screen go public, also make it the default pubscreen PubScreenStatus(screen, PUBLICSCREEN) SetDefaultPubScreen(args.pubname) -> enable Shanghai mode if user wants this IF args.shanghai THEN SetPubScreenModes(SHANGHAI OR SetPubScreenModes(0)) EXCEPT DO IF font THEN CloseFont(font) IF drawinfo THEN FreeScreenDrawInfo(defscreen, drawinfo) IF defscreen THEN UnlockPubScreen(NIL, defscreen) CloseLibrary(diskfontbase) CloseLibrary(aslbase) ReThrow() ENDPROC screen ->---- PROC openfont(deffont:PTR TO textattr) DEF fontdesc=NIL:PTR TO textattr, font=NIL:PTR TO textfont, name, size -> find out the real name/size of our requested (or not) font name, size := getfont(args.font) -> if a certain font has been decided, then open it from disk IF name IF diskfontbase := OpenLibrary('diskfont.library', 37) IF font := OpenDiskFont(fontdesc := NEW [name, size, 0, 0]:textattr) -> tsssk the user if he picked a proportional font IF font.flags AND FPF_PROPORTIONAL THEN msg(c(MSG_PROPFONT), fontdesc) ENDIF ENDIF ELSE -> only copy default font if it is fixed-width IF (deffont.flags AND FPF_PROPORTIONAL)=0 CopyMem(deffont, NEW fontdesc, SIZEOF textattr) fontdesc.name := StrCopy(String(StrLen(fontdesc.name)), fontdesc.name) ENDIF ENDIF ENDPROC fontdesc, font ->---- PROC getfont(fontname) -> process font-string (eg 'topaz/11', 'lcd.10', 'flyspeck', '?') and return -> proper name and size ('topaz.font',11, 'lcd.font',10 ...) DEF font=NIL, size=8, req:PTR TO fontrequester, valid, n IF fontname = NIL THEN RETURN NIL -> ASL font requester if fontname="?" or fontname="" IF (StrCmp(fontname, '?') OR StrCmp(fontname, '')) IF openasl() IF req := AllocAslRequest(ASL_FONTREQUEST, NIL) IF AslRequest(req, [ASLFO_FIXEDWIDTHONLY, TRUE, TAG_DONE]) font := StrCopy(String(StrLen(req.attr.name)), req.attr.name) size := req.attr.ysize ENDIF FreeAslRequest(req) ENDIF ENDIF ELSE -> copy fontname so we can (perhaps) modify it StrCopy(font := String(StrLen(fontname)+5), fontname) -> look for and remove size from string -> (in 'myfont/99' or 'myfont.99' format) IF (n := InStr(font, '/')) = -1 THEN n := InStr(font, '.') IF n <> -1 -> get size from string (or 8 as default) size, valid := Val(font+n+1) IF valid = FALSE THEN size := 8 -> remove size part from string font[n] := "\0" -> can we guarantee SetStr() to do this? SetStr(font, n) ENDIF -> add '.font' to name if neccessary IF InStr(font, '.font') = -1 THEN StrAdd(font, '.font') ENDIF ENDPROC font, size ->---- PROC getmode(modename, defmode) -> process string with some form of mode name in it, and return a numeric ID -> string can take the form of: -> '' or '?' (cause user choice from ASL screenmode requester) -> 'PAL:High Res' (named graphic mode) -> '12345678' (decimal for compatibility with ShellScr 1.2 and previous -> '0x29000' (hexadecimal spec with C-style number) -> '$29000' (hexadecimal spec with asm-style number) -> if parsing fails, it returns the default mode supplied DEF modeid, req:PTR TO screenmoderequester, ok, valid, dh, ni:nameinfo IF modename = NIL THEN RETURN defmode -> ASL screenmode requester when modename='?' or '' IF (StrCmp(modename, '?') OR StrCmp(modename, '')) IF openasl() IF req := AllocAslRequest(ASL_SCREENMODEREQUEST, NIL) ok := AslRequest(req, NEW [ ASLSM_DOAUTOSCROLL, TRUE, ASLSM_DODEPTH, TRUE, ASLSM_INITIALAUTOSCROLL, args.autoscroll, ASLSM_INITIALDISPLAYDEPTH, Long(args.depth), ASLSM_INITIALDISPLAYID, defmode, TAG_DONE ]) FreeAslRequest(req) IF ok = FALSE THEN Raise("canc") -> 'cancelled requester' exception PutLong(args.depth, req.displaydepth) args.autoscroll := req.autoscroll modeid := req.displayid msg(c(MSG_MODEID), {modeid}) RETURN modeid ENDIF ENDIF ENDIF -> compare modename against all named screenmodes in the display database modeid := INVALID_ID WHILE (modeid := NextDisplayInfo(modeid)) <> INVALID_ID IF (modeid AND MONITOR_ID_MASK) dh := FindDisplayInfo(modeid) IF GetDisplayInfoData(dh, ni, SIZEOF nameinfo, DTAG_NAME, INVALID_ID) IF StrCmp(modename, ni.name) THEN RETURN modeid ENDIF ENDIF ENDWHILE -> otherwise - a numeric ID. -> change '0xB1AB1A' into '$B1AB1A' IF StrCmp(modename, '0x', 2); INC modename; modename[] := "$"; ENDIF -> find the value of the ID. modeid, valid := Val(modename) ENDPROC IF valid THEN modeid ELSE defmode ->----------------------------------------------------------------------------- -> handy little things... -> message-printer for WB and shell PROC msg(msg, args=NIL) IF wbmessage EasyRequestArgs(NIL, NEW [20, 0, 'ShellScr', msg, c(MSG_OK)], 0, args) ELSE Vprintf(msg, args); PutStr('\n') ENDIF ENDPROC -> returns string form of DOS Fault. Can prepend header. PROC error(error=0, header=NIL) DEF x SetStr(x := String((IF header THEN StrLen(header) ELSE 0) + FAULT_MAX + 2), Fault(defarg(error, IoErr()), header, x, StrMax(x)) ) ENDPROC x -> open asl.library only once PROC openasl() IS defarg(aslbase, aslbase := OpenLibrary('asl.library', 38)) CHAR '$VER: ShellScr 1.6 (15.09.99)'