Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Loading…

Update for wide-chars. Panel librairy and example added. #464

Merged
merged 8 commits into from

1 participant

Commits on Apr 4, 2013
  1. FEAT: Updated Curses binding and examples

    be-red authored
  2. FEAT: Test wchar functions

    be-red authored
  3. FEAT: Utf-8 works on linux. Check for windows

    be-red authored
Commits on Apr 7, 2013
  1. Merge branch 'master' into utf8

    be-red authored
  2. FEAT: Identify UTF8

    be-red authored
Commits on Apr 8, 2013
Commits on Apr 9, 2013
  1. FIX: compilation script rename. Doc updated.

    be-red authored
This page is out of date. Refresh to see the latest.
View
29 red-system/library/curses/README.md
@@ -1,46 +1,57 @@
Curses library for Red/System
------------------------
-This is a low level binding for Curses library.
+This is a low level binding for Curses and Panel libraries.
+
+Curses for Red/System now uses wide-characters library (libncursesw.so).
Requirements
------------
* **Linux**
- *libncurses 5.9* : avaliable with your favorite distro.
+ *libncursesw 5.9* : avaliable with your favorite distro.
+
+ *libpanelw 5.9* : avaliable with your favorite distro.
* **Windows**
- *pdcurses.dll* : [Public Domain Curses for windows](http://sourceforge.net/projects/pdcurses/files/), version 3.4 : [pdc34dllw.zip](http://sourceforge.net/projects/pdcurses/files/pdcurses/3.4/pdc34dllw.zip/download)
+ *pdcurses.dll* : [Public Domain Curses for windows](http://sourceforge.net/projects/pdcurses/files/), version 3.4 : [pdc34dllu.zip](http://sourceforge.net/projects/pdcurses/files/pdcurses/3.4/pdc34dllu.zip/download)
+
+ The panel library is include in PDCurses.
* **MacOSX**
Help needed to check the right library name, write `%curses-macosx.reds` (may be identical to `%curses-linux.reds`) and test.
-Running the Red/System curses-example
+Running the Red/System curses examples
------------------------
+1. This binding is provided with two examples for curses and panel libraries.
+
1. From the REBOL console type :
`change-dir %red-system`
`do/args %rsc.r "%library/curses/examples/curses-example.reds"`, the compilation process should finish with a `...output file size` message.
+ `do/args %rsc.r "%library/curses/examples/panel-example.reds"`, the compilation process should finish with a `...output file size` message.
+
1. From command line, use the REBOL compilation script :
`cd red-system/library/builds/curses/examples`
- `rebol -s compile-curses-example.r` Linux
+ `rebol -s compile-examples.r` Linux
or
- `rebol.exe -s compile-curses-example.r` Windows
+ `rebol.exe -s compile-examples.r` Windows
+ This script buid all examples included in this directory.
-1. The resulting binary is in `red-system/builds/`, go try it!
+1. The resulting binaries are in `red-system/builds/`, go try them!
- Linux users run `curses-example` from command line.
+ Linux users run `curses-example` or `panel-example` from command line.
- Windows users need to open a DOS console and run `curses-example.exe` from there.
+ Windows users need to open a DOS console and run `curses-example.exe` or `panel-example.exe` from there.
View
13 red-system/library/curses/curses-linux.reds
@@ -1,7 +1,8 @@
Red/System [
- Title: "Linux Curses binding constant"
+ Title: "Linux Red/System Curses binding constant"
Author: "Bruno Anselme"
EMail: "be.red@free.fr"
+ File: %curses-linux.reds
Rights: "Copyright (c) 2013 Bruno Anselme"
License: {
Distributed under the Boost Software License, Version 1.0.
@@ -150,4 +151,14 @@ Red/System [
KEY_EVENT: 019Bh ; We were interrupted by an event
KEY_MAX: 01FFh ; Maximum key value is 019Bh
+
+ ; Not included in Linux curses.h. Added manually with Windows constant names.
+ CTL_UP: 0236h ; ctl-up arrow
+ CTL_DOWN: 020Dh ; ctl-down arrow
+ CTL_LEFT: 0221h ; Control-Left-Arrow
+ CTL_RIGHT: 0230h
+ CTL_PGUP: 022Bh
+ CTL_PGDN: 0226h
+ CTL_HOME: 0217h
+ CTL_END: 0207h
]
View
5 red-system/library/curses/curses-win32.reds
@@ -1,7 +1,8 @@
Red/System [
- Title: "Windows Curses binding constant"
+ Title: "Windows Red/System Curses binding constant"
Author: "Bruno Anselme"
EMail: "be.red@free.fr"
+ File: %curses-win32.reds
Rights: "Copyright (c) 2013 Bruno Anselme"
License: {
Distributed under the Boost Software License, Version 1.0.
@@ -302,4 +303,4 @@ Red/System [
KEY_MIN: KEY_BREAK ; Minimum curses key value
KEY_MAX: KEY_SDOWN ; Maximum curses key
- ]
+ ]
View
154 red-system/library/curses/curses.reds
@@ -2,6 +2,7 @@ Red/System [
Title: "Red/System curses Binding"
Author: "Bruno Anselme"
EMail: "be.red@free.fr"
+ File: %curses.reds
Rights: "Copyright (c) 2013 Bruno Anselme"
License: {
Distributed under the Boost Software License, Version 1.0.
@@ -21,6 +22,23 @@ Red/System [
curses: context [
+ #define __LC_CTYPE 0
+ #define __LC_ALL 6
+ #import [
+ LIBC-file cdecl [
+ setlocale: "setlocale" [
+ category [integer!]
+ locale [c-string!]
+ return: [c-string!]
+ ]
+ find-str: "strstr" [ ; Return first occurence of target in src or null if not found
+ src [c-string!]
+ target [c-string!]
+ return: [c-string!]
+ ]
+ ]
+ ]
+
#define window! integer!
#define sysfile! integer!
@@ -30,12 +48,12 @@ curses: context [
#define curses-library "pdcurses.dll"
]
MacOSX [
- #include %curses-macosx.reds ; TODO: missing file, to be written with macosx curses.h
- #define curses-library "libncurses.5.dylib" ; TODO: check this
+ #include %curses-macosx.reds ; TODO: missing file, to be written with macosx curses.h
+ #define curses-library "libncursesw.5.dylib" ; TODO: check this
]
#default [
#include %curses-linux.reds
- #define curses-library "libncurses.so.5"
+ #define curses-library "libncursesw.so.5"
]
]
@@ -56,6 +74,10 @@ curses: context [
wid [window!]
return: [integer!]
]
+ wnoutrefresh: "wnoutrefresh" [ ; Mark window to be refreshed
+ wid [window!]
+ return: [integer!]
+ ]
doupdate: "doupdate" [ ; Update terminal.
return: [integer!]
]
@@ -80,15 +102,6 @@ curses: context [
echo-off: "noecho" [ ; Disable terminal echo.
return: [integer!]
]
- echochar: "echochar" [ ; Echo single-byte character and rendition to screen and refresh.
- ch [integer!]
- return: [integer!]
- ]
- wechochar: "wechochar" [ ; Echo single-byte character and rendition to a window and refresh.
- wid [window!]
- ch [integer!]
- return: [integer!]
- ]
; Window management
@@ -261,10 +274,6 @@ curses: context [
col [integer!]
return: [integer!]
]
- ungetch: "ungetch" [ ; Push a character onto the input queue.
- ch [integer!]
- return: [integer!]
- ]
getnstr: "getnstr" [ ; Get almost n bytes from input.
str [c-string!]
n [integer!]
@@ -337,7 +346,16 @@ curses: context [
; Print to screen
- addch: "addch" [ ; Put character from current cursor position inside stdscr.
+ echochar: "echochar" [ ; Echo wide-character and immediately refresh the screen.
+ ch [integer!]
+ return: [integer!]
+ ]
+ wechochar: "wechochar" [ ; Echo wide-character and immediately refresh the window.
+ wid [window!]
+ ch [integer!]
+ return: [integer!]
+ ]
+ addch: "addch" [ ; Put wide-character from current cursor position inside stdscr.
ch [integer!]
return: [integer!]
]
@@ -350,7 +368,7 @@ curses: context [
str [c-string!]
return: [integer!]
]
- waddch: "waddch" [ ; Put character from current cursor position into window.
+ waddch: "waddch" [ ; Put wide-character from current cursor position into window.
wid [window!]
ch [integer!]
return: [integer!]
@@ -545,6 +563,7 @@ curses: context [
return: [integer!]
]
wclrtoeol: "wclrtoeol" [ ; Erase the current line from the cursor to the end of the line inside the specified window
+ wid [window!]
return: [integer!]
]
clrtobot: "clrtobot" [ ; Clear all lines following the cursor.
@@ -911,6 +930,11 @@ curses: context [
isendwin: "isendwin" [ ; Determine whether a screen has been refreshed.
return: [logic!]
]
+ ripoffline: "ripoffline" [ ; Reserves a screen line for use by the application.
+ line [integer!]
+ init [integer!] ; pointer on init: function [ [cdecl] wid [integer!] cols [integer!]
+ return: [integer!]
+ ]
def-prog-mode: "def_prog_mode" [ ; Saves the current terminal modes as the "program" (in Curses) state for use by reset_prog_mode.
return: [integer!]
@@ -927,7 +951,22 @@ curses: context [
baudrate: "baudrate" [ ; Returns the output speed of the terminal in bits per second.
return: [integer!]
]
-
+ #switch OS [
+ Windows [
+ ungetch: "PDC_ungetch" [ ; Push a character onto the input queue.
+ ch [integer!]
+ return: [integer!]
+ ]
+ ]
+ MacOSX [
+ ]
+ #default [
+ ungetch: "ungetch" [ ; Push a character onto the input queue.
+ ch [integer!]
+ return: [integer!]
+ ]
+ ]
+ ] ; #switch OS
] ; cdecl
] ; #import [curses-library
@@ -951,59 +990,96 @@ curses: context [
return stdscr
]
- color-set: function [ ; Set terminal color pair
+ color-set: function [ "Set terminal color pair"
pair [integer!]
][
_color_set pair 0
]
- wcolor-set: function [ ; Set window color pair
+ wcolor-set: function [ "Set window color pair"
wid [window!]
pair [integer!]
][
_wcolor_set wid pair 0
]
- getch: function [ ; Wait for user input. Not avaliable on Windows, so redefined here
- return: [integer!]
+ getch: function [ "Wait for user input. Not avaliable on Windows, so redefined here"
+ return: [integer!]
][
return wgetch stdscr
]
- printw-attr: function [ ; printw surrounded by attribute on/off
+ printw-attr: function [ "printw surrounded by attribute on/off"
attr [integer!]
txt [c-string!]
- return: [integer!]
][
attron attr
printw [ txt ]
attroff attr
]
- wprintw-attr: function [ ; wprintw surrounded by attribute on/off
+ wprintw-attr: function [ "wprintw surrounded by attribute on/off"
wid [window!]
attr [integer!]
txt [c-string!]
- return: [integer!]
][
wattron wid attr
wprintw [ wid txt ]
wattroff wid attr
]
- color-pair: func [
- pair [integer!]
- return: [integer!]
+ mvwprintw-attr: function [ "wprintw surrounded by attribute on/off"
+ wid [window!]
+ row [integer!]
+ col [integer!]
+ attr [integer!]
+ txt [c-string!]
+ ][
+ wmove wid row col
+ wattron wid attr
+ wprintw [ wid txt ]
+ wattroff wid attr
+ ]
+ color-pair: function [
+ pair [integer!]
+ return: [integer!]
][
return (pair << PDC_COLOR_SHIFT) and A_COLOR
]
- pair-number: func [
- pair [integer!]
- return: [integer!]
+ pair-number: function [
+ pair [integer!]
+ return: [integer!]
][
return (pair and A_COLOR) >> PDC_COLOR_SHIFT
]
+ _top_line: 0 ; Pointer to top line window
+ _bottom_line: 0 ; Pointer to bottom line window
+ _top_cols: 0 ; Number of columns in top line window
+ _bottom_cols: 0 ; Number of columns in bottom line window
+
+ init-top-line: function [ "Callback function for ripoffline"
+ [cdecl]
+ wid [window!]
+ cols [integer!]
+; return: [int-ptr!]
+ ][
+ _top_line: wid
+ _top_cols: cols
+; return 0
+ ]
+
+ init-bottom-line: function [ "Callback function for ripoffline"
+ [cdecl]
+ wid [window!]
+ cols [integer!]
+; return: [int-ptr!]
+ ][
+ _bottom_line: wid
+ _bottom_cols: cols
+; return 0
+ ]
+
; Test interface --------------------------------------------------------------------
init-screen: func [
@@ -1030,5 +1106,17 @@ curses: context [
return scr
]
+ locale: ""
+ UTF-8: false
+ #switch OS [
+ Windows [
+ ]
+ #default [
+ locale: setlocale __LC_ALL "" ;@@ check if "utf8" is present in returned string?
+ if null <> find-str locale "UTF-8" [
+ UTF-8: true
+ ]
+ ]
+ ] ; #switch OS
] ; with curses
] ; context curses
View
27 .../library/curses/examples/compile-curses-example.r → ...system/library/curses/examples/compile-examples.r
@@ -1,8 +1,8 @@
REBOL [
- Title: "Compilation script for curses-example.reds"
+ Title: "Compilation script for Red/System examples"
Author: "Bruno Anselme"
EMail: "be.red@free.fr"
- File: %compile-curses-example.r
+ File: %compile-examples.r
Rights: "Copyright (c) 2013 Bruno Anselme"
License: {
Distributed under the Boost Software License, Version 1.0.
@@ -15,14 +15,21 @@ REBOL [
windows: all [(system/version/4 = 3) (system/version/5 = 1)]
-appname: "curses-example"
+compile: func [
+ appname [string!]
+][
+ print [ "------ Compiling" appname "------" ]
+ do/args %rsc.r rejoin [ wdir appname %.reds ]
+
+ either windows [
+ print rejoin [ "Destination file : ../../../builds/" appname ".exe" ]
+ ][
+ print rejoin [ "Destination file : ../../../builds/" appname ]
+ ]
+]
+
wdir: what-dir
change-dir %../../../ ; locate here your red-system directory
-print [ "------ Compiling" appname "------" ]
-do/args %rsc.r rejoin [ wdir %curses-example.reds ]
+compile "curses-example"
+compile "panel-example"
-either windows [
- print rejoin [ "Destination file : ../../builds/" appname ".exe" ]
-][
- print rejoin [ "Destination file : ../../../builds/" appname ]
-]
View
108 red-system/library/curses/examples/curses-example.reds
@@ -1,7 +1,8 @@
Red/System [
- Title: "curses example: display Red and curses information"
+ Title: "Curses example: display Red and curses information"
Author: "Bruno Anselme"
EMail: "be.red@free.fr"
+ File: %curses-example.reds
Rights: "Copyright (c) 2013 Bruno Anselme"
License: {
Distributed under the Boost Software License, Version 1.0.
@@ -134,6 +135,7 @@ with curses [
mvwprintw [ win 3 2 "Application : %s" system/args-list/item ]
mvwprintw [ win 4 2 "OS : %s" op-sys ]
mvwprintw [ win 5 2 "Screen size : %dx%d" getmaxx screen getmaxy screen ]
+ mvwprintw [ win 6 2 "UTF-8 : %s" either UTF-8 [ "true" ][ "false" ]]
win
]
;-------------------------------------
@@ -189,7 +191,7 @@ with curses [
wgetstr win str
echo-off
raw
- mvwprintw [ win 4 2 "You wrote : %s " str ]
+ mvwprintw [ win 5 2 "You wrote : %s " str ]
curs-set 0
win
]
@@ -213,15 +215,15 @@ with curses [
][
nb-rows: getmaxy screen
memcur: curs-set 0
- car: #"^(0)"
+ car: 0
either (key and FFFFFF00h) = 0 [
- car: as byte! (key and 0000007Fh )
+ car: key and 000000FFh
mvprintw [ (nb-rows - 2) 3
- "Character pressed (int-hex-char) : %4d - %02Xh - %c "
- as integer! car
- as integer! car
- (either (car >= #" ") [ car ][ #" " ])
+ "Character pressed (int-hex-char) : %4d - %02Xh - "
+ car
+ car
]
+ mvaddch (nb-rows - 2) 53 car
][
if key <> FFFFFFFFh [
mvprintw [ (nb-rows - 2) 3
@@ -235,7 +237,7 @@ with curses [
refresh
wrefresh win-demo
curs-set memcur
- return car
+ return as byte! car
]
;-------------------------------------
show-edit: func [ ; Create the test input window
@@ -255,7 +257,7 @@ with curses [
mvwprintw [ win-demo 5 2 "Input text anywhere" ]
mvwprintw [ win-demo 7 2 "Esc to quit Screen Editor" ]
wmove win-demo 1 2
- if op-num = 1 [ move (wy + 1) (wx + 2) ] ; Buggy Windows cursor management
+ if op-num = 1 [ move wy (wx + 2) ] ; Buggy Windows cursor management
curs-set 1
wrefresh win-demo
until [
@@ -274,11 +276,11 @@ with curses [
KEY_RIGHT [ wmove win-demo getcury win-demo ((getcurx win-demo) + 1) ]
default [
if ((key and A_ATTRIBUTES) = 0) [
- wprintw [ win-demo "%c" car ]
+ waddch win-demo as integer! car
]
]
]
- if op-num = 1 [ move (wy + getcury win-demo) (wx + getcurx win-demo) ] ; Buggy Windows cursor management
+ if op-num = 1 [ move (wy - 1 + getcury win-demo) (wx + getcurx win-demo) ] ; Buggy Windows cursor management
wrefresh win-demo
]
all [ ((key and A_ATTRIBUTES) = 0) (car = #"^(1B)") ]
@@ -289,6 +291,47 @@ with curses [
return 0
]
;-------------------------------------
+ draw-charset: func [
+ win [window!]
+ mask [integer!]
+ col [integer!]
+ /local car [integer!] row limit
+ ][
+ row: 3
+ wmove win row col
+ car: 32
+ either UTF-8 [ limit: 127 ][ limit: 255 ]
+ until [
+ waddch win (mask or car)
+ car: car + 1
+ if (car % 32) = 0 [
+ row: row + 1
+ wmove win row col
+ ]
+ car = limit
+ ]
+ ]
+;-------------------------------------
+ show-charset: func [ ; Create the characters window
+ return: [window!]
+ /local win
+ ][
+ win: newwin 18 67 1 1
+ wcolor-set win 6
+ box win 0 0
+ mvwprintw [ win 0 3 " Characters set " ]
+ mvwprintw [ win 1 10 "Normal charset" ]
+ draw-charset win A_NORMAL 1
+ mvwprintw [ win 1 44 "Alt charset" ]
+ draw-charset win A_ALTCHARSET 34
+ if UTF-8 [
+ mvwprintw-attr win 12 5 (A_REVERSE or A_BLINK) " Warning "
+ wprintw [ win " : UTF-8 charset" ]
+ mvwprintw [ win 13 17 "Only 7 bits chars are displayed" ]
+ ]
+ return win
+ ]
+;-------------------------------------
show-menu: func [ ; Create the menu window
return: [window!]
/local win
@@ -304,6 +347,8 @@ with curses [
mvwprintw [ win 5 2 "5 Check terminal features" ]
mvwprintw [ win 6 2 "6 Mini screen editor" ]
mvwprintw [ win 7 2 "7 Test string input" ]
+ mvwprintw [ win 8 2 "8 Display charset" ]
+; mvwprintw [ win 9 2 "Accents éèàùüâô" ]
mvwprintw [ win 10 2 "Ctrl+Q to exit" ]
return win
]
@@ -340,6 +385,7 @@ with curses [
#"5" [ win-demo: show-features ]
#"6" [ win-demo: show-edit ]
#"7" [ win-demo: show-input ]
+ #"8" [ win-demo: show-charset ]
default [ ]
]
wrefresh win-menu
@@ -349,9 +395,47 @@ with curses [
]
]
;-------------------------------------
+ init-menu-bar: func [ ; callback function for ripoffline
+ [cdecl]
+ wid [integer!]
+ cols [integer!]
+; return: [integer!]
+ ][
+ menu-bar: wid
+; return 0
+ ]
+;-------------------------------------
+ init-status-bar: func [ ; callback function for ripoffline
+ [cdecl]
+ wid [integer!]
+ cols [integer!]
+; return: [integer!]
+ ][
+ status-bar: wid
+; return 0
+ ]
+;-------------------------------------
+ menu-bar: 0
+ status-bar: 0
+ ripoffline 1 as integer! :init-menu-bar
+ ripoffline -1 as integer! :init-status-bar
screen: init-screen
init-color-pairs
color-set 3
+
+ wcolor-set menu-bar 49
+ werase menu-bar
+ wcolor-set status-bar 25
+ werase status-bar
+ wprintw [ menu-bar "Line reserved for Menu bar" ]
+ wnoutrefresh menu-bar
+ either op-num = 1 [
+ wprintw [ status-bar "Line reserved for Status bar" ]
+ ][
+ wprintw [ status-bar curses/locale ]
+ ]
+ wnoutrefresh status-bar
+
box screen 0 0
mvprintw [ 0 2 " The Red/System Curses Show " ]
win-demo: 0
View
189 red-system/library/curses/examples/panel-example.reds
@@ -0,0 +1,189 @@
+Red/System [
+ Title: "Panel example"
+ Author: "Bruno Anselme"
+ EMail: "be.red@free.fr"
+ File: %panel-example.reds
+ Rights: "Copyright (c) 2013 Bruno Anselme"
+ License: {
+ Distributed under the Boost Software License, Version 1.0.
+ See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
+ }
+ Needs: {
+ Red/System >= 0.3.1
+ curses >= 5.9 (Linux)
+ pdcurses >= 3.4 (Windows)
+ }
+ Purpose: {
+ Minimalist panel demo.
+ }
+]
+
+
+#include %../../../runtime/libc.reds
+#include %../curses.reds
+#include %../panel.reds
+
+ #switch OS [
+ Windows [ op-sys: "Windows" op-num: 1 ]
+ MacOSX [ op-sys: "MacOSX" op-num: 2 ]
+ #default [ op-sys: "Linux" op-num: 0 ]
+ ]
+
+with [ curses panel ] [
+ wid: 0
+;-------------------------------------
+ trace-key: func [
+ key [integer!]
+ return: [byte!]
+ /local car nb-rows memcur
+ ][
+ nb-rows: getmaxy screen
+ memcur: curs-set 0
+ car: #"^(0)"
+ either (key and FFFFFF00h) = 0 [
+ car: as byte! (key and 0000007Fh )
+ mvprintw [ (nb-rows - 2) 3
+ "Character pressed (int-hex-char) : %4d - %02Xh - %c "
+ as integer! car
+ as integer! car
+ (either (car >= #" ") [ car ][ #" " ])
+ ]
+ ][
+ if key <> FFFFFFFFh [
+ mvprintw [ (nb-rows - 2) 3
+ "Key pressed (int-hex-name) : %4d - %04Xh - %s "
+ key
+ key
+ keyname key
+ ]
+ ]
+ ]
+ refresh
+ curs-set memcur
+ return car
+ ]
+;;-------------------------------------
+ fill-window: func [
+ win [window!]
+ n [integer!]
+ ][
+ box win 0 0
+ mvwprintw [ win 0 2 " Window %d " n ]
+ mvwprintw [ win 1 2 "The Red/System panel Show" ]
+ mvwprintw [ win 3 2 "Tab to browse through windows" ]
+ mvwprintw [ win 4 2 "Use arrow keys to move" ]
+ mvwprintw [ win 5 2 "Use Ctrl+arrow keys to resize" ]
+ mvwprintw [ win 7 2 "Ctrl+Q to exit" ]
+ ]
+;;-------------------------------------
+ add-panel: func [
+ n [integer!]
+ return: [panel!]
+ /local win pan
+ ][
+ win: newwin 9 55 n (3 * n)
+ pan: new-panel win
+ fill-window win n
+ pan
+ ]
+;;-------------------------------------
+ resize-panel: func [
+ n [integer!] ; panel number
+ addrow [integer!]
+ addcol [integer!]
+ /local row col nbrows nbcols maxrow maxcol win new-win
+ ][
+ win: panel-window panels/n
+ row: getbegy win
+ col: getbegx win
+ nbrows: getmaxy win
+ nbcols: getmaxx win
+ maxrow: getmaxy screen
+ maxcol: getmaxx screen
+ nbrows: addrow + nbrows
+ nbcols: addcol + nbcols
+ ; Check screen limits
+ if nbrows < 2 [ nbrows: 2 ]
+ if (row + nbrows) > maxrow[ nbrows: maxrow - row ]
+ if nbcols < 2 [ nbcols: 2 ]
+ if (col + nbcols) > maxcol[ nbcols: maxcol - col ]
+ new-win: newwin nbrows nbcols row col
+ replace-panel panels/n new-win
+ fill-window new-win n
+ delwin win
+ ]
+;;-------------------------------------
+ translate-panel: func [
+ n [integer!] ; panel number
+ addrow [integer!]
+ addcol [integer!]
+ /local row col nbrows nbcols maxrow maxcol win
+ ][
+ win: panel-window panels/n
+ row: getbegy win
+ col: getbegx win
+ nbrows: getmaxy win
+ nbcols: getmaxx win
+ maxrow: getmaxy screen
+ maxcol: getmaxx screen
+ row: row + addrow
+ col: col + addcol
+ ; Check screen limits
+ if row < 0 [ row: 0 ]
+ if (row + nbrows) > maxrow[ row: maxrow - nbrows ]
+ if col < 0 [ col: 0 ]
+ if (col + nbcols) > maxcol[ col: maxcol - nbcols ]
+ move-panel panels/n row col
+ ]
+;;-------------------------------------
+ screen: init-screen
+
+ nbpanel: 5
+ panel-array: allocate (nbpanel * size? integer!) ; Allocate memory for panel pointers
+ panels: as [pointer! [integer!]] panel-array
+
+ i: 1
+ until [
+ panels/i: add-panel i
+ i: i + 1
+ i > nbpanel
+ ]
+ key: 0
+ car: #"^(0)"
+ i: nbpanel
+ update-panels
+ doupdate
+ until [
+ key: getch
+ car: trace-key key
+ switch key [
+ 9 [ ; Tab key
+ i: i + 1
+ if i > nbpanel [ i: 1 ]
+ top-panel panels/i
+ ]
+ KEY_BTAB [ ; Backtab key
+ i: i - 1
+ if i < 1 [ i: nbpanel ]
+ top-panel panels/i
+ ]
+ KEY_DOWN [ translate-panel i 1 0 ]
+ KEY_UP [ translate-panel i -1 0 ]
+ KEY_LEFT [ translate-panel i 0 -1 ]
+ KEY_RIGHT [ translate-panel i 0 1 ]
+ CTL_DOWN [ resize-panel i 1 0 ]
+ CTL_UP [ resize-panel i -1 0 ]
+ CTL_LEFT [ resize-panel i 0 -1 ]
+ CTL_RIGHT [ resize-panel i 0 1 ]
+ default [ ]
+ ]
+ update-panels
+ doupdate
+ all [ ((key and A_ATTRIBUTES) = 0) (car = #"^Q") ]
+ ]
+ endwin
+ free panel-array
+
+ if op-num = 1 [ print [ lf lf ] ] ; Windows console needs to scroll
+ print [ "That's all folks..." lf ]
+]
View
103 red-system/library/curses/panel.reds
@@ -0,0 +1,103 @@
+Red/System [
+ Title: "panel Binding"
+ Author: "Bruno Anselme"
+ EMail: "be.red@free.fr"
+ File: %panel.reds
+ Rights: "Copyright (c) 2013 Bruno Anselme"
+ License: {
+ Distributed under the Boost Software License, Version 1.0.
+ See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
+ }
+ Needs: {
+ Red/System >= 0.3.1
+ panel >= 5.9 (Linux)
+ pdcurses >= 3.4 (Windows)
+ }
+]
+
+panel: context [
+
+ #define window! integer!
+ #define panel! integer!
+
+ #switch OS [
+ Windows [
+ #define panel-library "pdcurses.dll"
+ ]
+ MacOSX [
+ #define panel-library "panelw.dylib" ; TODO: check this
+ ]
+ #default [
+ #define panel-library "libpanelw.so.5"
+ ]
+ ]
+
+ #import [panel-library cdecl [
+ new-panel: "new_panel" [ ; Allocates a PANEL structure, places the panel on the top of the stack.
+ win [window!]
+ return: [panel!]
+ ]
+ update-panels: "update_panels" [ ; Refreshes the virtual screen to reflect the panels in the stack, but does not call doupdate to refresh the physical screen.
+ return: [integer!]
+ ]
+ hide-panel: "hide_panel" [ ; Removes the given panel from the panel stack and thus hides it from view.
+ pan [panel!]
+ return: [integer!]
+ ]
+ show-panel: "show_panel" [ ; Makes a hidden panel visible by placing it on top of the panels in the panel stack.
+ pan [panel!]
+ return: [integer!]
+ ]
+ del-panel: "del_panel" [ ; Removes the given panel from the stack and deallocates the PANEL structure (but not its associated window).
+ pan [panel!]
+ return: [integer!]
+ ]
+ top-panel: "top_panel" [ ; Puts the given visible panel on top of all panels in the stack.
+ pan [panel!]
+ return: [integer!]
+ ]
+ bottom-panel: "bottom_panel" [ ; Puts panel at the bottom of all panels.
+ pan [panel!]
+ return: [integer!]
+ ]
+ panel-window: "panel_window" [ ; Returns a pointer to the window of the given panel.
+ pan [panel!]
+ return: [window!]
+ ]
+ panel-above: "panel_above" [ ; Returns a pointer to the panel above pan.
+ pan [panel!]
+ return: [panel!]
+ ]
+ panel-below: "panel_below" [ ; Returns a pointer to the panel just below pan.
+ pan [panel!]
+ return: [panel!]
+ ]
+ move-panel: "move_panel" [ ; Moves the given panel window so that its upper-left corner is at starty, startx.
+ pan [panel!]
+ starty [integer!]
+ startx [integer!]
+ return: [integer!]
+ ]
+ replace-panel: "replace_panel" [ ; Replaces the current window of panel with window.
+ pan [panel!]
+ win [window!]
+ return: [integer!]
+ ]
+ panel-hidden: "panel_hidden" [ ; Returns TRUE if the panel is in the panel stack
+ pan [panel!]
+ return: [integer!]
+ ]
+ set-panel-userptr: "set_panel_userptr" [ ; Sets the panel’s user pointer.
+ pan [panel!]
+ data [pointer! [integer!]]
+ return: [integer!]
+ ]
+ panel-userptr: "panel_userptr" [ ; Returns the user pointer for a given panel.
+ pan [panel!]
+ return: [pointer! [integer!]]
+ ]
+
+ ] ; cdecl
+ ] ; #import [panel-library
+
+] ; context panel
Something went wrong with that request. Please try again.