Celestin Apprentice 7/Apprentice-Release7.iso/Utilities/Programming/Dialog Director 0.6/Dialog Dumper/Dialog Dumper.as

Text File | 1997-04-17 | 15.0 KB | 538 lines | [TEXT/ToyS]

property dBounds : null
property dToClipboard : true
property dOutFileName : "DD.Out.as"
property dAuto : true
property dGreyscale : true
property dDoTimeout : false
property dTimeout : 10
property dDoFontName : false
property dFontName : "Chicago"
property dDoFontSize : false
property dFontSize : 12
property dDoFontStyle : false
property dFontStyle : ""
property debugDiDum : false

--open [alias "Ram:Test:Dialog Dumper.rsrc"]
open [choose file with prompt "Choose a dialog resource file:" of type "rsrc"]

on open srcFile
    global rf, fileName, thePushButtons, itemNum
    set rf to null
    CheckForOsaxen()
    if not OptionsDialog() then return
    OpenOutput()
    set srcFile to item 1 of srcFile
    set rf to res open srcFile

    try
        set AppleScript's text item delimiters to [":"]
        set fileName to last text item of (srcFile as string)
        set AppleScript's text item delimiters to ""
        set rDlogCount to res count rf type "DLOG"
        if rDlogCount = 0 then ¬
            Fail("The file “" & fileName & "” has no 'DLOG' resources!")
        PutLn("-- " & fileName)
        repeat with n from 1 to rDlogCount
            set dInfo to res get info rf type "DLOG" index n
            if length of dInfo's res name ≠ 0 then
                set dName to "d" & dInfo's res name
            else
                set dName to "dlog" & dInfo's res id
            end if
            Put1("set " & dName & " to {")

            --
            --    the dialog
            --
            set d to res get rf type "DLOG" index n
            set dlog to cast d using template "DLOG" with label
            set R to dlog's boundsrect
            if item 1 of R = 0 and item 2 of R = 0 then
                Put1("size:[" & R's item 4 & ", " & R's item 3 & "]")
            else
                Put1("bounds:" & RectToString(R))
            end if
            if dAuto and dDoTimeout then PutLn(", timeout after:" & dTimeout & " ¬")
            if length of dlog's title ≠ 0 then Put1(", name:\"" & dlog's title & "\"")
            PutWindowStyle(dlog's procid)

            --
            --    the items
            --
            set d to GetRes("DITL", dlog's items_id)
            set ditl to cast d using template "DITL" with label
            PutLn(", contents:[ ¬")
            set thePushButtons to []
            set itemNum to 0
            set i to 1
            repeat
                set i to PutDialogItem(ditl, i)
                if i ≤ length of ditl then
                    PutLn("}, ¬")
                else
                    PutLn("} ¬")
                    exit repeat
                end if
            end repeat
            PutLn("    ] ¬")

            --
            --    the function calls
            --
            PutLn("}" & return)
            if dAuto then
                Put1("dd auto dialog " & dName)
            else
                Put1("dd install")
            end if
            if dDoFontName or dDoFontSize or dDoFontStyle then
                Put1(" font {")
                if dDoFontName then Put1("name:\"" & dFontName & "\"")
                if dDoFontSize then
                    if dDoFontName then Put1(", ")
                    Put1("size:" & dFontSize)
                end if
                if dDoFontStyle then
                    if dDoFontName or dDoFontSize then Put1(", ")
                    Put1("style:" & dFontStyle)
                end if
                Put1("}")
            end if
            if dGreyscale then Put1(" with greyscale")
            Put1(return)
            if not dAuto then
                PutLn("set d1 to dd make dialog " & dName)
                PutLn("repeat")
                PutLn("    set dItem to dd interact with user")
                if length of thePushButtons = 0 then
                    PutLn("    if dItem ≠ null then exit")
                else
                    set s to "dItem = " & item 1 of thePushButtons
                    if length of thePushButtons > 1 then
                        repeat with i from 2 to length of thePushButtons
                            set s to s & " or dItem = " & item i of thePushButtons
                        end repeat
                    end if
                    PutLn("    if " & s & " then exit")
                end if
                PutLn("end")
                PutLn("dd uninstall")
            end if
            PutLn(return)
            --exit repeat -- *** Debugging ***
        end repeat
    on error errText number errNum from offendingObject partial result resultList to expectedType
        if debugDiDum then -- Propergate errors when debugging
            res close rf
            CloseOutput()
            error errText number errNum from offendingObject partial result resultList to expectedType
        else
            Fail("Error number " & errNum)
        end if
    end try

    res close rf
    CloseOutput()
end open


--
--    Functions to output the dialog item descriptions
--

on PutClassAndBounds(t, d)
    Put1("        {class:" & t & ", bounds:" & RectToString(d's display_rect))
end PutClassAndBounds

on PutCntlClassAndBounds(t, d, c)
    set R to d's display_rect
    set y to R's item 1
    set x to R's item 2
    set R to c's boundsrect
    set h to (R's item 3) - (R's item 1)
    set w to (R's item 4) - (R's item 2)
    Put1("        {class:" & t & ", bounds:[" & x & ", " & y & ", " & x + w & ", " & y + h & "]")
end PutCntlClassAndBounds

on PutCheckbox(d)
    PutClassAndBounds("check box", d)
    Put1(", name:\"" & d's item_info & "\"")
end PutCheckbox

on PutPushButton(d)
    PutClassAndBounds("push button", d)
    Put1(", name:\"" & d's item_info & "\"")
end PutPushButton

on PutRadioButton(ditl, i) -- Merges adjacent radio buttons into a single radio group
    set d to item i of ditl
    set r0 to d's display_rect
    set x0 to item 2 of r0
    set y0 to item 1 of r0
    set w to (item 4 of r0) - x0
    set dx to 0
    set dy to 0
    set maxDown to ""
    set n to "\"" & d's item_info & "\""
    set i0 to i
    repeat while i < length of ditl
        set d to item (i + 1) of ditl
        if (d's item_type) mod 128 ≠ 6 then exit repeat
        set R to d's display_rect
        set x to item 2 of R
        set y to item 1 of R
        if (x - x0) ≠ 0 then
            if dx = 0 and dy ≠ 0 then set maxDown to ", max down:" & 1 + i - i0
            set dx to x - x0
        end if
        set dy to y - y0
        set n to n & ", \"" & d's item_info & "\""
        set x0 to x
        set y0 to y
        if w < (item 4 of R) - x then ¬
            set w to (item 4 of R) - x
        set i to i + 1
    end repeat
    set item 4 of r0 to (item 2 of r0) + w
    PutClassAndBounds("radio group", {display_rect:r0})
    Put1(", button offset:[" & dx & ", " & dy & "]" & maxDown & ", contents:[" & n & "]")
    return i + 1
end PutRadioButton

on PutPopUp(c, cntl, varCode)
    set n to c's refcon
    if length of c's title ≠ 0 then
        Put1(", name:\"" & c's title & "\"")
        if c's max ≠ 0 then ¬
            Put1(", name width:" & c's max)
    else if n ≠ 0 and varCode mod 8 < 4 then --        * Type-In field *
        Put1(", text field:" & n)
    end if
    if c's |value| ≠ 0 then ¬
        Put1(", value:" & c's |value|)

    if n ≠ 0 and varCode mod 8 ≥ 4 then --            * Resource list Pop-Up *
        Put1(", contents:\"" & (cast cntl from 19 length 4 to string) & "\"")
    else
        set mu to GetRes("MENU", c's min)
        set m to cast mu using template "MENU" with label
        set s to ""
        repeat with i in m's |menu items|
            if s = "" then
                set s to "\"" & i's menuitem & "\""
            else
                set s to s & ", \"" & i's menuitem & "\""
            end if
        end repeat
        Put1(", contents:[" & s & "]")
    end if
end PutPopUp

on PutControl(d)
    set cntl to GetRes("CNTL", ItemInfoToNum(d))
    set c to cast cntl using template "CNTL" with label
    set procid to (c's procid)
    set cType to procid div 16
    if cType = 25 or cType = 63 then --                *** Pop-Up ***
        PutCntlClassAndBounds("pop up", d, c)
        PutPopUp(c, cntl, procid mod 16)
        --set cntl to [c, m]
    else if cType = 22 then --                        *** List Box ***
        PutCntlClassAndBounds("list box", d, c)
        if c's |value| ≠ 0 then ¬
            Put1(", value:" & c's |value|)
        Put1(", contents:[" & "\"•••\"" & "]")
    else if cType = 5 then --                          *** Gauge ***
        PutCntlClassAndBounds("gauge", d, c)
        if c's |value| ≠ 0 then ¬
            Put1(", value:" & c's |value|)
        Put1(", max value:" & (c's max) - (c's min))
    else if cType = 10 then --                        *** Group Box ***
        if length of c's title ≠ 0 then -- Adjust bounds
            tell d's display_rect to set item 1 to (item 1) + 11
            tell c's boundsrect to set item 3 to (item 3) - 11
        end if
        PutCntlClassAndBounds("group box", d, c)
        if length of c's title ≠ 0 then ¬
            Put1(", name:\" " & c's title & " \"")
        if procid ≥ 164 then ¬
            Put1(", style:secondary group")
    else
        PutUnknown(d)
    end if
end PutControl

on PutTextField(d)
    PutClassAndBounds("text field", d)
    if length of d's item_info ≠ 0 then ¬
        Put1(", value:\"" & d's item_info & "\"")
end PutTextField

on PutStaticText(d)
    PutClassAndBounds("static text", d)
    Put1(", contents:\"" & d's item_info & "\"")
end PutStaticText

on PutIcon(d)
    PutClassAndBounds("icon", d)
    Put1(", contents:" & ItemInfoToNum(d))
end PutIcon

on PutPict(d)
    PutClassAndBounds("pict", d)
    Put1(", contents:" & ItemInfoToNum(d))
end PutPict

on PutUnknown(d)
    PutClassAndBounds("UNKNOWN_" & d's item_type, d)
    Put1(", name:\"" & d's item_info & "\"")
end PutUnknown

on PutDialogItem(ditl, i)
    global thePushButtons, itemNum
    set itemNum to itemNum + 1
    --PutLn("Item: " & i)
    set d to item i of ditl
    set c to (d's item_type) mod 128
    --if c <4 then set c to c +4
    if c = 0 then -- User item
        PutClassAndBounds("group box", d) --PutGroupBox(d)
    else if c = 4 then
        set thePushButtons to thePushButtons & itemNum
        PutPushButton(d)
    else if c = 5 then
        PutCheckbox(d)
    else if c = 6 then
        return PutRadioButton(ditl, i)
    else if c = 7 then
        PutControl(d)
    else if c = 8 then
        PutStaticText(d)
    else if c = 16 then
        PutTextField(d)
    else if c = 32 then
        PutIcon(d)
    else if c = 64 then
        PutPict(d)
    else
        PutUnknown(d)
    end if
    return i + 1
end PutDialogItem


--
--    Functions to convert the resource data
--

property winIDs : [0, "1", 2, 3, 4, 5, 8, 12, 16, 1985, 1987, 1989, 1991, 1993, 1995, 1997, 1999]
property winStyles : ["document window", "modal", "plain dialog", ¬
    "plain dialog", "document window", "movable modal", "document window", ¬
    "document window", "document window", "palette", "palette", "palette", "palette", ¬
    "sideways palette", "sideways palette", "sideways palette", "sideways palette"]

on PutWindowStyle(n)
    repeat with i from 1 to length of winIDs
        if n = item i of winIDs then
            Put1(", style:" & item i of winStyles)
            exit repeat
        end if
    end repeat
end PutWindowStyle

on RectToString(R)
    tell R to return "[" & item 2 & ", " & item 1 & ", " & item 4 & ", " & item 3 & "]"
end RectToString

on ItemInfoToNum(d)
    set n to d's item_info & "??"
    return (ASCII number n) * 256 + (ASCII number character 2 of n)
end ItemInfoToNum

on GetRes(rType, rID)
    global rf
    try
        return res get rf type rType id rID
    on error
        MissingRes(rType, rID)
    end try
end GetRes


--
--    The user interface
--

on OptionsDialog()
    if dBounds = null then set dBounds to dd calc dialog bounds [320, 294]
    if dAuto then
        set dMode to 1
    else
        set dMode to 2
    end if
    set dDDumper to {bounds:dBounds, style:movable modal, name:"Dialog Dumper", contents:[¬
        {class:push button, bounds:[10, 263, 100, 283], name:"To Clipboard"}, ¬
        {class:push button, bounds:[220, 263, 310, 283], name:"Cancel"}, ¬
        {class:push button, bounds:[115, 263, 205, 283], name:"To File…"}, ¬
        {class:group box, bounds:[10, 15, 310, 94], name:" Options "}, ¬
        {class:radio group, bounds:[66, 23, 126, 41], button offset:[70, 0], contents:["Auto", "Live"], value:dMode}, ¬
        {class:check box, bounds:[16, 43, 156, 61], name:"Greyscale", value:dGreyscale}, ¬
        {class:check box, bounds:[16, 63, 126, 81], name:"Timeout after", value:dDoTimeout, enabled:261}, ¬
        {class:text field, bounds:[132, 64, 172, 80], value:dTimeout, enabled:[dAnd, 7, 261]}, ¬
        {class:static text, bounds:[177, 64, 217, 80], contents:"secs"}, ¬
        {class:check box, bounds:[16, 126, 70, 144], name:"Font:", value:dDoFontName}, ¬
        {class:pop up, bounds:[72, 126, 282, 146], contents:"FONT", value:dFontName, enabled:10}, ¬
        {class:check box, bounds:[16, 152, 70, 170], name:"Size:", value:dDoFontSize}, ¬
        {class:text field, bounds:[75, 153, 115, 169], value:dFontSize, enabled:12}, ¬
        {class:pop up, bounds:[120, 152, 144, 172], text field:13, contents:["9;10;12;14;18;24;2;36"], enabled:12}, ¬
        {class:group box, bounds:[150, 159, 278, 244], name:"         ", style:secondary group}, ¬
        {class:check box, bounds:[160, 150, 240, 168], name:"Style", value:dDoFontStyle}, ¬
        {class:check box, bounds:[172, 168, 268, 186], name:"Bold", value:IsStyle("bold"), enabled:16}, ¬
        {class:check box, bounds:[172, 186, 268, 204], name:"Italic", value:IsStyle("italic"), enabled:16}, ¬
        {class:check box, bounds:[172, 204, 268, 222], name:"Underline", value:IsStyle("underline"), enabled:16}, ¬
        {class:check box, bounds:[172, 222, 268, 240], name:"Outline", value:IsStyle("outline"), enabled:16}, ¬
        {class:icon, bounds:[270, 22, 302, 54], contents:200}, ¬
        {class:static text, bounds:[16, 24, 66, 40], contents:"Mode:"}, ¬
        {class:group box, bounds:[10, 115, 310, 252], name:" Default Font "} ¬
            ] ¬
        }

    set dVals to dd auto dialog dDDumper with greyscale
    tell dVals
        if item 2 then return false
        set dBounds to last item
        set dToClipboard to item 1
        set dAuto to item 5 = 1
        set dGreyscale to item 6
        set dDoTimeout to item 7
        set dTimeout to item 8 as integer
        set dDoFontName to item 10
        set dFontName to item 11
        set dDoFontSize to item 12
        set dFontSize to item 13 as integer
        set dDoFontStyle to item 16
        set s to ""
        if item 17 then set s to ", bold"
        if item 18 then set s to s & ", italic"
        if item 19 then set s to s & ", underline"
        if item 20 then set s to s & ", outline"
        if length of s = 0 then
            set s to "plain"
        else
            set s to text 3 thru (length of s) of s
            if s contains "," then set s to "[" & s & "]"
        end if
        set dFontStyle to s
    end tell
    return true
end OptionsDialog

on IsStyle(s)
    return dFontStyle contains s
end IsStyle

--
--    Functions to manage the script output
--

on OpenOutput()
    global gBuf
    set gBuf to ""
end OpenOutput

on CloseOutput()
    global gBuf, gHasSF
    --tell application "Transcript" to «event miscEcho» gBuf
    if dToClipboard then -- Check the result from the options dialog
        activate
        set the clipboard to gBuf -- From Jon's Commands
    else
        set outFile to new file with prompt "Save script as:" default name dOutFileName
        set f to open for access outFile with write permission
        try
            set eof f to 0
            write gBuf to f
            if gHasSF then ¬
                tell application "Finder" to set creator type of outFile to "ToyS"
            set AppleScript's text item delimiters to [":"]
            set dOutFileName to last text item of (outFile as string)
            set AppleScript's text item delimiters to ""
        on error
            close access f
            error
        end try
        close access f
    end if
end CloseOutput

on Put1(s)
    global gBuf
    set gBuf to gBuf & s
end Put1

on PutLn(s)
    global gBuf
    set gBuf to gBuf & (s as string) & return
end PutLn


-- ---> osaxen checkers and error handling --->

on CheckForOsaxen()
    global gHasSF
    try -- Scriptable Finder
        with timeout of 3 seconds
            tell application "Finder" to exists
        end timeout
        set gHasSF to true
    on error
        set gHasSF to false
    end try

    try -- Programmer’s Tool
        alias ((path to extensions folder as string) & "Scripting Additions:programmer's tool")
        cast 9 to string -- Could be in there, but no compile or restart done!
    on error
        MissingOsax("Programmer's Tool")
    end try

    try -- Jon’s Commands
        clipboard info for "DiDi"
    on error
        MissingOsax("Jon’s Commands")
    end try

    try -- Resource Utilities
        res unique id 0 type "ICON"
    on error
        MissingOsax("Resource Utilities")
    end try

    try -- Dialog Director
        dd count dialogs
    on error
        MissingOsax("Dialog Director v0.6")
    end try
end CheckForOsaxen

on MissingRes(rType, rID)
    global fileName
    Fail("The file “" & fileName & "” is missing the '" & rType & "' resource ID " & rID & ".")
end MissingRes

on MissingOsax(n)
    Fail("The “" & n & "” Scripting Addition is not installed on this computer.

Dialog Dumper requires this file to be able to run.")
end MissingOsax

on Fail(msg)
    global rf
    if rf ≠ null then res close rf
    beep
    display dialog msg buttons "Quit" default button 1
    quit
end Fail

-- <--- osaxen checkers and error handling <---