(require :asdf)
(require :mcclim)

(uiop:define-package :NicCLIM
    (:mix :clim :clim-lisp :cl)
  (:export #:enclose-map))
(in-package :NicCLIM)

(define-application-frame map-editor ()
  ((table-list :initarg :table-list)
   (cursor-locn :initarg :cursor-locn)
   (cur1 :initform nil)
   (cur2 :initform nil))
  (:panes
   (int :interactor)
   (row :application
	:display-function
	(lambda (f p)
	  (princ "y=" p)
	  (with-slots
		(cursor-locn)
	      *application-frame*
	    (princ (car cursor-locn) p))))
   (col :application
	:display-function
	(lambda (f p)
	  (princ "x=" p)
	  (with-slots
		(cursor-locn)
	      *application-frame*
	    (princ (cadr cursor-locn) p))))
   (cell :application
	 :display-function
	 (lambda (f p)
	   (princ "has " p)
	   (ignore-errors
	    (with-slots
		  (cursor-locn table-list)
		*application-frame*
	      (princ (nth (cadr cursor-locn)
			  (nth (car cursor-locn)
			       table-list))
		     p)))))
   (cur1 :application)
   (cur2 :application)
   (map :application
	:display-function 'map-display
	:incremental-redisplay t))
  (:layouts
   (default
    (horizontally
	(:width 1024)
      int map)))
  (:default-initargs :cursor-locn '(0 0)))

(defun map-display (frame pane)
  (formatting-table
      (pane)
    (with-slots
	  (table-list)
	frame
      (loop :for row :in table-list :do
	(formatting-row
	    (pane)
	  (loop :for cell :in row :do
	    (formatting-cell
		(pane)
	      (updating-output
		  (pane)
		(loop :for symbol :in cell
		      :do (present symbol)
			  (terpri))))))))))

(defun enclose-map (file)
  "enclose-map (file) is the intended way of starting the frame
The file is thought to be READ-DELIMITED-LIST suitable."
  (let
      ((lists
	 (with-open-file
	     (in file)
	   (loop
	     :collect (handler-case
			  (read-delimited-list #\newline in)
			(end-of-file (e) (declare (ignore e))
			  (return lists)))
	       :into lists))))
    ;; Run the application-frame.
    (let ((frame (make-application-frame
		  'map-editor
		  :table-list lists)))
      (run-frame-top-level frame))
    ;; Print
    (format
     t
     "~{~{~s~^	~}~^~%~}"
     lists)
    ;; Overwrite file?
    (when
	(y-or-n-p "Clobber ~a? y/n" file)
      (with-open-file
	  (out file :direction :output
		    :if-exists :supersede)
	(format
	 out
	 "~{~{~s~^	~}~^~%~}"
	 lists)))))

;;;;⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇
;;;; COMMANDS⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇
;;;;⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇⌇

;;;≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅
;;; CURSOR COMMANDS≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅
;;;≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅

(define-map-editor-command
    (set-cur1 :name t :menu cursor)
    ((cur1i 'symbol :default NIL))
  "sets cur1 to a symbol."
  (with-slots
	(cur1)
      *application-frame*
    (setf cur1 cur1i)))

(define-map-editor-command
    (swap :name t :menu cursor)
    ()
  "swaps cur1 and cur2"
  (with-slots
	(cur1 cur2)
      *application-frame*
    (setf cur2 cur1 cur1 cur2)))
  
(define-map-editor-command
    (pushes :name t :menu cursor)
    ()
  "pushes cursor 1 to the current cell"
  (with-slots
	(table-list cursor-locn cur1)
      *application-frame*
    (nconc
     (nth (cadr cursor-locn) 
	  (nth (car cursor-locn)
	       table-list))
     (list cur1))))

(define-map-editor-command
    (s/cur1/cur2/g :name t :menu cursor)
    ()
  "s/cur1/cur2/g (in current cell)"
  (with-slots
	(table-list cursor-locn
	 cur1 cur2)
      *application-frame*
    (nsubst
     cur1
     cur2
     (nth (cadr cursor-locn) 
	  (nth (car cursor-locn)
	       table-list)))))

(define-map-editor-command
    (delcur :name t :menu cursor)
    ()
  "Deletes cur1 from current cell"
  (with-slots
	(table-list cursor-locn
	 cur1)
      *application-frame*
    (setf
     (nth (cadr cursor-locn) 
	  (nth (car cursor-locn)
	       table-list))
     (delete
      cur1
      (nth (cadr cursor-locn) 
	   (nth (car cursor-locn)
		table-list))
      :test 'string=
      :key 'symbol-name))))

(define-map-editor-command
    (rot-cell :name t :menu cursor)
    ((n 'integer :default 1))
  "rot-cell takes an integer and rotates the current cell that much."
  (with-slots
	(table-list cursor-locn)
      *application-frame*
    (setf
     (nth (cadr cursor-locn) 
	  (nth (car cursor-locn)
	       table-list))
     (alexandria:rotate
      (nth (cadr cursor-locn) 
	   (nth (car cursor-locn)
		table-list))
      n))))

;;;≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅
;;; MOVEMENT≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅
;;;≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅

(define-map-editor-command
    (com-h :menu mov :name t
	   :keystroke (#\h :control))
    ()
  (with-slots
	(cursor-locn)
      *application-frame*
    (decf (cadr cursor-locn))
    (print cursor-locn *terminal-io*)))

(define-map-editor-command
    (com-j :menu mov :name t
	   :keystroke (#\j :control))
    ()
  (with-slots
	(cursor-locn)
      *application-frame*
    (incf (car cursor-locn))
    (print cursor-locn *terminal-io*)))

(define-map-editor-command
    (com-k :menu mov :name t
	   :keystroke (#\k :control))
    ()
  (with-slots
	(cursor-locn)
      *application-frame*
    (decf (car cursor-locn))
    (print cursor-locn *terminal-io*)))

(define-map-editor-command
    (com-l :menu mov :name t
	   :keystroke (#\l :control))
    ()
  (with-slots
	(cursor-locn)
      *application-frame*
    (incf (cadr cursor-locn))
    (print cursor-locn *terminal-io*)))

(define-map-editor-command
    (jump :menu mov :name t)
    ((x 'integer :default 0)
     (y 'integer :default 0))
  "jump to absolute integer x integer y position"
  (with-slots
	(cursor-locn)
      *application-frame*
    (setf (cadr cursor-locn) x
	  (car cursor-locn) y)
    (print cursor-locn *terminal-io*)))

(define-map-editor-command
    (add :menu mov :name t)
    ((x 'integer :default 0)
     (y 'integer :default 0))
  "vector add integer x integer y to current position"
  (with-slots
	(cursor-locn)
      *application-frame*
    (incf (cadr cursor-locn) x)
    (incf (car cursor-locn) y)
    (print cursor-locn *terminal-io*)))

;;;≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅
;;;adding and removing≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅
;;;≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅

(define-map-editor-command
    (add-row :menu addrem :name t)
    ()
  "Adds a new row at row with one cell with cursor1 in it."
  (with-slots
	(table-list cursor-locn cur1)
      *application-frame*
    (multiple-value-bind
	  (row col)
	(apply 'values cursor-locn)
      (cond
	((zerop row)
	 (setf table-list
	       (nconc (list (list (list cur1)))
		      table-list)))
	(t 
	 (let ((rest
		 (nthcdr row table-list)))
	   (setf
	    (cdr (nthcdr (1- row) table-list))
	    (nconc (list (list (list cur1))) rest))))))))

(define-map-editor-command
    (add-cell :menu addrem :name t)
    ()
  "adds a new cell to current row, cell with cursor 1 in it"
  (with-slots
	(table-list cursor-locn cur1)
      *application-frame*
    (multiple-value-bind
	  (row col)
	(apply 'values cursor-locn)
      (cond
	((zerop col)
	 (push (list cur1) (nth row table-list)))
	(t 
	 (let ((rest
		 (nthcdr col (nth row table-list))))
	   (setf
	    (cdr (nthcdr (1- col) (nth row table-list)))
	    (nconc (list (list cur1)) rest))))))))

(define-map-editor-command
    (rem-cell :menu addrem :name t)
    ()
  "removes cell at current row, col"
  (with-slots
	(table-list cursor-locn)
      *application-frame*
    (multiple-value-bind
	  (row col)
	(apply 'values cursor-locn)
      (cond
	((zerop col)
	 (pop (nth row table-list)))
	(t 
	 (pop (cdr (nthcdr (1- col)
			   (nth row table-list)))))))))

(define-map-editor-command
    (rem-row :menu addrem :name t)
    ()
  "remove row at current row"
  (with-slots
	(table-list cursor-locn)
      *application-frame*
    (multiple-value-bind
	  (row)
	(apply 'values cursor-locn)
      (cond
	((zerop row)
	 (pop table-list))
	(t 
	 (pop (cdr (nthcdr (1- row) table-list))))))))

;;;≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅
;;;LOGGING≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅
;;;≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅≅

(define-map-editor-command
    (log-map :menu log :name t)
    ()
  "logs the current map to *terminal-io*"
  (with-slots
	(table-list cursor-locn)
      *application-frame*
    (format
     *terminal-io*
     "~{~{~s~^	~}~^~%~}"
     table-list)))
  


  



#|
;; nconc c
'(((1) (2)) ((3) (4)))
(make-application-frame 'map-editor :table-list *)
(run-frame-top-level *)
(with-slots (table-list) ** (mapc 'print table-list) nil)

((1 C) (2)) 
((3) (4)) 

;; jump 0 0, l, nconc c

((1) (2 C)) 
((3) (4))

;; jump 0 0, push cell

(NIL (1) (2)) 
((3) (4))

;; jump 0 0, l, push cell

((1) NIL (2)) 
((3) (4))

;; jump 0 0, concrow
'(((1) (2)) ((3) (4)))
(make-application-frame 'map-editor :table-list *)
(run-frame-top-level *)
(with-slots (table-list) ** (mapc 'print table-list) nil)

((NIL)) 
((1) (2)) 
((3) (4))

;; jump 0 0, j, concrow

((1) (2)) 
((NIL)) 
((3) (4))
|#