

256 buffer: tmp-buf
0 variable tmp-size

: char-to-tmp ( c -- )
  tmp-size @ 256 u<
  if
    tmp-buf tmp-size @ + c!
    1 tmp-size +!
  else
    drop
  then
;

: string-empty ( addr len -- addr len ? ) dup 0= ;
: first-char   ( addr len -- addr len c ) over c@ ;
: remove-first ( addr len -- addr' len' ) 1- swap 1+ swap ;

: cut-first-char   ( addr len -- addr' len' c )
  string-empty if bl else first-char >r remove-first r> then
;

: escape-string ( addr len -- addr' len' )
  0 tmp-size !

  begin
    string-empty not
  while
    cut-first-char

    dup [char] \ =
    if
      drop
      cut-first-char

      case
        [char] t of      $09 endof \ Tab
        [char] n of      $0A endof \ LF
        [char] r of      $0D endof \ CR
        [char] e of      $1B endof \ ESC
        [char] \ of      $5C endof \ \
        [char] ' of [char] " endof \ "

        dup \ Keep character unchanged if it isn't recognized
      endcase
    then

    char-to-tmp
  repeat
  2drop

  tmp-buf tmp-size @
;

: esc-s" ( parses up to "  -- addr len )
  [char] " parse
  escape-string
  postpone (s")
  string,
immediate ;

: hi esc-s" \'Hello World\',\nForth shouted happily." type ;

hi

