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

Amiga: Fixed example sources for new varargs

Browse Source 
git-svn-id: trunk@33239 -
This commit is contained in:
marcus 2016-03-13 17:08:22 +00:00
parent 671416959d
commit 38c98b02c0
41 changed files with 345 additions and 216 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
packages/amunits/examples/asltest.pas
View File

@ -26,13 +26,13 @@ VAR
BEGIN
fr := AllocAslRequestTags(ASL_FileRequest,[
ASLFR_InitialPattern,'#?',
ASLFR_TitleText,'Test av ASL-Requester by NS',
ASLFR_DoPatterns,ltrue,
ASLFR_InitialPattern, AsTag('#?'),
ASLFR_TitleText, AsTag('Test av ASL-Requester by NS'),
ASLFR_DoPatterns, LTrue,
TAG_DONE]);
IF fr <> nil THEN BEGIN
dummy := AslRequest(fr,NIL) <> LFALSE;
dummy := AslRequest(fr,NIL);
if dummy then begin
MessageBox('Test of Asl',
' The path is :' +

13
packages/amunits/examples/bezier.pas
View File

@ -221,10 +221,11 @@ end;
begin
s := OpenScreenTags(nil,[SA_Pens,@pens,
SA_Depth, 2,
SA_DisplayID, HIRES_KEY,
SA_Title, 'Simple Bezier Curves',
s := OpenScreenTags(nil,[
AsTag(SA_Pens), AsTag(@pens),
AsTag(SA_Depth), 2,
AsTag(SA_DisplayID), HIRES_KEY,
AsTag(SA_Title), AsTag('Simple Bezier Curves'),
TAG_END]);
if s = NIL then CleanUpAndDie;
@ -241,8 +242,8 @@ begin
WA_ReportMouse, ltrue,
WA_SmartRefresh, ltrue,
WA_Activate, ltrue,
WA_Title, 'Close the Window to Quit',
WA_CustomScreen, s,
WA_Title, AsTag('Close the Window to Quit'),
WA_CustomScreen, AsTag(s),
TAG_END]);
IF w=NIL THEN CleanUpAndDie;

9
packages/amunits/examples/bezier2.pas
View File

@ -242,10 +242,11 @@ begin
end;
begin
s := OpenScreenTags(nil,[SA_Pens, @pens,
s := OpenScreenTags(nil,[
SA_Pens, AsTag(@pens),
SA_Depth, 2,
SA_DisplayID, HIRES_KEY,
SA_Title, 'Simple Bezier Curves',
SA_Title, AsTag('Simple Bezier Curves'),
TAG_END]);
if s = NIL then CleanUpAndDie;
@ -262,8 +263,8 @@ begin
WA_ReportMouse, ltrue,
WA_SmartRefresh, ltrue,
WA_Activate, ltrue,
WA_Title, 'Close the Window to Quit',
WA_CustomScreen, s,
WA_Title, AsTag('Close the Window to Quit'),
WA_CustomScreen, AsTag(s),
TAG_END]);
IF w=NIL THEN CleanUpAndDie;

2
packages/amunits/examples/deviceinfo.pas
View File

@ -56,7 +56,7 @@ Begin
If ParamCount = 0 Then AsdaLaVista(' DiskInfo V1.0, © 1992 T.Schmid - Usage : DiskInfo Dfx:',0);
MyFile := ParamStr(1) + #0;
Inf:=pInfoData( AllocMem( SizeOf(tInfoData), MEMF_PUBLIC ) );
Inf:=pInfoData(ExecAllocMem( SizeOf(tInfoData), MEMF_PUBLIC ) );
If Inf=Nil Then AsdaLaVista('No memory',5);
s:= 'Writeenabled';

12
packages/amunits/examples/dirdemo.pas
View File

@ -10,7 +10,7 @@ PROGRAM DirDemo;
nils.sjoholm@mailbox.swipnet
}
uses Amigados, exec, strings, linklist,pastoc, amigalib;
uses Amigados, exec, strings, linklist, amigalib;
CONST BufferSize = 2048;
CSI = chr($9b);
@ -26,7 +26,7 @@ VAR ExData : pExAllData;
Buffer : PChar;
i,temp : longint;
TotalSize : longint;
TheDir : string;
TheDir : AnsiString;
PROCEDURE CleanUp(TheMsg : STRING; ErrCode : INTEGER);
BEGIN
@ -57,11 +57,11 @@ BEGIN
EAC := AllocDosObject(DOS_EXALLCONTROL,NIL);
IF EAC = NIL THEN CleanUp('No AllocDosObject',10);
ExData := AllocMem(BufferSize,0);
ExData := ExecAllocMem(BufferSize,0);
EAC^.eac_LastKey := 0;
EAC^.eac_MatchString := NIL;
EAC^.eac_MatchFunc := NIL;
MyLock:=Lock(pas2c(TheDir),SHARED_LOCK);
MyLock:=Lock(PChar(TheDir),SHARED_LOCK);
IF MyLock=0 THEN CleanUp('No lock on directory',10);
REPEAT
@ -88,13 +88,13 @@ BEGIN
tempnode := GetFirstNode(DirList);
FOR i := 1 TO NodesInList(DirList) DO BEGIN
printf('%-30s <DIR>'#10,[long(GetNodeData(tempnode))]);
printf('%-30s <DIR>'#10,[PtrUInt(GetNodeData(tempnode))]);
tempnode := GetNextNode(tempnode);
END;
Write(CSI, '0m');
tempnode := GetFirstNode(FileList);
FOR i := 1 TO NodesInList(FileList) DO BEGIN
printf('%-30s%7ld'#10 ,[long(GetNodeData(tempnode)),tempnode^.ln_Size]);
printf('%-30s%7ld'#10 ,[PtrUInt(GetNodeData(tempnode)),tempnode^.ln_Size]);
TotalSize := TotalSize + tempnode^.ln_Size;
tempnode := GetNextNode(tempnode);
END;

20
packages/amunits/examples/easygadtools.pas
View File

@ -15,7 +15,7 @@ PROGRAM EasyGadtools;
}
USES Intuition, Exec, AGraphics, GadTools, Utility, pastoc;
USES Intuition, Exec, AGraphics, GadTools, Utility;
CONST
@ -90,16 +90,16 @@ begin
ButtonGadget := gad;
end;
function ButtonGadget(id,left,top,width,height:word; txt: string): pGadget;
function ButtonGadget(id,left,top,width,height:word; txt: AnsiString): pGadget;
begin
ButtonGadget := ButtonGadget(id,left,top,width,height,pas2c(txt));
ButtonGadget := ButtonGadget(id,left,top,width,height,PChar(txt));
end;
function CycleGadget(id,left,top,width,height:word; txt:pchar ; thearr : Pointer): pGadget;
begin
ng := NewGadget(left,top,width,height,txt,attr,id,PLACETEXT_LEFT,vi,nil);
gad := CreateGadget(CYCLE_KIND,gad,@ng,[
GTCY_Labels,thearr,
AsTag(GTCY_Labels), AsTag(thearr),
TAG_END]);
CycleGadget := gad;
end;
@ -118,8 +118,8 @@ BEGIN
gad := ButtonGadget(2,10,HG,200,HGadget,'Screen Requester');
HG := HG + DistGad + 3;
gad := CycleGadget(3,100,HG,100,HGadget,'Cycle me',@strarray);
HG := HG + DistGad+4;
//gad := CycleGadget(3,100,HG,100,HGadget,'Cycle me',@strarray);
//HG := HG + DistGad+4;
gad := ButtonGadget(4,10,HG,96,HGadget,'OK');
gad := ButtonGadget(5,115,HG,96,HGadget,'Cancel');
@ -129,10 +129,10 @@ BEGIN
if gad = nil then CleanUp('Can''t create gadgets',20);
wp := OpenWindowTags(NIL,[
WA_Gadgets, glist,
WA_Title, 'Test of EasyGadtools',
WA_Left,100,
WA_Top,100,
WA_Gadgets, AsTag(glist),
WA_Title, AsTag('Test of EasyGadtools'),
WA_Left, AsTag(100),
WA_Top, AsTag(100),
WA_Flags, WFLG_SMART_REFRESH OR WFLG_NOCAREREFRESH OR
WFLG_DEPTHGADGET OR WFLG_DRAGBAR OR WFLG_CLOSEGADGET OR
WFLG_ACTIVATE,

1
packages/amunits/examples/getdate.pas
View File

@ -46,7 +46,6 @@ Begin
('O') : tmp := tmp + strpas(Month);
('Y') : tmp := tmp + strpas(Year);
end;
i:=i+1;
end
else
tmp := tmp + Str[i];

2
packages/amunits/examples/gtmenu.pas
View File

@ -130,7 +130,7 @@ begin
WA_Activate, ltrue,
WA_Height, 100,
WA_CloseGadget, ltrue,
WA_Title, 'Menu Test Window',
WA_Title, AsTag('Menu Test Window'),
WA_IDCMP, IDCMP_CLOSEWINDOW or IDCMP_MENUPICK,
TAG_END]);

8
packages/amunits/examples/imagegadget.pas
View File

@ -21,7 +21,7 @@ PROGRAM ImageGadget;
nils.sjoholm@mailbox.swipnet.se
}
USES Intuition, Exec, AGraphics, GadTools, Utility,pastoc;
USES Intuition, Exec, AGraphics, GadTools, Utility;
CONST
@ -361,8 +361,8 @@ BEGIN
g^.SelectRender := @selecti;
wp := OpenWindowTags(NIL,[
WA_Gadgets,gl,
WA_Title, 'Images in Gadgets',
WA_Gadgets, AsTag(gl),
WA_Title, AsTag('Images in Gadgets'),
WA_Flags, WFLG_SMART_REFRESH OR WFLG_NOCAREREFRESH OR
WFLG_DEPTHGADGET OR WFLG_DRAGBAR OR WFLG_CLOSEGADGET OR
WFLG_ACTIVATE,
@ -391,7 +391,7 @@ BEGIN
CASE iclass OF
IDCMP_CLOSEWINDOW : ende := TRUE;
IDCMP_GADGETUP :
i := EasyReq(wp,WIN_TITLE,pas2c('You have clicked on the Gadget!'),pas2c('Wheeew!'));
i := EasyReq(wp,WIN_TITLE, 'You have clicked on the Gadget!', 'Wheeew!');
ELSE END;
msg := GT_GetIMsg(wp^.UserPort);
END;

8
packages/amunits/examples/moire.pas
View File

@ -81,10 +81,10 @@ begin
s := OpenScreenTags(NIL, [
SA_Pens, @pens,
SA_Pens, AsTag(@pens),
SA_Depth, 2,
SA_DisplayID, HIRES_KEY,
SA_Title, 'Close the Window to End This Demonstration',
SA_Title, AsTag('Close the Window to End This Demonstration'),
TAG_END]);
if s <> NIL then begin
@ -105,8 +105,8 @@ begin
WA_SizeGadget, -1,
WA_SmartRefresh, -1,
WA_Activate, -1,
WA_Title, 'Feel Free to Re-Size the Window',
WA_CustomScreen, s,
WA_Title, AsTag('Feel Free to Re-Size the Window'),
WA_CustomScreen, AsTag(s),
TAG_END]);
IF w <> NIL THEN begin

8
packages/amunits/examples/otherlibs/amarqueetest.pas
View File

@ -21,11 +21,15 @@ Var
const
errid : longint = 0;
begin
if not Assigned(AMarqueeBase) then
begin
writeln('cannot open ' + AMARQUEENAME);
Halt(5);
end;
{Connect to localhost}
session := QNewSessionTags('localhost', 2957, 'pascal test',[QSESSION_ERRORCODEPTR,
@errid,TAG_DONE]);
AsTag(@errid),TAG_DONE]);
if session = nil then begin
writeln('Could not create connection to localhost/2957');
writeln('the error was ',QErrorName(errid));

5
packages/amunits/examples/otherlibs/bestmodeid.pas
View File

@ -47,6 +47,11 @@ Var
rda : pRDArgs;
Begin
if not Assigned(P96Base) then
begin
writeln('Cannot open ', PICASSO96APINAME);
Halt(5);
end;
width:=640;
height:=480;

22
packages/amunits/examples/otherlibs/checkbox.pas
View File

@ -29,10 +29,14 @@ begin
end;
begin
App := TR_CreateAppTags([TRCA_Name,'Triton CheckBox',
TRCA_Release,'1.0',
TRCA_Date,'03-06-1998',
if not Assigned(TritonBase) then
begin
writeln('cannot open ' + TRITONNAME);
Halt(5);
end;
App := TR_CreateAppTags([TRCA_Name, AsTag('Triton CheckBox'),
TRCA_Release, AsTag('1.0'),
TRCA_Date, AsTag('03-06-1998'),
TAG_DONE]);
if App = nil then CleanUp('Can''t create application',20);
@ -65,16 +69,18 @@ begin
CASE trmsg^.trm_Class OF
TRMS_CLOSEWINDOW : begin
if TR_GetCheckBox(Project,10) then
writeln('CheckBox was on')
else writeln('CheckBox was off');
writeln('CheckBox was on')
else
writeln('CheckBox was off');
close_me := True;
end;
TRMS_ERROR: WriteLN(TR_GetErrorString(trmsg^.trm_Data));
TRMS_NEWVALUE : begin
IF trmsg^.trm_ID = 10 then begin
if trmsg^.trm_Data = 0 then
writeln('CheckBox off')
else writeln('CheckBox on');
writeln('CheckBox off')
else
writeln('CheckBox on');
end;
end;
END;

25
packages/amunits/examples/otherlibs/demo.pas
View File

@ -115,7 +115,7 @@ VAR
BEGIN
ProjectStart;
WindowTitle('Groups'); WindowPosition(TRWP_CENTERDISPLAY); WindowUnderscore('~'); WindowID(1);
WindowTitle('Groups'); WindowPosition(TRWP_CENTERDISPLAY); WindowUnderscore(string('~')); WindowID(1);
HorizGroupA; Space; VertGroupA;
Space;
@ -994,8 +994,8 @@ ProjectStart;
ELSE reqstr := 'Icon(s) dropped into the window.' + #9 + 'Name of first dropped icon:' + #10 + '%3' + strpas(dirname);
END;
TR_EasyRequestTags(App,reqstr,'_Ok',[
TREZ_LockProject, appwindow_project,
TREZ_Title,'AppWindow report',
TREZ_LockProject, AsTag(appwindow_project),
TREZ_Title, AsTag('AppWindow report'),
TREZ_Activate,1,
TAG_END]);
@ -1103,8 +1103,8 @@ BEGIN
TR_EasyRequestTags(App,'To get help, move the mouse pointer over' + #10 +
'any gadget or menu item and press <Help>'+#10+
'or turn on QuickHelp before.','_Ok',[
TREZ_LockProject,Main_Project,
TREZ_Title,'Triton help',
TREZ_LockProject, AsTag(Main_Project),
TREZ_Title, AsTag('Triton help'),
TAG_END]);
end;
103: quit := True;
@ -1118,8 +1118,8 @@ BEGIN
reqstr := 'No help available for object ' + IntToStr(trmsg^.trm_ID);
END;
TR_EasyRequestTags(App,reqstr,'_Ok',[
TREZ_LockProject,Main_Project,
TREZ_Title,'Triton help',
TREZ_LockProject, AsTag(Main_Project),
TREZ_Title, AsTag('Triton help'),
TAG_END]);
END;
TRMS_ERROR: WriteLN(TR_GetErrorString(trmsg^.trm_Data));
@ -1136,11 +1136,16 @@ BEGIN
END;
BEGIN
if not Assigned(TritonBase) then
begin
writeln('cannot open ' + TRITONNAME);
Halt(5);
end;
App := TR_CreateAppTags([
TRCA_Name,'TritonDemo',
TRCA_LongName,'Triton Demo',
TRCA_Version,'2.0',
TRCA_Name, AsTag('TritonDemo'),
TRCA_LongName, AsTag('Triton Demo'),
TRCA_Version, AsTag('2.0'),
TAG_DONE]);
if App <> nil then begin

11
packages/amunits/examples/otherlibs/envprint.pas
View File

@ -352,10 +352,15 @@ BEGIN
END;
begin
if not Assigned(TritonBase) then
begin
writeln('cannot open ' + TRITONNAME);
Halt(5);
end;
Triton_App := TR_CreateAppTags([
TRCA_Name,'Envprint',
TRCA_LongName,'EnvPrint GUI demo',
TRCA_Version,'2.0',
TRCA_Name, AsTag('Envprint'),
TRCA_LongName, AsTag('EnvPrint GUI demo'),
TRCA_Version, AsTag('2.0'),
TAG_END]);
if Triton_App <> nil then begin

18
packages/amunits/examples/otherlibs/gadgetdemo.pas
View File

@ -73,19 +73,23 @@ BEGIN
END;
BEGIN
if not Assigned(TritonBase) then
begin
writeln('cannot open ' + TRITONNAME);
Halt(5);
end;
CreateList(MyList);
FOR i := 0 TO NumInList-2 DO BEGIN
MyNode := AddNewNode(MyList,mxstrings[i]);
END;
Triton_App := TR_CreateAppTags([
TRCA_Name,'FPC Pascal Demo',
TRCA_LongName,'FPC Pascal Application Demo :)',
TRCA_Version,'0.01',
TRCA_Info,'Just a test of Triton',
TRCA_Release,'1.0',
TRCA_Date,'01-05-1996',
TRCA_Name, AsTag('FPC Pascal Demo'),
TRCA_LongName, AsTag('FPC Pascal Application Demo :)'),
TRCA_Version, AsTag('0.01'),
TRCA_Info, AsTag('Just a test of Triton'),
TRCA_Release, AsTag('1.0'),
TRCA_Date, AsTag('01-05-1996'),
TAG_DONE]);
if Triton_App = NIL then CleanExit('Can''t create application',20);

15
packages/amunits/examples/otherlibs/gttest.pas
View File

@ -42,6 +42,11 @@ begin
end;
begin
if not Assigned(GTLayoutBase) then
begin
writeln('cannot open ' + GTLAYOUTNAME);
Halt(5);
end;
done := false;
handle := LT_CreateHandleTags(nil,[
LAHN_AutoActivate, lfalse,
@ -50,26 +55,26 @@ begin
if handle = nil then CleanUp('Could''t create a handle',20);
LT_New(handle,[LA_Type,VERTICAL_KIND, { A vertical group. }
LA_LabelText,'Main Group',
LA_LabelText, AsTag('Main Group'),
TAG_DONE]);
LT_New(handle,[LA_Type,BUTTON_KIND, { A plain button. }
LA_LabelText,'A button',
LA_LabelText, AsTag('A button'),
LA_ID,11,
TAG_DONE]);
LT_New(handle,[LA_Type,XBAR_KIND,TAG_DONE]); { A separator bar. }
LT_New(handle,[LA_Type,BUTTON_KIND, { A plain button. }
LA_LabelText,'Another button',
LA_LabelText, AsTag('Another button'),
LA_ID,22,
TAG_DONE]);
LT_New(handle,[LA_Type,CHECKBOX_KIND,LA_LabelText,'test',LA_ID,33,LA_BOOL,1,TAG_DONE]);
LT_New(handle,[LA_Type,CHECKBOX_KIND,LA_LabelText,AsTag('test'),LA_ID,33,LA_BOOL,1,TAG_DONE]);
LT_New(handle,[La_Type,END_KIND,TAG_DONE]); { This ends the current group. }
win := LT_Build(handle,[LAWN_Title,'Window title',
win := LT_Build(handle,[LAWN_Title, AsTag('Window title'),
LAWN_IDCMP, IDCMP_CLOSEWINDOW,
WA_CloseGadget, ltrue,
TAG_DONE]);

25
packages/amunits/examples/otherlibs/linklib.pas
View File

@ -106,8 +106,8 @@ BEGIN
dummy := TR_EasyRequestTags(Triton_App,'Sure you want to delete'+#10+
strpas(GetNodeData(mynode)),'_Remove|_Cancel',[
TREZ_LockProject,Project,
TREZ_Title,'Delete this file?',
TREZ_LockProject, AsTag(Project),
TREZ_Title, AsTag('Delete this file?'),
TREZ_Activate,1,
TAG_END]);
IF dummy = 1 THEN BEGIN
@ -124,8 +124,8 @@ VAR
BEGIN
dummy := TR_EasyRequestTags(Triton_App,'Sure you want to remove all files?',
'_Remove|_Cancel',[
TREZ_LockProject,Project,
TREZ_Title,'Delete all?',
TREZ_LockProject, AsTag(Project),
TREZ_Title, AsTag('Delete all?'),
TREZ_Activate,1,
TAG_END]);
IF dummy = 1 THEN BEGIN
@ -255,13 +255,18 @@ END;
BEGIN { Main }
if not Assigned(TritonBase) then
begin
writeln('cannot open ' + TRITONNAME);
Halt(5);
end;
Triton_App := TR_CreateAppTags([
TRCA_Name,'Triton ListView Demo',
TRCA_LongName,'Demo of ListView in Triton, made in FPC Pascal',
TRCA_Version,'0.01',
TRCA_Info,'Uses tritonsupport',
TRCA_Release,'11',
TRCA_Date,'03-02-1998',
TRCA_Name, AsTag('Triton ListView Demo'),
TRCA_LongName, AsTag('Demo of ListView in Triton, made in FPC Pascal'),
TRCA_Version, AsTag('0.01'),
TRCA_Info, AsTag('Uses tritonsupport'),
TRCA_Release, AsTag('11'),
TRCA_Date, AsTag('03-02-1998'),
TAG_END]);
if Triton_App <> nil then begin
path := @pdummy;

12
packages/amunits/examples/otherlibs/listview.pas
View File

@ -46,11 +46,15 @@ BEGIN
END;
begin
if not Assigned(TritonBase) then
begin
writeln('cannot open ' + TRITONNAME);
Halt(5);
end;
Triton_App := TR_CreateAppTags([
TRCA_Name,'Triton ListView',
TRCA_Release,'1.0',
TRCA_Date,'03-02-1998',
TRCA_Name, AsTag('Triton ListView'),
TRCA_Release, AsTag('1.0'),
TRCA_Date, AsTag('03-02-1998'),
TAG_DONE]);
if Triton_App = nil then Cleanexit('Can''t create application',20);

5
packages/amunits/examples/otherlibs/modelist.pas
View File

@ -31,6 +31,11 @@ Var
mn : pP96Mode;
Begin
if not Assigned(P96Base) then
begin
writeln('Cannot open ', PICASSO96APINAME);
Halt(5);
end;
width:=640;
height:=480;
depth:=8;

11
packages/amunits/examples/otherlibs/openpip.pas
View File

@ -38,6 +38,11 @@ Var
rda : pRDArgs;
Begin
if not Assigned(P96Base) then
begin
writeln('Cannot open ', PICASSO96APINAME);
Halt(5);
end;
width := 256;
height := 256;
StrCopy(@PubScreenName,WB);
@ -54,7 +59,7 @@ Begin
wd := p96PIP_OpenTags([P96PIP_SourceFormat, long(RGBFB_R5G5B5),
P96PIP_SourceWidth,256,
P96PIP_SourceHeight,256,
WA_Title,'Picasso96 API PIP Test',
WA_Title, AsTag('Picasso96 API PIP Test'),
WA_Activate,lTRUE,
WA_RMBTrap,lTRUE,
WA_Width,Width,
@ -65,14 +70,14 @@ Begin
WA_SizeGadget,lTRUE,
WA_CloseGadget,lTRUE,
WA_IDCMP,IDCMP_CLOSEWINDOW,
WA_PubScreenName,@PubScreenName,
WA_PubScreenName, AsTag(@PubScreenName),
TAG_DONE]);
If wd <> Nil Then Begin
goahead:=True;
rp:=Nil;
p96PIP_GetTags(wd,[P96PIP_SourceRPort, @rp, TAG_END]);
p96PIP_GetTags(wd,[P96PIP_SourceRPort, AsTag(@rp), TAG_END]);
If rp<>Nil Then Begin
For y:=0 To (Height-1) Do
For x:=0 To (Width-1) Do

17
packages/amunits/examples/otherlibs/openscreen.pas
View File

@ -61,6 +61,11 @@ begin
end;
BEGIN
if not Assigned(P96Base) then
begin
writeln('Cannot open ', PICASSO96APINAME);
Halt(5);
end;
Width:=640;
Height:=480;
Depth:=8;
@ -77,8 +82,8 @@ BEGIN
P96SA_Height, Height,
P96SA_Depth, Depth,
P96SA_AutoScroll, lTRUE,
P96SA_Pens, @Pens,
P96SA_Title, ScreenTitle,
P96SA_Pens, AsTag(@Pens),
P96SA_Title, AsTag(ScreenTitle),
TAG_DONE]);
@ -89,11 +94,11 @@ BEGIN
Dimensions[2]:=sc^.Width;
Dimensions[3]:=sc^.Height-sc^.BarHeight-1;
wdp:=OpenWindowTags(NIL,[WA_CustomScreen, PtrUInt(sc),
WA_Title,PtrUInt(PChar('Writepixel')),
wdp:=OpenWindowTags(NIL,[WA_CustomScreen, AsTag(sc),
WA_Title, AsTag('Writepixel'),
WA_Left, (sc^.Width DIV 2-200) DIV 2+sc^.Width DIV 2,
WA_Top, (sc^.Height-sc^.BarHeight-300) DIV 2,
WA_Zoom, PtrUInt(@Dimensions),
WA_Zoom, AsTag(@Dimensions),
WA_Width, 200,
WA_Height, 300,
WA_MinWidth, 100,
@ -109,7 +114,7 @@ BEGIN
WA_SizeGadget, lTRUE,
WA_SizeBBottom, lTRUE,
WA_GimmeZeroZero, lTRUE,
WA_ScreenTitle, PtrUInt(PChar(ScreenTitle)),
WA_ScreenTitle, AsTag(ScreenTitle),
WA_IDCMP, IDCMP_RAWKEY + IDCMP_CLOSEWINDOW,
TAG_DONE]);

21
packages/amunits/examples/otherlibs/p96checkboards.pas
View File

@ -39,20 +39,25 @@ BEGIN
END;
begin
if not Assigned(P96Base) then
begin
writeln('Cannot open ', PICASSO96APINAME);
Halt(5);
end;
BoardName := @boardtmp;
tmp := p96GetRTGDataTags([P96RD_NumberOfBoards, @NumBoards, TAG_END]);
tmp := p96GetRTGDataTags([P96RD_NumberOfBoards, AsTag(@NumBoards), TAG_END]);
writeln('Looking through all boards installed for Picasso96');
for i := 0 to NumBoards-1 do begin
p96GetBoardDataTags(i,[P96BD_BoardName, @BoardName,
P96BD_RGBFormats, @RGBFormats,
P96BD_TotalMemory, @MemorySize,
P96BD_FreeMemory, @FreeMemory,
P96BD_LargestFreeMemory, @LargestFreeMemory,
P96BD_MemoryClock, @MemoryClock,
P96BD_MonitorSwitch, @MoniSwitch,
p96GetBoardDataTags(i,[P96BD_BoardName, AsTag(@BoardName),
P96BD_RGBFormats, AsTag(@RGBFormats),
P96BD_TotalMemory, AsTag(@MemorySize),
P96BD_FreeMemory, AsTag(@FreeMemory),
P96BD_LargestFreeMemory, AsTag(@LargestFreeMemory),
P96BD_MemoryClock, AsTag(@MemoryClock),
P96BD_MonitorSwitch, AsTag(@MoniSwitch),
TAG_END]);
writeln('--------------------------------------------------');

12
packages/amunits/examples/otherlibs/palette.pas
View File

@ -22,11 +22,15 @@ var
begin
if not Assigned(TritonBase) then
begin
writeln('cannot open ' + TRITONNAME);
Halt(5);
end;
Triton_App := TR_CreateAppTags([
TRCA_Name,'Triton Palette Demo',
TRCA_Release,'1.0',
TRCA_Date,'03-06-1998',
TRCA_Name, AsTag('Triton Palette Demo'),
TRCA_Release, AsTag('1.0'),
TRCA_Date, AsTag('03-06-1998'),
TAG_DONE]);
if Triton_App <> nil then begin

9
packages/amunits/examples/otherlibs/progindex.pas
View File

@ -112,9 +112,14 @@ end;
(* /////////////////////////////////////////////////////////////////////////////////////////////////////// *)
begin
if not Assigned(TritonBase) then
begin
writeln('cannot open ' + TRITONNAME);
Halt(5);
end;
Triton_App := TR_CreateAppTags([
TRCA_Name,'trProgIndDemo',
TRCA_Version,'1.0',
TRCA_Name, AsTag('trProgIndDemo'),
TRCA_Version, AsTag('1.0'),
TAG_END]);
if Triton_App <> nil then begin

7
packages/amunits/examples/otherlibs/requestmodeid.pas
View File

@ -34,6 +34,11 @@ Var
Begin
if not Assigned(P96Base) then
begin
writeln('Cannot open ', PICASSO96APINAME);
Halt(5);
end;
width:=640;
height:=480;
depth:=15;
@ -49,7 +54,7 @@ Begin
DisplayID := p96RequestModeIDTags([P96MA_MinWidth, width,
P96MA_MinHeight, height,
P96MA_MinDepth, depth,
P96MA_WindowTitle, 'RequestModeID Test',
P96MA_WindowTitle, AsTag('RequestModeID Test'),
P96MA_FormatsAllowed, (RGBFF_CLUT or RGBFF_R5G6B5 or RGBFF_R8G8B8 or RGBFF_A8R8G8B8),
TAG_DONE]);

78
packages/amunits/examples/otherlibs/rtdemo.pas
View File

@ -24,7 +24,7 @@ PROGRAM RTDemo;
}
uses reqtools, strings, utility;
uses reqtools, strings, utility, exec, amigados;
@ -45,6 +45,7 @@ VAR
ret : Longint;
color : Longint;
undertag : Array [0..1] of tTagItem;
Param : array of PtrUInt;
FUNCTION GetScrollValue(value : INTEGER): STRING;
BEGIN
@ -61,6 +62,11 @@ BEGIN
END;
BEGIN
if not Assigned(ReqToolsBase) then
begin
writeln('Cannot open ', REQTOOLSNAME);
Halt(5);
end;
dummy:= StrAlloc(400);
dummy2 := StrAlloc(200);
@ -91,10 +97,10 @@ BEGIN
rtEZRequestA('You entered this string:' + #10 + '%s','So I did', NIL, @buffer, NIL);
ret := rtGetString(buffer, 127, 'Enter anything:', NIL,[
RTGS_GadFmt, ' _Ok |New _2.0 feature!|_Cancel',
RTGS_TextFmt,'These are two new features of ReqTools 2.0:' + #10
+ 'Text above the entry gadget and more than' + #10 + 'one response gadget.',
TAG_MORE, @undertag]);
RTGS_GadFmt, AsTag(' _Ok |New _2.0 feature!|_Cancel'),
RTGS_TextFmt, AsTag('These are two new features of ReqTools 2.0:' + #10
+ 'Text above the entry gadget and more than' + #10 + 'one response gadget.'),
TAG_MORE, AsTag(@undertag)]);
@ -103,15 +109,15 @@ BEGIN
'Oh boy!',NIL,NIL,NIL);
ret := rtGetString(buffer, 127, 'Enter anything:',NIL,[
RTGS_GadFmt,' _Ok | _Abort |_Cancel',
RTGS_TextFmt,'New is also the ability to switch off the' + #10 +
RTGS_GadFmt, AsTag(' _Ok | _Abort |_Cancel'),
RTGS_TextFmt, AsTag('New is also the ability to switch off the' + #10 +
'backfill pattern. You can also center the' + #10 +
'text above the entry gadget.' + #10 +
'These new features are also available in' + #10 +
'the rtGetLong() requester.',
RTGS_BackFill, FALSE,
'the rtGetLong() requester.'),
RTGS_BackFill, LFALSE,
RTGS_Flags, GSREQF_CENTERTEXT + GSREQF_HIGHLIGHTTEXT,
TAG_MORE, @undertag]);
TAG_MORE, AsTag(@undertag)]);
IF ret = 2 THEN
rtEZRequestA('What!! You pressed abort!?!' + #10 + 'You must be joking :-)',
@ -121,7 +127,7 @@ BEGIN
'Show me', NIL, NIL, NIL);
ret := rtGetLong(longnum, 'Enter a number:',NIL,[
RTGL_ShowDefault, FALSE,
RTGL_ShowDefault, LFALSE,
RTGL_Min, 0,
RTGL_Max, 666,
TAG_DONE]);
@ -130,7 +136,7 @@ BEGIN
rtEZRequestA('You entered nothing','I''m sorry', NIL, NIL, NIL)
ELSE
rtEZRequestA('The number You entered was:' + #10 + '%ld' ,
'So it was', NIL, readinlongs([longnum]), NIL);
'So it was', NIL, @longnum, NIL);
rtEZRequestA ('NUMBER 3:' + #10 + 'Notification requester, the requester' + #10 +
'you''ve been using all the time!' + #10 +
@ -175,7 +181,7 @@ BEGIN
RTEZ_DefaultResponse, 4,
TAG_DONE]);
rtEZRequestA('You picked ''%ld''.', 'How true', NIL, readinlongs([ret]),NIL);
rtEZRequestA('You picked ''%ld''.', 'How true', NIL, @ret, NIL);
{
If i used just a string for this text is will be truncated
@ -201,20 +207,22 @@ BEGIN
strcat(dummy,dummy2);
rtEZRequestA(dummy,'_Great|_Fantastic|_Swell|Oh _Boy',NIL,NIL,@undertag);
SetLength(Param, 2);
Param[0] := 5;
Param[1] := AsTag('five');
rtEZRequestA('You may also use C-style formatting codes in the body text.' + #10 +
'Like this:' + #10 + #10 +
'The number %%ld is written %%s. will give:' + #10 + #10 +
'The number %ld is written %s.' + #10 + #10 +
'if you also pass ''5'' and ''five'' to rtEZRequestA().',
'_Proceed',NIL,readinlongs([5,'five']),@undertag);
'_Proceed',NIL, @Param, @undertag);
ret := rtEZRequest('It is also possible to pass extra IDCMP flags' + #10 +
'that will satisfy rtEZRequest(). This requester' + #10 +
'has had DISKINSERTED passed to it.' + #10 +
'(Try inserting a disk).', '_Continue', NIL,NIL,[
RT_IDCMPFlags, DISKINSERTED,
TAG_MORE,@undertag]);
TAG_MORE, AsTag(@undertag)]);
IF ((ret = DISKINSERTED)) THEN
rtEZRequestA('You inserted a disk.', 'I did', NIL, NIL, NIL)
@ -228,14 +236,14 @@ BEGIN
'This works for all requesters, not just rtEZRequest()!',
'_Amazing', NIL,NIL,[
RT_ReqPos, REQPOS_TOPLEFTSCR,
TAG_MORE,@undertag]);
TAG_MORE, AsTag(@undertag)]);
rtEZRequest('Alternatively, you can center the' + #10 +
'requester on the screen.' + #10 +
'Check out ''reqtools.doc'' for all the possibilities.',
'I''ll do that', NIL,NIL,[
RT_ReqPos, REQPOS_CENTERSCR,
TAG_MORE,@undertag]);
TAG_MORE, AsTag(@undertag)]);
ret := rtEZRequestA('NUMBER 4:' + #10 + 'File requester' + #10 + 'function: rtFileRequest()',
@ -252,9 +260,11 @@ BEGIN
}
ret := Longint(rtFileRequestA(filereq, filename, 'Pick a file', NIL));
IF (ret)<>0 THEN begin
SetLength(Param, 2);
Param[0] := AsTag(filename);
Param[1] := AsTag(filereq^.Dir);
rtEZRequestA('You picked the file:' + #10 + '%s' + #10 + 'in directory:'
+ #10 + '%s', 'Right', NIL, readinlongs([
filename,filereq^.Dir]),NIL);
+ #10 + '%s', 'Right', NIL, @Param, NIL);
END
ELSE
rtEZRequestA('You didn''t pick a file.', 'No', NIL, NIL, NIL);
@ -275,7 +285,7 @@ BEGIN
'"%s"' + #10 +
'All the files are returned as a linked' + #10 +
'list (see demo.c and reqtools.h).',
'Aha', NIL, readinlongs([filelist^.Name]),NIL);
'Aha', NIL, @(filelist^.Name),NIL);
(* Traverse all selected files *)
(*
tempflist = flist;
@ -304,7 +314,7 @@ BEGIN
IF(ret=1) THEN begin
rtEZRequestA('You picked the directory:' + #10 +'%s',
'Right', NIL, readinlongs([filereq^.Dir]), NIL);
'Right', NIL, @(filereq^.Dir), NIL);
end ELSE
rtEZRequestA('You didn''t pick a directory.', 'No', NIL, NIL, NIL);
@ -321,10 +331,12 @@ BEGIN
fontreq^.Flags := FREQF_STYLE OR FREQF_COLORFONTS;
ret := rtFontRequestA (fontreq, 'Pick a font', NIL);
IF(ret<>0) THEN begin
SetLength(Param, 2);
Param[0] := AsTag(fontreq^.Attr.ta_Name);
Param[1] := AsTag(fontreq^.Attr.ta_YSize);
rtEZRequestA('You picked the font:' + #10 + '%s' + #10 + 'with size:' +
#10 + '%ld',
'Right', NIL, readinlongs([fontreq^.Attr.ta_Name,
fontreq^.Attr.ta_YSize]),NIL);
'Right', NIL, @Param, NIL);
end ELSE
ret := rtEZRequestA('You didn''t pick a font','I know', NIL, NIL, NIL);
rtFreeRequest(fontreq);
@ -341,7 +353,7 @@ BEGIN
'Nah', NIL, NIL, NIL)
ELSE begin
rtEZRequestA('You picked color number %ld.', 'Sure did',
NIL, readinlongs([color]), NIL);
NIL, @color, NIL);
END;
rtEZRequestA('NUMBER 7: (ReqTools 2.0)' + #10 +
@ -358,7 +370,7 @@ BEGIN
TAG_END]));
IF (ret = 1) THEN begin
rtEZRequestA('You picked the volume:' + #10 + '%s',
'Right',NIL,readinlongs([filereq^.Dir]),NIL);
'Right',NIL, @filereq^.Dir,NIL);
end
ELSE
rtEZRequestA('You didn''t pick a volume.','I did not',NIL,NIL,NIL);
@ -382,6 +394,13 @@ BEGIN
TAG_END]);
IF(ret=1) THEN BEGIN
SetLength(Param, 6);
Param[0] := scrnreq^.DisplayID;
Param[1] := scrnreq^.DisplayWidth;
Param[2] := scrnreq^.DisplayHeight;
Param[3] := scrnreq^.DisplayDepth;
Param[4] := scrnreq^.OverscanType;
Param[5] := AsTag(PChar(AnsiString(GetScrollValue(scrnreq^.AutoScroll))));
rtEZRequestA('You picked this mode:' + #10 +
'ModeID : 0x%lx' + #10 +
'Size : %ld x %ld' + #10 +
@ -389,12 +408,7 @@ BEGIN
'Overscan: %ld' + #10 +
'AutoScroll %s',
'Right', NIL,
readinlongs([scrnreq^.DisplayID,
scrnreq^.DisplayWidth,
scrnreq^.DisplayHeight,
scrnreq^.DisplayDepth,
scrnreq^.OverscanType,
GetScrollValue(scrnreq^.AutoScroll)]),NIL);
@Param,NIL);
END
ELSE
rtEZRequestA('You didn''t pick a screen mode.', 'Sorry', NIL, NIL, NIL);

12
packages/amunits/examples/otherlibs/scroller.pas
View File

@ -20,11 +20,15 @@ VAR
dummy : longint;
begin
if not Assigned(TritonBase) then
begin
writeln('cannot open ' + TRITONNAME);
Halt(5);
end;
App := TR_CreateAppTags([
TRCA_Name,' Triton Scroller Demo' ,
TRCA_Release,' 1.0' ,
TRCA_Date,' 03-08-1998' ,
TRCA_Name, AsTag(' Triton Scroller Demo'),
TRCA_Release, AsTag(' 1.0'),
TRCA_Date, AsTag(' 03-08-1998'),
TAG_DONE]);
if App <> nil then begin

12
packages/amunits/examples/otherlibs/slider.pas
View File

@ -30,11 +30,15 @@ Function IntToStr (I : Longint) : String;
end;
begin
if not Assigned(TritonBase) then
begin
writeln('cannot open ' + TRITONNAME);
Halt(5);
end;
Triton_App := TR_CreateAppTags([
TRCA_Name,' Triton Slider Demo' ,
TRCA_Release,' 1.0' ,
TRCA_Date,' 03-08-1998' ,
TRCA_Name, AsTag(' Triton Slider Demo'),
TRCA_Release, AsTag(' 1.0'),
TRCA_Date, AsTag(' 03-08-1998'),
TAG_DONE]);
if Triton_App <> nil then begin

11
packages/amunits/examples/otherlibs/smallplay.pas
View File

@ -18,20 +18,25 @@ var
SigBit : shortint;
SigMask : longint;
procedure CleanUp(why : string, err : integer);
procedure CleanUp(why : string; err : integer);
begin
if why <> '' then writeln(why);
halt(err);
end;
begin
if not Assigned(PTReplayBase) then
begin
writeln('cannot open ' + PTREPLAYNAME);
Halt(5);
end;
module := nil;
if ParamCount > 1 then
CleanUp('Specify one module only',20);
if ParamCount < 0 then
CleanUp('Play what module?',20);
module := PTLoadModule(ParamStr[1]);
module := PTLoadModule(ParamStr(1));
if not assigned(module) then
CleanUp('Couldn''t open/load module',20);
@ -43,7 +48,7 @@ begin
PTPlay(module);
SigMask := Wait(SIGBREAKF_CTRL_C or (1 shl SigBit));
if (SigMask and SIGBREAKF_CTRL_C) then
if (SigMask and SIGBREAKF_CTRL_C) <> 0 then
PTFade(module,1)
else
PTStop(module);

12
packages/amunits/examples/otherlibs/string.pas
View File

@ -21,11 +21,15 @@ VAR
App : pTR_App;
begin
if not Assigned(TritonBase) then
begin
writeln('cannot open ' + TRITONNAME);
Halt(5);
end;
App := TR_CreateAppTags([
TRCA_Name,'Triton String Demo',
TRCA_Release,'1.0',
TRCA_Date,'03-06-1998',
TRCA_Name, AsTag('Triton String Demo'),
TRCA_Release, AsTag('1.0'),
TRCA_Date, AsTag('03-06-1998'),
TAG_DONE]);
if App <> nil then begin
ProjectStart;

11
packages/amunits/examples/otherlibs/toolmanager1.pas
View File

@ -65,15 +65,20 @@ begin
end;
begin
if not Assigned(TritonBase) then
begin
writeln('cannot open ' + TRITONNAME);
Halt(5);
end;
CreateList(LVList);
FOR i := 0 TO 8 DO BEGIN
MyNode := AddNewNode(LVList,liststrings[i]);
END;
Triton_App := TR_CreateAppTags([
TRCA_Name,'ToolManagerGUIDemo1',
TRCA_LongName,'ToolManager GUI demo 1',
TRCA_Info,'Looks like the original ToolManager',
TRCA_Name, AsTag('ToolManagerGUIDemo1'),
TRCA_LongName, AsTag('ToolManager GUI demo 1'),
TRCA_Info, AsTag('Looks like the original ToolManager'),
TAG_END]);
if Triton_App = nil then CleanUp('Can''t create application',20);

11
packages/amunits/examples/otherlibs/toolmanager2.pas
View File

@ -66,15 +66,20 @@ begin
end;
begin
if not Assigned(TritonBase) then
begin
writeln('cannot open ' + TRITONNAME);
Halt(5);
end;
CreateList(LVList);
FOR i := 0 TO 8 DO BEGIN
MyNode := AddNewNode(LVList, liststrings[i]);
END;
Triton_App := TR_CreateAppTags([
TRCA_Name,'ToolManagerGUIDemo2',
TRCA_LongName,'ToolManager GUI demo 2',
TRCA_Info,'Looks like the ToolManager demo 2 of GUIFront',
TRCA_Name, AsTag('ToolManagerGUIDemo2'),
TRCA_LongName, AsTag('ToolManager GUI demo 2'),
TRCA_Info, AsTag('Looks like the ToolManager demo 2 of GUIFront'),
TAG_END]);
if Triton_App = nil then CleanUp('Can''t create application',20);

11
packages/amunits/examples/otherlibs/toolmanager3.pas
View File

@ -67,6 +67,11 @@ begin
end;
begin
if not Assigned(TritonBase) then
begin
writeln('cannot open ' + TRITONNAME);
Halt(5);
end;
CreateList(LVList);
FOR i := 0 TO 8 DO BEGIN
MyNode := AddNewNode(LVList,liststrings[i]);
@ -74,9 +79,9 @@ begin
Triton_App := TR_CreateAppTags([
TRCA_Name,'ToolManagerGUIDemo3',
TRCA_LongName,'ToolManager GUI demo 3',
TRCA_Info,'My own creation for a ToolManager GUI',
TRCA_Name, AsTag('ToolManagerGUIDemo3'),
TRCA_LongName, AsTag('ToolManager GUI demo 3'),
TRCA_Info, AsTag('My own creation for a ToolManager GUI'),
TAG_END]);
if Triton_App = nil then CleanUp('Can''t create application',20);

20
packages/amunits/examples/otherlibs/tritongadgets.pas
View File

@ -57,14 +57,18 @@ END;
begin
if not Assigned(TritonBase) then
begin
writeln('cannot open ' + TRITONNAME);
Halt(5);
end;
Triton_App := TR_CreateAppTags([
TRCA_Name,'TritonGadtools',
TRCA_LongName,'GadToolsDemo in Triton',
TRCA_Version,'0.01',
TRCA_Info,'Just a test of Triton',
TRCA_Release,'1.0',
TRCA_Date,'26-05-1998',
TRCA_Name, AsTag('TritonGadtools'),
TRCA_LongName, AsTag('GadToolsDemo in Triton'),
TRCA_Version, AsTag('0.01'),
TRCA_Info, AsTag('Just a test of Triton'),
TRCA_Release, AsTag('1.0'),
TRCA_Date, AsTag('26-05-1998'),
TAG_DONE]);
if Triton_App = nil then CleanExit('Can''t create Application',20);
@ -84,7 +88,7 @@ begin
Space;
SliderGadget(SLIDER_MIN,SLIDER_MAX,5,MYGAD_SLIDER);
Space;
TextID('5',MYGAD_SLIDERTEXT); SetTRTag(TRAT_MinWidth, 2);
TextID(string('5'),MYGAD_SLIDERTEXT); SetTRTag(TRAT_MinWidth, 2);
Space;
EndLine;
SpaceS;

12
packages/amunits/examples/otherlibs/writetruecolordata.pas
View File

@ -65,7 +65,11 @@ begin
end;
Begin
if not Assigned(P96Base) then
begin
writeln('Cannot open ', PICASSO96APINAME);
Halt(5);
end;
width:=640;
height:=480;
depth:=24;
@ -91,8 +95,8 @@ Begin
P96SA_Height, height,
P96SA_Depth, depth,
P96SA_AutoScroll, lTRUE,
P96SA_Pens, PtrUInt(@Pens),
P96SA_Title, PtrUInt(PChar('WriteTrueColorData Test')),
P96SA_Pens, AsTag(@Pens),
P96SA_Title, AsTag('WriteTrueColorData Test'),
TAG_DONE]);
if sc = nil then CleanUp('Can''t open screen');
@ -100,7 +104,7 @@ if sc = nil then CleanUp('Can''t open screen');
win := OpenWindowTags(Nil,[WA_CustomScreen, PtrUInt(sc),
win := OpenWindowTags(Nil,[WA_CustomScreen, AsTag(sc),
WA_Backdrop, lTRUE,
WA_Borderless, lTRUE,
WA_SimpleRefresh, lTRUE,

2
packages/amunits/examples/penshare.pas
View File

@ -58,7 +58,7 @@ Begin
Win:=OpenWindowTags(nil,[WA_Width,150,
WA_Height,100,
WA_Title,'PenShare',
WA_Title,AsTag('PenShare'),
WA_Flags,WFLG_CLOSEGADGET+WFLG_DRAGBAR,
WA_IDCMP,IDCMP_CLOSEWINDOW,
TAG_END]);

8
packages/amunits/examples/snow.pas
View File

@ -114,10 +114,10 @@ begin
nc := readcycles();
initarrays;
s := OpenScreenTags(nil, [SA_Pens, @pens,
s := OpenScreenTags(nil, [SA_Pens, AsTag(@pens),
SA_Depth, 2,
SA_DisplayID, HIRES_KEY,
SA_Title, 'Simple Fractal SnowFlakes',
SA_Title, AsTag('Simple Fractal SnowFlakes'),
TAG_END]);
if s = NIL then CleanUp('No screen',20);
@ -134,8 +134,8 @@ begin
WA_ReportMouse, ltrue,
WA_SmartRefresh, ltrue,
WA_Activate, ltrue,
WA_Title, 'Close the Window to Quit',
WA_CustomScreen, s,
WA_Title, AsTag('Close the Window to Quit'),
WA_CustomScreen, AsTag(s),
TAG_END]);
if w = nil then CleanUp('No window',20);

17
packages/amunits/examples/sortdemo.pas
View File

@ -192,16 +192,16 @@ PROCEDURE setpixel(i: Integer);
BEGIN
SetAPen(Rast,1);
IF needles THEN BEGIN
Move(Rast,i,range); Draw(Rast,i,Round((1-sort[i])*range));
GfxMove(Rast,i,range); Draw(Rast,i,Round((1-sort[i])*range));
END ELSE
IF WritePixel(Rast,i,Round((1-sort[i])*range))=0 THEN;
WritePixel(Rast,i,Round((1-sort[i])*range))
END;
PROCEDURE clearpixel(i: Integer);
BEGIN
SetAPen(Rast,0);
IF needles THEN BEGIN
Move(Rast,i,range); Draw(Rast,i,Round((1-sort[i])*range));
GfxMove(Rast,i,range); Draw(Rast,i,Round((1-sort[i])*range));
END ELSE
IF WritePixel(Rast,i,Round((1-sort[i])*range))=0 THEN;
END;
@ -262,7 +262,8 @@ BEGIN
range := w^.GZZHeight;
settitles(-1);
SetRast(Rast,0); { clear screen }
FOR i := 1 TO num DO BEGIN
FOR i := 1 TO num DO
BEGIN
IF rndom THEN sort[i] := Random { produces 0..1 }
ELSE sort[i] := (num-i)/num;
setpixel(i);
@ -499,8 +500,7 @@ begin
if vi = nil then CleanUp('No visual info',10);
w := OpenWindowTags(NIL, [
WA_IDCMP, IDCMP_CLOSEWINDOW or IDCMP_MENUPICK or
IDCMP_NEWSIZE,
WA_IDCMP, IDCMP_CLOSEWINDOW or IDCMP_MENUPICK or IDCMP_NEWSIZE,
WA_Left, 0,
WA_Top, s^.BarHeight+1,
WA_Width, 224,
@ -516,16 +516,14 @@ IDCMP_NEWSIZE,
WA_Activate, ltrue,
WA_SizeBRight, ltrue,
WA_GimmeZeroZero, ltrue,
WA_PubScreen, s,
WA_PubScreen, AsTag(s),
TAG_END]);
IF w=NIL THEN CleanUp('Could not open window',20);
Rast := w^.RPort;
{ Here we set the barlabel }
nm[3].nm_Label := PChar(NM_BARLABEL);
if pExecBase(_ExecBase)^.LibNode.Lib_Version >= 39 then begin
MenuStrip := CreateMenus(@nm,[
GTMN_FrontPen, 1, TAG_END]);
@ -534,7 +532,6 @@ IDCMP_NEWSIZE,
if MenuStrip = nil then CleanUp('Could not open Menus',10);
if LayoutMenusA(MenuStrip,vi,NIL)=false then
CleanUp('Could not layout Menus',10);
if SetMenuStrip(w, MenuStrip) = false then
CleanUp('Could not set the Menus',10);

2
packages/amunits/examples/stars.pas
View File

@ -115,7 +115,7 @@ BEGIN
Win:=OpenWindowTags(Nil, [
WA_Flags, WFLG_BORDERLESS,
WA_IDCMP, IDCMP_MOUSEBUTTONS,
WA_CustomScreen, Scr,
WA_CustomScreen, AsTag(Scr),
TAG_DONE]);
If Win=Nil Then CleanUp('No window',20);

10
packages/amunits/examples/talk2boopsi.pas
View File

@ -98,7 +98,7 @@ BEGIN
GA_Left, (w^.BorderLeft) + 5,
GA_Width, PROPGADGETWIDTH,
GA_Height, PROPGADGETHEIGHT,
ICA_MAP, @prop2intmap,
ICA_MAP, AsTag(@prop2intmap),
PGA_Total, TOTAL,
PGA_Top, INITIALVAL,
PGA_Visible, VISIBLE,
@ -116,16 +116,16 @@ BEGIN
PROPGADGETWIDTH + 15),
GA_Height, INTGADGETHEIGHT,
ICA_MAP, @int2propmap,
ICA_TARGET, prop,
GA_Previous, prop,
ICA_MAP, AsTag(@int2propmap),
ICA_TARGET, AsTag(prop),
GA_Previous,AsTag(prop),
STRINGA_LongVal, INITIALVAL,
STRINGA_MaxChars, MAXCHARS,
TAG_END]);
temp := SetGadgetAttrs(prop, w, NIL,[
ICA_TARGET, int,
ICA_TARGET, AsTag(int),
TAG_END]);
IF int = NIL THEN CleanUp('No INTEGER gadget',20);