~cadence/PE-DIA

33b61da80fe2ed7861c8771b7e56c55374ec9a7a — Cadence Ember 1 year, 3 months ago 7d763a1
Add experimental dia-to-md decompiler
1 files changed, 146 insertions(+), 0 deletions(-)

A decompiler.rkt
A decompiler.rkt => decompiler.rkt +146 -0
@@ 0,0 1,146 @@
#lang typed/racket/base
(require racket/list
         racket/port)

;; test structures

(module+ test
  (require/typed rackunit
    [check-equal? (Any Any -> Void)]
    [check-true (Any -> Void)]
    [check-false (Any -> Void)])

  (: check-fn ((Input-Port -> Any) Bytes Any -> Void))
  (define (check-fn fn bytes-in expected)
    (: in Input-Port)
    (define in (open-input-bytes bytes-in))
    (check-equal? (fn in)
                  expected)))

;; handler if there's not enough data

(define (end-of-input [message "Tried to read more from the file, but reached the end of the file."])
  (displayln message)
  (exit 1))

;; wonderland basic types

(: read-int (Input-Port -> Integer))
(define (read-int in)
  (define next (read-bytes 4 in))
  (cond
    [(eof-object? next) (end-of-input)]
    [(not (eq? (bytes-length next) 4)) (end-of-input)]
    [#t (integer-bytes->integer next #t)]))
(module+ test
  (check-fn read-int #"\3\1\0\0" 259))

(: read-string (Input-Port -> String))
(define (read-string in)
  (define l (read-int in))
  (define next (read-bytes l in))
  (cond
    [(eof-object? next) (end-of-input)]
    [(not (eq? (bytes-length next) l)) (end-of-input)]
    [#t (bytes->string/latin-1 next)]))
(module+ test
  (check-fn read-string #"\5\0\0\0hello" "hello"))

;; wonderland adventures dialog constants
(define chars-per-line 38)
(define max-number-of-lines 7)

;; wonderland adventures dialog structures

(struct effect^ ([class : Symbol] [type : String] [position : Integer]) #:transparent)
(: read-effect (Input-Port -> effect^))
(define (read-effect in)
  (define effect-type (read-string in))
  (define effect-class (string->symbol (string-downcase (substring effect-type 0 1))))
  (effect^ effect-class effect-type (read-int in)))

(struct reply^ ([text : String] [fnc : Integer] [fnc-data : Integer]
                                [cmd : Integer] [cmd-data-1 : Integer] [cmd-data-2 : Integer] [cmd-data-3 : Integer] [cmd-data-4 : Integer]) #:transparent)
(: read-reply (Input-Port -> reply^))
(define (read-reply in)
  (reply^
   (read-string in)
   (read-int in) ; fnc
   (read-int in)
   (read-int in) ; cmd
   (read-int in)
   (read-int in)
   (read-int in)
   (read-int in)))

(struct interchange^ ([lines : (Listof String)] [effects : (Listof effect^)] [replies : (Listof reply^)]) #:transparent)
(: read-interchange (Input-Port -> interchange^))
(define (read-interchange in)
  (define number-of-lines (read-int in))
  (define lines : (Listof String)
    (for/list ([_ (in-range number-of-lines)])
      (read-string in)))
  (define number-of-effects (read-int in))
  (define effects : (Listof effect^)
    (for/list ([_ (in-range number-of-effects)])
      (read-effect in)))
  (define number-of-replies (read-int in))
  (define replies : (Listof reply^)
    (for/list ([_ (in-range number-of-replies)])
      (read-reply in)))
  (interchange^ lines effects replies))

(struct dialog^ ([interchanges : (Listof interchange^)]) #:transparent)
(: read-dialog (Input-Port -> dialog^))
(define (read-dialog in)
  (define number-of-interchanges (read-int in))
  (dialog^ (for/list ([_ (in-range number-of-interchanges)]) (read-interchange in))))

;; conversion to text

(: fnc->text (Integer -> String))
(define (fnc->text fnc)
  (or (list-ref '(#f "END" "") fnc)
      (end-of-input (format "Invalid FNC number: ~a" fnc))))

(: dialog->text (dialog^ -> String))
(define (dialog->text dialog)
  (with-output-to-string
    (λ ()
      (for ([interchange (dialog^-interchanges dialog)])
        (for ([line (interchange^-lines interchange)]
              [n0 (in-naturals 0)])
          (define n1 (add1 n0))
          (define last-line? (eq? n1 (length (interchange^-lines interchange))))
          (define offset (* n0 38))
          (when (n1 . > . max-number-of-lines)
            (printf "~~ CAUTION: The next line is the ~ath line, but WA can only have ~a lines per interchange.~n~~          Remove the next line or the player and editor will become corrupted.~n" n1 max-number-of-lines))
          (for ([char line]
                [offset (in-range offset (+ offset (string-length line)))])
            (for ([effect (interchange^-effects interchange)]
                  #:when (eq? (effect^-position effect) offset))
              (printf "[~a " (effect^-type effect)))
            (display char))
          (when last-line?
            (for ([effect (interchange^-effects interchange)]
                  #:when ((effect^-position effect) . <= . offset))
              (display "]")))
          (displayln ""))
        (when (pair? (interchange^-replies interchange))
          (displayln "")
          (for* ([reply (interchange^-replies interchange)])
            (printf "* ~a /~a->~a ~a, ~a, ~a, ~a, ~a~n"
                    (reply^-text reply)
                    (fnc->text (reply^-fnc reply))
                    (reply^-fnc-data reply)
                    (reply^-cmd reply)
                    (reply^-cmd-data-1 reply)
                    (reply^-cmd-data-2 reply)
                    (reply^-cmd-data-3 reply)
                    (reply^-cmd-data-4 reply)))
          (displayln ""))))))

;; go!
(define in (open-input-file "x.dia"))
(define dialog (read-dialog in))
(displayln (dialog->text dialog))