home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a076 / 3.img / DCLIPDEV / DGE.ZIP / CLIPMENU.PRG next >
Encoding:
Text File  |  1989-06-17  |  6.4 KB  |  255 lines

  1. **
  2. **        CLIPMENU.PRG     Modified to run under DCLIPDGE.EXE
  3. **
  4. **        Main program for dGE Ver 2 demonstration
  5. **
  6. **        PROGMODE = 'R'  .. rolling demo with timed pauses
  7. **                 = 'M'  .. menu driven
  8. **
  9. **        Define directory and operational mode
  10.  
  11. set talk off
  12. set echo off
  13. set status off
  14. set bell off
  15. set scoreboard off
  16. set console off
  17.  
  18. PROGMODE = 'M'          && program mode
  19.  
  20. clear
  21.  
  22. videoid=0
  23. @ 3,17 SAY 'Enter Video Driver ID:'
  24. @ 5,17 SAY '3 = HERCULES mono'
  25. @ 6,17 SAY '4 = CGA mono'
  26. @ 7,17 SAY '5 = CGA color'
  27. @ 8,17 SAY '6 = EGA color'
  28. @ 9,17 SAY '7 = VGA color'
  29. @11,17 SAY 'Enter Selection ' GET videoid PICT '9' RANGE 3,7
  30. READ
  31. SETVIDEO(videoid)
  32.  
  33. clear
  34. set colo to 2+/0
  35. @  3,17 say 'Demonstration programs featuring dGE graphics'
  36. @  5,10 say 'The all-purpose graphics library for database applicatons.'
  37. set colo to 7/0
  38. if PROGMODE = 'M'
  39.   @  8,18 say 'You will be presented with a menu of examples.'
  40.   @ 10,15 say 'After each page is drawn hit any key to continue.'
  41.   @ 14,19 say 'Some examples feature continuous displays.'
  42.   @ 15,19 say 'These may be interrupted by a key-stroke'
  43. else
  44.   @ 10,28 say 'This is a rolling demo'
  45.   @ 12,8 say 'You may interrupt it by hitting any key after a screen is drawn'
  46. endif
  47. set colo to 2/0
  48. @ 20,19 say '(c) 1984,88 Bits Per Second Ltd, Brighton'
  49. set color to 7/0
  50.  
  51. if file('DGEDEFS.PRG')
  52.   DIRTYPE = 'S'
  53. else
  54.   DIRTYPE = 'M'
  55. endif
  56.  
  57. if DIRTYPE = 'M'
  58.   DATADIR = '..\'
  59.   CSDIR = '..\..\CSETS\'
  60. else
  61.   DATADIR = '.\'
  62.   CSDIR = '.\'
  63. endif
  64.                                 * Set pauses according to demo type
  65. if PROGMODE = 'R'
  66.   PAUSE1 = 0.25
  67.   PAUSE5 = 2
  68. else
  69.   PAUSE1 = 0
  70.   PAUSE5 = 0
  71. endif
  72. PAUSEBANN = 5
  73. @ 23,18 say 'Loading and initialising data .. please wait'
  74.  
  75.                                 * Check for our demo data files
  76. if .not.file(DATADIR+'demodata.dbf').or..not.file(DATADIR+'dgepl.dbf')
  77.   ? chr(7)+'Demonstration data files not found .. quitting'
  78.   quit
  79. endif
  80.                                 * Get the screen-driver identifier
  81. DRIVERID = getchar(2)
  82.                                 * Intialise dGE variables and get DRIVERID
  83. if DIRTYPE = 'M'
  84.   do ..\DGEDEFS
  85. else
  86.   do DGEDEFS
  87. endif
  88.                                 * Ensure dGE Version 2 on entry
  89. r = setver(2)
  90.                                 * Check for driver loaded
  91. if .not.(DRIVERID $ '34567')
  92.   ? 'SETDGE.COM has not been run .. aborting'
  93.   quit
  94. endif
  95.                                 * Warning if CGA colour
  96. if DRIVERID = '5'
  97.   set console on
  98.   clear
  99.   @ 6,13 say 'WARNING !!! You have installed the CGA colour driver.'
  100.   @ 10,11 say 'Owing to the reduced resolution of the CGA colour screen'
  101.   @ 12,11 say 'text characters are extra wide.'
  102.   @ 14,11 say 'This demonstration was not written for this mode and will'
  103.   @ 16,11 say 'produce poorly-presented text.'
  104.   @ 19,18 say 'Hit Q to quit or any other key to continue'
  105.   r = inkey(0)
  106.   if chr(r) $ 'qQ'
  107.     quit
  108.   endif
  109.   set console off
  110. endif
  111.                                 * Path for ch sets
  112. if DIRTYPE = 'M'
  113.   if DRIVERID $ '367'
  114.     CSDIR = CSDIR+'EGAHRC\'
  115.   else
  116.     CSDIR = CSDIR+'CGA\'
  117.   endif
  118. endif
  119.                                 * Load character sets
  120. r = loadcset(0, CSDIR+'STANDARD')
  121. r = loadcset(1, CSDIR+'THIN')
  122.                                 * Display dGE banner page
  123. do DGEBANN
  124.  
  125. chselect = 'A'
  126. noptions = 1
  127. if PROGMODE = 'R'
  128.   r = sethires(0)
  129. endif
  130. do while chselect <> 'Q'
  131.   r = setver(2)
  132.   r = loadcset(1, CSDIR+'THIN')
  133.   if PROGMODE = 'M'
  134.     set console on
  135.     clear
  136.  
  137.     @  2,27 say 'dGE demonstration menu'
  138.     if DRIVERID $ '567'
  139.       @ 5,25 say 'A  Pie charts and colour palette display'
  140.     else
  141.       @ 5,25 say 'A  Pie charts'
  142.     endif
  143.     @  6,25 say 'B  Statistics functions'
  144.     @  7,25 say 'C  Technical drawing'
  145.     @  8,25 say 'D  Various graphs and charts'
  146.     @  9,25 say 'E  X-Y graph styles'
  147.     @ 10,25 say 'F  Time-series graphs'
  148.     @ 11,25 say 'G  Polylines and vectors'
  149.     @ 12,25 say 'H  Polar graphs'
  150.     @ 13,25 say 'I  Axes and labels'
  151.     @ 14,25 say 'J  Shade and symbol library'
  152.     @ 15,25 say 'K  Fonts'
  153.     @ 16,25 say 'L  Simple X-Y Example'
  154.     @ 17,25 say 'M  Bar graph styles'
  155.     @ 18,25 say 'N  Interactive session'
  156.     @ 19,25 say 'O  Printing and plotting'
  157.     @ 20,25 say 'Q  Quit'
  158.  
  159.     @ 23,33 say 'Enter Option'
  160.     chselect = ' '
  161.     do while .not.(chselect $ 'ABCDEFGHIJKLMNOQ')
  162.       chselect = upper(chr(inkey()))
  163.     enddo
  164.                                 * Quit
  165.     if chselect = 'Q'
  166.       loop
  167.     endif
  168.     set console off
  169.     r = sethires(0)
  170.   endif
  171.  
  172.                                 * Do selected demo program
  173.   r = clrscreen()
  174.   r = boxfill(0,0,1500,1000,BXNOFILL,GREY)
  175.   r = boxfill(0,0,120,80,BXNOFILL,GREY)
  176.   r = saystring(20,14,0,0,GREEN,"dGE")
  177.  
  178.   OBJRELEASE('ALL')
  179.   do case
  180.   case chselect = 'A'
  181.     OBJLINK('DGE','PIES')
  182.     do PIES
  183.   case chselect = 'B'
  184.     OBJLINK('DGE','STAT')
  185.     do STAT
  186.   case chselect = 'C'
  187.     OBJLINK('DGE','TECH')
  188.     do TECH
  189.   case chselect = 'D'
  190.     OBJLINK('DGE','PICTURE')
  191.     do PICTURE
  192.   case chselect = 'E'
  193.     OBJLINK('DGE','XYS')
  194.     do XYS
  195.   case chselect = 'F'
  196.     OBJLINK('DGE','TIMEHIST')
  197.     do TIMEHIST
  198.   case chselect = 'G'
  199.     OBJLINK('DGE','POLYS')
  200.     OBJLINK('DGE','SAILPLAN')
  201.     do POLYS
  202.     do SAILPLAN
  203.   case chselect = 'H'
  204.     OBJLINK('DGE','POLARS')
  205.     do POLARS
  206.   case chselect = 'I'
  207.     OBJLINK('DGE','AXES')
  208.     do AXES
  209.   case chselect = 'J'
  210.     OBJLINK('DGE','ICONSHDE')
  211.     do ICONSHDE
  212.   case chselect = 'K'
  213.     OBJLINK('DGE','FONTS')
  214.     do FONTS
  215.   case chselect = 'L'
  216.     OBJLINK('DGE','SIMPLEXY')
  217.     do SIMPLEXY
  218.     r = inkey(PAUSE5)
  219.     OBJLINK('DGE','SXYTEXT')
  220.     do SXYTEXT
  221.     do SIMPLEXY
  222.   case chselect = 'M'
  223.     OBJLINK('DGE','BARS')
  224.     do BARS
  225.   case chselect = 'N'
  226.     OBJLINK('DGE','INTERACT')
  227.     do INTERACT
  228.   case chselect = 'O'
  229.     OBJLINK('DGE','HARDCOPY')
  230.     do HARDCOPY
  231.   endcase
  232.                                         * wait for key pressed
  233.   lpr = 0
  234.   if .not.(chselect $ 'FO')
  235.     lpr = inkey(PAUSE5)
  236.   endif
  237.  
  238.   if PROGMODE = 'M'
  239.     r = settext()
  240.   else
  241.     if lpr <> 0
  242.       r = settext()
  243.       chselect = 'Q'
  244.     else
  245.       chselect = chr( asc(chselect) + 1)
  246.       if chselect = 'N'
  247.         chselect = 'A'
  248.       endif
  249.     endif
  250.   endif
  251. enddo
  252.  
  253. clear
  254. RETURN
  255.