DEADSOFTWARE

Update list of bugs
[cavecraft.git] / src / video.pas
1 unit video;
3 interface
4 procedure initVideo(scrW, scrH:integer; canScale:boolean;);
5 procedure drawVideo;
7 implementation
8 uses scri, keyboard;
9 var
10 useRes:boolean;
12 procedure initVideo(scrW, scrH:integer; canScale:boolean;);
13 var
14 tmp:integer;
15 begin
16 keyboard.scrMulX:=1;
17 keyboard.scrMulY:=1;
18 useRes:=false;
19 if (getWidth>getHeight) and (scrW<scrH) then
20 begin
21 tmp:=scrW;
22 scrW:=scrH;
23 scrH:=tmp;
24 end;
26 if ((getWidth>scrW) and (getHeight>scrH)) or ((getHeight>scrW) and (getWidth>scrH)) then
27 begin
28 debug('Scaling: '+getWidth+'x'+getHeight+' -> '+scrW+'x'+scrH);
29 if getWidth<getHeight then
30 scrH:=getHeight/(getWidth/scrW);
31 else
32 scrW:=getWidth/(getHeight/scrH);
34 scrH:=getHeight/(getWidth/scrW);
35 scrW:=getWidth/(getHeight/scrH);
37 debug('Scaling result: '+getWidth+'x'+getHeight+' -> '+scrW+'x'+scrH);
39 ScriCreate(scrW, scrH);
40 if canScale then
41 begin
42 keyboard.scrMulX:=getWidth/scrW;
43 keyboard.scrMulY:=getHeight/scrH;
44 ScriScale(getWidth/scrW, getHeight/scrH);
45 ScriPosition(0, 0);
46 ScriSwap;
47 useRes:=true;
48 end;
49 end;
50 end;
52 procedure drawVideo;
53 begin
54 draw_virtual_keys;
55 if useRes then
56 begin
57 ScriSwap;
58 ScriDraw;
59 Repaint;
60 ScriSwap;
61 end;
62 else
63 Repaint;
64 end;
66 end.