home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / VPI1_330.ZIP / MENUSAVE.PRG < prev    next >
Encoding:
Text File  |  1992-01-05  |  3.3 KB  |  116 lines
  1. ***************************************************************************
  2. **  MENUSAVE.PRG
  3. **  (C) Copyright 1991-1992, Sub Rosa Publishing Inc.
  4. **
  5. **  A demonstration program provided to Info users.
  6. **  This program may be copied freely. If it is used in commercial code,
  7. **  please credit the source, Sub Rosa Publishing Inc.
  8. **
  9. **  MENUSAVE posts a menu on the screen, but takes a default action
  10. **  if the user makes no choice after four seconds. The default acttion
  11. **  presents a message in random colors at random postions on the screen -
  12. **  which would prevent burn-in of the memu if it had been left on the
  13. **  for a long time.
  14. **
  15. **  The other choices include a variety of sounds and effects
  16. **  available to the info programmer.
  17. **
  18. **  Note that menu selection can be made by selection of a trigger
  19. **  letter e.g. X for exit, T for Tear, etc.
  20. **
  21. **  Sid Bursten and Bernie Melman
  22. ***************************************************************************
  23. mcolor=:color
  24. ok=rand(val(time(3))) ; choose a starting random number based on the time
  25. SET sound on
  26. ON escape
  27.    SCREEN 1
  28.    SET color to mcolor
  29.    WINDOW
  30.    CURSOR 23,0
  31.    SET sound off
  32.    CANCEL
  33. ENDON
  34. IF :color <> 7
  35.    SET color to 31; white on blue
  36. ENDIF
  37. SET WIDTH to 80
  38. COLOR :color,0,0,24,79,177    ;fill screen with pattern
  39. * 177 is the fill character ▒.
  40. COLOR 112,7,20,21,66          ;draw black box to become shadow
  41. WINDOW 6,18,19,62 DOUBLE COLOR :color   ;declare space for menu text
  42. DO WHILE t                    ;put main menu in an infinite loop
  43.    :color=mcolor
  44.    WINDOW
  45.    ERASE                      ;fills window with blanks
  46.    COLOR :color,0,0,24,79,177    ;fill screen with pattern
  47. * 177 is the fill character ▒.
  48.    COLOR 112,7,20,21,66          ;draw black box to become shadow
  49.    WINDOW 6,18,19,62 DOUBLE COLOR :color   ;declare space for menu text
  50.    TEXT
  51.  
  52.              DEMO MAIN MENU
  53.     Choose by number or one of "XRTSMC"
  54.     0. eXit to Sample Programs Menu
  55.  
  56.     1. sound Tear
  57.     2. sound Ring
  58.     3. screen Swap
  59.     4. return to Main demonstration menu
  60.     5. exit to Conversation VP-Info
  61.    ENDTEXT
  62.    CURSOR 12,25 ; positions menu cursor over 1st character of 1st choice
  63. *
  64. *  five choices,menu bar width 37,timeout after 4 seconds
  65.    CHOICE=menu("XTRSMC",37,4)
  66.    DO CASE
  67.    CASE choice=0
  68.       SET sound off
  69.       CHAIN samples
  70.    CASE choice=1
  71.       SOUND 5
  72.    CASE choice=2
  73.       SOUND 7
  74.    CASE choice=3
  75.       SCREEN 1,2
  76.       CLS
  77.       SCREEN t
  78.    CASE choice=5
  79.       SET sound off
  80.       WINDOW
  81.       ERASE
  82.       CANCEL
  83.    CASE choice=65 ; timeout
  84.       WINDOW
  85.       ERASE
  86.       PERFORM scrnsave
  87.    ENDCASE
  88. ENDDO
  89. PROCEDURE scrnsave
  90.    DO WHILE t
  91.       IF ifkey()
  92.          dummy=inkey()
  93.          BREAK
  94.       ENDIF
  95. *      SOUND 3
  96.       row=(rand()*22)+1 ; range is 1-22
  97.       col=(rand()*65)+1 ; range is 1-65
  98.       IF :color<>7
  99.          flag=t
  100.          DO WHILE flag
  101.             :color=rand()*127+1   ;yields a color between 1 and 128
  102.             IF :color<>7
  103.                flag=f
  104.             ENDIF
  105.          ENDDO
  106.       ENDIF
  107.       WINDOW row,col,row+1,col+13
  108.       @ row,col say cen('VP-Info',14)
  109.       @ row+1,col say cen('Screen Saver',14)
  110.       SCREEN 1
  111. *      SOUND 8
  112.       DELAY .3        ;wait long enough to see something
  113.    ENDDO
  114. ENDPROCEDURE ; scrnsave
  115. *** end of MENUSAVE.PRG
  116.