#!/usr/local/bin/guile
!#

(use-modules (srfi srfi-1)
             (ncurses curses)
             (ncurses form))

;; Helper procedure to center a text
(define (print-in-middle win starty startx width str color)
  (let ((length (string-length str)))

    (attr-on! win color)
    (addstr win str
            #:y starty
            #:x (+ startx (/ (- width length) 2)))

    (attr-off! win color)
    (refresh stdscr)))


;; Initialize curses
(define stdscr (initscr))
(start-color!)
(cbreak!)
(noecho!)
(keypad! stdscr #t)

;;Initialize a few color pairs
(init-pair! 1 COLOR_RED COLOR_BLACK)

(define field (list
               (new-field 1 10 6 1 0 0)
               (new-field 1 10 8 1 0 0)))

;; Set field options
(set-field-back! (first field) A_UNDERLINE)
(field-opts-off! (first field) O_AUTOSKIP)

(set-field-back! (second field) A_UNDERLINE)
(field-opts-off! (second field) O_AUTOSKIP)

;; Create a new form
(define my-form (new-form field))

;; Calculate the area associated with the form
(define xy (scale-form my-form))
(define rows (car xy))
(define cols (cadr xy))

;; Create the window to be associated with the form
(define my-form-win (newwin (+ 4 rows)
                            (+ 4 cols)
                            4
                            4))
(keypad! my-form-win #t)

;; Set main window and subwindow
(set-form-win! my-form my-form-win)
(set-form-sub! my-form (derwin my-form-win rows cols 2 2))

;; Print a border around the main window and print a title
(box my-form-win 0 0)
(print-in-middle my-form-win 1 0 (+ cols 4) "My Form" (color-pair 1))

(post-form my-form)
(refresh my-form-win)

(addstr stdscr "Use UP, DOWN arrow keys to switch between fields"
        #:y (- (lines) 2) #:x 0)
(refresh stdscr)

;; Loop through to get user requests
(let loop ((ch (getch my-form-win)))
  (if (not (eqv? ch (key-f 1)))
      (cond
       ((eqv? ch KEY_DOWN)
        (begin
          ;; Go to the end of the next field
          (form-driver my-form REQ_NEXT_FIELD)
          (form-driver my-form REQ_END_LINE)
          (loop (getch my-form-win))))
       ((eqv? ch KEY_UP)
        (begin
          ;; Go to the end of the previous field
          (form-driver my-form REQ_PREV_FIELD)
          (form-driver my-form REQ_END_LINE)
          (loop (getch my-form-win))))
       (else
        (begin
          ;; Print any normal character
          (form-driver my-form ch)
          (loop (getch my-form-win)))))))

;; Unpost the form
(unpost-form my-form)

(endwin)