summaryrefslogtreecommitdiff
path: root/install/macosx/xcode/FPC-C-C++ Carbon Application/MainUnit.pas
blob: 0f602e7f366decbf0d974ba74a66c77456bb1369 (plain)
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
unit MainUnit;

interface

uses
	MacTypes;

procedure RunMainProcedure;
	
procedure Message(msg: Str255);
procedure _Message(msg: Str255); C;

implementation

uses
	FPCMacOSAll, CSupport;

var
	gCurrentY: SInt16;
	
{-------------------------------- }

procedure RunMainProcedure;

label
	whenErr;
	
var
	err: OSStatus;
	nib: IBNibRef;
	win: WindowRef;
	str: Str255;
	fID: SInt16;
	val: SInt32;
	
begin

    // 1st the usual simple window and menubar from nib:
	
    err:= CreateNibReference(CFSTR('main'), nib);
    if err <> noErr then goto whenErr;

    err:= SetMenuBarFromNib(nib, CFSTR('MenuBar'));
    if err <> noErr then goto whenErr;

    err := CreateWindowFromNib(nib, CFSTR('MainWindow'), win);
    if err <> noErr then goto whenErr;

    DisposeNibReference(nib);

    ShowWindow(win);
    SetPort(GetWindowPort(win));
	
	// get 12 pt Geneva bold text:
	
	GetFNum('Geneva', fID);
	TextFont(fID);
	TextSize(12);
	TextFace(bold);

	// call Message directly:
	Message('FPC Carbon app with C/C++ support.');
	
	// call Message through external C:
	val:= CFunction;
	NumToString(val, str);
	Message('CFunction return val = ' + str);

	// do the same through external C++:
	val:= CPlusFunction;
	NumToString(val, str);
	Message('CPlusFunction return val = ' + str);

	Message('');
	Message('That''s all. You may as well quit now.');

	// event loop until quit
    RunApplicationEventLoop;

	Halt(0);
	
whenErr:	
    Halt(1);
end;

{-------------------------------- }

procedure Message(msg: Str255);
begin
	MoveTo(10, gCurrentY);
	DrawString(msg);
	gCurrentY:= gCurrentY + 24;
end;
	
{-------------------------------- }

procedure _Message(msg: Str255); C;
alias: '_Message';
begin Message(msg);
end;

begin
	gCurrentY:= 30;
end.