← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcdocs/go32ex/seldes.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcdocs/go32ex/seldes.pp
 
1
{$mode delphi}
 
2
uses
 
3
        crt,
 
4
        go32;
 
5
 
 
6
const
 
7
        maxx = 80;
 
8
        maxy = 25;
 
9
        bytespercell = 2;
 
10
        screensize = maxx * maxy * bytespercell;
 
11
 
 
12
        linB8000 = $B800 * 16;
 
13
 
 
14
type
 
15
        string80 = string[80];
 
16
 
 
17
var
 
18
        text_save : array[0..screensize-1] of byte;
 
19
        text_oldx, text_oldy : Word;
 
20
 
 
21
        text_sel : Word;
 
22
 
 
23
procedure status(s : string80);
 
24
begin
 
25
     gotoxy(1, 1); clreol; write(s); readkey;
 
26
end;
 
27
 
 
28
procedure selinfo(sel : Word);
 
29
begin
 
30
     gotoxy(1, 24);
 
31
     clreol; writeln('Descriptor base address : $',
 
32
        hexstr(get_segment_base_address(sel), 8));
 
33
     clreol; write('Descriptor limit : ', get_segment_limit(sel));
 
34
end;
 
35
 
 
36
function makechar(ch : char; color : byte) : Word;
 
37
begin
 
38
     result := byte(ch) or (color shl 8);
 
39
end;
 
40
 
 
41
begin
 
42
     seg_move(dosmemselector, linB8000, get_ds, longint(@text_save),
 
43
        screensize);
 
44
     text_oldx := wherex; text_oldy := wherey;
 
45
     seg_fillword(dosmemselector, linB8000, screensize div 2,
 
46
        makechar(' ', Black or (Black shl 4)));
 
47
     status('Creating selector ''text_sel'' to a part of ' +
 
48
        'text screen memory');
 
49
     text_sel := allocate_ldt_descriptors(1);
 
50
     set_segment_base_address(text_sel,
 
51
        linB8000 + bytespercell * maxx * 1);
 
52
     set_segment_limit(text_sel, screensize - 1 - bytespercell *
 
53
        maxx * 3);
 
54
     selinfo(text_sel);
 
55
 
 
56
     status('and clearing entire memory selected by ''text_sel''' +
 
57
        ' descriptor');
 
58
     seg_fillword(text_sel, 0, (get_segment_limit(text_sel)+1) div 2,
 
59
        makechar(' ', LightBlue shl 4));
 
60
 
 
61
     status('Notice that only the memory described by the' +
 
62
        ' descriptor changed, nothing else');
 
63
 
 
64
     status('Now reducing it''s limit and base and setting it''s ' +
 
65
        'described memory');
 
66
     set_segment_base_address(text_sel,
 
67
        get_segment_base_address(text_sel) + bytespercell * maxx);
 
68
     set_segment_limit(text_sel,
 
69
        get_segment_limit(text_sel) - bytespercell * maxx * 2);
 
70
     selinfo(text_sel);
 
71
     status('Notice that the base addr increased by one line but ' +
 
72
        'the limit decreased by 2 lines');
 
73
     status('This should give you the hint that the limit is ' +
 
74
        'relative to the base');
 
75
     seg_fillword(text_sel, 0, (get_segment_limit(text_sel)+1) div 2,
 
76
        makechar(#176, LightMagenta or Brown shl 4));
 
77
 
 
78
     status('Now let''s get crazy and copy 10 lines of data from ' +
 
79
        'the previously saved screen');
 
80
     seg_move(get_ds, longint(@text_save), text_sel,
 
81
        maxx * bytespercell * 2, maxx * bytespercell * 10);
 
82
 
 
83
     status('At last freeing the descriptor and restoring the old '+
 
84
        ' screen contents..');
 
85
     status('I hope this little program may give you some hints on '+
 
86
        'working with descriptors');
 
87
     free_ldt_descriptor(text_sel);
 
88
     seg_move(get_ds, longint(@text_save), dosmemselector,
 
89
        linB8000, screensize);
 
90
     gotoxy(text_oldx, text_oldy);
 
91
end.
 
 
b'\\ No newline at end of file'