-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathI_PPLED1.PAS
116 lines (110 loc) · 3.3 KB
/
I_PPLED1.PAS
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
function selectcreature(start:byte):byte;
const
XLOC=20;
YLOC=20;
var
numobjs:byte; {number of objs in this catagory}
currcat:byte; {current catagory}
whatobj,whatobjold:byte; {what obj, 1..numobjs}
topobj,topobjold:byte;
objlist:array[1..MAXCRCS] of byte;
done:boolean;
redisplay_sidebar:boolean;
i:integer;
j:char;
procedure makecrclist;
var c:byte;s:string[18];
begin
topobjold:=255;
whatobjold:=255;
blankbox(XLOC*4,YLOC+8,XLOC*4+183,YLOC+153);
case currcat of
1:s:='LAWFUL PEOPLE ';
2:s:='EVIL PEOPLE ';
3:s:='NEUTRAL PEOPLE ';
4:s:='ANIMALS/MONSTERS';
end;
say(XLOC+2,YLOC,6,s);
numobjs:=0;
whatobj:=1;
topobj:=1;
for c:=1 to MAXCRCS do
if crc^[c].t=currcat then
begin;inc(numobjs);objlist[numobjs]:=c;end;
end;
begin
done:=false;
if start<>0 then
currcat:=crc^[start].t
else currcat:=1;
whatobjold:=1;
whatobjold:=255;
blankbox(XLOC*4-3,YLOC-3,XLOC*4+187,YLOC+156);
drawh(XLOC*4-2,YLOC-2,XLOC*4+186,3);
drawh(XLOC*4-2,YLOC+155,XLOC*4+186,3);
drawv(XLOC*4-2,YLOC-2,YLOC+155,3);
drawv(XLOC*4+186,YLOC-2,YLOC+155,3);
makecrclist;
repeat
if numobjs>9 then
if whatobjold<>whatobj then
begin
for i:=1 to 18 do begin;say(XLOC,YLOC+i*8,5,'Œ');end;
i:=trunc(whatobj/numobjs*18);
say(XLOC,YLOC+i*8,6,' '); {Remember, whatobj is NOT 1..255}
end;
if topobjold<>topobj then
if numobjs=0 then say(XLOC+12,YLOC+8,0,'NONE.')
else for i:=0 to 8 do
begin
if i+topobj<=numobjs then
begin
putgrap(XLOC+6,YLOC+8+(16*i),crc^[objlist[topobj+i]].g1);
say(XLOC+12,YLOC+8+(16*i),0,' ');
say(XLOC+12,YLOC+16*(i+1),0,' ');
say(XLOC+12,YLOC+16*(i+1),0,crc^[objlist[topobj+i]].n);
say(XLOC+12,YLOC+8+(16*i),0,'#'+strnum(objlist[topobj+i])+' ');
end
else begin
say(XLOC+6,YLOC+8+(16*i),0,' ');
say(XLOC+6,YLOC+16*(i+1),0,' ');
end;
end;
if numobjs>0 then
begin
say(XLOC+10,YLOC+8+(16*(whatobj-topobj)),6,' ');
say(XLOC+10,YLOC+(16*(whatobj-topobj+1)),6,' ');
end;
topobjold:=topobj;
whatobjold:=whatobj;
j:=upcase_sync(readkey);
say(XLOC+10,YLOC+8+(16*(whatobj-topobj)),0,' ');
say(XLOC+10,YLOC+(16*(whatobj-topobj+1)),0,' ');
case j of
#0:case readkey of
#59:help;
'K':begin;cycle(currcat,1,4,-1);
makecrclist;end;
'M':begin;cycle(currcat,1,4,+1);
makecrclist;end;
'H':if whatobj>topobj then dec(whatobj)
else if topobj>9 then begin;dec(topobj,9);dec(whatobj);end
else begin;topobj:=1;whatobj:=1;end;
'P':if whatobj<numobjs then
if whatobj<topobj+8 then inc(whatobj)
else begin;topobj:=whatobj+1;inc(whatobj);end;
'I':if topobj>9 then begin;dec(topobj,9);whatobj:=topobj;end
else begin;topobj:=1;whatobj:=1;end;
'Q':if topobj+9<=numobjs then begin;inc(topobj,9);whatobj:=topobj;end
else begin;topobj:=numobjs;whatobj:=numobjs;end;
'G':begin;topobj:=1;whatobj:=1;end;
'O':begin;topobj:=numobjs;whatobj:=numobjs;end;
end; {0case}
#32,#13:done:=true;
#27:begin;whatobj:=0;done:=true;end;
end; {keycase}
until done;
if numobjs=0 then whatobj:=0;
if whatobj<>0 then selectcreature:=objlist[whatobj]
else selectcreature:=start;
end;