home *** CD-ROM | disk | FTP | other *** search
/ Harvey Norman Games / HN.iso / BOARD / LIFE2P0.ZIP / EXT_PROC.BAS < prev    next >
BASIC Source File  |  1994-05-30  |  10KB  |  471 lines
  1. DECLARE SUB Procedure12 ()
  2. DECLARE SUB Procedure11 ()
  3. DECLARE SUB Procedure8 ()
  4. DECLARE SUB Procedure7 ()
  5. DECLARE SUB Procedure6 ()
  6. DECLARE SUB Procedure5 ()
  7. DECLARE SUB Procedure4 ()
  8. DECLARE SUB Procedure3 ()
  9. DECLARE SUB Procedure2 ()
  10. DECLARE SUB Procedure1 ()
  11. DECLARE SUB Procedure9 ()
  12. DECLARE SUB Procedure10 ()
  13.  
  14.  
  15.  
  16.  
  17.  
  18. DEFINT A-Z
  19. '
  20. '
  21. 'This demonstrates how to get your own programs to interact with LIFE.
  22. '
  23. 'This program can be run with QBasic or compiled with QB.
  24. '
  25. 'Basically, all an external procedure needs to do is.. .
  26. ' 1/    Clear the screen. It should still be in mode 13
  27. ' 2/    Read in and act on information from life in RETURN.DTA
  28. ' 3/    Draw something on screen. (COLOR 1)
  29. ' 4/    Set values in Control structure and save to CONTROL.DTA
  30. ' 5/    END. Which returns control to life with a new screen of data or
  31. '            a command to stop processing.
  32. '
  33. 'The screen drawn is returned to life in the video memory.
  34. '
  35. 'If there are any other things you would like in these structures
  36. 'please let me know.
  37. '
  38. '
  39. '
  40. 'For best results, use SMARTDRV with as large a buffer as possible and the
  41. ' /N switch or a RAM disk.
  42. '
  43. '
  44. 'Files with the extension .DTA are tempory files and may be deleted when no
  45. 'longer required. I suggest you stay with this convention.
  46. '
  47. 'Life reads from CONTROL.DAT, if it exists and sends info to this program
  48. 'in RETURN.DTA.
  49. '
  50. '
  51. 'This program IS the documentation for the LIFE External procedure.
  52. '
  53. '
  54. '
  55.  
  56.  
  57.  
  58.  
  59. 'This structure controls the life program
  60. TYPE Frame
  61.    
  62.     ExitAfter AS LONG   'LIFE returns to this program after
  63.                         'ExitAfter generations.
  64.    
  65.     MaxNoChange AS LONG 'LIFE returns if population doesn't change for this
  66.                         'number of generations.
  67.    
  68.     Wrap AS INTEGER     '-1 turns wrap mode on, 0 turns wrap mode off.
  69.    
  70.     Rules AS STRING * 4
  71.     StopExecution AS INTEGER 'if set to -1 will cause life to display menu
  72.     Delay   AS INTEGER       'Delay time, same as delay in control menu.
  73.     StartDelay AS INTEGER    'time to delay start of processing.
  74.     reserved AS STRING * 1004   'pad to 1024 bytes. All 0.
  75. END TYPE
  76. DIM SHARED Control AS Frame
  77.  
  78. 'This is returned from LIFE
  79. TYPE rd
  80.     Version AS INTEGER  'Version number of LIFE.
  81.     Population AS LONG  'Number of cells on screen, current population.
  82.     generation AS LONG  'Number of generations completed.
  83.     LastStableGeneration AS LONG    'Generation where last stable population
  84.                                     'occured.
  85.  
  86.     GenerationsPerSecond AS STRING * 10 'Just what it says
  87.     Wrap AS INTEGER                     'Wrap mode -1 = on,  0 = OFF
  88.     Rules AS STRING * 4                 'The rules.  See below.
  89.     Delay AS INTEGER                    'Delay value 0 - 255, 0 = fastest.
  90.     reserved AS STRING * 992  'padding to make 1024 bytes long
  91. END TYPE
  92. DIM SHARED ReturnData AS rd
  93.  
  94.  
  95.  
  96. StartUp& = TIMER   'make it different each time.
  97.  
  98.  
  99.  
  100.  
  101. 'Check for existance is if Version number is 0, could use EOF()
  102. n$ = "RETURN.DTA"
  103. OPEN n$ FOR BINARY AS #1
  104.     GET #1, , ReturnData
  105. CLOSE #1
  106.  
  107.  
  108.  
  109.  
  110. IF ReturnData.Version = 0 THEN GOTO FirstTime
  111. 'File didn't exist so is the first this program has been called.
  112.  
  113.  
  114.  
  115.  
  116. 'extract rules for no reason but to show how to.
  117. LeastToLive = ASC(MID$(ReturnData.Rules, 1, 1))
  118. LowestBirth = ASC(MID$(ReturnData.Rules, 2, 1))
  119. HighestBirth = ASC(MID$(ReturnData.Rules, 3, 1))
  120. MostToLive = ASC(MID$(ReturnData.Rules, 4, 1))
  121.  
  122. Max = 8000' only interested in things that last longer than this.
  123.  
  124.  
  125.  
  126.  
  127.  
  128. 'Test if meets criteria of >=8000 Generations.
  129. 'If it does, BEEP and signal stop in Control structure.
  130.  
  131. IF (ReturnData.LastStableGeneration > Max) OR (ReturnData.generation >= Max) THEN
  132.     'first fix so it only stops first time thru.
  133.     n$ = "RETURN.DTA"
  134.     ReturnData.generation = 0
  135.     ReturnData.LastStableGeneration = 0
  136.     OPEN n$ FOR BINARY AS #1
  137.         PUT #1, , ReturnData
  138.     CLOSE #1
  139.  
  140.    
  141.     PLAY "a c b f f g"          'HEY YOU ...
  142.     Control.StopExecution = -1  'Tell LIFE to stop processing.
  143.     GOTO ImmediateExit:
  144.  
  145. END IF
  146.  
  147.  
  148. 'un-comment to keep a log, a simple example
  149. 'n$ = "log.dta"
  150. 'OPEN n$ FOR APPEND AS #1
  151. '    PRINT #1, "StartUp "; StartUp&; "Gen "; ReturnData.LastStableGeneration, "Pop "; ReturnData.Population, "  Size "; s
  152. 'CLOSE #1
  153.  
  154.  
  155.  
  156.  
  157.  
  158. FirstTime:
  159.  
  160.  
  161.  
  162.  
  163. SCREEN 13                       'Must be SCREEN 13. BASIC  won't clear screen
  164.                                 'if it was already in mode 13.
  165.  
  166. COLOR 1                         'Must be color 1 to work properly, try some
  167.                                 'others if you like.
  168.  
  169. CLS
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  
  176. 'Put something onto the screen.
  177.  
  178.  
  179.  
  180.  
  181. RANDOMIZE StartUp&
  182.  
  183. LoopHere:
  184. v = INT(12 * RND) + 1
  185. 'v = 12       'Debug control to force selection of same one.
  186.  
  187.  
  188. SELECT CASE v
  189.  
  190.     CASE 1
  191.         Procedure1
  192.     CASE 2
  193.         Procedure2
  194.     CASE 3
  195.         Procedure3
  196.     CASE 4
  197.         Procedure4
  198.     CASE 5
  199.         Procedure5
  200.     CASE 6
  201.         Procedure6
  202.     CASE 7
  203.         Procedure7
  204.     CASE 8
  205.         Procedure8
  206.     CASE 9
  207.         Procedure9
  208.     CASE 10
  209.         Procedure10
  210.     CASE 11
  211.         Procedure11
  212.     CASE 12
  213.         Procedure12
  214.    
  215.     CASE ELSE
  216.         BEEP    'Should never happen, here for debugging.
  217.         BEEP
  218. END SELECT
  219.  
  220.  
  221.  
  222. 'Set-up and save control info.
  223.  
  224. Control.StopExecution = 0       'Don't stop
  225.  
  226. ImmediateExit:
  227.  
  228. Control.ExitAfter = Max + 10
  229. 'Set to exit after X generations. Slightly larger than max generations.
  230. 'Life will stop processing after Max+10 generations.
  231.  
  232.  
  233. Control.MaxNoChange = 500 'number of no population change generations.
  234. 'LIFE will stop processing the current screen after this number of
  235. 'generations without a population change.
  236.  
  237.  
  238.  
  239.  
  240. Control.Wrap = -1   ' Wrap mode is ON
  241. Control.Rules = CHR$(2) + CHR$(3) + CHR$(3) + CHR$(3) 'standard rules.2333
  242. Control.Delay = 0'No delay
  243. Control.StartDelay = 0 'delay between display and start of processing in
  244. '1/18 seconds.
  245.  
  246. n$ = "CONTROL.DTA"   ' Change directory to suit, must retain the
  247.                                 ' same filename, CONTROL.DTA.
  248.  
  249. 'Save control info.
  250. OPEN n$ FOR BINARY AS #1
  251.     PUT #1, , Control
  252. CLOSE
  253.  
  254.  
  255. 'That's all, LIFE will restore what needs to be so just end.
  256. SYSTEM
  257.  
  258. SUB Procedure1
  259.  
  260. sx = RND * 64 + 1
  261. sy = RND * 64 + 1
  262. DO
  263.     Density! = RND
  264. LOOP UNTIL Density! < .66
  265. FOR x = 0 TO sx - 1
  266.     FOR y = 0 TO sy - 1
  267.         IF RND > Density! THEN
  268.             PSET (x + 160 - (sx \ 2), y + 100 - (sy \ 2)), 1
  269.         END IF
  270.     NEXT
  271. NEXT
  272.  
  273.  
  274. END SUB
  275.  
  276. SUB Procedure10
  277.  
  278. s = RND * 150
  279. o = 0
  280. IF RND > .5 THEN o = 1
  281. l = RND * 199
  282. LINE (160 - s + o, 0)-(160 - s + o, l), 1
  283.  
  284. LINE (160 + s, 0)-(160 + s, l), 1
  285.  
  286.  
  287.  
  288.  
  289. END SUB
  290.  
  291. SUB Procedure11
  292.  
  293. l = RND * 99
  294.  
  295. LINE (160, 100)-(160 - l, 100 - l), 1
  296. LINE (160, 100)-(160 + l, 100 - l), 1
  297. LINE (160, 100)-(160 - l, 100 + l), 1
  298. LINE (160, 100)-(160 + l, 100 + l), 1
  299.  
  300. IF RND > .5 THEN
  301.     l = RND * 100
  302.     LINE (160 - l, 100 - l)-(160 + l, 100 + l), 1, B
  303. END IF
  304.  
  305.  
  306. END SUB
  307.  
  308. SUB Procedure12
  309.  
  310. l = RND * 99
  311.  
  312. 'Up and left
  313. LINE (160 - 1, 100 - 1)-(160 - l - 1, 100 - l - 1), 1
  314.  
  315. 'Up and right
  316. LINE (160, 100 - 1)-(160 + l, 100 - l - 1), 1
  317.  
  318.  
  319. 'Down and left
  320. LINE (160 - 1, 100)-(160 - l - 1, 100 + l), 1
  321.  
  322. 'Down and right
  323. LINE (160, 100)-(160 + l, 100 + l), 1
  324. IF RND > .5 THEN
  325.     l = RND * 100
  326.     LINE (160 - l - 1, 100 - l - 1)-(160 + l, 100 + l), 1, B
  327. END IF
  328. END SUB
  329.  
  330. SUB Procedure2
  331.  
  332. Size = RND * 100 + 10
  333. Number = RND * 1000 + 50
  334. x = 160
  335. y = 100
  336. IF RND > .5 THEN
  337.     inc = 1
  338. ELSE
  339.     inc = 0
  340. END IF
  341. FOR t = 1 TO Number
  342.    
  343.     x1 = RND * Size
  344.     y1 = RND * Size
  345.    
  346.     PSET (x - x1, y + y1 - inc), 1
  347.     PSET (x - x1, y - y1), 1
  348.     PSET (x + x1 - inc, y - y1), 1
  349.     PSET (x + x1 - inc, y + y1 - inc), 1
  350. NEXT
  351.  
  352. END SUB
  353.  
  354. SUB Procedure3
  355. x = 160
  356. y = 100
  357. n = RND * 1000 + 50
  358. z = 5 + RND * 60
  359. o = RND * 16
  360. IF RND > .5 THEN
  361.     inc = 1
  362. ELSE
  363.     inc = 0
  364. END IF
  365.  
  366. FOR count = 1 TO n
  367.        
  368.     x1 = RND * z + o
  369.     y1 = RND * z + o
  370.  
  371.     PSET (x + x1, y + y1), 1
  372.     PSET (x + y1, y - x1), 1
  373.     PSET (x - x1 + inc, y - y1 + inc), 1
  374.     PSET (x - y1 + inc, y + x1 + inc), 1
  375. NEXT
  376.  
  377. END SUB
  378.  
  379. SUB Procedure4
  380.  
  381.  
  382.  
  383. n = INT(RND * 16) + 1
  384. s = INT(RND * 15) + 1
  385. w = INT(RND * 150) + 1
  386.  
  387.  
  388. YSize = (n - 1) * s
  389. y = 100 - (YSize \ 2)
  390. x = 160 - (w \ 2)
  391.  
  392. FOR t = 1 TO n
  393.     LINE (x, y)-(x + w, y), 1'must be color 1
  394.     y = y + s
  395. NEXT
  396.  
  397. END SUB
  398.  
  399. SUB Procedure5
  400.  
  401. xl = INT(160 * RND) + 1
  402. yl = INT(100 * RND) + 1
  403.  
  404. x = xl \ 2
  405. LINE (160 - x, 100)-(160 + x, 100), 1
  406.  
  407. y = yl \ 2
  408. LINE (160, 100 - y)-(160, 100 + y), 1
  409.  
  410. END SUB
  411.  
  412. SUB Procedure6
  413.  
  414. x = INT(80 * RND) + 1
  415. y = INT(50 * RND) + 1
  416. inc = RND > .5
  417.  
  418. LINE (160 - x, 100 - y)-(160 + x, 100 - y), 1
  419. LINE (160 - x, 100 + y + inc)-(160 + x, 100 + y + inc), 1
  420. LINE (160 - x, 100 - y)-(160 - x, 100 + y + inc), 1
  421.  
  422.  
  423. END SUB
  424.  
  425. SUB Procedure7
  426.  
  427. x = INT(80 * RND) + 1
  428. y = INT(50 * RND) + 1
  429. inc = RND > .5
  430. inc2 = RND > .5
  431. LINE (160 - x, 100 - y)-(160 + inc2 + x, 100 - y), 1
  432. LINE (160 - x, 100 + y + inc)-(160 + inc2 + x, 100 + y + inc), 1
  433. LINE (160 - x, 100 - y)-(160 - x, 100 + y + inc), 1
  434. LINE (160 + inc2 + x, 100 - y)-(160 + inc2 + x, 100 + y + inc), 1
  435.  
  436.  
  437.  
  438. END SUB
  439.  
  440. SUB Procedure8
  441. FOR t = 1 TO RND * 15 + 2
  442.     x = INT(80 * RND) + 1
  443.     y = INT(50 * RND) + 1
  444.     LINE (160 - x, 100 - y)-(160 + x, 100 - y), 1
  445.     LINE (160 - x, 100 + y)-(160 + x, 100 + y), 1
  446.     LINE (160 - x, 100 - y)-(160 - x, 100 + y), 1
  447.     LINE (160 + x, 100 - y)-(160 + x, 100 + y), 1
  448. NEXT
  449. END SUB
  450.  
  451. SUB Procedure9
  452.  
  453. x = INT(80 * RND) + 1
  454. y = INT(50 * RND) + 1
  455. inc = RND > .5
  456. inc2 = RND > .5
  457. xl = 160 - x
  458. xr = 160 + inc + x
  459. LINE (xl, 100)-(xr, 100), 1
  460.  
  461. yt = -INT(50 * RND) + 1
  462. yb = INT(50 * RND) + 1
  463.  
  464.  
  465. LINE (xl, 100 + yt)-(xl, 100 + yb), 1
  466.  
  467. LINE (xr, 100 + yt)-(xr, 100 + yb), 1
  468.  
  469. END SUB
  470.  
  471.