home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / RPCX10 / RPCXDEMO.PRG < prev    next >
Text File  |  1993-09-15  |  16KB  |  623 lines
  1. *--------------------------------------------------------------------------
  2. * RPCXDemo.PRG - Program to demonstrate the use of the functions
  3. *                in the graphic RPCXLib library for Clipper
  4. *
  5. * This demo has been written for Clipper version 5.xx
  6. *
  7. * Compile    :    CLIPPER RPCXDEMO /N
  8. *
  9. * Link       :    RTLINK  file RPCXDEMO lib RPCXLIB    - or -
  10. *        BLINKER file RPCXDEMO lib RPCXLIB
  11. *
  12. * Syntax     :  RPCXDEMO [d:][\path]
  13. *        [d:][\path] : directory where PCX-files are located
  14. *--------------------------------------------------------------------------
  15. * Date       :  11/08/93
  16. *--------------------------------------------------------------------------
  17. * Author     :  Rolf van Gelder
  18. *               Binnenwiertzstraat 27
  19. *               5615 HG  EINDHOVEN
  20. *        THE NETHERLANDS
  21. *
  22. * E-Mail     :  Internet: RCROLF@urc.tue.nl
  23. *               BitNet  : RCROLF@heitue5
  24. *--------------------------------------------------------------------------
  25. * (c) 1993  Rolf van Gelder  -  All rights reserved
  26. *--------------------------------------------------------------------------
  27. MEMVAR    GetList                && To eliminate Clipper /W warning
  28.  
  29. *--------------------------------------------------------------------------
  30. * Standard Clipper HEADER files
  31. *--------------------------------------------------------------------------
  32. #include "Inkey.ch"
  33. #include "AChoice.ch"
  34. #include "SetCurs.ch"
  35. #include "Directry.ch"
  36.  
  37. *--------------------------------------------------------------------------
  38. * RPCXLIB HEADER FILE
  39. *--------------------------------------------------------------------------
  40. #include "RPCXLib.ch"
  41.  
  42. *--------------------------------------------------------------------------
  43. * Static array (used by different functions)
  44. *--------------------------------------------------------------------------
  45. *-- Initialize the array with error messages (from RPCXLib.CH)
  46. STATIC    aPCXError := PL_ERRMSG
  47.  
  48. *--------------------------------------------------------------------------
  49. *
  50. *                         Main function : RPCXDemo
  51. *
  52. *--------------------------------------------------------------------------
  53.  
  54. FUNCTION R_PCXDemo ( cDrvPath )
  55.  
  56. LOCAL    nSVGA     := R_VGACard ()    && Number of SVGA card
  57. LOCAL    aDrivers  := PL_SVGA_NAMES    && Names of the SVGA cards
  58.  
  59. LOCAL    cGraphDrv            && Description SVGA card
  60. LOCAL    cGraphSys := 'UNKNOWN'        && Description Graphic System
  61.  
  62. LOCAL    cGraphMsg            && Text buffer
  63.  
  64. LOCAL    nFiles                && Number of PCX-files in directory
  65. LOCAL    nBottom                && Last line for AChoice window
  66.  
  67. LOCAL    aPCXList  := {}            && Array with PCX-file info
  68. LOCAL    aValid    := {}            && Selectable items for AChoice
  69. LOCAL    aPCXDir   := {}            && Directory info PCX-files
  70.  
  71. LOCAL    nChoice   := 1            && Sequence number chosen file
  72. LOCAL    nLastKey            && Keycode
  73. LOCAL    cFile                && Name of PCX-file
  74. LOCAL    nVidMode  := R_VMGet ()        && Original video mode
  75. LOCAL    nRetCode            && Return code of R_ShowPCX
  76. LOCAL    cScreen                && Screen buffer
  77. LOCAL    cSpec                && Filespec PCX-file
  78. LOCAL    cComment            && Comment on PCX-file
  79. LOCAL    i                && Counter
  80. LOCAL    n                && Help variable
  81. LOCAL    nRed                && Red   component
  82. LOCAL    nGreen                && Green component
  83. LOCAL    nBlue                && Blue  component
  84.  
  85. LOCAL    aBWhite := PL_DEF_BRIGHT_WHITE    && Composition BRIGHT WHITE
  86. LOCAL    aWhite  := PL_DEF_WHITE        && Composition WHITE
  87. LOCAL    aYellow := PL_DEF_YELLOW    && Composition YELLOW
  88.  
  89. LOCAL    cPalette            && Palette buffer
  90. LOCAL    cPalOrg := R_SavePal ()        && Save original palette
  91.  
  92. *-- Install the default Clipper palette (just to be sure ...)
  93. R_DefPal ()
  94.  
  95. *-- Mix a special GREEN colour for the background :
  96. *--    5 x RED + 30 x GREEN + 30 x BLUE
  97. R_SetRGB ( PL_GREEN, 5, 30, 30 )
  98.  
  99. *-- Determine the number of PCX-files in the current directory
  100. IF cDrvPath != NIL
  101.    *-- Path passed as command line parameter
  102.  
  103.    *-- Append a backslash (if needed)
  104.    cDrvPath := Trim ( cDrvPath )
  105.  
  106.    IF Right ( cDrvPath, 1 ) != ':'
  107.       *-- Path has been given
  108.  
  109.       IF Right ( cDrvPath, 1 ) != '\'
  110.          *-- Path doesn't end with a backslash : append !
  111.  
  112.          cDrvPath += '\'
  113.  
  114.       ENDIF
  115.  
  116.    ENDIF
  117.  
  118. ELSE
  119.    *-- No drive nor path given
  120.  
  121.    cDrvPath := ''
  122.  
  123. ENDIF
  124.  
  125. *-- Get the directory list of the PCX-files
  126. aPCXDir := Directory ( cDrvPath + '*.PCX' )
  127. nFiles  := Len ( aPCXDir )
  128.  
  129. IF nFiles > 0
  130.    *-- PCX-files found !
  131.  
  132.    FOR i := 1 TO nFiles
  133.       *-- Stuff the info of all the PCX-files in an array
  134.  
  135.       AADD ( aValid , GetInfo (cDrvPath+aPCXDir[i,F_NAME], @cSpec, @cComment ) )
  136.       AADD ( aPCXList, PADR ( aPCXDir[i,F_NAME], 12 ) + ' │ ' + ;
  137.          Str ( aPCXDir[i,F_SIZE],6 ) + ' │ ' + ;
  138.          PADR ( cSpec, 16 ) + ' │ ' + PADR ( cComment, 33 ) )
  139.  
  140.    NEXT
  141.  
  142.    *-- Sort the array on file name
  143.    aPCXList := ASORT ( aPCXList )
  144.    
  145. ENDIF
  146.  
  147. IF nSVGA < 1
  148.    *-- SuperVGA unknown or not present !
  149.  
  150.    *-- Determine the graphic system of the PC
  151.    IF R_IsMCGA ()
  152.       cGraphSys := 'MCGA'
  153.       
  154.    ELSEIF R_IsVGA ()
  155.       cGraphSys := 'VGA'
  156.       
  157.    ELSEIF R_IsEGA ()
  158.       cGraphSys := 'EGA'
  159.       
  160.    ENDIF
  161.    
  162. ELSE
  163.    
  164.    cGraphSys := 'SUPERVGA'
  165.  
  166.    *-- Name of the SuperVGA adapter
  167.    cGraphDrv := aDrivers [nSVGA]
  168.    
  169. ENDIF
  170.  
  171. SETCOLOR ( 'W+/G' )
  172. SETBLINK ( .t. )
  173. CLEAR
  174.  
  175. *-- Header text
  176. DEVPOS ( 1, 12 )
  177. DEVOUT ( 'RPCXDemo :  Demo program for the RPCXLib Clipper Library' )
  178.  
  179. SETCOLOR ( 'GR+/G' )
  180. DEVPOS ( 2, 27 )
  181. DEVOUT ( '(c) 1993   Rolf van Gelder' )
  182. SETCOLOR ('W+/G')
  183.  
  184. IF nFiles < 1
  185.    *-- No PCX-files in current directory :
  186.    *--    Just show the graphic configuration
  187.    
  188.    ALERT ( '-+- CONFIGURATION -+-;;;Graphic System: ' + cGraphSys + ;
  189.       IF ( cGraphDrv != nil, ';;;SVGA Adapter: ' + cGraphDrv, nil ) )
  190.    
  191.    ALERT ( 'No PCX-files found !' )
  192.    
  193.    RETURN nil
  194.    
  195. ENDIF
  196.  
  197. *-- Determine the height of the directory listbox
  198. nBottom := Min ( nFiles+6, 16 ) 
  199.  
  200. DEVPOS ( nBottom+1, 11 )
  201. DEVOUT ( '<─┘ = Show file  -+-  <F10> = SlideShow   -+- <Esc> = Quit' )
  202.  
  203. @19,0 TO 22,79
  204. DEVPOS ( 20, 2 )
  205. DEVOUT ( 'MIX BACKGROUND COLOUR         Current values : RED   5'+;
  206.          ' - GREEN 30 -  BLUE 30' )
  207. DEVPOS ( 21, 2 )
  208. DEVOUT ( 'F1=RED    F2=RED        F3=GREEN    F4=GREEN       '+;
  209.          'F5=BLUE    F6=BLUE ' )
  210.  
  211. @4,0 TO nBottom,79 DOUBLE
  212. SETCOLOR ( 'GR+/G' )
  213. @5,2 SAY 'File name    │  Bytes │ Width Height Col │ Video mode / Comment  '
  214.  
  215. *-- Display the graphic configuration on line 23
  216. cGraphMsg := '-+- Graphic System : '+cGraphSys
  217.  
  218. IF cGraphDrv != nil
  219.    
  220.    cGraphMsg += ' -+- SVGA Adapter : '+cGraphDrv
  221.    
  222. ENDIF
  223.  
  224. cGraphMsg += ' -+-'
  225.  
  226. @23, ( 80 - LEN ( cGraphMsg ) ) / 2 SAY cGraphMsg
  227. SETCOLOR ( 'W+/G,W+/R,,,W/G' )
  228.  
  229. cScreen := SAVESCREEN ( 0, 0, MAXROW(), MAXCOL() )
  230.  
  231. *----------------------------------------------------------------
  232. * Main loop for displaying pictures and changing the background
  233. * colour
  234. *----------------------------------------------------------------
  235. DO WHILE .T.
  236.    
  237.    nChoice  := ACHOICE ( 6, 2, nBottom-1, 77, aPCXList, ;
  238.                aValid, 'AchUser', nChoice )
  239.  
  240.    nLastKey := LASTKEY ()
  241.  
  242.    DO CASE
  243.  
  244.    CASE nLastKey = K_ESC
  245.       *-- Quit
  246.       EXIT
  247.  
  248.    CASE nLastKey = K_RETURN
  249.       *-- SHOW CHOSEN FILE
  250.  
  251.       *-- File name PCX-file
  252.       cFile    := cDrvPath + TRIM ( LEFT ( aPCXList [nChoice], 12 ) )
  253.  
  254.       *-- Save current palette to a string
  255.       cPalette := R_SavePal ()
  256.  
  257.       *-- Show the PCX-file on the screen
  258.       nRetCode := R_ShowPCX ( cFile )
  259.    
  260.       IF nRetCode = PL_OKAY
  261.          *-- It went okay !
  262.  
  263.          *-- Show the picture 10 seconds (interruptible)
  264.          INKEY ( 10 )
  265.  
  266.          *-- Restore original video mode
  267.          R_VMSet ( nVidMode )
  268.  
  269.       ENDIF
  270.  
  271.       *-- Restore original palette
  272.       *-- (Palette has been reset by R_VMSet () ....)
  273.       R_RestPal ( cPalette )
  274.  
  275.       *-- Repaint the screen
  276.       RESTSCREEN ( 0, 0, MAXROW(), MAXCOL(), cScreen )
  277.  
  278.       IF nRetCode != PL_OKAY
  279.  
  280.          *-- Error while displaying PCX-file : display error message
  281.  
  282.          ALERT ('-+- Error displaying '+cFile+' -+-;;'+;
  283.             aPCXError[nRetCode])
  284.  
  285.       ENDIF
  286.  
  287.    CASE nLastKey = K_F10
  288.       *-- Slideshow
  289.  
  290.       *-- Save current palette to a string
  291.       cPalette := R_SavePal ()
  292.  
  293.       FOR i := 1 TO nFiles
  294.  
  295.           IF aValid [i]
  296.              *-- PCX-file can be displayed !
  297.  
  298.              *-- Name of the PCX-file
  299.              cFile    := cDrvPath + TRIM ( LEFT ( aPCXList [i], 12 ) )
  300.  
  301.              *-- Display the PCX-file
  302.              nRetCode := R_ShowPCX ( cFile )
  303.    
  304.              IF nRetCode = PL_OKAY
  305.                 *-- Picture is on the screen
  306.  
  307.                 *-- Wait for 5 seconds (interruptible)
  308.                 INKEY ( 5 )
  309.  
  310.              ENDIF
  311.  
  312.          ENDIF
  313.  
  314.       NEXT
  315.  
  316.       *-- Restore original video mode
  317.       R_VMSet ( nVidMode )
  318.  
  319.       *-- Restore original palette
  320.       *-- (The palette has been reset by R_VMSet () ....)
  321.       R_RestPal ( cPalette )
  322.  
  323.       *-- Repaint the screen
  324.       RESTSCREEN ( 0, 0, MAXROW(), MAXCOL(), cScreen )
  325.  
  326.    ENDCASE
  327.    
  328. ENDDO
  329.  
  330. SETCURSOR ( SC_NONE )
  331.  
  332. *--------------------------------------------------------------------------
  333. * Nice piece of code which demonstrates the DIMMING of colours.
  334. * All colours on the screen will fade to BLACK.
  335. *--------------------------------------------------------------------------
  336.  
  337. *-- Get the current composition of PL_GREEN
  338. R_GetRGB ( PL_GREEN, @nRed, @nGreen, @nBlue )
  339.  
  340. *-- Loop to put the colours to BLACK (gradually)
  341. FOR i := 63 TO 0 STEP -1
  342.  
  343.    *-- Scaling factor
  344.    N := i / 63
  345.  
  346.    *-- Decrease BRIGHT WHITE
  347.    R_SetRGB ( PL_BRIGHT_WHITE, N * aBWhite[1], N * aBWhite[2], N * aBWhite[3] )
  348.  
  349.    *-- Decrease WHITE
  350.    R_SetRGB ( PL_WHITE,  N * aWhite[1],  N * aWhite[2],  N * aWhite[3] )
  351.  
  352.    *-- Decrease YELLOW
  353.    R_SetRGB ( PL_YELLOW, N * aYellow[1], N * aYellow[2], N * aYellow[3] )
  354.  
  355.    *-- Decrease GREEN
  356.    R_SetRGB ( PL_GREEN,  N * nRed,       N * nGreen,     N * nBlue )
  357.  
  358.    *-- Little delay
  359.    IF INKEY ( 0.1 ) = K_ESC
  360.       *-- <Esc> pressed : abort
  361.       EXIT
  362.    ENDIF
  363.    
  364. NEXT
  365.  
  366. SETCOLOR ('W/N')
  367.  
  368. CLEAR
  369.  
  370. *-- Restore the original palette
  371. R_RestPal ( cPalOrg )
  372.  
  373. CLEAR
  374.  
  375. SETCURSOR ( SC_NORMAL )
  376.  
  377. RETURN NIL
  378.  
  379.  
  380. *--------------------------------------------------------------------------
  381. *
  382. *                   GetInfo ( cFName, cSpec, cComment )
  383. *
  384. *--------------------------------------------------------------------------
  385. * Function to get and format PCX-file information
  386. *
  387. * INPUT
  388. * cFName   : Name PCX-file (has to have the .PCX extension)
  389. * cSpec    : Text buffer for specification of the PCX-file
  390. * cComment : Text buffer for comment about the PCX-file
  391. *
  392. * OUTPUT
  393. * lValid   : .T. = PCX-file is valid
  394. *            .F. = PCX-file is invalid
  395. *--------------------------------------------------------------------------
  396. STATIC FUNCTION GetInfo ( cFName, cSpec, cComment )
  397.  
  398. LOCAL    nWidth            && Width  of the PCX-file (pixels)
  399. LOCAL    nHeight            && Height of the PCX-file (pixels)
  400. LOCAL    nColors            && Number of colours (16 or 256)
  401. LOCAL    nAdapter        && Required adapter for PCX-file
  402. LOCAL    lValid := .T.        && Return code (.T.=valid, .F.=invalid)
  403. LOCAL    nRetCode        && Return code of R_PCXInfo ()
  404.  
  405. ***
  406. * Get information of the current PCX-file.
  407. *    Note : the last 4 parameters must be passed BY REFERENCE (@) !
  408. ***
  409. nRetCode := R_PCXInfo ( cfname, @nWidth, @nHeight, @nColors, @nAdapter )
  410.  
  411. IF nRetCode != PL_OKAY
  412.    *-- Error detected by R_PCXInfo()
  413.  
  414.    *-- Place the error message in cComment
  415.    cComment := aPCXError [nRetCode]
  416.    
  417.    RETURN .F.
  418.    
  419. ENDIF
  420.  
  421. cComment := cSpec := ""
  422.  
  423. *-- Place the dimension and colours in the specification string (cSpec)
  424. cSpec    := STR(nWidth,5) + ' ' + STR(nHeight,6) + ' ' + STR(nColors,3)
  425.  
  426. *--------------------------------------------------------------------------
  427. * Determine which VIDEO MODE will be used for the current PCX_file
  428. *--------------------------------------------------------------------------
  429. IF nWidth > 640 .OR. nHeight > 480
  430.  
  431.    *-- Maximal dimension is 640 x 480 !
  432.    cComment := '(Picture too large !)'
  433.  
  434.    RETURN .F.
  435.    
  436. ENDIF
  437.  
  438. IF nColors = 16
  439.  
  440.    *-- 16 colours !
  441.    IF nAdapter = PL_EGA
  442.  
  443.       *-- EGA adapter required
  444.       cComment := 'EGA 16    640 x 350 x  16'
  445.  
  446.       *-- EGA adapter present ?
  447.       lValid   := R_IsEGA ()
  448.  
  449.    ELSE
  450.  
  451.       *-- Standard VGA adapter required
  452.       cComment := 'VGA 18    640 x 480 x  16'
  453.  
  454.       *-- Standard VGA adapter present ?
  455.       lValid   := R_IsVGA ()
  456.  
  457.    ENDIF
  458.  
  459. ELSE
  460.    *-- 256 colours !
  461.    IF nAdapter = PL_VGA
  462.  
  463.       *-- Standard VGA adapter required
  464.       cComment := 'VGA 19    320 x 200 x 256'
  465.  
  466.       *-- Standard VGA adapter present ?
  467.       lValid   := R_IsVGA ()
  468.  
  469.    ELSE
  470.  
  471.       *-- SuperVGA adapter required
  472.       cComment := 'SuperVGA  640 x 480 x 256'
  473.  
  474.       *-- Supported SuperVGA adapter present ?
  475.       lValid   := R_IsSVGA ()
  476.  
  477.    ENDIF
  478.  
  479. ENDIF
  480.  
  481. RETURN lValid
  482.  
  483.  
  484. *--------------------------------------------------------------------------
  485. *
  486. *                              AchUser ( nMode )
  487. *
  488. *--------------------------------------------------------------------------
  489. * User-defined function for the Clipper AChoice () function
  490. *
  491. * INPUT
  492. * nMode : Mode of AChoice ()
  493. *
  494. * OUTPUT
  495. * Return code for AChoice ()
  496. *--------------------------------------------------------------------------
  497. FUNCTION AchUser ( nMode )
  498.  
  499. LOCAL    nKey := LASTKEY ()        && Last key pressed
  500.  
  501. LOCAL    nRed                && Red   component
  502. LOCAL    nGreen                && Green component
  503. LOCAL    nBlue                && Blue  component
  504.  
  505. LOCAL    lSetPal := .F.            && Flag that indicates whether
  506.                     && the palette is changed
  507.  
  508. IF nMode != AC_EXCEPT
  509.    *-- No keystroke exception
  510.    
  511.    RETURN AC_CONT
  512.    
  513. ENDIF
  514.  
  515. *-- KEYSTROKE EXCEPTION
  516.  
  517. IF nKey = K_F1 .OR. nKey = K_F2 .OR. ;
  518.    nKey = K_F3 .OR. nKey = K_F4 .OR. ;
  519.    nKey = K_F5 .OR. nKey = K_F6
  520.  
  521.    *-- Key pressed for changing the background colour
  522.  
  523.    *-- Get the current composition of PL_GREEN
  524.    R_GetRGB ( PL_GREEN, @nRed, @nGreen, @nBlue )
  525.    
  526. ENDIF
  527.  
  528. DO CASE
  529.    
  530. CASE nKey = K_F1
  531.    *-- Increase the RED component
  532.    IF nRed < 63
  533.       *-- Can be increased
  534.       nRed ++
  535.       lSetPal := .T.
  536.    ENDIF
  537.    
  538. CASE nKey = K_F2
  539.    *-- Decrease the RED component
  540.    IF nRed > 0
  541.       *-- Can be decreased
  542.       nRed --
  543.       lSetPal := .T.
  544.    ENDIF
  545.    
  546. CASE nKey = K_F3
  547.    *-- Increase the GREEN component
  548.    IF nGreen < 63
  549.       *-- Can be increased
  550.       nGreen ++
  551.       lSetPal := .T.
  552.    ENDIF
  553.    
  554. CASE nKey = K_F4
  555.    *-- Decrease the GREEN component
  556.    IF nGreen > 0
  557.       *-- Can be decreased
  558.       nGreen --
  559.       lSetPal := .T.
  560.    ENDIF
  561.    
  562. CASE nKey = K_F5
  563.    *-- Increase the BLUE component
  564.    IF nBlue < 63
  565.       *-- Can be increased
  566.       nBlue ++
  567.       lSetPal := .T.
  568.    ENDIF
  569.    
  570. CASE nKey = K_F6
  571.    *-- Decrease the BLUE component
  572.    IF nBlue > 0
  573.       *-- Can be decreased
  574.       nBlue --
  575.       lSetPal := .T.
  576.    ENDIF
  577.  
  578. CASE nKey = K_F10
  579.    *-- Request for a SLIDESHOW : abort AChoice ()
  580.    RETURN AC_SELECT
  581.    
  582. CASE nKey = K_HOME
  583.    *-- To first record
  584.    KEYBOARD (CHR(K_CTRL_PGUP))
  585.    
  586. CASE nKey = K_END
  587.    *-- To last record
  588.    KEYBOARD (CHR(K_CTRL_PGDN))
  589.    
  590. CASE nKey = K_RETURN
  591.    *-- PCX-file chosen
  592.    RETURN AC_SELECT
  593.    
  594. CASE nKey = K_ESC
  595.    *-- Aborted
  596.    RETURN AC_ABORT
  597.    
  598. CASE nKey > 31 .AND. nKey < 126
  599.    *-- Letter or digit
  600.    RETURN AC_GOTO
  601.    
  602. CASE nKey = K_LEFT .OR. nKey = K_RIGHT
  603.    *-- Ignore Left and Right arrow keys
  604.    RETURN AC_CONT
  605.    
  606. ENDCASE
  607.  
  608. IF lSetPal
  609.    *-- Background colour changed : adjust the palette
  610.  
  611.    *-- Substitute the new value of PL_GREEN into the palette
  612.    R_SetRGB ( PL_GREEN, nRed, nGreen, nBlue )
  613.  
  614.    *-- Display the new composition of the background colour (PL_GREEN)
  615.    DEVPOS ( 20,54 ); DEVOUT ( STR ( nRed,  2 ) )
  616.    DEVPOS ( 20,65 ); DEVOUT ( STR ( nGreen, 2 ) )
  617.    DEVPOS ( 20,76 ); DEVOUT ( STR ( nBlue, 2 ) )
  618.    
  619. ENDIF
  620.  
  621. RETURN AC_CONT
  622. *
  623. * EOF RPCXDemo.PRG ========================================================