diff options
Diffstat (limited to 'Scripting/Perl/PoserRPC.pl')
| -rwxr-xr-x | Scripting/Perl/PoserRPC.pl | 313 |
1 files changed, 313 insertions, 0 deletions
diff --git a/Scripting/Perl/PoserRPC.pl b/Scripting/Perl/PoserRPC.pl new file mode 100755 index 0000000..6141667 --- /dev/null +++ b/Scripting/Perl/PoserRPC.pl @@ -0,0 +1,313 @@ +#!/usr/bin/perl +######################################################################## +# +# File: PoserRPC.pl +# +# Purpose: Scrap file for testing Poser's RPC mechanism +# +# Description: This file contains a hodgepodge of scripts and +# commands used to test out parts of Poser's RPC. +# Don't take anything in this file too seriously; +# it's provided only for completeness' sake. +# +######################################################################## + +use EmRPC; # EmRPC::OpenConnection, CloseConnection +use EmFunctions; +use EmUtils; # Wait, TapPen, TapButton + +use constant hostSignalReserved => 0; +use constant hostSignalIdle => 1; +use constant hostSignalQuit => 2; +use constant hostSignalSessionStarted => 3; +use constant hostSignalSessionStopped => 4; + +EmRPC::OpenConnection(6415, "localhost"); + +if (1) +{ + my ($err, $result) = HwrDisplayAttributes (0, hwrDispType, "xxxx"); + print "hwrDispType", ($err ? ": err = $err" : (" = ", $result)), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispRev, "xx"); + print "hwrDispRev", ($err ? ": err = $err" : (" = ", unpack ("n", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispVers, "xx"); + print "hwrDispVers", ($err ? ": err = $err" : (" = ", unpack ("n", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispAllDepths, "xx"); + print "hwrDispAllDepths", ($err ? ": err = $err" : (" = ", unpack ("n", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispMaxDepth, "xx"); + print "hwrDispMaxDepth", ($err ? ": err = $err" : (" = ", unpack ("n", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispBootDepth, "xx"); + print "hwrDispBootDepth", ($err ? ": err = $err" : (" = ", unpack ("n", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispMaxGrays, "xx"); + print "hwrDispMaxGrays", ($err ? ": err = $err" : (" = ", unpack ("n", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispHorizontal, "xx"); + print "hwrDispHorizontal", ($err ? ": err = $err" : (" = ", unpack ("n", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispVertical, "xx"); + print "hwrDispVertical", ($err ? ": err = $err" : (" = ", unpack ("n", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispVRAMBaseAddr, "xxxx"); + print "hwrDispVRAMBaseAddr", ($err ? ": err = $err" : (" = ", unpack ("N", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispVRAMSize, "xxxx"); + print "hwrDispVRAMSize", ($err ? ": err = $err" : (" = ", unpack ("N", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispColor, "xx"); + print "hwrDispColor", ($err ? ": err = $err" : (" = ", unpack ("n", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispName, pack ("x32")); + print "hwrDispName", ($err ? ": err = $err" : (" = ", $result)), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispBaseAddr, "xxxx"); + print "hwrDispBaseAddr", ($err ? ": err = $err" : (" = ", unpack ("N", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispDepth, "xx"); + print "hwrDispDepth", ($err ? ": err = $err" : (" = ", unpack ("n", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispWidth, "xx"); + print "hwrDispWidth", ($err ? ": err = $err" : (" = ", unpack ("n", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispHeight, "xx"); + print "hwrDispHeight", ($err ? ": err = $err" : (" = ", unpack ("n", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispRowBytes, "xx"); + print "hwrDispRowBytes", ($err ? ": err = $err" : (" = ", unpack ("n", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispBacklight, "x"); + print "hwrDispBacklight", ($err ? ": err = $err" : (" = ", unpack ("c", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispBrightness, "x"); + print "hwrDispBrightness", ($err ? ": err = $err" : (" = ", unpack ("c", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispContrast, "x"); + print "hwrDispContrast", ($err ? ": err = $err" : (" = ", unpack ("c", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispDbgIndicator, "xx"); + print "hwrDispDbgIndicator", ($err ? ": err = $err" : (" = ", unpack ("n", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispEndAddr, "xxxx"); + print "hwrDispEndAddr", ($err ? ": err = $err" : (" = ", unpack ("N", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispBufferMask, "xxxx"); + print "hwrDispBufferMask", ($err ? ": err = $err" : (" = ", unpack ("N", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispResolutionX, "xxxx"); + print "hwrDispResolutionX", ($err ? ": err = $err" : (" = ", unpack ("N", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispResolutionY, "xxxx"); + print "hwrDispResolutionY", ($err ? ": err = $err" : (" = ", unpack ("N", $result))), "\n"; + + my ($err, $result) = HwrDisplayAttributes (0, hwrDispMemAccessOK, "x"); + print "hwrDispMemAccessOK", ($err ? ": err = $err" : (" = ", unpack ("c", $result))), "\n"; +} + +if (0) +{ + TapButtonSync("OK"); +} + +if (0) +{ + Wait(); + $err = HostSessionClose (""); # Don't save + die "$err" if $err; + $err = HostSessionQuit (); + die "$err" if $err; +} + + +if (0) +{ + my ($err, $signal); + + ######################################################################## + print "Waiting for idle\n"; + + do { + ($err, $signal) = HostSignalWait (0x7fffffff); + if ($err) + { + HostSignalResume (); + die "Error $err while waiting for hostSignalIdle"; + } + } while ($signal != hostSignalIdle); + + ######################################################################## + print "Closing session\n"; + + $err = HostSessionClose (""); # Don't save + + ######################################################################## + print "Waiting for session to close\n"; + + do { + ($err, $signal) = HostSignalWait (0x7fffffff); + if ($err) + { + HostSignalResume (); + die "Error $err while waiting for hostSignalSessionStopped"; + } + } while ($signal != hostSignalSessionStopped); + + ######################################################################## + print "Creating session\n"; + + $err = HostSessionCreate ("PalmIII", 1024, "C:\\ROMs\\spp\\rom30dbg.rom"); + + ######################################################################## + print "Waiting for session to start\n"; + + do { + ($err, $signal) = HostSignalWait (0x7fffffff); + if ($err) + { + HostSignalResume (); + die "Error $err while waiting for hostSignalSessionStarted"; + } + } while ($signal != hostSignalSessionStarted); + + ######################################################################## + print "Closing session\n"; + + $err = HostSessionClose (""); # Don't save + + ######################################################################## + print "Waiting for session to close\n"; + + do { + ($err, $signal) = HostSignalWait (0x7fffffff); + if ($err) + { + HostSignalResume (); + die "Error $err while waiting for hostSignalSessionStopped"; + } + } while ($signal != hostSignalSessionStopped); + + ######################################################################## + + HostSignalResume (); + print "Done!\n"; +} + +if (0) +{ + $addr = MemPtrNew (100); + printf ("0x%08X\n", $addr); + EmRPC::WriteBlock ($addr, "1234567890"); + $str = EmRPC::ReadBlock ($addr, 10); + print $str, "\n"; + MemPtrFree ($addr); +} + +if (0) +{ + TapPen (100, 100); +} + +if (0) +{ + $vers = HostGetHostVersion (); + printf ("HostGetHostVersion() = 0x%08X\n", $vers); +} + +if (0) +{ + $num = DmNumDatabases (0); + print "DmNumDatabases(0) = ", $num, "\n"; + + $localID = DmFindDatabase (0, "MemoDB"); + printf ("DmFindDatabase(0, \"MemoDB\") = 0x%08X\n", $localID); + + ($err, %results) = DmDatabaseInfo (0, $localID); + printf ("DmDatabaseInfo(0, 0x%08X) = 0x%08X\n", $localID, $err); + print ("results: \n"); + print ("\tname = ", $results{name}, "\n"); + print ("\tattributes = ", $results{attributes}, "\n"); + print ("\tversion = ", $results{version}, "\n"); + print ("\tcrDate = ", $results{crDate}, "\n"); + print ("\tmodDate = ", $results{modDate}, "\n"); + print ("\tbckUpDate = ", $results{bckUpDate}, "\n"); + print ("\tmodNum = ", $results{modNum}, "\n"); + print ("\tappInfoID = ", $results{appInfoID}, "\n"); + print ("\tsortInfoID = ", $results{sortInfoID}, "\n"); + print ("\ttype = ", $results{type}, "\n"); + print ("\tcreator = ", $results{creator}, "\n"); +} + +if (0) +{ + $block = EmRPC::ReadBlock (0, 256); + EmRPC::PrintString ($block); +} + +if (0) +{ + my ($form) = FrmGetActiveForm(); + my ($num_objects) = FrmGetNumberOfObjects($form); + + for $ii (0..$num_objects - 1) + { + my ($line) = "$ii. "; + my ($object_type) = FrmGetObjectType($form, $ii); + + my ($type) = ("frmFieldObj", "frmControlObj", "frmListObj", "frmTableObj", + "frmBitmapObj", "frmLineObj", "frmFrameObj", "frmRectangleObj", + "frmLabelObj", "frmTitleObj", "frmPopupObj", "frmGraffitiStateObj", + "frmGadgetObj", "frmScrollBarObj")[$object_type]; + + $line .= " $type"; + + if ($object_type == frmControlObj) + { + my ($obj_ptr) = FrmGetObjectPtr ($form, $ii); + my ($address, $label) = CtlGetLabel($obj_ptr); + $line .= " \"$label\""; + } + elsif ($object_type == frmLabelObj) + { + my ($label_id) = FrmGetObjectId ($form, $ii); + my ($address, $label) = FrmGetLabel($form, $label_id); + $line .= " \"$label\""; + } + elsif ($object_type == frmTitleObj) + { + my ($address, $title) = FrmGetTitle($form,); + $line .= " \"$title\""; + } + else + { + $line .= " <no label>"; + } + + my (%bounds) = FrmGetObjectBounds($form, $ii); + $line .= " ($bounds{left}, $bounds{top}, $bounds{right}, $bounds{bottom})"; + + print "$line\n"; + } +} + +if (0) +{ + $err = HostSessionClose (""); + printf ("HostSessionClose() = 0x%08X\n", $err); + + $err = HostSessionQuit (); + printf ("HostSessionQuit() = 0x%08X\n", $err); +} + +if (0) +{ + HostGremlinNew (0, 3, 0, -1, 10000, "Memo Pad") == 0 || die "HostGremlinNew failed, stopped"; +} + +EmRPC::CloseConnection(); + + + |