Add Christoph Hetz's all new, all singing, and all dancing input fields
This commit is contained in:
parent
54e9e1cee4
commit
445317ca90
|
@ -0,0 +1,171 @@
|
||||||
|
|
||||||
|
Input-fields
|
||||||
|
============
|
||||||
|
|
||||||
|
1. Erstellen und installieren
|
||||||
|
-----------------------------
|
||||||
|
|
||||||
|
(make-input-field x-dim y-dim) -> <input-field>
|
||||||
|
|
||||||
|
erstellt ein Input-field mit x-dim Spalten und y-dim Zeilen.
|
||||||
|
Make-input-field können weitere optinale Parameter übergeben
|
||||||
|
werden:
|
||||||
|
|
||||||
|
(make-input-field x-dim y-dim
|
||||||
|
[default-text
|
||||||
|
[behavior
|
||||||
|
[insert-active
|
||||||
|
[x-scroll-enabled
|
||||||
|
[y-scroll-enabled]]]]])
|
||||||
|
|
||||||
|
default-text: ist ein String, der am Anfang und nach einem Reset (s.u.)
|
||||||
|
der Inhalt des Input-fields ist.
|
||||||
|
(Default: "")
|
||||||
|
behavior: ist eine Liste von Paaren. Der car eines solchen Paares
|
||||||
|
ist die Nummer eines Zeichens oder einer Tastenkombination,
|
||||||
|
wie sie von wgetch (aus ncurses) zurückgegeben werden.
|
||||||
|
Der cdr des Paares ist ein Symbol, das eine Nachricht an ein
|
||||||
|
Input-field darstellt, so würde ein Input-field, das mit dem
|
||||||
|
Behvior
|
||||||
|
(list (cons 27
|
||||||
|
'clear))
|
||||||
|
erzeugt worden ist beim drücken der ESC-Taste seinen Inhalt
|
||||||
|
löschen.Es stehen zwei Standardlisten zu Verfügung:
|
||||||
|
standard-behavior und standard-behavior-pro (s.u.).
|
||||||
|
(Default: standard-behavior)
|
||||||
|
insert-active: ist ein Boolean und gibt an ob das sich das Input-field am
|
||||||
|
Anfang im Insert- oder im Overwrite-Modus befindet.
|
||||||
|
(Default: #t)
|
||||||
|
x-scroll-enabled: ist ein Boolean und gibt an ob horizontales Scrollen
|
||||||
|
erlaubt ist.
|
||||||
|
(Default #f)
|
||||||
|
y-scroll-enabled: ist ein Boolean und gibt an, ob vertikales Scrollen erlaubt ist.
|
||||||
|
(Default #f)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(install-input-field input-field
|
||||||
|
window
|
||||||
|
x-loc y-loc)
|
||||||
|
Ordnet das Input-field input-field dem (ncurses-)Fenter window zu und
|
||||||
|
platziert es mit der linken oberen Ecke in der Spalte x-loc und der
|
||||||
|
Zeile y-loc.
|
||||||
|
Will man das Input-field später nicht direkt verwenden, sondern nur
|
||||||
|
über cursor-over-input-field? (s.u.) so kann man es auch mittels
|
||||||
|
make&install-input-field auf einmal erzeugen und installieren:
|
||||||
|
|
||||||
|
(make&install-input-field window
|
||||||
|
x-loc y-loc
|
||||||
|
x-dim y-dim
|
||||||
|
[...])
|
||||||
|
|
||||||
|
|
||||||
|
2. Typpredikat und Feldselektoren
|
||||||
|
----------------------------------
|
||||||
|
|
||||||
|
Input-fields exportirt außerdem ein Typpredikat:
|
||||||
|
input-field?
|
||||||
|
und die folgenden Selektoren
|
||||||
|
input-field-default-text: default-text
|
||||||
|
input-field-text: der aktuelle Inhalt des Input-fields
|
||||||
|
als String
|
||||||
|
input-field-x-location: x-loc
|
||||||
|
input-field-y-location: y-loc
|
||||||
|
input-field-x-size: x-dim
|
||||||
|
input-field-y-size: y-dim
|
||||||
|
input-field-x-scroll: x-scroll-enabled
|
||||||
|
input-field-y-scroll: y-scroll-enabled
|
||||||
|
input-field-line: die Zeile, in der der Cursor steht
|
||||||
|
input-field-column: die Spalte, in der der Cursor steht
|
||||||
|
input-field-insert: insert-active
|
||||||
|
|
||||||
|
|
||||||
|
3. Bahaviors
|
||||||
|
----------------------
|
||||||
|
|
||||||
|
standard-behavior führt die folgenden Bindungen ein:
|
||||||
|
Pfeil-Hoch : Cursor um eine Zeile nach oben bewegen.
|
||||||
|
Pfeil-Runter: Cursor um eine Zeile nach unten bewegen.
|
||||||
|
Pfeil-links: Cursor nach links bewegen.
|
||||||
|
Pfeil-Rechts: Cursor nach rechts bewegen.
|
||||||
|
Home: An den Anfang der Zeile springen.
|
||||||
|
End: Ans Ende der Zeile springen.
|
||||||
|
Backspace: Zeichen vor dem Cursor löschen.
|
||||||
|
Delete: Zeichen unter dem Cursor löschen
|
||||||
|
|
||||||
|
standard-behavior-pro erweitert standard-behavior um die
|
||||||
|
folgenden Bindungen:
|
||||||
|
C-p: Cursor um eine Zeile nach oben bewegen.
|
||||||
|
C-n: Cursor um eine Zeile nach unten bewegen.
|
||||||
|
C-b: Cursor nach links bewegen.
|
||||||
|
C-f: Cursor nach rechts bewegen.
|
||||||
|
C-a: An den Anfang der Zeile springen.
|
||||||
|
C-e: Ans Ende der Zeile springen.
|
||||||
|
C-d: Zeichen unter dem Cursor löschen.
|
||||||
|
C-k: alles rechts vom Cursor löschen.
|
||||||
|
|
||||||
|
die folgenden (hoffentlich) selbsterklärenden Symbole stehen
|
||||||
|
zum Erstellen von Behaviors zu verfügung:
|
||||||
|
|
||||||
|
'move-prev-line
|
||||||
|
'move-next-line
|
||||||
|
'move-left
|
||||||
|
'move-right
|
||||||
|
|
||||||
|
'move-forawrd - wie move-right, springt aber nach Ende der Zeile
|
||||||
|
auf den Anfang der Nächsten.
|
||||||
|
'move-backward - equivalent zu 'move-forward
|
||||||
|
|
||||||
|
'goto-begin-of-line
|
||||||
|
'goto-end-of-line
|
||||||
|
'goto-begin-of-first-line
|
||||||
|
'goto-begin-of-last-line
|
||||||
|
'goto-begin-of-word-forward
|
||||||
|
'goto-begin-of-word-backward
|
||||||
|
|
||||||
|
'delete-left
|
||||||
|
'delete-right
|
||||||
|
'delete-all-left
|
||||||
|
'delete-all-right
|
||||||
|
'delete-line
|
||||||
|
|
||||||
|
'restore: Synchronisiert inrterne Daten mit externer Darstellung
|
||||||
|
und Zeichent das Input-field neu.
|
||||||
|
(war bisher nicht nötig, aber sobald Sonderzeichen erlaubt
|
||||||
|
sind.... ;-)
|
||||||
|
|
||||||
|
Außerdem zeichnet die Funktion
|
||||||
|
(input-field-refresh input-field)
|
||||||
|
das Input-field neu.
|
||||||
|
|
||||||
|
4. Cursor-over-inputfield? und send-input-field
|
||||||
|
-----------------------------------------------
|
||||||
|
|
||||||
|
(cursor-over-input-field? window) -> #f | input-field
|
||||||
|
liefert, wenn der Cursor im Fenster window über einem zuvor installiertem
|
||||||
|
Input-field steht, dieses Input-field zurück, ansonsten #f.
|
||||||
|
|
||||||
|
(send-input-field input-field integer) -> (values boolean boolean)
|
||||||
|
übergibt dem Input-field input-field die Zahl integer. Das Input-field
|
||||||
|
schaut zuerst, ob es sich um eine im Behavior gebundene Zahl handelt und
|
||||||
|
führt, falls dies der Fall ist die entsprechende Aktion aus. Falls integer
|
||||||
|
nicht im Behavior gebunden ist überprüft das Input-field ob es sich um einen
|
||||||
|
gültigen zum Einfügen gültigen Ascii-code (32-126) handelt und fügt das
|
||||||
|
entsprechende Zeichen gegebenenfalls an der aktuellen Cursorposition ein.
|
||||||
|
|
||||||
|
|
||||||
|
5. Position, Größe, Scrolleigenschaften nachträglich verändern
|
||||||
|
--------------------------------------------------------------
|
||||||
|
|
||||||
|
;; TODOOO
|
||||||
|
|
||||||
|
hierzu stehen folgende Funktionen zur Verfügung:
|
||||||
|
|
||||||
|
(input-field-reset input-field) - stellt den default-text wieder her
|
||||||
|
(input-field-clear input-field) - löscht den Inhalt
|
||||||
|
(input-field-move input-field x-loc y-loc) - setzt die linke, obere Ecke auf (x-loc y-loc)
|
||||||
|
(input-field-resize input-field x-dim y-dim) - setzt ...
|
||||||
|
(input-field-toggle-x-scroll input-field)
|
||||||
|
(input-field-toggle-y-scroll input-field)
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,217 @@
|
||||||
|
(define NULL (ascii->char 0))
|
||||||
|
|
||||||
|
(define demo
|
||||||
|
(lambda ()
|
||||||
|
(let ((win (init-screen)))
|
||||||
|
(keypad win #t)
|
||||||
|
(noecho)
|
||||||
|
|
||||||
|
(make&install-input-field win
|
||||||
|
20 10
|
||||||
|
42 23
|
||||||
|
"
|
||||||
|
+----------------------------------+
|
||||||
|
| f1 : move left input-field |
|
||||||
|
| f2 : move right input-field |
|
||||||
|
| f3 : move up input-field |
|
||||||
|
| f4 : move down input-field |
|
||||||
|
| |
|
||||||
|
| f5 : make bigger in x direction |
|
||||||
|
| f6 : make smaler in x direction |
|
||||||
|
| f7 : make bigger in y direction |
|
||||||
|
| f8 : make smaler in y direction |
|
||||||
|
| |
|
||||||
|
| f9 : toggle x-scroll |
|
||||||
|
| f10 : toggle y-scroll |
|
||||||
|
| |
|
||||||
|
| f11 : clear |
|
||||||
|
| f12 : reset |
|
||||||
|
| |
|
||||||
|
| tab : toggle insert |
|
||||||
|
| |
|
||||||
|
| ESC : quit |
|
||||||
|
+----------------------------------+
|
||||||
|
|
||||||
|
0-0 0-1 0-2 0-3 0-4 0-5
|
||||||
|
1-0 1-1 1-2 1-3 1-4 1-5 1-6
|
||||||
|
2-0 2-1 2-2 2-3 2-4 2-5 2-6 2-7
|
||||||
|
3-0 3-1 3-2 3-3 3-4 3-5 3-6 3-7 3-8
|
||||||
|
4-0 4-1 4-2 4-3 4-4 4-5 4-6 4-7 4-8 4-9
|
||||||
|
5-0 5-1 5-2 5-3 5-4 5-5 5-6 5-7 5-8 4-9
|
||||||
|
6-0 6-1 6-2 6-3 6-4 6-5 6-6 6-7 6-8
|
||||||
|
7-0 7-1 7-2 7-3 7-4 7-5 7-6 7-7
|
||||||
|
8-0 8-1 8-2 8-3 8-4 8-5 8-6
|
||||||
|
9-0 9-1 9-2 9-3 9-4 9-5\n"
|
||||||
|
(append
|
||||||
|
(list (cons 9 ;; tab
|
||||||
|
'toggle-insert)
|
||||||
|
(cons key-ppage
|
||||||
|
'move-backward)
|
||||||
|
(cons key-npage
|
||||||
|
'move-forward))
|
||||||
|
standard-behavior-pro)
|
||||||
|
#t #t #t)
|
||||||
|
|
||||||
|
(wmove win 10 20)
|
||||||
|
(screen-refresh win)
|
||||||
|
|
||||||
|
(letrec ((else-loop (lambda (asc)
|
||||||
|
(let ((infl (cursor-over-input-field? win)))
|
||||||
|
(cond ((= asc 27)
|
||||||
|
(wclear win)
|
||||||
|
(clear)
|
||||||
|
(echo)
|
||||||
|
(endwin))
|
||||||
|
((= asc key-f1)
|
||||||
|
(input-field-move infl
|
||||||
|
(- (input-field-x-location infl)
|
||||||
|
1)
|
||||||
|
(input-field-y-location infl))
|
||||||
|
(screen-refresh win)
|
||||||
|
(loop (wgetch win)))
|
||||||
|
((= asc key-f2)
|
||||||
|
(input-field-move infl
|
||||||
|
(+ (input-field-x-location infl)
|
||||||
|
1)
|
||||||
|
(input-field-y-location infl))
|
||||||
|
(screen-refresh win)
|
||||||
|
(loop (wgetch win)))
|
||||||
|
((= asc key-f3)
|
||||||
|
(input-field-move infl
|
||||||
|
(input-field-x-location infl)
|
||||||
|
(- (input-field-y-location infl)
|
||||||
|
1))
|
||||||
|
(screen-refresh win)
|
||||||
|
(loop (wgetch win)))
|
||||||
|
((= asc key-f4)
|
||||||
|
(input-field-move infl
|
||||||
|
(input-field-x-location infl)
|
||||||
|
(+ (input-field-y-location infl)
|
||||||
|
1))
|
||||||
|
(screen-refresh win)
|
||||||
|
(loop (wgetch win)))
|
||||||
|
((= asc key-f5)
|
||||||
|
(input-field-resize infl
|
||||||
|
(+ (input-field-x-size infl)
|
||||||
|
1)
|
||||||
|
(input-field-y-size infl))
|
||||||
|
(screen-refresh win)
|
||||||
|
(loop (wgetch win)))
|
||||||
|
((= asc key-f6)
|
||||||
|
(input-field-resize infl
|
||||||
|
(- (input-field-x-size infl)
|
||||||
|
1)
|
||||||
|
(input-field-y-size infl))
|
||||||
|
(screen-refresh win)
|
||||||
|
(loop (wgetch win)))
|
||||||
|
((= asc key-f7)
|
||||||
|
(input-field-resize infl
|
||||||
|
(input-field-x-size infl)
|
||||||
|
(+ (input-field-y-size infl)
|
||||||
|
1))
|
||||||
|
(screen-refresh win)
|
||||||
|
(loop (wgetch win)))
|
||||||
|
((= asc key-f8)
|
||||||
|
(input-field-resize infl
|
||||||
|
(input-field-x-size infl)
|
||||||
|
(- (input-field-y-size infl)
|
||||||
|
1))
|
||||||
|
(screen-refresh win)
|
||||||
|
(loop (wgetch win)))
|
||||||
|
((= asc key-f9)
|
||||||
|
(input-field-toggle-x-scroll infl)
|
||||||
|
(wrefresh win)
|
||||||
|
(loop (wgetch win)))
|
||||||
|
((= asc key-f10)
|
||||||
|
(input-field-toggle-y-scroll infl)
|
||||||
|
(wrefresh win)
|
||||||
|
(loop (wgetch win)))
|
||||||
|
((= asc key-f11)
|
||||||
|
(input-field-clear infl)
|
||||||
|
(wrefresh win)
|
||||||
|
(loop (wgetch win)))
|
||||||
|
((= asc key-f12)
|
||||||
|
(input-field-reset infl)
|
||||||
|
(wrefresh win)
|
||||||
|
(loop (wgetch win)))
|
||||||
|
(else (loop (wgetch win)))))))
|
||||||
|
(loop (lambda (asc)
|
||||||
|
(cond ((cursor-over-input-field? win)
|
||||||
|
=> (lambda (infl)
|
||||||
|
(call-with-values
|
||||||
|
(lambda ()
|
||||||
|
(send-input-field infl asc))
|
||||||
|
(lambda (was-known is-changed)
|
||||||
|
(if is-changed
|
||||||
|
(begin
|
||||||
|
(wrefresh win)
|
||||||
|
(loop (wgetch win)))
|
||||||
|
(if was-known
|
||||||
|
(loop (wgetch win))
|
||||||
|
(else-loop asc)))))))))))
|
||||||
|
(loop (wgetch win))))))
|
||||||
|
|
||||||
|
|
||||||
|
(define screen-refresh
|
||||||
|
(lambda (screen)
|
||||||
|
(let ((infl (cursor-over-input-field? screen))
|
||||||
|
(x (getx screen))
|
||||||
|
(y (gety screen)))
|
||||||
|
(wclear screen)
|
||||||
|
(input-field-refresh infl)
|
||||||
|
(wdraw-box screen
|
||||||
|
(- (input-field-x-location infl) 1)
|
||||||
|
(- (input-field-y-location infl) 1)
|
||||||
|
(+ (input-field-x-size infl) 2)
|
||||||
|
(+ (input-field-y-size infl) 2))
|
||||||
|
(wmove screen y x)
|
||||||
|
(wrefresh screen))))
|
||||||
|
|
||||||
|
(define wdraw-box
|
||||||
|
(lambda (win x y dimx dimy)
|
||||||
|
(mvwaddstr win
|
||||||
|
y
|
||||||
|
x "+")
|
||||||
|
(mvwaddstr win
|
||||||
|
y
|
||||||
|
(+ dimx
|
||||||
|
(- x
|
||||||
|
1)) "+")
|
||||||
|
(mvwaddstr win
|
||||||
|
(+ dimy
|
||||||
|
(- y
|
||||||
|
1))
|
||||||
|
x "+")
|
||||||
|
(mvwaddstr win
|
||||||
|
(+ dimy
|
||||||
|
(- y
|
||||||
|
1))
|
||||||
|
(+ dimx
|
||||||
|
(- x
|
||||||
|
1)) "+")
|
||||||
|
(let loop-x ((dx (+ x 1)))
|
||||||
|
(if (= dx (+ x (- dimx 2)))
|
||||||
|
(begin
|
||||||
|
(mvwaddstr win y dx "-")
|
||||||
|
(mvwaddstr win (+ dimy
|
||||||
|
(- y
|
||||||
|
1)) dx "-"))
|
||||||
|
(begin
|
||||||
|
(mvwaddstr win y dx "-")
|
||||||
|
(mvwaddstr win (+ dimy
|
||||||
|
(- y
|
||||||
|
1)) dx "-")
|
||||||
|
(loop-x (+ dx 1)))))
|
||||||
|
(let loop-y ((dy (+ y 1)))
|
||||||
|
(if (= dy (+ y (- dimy 2)))
|
||||||
|
(begin
|
||||||
|
(mvwaddstr win dy x "|")
|
||||||
|
(mvwaddstr win dy (+ dimx
|
||||||
|
(- x
|
||||||
|
1)) "|"))
|
||||||
|
(begin
|
||||||
|
(mvwaddstr win dy x "|")
|
||||||
|
(mvwaddstr win dy (+ dimx
|
||||||
|
(- x
|
||||||
|
1)) "|")
|
||||||
|
(loop-y (+ dy 1)))))))
|
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue