home *** CD-ROM | disk | FTP | other *** search
-
- include "tdoms.pro"
- include "tpreds.pro"
- include "..\\include\\iodecl.pre"
-
-
- /*****************************************************************************
- Define the constant below to try out the availableems predicate.
- This predicate only applies to DOS, and won't be recognized in
- the OS/2 version.
- *****************************************************************************/
-
- CONSTANTS
- %try_ems = 1
-
-
- /*****************************************************************************
- Present the user for a text
- *****************************************************************************/
-
- PREDICATES
- present(STRING)
-
- CLAUSES
- present(S):-
- write("\n-----------------------------------------------------------\n"),
- write(S),
- readkey(_).
-
- /*****************************************************************************
- Test the last error predicate
- *****************************************************************************/
-
- PREDICATES
- testtrap
-
- CLAUSES
- testtrap:-
- lasterror(ErrorNo,Module,IncludeFile,Pos),
- write("\nModule=",Module,", IncludeFile=",IncludeFile,", Pos=",Pos,",No=",ErrorNo).
-
-
- /*****************************************************************************
- Test
- window_str_offset(RowOffset,ColOffset,ScreenString)
- (integer,integer,string) - (i,i,o)
- *****************************************************************************/
-
- PREDICATES
- window_str_test
- window_str_test(ROW,COL,STRING)
- window_str_test(KEY,ROW,COL,ROW,COL)
-
- CLAUSES
- window_str_test:-
- file_str("news.pro",X),
- textmode(RR,CC),RR1=RR-5,
- makewindow(3,7,7,"Help",RR1,0,5,CC),
- write("Up, down, left and right moves the text."),
- write("\nPress Esc to end the demo"),
- makewindow(1,7,7,"Window 1",0,0,RR1,CC),
- window_str(X),
- window_str_test(0,0,X),
- removewindow,
- removewindow.
-
- window_str_test(Row,Col,Text):-
- readkey(KEY),
- window_str_test(KEY,Row,Col,Row1,Col1),!,
- window_str(Row1,Col1,Text),
- window_str_test(Row1,Col1,Text).
- window_str_test(_,_,_).
-
- window_str_test(esc,_,_,_,_):-!,fail.
- window_str_test(up,Row1,Col,Row2,Col):-
- Row1>0, !, Row2 = Row1-1.
- window_str_test(down,Row1,Col,Row2,Col):- !,
- Row2 = Row1 + 1.
- window_str_test(left,Row,Col1,Row,Col2):-
- Col1>0, !, Col2 = Col1 - 1.
- window_str_test(right,Row,Col1,Row,Col2):- !,
- Col2 = Col1 + 1.
- window_str_test(_,Row,Col,Row,Col).
-
-
- /*****************************************************************************
- Test expand and compress window
- *****************************************************************************/
-
- PREDICATES
- test_expand
-
- CLAUSES
- test_expand:-keypressed,!.
- test_expand:-
- makewindow(_,_,_,_,_,_,RR,CC),
- RR1=RR-1,CC1=CC-15,
- expandwindow,
- time(H,M,S,_),
- format(Time,"%2:%2:%2",H,M,S),
- field_str(RR1,5,8,Time),
- date(Year,Month,Day),
- format(Date,"%/%/%",Day,Month,Year),
- str_len(Date,DateLen),
- field_str(RR1,CC1,DateLen,Date),
- compresswindow,
- test_expand.
-
-
- /*****************************************************************************
- Timeout loop.
- *****************************************************************************/
-
- PREDICATES
- ttimeout(real)
-
- CLAUSES
- ttimeout(TM):-
- timeout(TM), !,
- write("\nTIMEOUT!").
- ttimeout(TM):-
- write("\nNo timeout, sleep 0.5 secs"),
- sleep(50),
- ttimeout(TM).
-
-
- /*****************************************************************************
- Main testing clauses
- *****************************************************************************/
-
- CONSTANTS
- /*
- fa_rdonly = $01 /* Read only file */
- fa_hidden = $02 /* Hidden file */
- fa_system = $04 /* System file */
- fa_subdir = $10 /* Subdirectory */
- fa_arch = $20 /* Archive file */
- fa_normal = $40 /* Normal file - No read/write restrictions */
- */
-
- DOMAINS
- file=filesel
- db_selector = db
-
- PREDICATES
- test
-
- CLAUSES
- test:-
- present("Test the last error predicate"),
- trap(shiftwindow(10000),_,testtrap),
- fail.
-
- test:-
- present("test the predicate: window_str/3"),
- window_str_test,
- fail.
-
- test:-
- present("test the predicate: osversion"),
- osversion(V),
- write("\nYour OS version is ",V,'\n'),
- fail.
-
- test:-
- present("test the predicates: expandwindow and compresswindow"),
- makewindow(1,7,7,"HELLO",5,5,10,50),
- write("\n Example on how to write in the border"),
- write("\n By using expand- and compresswindow"),
- write("\n Press Esc to end the demo"),
- test_expand,
- removewindow,
- fail.
-
- test:-
- present("test the predicate: stlnsetup"),
- write("\n Try to change the content of the display"),
- write("\n and the file name select, and watch the status lines"),
- write("\n when the editor and the directory browser is called"),
- stlnsetup,
- makewindow(1,7,7,"Small edit window",5,20,10,40),
- display("This is the editor called in display mode"),
- dir("","*.pro",_),
- fail.
-
- test:-
- removewindow,
- fail.
-
- test:-
- present("test the predicate: keyboardsetup"),
- write("\n Change keyboard setup, and inspect the keyboard setup"),
- write("\n when the editor is called afterwards"),
- keyboardsetup,
- makewindow(1,7,7,"Small edit window",5,20,10,40),
- edit("test",_),
- removewindow,
- fail.
-
- test:-
- present("test the predicate: searchfile"),
- SearchFile(".;..;C:\\","autoexec.bat",FoundName),
- write("\nAutoexec.bat is found at: ",FoundName),
- fail.
-
- test:-
- present("test the predicate: cursorstate"),
- makewindow(1,7,7,"",5,5,7,35),
- cursorstate(off),
- write("Now the cursor has been switched\noff\nPress any key to continue"),
- readkey(_),
- clearwindow,
- write("OK, turn cursor on\nand off a few times: "),
- sound(10,880),
- cursorstate(on),
- sleep(200),
- sound(10,440),
- cursorstate(off),
- sleep(200),
- sound(10,880),
- cursorstate(on),
- sleep(200),
- sound(10,440),
- cursorstate(off),
- sleep(200),
- sound(10,880),
- cursorstate(on),
- sleep(200),
- sound(10,440),
- cursorstate(off),
- sleep(200),
- edit("When cursorstate(off) has been\ncalled, not even the editor\nwill turn it on.",_),
- cursorstate(on),
- removewindow,
- fail.
-
- test:-
- present("test the predicates: readblock & writeblock"),
- file_str("dd.dat","This\nis\na\ntest\n"),
- openmodify(filesel,"dd.dat"),
- readdevice(filesel),
- readblock(11,Str),
- writedevice(filesel),
- filepos(filesel,18,0),
- writeblock(11,Str),
- closefile(filesel),
- file_str("dd.dat",Result),
- makewindow(1,7,7,"Read from file",5,5,10,40),
- write(">>",Str,"<<"),
- write("\n( Note that the carriage return\ncharacter deletes the line)"),
- makewindow(1,7,7,"The result is",13,15,10,40),
- write(">>",Result,"<<"),
- readkey(_),
- removewindow,removewindow,
- fail.
-
- test:-
- present("test the predicate: str_ref/2"),
- db_create(db,"dd",in_memory),
- chain_inserta(db,"Chain",integer,99,Ref),
- str_ref(Str,Ref),
- write("\nRef=",Ref,", Str=",Str),
- write("\nConvert back to reference number"),
- str_ref(Str,Ref1),
- write("\nRef1=",Ref,", Str=",Str),
- write("\nTest for equality"),
- Ref=Ref1,
- write("\nSucces\nTest for equality with the spred"),
- write("\nSucces"),
- str_ref(Str,Ref1),
- db_close(db),
- fail.
-
- test:-
- present("test the predicate: real_ints/5"),
- R=115.0,
- real_ints(R,I1,I2,I3,I4),
- write("\nReal=",R,", I1=",I1,", I2=",I2,", I3=",I3,", I4=",I4),
- real_ints(Real,I1,I2,I3,I4),
- write("\nConverted back: Real=",Real),
- fail.
-
- test:-
- present("test the predicate: FileNamePath"),
- FullName="c:\\psys\\prolog.exe",
- FileNamePath(FullName,Path,Name),
- write("\nFullName=",FullName),
- write("\nPath=",Path),
- write("\nName=",Name),
- FileNamePath(NewName,Path,Name),
- write("\nConverted back: ",NewName),
- fail.
-
- test:-
- present("test the predicate: FileNameExt"),
- FullName="c:\\psys\\prolog.exe",
- FileNameExt(FullName,Name,Ext),
- write("\nFullName=",FullName),
- write("\nExt=",Ext),
- write("\nName=",Name),
- FileNameExt(NewName,Name,Ext),
- write("\nConverted back: ",NewName),
-
- % Override the old extension
- FileNameExt(NewName1,"PROLOG.EXE",".HLP"),
- write("\nNewName1=",NewName1),
- fail.
-
- test:-
- present("test the predicate: bt_copyselector"),
- db_create(db,"dd",in_memory),
- bt_create(db,"dd",BTSEL,5,5),
- bt_copyselector(db,BTSEL,NewBtSel),
- write("\nOldBtsel=",BTSEL),
- write("\nNewBtsel=",NEWBTSEL),
- db_close(db),
- fail.
-
- test:-
- present("Insert binary chunks in the external DB"),
- db_create(db,"dd",in_memory),
-
- % For an easy demo just ordinary strings are inserted in the database
- chain_bininserta(db,"chain1","HELLO",6,Ref1),
- chain_bininsertz(db,"chain1","GUYS",5,Ref3),
- chain_bininsertafter(db,"chain1",Ref3,"YOU",4,Ref2),
-
- ref_bin(db,Ref1,Str1,Size1),
- write("\nRef=",Ref1,", Str=",Str1,", Size=",Size1),
- ref_bin(db,Ref2,Str2,Size2),
- write("\nRef=",Ref2,", Str=",Str2,", Size=",Size2),
- ref_bin(db,Ref3,Str3,Size3),
- write("\nRef=",Ref3,", Str=",Str3,", Size=",Size3),
- db_close(db),
- fail.
-
- ifdef try_ems
- test:-
- present("test the predicate: availableems"),
- availableems(Size),
- write("\nAvailable ems size=",Size),
- fail.
- enddef
-
- test:-
- present("Test new date/4"),
- date(Y,M,D,Dow),
- writef("\nThis is day number % - date is %/%/%",Dow,Y,M,D),
- fail.
-
- test:-
- present("Test the syspath predicate"),
- syspath(Path,Name),
- write("\nExecuting ",Name," from ",Path,'\n'),
- fail.
-
- test:-
- present("Test the new string predicates"),
- substring("GOLORP",2,3,S1),
- write("\nsubstring(\"GOLORP\",2,3,S1) gives S1 = ",S1,'\n'),
- subchar("GOLORP",1,Char),
- write("subchar(\"GOLORP\",1,Char) gives Char = ",Char,'\n'),
- searchstring("GOLORP","OLO",Pos),
- write("searchstring(\"GOLORP\",\"OLO\",Pos) gives Pos = ",Pos,'\n'),
- searchchar("GOLORP",'L',Pos1),
- write("searchchar(\"GOLORP\",'L',Pos1) gives Pos1 = ",Pos1,'\n'),
- fail.
-
- test:-
- present("Sleep 1.5 seconds"),
- sleep(150),
- write("\nWAKY-WAAYYKYYYY!"),
- fail.
-
- test:-
- present("Mark time for four secs and timeout"),
- marktime(400,TM),
- ttimeout(TM),
- fail.
- test:-
- present("Test new file- and directory handling"),
- write("\nTest mkdir - please enter name of directory to make: "),
- readln(DirName),
- mkdir(DirName),
- write(DirName," created, please select file to copy to new directory:"),
- makewindow(99,7,7,"",3,3,10,60),
- dir("c:\\","*.*",Fname),
- removewindow,
- filenamepath(Fname,_,BaseName),
- filenamepath(NewFname,DirName,BaseName),
- writef("\nCopy % to %\n",Fname,NewFname),
- copyfile(Fname,NewFname),
- writef("Now use directory matching to look at %\nPress a key",NewFname),
- readkey(_),
- diropen(NewFname,fa_normal,Block),
- dirmatch(Block,CopyFnam,CopyAttr,CopyHour,CopyMin,
- CopySec,CopyYear,CopyMonth,CopyDay,CopySize),
- dirclose(Block),
- write("\nIn ",DirName," we find ",CopyFnam,' ',CopyAttr,' ',CopyHour,':',
- CopyMin,':',CopySec,' ',
- CopyDay,'-',CopyMonth,'-',CopyYear,' ',CopySize,'\n'),
- writef("Press any key to delete % and remove directory %",NewFname,DirName),
- readkey(_),
- deletefile(NewFname),
- rmdir(DirName),
- fail.
-
- test:-
- present("Find all hidden and system files in C:\\\n"),
- Attrib = fa_system + fa_hidden,
- dirfiles("c:\\*.*",Attrib,Fnam,RetAttr,Hour,Min,Sec,
- Year,Month,Day,Size),
- write(Fnam,' ',RetAttr,' ',Hour,':',Min,':',Sec,' ',Day,'-',
- Month,'-',Year,' ',Size,'\n'),
- fail.
-
- test:-
- present("test the predicates: configload & configsave"),
- write("\n Load a new setup from: "),
- configload("PROLOG.CFG",FoundName),
- write(FoundName),
- configsave("DD.CFG"),
- keyboardsetup,
- fail.
-
- test:-
- present("That was all").
-
-
- /*****************************************************************************
- Goal
- *****************************************************************************/
-
- GOAL
- textmode(RR,CC),
- makewindow(55,7,7,"Dialog window",0,0,RR,CC),
- test.
-