REBOL [
    Title: "Dumpall"
]

;; [---------------------------------------------------------------------------]
;; [ This is a program for making a hex dump of any file.                      ]
;; [ It reads the whole file in binary form and prints out the hex values      ]
;; [ of the data.                                                              ]
;; [---------------------------------------------------------------------------]

;; [---------------------------------------------------------------------------]
;; [ Function to pad strings in various ways.                                  ]
;; [---------------------------------------------------------------------------]
GLB-FILLER: func [
    "Return a string of a given number of spaces"
    SPACE-COUNT [integer!]
    /local FILLER 
] [
    FILLER: copy ""
    loop SPACE-COUNT [
        append FILLER " "
    ]
    return FILLER
]
GLB-ZEROFILL: func [
    "Convert number to string, pad with leading zeros"
    INPUT-STRING
    FINAL-LENGTH
    /local ALL-DIGITS 
           LENGTH-OF-ALL-DIGITS
           NUMER-OF-ZEROS-TO-ADD
           REVERSED-DIGITS 
           FINAL-PADDED-NUMBER
] [
    ALL-DIGITS: copy ""
    ALL-DIGITS: trim/with to-string INPUT-STRING trim/with 
        copy to-string INPUT-STRING "0123456789"
    LENGTH-OF-ALL-DIGITS: length? ALL-DIGITS
    if (LENGTH-OF-ALL-DIGITS <= FINAL-LENGTH) [
        NUMBER-OF-ZEROS-TO-ADD: (FINAL-LENGTH - LENGTH-OF-ALL-DIGITS)
        REVERSED-DIGITS: copy ""
        REVERSED-DIGITS: reverse ALL-DIGITS    
        loop NUMBER-OF-ZEROS-TO-ADD [
            append REVERSED-DIGITS "0"
        ]
        FINAL-PADDED-NUMBER: copy ""
        FINAL-PADDED-NUMBER: GLB-SUBSTRING reverse REVERSED-DIGITS 1 FINAL-LENGTH
    ]
    return FINAL-PADDED-NUMBER
]
GLB-SUBSTRING: func [
    "Return a substring from the start position to the end position"
    INPUT-STRING [series!] "Full input string"
    START-POS    [number!] "Starting position of substring"
    END-POS      [number!] "Ending position of substring"
] [
    if END-POS = -1 [END-POS: length? INPUT-STRING]
    return skip (copy/part INPUT-STRING END-POS) (START-POS - 1)
]

;; [---------------------------------------------------------------------------]
;; [ This is the window that will appear as a confirmation that we are done.   ]
;; [ It will show the data in hex format, and have buttons for some options    ]
;; [ for what to do with this now-decoded data.                                ]
;; [---------------------------------------------------------------------------]
TFACE-OUT: center-face layout [
    across
    h3 "Program Output" 
    return
    space 0
    T1: text 800x600 wrap green black font-name font-fixed 
    S1: scroller 16x600 [TFACE-SCROLL T1 S1]
    return
    pad 0x5 
    space 5
    button "Close" [TFACE-CLOSE T1 S1]
    button 150 "Write dump.txt" [TFACE-WRITE]
    button 150 "Write printable" [TFACE-WRITE-CHAR]
]
TFACE-SCROLL: func [TXT BAR][
    TXT/para/scroll/y: negate BAR/data *
        (max 0 TXT/user-data - TXT/size/y)
    show TXT
]
TFACE-SHOW-TEXT: func [TFACE-TEXT-IN][
    T1/text: TFACE-TEXT-IN  
    T1/para/scroll/y: 0
    S1/data: 0
    T1/line-list: none
    T1/user-data: second size-text T1
    S1/redrag T1/size/y / T1/user-data
    view TFACE-OUT
]
TFACE-CLOSE: func [TXT BAR] [
    unview
]
TFACE-WRITE: does [
    DUMP-FILE: %dump.txt
    write DUMP-FILE FULL-DUMP 
    alert "Done" 
] 
TFACE-WRITE-CHAR: does [
    DUMP-FILE: %dump.txt
    write DUMP-FILE PRINTABLE-DUMP
    alert "Done"
]

;; [---------------------------------------------------------------------------]
;; [ Get a file name and read it into memory in binary format.                 ]
;; [---------------------------------------------------------------------------]
FILE-ID: request-file/only
if not FILE-ID [
    alert "No file selected"
    quit
]
BINARY-DATA: read/binary FILE-ID 

;; [---------------------------------------------------------------------------]
;; [ Take a binary value for one byte and produce two bytes that are the       ]
;; [ hex representation, which are printable.                                  ]
;; [---------------------------------------------------------------------------]
HEX-VAL: func [
    BINARY-VAL
] [
    HEX-BYTE: copy ""
    HEX-BYTE: reverse copy/part reverse to-string to-hex BINARY-VAL 2
]

;; [---------------------------------------------------------------------------]
;; [ Take a binary value for one byte and produce one byte that is the         ]
;; [ ascii character for that binary value.  If the result is not a            ]
;; [ printable character, return a dot.                                        ]
;; [---------------------------------------------------------------------------]
CHAR-VAL: func [
    BINARY-VAL
] [
    CHAR-BYTE: copy ""
    either ((BINARY-VAL > 31) and (BINARY-VAL < 127)) [
        CHAR-BYTE: copy to-string to-char BINARY-VAL
    ] [
        CHAR-BYTE: copy "."
    ]
]

;; [---------------------------------------------------------------------------]
;; [ Go through the binary data one byte at a time and convert each byte       ]
;; [ to a two-character hex representation and a one-character printable       ]
;; [ character.                                                                ]
;; [---------------------------------------------------------------------------]
HEX-DATA: copy ""
CHAR-DATA: copy ""
foreach BCHAR BINARY-DATA [
    append HEX-DATA HEX-VAL BCHAR
    append CHAR-DATA CHAR-VAL BCHAR
]

;; [---------------------------------------------------------------------------]
;; [ With the binary data translated into two forms, format those two          ]
;; [ forms into text lines that will look useful when displayed in a           ]
;; [ fixed-format font.  We will display LINE-LENGTH chunks in                 ]
;; [ two-lines, the hex line on top and the printable line beneath.            ]
;; [ The FULL-DUMP is lines of text, a hex line followed by an ascii line,     ]
;; [ and is what we show when we pop up the viewing window.                    ]
;; [ In anticipation of other needs, PRINTABLE-DUMP is just the ascii lines.   ]
;; [ Sometimes a person might want to view the printable characters in a       ]
;; [ binary file if all the non-printable characters can be replaced with      ]
;; [ something printable.                                                      ]
;; [---------------------------------------------------------------------------]
FILE-SIZE: length? CHAR-DATA
START-POS: 1
END-POS: length? CHAR-DATA
CHAR-COUNT: 0 
HEX-PICK-1: 0
HEX-PICK-2: 0  
FULL-DUMP: copy ""
PRINTABLE-DUMP: copy "" 
HEX-LINE: copy ""
CHAR-LINE: copy ""
PRINTABLE-LINE: copy ""
LINE-LENGTH: 50
LINE-COUNT: 0   ;; for counting characters placed on the line so far
LINE-START-COUNT: 1 ;; character number on beginning of current line 
LINE-START-COUNT: START-POS 
for CHAR-COUNT START-POS END-POS 1 [
    LINE-COUNT: LINE-COUNT + 1
    if (LINE-COUNT > LINE-LENGTH) [
        LINE-COUNT: 1
        append FULL-DUMP GLB-ZEROFILL LINE-START-COUNT 6
        append FULL-DUMP ": "
        append FULL-DUMP HEX-LINE
        append FULL-DUMP newline
        HEX-LINE: copy ""
        append FULL-DUMP GLB-FILLER 8
        append FULL-DUMP CHAR-LINE
        append FULL-DUMP newline
        CHAR-LINE: copy ""
        append PRINTABLE-DUMP GLB-ZEROFILL LINE-START-COUNT 6
        append PRINTABLE-DUMP ": "
        append PRINTABLE-DUMP PRINTABLE-LINE
        append PRINTABLE-DUMP newline
        PRINTABLE-LINE: copy ""
        LINE-START-COUNT: CHAR-COUNT
    ]
    append CHAR-LINE CHAR-DATA/:CHAR-COUNT
    append CHAR-LINE " "
    HEX-PICK-1: ((CHAR-COUNT * 2) - 1)
    HEX-PICK-2: HEX-PICK-1 + 1
    append HEX-LINE HEX-DATA/:HEX-PICK-1
    append HEX-LINE HEX-DATA/:HEX-PICK-2
    append PRINTABLE-LINE CHAR-DATA/:CHAR-COUNT
]
if (LINE-COUNT > 0) [
    append FULL-DUMP GLB-ZEROFILL LINE-START-COUNT 6
    append FULL-DUMP ": "
    append FULL-DUMP HEX-LINE
    append FULL-DUMP newline
    append FULL-DUMP GLB-FILLER 8
    append FULL-DUMP CHAR-LINE
    append FULL-DUMP newline
    append PRINTABLE-DUMP GLB-ZEROFILL LINE-START-COUNT 6
    append PRINTABLE-DUMP ": "
    append PRINTABLE-DUMP PRINTABLE-LINE
    append PRINTABLE-DUMP newline
]

;; [---------------------------------------------------------------------------]
;; [ Write the formatted lines to a viewing window.                            ]
;; [ This file will not look right unless viewed in a fixed font.              ]
;; [---------------------------------------------------------------------------]

TFACE-SHOW-TEXT FULL-DUMP