← Back to branch summary

~ubuntu-branches/ubuntu/lucid/fpc/lucid-proposed

« back to all changes in this revision

Viewing changes to fpcsrc/packages/ncurses/examples/tpad.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-10-09 23:29:00 UTC
  • mfrom: (4.1.1 sid)
  • Revision ID: james.westby@ubuntu.com-20081009232900-553f61m37jkp6upv
Tags: 2.2.2-4
http://bugs.debian.org/498882
[ Torsten Werner ]
* Update ABI version in fpc-depends automatically.
* Remove empty directories from binary package fpc-source.

[ Mazen Neifer ]
* Removed leading path when calling update-alternatives to remove a Linitian
  error.
* Fixed clean target.
* Improved description of packages. (Closes: #498882)

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/packages/ncurses/examples/tpad.pp
 
1
{
 
2
   Author: Vitaliy Trifonov
 
3
}
 
4
program pad_demo;
 
5
 
 
6
{$MODE OBJFPC}
 
7
 
 
8
{$IFDEF DEBUG}
 
9
{$ASSERTIONS ON}
 
10
{$OVERFLOWCHECKS ON}
 
11
{$RANGECHECKS ON}
 
12
{$CHECKPOINTER ON}
 
13
{$ENDIF}
 
14
 
 
15
uses
 
16
  ncurses, panel, sysutils;
 
17
 
 
18
type
 
19
  TNcCoord = array[0..1] of Smallint;
 
20
 
 
21
  TNcStr = packed record
 
22
    str: AnsiString;
 
23
    attr: attr_t;
 
24
    coord: TNcCoord;
 
25
  end;
 
26
 
 
27
const y = 0; x = 1;
 
28
 
 
29
function CTRL( ch: chtype ): chtype; inline;
 
30
begin
 
31
  CTRL := ch AND $001F
 
32
end;
 
33
 
 
34
function randomchar: chtype;
 
35
var
 
36
  ch: Char = #0;
 
37
begin
 
38
  while not (ch in ['0'..'9','A'..'Z','a'..'z']) do
 
39
    ch := Char(Random(123));
 
40
  randomchar := chtype(ch);
 
41
end;
 
42
 
 
43
function randompair: longint;
 
44
var
 
45
  pair: longint = 0;
 
46
begin
 
47
  while not (pair in [1..5]) do
 
48
    pair := Random(6);
 
49
  randompair := pair;
 
50
end;
 
51
 
 
52
 
 
53
procedure draw;
 
54
var
 
55
  y, x:  Smallint;
 
56
begin
 
57
  for y := 0 to LINES - 1 do
 
58
    for x := 0 to COLS - 1 do
 
59
      mvaddch(y, x, randomchar OR COLOR_PAIR(randompair));
 
60
end;
 
61
 
 
62
procedure draw_pad(win: PWINDOW);
 
63
 
 
64
var
 
65
  y, x, my, mx:  Smallint;
 
66
begin
 
67
  getmaxyx(win,my,mx);
 
68
  wborder(win, ACS_CKBOARD,ACS_CKBOARD,ACS_CKBOARD,ACS_CKBOARD,
 
69
          ACS_CKBOARD,ACS_CKBOARD,ACS_CKBOARD,ACS_CKBOARD);
 
70
  for y := 1 to my - 2 do
 
71
    if (y mod 5) = 1 then
 
72
      for x := 1 to mx - 2 do
 
73
        if (x mod 10) = 1 then
 
74
          mvwaddch(win, y, x, randomchar OR COLOR_PAIR(randompair))
 
75
        else
 
76
          mvwaddch(win, y, x, ACS_HLINE)
 
77
    else
 
78
      for x := 1 to mx - 2 do
 
79
        if (x mod 10) = 1 then
 
80
          mvwaddch(win, y, x, ACS_VLINE)
 
81
        else
 
82
          mvwaddch(win, y, x, chtype(' '))
 
83
end;
 
84
 
 
85
 
 
86
function st_middle(scrlen, itemlen: Smallint): Smallint; inline;
 
87
begin
 
88
  st_middle := (scrlen - itemlen) div 2;
 
89
end;
 
90
 
 
91
procedure print_in_middle(win: PWINDOW; var nstr: TNcStr; width: Longint);
 
92
var
 
93
  my, mx: Smallint;
 
94
begin
 
95
  getmaxyx(win, my, mx);
 
96
  mx -= nstr.coord[1];
 
97
 
 
98
  if (width > length(nstr.str)) OR  (width < 1) then
 
99
    width := length(nstr.str);
 
100
 
 
101
  if width > mx then
 
102
    width := mx;
 
103
 
 
104
  nstr.coord[x] += st_middle(mx,width);
 
105
 
 
106
  wattron(win,nstr.attr);
 
107
  mvwaddnstr(win,nstr.coord[y],nstr.coord[x],PChar(nstr.str),width);
 
108
  wattroff(win,nstr.attr);
 
109
end;
 
110
 
 
111
type
 
112
  TBarData = packed record
 
113
    beg, len, slen: Smallint;
 
114
  end;
 
115
 
 
116
  TPad = class
 
117
  private
 
118
    wyx, pyx, ppos, grid: TNcCoord;
 
119
    hbar, vbar: TBarData;
 
120
    padwin, projwin: PWINDOW;
 
121
    panel: PPANEL;
 
122
    header: TNcStr;
 
123
    changed: Boolean;
 
124
    procedure init_bars;
 
125
    procedure draw_hbar;
 
126
    procedure draw_vbar;
 
127
  public
 
128
    function scroll_right: Boolean;
 
129
    function scroll_left: Boolean;
 
130
    function scroll_down: Boolean;
 
131
    function scroll_up: Boolean;
 
132
    function  doevent: chtype;
 
133
    procedure dorefresh;
 
134
    function  move(const ncoord: array of Smallint): Boolean; inline;
 
135
    function  hide: Boolean; inline;
 
136
    function  show: Boolean; inline;
 
137
    procedure resize;
 
138
    function  resize(const nsize: array of Smallint): Boolean;
 
139
    constructor create(const parm: array of TNcCoord; const hdr: TNcStr);
 
140
    destructor destroy; override;
 
141
    property win: PWINDOW read padwin;
 
142
    property ysize: Smallint read wyx[y];
 
143
    property xsize: Smallint read wyx[x];
 
144
  end;
 
145
 
 
146
 
 
147
procedure TPad.init_bars;
 
148
 
 
149
function get_scrl_len(blen, wsz, psz: Smallint): Smallint; inline;
 
150
begin
 
151
  get_scrl_len := (blen * wsz) div psz;
 
152
end;
 
153
 
 
154
begin
 
155
  hbar.beg  := 4;
 
156
  hbar.len  := wyx[x] - hbar.beg * 2;
 
157
  hbar.slen := get_scrl_len(hbar.len, wyx[x], pyx[x]);
 
158
 
 
159
  vbar.beg  := 2;
 
160
  vbar.len  := wyx[y] - vbar.beg * 2;
 
161
  vbar.slen := get_scrl_len(vbar.len, wyx[y], pyx[y]);
 
162
end;
 
163
 
 
164
function get_scrl_beg(ind, slen, blen, wsz, psz, bbeg: Smallint): Smallint;
 
165
begin
 
166
  if psz <> wsz then
 
167
    get_scrl_beg := (ind * (blen - slen)) div (psz - wsz) + bbeg
 
168
  else
 
169
    get_scrl_beg := bbeg;
 
170
end;
 
171
 
 
172
procedure TPad.draw_hbar;
 
173
var
 
174
  i, sbeg: Smallint;
 
175
begin
 
176
  with hbar do
 
177
  begin
 
178
    sbeg := get_scrl_beg(ppos[x],hbar.slen,hbar.len,wyx[x], pyx[x],hbar.beg);
 
179
    wattron(projwin,header.attr);
 
180
    for i :=  beg to beg + len - 1 do
 
181
    if (i < sbeg) OR (i > sbeg + slen) then
 
182
      mvwaddch(projwin,wyx[y]-1,i  ,ACS_CKBOARD)
 
183
    else
 
184
      mvwaddch(projwin,wyx[y]-1,i,ACS_BLOCK);
 
185
    wattroff(projwin,header.attr);
 
186
  end
 
187
end;
 
188
 
 
189
procedure TPad.draw_vbar;
 
190
var
 
191
  i, sbeg: Smallint;
 
192
begin
 
193
  with vbar do
 
194
  begin
 
195
    sbeg := get_scrl_beg(ppos[y],vbar.slen,vbar.len,wyx[y], pyx[y],vbar.beg);
 
196
    wattron(projwin,header.attr);
 
197
    for i :=  beg to beg + len - 1 do
 
198
    if (i < sbeg) OR (i > sbeg + slen) then
 
199
      mvwaddch(projwin,i,wyx[x]-1,ACS_CKBOARD)
 
200
    else
 
201
      mvwaddch(projwin,i,wyx[x]-1,ACS_BLOCK);
 
202
    wattroff(projwin,header.attr);
 
203
  end
 
204
end;
 
205
 
 
206
function TPad.scroll_right: Boolean;
 
207
begin
 
208
  if ppos[x] > 0 then
 
209
  begin
 
210
    if (ppos[x] < grid[x]) then
 
211
      ppos[x] := 0
 
212
    else
 
213
      ppos[x] -= grid[x];
 
214
    draw_hbar;
 
215
    changed := true;
 
216
    scroll_right := true
 
217
  end
 
218
  else
 
219
    scroll_right := false
 
220
end;
 
221
 
 
222
function TPad.scroll_left: Boolean;
 
223
var
 
224
  dwidth: Longint;
 
225
begin
 
226
  dwidth := pyx[x] - wyx[x] + 2;
 
227
  if ppos[x] < dwidth then
 
228
  begin
 
229
    if ppos[x] > (dwidth - grid[x]) then
 
230
      ppos[x] := dwidth
 
231
    else
 
232
      ppos[x] += grid[x];
 
233
    draw_hbar;
 
234
    changed := true;
 
235
    scroll_left := true
 
236
  end
 
237
  else
 
238
    scroll_left := false
 
239
end;
 
240
 
 
241
function TPad.scroll_down: Boolean;
 
242
begin
 
243
  if ppos[y] > 0 then
 
244
  begin
 
245
    if ppos[y] < grid[y] then
 
246
      ppos[y] := 0
 
247
    else
 
248
      ppos[y] -= grid[y];
 
249
    draw_vbar;
 
250
    changed := true;
 
251
    scroll_down := true
 
252
  end
 
253
  else
 
254
    scroll_down := false
 
255
end;
 
256
 
 
257
function TPad.scroll_up: Boolean;
 
258
var
 
259
  dheight: Longint;
 
260
begin
 
261
  dheight := pyx[y] - wyx[y] + 2;
 
262
  if ppos[y] < dheight then
 
263
  begin
 
264
    if ppos[y] > (dheight - grid[x]) then
 
265
      ppos[y] := dheight
 
266
    else
 
267
      ppos[y] += grid[x];
 
268
    draw_vbar;
 
269
    changed := true;
 
270
    scroll_up := true
 
271
  end
 
272
  else
 
273
    scroll_up := false
 
274
end;
 
275
 
 
276
function  TPad.doevent: chtype;
 
277
var
 
278
  ch: chtype;
 
279
  rval: Boolean = true;
 
280
begin
 
281
  ch := wgetch(projwin);
 
282
  case ch of
 
283
    KEY_DOWN:  rval := scroll_up;
 
284
    KEY_UP:    rval := scroll_down;
 
285
    KEY_LEFT:  rval := scroll_right;
 
286
    KEY_RIGHT: rval := scroll_left;
 
287
  end;
 
288
  if not rval then
 
289
  begin
 
290
    ncurses.beep();
 
291
    flash();
 
292
  end;
 
293
  doevent := ch
 
294
end;
 
295
 
 
296
procedure TPad.dorefresh;
 
297
var
 
298
  rval: Longint = OK;
 
299
begin
 
300
  if changed then
 
301
  begin
 
302
    rval := copywin(padwin,projwin,ppos[y],ppos[x],1,1,wyx[y]-2,wyx[x]-2, 0);
 
303
    assert(rval=OK,'copywin error');
 
304
    if rval = OK then
 
305
      changed := false;
 
306
  end
 
307
end;
 
308
 
 
309
function TPad.move(const ncoord: array of Smallint): Boolean;
 
310
begin
 
311
  move :=  move_panel(panel, ncoord[y], ncoord[x]) = OK
 
312
end;
 
313
 
 
314
function TPad.hide: Boolean;
 
315
begin
 
316
  hide := hide_panel(panel) = OK
 
317
end;
 
318
 
 
319
function TPad.show: Boolean;
 
320
begin
 
321
  show := show_panel(panel) = OK
 
322
end;
 
323
 
 
324
procedure TPad.resize;
 
325
var
 
326
  nsize: TNcCoord;
 
327
  doresize: Boolean = false;
 
328
begin
 
329
  getbegyx(projwin,nsize[y],nsize[x]);
 
330
 
 
331
  nsize[y] += wyx[y];
 
332
  nsize[x] += wyx[x];
 
333
 
 
334
  if nsize[y] > LINES then
 
335
  begin
 
336
    nsize[y] := LINES; doresize := true
 
337
  end
 
338
  else
 
339
    nsize[y] := wyx[y];
 
340
 
 
341
  if nsize[x] > COLS then
 
342
  begin
 
343
    nsize[x] := COLS; doresize := true
 
344
  end
 
345
  else
 
346
    nsize[x] := wyx[x];
 
347
 
 
348
  if doresize then
 
349
    resize(nsize)
 
350
end;
 
351
 
 
352
function TPad.resize(const nsize: array of Smallint): Boolean;
 
353
var
 
354
  by, bx: Smallint;
 
355
  domove: Boolean = false;
 
356
  tcoord: TNcCoord;
 
357
begin
 
358
 
 
359
  if (nsize[y] <= LINES)AND(nsize[x] <= COLS) then
 
360
  begin
 
361
    if nsize[y] > pyx[y] + 2 then
 
362
      tcoord[y] := pyx[y] + 2
 
363
    else
 
364
      tcoord[y] := nsize[y];
 
365
 
 
366
    if nsize[x] > pyx[x] + 2 then
 
367
      tcoord[x] := pyx[x] + 2
 
368
    else
 
369
      tcoord[x] := nsize[x];
 
370
 
 
371
 
 
372
    getbegyx(projwin, by, bx);
 
373
 
 
374
    if tcoord[y] + by >= LINES then
 
375
    begin
 
376
      by := LINES - tcoord[y]; domove := true
 
377
    end;
 
378
 
 
379
    if tcoord[x] + bx >= COLS then
 
380
    begin
 
381
      bx := COLS - tcoord[x]; domove := true
 
382
    end;
 
383
 
 
384
    if tcoord[x] > (pyx[x] - ppos[x]) then
 
385
      scroll_right;
 
386
    if tcoord[y] > (pyx[y] - ppos[y]) then
 
387
      scroll_down;
 
388
 
 
389
    hide_panel(panel);
 
390
    wresize(projwin, tcoord[y], tcoord[x]);
 
391
 
 
392
    if domove then
 
393
      move_panel(panel, by, bx);
 
394
    show_panel(panel);
 
395
 
 
396
    box(projwin, ACS_VLINE, ACS_HLINE);
 
397
 
 
398
    getmaxyx(projwin,wyx[y],wyx[x]);
 
399
    header.coord[y] := 0; header.coord[x] := 0;
 
400
 
 
401
    print_in_middle(projwin, header, 0);
 
402
    init_bars;
 
403
    draw_hbar;
 
404
    draw_vbar;
 
405
 
 
406
    changed := true;
 
407
    resize := true
 
408
  end
 
409
  else
 
410
    resize := false
 
411
end;
 
412
 
 
413
constructor TPad.create(const parm: array of TNcCoord; const hdr: TNcStr);
 
414
{$IFDEF DEBUG}
 
415
var
 
416
  tysz, txsz: Smallint;
 
417
{$ENDIF}
 
418
begin
 
419
  if parm[0,y] >= parm[1,y] + 2 then
 
420
    wyx[y] := parm[1,y] + 2
 
421
  else
 
422
    wyx[y] := parm[0,y];
 
423
 
 
424
  if parm[0,x] >= parm[1,x] + 2  then
 
425
    wyx[x] := parm[1,x] + 2
 
426
  else
 
427
    wyx[x] := parm[0,x];
 
428
 
 
429
  projwin := newwin(wyx[y], wyx[x], (LINES - wyx[y]) div 2, (COLS - wyx[x]) div 2);
 
430
  intrflush(projwin, FALSE);
 
431
  keypad(projwin, TRUE);
 
432
  box(projwin, ACS_VLINE, ACS_HLINE);
 
433
 
 
434
  panel := new_panel(projwin);
 
435
  padwin := newpad(parm[1,y], parm[1,x]);
 
436
 
 
437
  header := hdr;
 
438
  pyx := parm[1];
 
439
  grid := parm[2];
 
440
 
 
441
{$IFDEF DEBUG}
 
442
  getmaxyx(projwin,tysz, txsz);
 
443
  assert((wyx[y]=tysz)AND(wyx[x]=txsz), 'Invalid window');
 
444
 
 
445
  getmaxyx(padwin,tysz, txsz);
 
446
  assert((pyx[y]=tysz)AND(pyx[x]=txsz), 'Invalid pad');
 
447
{$ENDIF}
 
448
  FmtStr(header.str, '%s, pad: h=%d w=%d, win: h=%d w=%d', [hdr.str,pyx[y],pyx[x],wyx[y],wyx[x]]);
 
449
 
 
450
 
 
451
  print_in_middle(projwin, header, 0);
 
452
 
 
453
  init_bars;
 
454
  draw_hbar;
 
455
  draw_vbar;
 
456
 
 
457
  changed := true;
 
458
end;
 
459
 
 
460
destructor TPad.destroy;
 
461
begin
 
462
  del_panel(panel);
 
463
  delwin(padwin);
 
464
  delwin(projwin);
 
465
end;
 
466
 
 
467
procedure init_stdscr;
 
468
begin
 
469
  draw;
 
470
  attron(COLOR_PAIR(7));
 
471
  mvaddstr(LINES - 3, 0,'press "+" "-" to resize              ');
 
472
  mvaddstr(LINES - 2, 0,'press UP, DOWN, LEFT, RIGHT to scroll');
 
473
  mvaddstr(LINES - 1, 0,'press F10 or q to exit               ');
 
474
  attroff(COLOR_PAIR(7));
 
475
end;
 
476
 
 
477
 
 
478
 
 
479
var
 
480
  ch: chtype;
 
481
  ncpad: TPad;
 
482
  my_bg: Smallint = COLOR_BLACK;
 
483
  wnd, pad, grid: TNcCoord;
 
484
  code: Word;
 
485
  header: TNcStr = (str:'Pad demo';attr:A_NORMAL;coord:(0,0));
 
486
begin
 
487
  try
 
488
    initscr();
 
489
    noecho();
 
490
    clear();
 
491
    cbreak();
 
492
    curs_set(0);
 
493
    keypad(stdscr, TRUE);
 
494
    meta(stdscr, TRUE);
 
495
    mousemask(1, nil);
 
496
 
 
497
   if has_colors() then
 
498
   begin
 
499
     start_color();
 
500
     if (use_default_colors() = OK) then
 
501
       my_bg := -1
 
502
     else
 
503
       my_bg := COLOR_BLACK;
 
504
 
 
505
     init_pair(1, COLOR_YELLOW, my_bg);
 
506
     init_pair(2, COLOR_MAGENTA, my_bg);
 
507
     init_pair(3, COLOR_WHITE, my_bg);
 
508
     init_pair(4, COLOR_CYAN, my_bg);
 
509
     init_pair(5, COLOR_GREEN, my_bg);
 
510
     init_pair(6, COLOR_WHITE, COLOR_BLUE);
 
511
     init_pair(7, COLOR_BLACK, COLOR_YELLOW);
 
512
   end;
 
513
 
 
514
    init_stdscr;
 
515
    //refresh();
 
516
 
 
517
    wnd[y]  := LINES - 6;
 
518
    wnd[x]  := COLS - 12;
 
519
    pad[y]  := wnd[y] + 6;
 
520
    pad[x]  := wnd[x] + 6;
 
521
    grid[y] := 3;
 
522
    grid[x] := 3;
 
523
 
 
524
 
 
525
    if paramcount > 1 then
 
526
    begin
 
527
      val(ParamStr(1),pad[y],code);
 
528
      val(ParamStr(2),pad[x],code);
 
529
    end;
 
530
 
 
531
    if paramcount > 3 then
 
532
    begin
 
533
      val(ParamStr(3),wnd[y],code);
 
534
      val(ParamStr(4),wnd[x],code);
 
535
    end;
 
536
 
 
537
    header.attr := COLOR_PAIR(6);
 
538
    ncpad := TPad.create([wnd,pad,grid],header);
 
539
    draw_pad(ncpad.win);
 
540
    ncpad.dorefresh;
 
541
    update_panels();
 
542
    doupdate();
 
543
 
 
544
    repeat
 
545
      ch := ncpad.doevent;
 
546
      case ch of
 
547
        chtype('+'): ncpad.resize([ncpad.ysize + 1,ncpad.xsize + 1]);
 
548
        chtype('='): ncpad.resize([ncpad.ysize + 1,ncpad.xsize + 1]);
 
549
        chtype('-'): ncpad.resize([ncpad.ysize - 1,ncpad.xsize - 1]);
 
550
        chtype(' '): ncpad.resize([wnd[y],wnd[x]]);
 
551
        KEY_RESIZE:
 
552
        begin
 
553
          flash();
 
554
          init_stdscr;
 
555
          ncpad.resize;
 
556
        end;
 
557
      end;
 
558
      ncpad.dorefresh;
 
559
      update_panels();
 
560
      doupdate();
 
561
    until (ch = chtype('q')) OR (ch = KEY_F(10));
 
562
  finally
 
563
    ncpad.destroy;
 
564
    curs_set(1);
 
565
    endwin();
 
566
  end;
 
567
end.