home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a076 / 3.img / DCLIPDEV / GRUMP.ZIP / DEMO.PRG < prev    next >
Encoding:
Text File  |  1989-06-18  |  13.1 KB  |  418 lines
  1. *┌──────────────────────────────────────┐                                                                        │
  2. *│   DEMO.prg                           │
  3. *│   Grumpfish Library demo             │
  4. *│   June 1989 - Greg Lief              │
  5. *└──────────────────────────────────────┘
  6.  
  7. *
  8. *  Modified by Roger Donnay to run under dCLIP
  9.  
  10. LIBLOAD('\GRUMP\GRUMP')
  11. LIBLOAD('\GRUMPFUN\GRUMPFUN')
  12.  
  13. EXTERNAL soundex
  14. PUBLIC start_time, thepalette
  15. SET CURSOR OFF
  16. SET WRAP ON
  17. SAVE SCREEN TO predemo
  18. selected = 'i'
  19. maincolor = IF(Iscolor(), 'w/b', 'w/n')
  20.  
  21. thepalette = ''
  22. FOR xx = 0 TO 127
  23.    thepalette = thepalette + ' ' + chr(xx) + chr(4) + chr(xx) + ' ' + chr(xx)
  24. NEXT
  25.  
  26. DO WHILE .T.
  27.    SETCOLOR('+W/N')
  28.    CLEAR
  29.    mstring = 'The Grumpfish Library'
  30.    colorstr = 'W BRR GRBGB G '
  31.    Fallguy(03,30,mstring)
  32.    X = 1
  33.    MROW = 3
  34.  
  35.    SETCOLOR('+BR/N')
  36.    CENTER(24, 'Press space bar for the demo or Esc for DOS')
  37.  
  38.    DO WHILE LASTKEY() <> 32 .AND. LASTKEY() <> 27
  39.       SHOWSTRING(IF(INT(X%7)=0, 7, INT(X%7)), MROW, MROW+2, .05)
  40.       X = X + 1
  41.       MROW = MROW + 3
  42.       IF MROW > 20
  43.          MROW = 3
  44.       ENDIF
  45.    ENDDO
  46.    IF LASTKEY() = 27
  47.       EXIT
  48.    ENDIF
  49.    DO lets_go
  50. ENDDO
  51. RESTORE SCREEN FROM predemo
  52. SET COLOR TO
  53. SET CURSOR ON
  54. RETURN
  55.  
  56. PROCEDURE lets_go
  57. IF FILE('demo.scr')
  58.    pull_drape('demo.scr')
  59. ELSE
  60.    SETCOLOR(maincolor)
  61.    coolscrn()
  62.    SETCOLOR('W/RB')
  63.    Shadowbox(5,29,19,49,1)
  64.    SETCOLOR('+W/RB')
  65. ENDIF
  66. DO WHILE .T.
  67.    SETCOLOR('+W/RB')
  68.    @ 06,30 PROMPT '    Calculator     '
  69.    @ 07,30 PROMPT '      Notepad      '
  70.    @ 08,30 PROMPT '  Phone Directory  '
  71.    @ 09,30 PROMPT '   Appointments    '
  72.    @ 10,30 PROMPT '     Stopwatch     '
  73.    @ 11,30 PROMPT '   Query Builder   '
  74.    @ 12,30 PROMPT '   Box Functions   '
  75.    @ 13,30 PROMPT '   String Tricks   '
  76.    @ 14,30 PROMPT '   Screen Tricks   '
  77.    @ 15,30 PROMPT '   User Feedback   '
  78.    @ 16,30 PROMPT '   Color Palette   '
  79.    @ 17,30 PROMPT '  Frivolous Things '
  80.    @ 18,30 PROMPT '       Exit        '
  81.    IF ! FILE('demo.scr')
  82.       SAVE_DRAPE('demo.scr')
  83.    ENDIF
  84.    save screen to mainmenu
  85.    menu to sel
  86.    DO CASE
  87.    CASE sel = 1
  88.       do popcalc
  89.    CASE sel = 2
  90.       do popnote
  91.    CASE sel = 3
  92.       setcolor(maincolor)
  93.       do popphone
  94.    CASE sel = 4
  95.       setcolor(maincolor)
  96.       do popdate
  97.    CASE sel = 5
  98.       do popstop
  99.    CASE sel = 6
  100.       IF ! FILE('phone.dbf') .OR. ! FILE('phone.ntx')
  101.          Err_msg("Select the 'phone directory' option before using this")
  102.       else
  103.          USE phone INDEX phone
  104.          setcolor(maincolor)
  105.          DO Setfilt
  106.          CLOSE data
  107.       endif
  108.    CASE sel=7
  109.       SETCOLOR(maincolor)
  110.       CLEAR
  111.       SETCOLOR('+w/rb')
  112.       Exbox(07, 01, 14, 60, 2, 5, '', .F., 'Exploding Box')
  113.       INKEY(.4)
  114.       SETCOLOR('+w/r')
  115.       Exbox(18, 10, 23, 50, 4, 6, '', .F., 'Exploding Box 2', .T.)
  116.       INKEY(.4)
  117.       SETCOLOR('+gr/n')
  118.       Exbox(00, 00, 4, 36, 2, 5, '', .F., 'Exploding Box 3')
  119.       INKEY(.4)
  120.       SETCOLOR('n/gr')
  121.       Exbox(12, 65, 22, 78, 3, 3, '', .F., 'Box #4', .T.)
  122.       INKEY(.4)
  123.       SETCOLOR('+w/g')
  124.       Exbox(01, 45, 04, 78, 1, 11, '', .F., 'Yet Another Exploding Box')
  125.       INKEY(2.5)
  126.       Shrbox(01, 45, 04, 78, 5, maincolor)
  127.       INKEY(.3)
  128.       Shrbox(12, 65, 22, 78, 5, maincolor)
  129.       INKEY(.3)
  130.       Shrbox(00, 00, 4, 36, 5, maincolor)
  131.       INKEY(.3)
  132.       Shrbox(18, 10, 23, 50, 5, maincolor)
  133.       INKEY(.3)
  134.       Shrbox(07, 01, 14, 60, 5, maincolor)
  135.       INKEY(1)
  136.       SETCOLOR('n/bg')
  137.       Popbox(00, 00, 22, 40, 2, 18, .F., 'Pop-up Box 1')
  138.       INKEY(.35)
  139.       SETCOLOR('+gr/n')
  140.       Dropbox(00, 55, 18, 79, 1, 25, .F., 'Pull-down Box 1', .T.)
  141.       INKEY(.35)
  142.       SETCOLOR('n/gr')
  143.       Popbox(03, 44, 20, 70, 5, 20, .F., 'Pop-up Box 2')
  144.       INKEY(.35)
  145.       SETCOLOR('n/w')
  146.       Dropbox(04, 38, 13, 60, 4, 25, .F., 'Pull-down Box 2')
  147.       INKEY(.35)
  148.       SETCOLOR('+w/r')
  149.       Popbox(12, 30, 23, 55, 2, 20, .F., 'Pop-up Box 3', .T.)
  150.       INKEY(.35)
  151.       SETCOLOR('+w/b')
  152.       Popbox(03, 05, 20, 29, 2, 18, .F., 'Another Pop-up')
  153.       INKEY(.35)
  154.       SETCOLOR('n/g')
  155.       Dropbox(06, 28, 20, 66, 1, 12, .T., 'Another Pull-down Box')
  156.       INKEY(.35)
  157.       SETCOLOR('n/r')
  158.       Popbox(02, 15, 17, 45, 1, 10, .T., 'Pop-up Box w/ Crossbar', .T.)
  159.       INKEY(.35)
  160.       SETCOLOR('+w/rb')
  161.       Shadowbox(09, 20, 14, 50, 2, 'Shadow Box', .T.)
  162.       INKEY(.35)
  163.       TTY2(24, 'Press any key to return to the main menu', 0, maincolor)
  164.  
  165.    CASE sel=8
  166.       SETCOLOR(maincolor)
  167.       CLEAR
  168.       SETCOLOR('+w/bg')
  169.       Exbox(9, 07, 15, 71, 1, 5, '', .T., 'Silly Strings')
  170.       SPREAD('It is a snap to display character strings from the middle out',10,25)
  171.       SPREAD('as we are demonstrating here. You may also wish to use either',11,25)
  172.       SPREAD('of the two teletype functions, which continuously scroll your',12,25)
  173.       SPREAD('message across a specified row.   Perhaps you already saw the',13,25)
  174.       SPREAD('falling string trick, but in case you missed it,             ',14,25)
  175.       INKEY(4)
  176.       FallGuy(14,58,'here it is!!')
  177.       SETCOLOR(maincolor)
  178.       INKEY(1)
  179.       TTY(20, 'Copyright (C) 1988-89 Greg Lief', 35, 24)
  180.       TTY2(24, 'Press any key to return to the main menu', 0, maincolor)
  181.  
  182.    CASE sel=9
  183.       SETCOLOR('W/RB')
  184.       coolscrn()
  185.       SAVE SCREEN TO tempscrn
  186.       SETCOLOR('+W/RB')
  187.       SPREAD('Clear the screen in seven novel ways with Grumpfish', 0)
  188.       INKEY(2)
  189.       SETCOLOR('W/N')
  190.       FOR xx = 1 TO 7
  191.          CLRSCR(xx)
  192.          INKEY(.2)
  193.          RESTORE SCREEN FROM tempscrn
  194.          INKEY(.2)
  195.       NEXT
  196.       SETCOLOR('+W/RB')
  197.       SPREAD('or use the spreading curtains to display your title screen like this...', 0)
  198.       INKEY(2)
  199.       PULL_DRAPE('demo.scr')
  200.  
  201.    CASE sel=10
  202.       SETCOLOR(maincolor)
  203.       coolscrn()
  204.       SETCOLOR('+W/BG')
  205.       Exbox(9, 08, 14, 70, 1, 5, '', .T., 'User Feedback')
  206.       SPREAD('The Grumpfish Library includes several user feedback items.',10,20)
  207.       SPREAD('There are two functions for yes/no prompts, printer status ',11,20)
  208.       SPREAD('test function, error message display, messages for tedious ',12,20)
  209.       SPREAD("routines (printing, reindexing, etc). Let's look at them...",13,20)
  210.  
  211.       INKEY(5)
  212.       firstans = YES_NO('This is one of the two Grumpfish yes/no prompts',;
  213.                         'Would you like to see the other one')
  214.       IF ! firstans
  215.          Err_Msg('Too bad, you are going to see it anyway')
  216.       ENDIF
  217.       yes_no2('Shall we zap the database now?', 12, ' OK ', ' Cancel ', .F.)
  218.       waiton('Now zapping database... please wait')
  219.       INKEY(2)
  220.       waitoff()
  221.       firstans = yes_no2('Print the report now?', 12, ' OK ', ' Cancel ')
  222.       IF ! firstans
  223.          waiton("For the sake of argument, let's assume that we are printing now")
  224.          INKEY(2)
  225.          waitoff()
  226.       ENDIF
  227.  
  228.       inkey(1)
  229.       if isprinter()
  230.          waiton('Please turn off your printer so you can see how Grumpfish handles it')
  231.          do while isprinter()
  232.          enddo
  233.          waitoff()
  234.       endif
  235.       printok()
  236.  
  237.       Err_msg('Hey!  You forgot to wear deodorant today!!')
  238.  
  239.    CASE sel=11
  240.       coolscrn()
  241.       save screen to temp
  242.       SETCOLOR('RB/N')
  243.       shadowbox(10, 06, 14, 72, 2, 'Interactive Color Palette')
  244.       SETCOLOR('+GR/N')
  245.       Spread('If Michelango were alive today, he would get a kick out of this',11,20)
  246.       Spread('interactive color palette!  Plug it instantly into your program',12,20)
  247.       Spread('for maximum color flexibility. Try changing the screen with it!',13,20)
  248.       INKEY(4)
  249.       restore screen from temp
  250.       COLORPAL()
  251.  
  252.    CASE sel=12
  253.       DO WHILE .T.
  254.          @ 06,30 PROMPT '    Mastermind     '
  255.          @ 07,30 PROMPT '  Number  Puzzle   '
  256.          @ 08,30 PROMPT '     Ballgame      '
  257.          @ 09,30 PROMPT '     Star Trek     '
  258.          @ 10,30 PROMPT '     Jeopardy      '
  259.          @ 11,30 PROMPT " That's All Folks! "
  260.          @ 12,30 PROMPT ' Girl From Ipanema '
  261.          @ 13,30 PROMPT '     Birthday      '
  262.          @ 14,30 PROMPT 'Pop Goes The Weasel'
  263.          @ 15,30 PROMPT 'Nanny-Nanny-Boo-Boo'
  264.          @ 16,30 PROMPT '    Green Acres    '
  265.          @ 17,30 PROMPT '    Blue Danube    '
  266.          @ 18,30 PROMPT '       Quit        '
  267.          MENU TO silly_sel
  268.          DO CASE
  269.             CASE silly_sel = 1
  270.                DO POPMM
  271.             CASE silly_sel = 2
  272.                DO POPPUZ
  273.             CASE silly_sel = 3
  274.                DO BALLGAME
  275.             CASE silly_sel = 4
  276.                DO STARTREK
  277.             CASE silly_sel = 5
  278.                DO JEOPARDY
  279.             CASE silly_sel = 6
  280.                DO THATSALL
  281.             CASE silly_sel = 7
  282.                DO IPANEMA
  283.             CASE silly_sel = 8
  284.                DO BIRTHDAY WITH 'GRUMPY'
  285.             CASE silly_sel = 9
  286.                DO WEASEL
  287.             CASE silly_sel = 10
  288.                DO NANNYBOO
  289.             CASE silly_sel = 11
  290.                DO GREENACR
  291.             CASE silly_sel = 12
  292.                DO BLUEDANU
  293.             CASE silly_sel = 13 .OR. silly_sel = 0
  294.                EXIT
  295.          ENDCASE
  296.       ENDDO
  297.  
  298.    CASE sel=13
  299.       exit
  300.    ENDCASE
  301.    RESTORE SCREEN FROM mainmenu
  302. ENDDO
  303. RETURN
  304.  
  305.  
  306. FUNCTION showstring
  307. PARAM mcolor,mstart,mstop,delay
  308. PRIVATE mrow
  309. SETCOLOR('+'+TRIM(SUBSTR(colorstr,(mcolor-1)*2+1,2))+'/N')
  310. FOR mrow = mstart TO mstop
  311.    @ mrow,30 SAY mstring
  312.    IF PCOUNT() = 4
  313.       INKEY(delay)
  314.    ENDIF
  315. NEXT
  316. RETURN('')
  317.  
  318.  
  319. FUNCTION coolscrn
  320. FOR X = 0 TO 24
  321.    @ X,0 SAY REPLICATE(CHR(250),80)
  322. NEXT
  323.  
  324.  
  325. ********************************************************************
  326. * colorpal(): virtually identical to Grumpfish Library version
  327. *             except that it repaints the screen when color changes
  328. ********************************************************************
  329. FUNCTION colorpal
  330. PRIVATE oldrow, oldcol, oldcolor, mrow, mcol, palettetop, oldscrn, ;
  331.         colorstrng, mfore, mback, keypress, buffer
  332. palettetop = 16    && top row for palette - change this to suit your needs
  333. ** save environment
  334. oldrow = ROW()
  335. oldcol = COL()
  336. oldcolor = SETCOLOR()
  337. oldscrn = SAVESCREEN(palettetop, 16, palettetop + 8, 63)
  338.  
  339. ** this string will be used in converting color numbers in the
  340. ** range of 0-127 to dBASE color strings (e.g. "W/N" etc)
  341. colorstrng = 'N  B  G  BG R  BR GR W  N+ B+ G+ BG+R+ BR+GR+W+ '
  342.  
  343. curr_color = 7
  344.  
  345. RESTSCREEN(palettetop, 16, palettetop + 7, 63, thepalette)
  346. SETCOLOR('GR+/N')
  347. SCROLL(palettetop + 8, 16, palettetop + 8, 63, 00)
  348. @ 24,16 SAY CHR(24)+CHR(25)+CHR(27)+CHR(26)+' to move'
  349. @ 24,33 SAY 'Enter to select'
  350. @ 24,53 SAY 'Esc to exit'
  351.  
  352. ** determine starting row and column within palette
  353. mrow = palettetop + INT(curr_color/16)
  354. mcol = 17 + curr_color % 16 * 3
  355.  
  356. ** commence main keypress loop
  357. DO WHILE .T.
  358.  
  359.    ** draw blinking diamond to mark current color and get keypress
  360.    SETCOLOR('*' + color_n2s(curr_color))
  361.    @ mrow,mcol SAY CHR(4)
  362.    INKEY(0)
  363.    keypress = LASTKEY()
  364.  
  365.    ** clear blinking diamond
  366.    SETCOLOR(color_n2s(curr_color))
  367.    @ mrow,mcol SAY CHR(4)
  368.  
  369.    ** process keystroke
  370.    DO CASE
  371.       ** user pressed an arrow key (24=down, 5=up, 4=left, 19=right)
  372.       CASE (keypress = 24 .AND. mrow < palettetop+7) .OR. ;
  373.                    (keypress = 5  .AND. mrow > palettetop) .OR.  ;
  374.                    (keypress = 4  .AND. mcol < 62) .OR. ;
  375.                    (keypress = 19 .AND. mcol > 17)
  376.          ** adjust row position for up or down arrows
  377.          mrow = mrow + IF(keypress = 24, 1, IF(keypress = 5, -1, 0))
  378.          ** adjust column position for left or right arrows
  379.          mcol = mcol + IF(keypress = 4, 3, IF(keypress = 19, -3, 0))
  380.          ** change color number accordingly
  381.          curr_color = curr_color + IF(keypress=24, 16, ;
  382.                       IF(keypress = 5, -16, IF(keypress = 4, 1, -1)))
  383.       ** user pressed Enter or Esc - time to move along
  384.       CASE keypress = 13 .OR. keypress = 27
  385.          EXIT
  386.       ** user pressed something else
  387.       OTHERWISE
  388.          TONE(220,1)
  389.          TONE(220,1)
  390.    ENDCASE
  391.    *** here is where this version of ColorPal() differs from
  392.    *** what is in the Grumpfish Library - I have added the
  393.    *** following code to redraw the screen in each new color
  394.    *** please refer to the documentation on how to do this
  395.    *** it is actually very simple and incredibly useful!
  396.    SETCOLOR(color_n2s(curr_color))
  397.    buffer = SAVESCREEN(palettetop, 16, palettetop + 8, 63)
  398.    coolscrn()
  399.    RESTSCREEN(palettetop, 16, palettetop + 8, 63, buffer)
  400. ENDDO
  401.  
  402. ** restore environment
  403. @ oldrow, oldcol SAY ''
  404. SETCOLOR(oldcolor)
  405. RESTSCREEN(palettetop, 16, palettetop + 8, 63, oldscrn)
  406. ** if user pressed Esc to abort, return the old color
  407. RETURN (IF(keypress = 27, oldcolor, color_n2s(curr_color)))
  408.  
  409. ***********************************************************
  410. * color_n2s(): convert color number (0-127) to color string
  411. ***********************************************************
  412. FUNCTION color_n2s
  413. PARAM colorno
  414. RETURN (TRIM(SUBSTR(colorstrng, (colorno % 16) * 3 + 1, 3)) + '/' + ;
  415.         TRIM(SUBSTR(colorstrng, INT(colorno / 16) * 3 + 1, 3)))
  416.  
  417. * End of File: DEMO.prg
  418.