#!/usr/bin/perl # constantly cycle through changing outfits # # This is NOT the install package version! # If you are looking to install the Auto-Magical Outfit Changer, you # should go to http://www.therefan.com/ThereOutfits.html and follow # the instructions there! This version goes with the TherePerl tutorial. require 'TherePerlGlobals.pl'; require 'TherePerlSubs.pl'; $URLoutfits = "http://localhost:9999/ScriptHook/Get?Path=/pilotPobs/outfits"; $URLname = "http://localhost:9999/ScriptHook/Get?Path=/pilotPobs/outfits/000000000/name"; $URLputon = "http://localhost:9999/ScriptHook/Invoke?Path=/pilotPobs/outfits/000000000/Put+on"; print "Welcome to DoctorGibbs' automagical outfit cycler!\n"; print "\nInstructions: Be sure your There window is visible. (OK if it is partially hidden by other windows.) You will cycle among all outfits whose names contain a \"pattern\" that you will be asked to enter. The pattern is any case-sensitive combination of characters. If you enter no pattern (i.e., just hit enter), you will cycle among ALL your outfits. Close this window (X button upper right) to end the program.\n\n"; do { print "How many seconds to you want to wear each outfit? "; $dur = <>; } until ($dur =~ m/^\s*([0-9]*)\s*$/); $dur = $1; if (! $dur) {$dur = 30;} if ($dur < 15) {$dur = 15;} print "Now enter your pattern, followed by enter: "; $_ = <>; chop; $patt = $_; $therewin = &GetThereWindow(); if (! $therewin) {die "No There window found.";} Win32::GuiTest::SetForegroundWindow($therewin); &SendShiftCtrlL($therewin); # get DOIDs for all outfits @outfits = (); $req = HTTP::Request->new('GET', $URLoutfits); $res = $ua->request($req); $ret = $res->content; while ($ret =~ m/([0-9]+)<\/Name>/g) { push @outfits, $1 ;} print "\n"; # get names for each outfit undef %names; $numm = 0; foreach $outfit (@outfits) { $url = $URLname; $url =~ s/000000000/$outfit/; $req = HTTP::Request->new('GET', $url); $res = $ua->request($req); $ret = $res->content; if ($ret =~ m/(.+)<\/Value>/g) { $name = $1; $names{$outfit} = $name; if ((! $patt) || ($name =~ m/$patt/)) { print "$name will be included in the cycle\n"; $numm++; } } } if ($numm == 0) { print "No outfits match that pattern. Exiting...\n"; exit (0); } print "\n"; # forever randomize @outfits and put on those matching $patt while (1) { for ($i = @outfits; --$i; ) { $j = int rand ($i+1); next if $i == $j; @outfits[$i,$j] = @outfits[$j,$i]; } foreach $outfit (@outfits) { $name = $names{$outfit}; if (($patt) && ($name !~ m/$patt/)) {next;} print "now putting on <$name> ...\n"; $url = $URLputon; $url =~ s/000000000/$outfit/; $req = HTTP::Request->new('GET', $url); $res = $ua->request($req); $ret = $res->content; sleep $dur; } } #END MAIN