mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-17 13:39:36 +02:00
* removed warnings/notes
This commit is contained in:
peter
parent
7b226fcd19
commit
66ea55dd7c
@ -2,7 +2,7 @@ Program fd2pascal;
|
||||
|
||||
{ ---------------------------------------------------------------------------
|
||||
Program to convert forms fdesign file to pascal code
|
||||
Copyright (C) 1997 Michael Van Canneyt
|
||||
Copyright (C) 1997 Michael Van Canneyt
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
@ -25,7 +25,7 @@ Uses linux;
|
||||
|
||||
Const RevString = '$Revision$';
|
||||
NrOptions = 4;
|
||||
Options : Array[0..NrOptions] Of String[20] =
|
||||
Options : Array[0..NrOptions] Of String[20] =
|
||||
('v','callback','main','altformat','compensate');
|
||||
|
||||
Type
|
||||
@ -34,7 +34,7 @@ Type
|
||||
CPlcol,CPlabel,CPShortcut,CPresize,CPgravity,CPname,CPCallback,
|
||||
CPargument,
|
||||
CPinvalid);
|
||||
{ Properties of an object for which defaults must be set }
|
||||
{ Properties of an object for which defaults must be set }
|
||||
AdjProps=(APClass,APBoxtype,ApColors,APAlignment,APSize,APLcol,APstyle,APgravity);
|
||||
{ List of all object classes }
|
||||
ObjClasses=(FL_INVALID,FL_BUTTON, FL_LIGHTBUTTON,FL_ROUNDBUTTON, FL_ROUND3DBUTTON,
|
||||
@ -47,7 +47,7 @@ Type
|
||||
PreProps=(PPmagic,PPNrforms,PPUnitofMeasure,PPinvalid);
|
||||
{ Properties of a form }
|
||||
FormProps=(FPName,FPWidth,FPHeight,FPnumObjs,FPinvalid);
|
||||
|
||||
|
||||
Const
|
||||
{ Names of all object properties }
|
||||
ContPropNames : Array[ContProps] of string[20] =
|
||||
@ -55,17 +55,17 @@ Const
|
||||
'lcol','label','shortcut','resize','gravity','name','callback',
|
||||
'argument',
|
||||
'invalid');
|
||||
{ Names of all object properties which must be checked.}
|
||||
{ Names of all object properties which must be checked.}
|
||||
AdjPropsNames : Array[AdjProps] of string[20] =
|
||||
('class','boxtype','colors','alignment','size','lcol','style','gravity');
|
||||
{ Names of all preamble properties }
|
||||
PrePropNames : Array[PreProps] of string[20] =
|
||||
{ Names of all preamble properties }
|
||||
PrePropNames : Array[PreProps] of string[20] =
|
||||
('Magic','Number of forms','Unit of measure','Invalid');
|
||||
{ Names of all form properties }
|
||||
{ Names of all form properties }
|
||||
FormPropNames : Array[FormProps] of string[20] =
|
||||
('Name','Width','Height','Number of Objects','Invalid');
|
||||
{ Names of all object classes }
|
||||
FObjClassNames : Array[ObjClasses] of string[20]=
|
||||
{ Names of all object classes }
|
||||
FObjClassNames : Array[ObjClasses] of string[20]=
|
||||
('FL_INVALID','BUTTON', 'LIGHTBUTTON','ROUNDBUTTON', 'ROUND3DBUTTON',
|
||||
'CHECKBUTTON', 'BITMAPBUTTON', 'PIXMAPBUTTON','BITMAP', 'PIXMAP',
|
||||
'BOX', 'TEXT', 'MENU', 'CHART', 'CHOICE', 'COUNTER', 'SLIDER', 'VALSLIDER', 'INPUT',
|
||||
@ -76,7 +76,7 @@ Const
|
||||
{ Default properties. If empty a property is ignored.
|
||||
To force setting of a property, put 'FL_FORCE' as a string.
|
||||
Mind : Case sensitive }
|
||||
|
||||
|
||||
DefProps : array[ObjClasses,AdjProps] of string[25] =
|
||||
(('FL_INVALID','','','','','','FL_NORMAL_STYLE','FL_FORCE'),
|
||||
('BUTTON','FL_UP_BOX','FL_COL1 FL_COL1','FL_ALIGN_CENTER','','FL_LCOL','FL_NORMAL_STYLE','FL_FORCE'),
|
||||
@ -110,7 +110,7 @@ Const
|
||||
('GLCANVAS','','','','','','FL_NORMAL_STYLE','FL_FORCE'),
|
||||
('IMAGECANVAS','','','','','','FL_NORMAL_STYLE','FL_FORCE'),
|
||||
('FOLDER','','','','','','FL_NORMAL_STYLE','FL_FORCE'));
|
||||
|
||||
|
||||
Type
|
||||
{ object data type }
|
||||
PControl = ^TControl;
|
||||
@ -118,14 +118,14 @@ Type
|
||||
Props : array[ContProps] of string;
|
||||
NextControl : PControl;
|
||||
end;
|
||||
|
||||
|
||||
{ Form data type}
|
||||
PFormRec = ^TFormRec;
|
||||
TFormRec = Record
|
||||
Name : String;
|
||||
Width,Height : String[5];
|
||||
Controls : PControl;
|
||||
NextForm : PFormRec;
|
||||
NextForm : PFormRec;
|
||||
end;
|
||||
{ Callback data type }
|
||||
PCBrec = ^TCBrec;
|
||||
@ -133,17 +133,15 @@ Type
|
||||
name : string;
|
||||
next : PCBrec;
|
||||
end;
|
||||
{ Property emitting procedures }
|
||||
{ Property emitting procedures }
|
||||
EmitProp = Procedure (Data : PControl;ObjClass : ObjClasses);
|
||||
|
||||
|
||||
Var
|
||||
OptionsSet : Array[1..NrOptions] Of Boolean;
|
||||
FileName : String;
|
||||
Infile,outfile : Text;
|
||||
Magic : String[20];
|
||||
LineNr : Longint;
|
||||
NrForms,NrControls : Longint;
|
||||
UnitOfMeasure : string;
|
||||
FormRoot : PFormRec;
|
||||
cbroot : pcbrec;
|
||||
{ Default properties emitters }
|
||||
@ -152,7 +150,7 @@ Var
|
||||
ClassEmitters : Array[ObjClasses] of EmitProp;
|
||||
|
||||
{ ------------------------------------------------------------------------
|
||||
Utilities Code
|
||||
Utilities Code
|
||||
------------------------------------------------------------------------ }
|
||||
|
||||
|
||||
@ -165,7 +163,7 @@ begin
|
||||
IntToStr:=Temp;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Procedure EmitError (Const s : String);
|
||||
|
||||
begin
|
||||
@ -181,7 +179,7 @@ end;
|
||||
|
||||
|
||||
{ ------------------------------------------------------------------------
|
||||
Option handling Code
|
||||
Option handling Code
|
||||
------------------------------------------------------------------------ }
|
||||
|
||||
|
||||
@ -189,7 +187,7 @@ Procedure DoOptions;
|
||||
|
||||
Var i,j,k : byte;
|
||||
os : string;
|
||||
|
||||
|
||||
Procedure ShowVersion;
|
||||
|
||||
begin
|
||||
@ -226,12 +224,12 @@ begin
|
||||
begin
|
||||
os:=copy(paramstr(i),2,length(paramstr(i))-1);
|
||||
k:=NrOptions+1;
|
||||
for j:=0 to NrOptions do
|
||||
for j:=0 to NrOptions do
|
||||
if os=options[j] then k:=j;
|
||||
if k=NrOptions+1 then
|
||||
EmitError('Option not recognised : '+paramstr(i))
|
||||
else
|
||||
if k=0 then ShowVersion else OptionsSet[k]:=True;
|
||||
if k=0 then ShowVersion else OptionsSet[k]:=True;
|
||||
end
|
||||
end; {for}
|
||||
if FileName='' then
|
||||
@ -242,7 +240,7 @@ begin
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------------
|
||||
Code for reading the input file.
|
||||
Code for reading the input file.
|
||||
------------------------------------------------------------------------ }
|
||||
|
||||
|
||||
@ -251,7 +249,7 @@ begin
|
||||
if pos('.fd',FileName)=0 then
|
||||
FileName:=FileName+'.fd';
|
||||
assign(infile,Filename);
|
||||
{$i-}
|
||||
{$i-}
|
||||
reset (infile);
|
||||
{$i+}
|
||||
if ioresult<>0 then
|
||||
@ -259,7 +257,7 @@ begin
|
||||
EmitError('Can''t open : '+filename);
|
||||
halt(1);
|
||||
end;
|
||||
LineNr:=0;
|
||||
LineNr:=0;
|
||||
end;
|
||||
|
||||
Procedure CloseFile;
|
||||
@ -273,7 +271,7 @@ Procedure GetLine(Var S : String);
|
||||
begin
|
||||
inc(LineNr);
|
||||
Readln(infile,s);
|
||||
{$ifdef debug}
|
||||
{$ifdef debug}
|
||||
writeln ('Reading line : ',linenr)
|
||||
{$endif}
|
||||
end;
|
||||
@ -281,17 +279,17 @@ end;
|
||||
Procedure ProcessPreAmbleLine (Const s: String);
|
||||
|
||||
var key,value : string;
|
||||
ppos : Longint;
|
||||
ppos : Longint;
|
||||
i,k : PreProps;
|
||||
code : Word;
|
||||
|
||||
|
||||
begin
|
||||
if s='' then exit;
|
||||
ppos:=pos(':',s);
|
||||
if ppos=0 then
|
||||
exit;
|
||||
Key:=Copy(s,1,ppos-1);
|
||||
Value:=Copy(s,ppos+2,length(s)-ppos-1);
|
||||
Value:=Copy(s,ppos+2,length(s)-ppos-1);
|
||||
k:=PPinvalid;
|
||||
for i:=PPmagic to PPinvalid do
|
||||
if key=PrePropNames[i] then k:=i;
|
||||
@ -299,17 +297,17 @@ begin
|
||||
EmitLineError('Unknown keyword : '+Key)
|
||||
else
|
||||
Case K of
|
||||
PPMagic : Magic:=key;
|
||||
PPMagic,
|
||||
PPunitofmeasure: ;
|
||||
PPnrforms: begin
|
||||
val(value,NrForms,code);
|
||||
if code<>0 then EmitLineError('Invalid number of forms');
|
||||
end;
|
||||
PPunitofmeasure: UnitOfMeasure:=Value;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------------
|
||||
Code for reading preamble.
|
||||
Code for reading preamble.
|
||||
------------------------------------------------------------------------ }
|
||||
|
||||
|
||||
@ -330,7 +328,7 @@ begin
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------------
|
||||
Code for reading 1 object.
|
||||
Code for reading 1 object.
|
||||
------------------------------------------------------------------------ }
|
||||
|
||||
|
||||
@ -338,15 +336,15 @@ Procedure ProcessControlLine (PC : PControl; const S : String);
|
||||
|
||||
Var Key,Value : String;
|
||||
i,k : ContProps;
|
||||
ppos,code : word;
|
||||
|
||||
ppos : word;
|
||||
|
||||
begin
|
||||
if s='' then exit;
|
||||
ppos:=pos(':',s);
|
||||
if ppos=0 then
|
||||
exit;
|
||||
Key:=Copy(s,1,ppos-1);
|
||||
Value:=Copy(s,ppos+2,length(s)-ppos-1);
|
||||
Value:=Copy(s,ppos+2,length(s)-ppos-1);
|
||||
K:=CPInvalid;
|
||||
For i:=CPclass to CPInvalid do
|
||||
if ContPropNames[i]=Key then k:=i;
|
||||
@ -376,7 +374,7 @@ begin
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------------
|
||||
Code for reading 1 form.
|
||||
Code for reading 1 form.
|
||||
------------------------------------------------------------------------ }
|
||||
|
||||
Procedure ProcessFormLine (PF : PFormRec; const S : String);
|
||||
@ -384,14 +382,14 @@ Procedure ProcessFormLine (PF : PFormRec; const S : String);
|
||||
Var Key,Value : String;
|
||||
i,k : FormProps;
|
||||
ppos,code : word;
|
||||
|
||||
|
||||
begin
|
||||
if s='' then exit;
|
||||
ppos:=pos(':',s);
|
||||
if ppos=0 then
|
||||
exit;
|
||||
Key:=Copy(s,1,ppos-1);
|
||||
Value:=Copy(s,ppos+2,length(s)-ppos-1);
|
||||
Value:=Copy(s,ppos+2,length(s)-ppos-1);
|
||||
K:=FPInvalid;
|
||||
For i:=FPName to FPInvalid do
|
||||
if FormPropNames[i]=Key then k:=i;
|
||||
@ -416,7 +414,7 @@ Procedure ProcessForm (PF : PFormRec);
|
||||
Var line : String;
|
||||
CurrentControl : PControl;
|
||||
I : Integer;
|
||||
|
||||
|
||||
begin
|
||||
{$ifdef debug}
|
||||
writeln('Starting form');
|
||||
@ -455,16 +453,16 @@ begin
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------------
|
||||
Code for reading the forms.
|
||||
Code for reading the forms.
|
||||
------------------------------------------------------------------------ }
|
||||
|
||||
|
||||
Procedure DoForms;
|
||||
|
||||
Var Line : String;
|
||||
Var
|
||||
i : Longint;
|
||||
CurrentForm: PformRec;
|
||||
|
||||
|
||||
begin
|
||||
FormRoot:=Nil;
|
||||
if NrForms=0 then exit;
|
||||
@ -473,7 +471,7 @@ begin
|
||||
for i:=1 to nrforms do
|
||||
begin
|
||||
ProcessForm (CurrentForm);
|
||||
If i=nrforms then
|
||||
If i=nrforms then
|
||||
Currentform^.NextForm:=nil
|
||||
else
|
||||
New(CurrentForm^.NextForm);
|
||||
@ -482,7 +480,7 @@ begin
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------------
|
||||
Code for reading the postamble.
|
||||
Code for reading the postamble.
|
||||
------------------------------------------------------------------------ }
|
||||
|
||||
|
||||
@ -492,7 +490,7 @@ begin
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------------
|
||||
Code for writing the output file.
|
||||
Code for writing the output file.
|
||||
------------------------------------------------------------------------ }
|
||||
|
||||
Procedure OpenOutFile;
|
||||
@ -512,7 +510,7 @@ begin
|
||||
{$i-}
|
||||
rewrite(outfile);
|
||||
{$i+}
|
||||
if ioresult<>0 then
|
||||
if ioresult<>0 then
|
||||
begin
|
||||
EmitError('Couldn''t open output file : '+filename);
|
||||
halt(1)
|
||||
@ -526,7 +524,7 @@ begin
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------------
|
||||
Code to emit Header/variable/type declarations
|
||||
Code to emit Header/variable/type declarations
|
||||
------------------------------------------------------------------------ }
|
||||
|
||||
|
||||
@ -540,7 +538,7 @@ begin
|
||||
writeln (OutFile,' vdata : Pointer;');
|
||||
writeln (OutFile,' ldata : Longint;');
|
||||
cp:=fp^.controls;
|
||||
{Skip first control, is formbackground }
|
||||
{Skip first control, is formbackground }
|
||||
if cp<>nil then cp:=cp^.nextcontrol;
|
||||
while cp<>nil do
|
||||
begin
|
||||
@ -566,7 +564,7 @@ var cp : PControl;
|
||||
begin
|
||||
writeln (OutFile,' ',fp^.name,' : PFL_FORM;');
|
||||
cp:=fp^.controls;
|
||||
{Skip first control, is formbackground }
|
||||
{Skip first control, is formbackground }
|
||||
if cp<>nil then cp:=cp^.nextcontrol;
|
||||
while cp<>nil do
|
||||
begin
|
||||
@ -586,7 +584,6 @@ end;
|
||||
Procedure EmitHeader;
|
||||
|
||||
var fp : PFormRec;
|
||||
cp : PControl;
|
||||
|
||||
begin
|
||||
if OptionsSet[2] then
|
||||
@ -618,12 +615,12 @@ begin
|
||||
EmitVar(fp); { Emit Variable declaration}
|
||||
fp:=fp^.nextform;
|
||||
end;
|
||||
if not optionsset[2] then
|
||||
if not optionsset[2] then
|
||||
begin
|
||||
{ No program, we must emit interface stuff }
|
||||
if not (optionsset[3]) then
|
||||
begin
|
||||
{ Emit normal interface declarations
|
||||
{ Emit normal interface declarations
|
||||
-> functions }
|
||||
fp:=formroot;
|
||||
while fp<>nil do
|
||||
@ -635,7 +632,7 @@ begin
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ Emit alternate interface declaration
|
||||
{ Emit alternate interface declaration
|
||||
-> 1 function to create all forms.}
|
||||
writeln (OutFile,'Procedure Create_The_Forms;');
|
||||
end;
|
||||
@ -681,13 +678,10 @@ begin
|
||||
fp:=fp^.nextform;
|
||||
end;
|
||||
writeln (outFile,'End;');
|
||||
writeln (OutFile);
|
||||
writeln (OutFile);
|
||||
end;
|
||||
|
||||
Procedure EmitAlternateMain;
|
||||
|
||||
var fp : PFormRec;
|
||||
|
||||
begin
|
||||
{ Alternate format, we just call creatallforms to create all forms}
|
||||
writeln (OutFile,'Create_The_Forms;');
|
||||
@ -709,16 +703,13 @@ begin
|
||||
writeln (OutFile,' ',fp^.name,' :=Create_Form_',fp^.name,';');
|
||||
fp:=fp^.nextform;
|
||||
end;
|
||||
{ Show the first form }
|
||||
{ Show the first form }
|
||||
writeln (OutFile,' fl_show_form(',formroot^.name,'^.',Formroot^.name,
|
||||
',FL_PLACE_CENTER,FL_FULLBORDER,''',
|
||||
FormRoot^.name,''');');
|
||||
end;
|
||||
|
||||
Procedure EmitFooter;
|
||||
|
||||
var fp : PFormRec;
|
||||
|
||||
begin
|
||||
if OptionsSet[3] then {Alternate format.}
|
||||
EmitCreateForms;
|
||||
@ -778,7 +769,7 @@ end;
|
||||
|
||||
Procedure EmitColors (cp : PControl;ObjClass : ObjClasses);
|
||||
|
||||
var temp : string;
|
||||
var temp : string;
|
||||
|
||||
begin
|
||||
if cp^.props[cpcolors]<>defprops[objclass,APcolors] then
|
||||
@ -856,13 +847,12 @@ end;
|
||||
Procedure EmitObject(cp : PControl);
|
||||
|
||||
var temp : string;
|
||||
Corners : array[1..4] of string[5];
|
||||
I : Longint;
|
||||
I : Longint;
|
||||
j,k : ObjClasses;
|
||||
|
||||
begin
|
||||
with cp^ do
|
||||
begin
|
||||
begin
|
||||
temp:=lowercase(props[CPclass]);
|
||||
delete(temp,1,3);
|
||||
if temp='begin_group' then
|
||||
@ -904,7 +894,7 @@ with cp^ do
|
||||
k:=FL_INVALID;
|
||||
for j:=FL_BUTTON to FL_FOLDER do
|
||||
if temp=DefProps[j,apclass] then k:=j;
|
||||
if k<>FL_INVALID then
|
||||
if k<>FL_INVALID then
|
||||
begin
|
||||
{ Emit defaults }
|
||||
EmitProperties (cp,k);
|
||||
@ -912,12 +902,12 @@ with cp^ do
|
||||
if Assigned(ClassEmitters[k]) then
|
||||
ClassEmitters[k] (cp,k);
|
||||
end;
|
||||
{ Assign to needed object. }
|
||||
{ Assign to needed object. }
|
||||
if Optionsset[3] then
|
||||
Writeln (OutFile,' ',props[cpname],':=obj;')
|
||||
else
|
||||
else
|
||||
Writeln (OutFile,' fdui^.',props[cpname],':=obj;');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------------
|
||||
@ -963,7 +953,7 @@ with fp^ do
|
||||
EmitString (cp^.props[CPname]),');');
|
||||
cp:=cp^.nextcontrol;
|
||||
{ Emit all objects }
|
||||
while cp<>nil do
|
||||
while cp<>nil do
|
||||
begin
|
||||
EmitObject(cp);
|
||||
cp:=cp^.nextcontrol;
|
||||
@ -983,18 +973,15 @@ with fp^ do
|
||||
end;
|
||||
writeln (OutFile,'end;');
|
||||
writeln (OutFile);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure EmitForms;
|
||||
|
||||
var
|
||||
|
||||
fp : PformRec;
|
||||
cp : PControl;
|
||||
|
||||
fp : PformRec;
|
||||
begin
|
||||
{ Start emitting forms }
|
||||
{ Start emitting forms }
|
||||
fp:=Formroot;
|
||||
while fp<>nil do
|
||||
begin
|
||||
@ -1012,7 +999,7 @@ Procedure CollectCallbacks;
|
||||
Var CurrentCb,CBwalk : PCBrec;
|
||||
fp : PformRec;
|
||||
cp : PControl;
|
||||
|
||||
|
||||
begin
|
||||
CbRoot:=nil;
|
||||
CurrentCB:=cbroot;
|
||||
@ -1049,7 +1036,7 @@ begin
|
||||
cp:=cp^.nextcontrol;
|
||||
end;
|
||||
fp:=fp^.nextform;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure EmitCallback (Const s : string);
|
||||
@ -1061,7 +1048,7 @@ begin
|
||||
writeln (OutFile,' { Place your code here }');
|
||||
writeln (OutFile,'end;');
|
||||
writeln (OutFile);
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure EmitCallBacks;
|
||||
|
||||
@ -1076,13 +1063,13 @@ begin
|
||||
begin
|
||||
EmitCallBack(cb^.Name);
|
||||
cb:=cb^.next;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ ------------------------------------------------------------------------
|
||||
EmitterTable initialization Code
|
||||
EmitterTable initialization Code
|
||||
------------------------------------------------------------------------ }
|
||||
|
||||
Procedure EmitDummy (cp : PControl;ObjClass : ObjClasses);
|
||||
@ -1103,12 +1090,12 @@ begin
|
||||
EmitProcs[APsize]:=@EmitSize;
|
||||
EmitProcs[APStyle]:=@EmitStyle;
|
||||
EmitProcs[APgravity]:=@EmitGravity;
|
||||
for i:=FL_INVALID to FL_FOLDER do
|
||||
for i:=FL_INVALID to FL_FOLDER do
|
||||
ClassEmitters[i]:=EmitProp(Nil);
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------------
|
||||
Main program Code
|
||||
Main program Code
|
||||
------------------------------------------------------------------------ }
|
||||
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -742,7 +742,6 @@ End;
|
||||
function Keypressed : boolean;
|
||||
var
|
||||
l : longint;
|
||||
fd : fdSet;
|
||||
Begin
|
||||
Keypressed := FALSE;
|
||||
nodelay(ActiveWn,bool(TRUE));
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -46,7 +46,7 @@ type
|
||||
var
|
||||
nActive, nNextEdge : Longint;
|
||||
p0, p1 : pointtype;
|
||||
endy, i, j, gap, x0, x1, y, nEdges : Longint;
|
||||
i, j, gap, x0, x1, y, nEdges : Longint;
|
||||
ET : pedgearray;
|
||||
GET, AET : ppedgearray;
|
||||
t : pedge;
|
||||
@ -68,7 +68,7 @@ begin
|
||||
ptable := @polypoints;
|
||||
|
||||
{ check for getmem success }
|
||||
|
||||
|
||||
nEdges := 0;
|
||||
for i := 0 to (numpoints-1) do begin
|
||||
p0 := ptable[i];
|
||||
@ -368,7 +368,6 @@ var
|
||||
Cont : Boolean;
|
||||
BackupColor : Word;
|
||||
x1, x2, prevy: smallint;
|
||||
Index : smallint;
|
||||
Begin
|
||||
FillChar(DrawnList,sizeof(DrawnList),0);
|
||||
{ init prevy }
|
||||
@ -387,8 +386,6 @@ var
|
||||
end;
|
||||
If (x<0) Or (y<0) Or
|
||||
(x>ViewWidth) Or (y>ViewHeight) then Exit;
|
||||
{ Some internal variables }
|
||||
Index := 0;
|
||||
{ Index of points to check }
|
||||
Buffer.WordIndex:=0;
|
||||
PushPoint (x,y);
|
||||
@ -482,7 +479,10 @@ var
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.17 2000-02-12 13:39:19 jonas
|
||||
Revision 1.18 2000-02-27 14:41:25 peter
|
||||
* removed warnings/notes
|
||||
|
||||
Revision 1.17 2000/02/12 13:39:19 jonas
|
||||
+ new, faster fillpoly from Thomas Schatzl
|
||||
* some logging commands in vesa.inc disabled
|
||||
|
||||
|
||||
@ -2099,55 +2099,28 @@ end;
|
||||
Begin
|
||||
{ All default hooks procedures }
|
||||
|
||||
{$ifdef fpc}
|
||||
{ required...}
|
||||
DirectPutPixel := @DirectPutPixelDefault;
|
||||
PutPixel := @PutPixelDefault;
|
||||
GetPixel := @GetPixelDefault;
|
||||
SetRGBPalette := @SetRGBPaletteDefault;
|
||||
GetRGBPalette := @GetRGBPaletteDefault;
|
||||
|
||||
DirectPutPixel := {$ifdef fpc}@{$endif}DirectPutPixelDefault;
|
||||
PutPixel := {$ifdef fpc}@{$endif}PutPixelDefault;
|
||||
GetPixel := {$ifdef fpc}@{$endif}GetPixelDefault;
|
||||
SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteDefault;
|
||||
GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteDefault;
|
||||
|
||||
{ optional...}
|
||||
SetActivePage := @SetActivePageDefault;
|
||||
SetVisualPage := @SetVisualPageDefault;
|
||||
ClearViewPort := @ClearViewportDefault;
|
||||
PutImage := @DefaultPutImage;
|
||||
GetImage := @DefaultGetImage;
|
||||
ImageSize := @DefaultImageSize;
|
||||
{$else fpc}
|
||||
{ required...}
|
||||
DirectPutPixel := DirectPutPixelDefault;
|
||||
PutPixel := PutPixelDefault;
|
||||
GetPixel := GetPixelDefault;
|
||||
SetRGBPalette := SetRGBPaletteDefault;
|
||||
GetRGBPalette := GetRGBPaletteDefault;
|
||||
|
||||
{ optional...}
|
||||
SetActivePage := SetActivePageDefault;
|
||||
SetVisualPage := SetVisualPageDefault;
|
||||
ClearViewPort := ClearViewportDefault;
|
||||
PutImage := DefaultPutImage;
|
||||
GetImage := DefaultGetImage;
|
||||
ImageSize := DefaultImageSize;
|
||||
{$endif fpc}
|
||||
SetActivePage := {$ifdef fpc}@{$endif}SetActivePageDefault;
|
||||
SetVisualPage := {$ifdef fpc}@{$endif}SetVisualPageDefault;
|
||||
ClearViewPort := {$ifdef fpc}@{$endif}ClearViewportDefault;
|
||||
PutImage := {$ifdef fpc}@{$endif}DefaultPutImage;
|
||||
GetImage := {$ifdef fpc}@{$endif}DefaultGetImage;
|
||||
ImageSize := {$ifdef fpc}@{$endif}DefaultImageSize;
|
||||
GraphFreeMemPtr := nil;
|
||||
GraphGetMemPtr := nil;
|
||||
{$ifdef fpc}
|
||||
GetScanLine := @GetScanLineDefault;
|
||||
Line := @LineDefault;
|
||||
InternalEllipse := @InternalEllipseDefault;
|
||||
PatternLine := @PatternLineDefault;
|
||||
HLine := @HLineDefault;
|
||||
VLine := @VLineDefault;
|
||||
{$else fpc}
|
||||
GetScanLine := GetScanLineDefault;
|
||||
Line := LineDefault;
|
||||
InternalEllipse := InternalEllipseDefault;
|
||||
PatternLine := PatternLineDefault;
|
||||
HLine := HLineDefault;
|
||||
VLine := VLineDefault;
|
||||
{$endif fpc}
|
||||
GetScanLine := {$ifdef fpc}@{$endif}GetScanLineDefault;
|
||||
Line := {$ifdef fpc}@{$endif}LineDefault;
|
||||
InternalEllipse := {$ifdef fpc}@{$endif}InternalEllipseDefault;
|
||||
PatternLine := {$ifdef fpc}@{$endif}PatternLineDefault;
|
||||
HLine := {$ifdef fpc}@{$endif}HLineDefault;
|
||||
VLine := {$ifdef fpc}@{$endif}VLineDefault;
|
||||
end;
|
||||
|
||||
Procedure InitVars;
|
||||
@ -2176,6 +2149,7 @@ end;
|
||||
PaletteSize := 0;
|
||||
DirectColor := FALSE;
|
||||
HardwarePages := 0;
|
||||
if hardwarepages=0 then; { remove note }
|
||||
DefaultHooks;
|
||||
end;
|
||||
|
||||
@ -2212,22 +2186,14 @@ end;
|
||||
{ OldWriteMode := CurrentWriteMode;
|
||||
if (LineInfo.Thickness = NormWidth) then
|
||||
CurrentWriteMode := NormalPut;}
|
||||
{$ifdef fpc}
|
||||
InternalEllipse(X,Y,Radius,Radius,StAngle,Endangle,@DummyPatternLine);
|
||||
{$else fpc}
|
||||
InternalEllipse(X,Y,Radius,Radius,StAngle,Endangle,DummyPatternLine);
|
||||
{$endif fpc}
|
||||
InternalEllipse(X,Y,Radius,Radius,StAngle,Endangle,{$ifdef fpc}@{$endif}DummyPatternLine);
|
||||
{ CurrentWriteMode := OldWriteMode;}
|
||||
end;
|
||||
|
||||
|
||||
procedure Ellipse(X,Y : smallint; stAngle, EndAngle: word; XRadius,YRadius: word);
|
||||
Begin
|
||||
{$ifdef fpc}
|
||||
InternalEllipse(X,Y,XRadius,YRadius,StAngle,Endangle,@DummyPatternLine);
|
||||
{$else fpc}
|
||||
InternalEllipse(X,Y,XRadius,YRadius,StAngle,Endangle,DummyPatternLine);
|
||||
{$endif fpc}
|
||||
InternalEllipse(X,Y,XRadius,YRadius,StAngle,Endangle,{$ifdef fpc}@{$endif}DummyPatternLine);
|
||||
end;
|
||||
|
||||
|
||||
@ -2278,11 +2244,7 @@ end;
|
||||
OldWriteMode := CurrentWriteMode;
|
||||
CurrentWriteMode := CopyPut;
|
||||
end;
|
||||
{$ifdef fpc}
|
||||
InternalEllipse(X,Y,Radius,Radius,0,360,@DummyPatternLine);
|
||||
{$else fpc}
|
||||
InternalEllipse(X,Y,Radius,Radius,0,360,DummyPatternLine);
|
||||
{$endif fpc}
|
||||
InternalEllipse(X,Y,Radius,Radius,0,360,{$ifdef fpc}@{$endif}DummyPatternLine);
|
||||
if LineInfo.Thickness = Normwidth then
|
||||
CurrentWriteMode := OldWriteMode;
|
||||
{ restore arc information }
|
||||
@ -2455,14 +2417,8 @@ end;
|
||||
end;
|
||||
|
||||
procedure Sector(x, y: smallint; StAngle,EndAngle, XRadius, YRadius: Word);
|
||||
(* var angle : graph_float;
|
||||
writemode : word; *)
|
||||
begin
|
||||
{$ifdef fpc}
|
||||
internalellipse(x,y,XRadius, YRadius, StAngle, EndAngle, @SectorPL);
|
||||
{$else fpc}
|
||||
internalellipse(x,y,XRadius, YRadius, StAngle, EndAngle, SectorPL);
|
||||
{$endif fpc}
|
||||
internalellipse(x,y,XRadius, YRadius, StAngle, EndAngle, {$ifdef fpc}@{$endif}SectorPL);
|
||||
Line(ArcCall.XStart, ArcCall.YStart, x,y);
|
||||
Line(x,y,ArcCall.Xend,ArcCall.YEnd);
|
||||
end;
|
||||
@ -3010,7 +2966,6 @@ begin
|
||||
ModeList := nil;
|
||||
SaveVideoState := nil;
|
||||
RestoreVideoState := nil;
|
||||
SavePtr := Nil;
|
||||
{$ifdef oldfont}
|
||||
{$ifdef go32v2}
|
||||
LoadFont8x8;
|
||||
@ -3045,14 +3000,12 @@ begin
|
||||
charmessagehandler:=nil;
|
||||
{$endif win32}
|
||||
end.
|
||||
|
||||
|
||||
SetGraphBufSize
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.56 2000-02-06 01:47:15 sg
|
||||
Revision 1.57 2000-02-27 14:41:25 peter
|
||||
* removed warnings/notes
|
||||
|
||||
Revision 1.56 2000/02/06 01:47:15 sg
|
||||
* For Linux, "/" is added to the bgipath instead of "\" if this character
|
||||
isn't already there.
|
||||
|
||||
|
||||
@ -368,7 +368,6 @@
|
||||
cnt3,cnt4 : smallint;
|
||||
charsize : word;
|
||||
WriteMode : word;
|
||||
CurX, CurY : smallint;
|
||||
curX2, curY2, xpos2, ypos2, x2, y2: graph_float;
|
||||
oldvalues : linesettingstype;
|
||||
chr : char;
|
||||
@ -591,7 +590,6 @@
|
||||
Prefix: array[0..Prefix_Size-1] of char; {* File Prefix Holder *}
|
||||
Length, Current: longint;
|
||||
FontData: Pchar;
|
||||
Base: longint;
|
||||
hp : pchar;
|
||||
i : longint;
|
||||
begin
|
||||
@ -685,22 +683,14 @@
|
||||
move(hp[i+1],fonts[font].PHeader,sizeof(TFHeader));
|
||||
(* Read in the Header file *)
|
||||
BlockRead(F,fonts[font].Header,Sizeof(THeader));
|
||||
Base := FilePos(F); {* Remember the address of table*}
|
||||
|
||||
BlockRead(F,Fonts[font].Offsets[Fonts[font].Header.First_Char],Fonts[font].Header.Nr_chars*sizeof(smallint));
|
||||
|
||||
{* Load the character width table into memory. *}
|
||||
|
||||
base := filePos( f );
|
||||
BlockRead(F,Fonts[font].Widths[Fonts[font].Header.First_Char],Fonts[font].Header.Nr_chars*sizeof(byte));
|
||||
|
||||
{* Determine the length of the stroke database. *}
|
||||
|
||||
current := FilePos( f ); {* Current file location *}
|
||||
Seek( f, FileSize(F)); {* Go to the end of the file *}
|
||||
length := FilePos( f ); {* Get the file length *}
|
||||
Seek( f, current); {* Restore old file location *}
|
||||
|
||||
{* Load the stroke database. *}
|
||||
{ also allocate space for Null character }
|
||||
Getmem(FontData, Length+1); {* Create space for font data *}
|
||||
@ -737,7 +727,10 @@
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.14 2000-01-07 16:41:38 daniel
|
||||
Revision 1.15 2000-02-27 14:41:25 peter
|
||||
* removed warnings/notes
|
||||
|
||||
Revision 1.14 2000/01/07 16:41:38 daniel
|
||||
* copyright 2000
|
||||
|
||||
Revision 1.13 2000/01/07 16:32:26 daniel
|
||||
|
||||
@ -89,7 +89,7 @@ var
|
||||
procedure getIntPart(d: extended);
|
||||
var
|
||||
intPartStack: TIntPartStack;
|
||||
count, stackPtr, endStackPtr, digits: longint;
|
||||
stackPtr, endStackPtr, digits: longint;
|
||||
overflow: boolean;
|
||||
begin
|
||||
{ position in the stack (gets increased before first write) }
|
||||
@ -376,7 +376,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.24 2000-02-26 18:53:11 jonas
|
||||
Revision 1.25 2000-02-27 14:41:25 peter
|
||||
* removed warnings/notes
|
||||
|
||||
Revision 1.24 2000/02/26 18:53:11 jonas
|
||||
* fix for lost precision because sometimes the correction value was
|
||||
larger than the number to be corrected
|
||||
* incompatibility with TP's output fixed
|
||||
|
||||
@ -20,9 +20,6 @@
|
||||
const
|
||||
InternalDriverName = 'LinuxGGI';
|
||||
|
||||
var
|
||||
SavePtr: Pointer;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
GGI bindings [(c) 1999 Sebastian Guenther]
|
||||
---------------------------------------------------------------------}
|
||||
@ -433,43 +430,43 @@ begin
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.8 2000-01-07 16:41:40 daniel
|
||||
* copyright 2000
|
||||
$Log$
|
||||
Revision 1.9 2000-02-27 14:41:25 peter
|
||||
* removed warnings/notes
|
||||
|
||||
Revision 1.7 1999/12/20 11:22:38 peter
|
||||
* modes moved to interface
|
||||
* integer -> smallint
|
||||
Revision 1.8 2000/01/07 16:41:40 daniel
|
||||
* copyright 2000
|
||||
|
||||
Revision 1.6 1999/12/11 23:41:39 jonas
|
||||
* changed definition of getscanlineproc to "getscanline(x1,x2,y:
|
||||
smallint; var data);" so it can be used by getimage too
|
||||
* changed getimage so it uses getscanline
|
||||
* changed floodfill, getscanline16 and definitions in Linux
|
||||
include files so they use this new format
|
||||
+ getscanlineVESA256 for 256 color VESA modes (banked)
|
||||
Revision 1.7 1999/12/20 11:22:38 peter
|
||||
* modes moved to interface
|
||||
* integer -> smallint
|
||||
|
||||
Revision 1.5 1999/11/12 02:13:01 carl
|
||||
* Bugfix if getimage / putimage, format was not standard with FPC
|
||||
graph.
|
||||
Revision 1.6 1999/12/11 23:41:39 jonas
|
||||
* changed definition of getscanlineproc to "getscanline(x1,x2,y:
|
||||
smallint; var data);" so it can be used by getimage too
|
||||
* changed getimage so it uses getscanline
|
||||
* changed floodfill, getscanline16 and definitions in Linux
|
||||
include files so they use this new format
|
||||
+ getscanlineVESA256 for 256 color VESA modes (banked)
|
||||
|
||||
Revision 1.4 1999/11/10 10:54:24 sg
|
||||
* Fixed a LOT of bugs:
|
||||
* - Default mode should be determined by GGI now
|
||||
* - Colors are working (only the 16 standard VGA colors, though)
|
||||
Revision 1.5 1999/11/12 02:13:01 carl
|
||||
* Bugfix if getimage / putimage, format was not standard with FPC
|
||||
graph.
|
||||
|
||||
Revision 1.3 1999/11/08 20:04:55 sg
|
||||
* GGI programs must link to libc, or ggiOpen will fail!
|
||||
* Changed max length of ModeNames string from 18 to 20 chars
|
||||
Revision 1.4 1999/11/10 10:54:24 sg
|
||||
* Fixed a LOT of bugs:
|
||||
* - Default mode should be determined by GGI now
|
||||
* - Colors are working (only the 16 standard VGA colors, though)
|
||||
|
||||
Revision 1.2 1999/11/08 00:08:43 michael
|
||||
* Fist working version of svgalib new graph unit
|
||||
* Initial implementation of ggi new graph unit
|
||||
Revision 1.3 1999/11/08 20:04:55 sg
|
||||
* GGI programs must link to libc, or ggiOpen will fail!
|
||||
* Changed max length of ModeNames string from 18 to 20 chars
|
||||
|
||||
Revision 1.1 1999/11/07 16:57:26 michael
|
||||
+ Start of common graph implementation
|
||||
Revision 1.2 1999/11/08 00:08:43 michael
|
||||
* Fist working version of svgalib new graph unit
|
||||
* Initial implementation of ggi new graph unit
|
||||
|
||||
Revision 1.1 1999/11/07 16:57:26 michael
|
||||
+ Start of common graph implementation
|
||||
}
|
||||
|
||||
@ -17,8 +17,6 @@
|
||||
const
|
||||
InternalDriverName = 'LinuxVGA';
|
||||
|
||||
var SavePtr : Pointer;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
SVGA bindings.
|
||||
|
||||
@ -161,12 +159,10 @@ var
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
procedure libvga_savevideostate;
|
||||
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure libvga_restorevideostate;
|
||||
|
||||
begin
|
||||
vga_setmode(0);
|
||||
end;
|
||||
@ -449,26 +445,29 @@ end;
|
||||
end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.8 2000-02-06 11:26:45 sg
|
||||
* Fixed SetRGBPalette and GetRGBPalette (hopefully; not tested)
|
||||
$Log$
|
||||
Revision 1.9 2000-02-27 14:41:25 peter
|
||||
* removed warnings/notes
|
||||
|
||||
Revision 1.7 2000/02/06 01:48:55 sg
|
||||
* Fixed the default palette. libsvga works with a RGB range from 0-63, not
|
||||
0-255!
|
||||
* PutPixel fixed (pixels didn't get drawn before)
|
||||
Revision 1.8 2000/02/06 11:26:45 sg
|
||||
* Fixed SetRGBPalette and GetRGBPalette (hopefully; not tested)
|
||||
|
||||
Revision 1.6 2000/02/03 20:39:58 michael
|
||||
+ Version using only vgalib
|
||||
Revision 1.7 2000/02/06 01:48:55 sg
|
||||
* Fixed the default palette. libsvga works with a RGB range from 0-63, not
|
||||
0-255!
|
||||
* PutPixel fixed (pixels didn't get drawn before)
|
||||
|
||||
Revision 1.5 2000/01/07 16:41:42 daniel
|
||||
Revision 1.6 2000/02/03 20:39:58 michael
|
||||
+ Version using only vgalib
|
||||
|
||||
Revision 1.5 2000/01/07 16:41:42 daniel
|
||||
* copyright 2000
|
||||
|
||||
Revision 1.4 1999/12/20 11:22:38 peter
|
||||
Revision 1.4 1999/12/20 11:22:38 peter
|
||||
* modes moved to interface
|
||||
* integer -> smallint
|
||||
|
||||
Revision 1.3 1999/12/11 23:41:39 jonas
|
||||
Revision 1.3 1999/12/11 23:41:39 jonas
|
||||
* changed definition of getscanlineproc to "getscanline(x1,x2,y:
|
||||
integer; var data);" so it can be used by getimage too
|
||||
* changed getimage so it uses getscanline
|
||||
@ -476,11 +475,10 @@ Revision 1.3 1999/12/11 23:41:39 jonas
|
||||
include files so they use this new format
|
||||
+ getscanlineVESA256 for 256 color VESA modes (banked)
|
||||
|
||||
Revision 1.2 1999/11/08 00:08:43 michael
|
||||
* Fist working version of svgalib new graph unit
|
||||
* Initial implementation of ggi new graph unit
|
||||
|
||||
Revision 1.1 1999/11/07 16:57:26 michael
|
||||
+ Start of common graph implementation
|
||||
Revision 1.2 1999/11/08 00:08:43 michael
|
||||
* Fist working version of svgalib new graph unit
|
||||
* Initial implementation of ggi new graph unit
|
||||
|
||||
Revision 1.1 1999/11/07 16:57:26 michael
|
||||
+ Start of common graph implementation
|
||||
}
|
||||
|
||||
@ -87,7 +87,7 @@ end ;
|
||||
function MSecsToTimeStamp(MSecs: comp): TTimeStamp;
|
||||
begin
|
||||
result.Date := trunc(msecs / msecsperday);
|
||||
msecs:= msecs - comp(result.date) * comp(msecsperday);
|
||||
msecs:= comp(msecs-result.date*msecsperday);
|
||||
result.Time := Trunc(MSecs);
|
||||
end ;
|
||||
|
||||
@ -680,7 +680,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.20 2000-02-09 16:59:32 peter
|
||||
Revision 1.21 2000-02-27 14:41:25 peter
|
||||
* removed warnings/notes
|
||||
|
||||
Revision 1.20 2000/02/09 16:59:32 peter
|
||||
* truncated log
|
||||
|
||||
Revision 1.19 1999/11/29 16:59:27 pierre
|
||||
|
||||
Loading…
Reference in New Issue
Block a user