home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / progbas / dframe31.arj / DFDEMO.ZIP / DFDEMO.BAS next >
Encoding:
BASIC Source File  |  1992-04-30  |  12.1 KB  |  351 lines
  1. DEFINT A-Z
  2. ' $INCLUDE: '\inc\dframe.inc'           'change path if needed
  3. ' $INCLUDE: '\inc\owner.inc'            'contains my serial #. Delete this
  4.                                         'line if need be.
  5.  
  6. ProgName$ = "DoorFrame Demo"
  7. ExeName$ = "DFDEMO"
  8. Version$ = " 1.0"
  9.  
  10. INITIALIZE
  11. CLOSE #1
  12. DETECT.ANSI                     'Make sure the caller is ANSI capable!
  13. ON ERROR GOTO Err.Routine       'Errors? What errors?
  14. SysopKeys% = 1                  'Use alternate set so we can use the arrows
  15. DIM Menu$(8)                    'Holds our Menu entries
  16.  
  17. 'Since this demo uses cursor positioning, the caller must be ANSI compatible.
  18. 'Kick him out if he isn't.
  19. IF Graphics% = 0 THEN
  20.    CLRSCRN BLACK
  21.    DIS.PLAY "This Door requires ANSI.SYS compatibility!", LWHITE, BLACK, 0, 0, 1, 1, 1, 0, 0
  22.    DIS.PLAY "Returning you to the BBS", LWHITE, BLACK, 0, 0, 2, 1, 1, 0, 0
  23.    DE.LAY 3
  24.    EXIT.DOOR "Y"
  25. END IF
  26.  
  27. 'Also needs color to see the demo. If not in color mode, ask to switch.
  28.  
  29. PriorMode% = Mode%                      'Save current color mode
  30. IF Mode% = 0 THEN                       'Does he have color on?
  31.    DIS.PLAY "You will need to be in Color Mode to see this demo.", LWHITE, BLACK, 0, 1, 10, 1, 1, 1, 0
  32.    DIS.PLAY "Type Y to switch to Color or N to return to BBS [Y/n] > ", LWHITE, BLACK, 0, 0, 12, 1, 0, 1, 0
  33.    IF UCASE$(Response$) <> "N" THEN
  34.       Mode% = -1                        'Turn color on
  35.    ELSE
  36.       EXIT.DOOR "Y"
  37.    END IF
  38. END IF
  39.  
  40. Menu$(1) = "^B^ox.It Demo"
  41. Menu$(2) = "Clr^E^ol Demo"
  42. Menu$(3) = "^C^lrScrn Demo"
  43. Menu$(4) = "^D^is.Play Demo"
  44. Menu$(5) = "^I^n.Put Demo"
  45. Menu$(6) = "^M^ake.Blt Demo"
  46. Menu$(7) = "^S^end Demo"
  47. Menu$(8) = "^G^et me out!"
  48.  
  49. Start:
  50. MenuPos% = 1                    'Where are we on the Menu?
  51. CLRSCRN BLUE                    'Clear the screen with a BLUE background
  52.  
  53. 'Draw a box for our menu
  54. BOX.IT 5, 30, 16, 50, 2, LWHITE, CYAN, LWHITE, CYAN, 32, 0, "Menu", 0, 7
  55.  
  56. 'Write the menu and highlight bar
  57. FOR x = 1 TO 8
  58.    DIS.PLAY Menu$(x), BLACK, CYAN, 0, 0, x + 6, 33, 1, 0, 0
  59. NEXT
  60. DIS.PLAY Menu$(MenuPos%), BLACK, WHITE, 0, 0, MenuPos% + 6, 33, 1, 0, 0
  61.  
  62. GetInput:
  63. 'Prompt for a choice. Get a 1-key response and act on it
  64. DIS.PLAY "Your Choice? ", LWHITE, BLUE, 0, 0, 19, 34, 0, 0, 0
  65. IN.PUT 1, 0, LCYAN, BLUE
  66.  
  67. SELECT CASE UCASE$(Response$)           'Response$ holds the callers input.
  68. CASE "B"
  69.    GOSUB BoxDemo
  70. CASE "E"
  71.    GOSUB EolDemo
  72. CASE "C"
  73.    GOSUB ClrDemo
  74. CASE "D"
  75.    GOSUB DisplayDemo
  76. CASE "I"
  77.    GOSUB InputDemo
  78. CASE "M"
  79.    GOSUB BltDemo
  80. CASE "S"
  81.    GOSUB SendDemo
  82. CASE "G"
  83.    GOTO GoodBye
  84. CASE "UP"               'Returned in Response$ when using alternate Sysop
  85.                         'keys and the UP Arrow is pressed.
  86.    DIS.PLAY Menu$(MenuPos%), BLACK, CYAN, 0, 0, MenuPos% + 6, 33, 1, 0, 0
  87.    IF MenuPos% = 1 THEN
  88.       MenuPos% = 8
  89.    ELSE
  90.       MenuPos% = MenuPos% - 1
  91.    END IF
  92.    DIS.PLAY Menu$(MenuPos%), BLACK, WHITE, 0, 0, MenuPos% + 6, 33, 1, 0, 0
  93.    GOTO GetInput
  94. CASE "DOWN"
  95.    DIS.PLAY Menu$(MenuPos%), BLACK, CYAN, 0, 0, MenuPos% + 6, 33, 1, 0, 0
  96.    IF MenuPos% = 8 THEN
  97.       MenuPos% = 1
  98.    ELSE
  99.       MenuPos% = MenuPos% + 1
  100.    END IF
  101.    DIS.PLAY Menu$(MenuPos%), BLACK, WHITE, 0, 0, MenuPos% + 6, 33, 1, 0, 0
  102.    GOTO GetInput
  103. CASE ""
  104.    ON MenuPos% GOSUB BoxDemo, EolDemo, ClrDemo, DisplayDemo, InputDemo, BltDemo, SendDemo, GoodBye
  105. CASE ELSE
  106.    'Display boo-boo message with a bell and wait 4 seconds
  107.    DIS.PLAY "Invalid selection!", LRED, BLUE, 0, 1, 19, 32, 0, 0, 0
  108.    DE.LAY 4
  109.    CLREOL 19, 32, BLUE                  'Clear the message off
  110.    GOTO GetInput
  111. END SELECT
  112. GOTO Start                              'Back to the Menu
  113.  
  114.  
  115. BoxDemo:                                'Box.It and Lines demo
  116. '10x15 Box with no borders, shadow or title
  117. CLRSCRN WHITE
  118. BOX.IT 2, 2, 11, 16, 0, LWHITE, BLUE, LCYAN, BLUE, 32, 0, "", 0, 0
  119. 'Tell 'em what it is
  120. DIS.PLAY "10x15 Box", LWHITE, BLUE, 0, 0, 3, 4, 0, 0, 0
  121. DIS.PLAY "No Border", LWHITE, BLUE, 0, 0, 5, 4, 0, 0, 0
  122. DIS.PLAY "No Title", LWHITE, BLUE, 0, 0, 7, 4, 0, 0, 0
  123. DIS.PLAY "No Shadow", LWHITE, BLUE, 0, 0, 9, 4, 0, 0, 0
  124.  
  125. 'With border
  126. BOX.IT 2, 21, 11, 36, 2, LWHITE, BLUE, LCYAN, BLUE, 32, 0, "", 0, 0
  127. DIS.PLAY "Same box", LWHITE, BLUE, 0, 0, 5, 24, 0, 0, 0
  128. DIS.PLAY "With border", LWHITE, BLUE, 0, 0, 7, 24, 0, 0, 0
  129.  
  130. 'Add a shadow
  131. BOX.IT 2, 41, 11, 56, 2, LWHITE, BLUE, LCYAN, BLUE, 32, 1, "", 0, 0
  132. DIS.PLAY "Same box", LWHITE, BLUE, 0, 0, 5, 44, 0, 0, 0
  133. DIS.PLAY "With shadow", LWHITE, BLUE, 0, 0, 7, 44, 0, 0, 0
  134.  
  135. 'Add a title
  136. BOX.IT 2, 61, 11, 76, 2, LWHITE, BLUE, LCYAN, BLUE, 32, 1, "Title Demo", LCYAN, RED
  137. DIS.PLAY "Same box", LWHITE, BLUE, 0, 0, 5, 64, 0, 0, 0
  138. DIS.PLAY "With title", LWHITE, BLUE, 0, 0, 7, 64, 0, 0, 0
  139.  
  140. 'Now add some lines
  141. DIS.PLAY "Now let's add some lines to the boxes", LRED, WHITE, 1, 0, 13, 1, 0, 1, 0
  142.  
  143. 'Pause for effect
  144. DE.LAY 2
  145. LINES 4, 2, 15, "H", 0, 2, LWHITE, BLUE, LWHITE, BLUE
  146. LINES 6, 2, 15, "H", 0, 1, LWHITE, BLUE, LWHITE, BLUE
  147. LINES 8, 2, 15, "H", 0, 2, LWHITE, BLUE, LWHITE, BLUE
  148.  
  149. DE.LAY 2
  150. LINES 4, 21, 16, "H", 2, 2, LWHITE, BLUE, LWHITE, BLUE
  151. LINES 6, 21, 16, "H", 2, 1, LWHITE, BLUE, LWHITE, BLUE
  152. LINES 8, 21, 16, "H", 2, 2, LWHITE, BLUE, LWHITE, BLUE
  153.  
  154. DE.LAY 2
  155. LINES 4, 41, 16, "H", 2, 2, LWHITE, BLUE, LWHITE, BLUE
  156. LINES 6, 41, 16, "H", 2, 1, LWHITE, BLUE, LWHITE, BLUE
  157. LINES 8, 41, 16, "H", 2, 2, LWHITE, BLUE, LWHITE, BLUE
  158. LINES 2, 48, 10, "V", 2, 1, LWHITE, BLUE, LWHITE, BLUE
  159.  
  160. CLREOL 13, 1, WHITE
  161. DIS.PLAY "How about some multi-colored boxes!!", BLACK, WHITE, 0, 0, 13, 1, 0, 1, 0
  162. DE.LAY 4
  163. 'Draw a big box
  164. BOX.IT 15, 2, 20, 77, 2, LWHITE, BLUE, LCYAN, BLUE, 32, 1, "Title Demo", LCYAN, RED
  165.  
  166. 'Divide it in 3 parts
  167. LINES 15, 27, 6, "V", 2, 1, LWHITE, BLUE, LWHITE, BLUE
  168. LINES 15, 52, 6, "V", 2, 1, LWHITE, BLUE, LWHITE, BLUE
  169.  
  170. 'Color in 2 of them
  171. BOX.IT 16, 28, 19, 51, 0, LWHITE, GREEN, LCYAN, GREEN, 32, 0, "", 0, 0
  172. BOX.IT 16, 53, 19, 76, 0, LWHITE, RED, LCYAN, RED, 32, 0, "", 0, 0
  173.  
  174. ENTER
  175. RETURN
  176.  
  177. EolDemo:                                'ClrEol demo
  178. CLRSCRN BLACK
  179. DIS.PLAY "ClrEol Demo", LWHITE, BLACK, 0, 0, 1, 1, 0, 1, 0
  180.  
  181. ' Clear 8 lines using each of the background colors
  182. FOR x = 1 TO 7
  183.    CLREOL x + 3, 1, x
  184. NEXT
  185. DIS.PLAY "Clears from specified row/column to the End of Line in 8 Background colors", LWHITE, BLACK, 0, 0, 11, 1, 1, 1, 0
  186.  
  187. 'Do it again but put 2 different colors on each line
  188. FOR x = 1 TO 7
  189.    CLREOL x + 12, 1, x
  190.    IF x < 4 THEN
  191.       CLREOL x + 12, 41, x + 4
  192.    ELSE
  193.       CLREOL x + 12, 41, x - 3
  194.    END IF
  195. NEXT
  196. DIS.PLAY "Multiple use results in lines with 2 or more colors", LWHITE, BLACK, 0, 0, 20, 1, 1, 1, 0
  197. ENTER
  198. RETURN
  199.  
  200. ClrDemo:                                'ClrScrn demo
  201. 'Clear the screen using the 8 available background colors
  202. FOR x = 0 TO 7
  203.    CLRSCRN x
  204.    IF x = 7 THEN
  205.       '7 = White so change foreground to Black
  206.       DIS.PLAY "ClrScrn Demo using background color" + STR$(x), BLACK, x, 0, 0, 11, 1, 0, 1, 0
  207.    ELSE
  208.       DIS.PLAY "ClrScrn Demo using background color" + STR$(x), LWHITE, x, 0, 0, 11, 1, 0, 1, 0
  209.    END IF
  210.    DE.LAY 4
  211. NEXT
  212.  
  213. ENTER
  214. RETURN
  215.  
  216. DisplayDemo:                            'Dis.Play demo
  217. 'Demonstrate various ways of using the Dis.Play statement
  218. CLRSCRN BLACK
  219. DIS.PLAY "To demonstrate the Upper/Lower Case, please type a few words with mixed case", LWHITE, BLACK, 0, 0, 11, 1, 1, 0, 0
  220. DIS.PLAY "> ", LCYAN, BLACK, 0, 0, 12, 1, 0, 0, 0
  221. IN.PUT 70, 0, LCYAN, BLACK
  222. IF Response$ = "" OR Response$ < "A" THEN
  223.    CLREOL 11, 1, 0
  224.    CLREOL 12, 1, 0
  225.    DIS.PLAY "Ok, fine!", LWHITE, BLACK, 0, 0, 11, 1, 1, 1, 0
  226. ELSE
  227.    CLREOL 11, 1, 0
  228.    CLREOL 12, 1, 0
  229.    DIS.PLAY "Your response in lower case.", LWHITE, BLACK, 0, 0, 9, 1, 1, 1, 0
  230.    DIS.PLAY Response$, LWHITE, BLACK, 0, 0, 11, 1, 1, 1, -1
  231.  
  232.    DE.LAY 4
  233.    CLREOL 9, 1, 0
  234.    CLREOL 11, 1, 0
  235.    DIS.PLAY "Your response in upper case.", LWHITE, BLACK, 0, 0, 9, 1, 1, 1, 0
  236.    DIS.PLAY Response$, LWHITE, BLACK, 0, 0, 11, 1, 1, 1, 1
  237. END IF
  238.  
  239. DE.LAY 4
  240. CLREOL 9, 1, 0
  241. CLREOL 11, 1, 0
  242. DIS.PLAY "This is a normal line in White on Black", LWHITE, BLACK, 0, 0, 11, 1, 1, 0, 0
  243. DE.LAY 4
  244. CLREOL 11, 1, 0
  245. DIS.PLAY "Blinking White on Black", LWHITE, BLACK, 1, 0, 11, 1, 1, 0, 0
  246. DE.LAY 4
  247. CLREOL 11, 1, 0
  248. DIS.PLAY "Blinking White on Black and Centered", LWHITE, BLACK, 1, 0, 11, 1, 1, 1, 0
  249. DE.LAY 4
  250. CLREOL 11, 1, 0
  251. DIS.PLAY "Normal White on Black with |Magenta| and %^Blinking Red^.", LWHITE, BLACK, 0, 0, 11, 1, 1, 0, 0
  252. DE.LAY 4
  253. CLREOL 11, 1, 0
  254. DIS.PLAY "Blinking White on Black with {Yellow{ and ~Blue~", LWHITE, BLACK, 1, 0, 11, 1, 1, 1, 0
  255. DE.LAY 4
  256. CLREOL 11, 1, 0
  257. DIS.PLAY "Normal White on Red with *%}Blinking Low intensity White}", LWHITE, RED, 0, 0, 11, 1, 1, 0, 0
  258. DE.LAY 4
  259. CLREOL 11, 1, 0
  260. DIS.PLAY "Blinking White on Red, Centered, with @Cyan@", LWHITE, RED, 1, 0, 11, 1, 1, 1, 0
  261. DE.LAY 4
  262. CLREOL 11, 1, 0
  263. DIS.PLAY "Well, `you` ~get~ @the@ ^idea^!  }Hit} {the{ %|ENTER| key.", LWHITE, BLACK, 0, 0, 11, 1, 1, 1, 0
  264. ENTER
  265. RETURN
  266.  
  267.  
  268. InputDemo:                              'In.Put demo
  269. CLRSCRN BLACK
  270. DIS.PLAY "You can tell In.Put how many keystrokes to accept before returning.", LWHITE, BLACK, 0, 0, 5, 1, 1, 0, 0
  271. DIS.PLAY "You can do %^Hot Keys^ like this:  IN.PUT 1, 0, 10, 0", LWHITE, BLACK, 0, 0, 6, 1, 1, 0, 0
  272. DIS.PLAY "Hit any key > ", LWHITE, BLACK, 0, 0, 7, 1, 0, 0, 0
  273. IN.PUT 1, 0, LGREEN, BLACK
  274.  
  275. DIS.PLAY "Now type 3 keys > ", LWHITE, BLACK, 0, 0, 11, 1, 0, 0, 0
  276. IN.PUT 3, 0, LWHITE, RED
  277. DIS.PLAY "As you can see, you may specify fore/background color for the input.", LWHITE, BLACK, 0, 0, 13, 1, 1, 0, 0
  278. DIS.PLAY "You can specify a wait time in the second parameter of In.Put.", LWHITE, BLACK, 0, 0, 16, 1, 1, 0, 0
  279. DIS.PLAY "For example: In.Put 5, 15, 10, 0  would wait for 5 chars or 15 seconds.", LWHITE, BLACK, 0, 0, 17, 1, 1, 0, 0
  280.  
  281. ENTER
  282. RETURN
  283.  
  284. BltDemo:                                'Make.Blt and Show.Blt demo
  285. CLRSCRN BLACK
  286. DIS.PLAY "DoorFrame features two internal Bulletin generators.", LWHITE, BLACK, 0, 0, 10, 1, 1, 0, 0
  287. DIS.PLAY "Make.Blt generates a Top Ten Listing of the highest scores obtained.", LWHITE, BLACK, 0, 0, 11, 1, 1, 0, 0
  288. DIS.PLAY "Make.Blt.Current lists the current score rather than the highest.", LWHITE, BLACK, 0, 0, 12, 1, 1, 0, 0
  289. DIS.PLAY "We'll demonstrate Make.Blt first. Enter a 5 digit number.", LWHITE, BLACK, 0, 0, 14, 1, 1, 0, 0
  290. DIS.PLAY "Score = ", LCYAN, BLACK, 0, 0, 15, 1, 0, 0, 0
  291. IN.PUT 5, 0, 10, 0
  292. Score& = VAL(Response$)
  293. MAKE.BLT Score&                 'Create the BLT with the number he entered
  294. SHOW.BLT "Y"                    'Now show it to him.
  295.  
  296. CLRSCRN BLACK
  297. DIS.PLAY "Now enter a 4 digit number and we'll demonstrate Make.Blt.Current.", LWHITE, BLACK, 0, 0, 11, 1, 1, 0, 0
  298. DIS.PLAY "Score = ", LCYAN, BLACK, 0, 0, 12, 1, 0, 0, 0
  299. IN.PUT 4, 0, 10, 0
  300. Score& = VAL(Response$)
  301. MAKE.BLT.CURRENT Score&
  302. SHOW.BLT "Y"
  303. CLRSCRN BLACK
  304. DIS.PLAY "As you can see, Make.Blt.Current uses your current score regardless of your", LWHITE, BLACK, 0, 0, 11, 1, 1, 0, 0
  305. DIS.PLAY "previous high score. When using Make.Blt, you would have to exceed your", LWHITE, BLACK, 0, 0, 12, 1, 1, 0, 0
  306. DIS.PLAY "highest score before the bulletin listing would change.", LWHITE, BLACK, 0, 0, 13, 1, 1, 0, 0
  307. ENTER
  308. RETURN
  309.  
  310. SendDemo:                               'Send demo
  311. CLRSCRN BLACK
  312. DIS.PLAY "First we'll send an ASCII file.", LWHITE, BLACK, 0, 0, 11, 1, 1, 1, 0
  313. DE.LAY 5
  314. CLREOL 11, 1, 0
  315.  
  316. 'First check for the existance of the files
  317. Found% = EXIST2%("MICRONET.ASC")
  318. IF Found% THEN
  319.    SEND "MICRONET.ASC", 1, 1    'Clear the screen, send it, use ENTER prompt
  320. ELSE
  321.    DIS.PLAY "Whoops! Your Sysop does not have that file available!", LRED, BLACK, 0, 1, 11, 1, 1, 1, 0
  322.    DE.LAY 5
  323.    CLREOL 11, 1, 0
  324. END IF
  325. CLRSCRN BLACK
  326.  
  327. DIS.PLAY "Now we'll send an ANSI file.", LWHITE, BLACK, 0, 0, 11, 1, 1, 1, 0
  328. DE.LAY 5
  329. CLREOL 11, 1, 0
  330.  
  331. Found% = EXIST2%("MICRONET.ASC")
  332. IF Found% THEN
  333.    SEND "MICRONET.ANS", 1, 1
  334. ELSE
  335.    DIS.PLAY "Whoops! Your Sysop does not have that file available!", LRED, BLACK, 0, 1, 11, 1, 1, 1, 0
  336.    DE.LAY 5
  337.    CLREOL 11, 1, 0
  338. END IF
  339. RETURN
  340.  
  341.  
  342. Err.Routine:
  343. ERRORS ERR, ERL
  344.  
  345. GoodBye:
  346. Mode% = PriorMode%                   'Restore original color mode
  347. EXIT.DOOR "Y"                        'Leave & display ending message
  348. END
  349.  
  350.  
  351.