home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / DEMO3TRA.BAS < prev    next >
BASIC Source File  |  1989-07-29  |  7KB  |  199 lines
  1. '***********************************************************
  2. '* 
  3. '* Program Name: Demo3.BAS
  4. '*
  5. '* Description : This is the transition version of Demo3.BAS
  6. '*               It uses essentially the same I/O and flow
  7. '*               as the original Demo3.BAS. All standard I/O
  8. '*               has been replaced with the routines from
  9. '*               WinStdIO.BAS (WinCLS, WinPrint, WinInput,
  10. '*               WinLocate, WinPos).
  11. '*
  12. '* Changes:      SKELETON main program added
  13. '*               I/O control moved to ClientWndProc (WMPAINT)
  14. '*               Sound loops changed to WMTIMER
  15. '*               SOUND statements changed to DosBeep
  16. '***********************************************************
  17.  
  18. '*********         Initialization section        ***********
  19.  
  20. REM $INCLUDE: 'PMBase.BI'
  21. REM $INCLUDE: 'WinMisc.BI'
  22. REM $INCLUDE: 'WinInput.BI'      Needed for WMCHAR
  23. REM $INCLUDE: 'BSEDosPC.BI'      Needed for DosBeep
  24. REM $INCLUDE: 'WinStdIO.BI'      Needed for Standard Input & Output
  25. CONST MsPerTick = 1000 / 18     'Needed to convert SOUND units to DosBeep
  26. COMMON SHARED /HANDLE/ hab&     'Needed for WinStart/StopTimer
  27.  
  28. DIM aqmsg AS QMSG
  29.  
  30. flFrameFlags& = FCFTITLEBAR      OR FCFSYSMENU OR _
  31.                 FCFSIZEBORDER    OR FCFMINMAX  OR _
  32.                 FCFSHELLPOSITION OR FCFTASKLIST
  33.  
  34. szClientClass$ = "ClassName" + CHR$(0)
  35.  
  36. hab& = WinInitialize(0)
  37. hmq& = WinCreateMsgQueue(hab&, 0)
  38.  
  39. bool% = WinRegisterClass(_
  40.           hab&,_
  41.           MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  42.           RegBas,_
  43.           0,_
  44.           0)
  45.  
  46. hwndFrame& = WinCreateStdWindow (_
  47.           HWNDDESKTOP,_
  48.           WSVISIBLE,_
  49.           MakeLong (VARSEG(flFrameFlags&), VARPTR(flFrameFlags&)),_
  50.           MakeLong (VARSEG(szClientClass$), SADD(szClientClass$)),_
  51.           0,_
  52.           0,_
  53.           0,_
  54.           0,_
  55.           MakeLong (VARSEG(hwndClient&), VARPTR(hwndClient&)))
  56.  
  57.  
  58. '**************         Message loop         ***************
  59.  
  60. WHILE WinGetMsg(hab&,_
  61.        MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  62.   bool% = WinDispatchMsg(hab&,_
  63.               MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  64. WEND
  65.      
  66. '***********         Finalize section        ***************
  67.  
  68. bool% = WinDestroyWindow(hwndFrame&)
  69. bool% = WinDestroyMsgQueue(hmq&)
  70. bool% = WinTerminate(hab&)
  71.  
  72. END
  73.  
  74. '***********         Window procedure        ***************
  75.  
  76. '****
  77. '** ClientWndProc handles most control from WMPAINT and WMTIMER
  78. '** messages. WMPAINT is used for I/O because KeyMsg causes
  79. '** a WMPAINT for WinInkey$. WMTIMER is used for sound loops
  80. '** so other messages can get through for terminating sound.
  81. '**
  82. '** Key pressed controls flow in WMPAINT
  83. '** CurrSound static variable (set in WMPAINT) control which sound in WMTIMER
  84.  
  85. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  86.      DIM ClientRect AS RECTL
  87.  
  88.      ClientWndProc&=0
  89.      SELECT CASE msg%
  90.     CASE WMPAINT     'Paint the window with background color
  91.           hps&  = WinBeginPaint(hwnd&, 0,_
  92.                      MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  93.               Q$ = UCASE$(WinInkey$)          'Check current key
  94.               SELECT CASE Q$                  'NOTE: Loop is message loop
  95.  
  96.                         CASE "B"              'Bouncing
  97.                  CurrSound = 1
  98.                  CALL WinCLS ( hwnd&, hps& )
  99.                  CALL WinPrint ( hps&, "Bouncing .  .  ." )
  100.                  CALL WinPrint ( hps&, ".  .  . Press any key to end.")
  101.                              Bool% = WinStartTimer (hab&, hwnd&, 1, 10)
  102.  
  103.                         CASE "F"              'Falling
  104.                  CurrSound =  2
  105.                  CALL WinCLS ( hwnd&, hps& )
  106.                  CALL WinPrint ( hps&, "Falling .  .  ." )
  107.                  CALL WinPrint ( hps&, ".  .  . Press any key to end.")
  108.                  Bool% = WinStartTimer (hab&,hwnd&,1,10)
  109.  
  110.                         CASE "S"              'Siren
  111.                  CurrSound = 3
  112.                  CALL WinCLS ( hwnd&, hps& )
  113.                  CALL WinPrint ( hps&, "Wailing .  .  ." )
  114.                  CALL WinPrint ( hps&, ".  .  . Press any key to end.")
  115.                  Bool% = WinStartTimer (hab&,hwnd&,1,10)
  116.  
  117.                         CASE "K"              'Klaxon
  118.                  CurrSound = 4
  119.                  CALL WinCLS ( hwnd&, hps& )
  120.                  CALL WinPrint ( hps&, "Oscillating .  .  ." )
  121.                  CALL WinPrint ( hps&, ".  .  . Press any key to end.")
  122.                  Bool% = WinStartTimer (hab&,hwnd&,1,10)
  123.  
  124.                         CASE "Q"              'Quit
  125.                  Quit& = WinSendMsg(HWND&,WMClose,0,0)
  126.  
  127.                         'If a non-active key, stop timer (and thus stop sound)
  128.                         CASE ELSE           ' and display menu
  129.                              Bool% =  WinStopTimer (hab&,hwnd&,1)
  130.                              CALL Menu(hwnd&, hps&)
  131.           END SELECT
  132.  
  133.           bool% = WinEndPaint(hps&)
  134.         CASE WMCHAR
  135.               CALL KeyMsg (hwnd&,mp1&,mp2&)    'Buffer keys for WinInkey$
  136.     CASE WMTIMER
  137.           SELECT CASE CurrSound                'Which sound?
  138.           CASE 1
  139.             CALL Bounce (32767, 246)
  140.           CASE 2
  141.             CALL Fall (2000, 550, 500)
  142.           CASE 3
  143.             CALL Siren (780, 650)
  144.           CASE 4
  145.             CALL Klaxon (987, 329)
  146.           CASE ELSE
  147.       END SELECT
  148.     CASE ELSE
  149.           ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  150.      END SELECT
  151. END FUNCTION
  152.  
  153.  
  154. '**** Menu uses the WinStdIO routines to display menu.
  155.  
  156. SUB Menu (hwnd&, hps&) STATIC
  157.           CALL WinCLS ( hwnd&, hps& )
  158.           CALL WinPrint ( hps&, "Sound Effects" )
  159.               CALL WinPrint ( hps&, "             " )
  160.               CALL WinPrint ( hps&, "Bouncing" )
  161.               CALL WinPrint ( hps&, "Falling" )
  162.               CALL WinPrint ( hps&, "Klaxon" )
  163.               CALL WinPrint ( hps&, "Siren" )
  164.               CALL WinPrint ( hps&, "Quit" )
  165.           CALL WinPrint ( hps&, "             " )
  166.           CALL WinPrint ( hps&, "Select:" )
  167. END SUB
  168.  
  169. '**** Original Demo3.BAS source with SOUND statements replaced with DosBeep
  170.  
  171. ' Loop two sounds down at decreasing time intervals
  172. SUB Bounce (Hi%, Low%) STATIC
  173.    FOR Count% = 60 TO 1 STEP -2
  174.       X% = DosBeep ( Low% - Count% / 2,  MsPerTick * Count% / 20 )
  175.       X% = DosBeep ( Hi%, MsPerTick * Count% / 15 )
  176.    NEXT Count%
  177. END SUB
  178.  
  179. ' Loop down from a high sound to a low sound
  180. SUB Fall (Hi%, Low%, Del%) STATIC
  181.    FOR Count% = Hi% TO Low% STEP -10
  182.       X% = DosBeep( Count%, MsPerTick * Del% / Count% )
  183.    NEXT Count%
  184. END SUB
  185.  
  186. ' Alternate two sounds until a key is pressed
  187. SUB Klaxon (Hi%, Low%) STATIC
  188.       X% = DosBeep ( Hi%, MsPerTick * 5 )
  189.       X% = DosBeep ( Low%, MsPerTick * 5 )
  190. END SUB
  191.  
  192. ' Loop a sound from low to high to low
  193. SUB Siren (Hi%, Range%) STATIC
  194.          FOR Count% = Range% TO -Range% STEP -4
  195.             X% = DosBeep ( Hi% - ABS(Count%), MsPerTick * .3 )
  196.             Count% = Count% - 2 / Range%
  197.          NEXT Count%
  198. END SUB
  199.