home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 7 / 07.iso / c / c011 / 4.ddi / EXAMPLES / FOR / FXTEST.FOR < prev   
Encoding:
Text File  |  1989-06-01  |  4.6 KB  |  146 lines
  1. * fxTest.FOR                                                                *
  2. * Copyright (c) Genus Microprogramming, Inc. 1988-89  All Rights Reserved.  *
  3.  
  4. *****************************************************************************
  5. *                                                                           *
  6. * This program demonstrates the usage of an effect. It is an example        *
  7. * Fortran routine for the PCX Effects Toolkit.                              *
  8. *                                                                           *
  9. * To Compile: MS Fortran  4.1    FL   /c fxtest.for                         *
  10. *                                Link fxtest,,,pcx_cl fx_cl;                *
  11. *                                                                           *
  12. * Microsoft Fortran 4.1                   Programmer: Chris Howard  5/10/89 *
  13. *                                                                           *
  14. *****************************************************************************
  15.  
  16. * Include the PCX Toolkit and PCX Effects interfaces
  17. $INCLUDE: 'pcxint.for'
  18. $INCLUDE: 'fxint.for'
  19.  
  20. PROGRAM fxTest
  21.  
  22. * Include the PCX Toolkit and PCX Effects constants
  23. $INCLUDE: 'pcxlib.for'
  24. $INCLUDE: 'fxlib.for'
  25.  
  26. * Globals
  27.       CHARACTER*1   key
  28.  
  29.       CHARACTER*20  pcximage [C]
  30.       INTEGER*2     pcxtype,retcode,bufmax
  31.  
  32.       PARAMETER     (bufmax = 20000)
  33.       CHARACTER     buffer(bufmax)
  34.  
  35.       INTEGER*4     vfree,vreq,vptr
  36.       INTEGER*2     width,depth,wx2,wy2
  37.  
  38.       DATA pcxtype  /pcxCGA_6/
  39.       DATA pcximage /'fxTest.PCX' C/
  40.       DATA retcode  /-999/
  41.  
  42. ***********
  43.  
  44. * Display program header
  45.       PRINT '(A)',' '
  46.       PRINT '(A)',' ╒═══════════════════════════════════════════════════
  47.      +═══════════════════════╕'
  48.       PRINT '(A)',' │ fxTest: Example Fortran Effects Program            
  49.      +      PCX Effects 1.0x │'
  50.       PRINT '(A)',' │ Copyright (c) Genus Microprogramming, Inc. 1988-89
  51.      +  All Rights Reserved. │'
  52.       PRINT '(A)',' ╘═══════════════════════════════════════════════════
  53.      +═══════════════════════╛'
  54.       PRINT '(A)',' '
  55.  
  56. *     Get a key, to begin
  57.       PRINT '(A)',' Press [ENTER] to run . . .'
  58.       READ(*,'(A1)') key
  59.  
  60. *     Allocate a larger toolkit buffer, to speed up file and display speed. 
  61.       retcode = pcxSetBuffer(buffer,bufmax)
  62.  
  63. *     Check if we have expanded memory, and display
  64.       IF (pcxEMInstalled .EQ. pcxSUCCESS) THEN
  65.         vfree = pcxVirtualFree(pcxEMM)
  66.         PRINT '(A,I8)',' Free EMM: ',vfree
  67.       ENDIF
  68.  
  69. *     Display the amount of conventional free memory
  70.       vfree = pcxVirtualFree(pcxCMM)
  71.       PRINT '(A,I8)',' Free CMM: ',vfree
  72.  
  73. *     Look at the current hardware, to find a B/W mode
  74.       retcode = pcxVideoInfo(adapter1)
  75.  
  76.       IF (adapter1 .EQ. viCGA) THEN
  77.         pcxtype = pcxCGA_6
  78.       ELSEIF (adapter1 .EQ. viEGA) THEN
  79.         IF (display1 .EQ. viMDAdisp) THEN
  80.           pcxtype = pcxEGA_F
  81.         ELSE
  82.           pcxtype = pcxEGA_10
  83.         ENDIF
  84.       ELSEIF (adapter1 .EQ. viVGA) THEN
  85.         pcxtype = pcxVGA_11
  86.       ELSEIF (adapter1 .EQ. viHGC) THEN
  87.         pcxtype = pcxHERC
  88.       ELSE
  89.         pcxtype = -1
  90.       ENDIF
  91.       
  92. *     If we found a mode, continue
  93.       IF (pcxtype .NE. -1) THEN
  94.  
  95. *       Set the display type
  96.         retcode = pcxSetDisplay(pcxtype)
  97.  
  98. *       Load the image
  99.         retcode = fxFileImage(pcxCMM,vptr,pcximage)
  100.         IF (retcode .EQ. fxSUCCESS) THEN
  101.  
  102. *         Change to graphics mode
  103.           retcode = pcxSetMode(pcxGRAPHICS)
  104.  
  105. *         Calibrate the delay timer, and play a looping song 
  106.           retcode = fxCalibrateDelay
  107.           retcode = fxPlayLoop(25)
  108.           retcode = fxPlay('T120 MB O3 L32 C D E F G A B A G F E D 'C)
  109.  
  110. *         Select our effect
  111.           retcode = fxSetEffect(fxRANDOM)
  112.           retcode = fxSetGrain(8)
  113.  
  114. *         and do it
  115.           retcode = fxVirtualEffect(vptr,0,0,fxNONE)
  116.  
  117. *         Kill the play
  118.           retcode = fxPlayKill
  119.  
  120. *         Wait for a key
  121.           READ(*,'(A1)') key
  122.  
  123. *         Get back to text mode
  124.           retcode = pcxSetMode(pcxTEXT)
  125.  
  126. *         Were we successful?
  127.           IF (retcode .NE. pcxSUCCESS) THEN
  128.             PRINT '(A,I5)',' pcxVirtualScroll Error: ',retcode
  129.           ENDIF
  130.  
  131.         ELSE
  132. *         Error loading file to virtual buffer
  133.           PRINT '(A,I5)',' Could not load image: ',retcode
  134.         ENDIF
  135.  
  136. *       Destroy the image
  137.         retcode = fxFreeImage(vptr)
  138.  
  139.       ELSE
  140. *       We could not find a good mode
  141.         PRINT '(A,I5)',' Could not find a good mode type . . .',retcode
  142.       ENDIF
  143.  
  144.       END 
  145.  
  146.