From 025637129175285e3bd6acf3537a95f39083eb68 Mon Sep 17 00:00:00 2001
From: demattia <demattia>
Date: Mon, 13 Sep 2004 08:24:42 +0000
Subject: [PATCH] *** empty log message ***

---
 scheme/nui-engine.scm | 528 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 528 insertions(+)
 create mode 100644 scheme/nui-engine.scm

diff --git a/scheme/nui-engine.scm b/scheme/nui-engine.scm
new file mode 100644
index 0000000..956265d
--- /dev/null
+++ b/scheme/nui-engine.scm
@@ -0,0 +1,528 @@
+;; ,load /home/demattia/studium/studienarbeit/scsh-ncurses/scheme/scsh-nui-engine.scm
+
+
+;;*************************************************************************
+;;Zustand
+
+;;Zustand des oberen Fensters (Command-Window)
+;;---------------------------
+
+;;Text
+(define text-command (list "Welcome in the scsh-ncurses-ui!" ""))
+
+;;gibt an, in welcher Zeile der gesamten Command-History man sich befindet
+(define pos-command 2)
+;;in welcher Spalte
+(define pos-command-col 2)
+
+;;gibt an, in welcher Zeile des Buffers nach Zeilenumbruch man sich befindet.
+(define pos-command-fin-ln 2)
+
+;;gibt an, in welcher Zeile des Buffers man sich befindet
+(define command-buffer-pos-y 2)
+;;gibt an, an welcher Position des Buffers man sich befindet.
+(define command-buffer-pos-x 2)
+
+;;Anzahl der Zeilen des Commando-Buffers
+(define command-lines 0)
+
+;;Anzahl der Spalten des Commando-Buffers
+(define command-cols 0)
+
+;;befindet sich der cursor am Ende der letzten Zeile des command-wins?
+(define can-write-command #t)
+
+
+;;Zustand des unteren Fensters (Result-Window)
+;;----------------------------
+
+;;Text
+(define text-result (list "Start entering commands."
+			  "Ctrl-h for help."))
+
+;;gibt an, in welcher Zeile des Result-Buffers man sich befindet
+(define pos-result 2)
+;;in welcher Spalte
+(define pos-result-col 17)
+
+;;gibt an, in welcher Zeile des Buffers man sich befindet
+(define result-buffer-pos-y 2)
+;;gibt an, an welcher Position des Buffers man sich befindet.
+(define result-buffer-pos-x 2)
+
+;;Anzahl der Zeilen des Buffers
+(define result-lines 0)
+;;Anzahl der Spalten des Buffers
+(define result-cols 0)
+
+  
+
+;;allgemeiner Zustand
+;;-------------------
+
+;;entweder 1...oben oder 2...unten
+(define active-buffer 1)
+
+
+;;*************************************************************************
+;;Verhalten
+      
+;;Eingabe verarbeiten
+(define run
+  (lambda ()
+    (let loop ((ch (paint)))
+      (cond
+       
+       ;;Beenden
+       ((= ch key-f1)
+	#t)
+
+       ;;Enter
+       ((= ch 10)
+	(if (= active-buffer 1)
+	    (begin
+	      (execute-command)
+	      (loop (paint)))
+	    (loop (paint))))
+
+       ;;Backspace
+       ((= ch key-backspace)
+	(if (= active-buffer 1)
+	    (if can-write-command
+		(if (< pos-command-col 3)
+		    (loop (paint))
+		    (begin
+		      (remove-from-command-buffer)
+		      (set! pos-command-col (- pos-command-col 1))
+		      (loop (paint))))
+		(loop (paint)))
+	    (loop (paint))))
+
+       ;;Navigieren
+       ((= ch key-up)
+	(if (= active-buffer 1)
+	    (if (< pos-command-fin-ln 2)
+		(loop (paint))
+		(let ((length-prev-line
+		       (string-length
+			(list-ref text-command (- pos-command 2)))))
+		(begin
+		  (set! can-write-command #f)
+		  (set! pos-command (- pos-command 1))
+		  (set! pos-command-col (+ length-prev-line 2))
+		  (loop (paint)))))
+	    (if (< pos-result 2)
+		(loop (paint))
+		(let ((length-prev-line
+		       (string-length
+			(list-ref text-result (- pos-result 2)))))
+		  (begin
+		    (set! pos-result (- pos-result 1))
+		    (set! pos-result-col (+ length-prev-line 1))
+		    (loop (paint)))))))
+
+       ((= ch key-down)
+	(if (= active-buffer 1)
+	    (let ((last-pos (length text-command)))
+	      (if (>= pos-command last-pos)
+		  (loop (paint))
+		  (let ((length-next-line 
+			 (string-length 
+			  (list-ref text-command pos-command))))
+		  (begin
+		    (set! pos-command-col (+ length-next-line 2))
+		    (set! pos-command (+ pos-command 1))
+		    (if (= pos-command last-pos)
+			(set! can-write-command #t))
+		    (loop (paint))))))
+	    (let ((last-pos (length text-result)))
+	      (if (>= pos-result last-pos)
+		  (loop (paint))
+		  (let ((length-next-line 
+			 (string-length 
+			  (list-ref text-result pos-result))))
+		    (begin
+		    (set! pos-result-col (+ length-next-line 1))
+		    (set! pos-result (+ pos-result 1))
+		    (loop (paint))))))))
+
+       ((= ch key-left)
+	(if (= active-buffer 1)
+	    (if (<= pos-command-col 2)
+		(loop (paint))
+		(begin
+		  (set! pos-command-col (- pos-command-col 1))
+		  (loop (paint))))
+	    (if (<= pos-result-col 1)
+		(loop (paint))
+		(begin
+		  (set! pos-result-col (- pos-result-col 1))
+		  (loop (paint))))))
+
+       ((= ch key-right)
+	(if (= active-buffer 1)
+	    (let ((line-length (string-length 
+				(list-ref text-command (- pos-command 1)))))
+	      (if (>= pos-command-col (+ line-length 2))
+		  (loop (paint))
+		  (begin
+		    (set! pos-command-col (+ pos-command-col 1))
+		    (loop (paint)))))
+	    (let ((line-length (string-length 
+				(list-ref text-result (- pos-result 1)))))
+	      (if (>= pos-result-col (+ line-length 1))
+		  (loop (paint))
+		  (begin
+		    (set! pos-result-col (+ pos-result-col 1))
+		    (loop (paint)))))))
+       
+       ;;Ctrl+b -> Buffer wechseln
+       ((= ch 2)
+	(begin
+	  (if (= active-buffer 1)
+	      (set! active-buffer 2)
+	      (set! active-buffer 1))
+	  (loop (paint))))
+       
+
+       ;;Ctrl+a -> Zeilenanfang
+       ((= ch 1)
+	(if (= active-buffer 1)
+	    (begin
+	      (set! command-buffer-pos-x 2)
+	      (loop (paint)))))
+
+       ;;Ctrl-e -> Zeilenende
+       ((= ch 5)
+	(if (= active-buffer 1)
+	    (let ((line-length (string-length 
+				(list-ref text-command (- pos-command 1)))))
+	      (begin
+		(set! command-buffer-pos-x (+ line-length 2))
+		(loop (paint))))))
+       
+       (else 
+	(if (= active-buffer 1)
+	    (if (<= ch 255)
+		(if can-write-command
+		    (begin
+		      (add-to-command-buffer ch)
+		      (loop (paint)))
+		    (loop (paint)))
+		(loop (paint)))))))))
+       
+
+;;darstellen und auf Eingabe warten
+(define paint
+  (lambda ()
+  (begin
+    (init-screen)
+    (cbreak)
+    (let* ((bar1-y 0)
+	   (bar1-x 0)
+	   (bar1-h 3)
+	   (bar1-w (COLS))
+	   (bar2-y (round (/ (LINES) 3)))
+	   (bar2-x 0)
+	   (bar2-h 3)
+	   (bar2-w (COLS))
+	   (comwin-y 3)
+	   (comwin-x 0)
+	   (comwin-h (- bar2-y 3))
+	   (comwin-w (COLS))
+	   (reswin-y (+ bar2-y 3))
+	   (reswin-x 0)
+	   (reswin-h (- (- (- (LINES) 6) comwin-h) 3))
+	   (reswin-w (COLS))
+	   (bar3-y (+ reswin-y reswin-h))
+	   (bar3-x 0)
+	   (bar3-h 3)
+	   (bar3-w (COLS)))
+      (let ((bar1 (newwin bar1-h bar1-w bar1-y bar1-x))
+	    (bar2 (newwin bar2-h bar2-w bar2-y bar2-x))
+	    (command-win (newwin  comwin-h comwin-w comwin-y comwin-x))
+	    (result-win (newwin reswin-h reswin-w reswin-y reswin-x))
+	    (bar3 (newwin bar3-h bar3-w bar3-y bar3-x)))
+	(box bar1 (ascii->char 0) (ascii->char 0))
+	(mvwaddstr bar1  1 1 "Command")
+	(wrefresh bar1)
+	(box bar2 (ascii->char 0) (ascii->char 0))
+	(mvwaddstr bar2  1 1 "Result")
+	(wrefresh bar2)
+	(box command-win (ascii->char 0) (ascii->char 0))
+	(set! command-lines (- comwin-h 2))
+	(set! command-cols (- comwin-w 3))
+	(print-command-buffer command-win)
+	(wrefresh command-win)
+	(box result-win (ascii->char 0) (ascii->char 0))
+	(set! result-lines (- reswin-h 2))
+	(set! result-cols (- reswin-w 3))
+	(print-result-buffer result-win)
+	(wrefresh result-win)
+	(box bar3 (ascii->char 0) (ascii->char 0))
+	(wattron bar3 (A-REVERSE))
+	(mvwaddstr bar3 1 1 "F1:Exit | Ctrl+b:Switch-Buffer")
+	(wstandend bar3)
+	(wrefresh bar3)
+	(cursor-right-pos command-win result-win comwin-h reswin-h)
+	(noecho)
+	(keypad bar1 #t)
+	(let ((ch (wgetch bar1)))
+	  (wclear bar1) 
+	  (wclear bar2)
+	  (wclear command-win)
+	  (wclear result-win)
+	  (wclear bar3)
+	  (clear)
+	  (endwin)
+	  (echo)
+	  ch
+	))))))
+
+;;Eingabe wurde durch Benutzer bestätigt -> Kommando ausfuehren
+(define execute-command
+  (lambda ()
+    (let ((command (list-ref text-command (- (length text-command) 1))))
+      ;(command)
+      ;(set! text-command (append text-command (list "unknown command")))
+      (layout-result command result-cols)
+      (set! text-command (append text-command (list "")))
+      (scroll-command-buffer))))
+
+;;Nach einer Eingabe kann es sein, dass die aktive Buffer_Zeile verschoben 
+;;werden muss.
+(define scroll-command-buffer
+  (lambda ()
+    (begin
+      (set! pos-command (+ pos-command 1))
+      (set! pos-command-col 2))))
+
+
+;;Der Benutzer muss sich darum kümmern, dass das Ergebnis sinnvoll
+;;dargestellt wird.
+(define layout-result
+  (lambda (command width)
+    ;;standard
+    (begin
+      (let ((com (if (> (string-length command) (- width 22)) 
+		     (string-append (substring command 0 (- width 22)) "...")
+		     command)))
+	(set! text-result (cons (string-append "command unknown: " com) '()))
+	(set! pos-result-col (+ 18 (string-length com)))
+	(set! pos-result 1)))))
+
+
+;;Ein Character zur letzten Zeile des Command-Buffers hinzufügen
+(define add-to-command-buffer
+  (lambda (ch)
+	(let* ((last-pos (- (length text-command) 1))
+	       (old-last-el (list-ref text-command last-pos))
+	       (old-rest (sublist text-command 0 last-pos))
+	       (before-ch (substring old-last-el 0 
+				     (max 0 (- pos-command-col 2))))
+	       (after-ch (substring old-last-el 
+				    (max 0 (- pos-command-col 2))
+				    (string-length old-last-el)))
+	       (new-last-el (string-append  before-ch
+					    (string (ascii->char ch))
+					   after-ch)))
+      (set! text-command (append old-rest (list new-last-el)))
+      (set! pos-command-col (+ pos-command-col 1)))))
+
+;;Ein Character aus der letzten Zeile entfernen (backspace)
+(define remove-from-command-buffer
+  (lambda ()
+    (let* ((last-pos (- (length text-command) 1))
+	   (old-last-el (list-ref text-command last-pos))
+	   (old-rest (sublist text-command 0 last-pos))
+	   (before-ch (substring old-last-el 0 
+				 (max 0 (- pos-command-col 3))))
+	   (after-ch (if (= pos-command-col 
+			       (+ (string-length old-last-el) 2))
+			 ""
+			 (substring old-last-el 
+				(max 0 (- pos-command-col 2))
+				(string-length old-last-el))))
+	   (new-last-el (if (= pos-command-col 
+			       (+ (string-length old-last-el) 2))
+			    before-ch
+			    (string-append  before-ch after-ch))))
+      (set! text-command (append old-rest (list new-last-el))))))
+	   
+	   
+
+;;Es wird der sichtbare Teil der bisherigen Eingaben in den Command-
+;;Buffer angezeigt.
+(define print-command-buffer
+  (lambda (comwin)
+    (let ((lines (get-right-command-lines)))
+      (let loop ((pos 1))
+	(if (> pos command-lines)
+	    values
+	    (let ((line (list-ref lines (- pos 1))))
+	      (begin
+		(mvwaddstr comwin pos 1 line)
+		(wrefresh comwin)
+		(loop (+ pos 1)))))))))
+
+
+;;Anzeigen des sichtbaren Teils des Result-Buffers
+(define print-result-buffer
+  (lambda (reswin)
+    (let ((lines (get-right-result-lines)))
+      (let loop ((pos 1))
+	(if (> pos result-lines)
+	    values
+	    (let ((line (list-ref lines (- pos 1))))
+	      (begin
+		(mvwaddstr reswin pos 1 line)
+		(wrefresh reswin)
+		(loop (+ pos 1)))))))))
+
+
+;;Es werden die anzuzeigenden Zeilen erzeugt.
+;;nötig, damit auch Befehle über mehrere Zeilen möglich sind:
+(define get-right-command-lines
+  (lambda ()
+    (let* ((all-lines-seperated (all-commands-seperated text-command))
+	   (num-all-lines (length all-lines-seperated)))
+      (if (>= pos-command-fin-ln command-lines)
+	  ;;aktive Zeile ist die unterste
+	  (sublist all-lines-seperated 
+		   (- pos-command-fin-ln command-lines) 
+		   command-lines)
+	  (if (<= num-all-lines command-lines)
+	      ;;noch keine ganze Seite im Buffer
+	      (prepare-lines all-lines-seperated 
+			     command-lines (- pos-command-fin-ln 1))
+	      ;;scrollen auf der ersten Seite
+	      (sublist all-lines-seperated 0 command-lines))))))
+
+;;anzuzeigende Zeilen im Result-Buffer
+(define get-right-result-lines
+  (lambda ()
+    (prepare-lines text-result result-lines pos-result)))
+	  
+
+;;Ein Statement wird in Stücke zerlegt, so dass dann jedes Stück in eine
+;;Zeile passt.
+(define seperate-line
+  (lambda (line width)
+    (let loop ((new '())
+	       (old line))
+      (if (> width (string-length old))
+	  (if (= 0 (string-length old))
+	      (if (equal? new '())
+		  (add-prompts '(""))
+		  (add-prompts  new))
+	      ;new
+	      (add-prompts (append (list old) new)))
+	      ;(append (list old) new))
+	  (let ((next-line (substring old 0 width))
+		(rest-old (substring old width (string-length old))))
+	    (loop (cons next-line new) rest-old))))))
+
+
+
+
+;;alle Statements zerlegen
+(define all-commands-seperated
+  (lambda (commands)
+    (let loop ((act-pos 1)
+	       (new '()))
+      (begin
+	(if (= act-pos pos-command)
+	    (let* ((length-new (length new))
+		   (first-el-old (list-ref commands (- act-pos 1)))
+		   (seperated-act (seperate-line first-el-old command-cols))
+		   (length-act (length seperated-act)))
+	      (set! pos-command-fin-ln (+ length-new length-act))))
+	
+	(if (> act-pos (length commands))
+	    (reverse new)
+	    (let* ((first-el-old (list-ref commands (- act-pos 1)))
+		   (seperated-fst-el-old 
+		    (seperate-line first-el-old command-cols)))
+	      (loop (+ act-pos 1) (append seperated-fst-el-old new))))))))
+
+
+;;> hinzufügen
+(define add-prompts
+  (lambda (l)
+     (let* ((lr (reverse l))
+	    (old-first-el (list-ref lr 0))
+	    (new-first-el (string-append ">" old-first-el))
+	    (old-rest (list-tail lr 1)))
+      (let loop ((old old-rest)
+		 (new (list new-first-el)))
+	(if (> (length old) 0)
+	    (let* ((old-first-el (list-ref old 0))
+		   (new-first-el (string-append " " old-first-el)))
+	      (loop (list-tail old 1) (append new (list new-first-el))))
+	    (reverse new))))))
+
+
+
+;;Cursor an die richtige Stelle bewegen:
+(define cursor-right-pos
+  (lambda (comwin reswin comwin-h reswin-h)
+    (begin
+      (compute-y-x)
+      (if (= active-buffer 1)
+	  (begin
+	    (wmove comwin command-buffer-pos-y command-buffer-pos-x)
+	    (wrefresh comwin))
+	  (begin
+	    (wmove reswin result-buffer-pos-y result-buffer-pos-x)
+	    (wrefresh reswin))))))
+
+
+;;pos-y und pos-x berechnen
+(define compute-y-x
+  (lambda ()
+    (if (= active-buffer 1)
+	(begin
+	  ;;zuerst mal y 
+	  (if (>= pos-command-fin-ln command-lines)
+	      ;;unterste Zeile
+	      (set! command-buffer-pos-y command-lines)
+	      ;;sonst
+	      (set! command-buffer-pos-y pos-command-fin-ln))
+	  ;;jetzt x
+	  (let ((posx (modulo pos-command-col command-cols)))
+	    (set! command-buffer-pos-x posx)))
+	(begin
+	  ;;zuerst y
+	  (if (>= pos-result result-lines)
+	      (set! result-buffer-pos-y result-lines)
+	      (set! result-buffer-pos-y pos-result))
+	  (set! result-buffer-pos-x pos-result-col)))))
+
+
+;;Es wird in einer Liste der zu druckende Berecih ausgewählt:
+(define prepare-lines
+  (lambda (l height pos)
+    (if (< (length l) height)
+	;; Liste zu kurz -> ""s hinzufügen
+	(let loop ((tmp-list l))
+	  (if (= height (length tmp-list))
+	      tmp-list
+	      (loop (append tmp-list (list "")))))
+	;; Teilliste holen
+	(if (<  pos height)
+	    ;;pos nicht ganz unten
+	    (sublist l 0 height)
+	    ;;standard-Fall 
+	    (sublist l (- pos height) height)))))
+
+;;Teilliste
+(define sublist
+  (lambda (l pos k)
+    (let ((tmp (list-tail l pos)))
+      (reverse (list-tail (reverse tmp) 
+			  (- (length tmp) k))))))
+
+
+   
+(run)
+ 
\ No newline at end of file