One of the benefits of learning to program is learning how to automate tasks performed with a computer. I thought it might be fun to build a simple vocabulary to allow getting and setting of the desktop background picture. Since Factor makes it pretty easy to build cross-platform vocabularies, we will implement this on Mac OS X, Linux, and Windows.
Our API consists of two words, one that gets the current desktop picture and one that sets a new desktop picture, dispatching based on which operating system we are running on (technically, based on the value of the os variable).
HOOK: get-desktop-picture os ( -- path ) HOOK: set-desktop-picture os ( path -- )
Mac OS X
On Mac OS X, we use AppleScript to ask the Finder what the path to the current desktop picture is, or tell it to set the desktop picture to a specific path.
M: macosx get-desktop-picture { "osascript" "-e" "tell app \"Finder\" to get posix path of (get desktop picture as alias)" } utf8 [ readln ] with-process-reader ; M: macosx set-desktop-picture absolute-path "tell application \"Finder\" to set desktop picture to POSIX file \"%s\"" sprintf run-apple-script ;
Windows
On Windows, we use the SystemParametersInfo function to get and set the desktop wallpaper.
CONSTANT: SPI_GETDESKWALLPAPER 0x0073 CONSTANT: SPI_SETDESKWALLPAPER 0x0014 M: windows get-desktop-picture SPI_GETDESKWALLPAPER MAX_PATH dup 1 + WCHAR <c-array> [ 0 SystemParametersInfo win32-error<>0 ] keep alien>native-string ; M: windows set-desktop-picture [ SPI_SETDESKWALLPAPER 0 ] dip utf16n encode 0 SystemParametersInfo win32-error<>0 ;
Linux
On Linux, which has many different desktops, we are going to assume a GNOME environment. Other window managers have different ways to change the desktop background.
M: linux get-desktop-picture { "gsettings" "get" "org.gnome.desktop.background" "picture-uri" } utf8 [ readln ] with-process-reader "'file://" ?head drop "'" ?tail drop ; M: linux set-desktop-picture { "gsettings" "set" "org.gnome.desktop.background" "picture-uri" } swap absolute-path "file://" prepend suffix try-process ;
This is available on my GitHub.
No comments:
Post a Comment