home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l217 / 2.ddi / PROGRAMS / NEWS.PRO < prev    next >
Encoding:
Text File  |  1990-03-26  |  11.7 KB  |  438 lines

  1.  
  2. include "tdoms.pro"
  3. include "tpreds.pro"
  4. include "..\\include\\iodecl.pre"
  5.  
  6.  
  7. /*****************************************************************************
  8.     Define the constant below to try out the availableems predicate.
  9.     This predicate only applies to DOS, and won't be recognized in
  10.     the OS/2 version.
  11. *****************************************************************************/
  12.  
  13. CONSTANTS
  14. %try_ems = 1
  15.  
  16.  
  17. /*****************************************************************************
  18.     Present the user for a text
  19. *****************************************************************************/
  20.  
  21. PREDICATES
  22.   present(STRING)
  23.  
  24. CLAUSES
  25.   present(S):-
  26.     write("\n-----------------------------------------------------------\n"),
  27.     write(S),
  28.     readkey(_).
  29.  
  30. /*****************************************************************************
  31.     Test the last error predicate
  32. *****************************************************************************/
  33.  
  34. PREDICATES
  35.   testtrap
  36.  
  37. CLAUSES
  38.   testtrap:-
  39.     lasterror(ErrorNo,Module,IncludeFile,Pos),
  40.     write("\nModule=",Module,", IncludeFile=",IncludeFile,", Pos=",Pos,",No=",ErrorNo).
  41.  
  42.  
  43. /*****************************************************************************
  44.         Test
  45. window_str_offset(RowOffset,ColOffset,ScreenString)
  46.     (integer,integer,string) - (i,i,o)
  47. *****************************************************************************/
  48.  
  49. PREDICATES
  50.   window_str_test
  51.   window_str_test(ROW,COL,STRING)
  52.   window_str_test(KEY,ROW,COL,ROW,COL)
  53.  
  54. CLAUSES
  55.   window_str_test:-
  56.     file_str("news.pro",X),
  57.     textmode(RR,CC),RR1=RR-5,
  58.     makewindow(3,7,7,"Help",RR1,0,5,CC),
  59.     write("Up, down, left and right moves the text."),
  60.     write("\nPress Esc to end the demo"),
  61.     makewindow(1,7,7,"Window 1",0,0,RR1,CC),
  62.     window_str(X),
  63.     window_str_test(0,0,X),
  64.     removewindow,
  65.     removewindow.
  66.  
  67.   window_str_test(Row,Col,Text):-
  68.     readkey(KEY),
  69.     window_str_test(KEY,Row,Col,Row1,Col1),!,
  70.     window_str(Row1,Col1,Text),
  71.     window_str_test(Row1,Col1,Text).
  72.   window_str_test(_,_,_).
  73.  
  74.   window_str_test(esc,_,_,_,_):-!,fail.
  75.   window_str_test(up,Row1,Col,Row2,Col):-
  76.       Row1>0, !, Row2 = Row1-1.
  77.   window_str_test(down,Row1,Col,Row2,Col):- !,
  78.         Row2 = Row1 + 1.
  79.   window_str_test(left,Row,Col1,Row,Col2):-
  80.       Col1>0, !, Col2 = Col1 - 1.
  81.   window_str_test(right,Row,Col1,Row,Col2):- !,
  82.       Col2 = Col1 + 1.
  83.   window_str_test(_,Row,Col,Row,Col).
  84.  
  85.  
  86. /*****************************************************************************
  87.     Test expand and compress window
  88. *****************************************************************************/
  89.  
  90. PREDICATES
  91.   test_expand
  92.  
  93. CLAUSES
  94.   test_expand:-keypressed,!.
  95.   test_expand:-
  96.     makewindow(_,_,_,_,_,_,RR,CC),
  97.     RR1=RR-1,CC1=CC-15,
  98.     expandwindow,
  99.     time(H,M,S,_),
  100.     format(Time,"%2:%2:%2",H,M,S),
  101.     field_str(RR1,5,8,Time),
  102.     date(Year,Month,Day),
  103.     format(Date,"%/%/%",Day,Month,Year),
  104.     str_len(Date,DateLen),
  105.     field_str(RR1,CC1,DateLen,Date),
  106.     compresswindow,
  107.     test_expand.
  108.  
  109.  
  110. /*****************************************************************************
  111.     Timeout loop.
  112. *****************************************************************************/
  113.  
  114. PREDICATES
  115.   ttimeout(real)
  116.  
  117. CLAUSES
  118.   ttimeout(TM):-
  119.     timeout(TM), !,
  120.     write("\nTIMEOUT!").
  121.   ttimeout(TM):-
  122.     write("\nNo timeout, sleep 0.5 secs"),
  123.     sleep(50),
  124.     ttimeout(TM).
  125.  
  126.  
  127. /*****************************************************************************
  128.     Main testing clauses
  129. *****************************************************************************/
  130.  
  131. CONSTANTS
  132. /*
  133. fa_rdonly = $01    /* Read only file       */
  134. fa_hidden = $02    /* Hidden file          */
  135. fa_system = $04    /* System file          */
  136. fa_subdir = $10    /* Subdirectory         */
  137. fa_arch   = $20    /* Archive file         */
  138. fa_normal = $40    /* Normal file - No read/write restrictions */
  139. */
  140.  
  141. DOMAINS
  142.   file=filesel
  143.   db_selector = db
  144.  
  145. PREDICATES
  146.   test
  147.  
  148. CLAUSES
  149.   test:-
  150.     present("Test the last error predicate"),
  151.     trap(shiftwindow(10000),_,testtrap),
  152.     fail.
  153.  
  154.   test:-
  155.     present("test the predicate: window_str/3"),
  156.     window_str_test,
  157.     fail.
  158.  
  159.   test:-
  160.     present("test the predicate: osversion"),
  161.     osversion(V),
  162.     write("\nYour OS version is ",V,'\n'),
  163.     fail.
  164.  
  165.   test:-
  166.     present("test the predicates: expandwindow and compresswindow"),
  167.     makewindow(1,7,7,"HELLO",5,5,10,50),
  168.     write("\n  Example on how to write in the border"),
  169.     write("\n  By using expand- and compresswindow"),
  170.     write("\n  Press Esc to end the demo"),
  171.     test_expand,
  172.     removewindow,
  173.     fail.
  174.  
  175.   test:-
  176.     present("test the predicate: stlnsetup"),
  177.     write("\n  Try to change the content of the display"),
  178.     write("\n  and the file name select, and watch the status lines"),
  179.     write("\n  when the editor and the directory browser is called"),
  180.     stlnsetup,
  181.     makewindow(1,7,7,"Small edit window",5,20,10,40),
  182.     display("This is the editor called in display mode"),
  183.     dir("","*.pro",_),
  184.     fail.
  185.  
  186.   test:-
  187.     removewindow,
  188.     fail.
  189.  
  190.   test:-
  191.     present("test the predicate: keyboardsetup"),
  192.     write("\n  Change keyboard setup, and inspect the keyboard setup"),
  193.     write("\n  when the editor is called afterwards"),
  194.     keyboardsetup,
  195.     makewindow(1,7,7,"Small edit window",5,20,10,40),
  196.     edit("test",_),
  197.     removewindow,
  198.     fail.
  199.  
  200.   test:-
  201.     present("test the predicate: searchfile"),
  202.     SearchFile(".;..;C:\\","autoexec.bat",FoundName),
  203.     write("\nAutoexec.bat is found at: ",FoundName),
  204.     fail.
  205.  
  206.   test:-
  207.     present("test the predicate: cursorstate"),
  208.     makewindow(1,7,7,"",5,5,7,35),
  209.     cursorstate(off),
  210.     write("Now the cursor has been switched\noff\nPress any key to continue"),
  211.     readkey(_),
  212.     clearwindow,
  213.     write("OK, turn cursor on\nand off a few times: "),
  214.     sound(10,880),
  215.     cursorstate(on),
  216.     sleep(200),
  217.     sound(10,440),
  218.     cursorstate(off),
  219.     sleep(200),
  220.     sound(10,880),
  221.     cursorstate(on),
  222.     sleep(200),
  223.     sound(10,440),
  224.     cursorstate(off),
  225.     sleep(200),
  226.     sound(10,880),
  227.     cursorstate(on),
  228.     sleep(200),
  229.     sound(10,440),
  230.     cursorstate(off),
  231.     sleep(200),
  232.     edit("When cursorstate(off) has been\ncalled, not even the editor\nwill turn it on.",_),
  233.     cursorstate(on),
  234.     removewindow,
  235.     fail.
  236.  
  237.   test:-
  238.     present("test the predicates: readblock & writeblock"),
  239.     file_str("dd.dat","This\nis\na\ntest\n"),
  240.     openmodify(filesel,"dd.dat"),
  241.     readdevice(filesel),
  242.     readblock(11,Str),
  243.     writedevice(filesel),
  244.     filepos(filesel,18,0),
  245.     writeblock(11,Str),
  246.     closefile(filesel),
  247.     file_str("dd.dat",Result),
  248.     makewindow(1,7,7,"Read from file",5,5,10,40),
  249.     write(">>",Str,"<<"),
  250.     write("\n( Note that the carriage return\ncharacter deletes the line)"),
  251.     makewindow(1,7,7,"The result is",13,15,10,40),
  252.     write(">>",Result,"<<"),
  253.     readkey(_),
  254.     removewindow,removewindow,
  255.     fail.
  256.  
  257.   test:-
  258.     present("test the predicate: str_ref/2"),
  259.     db_create(db,"dd",in_memory),
  260.     chain_inserta(db,"Chain",integer,99,Ref),
  261.     str_ref(Str,Ref),
  262.     write("\nRef=",Ref,", Str=",Str),
  263.     write("\nConvert back to reference number"),
  264.     str_ref(Str,Ref1),
  265.     write("\nRef1=",Ref,", Str=",Str),
  266.     write("\nTest for equality"),
  267.     Ref=Ref1,
  268.     write("\nSucces\nTest for equality with the spred"),
  269.     write("\nSucces"),
  270.     str_ref(Str,Ref1),
  271.     db_close(db),
  272.     fail.
  273.  
  274.   test:-
  275.     present("test the predicate: real_ints/5"),
  276.     R=115.0,
  277.     real_ints(R,I1,I2,I3,I4),
  278.     write("\nReal=",R,", I1=",I1,", I2=",I2,", I3=",I3,", I4=",I4),
  279.     real_ints(Real,I1,I2,I3,I4),
  280.     write("\nConverted back: Real=",Real),
  281.     fail.
  282.  
  283.   test:-
  284.     present("test the predicate: FileNamePath"),
  285.     FullName="c:\\psys\\prolog.exe",
  286.     FileNamePath(FullName,Path,Name),
  287.     write("\nFullName=",FullName),
  288.     write("\nPath=",Path),
  289.     write("\nName=",Name),
  290.     FileNamePath(NewName,Path,Name),
  291.     write("\nConverted back: ",NewName),
  292.     fail.
  293.  
  294.   test:-
  295.     present("test the predicate: FileNameExt"),
  296.     FullName="c:\\psys\\prolog.exe",
  297.     FileNameExt(FullName,Name,Ext),
  298.     write("\nFullName=",FullName),
  299.     write("\nExt=",Ext),
  300.     write("\nName=",Name),
  301.     FileNameExt(NewName,Name,Ext),
  302.     write("\nConverted back: ",NewName),
  303.     
  304.     % Override the old extension
  305.     FileNameExt(NewName1,"PROLOG.EXE",".HLP"),
  306.     write("\nNewName1=",NewName1),
  307.     fail.
  308.  
  309.   test:-
  310.     present("test the predicate: bt_copyselector"),
  311.     db_create(db,"dd",in_memory),
  312.     bt_create(db,"dd",BTSEL,5,5),
  313.     bt_copyselector(db,BTSEL,NewBtSel),
  314.     write("\nOldBtsel=",BTSEL),
  315.     write("\nNewBtsel=",NEWBTSEL),
  316.     db_close(db),
  317.     fail.
  318.  
  319.   test:-
  320.     present("Insert binary chunks in the external DB"),
  321.     db_create(db,"dd",in_memory),
  322.  
  323.     % For an easy demo just ordinary strings are inserted in the database
  324.     chain_bininserta(db,"chain1","HELLO",6,Ref1),
  325.     chain_bininsertz(db,"chain1","GUYS",5,Ref3),
  326.     chain_bininsertafter(db,"chain1",Ref3,"YOU",4,Ref2),
  327.  
  328.     ref_bin(db,Ref1,Str1,Size1),
  329.     write("\nRef=",Ref1,", Str=",Str1,", Size=",Size1),
  330.     ref_bin(db,Ref2,Str2,Size2),
  331.     write("\nRef=",Ref2,", Str=",Str2,", Size=",Size2),
  332.     ref_bin(db,Ref3,Str3,Size3),
  333.     write("\nRef=",Ref3,", Str=",Str3,", Size=",Size3),
  334.     db_close(db),
  335.     fail.
  336.  
  337. ifdef try_ems
  338.   test:-
  339.     present("test the predicate: availableems"),
  340.     availableems(Size),
  341.     write("\nAvailable ems size=",Size),
  342.     fail.
  343. enddef
  344.  
  345.   test:-
  346.     present("Test new date/4"),
  347.     date(Y,M,D,Dow),
  348.     writef("\nThis is day number % - date is %/%/%",Dow,Y,M,D),
  349.     fail.
  350.  
  351.   test:-
  352.     present("Test the syspath predicate"),
  353.     syspath(Path,Name),
  354.     write("\nExecuting ",Name," from ",Path,'\n'),
  355.     fail.
  356.  
  357.   test:-
  358.     present("Test the new string predicates"),
  359.     substring("GOLORP",2,3,S1),
  360.     write("\nsubstring(\"GOLORP\",2,3,S1) gives S1 = ",S1,'\n'),
  361.     subchar("GOLORP",1,Char),
  362.     write("subchar(\"GOLORP\",1,Char) gives Char = ",Char,'\n'),
  363.     searchstring("GOLORP","OLO",Pos),
  364.     write("searchstring(\"GOLORP\",\"OLO\",Pos) gives Pos = ",Pos,'\n'),
  365.     searchchar("GOLORP",'L',Pos1),
  366.     write("searchchar(\"GOLORP\",'L',Pos1) gives Pos1 = ",Pos1,'\n'),
  367.     fail.
  368.  
  369.   test:-
  370.     present("Sleep 1.5 seconds"),
  371.     sleep(150),
  372.     write("\nWAKY-WAAYYKYYYY!"),
  373.     fail.
  374.  
  375.   test:-
  376.     present("Mark time for four secs and timeout"),
  377.     marktime(400,TM),
  378.     ttimeout(TM),
  379.     fail.
  380.   test:-
  381.     present("Test new file- and directory handling"),
  382.     write("\nTest mkdir - please enter name of directory to make: "),
  383.     readln(DirName),
  384.     mkdir(DirName),
  385.     write(DirName," created, please select file to copy to new directory:"),
  386.     makewindow(99,7,7,"",3,3,10,60),
  387.     dir("c:\\","*.*",Fname),
  388.     removewindow,
  389.     filenamepath(Fname,_,BaseName),
  390.     filenamepath(NewFname,DirName,BaseName),
  391.     writef("\nCopy % to %\n",Fname,NewFname),
  392.     copyfile(Fname,NewFname),
  393.     writef("Now use directory matching to look at %\nPress a key",NewFname),
  394.     readkey(_),
  395.     diropen(NewFname,fa_normal,Block),
  396.     dirmatch(Block,CopyFnam,CopyAttr,CopyHour,CopyMin,
  397.                 CopySec,CopyYear,CopyMonth,CopyDay,CopySize),
  398.     dirclose(Block),
  399.     write("\nIn ",DirName," we find ",CopyFnam,' ',CopyAttr,' ',CopyHour,':',
  400.             CopyMin,':',CopySec,' ',
  401.             CopyDay,'-',CopyMonth,'-',CopyYear,' ',CopySize,'\n'),
  402.     writef("Press any key to delete % and remove directory %",NewFname,DirName),
  403.     readkey(_),
  404.     deletefile(NewFname),
  405.     rmdir(DirName),
  406.     fail.
  407.  
  408.   test:-
  409.     present("Find all hidden and system files in C:\\\n"),
  410.     Attrib = fa_system + fa_hidden,
  411.     dirfiles("c:\\*.*",Attrib,Fnam,RetAttr,Hour,Min,Sec,
  412.                             Year,Month,Day,Size),
  413.     write(Fnam,' ',RetAttr,' ',Hour,':',Min,':',Sec,' ',Day,'-',
  414.                         Month,'-',Year,' ',Size,'\n'),
  415.     fail.
  416.  
  417.   test:-
  418.     present("test the predicates: configload & configsave"),
  419.     write("\n  Load a new setup from: "),
  420.     configload("PROLOG.CFG",FoundName),
  421.     write(FoundName),
  422.     configsave("DD.CFG"),
  423.     keyboardsetup,
  424.     fail.
  425.  
  426.   test:-
  427.     present("That was all").
  428.  
  429.  
  430. /*****************************************************************************
  431.     Goal
  432. *****************************************************************************/
  433.  
  434. GOAL 
  435.     textmode(RR,CC),
  436.     makewindow(55,7,7,"Dialog window",0,0,RR,CC),
  437.     test.
  438.