colours and ascii dump (not working correctly)

xxd but bad

1 files changed, 23 insertions, 3 deletions

diff --git a/jefs.fs b/jefs.fs
index af08710..af577b6 100644
--- a/jefs.fs
+++ b/jefs.fs
@@ -398,10 +398,30 @@ termios TCGETS stdin ioctl ( noname ) swap execute value tty
 
 \ DUMP {{{
 \ it's designed to look like xxd. i like xxd's hex dumps.
+hex
+\ blorken
+: dump-colour ( c -- n )  dup 0= if white else
+	dup 0a = if yellow else
+	dup 20 < if red else
+	dup 7f < if green else
+	dup ff < if red else blue
+	then then then then then nip ;
+
+\ also blorken
+: dump-char ( c -- c )  dup 20 < if drop [ char . ] literal else
+	dup 7e >= if drop [ char . ] literal then then ;
+decimal
+
+: (dumpchar) ( a -- a+1 )  dup @ dup dump-colour foreground dump-char emit 1+ ;
+: (dumpascii) ( a -- )  16 begin ?dup 0> while swap (dumpchar) swap 1- repeat default foreground drop ;
+
 : (dumploc) ( a -- )  (.dword) say ." : " ;
-: (d+) ( a -- a+1 )  dup @ .word 1+ ;
-: (dumphex) ( a -- a ) (d+) (d+) (d+) (d+) (d+) (d+) (d+) (d+) ;
-: (dump) ( a -- )  dup (dumploc) (dumphex) drop cr ; \ dump cell of memory at a
+
+: (d+) ( a -- a+1 )  dup @ dup dump-colour foreground (.byte) say default foreground 1+ ;
+: (dw+) ( a -- a+2 )  (d+) (d+) space ;
+: (dumphex) ( a -- ) (dw+) (dw+) (dw+) (dw+) (dw+) (dw+) (dw+) (dw+) drop ;
+
+: (dump) ( a -- )  dup (dumploc) bold dup (dumphex) 2 spaces (dumpascii) normal cr ; \ dump cell of memory at a
 : dump ( n a -- ) swap begin ?dup 0> while swap dup (dump) 16 + swap 1- repeat drop ; \ dump n lines (of 16 bytes each) of memory starting at a
 \ }}}