[Scummvm-cvs-logs] SF.net SVN: scummvm: [27877] tools/branches/gsoc2007-decompiler

brixxie at users.sourceforge.net brixxie at users.sourceforge.net
Tue Jul 3 02:39:45 CEST 2007


Revision: 27877
          http://scummvm.svn.sourceforge.net/scummvm/?rev=27877&view=rev
Author:   brixxie
Date:     2007-07-02 17:39:44 -0700 (Mon, 02 Jul 2007)

Log Message:
-----------
antipasto.scm: some refactoring of byte sequence reading procedures

Modified Paths:
--------------
    tools/branches/gsoc2007-decompiler/antipasto.scm

Property Changed:
----------------
    tools/branches/gsoc2007-decompiler/


Property changes on: tools/branches/gsoc2007-decompiler
___________________________________________________________________
Name: svk:merge
   - 489ca303-0d3d-4dc1-a57d-017c7912a06a:/local/gsoc2007-decompiler:11
   + 489ca303-0d3d-4dc1-a57d-017c7912a06a:/local/gsoc2007-decompiler:16

Modified: tools/branches/gsoc2007-decompiler/antipasto.scm
===================================================================
--- tools/branches/gsoc2007-decompiler/antipasto.scm	2007-07-03 00:07:28 UTC (rev 27876)
+++ tools/branches/gsoc2007-decompiler/antipasto.scm	2007-07-03 00:39:44 UTC (rev 27877)
@@ -2,7 +2,7 @@
 
 ;;; Antipasto - Scumm Script Disassembler Prototype (version 5 scripts)
 ;;; Copyright (C) 2007 Andreas Scholta
-;;; Time-stamp: <2007-06-25 05:05:15 brx>
+;;; Time-stamp: <2007-06-27 12:42:00 brx>
 
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License
@@ -69,84 +69,69 @@
       (fetch-word)
       (get-var)))
 
+(define (process-bytes-from-script finished? mp
+                                   #!optional (acc cons)
+                                              (finally reverse)
+                                              (nil '()))
+  (let fetch-bytes ((byte (fetch-byte))
+                    (accum nil))
+    (if (finished? byte)
+        (finally accum)
+        (condition-case
+            (let ((val (mp byte)))
+              (fetch-bytes (fetch-byte) (acc val accum)))
+          (e (exn) (signal e))
+          (var () (fetch-bytes (car var)
+                               (cons (cdr var) accum)))))))
+
 (define (get-arg-list)
-  (let read-arg-list ((arg-list '())
-                      (byte (fetch-byte)))
-    (cond
-      ((= byte #xff)
-       (reverse arg-list))
-      (else
-       (read-arg-list (cons (get-var/word byte param-1)
-                            arg-list)
-                      (fetch-byte))))))
+  (process-bytes-from-script
+   (cut = #xff <>)
+   (cut get-var/word <> param-1)))
 
 (define (get-ascii)
-  (let read-ascii ((byte (fetch-byte))
-                   (byte-list '()))
-    (cond ((zero? byte)
-           (list->string (map integer->char (reverse byte-list))))
-          ((= byte #xff)
-           (let ((a (fetch-byte)))
-             (if (and (/= a 1)
-                      (/= a 2)
-                      (/= a 3)
-                      (/= a 8))
-                 (let ((b (fetch-byte))
-                       (c (fetch-byte)))
-                   (read-ascii (fetch-byte)
-                               (cons c
-                                     (cons b
-                                           (cons a
-                                                 (cons byte byte-list))))))
-                 (read-ascii (fetch-byte)
-                             (cons a (cons byte byte-list))))))
-          (else
-           (read-ascii (fetch-byte)
-                       (cons byte byte-list))))))
+  (process-bytes-from-script
+   zero?
+   (lambda (byte)
+     (if (= byte #xff)
+         (let ((a (fetch-byte)))
+           (if (and (/= a 1) (/= a 2)
+                    (/= a 3) (/= a 8))
+               (list byte a (fetch-byte) (fetch-byte))
+               (list byte a)))
+         (list byte)))
+   (lambda (x z) (append z x))
+   (compose list->string (cut map integer->char <>))))
 
 (define (decode-parse-string)
-  (let read-string ((string-infos '())
-                    (byte (fetch-byte)))
-    (cond
-      ((= byte #xff)
-       (reverse string-infos))
-      ((= 0 (band byte #xf))
-       (read-string (cons (list "Pos"
-                                (get-var/word byte param-1)
-                                (get-var/word byte param-2))
-                          string-infos)
-                    (fetch-byte)))
-      ((= 1 (band byte #xf))
-       (read-string (cons (list "Color" (get-var/byte byte param-1))
-                          string-infos)
-                    (fetch-byte)))
-      ((= 2 (band byte #xf))
-       (read-string (cons (list "Clipped" (get-var/word byte param-1))
-                          string-infos)
-                    (fetch-byte)))
-      ((= 3 (band byte #xf))
-       (read-string (cons (list "RestoreBG"
-                                (get-var/word byte param-1)
-                                (get-var/word byte param-2))
-                          string-infos)
-                    (fetch-byte)))
-      ((= 4 (band byte #xf))
-       (read-string (cons "Center" string-infos) (fetch-byte)))
-      ((= 6 (band byte #xf))
-       (read-string (cons "Left" string-infos) (fetch-byte)))
-      ((= 7 (band byte #xf))
-       (read-string (cons "Overhead" string-infos) (fetch-byte)))
-      ((= 8 (band byte #xf))
-       (read-string (cons (list "PlayCDTrack"
-                                             (get-var/word byte param-1)
-                                             (get-var/word byte param-2))
-                                       string-infos)
-                    (fetch-byte)))
-      ((= 15 (band byte #xf))
-       (read-string (cons (list "Text" (get-ascii)) string-infos)
-                    #xff))
-      (else
-       (error "printEgo fucked up" string-infos)))))
+  (let ((hack-nil '()))
+    (process-bytes-from-script
+     (cut = #xff <>)
+     (lambda (byte)
+       (cond
+         ((= 0 (band byte #xf))
+          (list "Pos"
+                (get-var/word byte param-1)
+                (get-var/word byte param-2)))
+         ((= 1 (band byte #xf))
+          (list "Color" (get-var/byte byte param-1)))
+         ((= 2 (band byte #xf))
+          (list "Clipped" (get-var/word byte param-1)))
+         ((= 3 (band byte #xf))
+          (list "RestoreBG"
+                (get-var/word byte param-1)
+                (get-var/word byte param-2)))
+         ((= 4 (band byte #xf)) "Center")
+         ((= 6 (band byte #xf)) "Left")
+         ((= 7 (band byte #xf)) "Overhead")
+         ((= 8 (band byte #xf))
+          (list "PlayCDTrack"
+                (get-var/word byte param-1)
+                (get-var/word byte param-2)))
+         ((= 15 (band byte #xf))
+          (signal (cons #xff (list "Text" (get-ascii)))))
+         (else
+          (error "printEgo fucked up")))))))
 
 (make-123-op "actorFollowCamera"
              #x52
@@ -172,15 +157,15 @@
                    (let ((byte (fetch-byte)))
                      (cond ((or (= byte 1)
                                 (= byte 81))
-                            (list "for actor" (get-var/byte byte param-1)))
+                            (list 'for-actor (get-var/byte byte param-1)))
                            ((= byte 2)
-                            (list "for message"))
+                            (list 'for-message))
                            ((= byte 3)
-                            (list "for camera"))
+                            (list 'for-camera))
                            ((= byte 4)
-                            (list "for sentence"))
+                            (list 'for-sentence))
                            (else
-                            (list "for something unknown"))))))
+                            (list 'for-weekend))))))
 
 (register-opcode "delay"
                  #x2e


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.




More information about the Scummvm-git-logs mailing list