paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-29 23:40:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

palmunits: optimized palmcube slightly, and added offscreen rendering to eliminate flickering on real devices

Browse Source 
git-svn-id: trunk@37933 -
This commit is contained in:
Károly Balogh 2018-01-07 18:31:40 +00:00
parent 9915de038f
commit 8d3cf05b73
1 changed files with 44 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
packages/palmunits/examples/palmcube.pas
View File

@ -14,7 +14,8 @@
program palmcube; program palmcube;
uses uses
event_, sysevent, systemmgr, window, font; event_, sysevent, systemmgr, window, font,
errorbase, rect;
type type
tvertex = record tvertex = record
@ -180,7 +181,6 @@ var
scale: longint; scale: longint;
sx,sy: string; sx,sy: string;
begin begin
WinEraseWindow();
WinGetWindowExtent(w,h); WinGetWindowExtent(w,h);
scale:=(min(h,w) div 5) shl 16; scale:=(min(h,w) div 5) shl 16;
@ -194,33 +194,58 @@ begin
rcube[i].y:=cy + sarlongint(mulfp(vy,scale),16); rcube[i].y:=cy + sarlongint(mulfp(vy,scale),16);
end; end;
for i:=low(faces) to high(faces) do
begin
if (faces[i].edge and 1) > 0 then
WinDrawLine(rcube[faces[i].v1].x,rcube[faces[i].v1].y,
rcube[faces[i].v2].x,rcube[faces[i].v2].y);
if (faces[i].edge and 2) > 0 then
WinDrawLine(rcube[faces[i].v2].x,rcube[faces[i].v2].y,
rcube[faces[i].v3].x,rcube[faces[i].v3].y);
if (faces[i].edge and 4) > 0 then
WinDrawLine(rcube[faces[i].v3].x,rcube[faces[i].v3].y,
rcube[faces[i].v1].x,rcube[faces[i].v1].y);
end;
str(tx,sx); str(tx,sx);
str(ty,sy); str(ty,sy);
sx:='FPC Cube! X:'+sx+' Y:'+sy; sx:='FPC Cube! X:'+sx+' Y:'+sy;
WinEraseWindow();
WinDrawChars(@sx[1],length(sx),1,h-FntLineHeight); WinDrawChars(@sx[1],length(sx),1,h-FntLineHeight);
for i:=low(faces) to high(faces) do
begin
with faces[i] do
begin
if (edge and 1) > 0 then
WinDrawLine(rcube[v1].x,rcube[v1].y,
rcube[v2].x,rcube[v2].y);
if (edge and 2) > 0 then
WinDrawLine(rcube[v2].x,rcube[v2].y,
rcube[v3].x,rcube[v3].y);
if (edge and 4) > 0 then
WinDrawLine(rcube[v3].x,rcube[v3].y,
rcube[v1].x,rcube[v1].y);
end;
end;
end; end;
function CreateOffscreenWin(var offScreen: WinHandle; var screen: WinHandle; var r: RectangleType): boolean;
var
err: word;
w, h: smallint;
begin
WinGetWindowExtent(w,h);
offScreen:=WinCreateOffscreenWindow(w,h,screenFormat,err);
screen:= WinGetDrawWindow();
if err = 0 then
WinSetDrawWindow(offScreen);
r.topLeft.x:=0;
r.topLeft.y:=0;
r.extent.x:=h;
r.extent.y:=w;
CreateOffscreenWin:=err = 0;
end;
procedure EventLoop; procedure EventLoop;
var var
event: EventType; event: EventType;
prevX,prevY: smallint; prevX,prevY: smallint;
offscreen: boolean;
offScrWin, scrWin: WinHandle;
r: RectangleType;
begin begin
prevX:=-1; prevX:=-1;
prevY:=-1; prevY:=-1;
offScreen:=CreateOffscreenWin(offScrWin,scrWin,r);
repeat repeat
EvtGetEvent(event, 20); EvtGetEvent(event, 20);
SysHandleEvent(event); SysHandleEvent(event);
@ -229,8 +254,12 @@ begin
prevX:=event.screenX; prevX:=event.screenX;
prevY:=event.screenY; prevY:=event.screenY;
paintcube(prevX,prevY); paintcube(prevX,prevY);
if offscreen then
WinCopyRectangle(offScrWin, scrWin, r, 0, 0, winPaint);
end; end;
until (event.eType = appStopEvent); until (event.eType = appStopEvent);
if offscreen then
WinDeleteWindow(offScrWin, false);
end; end;
begin begin