home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1996 December / CD_shareware_12-96.iso / DOS / Programa / AI_WHEEL.ZIP / AI-WHEEL.BAS < prev    next >
Encoding:
BASIC Source File  |  1996-08-15  |  69.1 KB  |  2,111 lines
  1. ' AI~WHEEL.BAS  Academic Shareware Version 1.1         PRESS F5 TO START
  2. ' UNIVERSAL ROBOTIC BRAIN CELL
  3. ' by David Albert Harrell
  4. ' Copyright 1996 - All Rights Reserved.
  5. ' Educational non-profit non-government individuals may use this software
  6. ' for a 30 day evaluation period only, after which time users must register.
  7. ' Profit oriented and/or government entities may NOT utilize any portion
  8. ' or version of AI~WHEEL without written permission from David Albert Harrell.
  9. retrogdupnn = 0: supcnd = 1: forceobjkeypp = 0: recvalonly = -50: matchallbyprod = 0: appearnowonly = 0: appearnow = 1: evrechardlimit = 500: incondtot = 10: outcondtot = 10: inparthardlimit = 20: outparthardlimit = 11: lawshardlimit = 30: maxminmute = 8888: rndrndon = 1: rndrndstop = 350: rndwithevnum = 1: rndtop = 100: numneedon = 1: rndsimnnrate = 66: linkalways = 1: simselon = 1: linktrys = 25: likelinks = 1: fulpartrnd = 0: bailaftval = 0: useppout = 0: dominaterndflag = 1: dominaterndrate = 25: bailaftmmordisapr = 0: actmaxlimit = 100: settlefor = .1: nodefaultflag = 1: tttflag = 0: rndrate = 25: calcpospponly = 2: calcnnppalso = 1: usevalppflag = 1: compglobalppflag = 1: simnnon = 1: beginpp = 2: boxstall = 1: noduprecs = 0: fleecode = 969696: disapearcode = 868686: icc = 987654
  10. jj = 13: kk = 20: acnum = 1: nt$ = "MBL20": ot = 1: jauger = 41: back = 6: box = 9: rrr = 1: ccc = 51: flash = 14: flashback = 4: black = 0: blue = 1: green = 2: cyan = 3: red = 4: mag = 5: brown = 6: white = 7: gray = 8: lblue = 9: lgreen = 10: lcyan = 11: lred = 12: lmag = 13: yel = 14: whiteh = 15: backg = white: foreg = gray
  11. GOSUB menusub3
  12. REDIM condlinkfinal(incondtot)
  13. REDIM conlink(incondtot, outcondtot)
  14. DIM incondfreq(incondtot, inparthardlimit)
  15. DIM incondgift(incondtot, inparthardlimit)
  16. DIM incondord(incondtot, inparthardlimit)
  17. REDIM befincondtext$(incondtot)
  18. REDIM befoutcondtext$(outcondtot)
  19. REDIM aftincondtext$(incondtot)
  20. REDIM aftoutcondtext$(outcondtot)
  21. REDIM inconddiscribe$(incondtot)
  22. REDIM outconddiscribe$(outcondtot)
  23. DIM currin(incondtot)
  24. DIM currout(outcondtot)
  25. DIM actname$(outcondtot, outparthardlimit)
  26. DIM objname$(incondtot, inparthardlimit)
  27. DIM actenrgused(outcondtot, outparthardlimit)
  28. REDIM inpartspectrumtot(incondtot)
  29. REDIM outpartspectrumtot(outcondtot)
  30. REDIM rrin(incondtot, lawshardlimit)
  31. REDIM rrout(outcondtot, lawshardlimit)
  32. REDIM valaug(lawshardlimit)
  33. REDIM mmgrant(lawshardlimit)
  34. REDIM mmkey(lawshardlimit)
  35. REDIM ippnt(incondtot)
  36. REDIM pinstk(incondtot)
  37. REDIM oppnt(outcondtot)
  38. REDIM poutstk(outcondtot)
  39. REDIM inhistory(incondtot, evrechardlimit)
  40. REDIM outhistory(outcondtot, evrechardlimit)
  41. DIM byprod(incondtot, evrechardlimit)
  42. DIM convcost(evrechardlimit)
  43. DIM numneed(evrechardlimit)
  44. DIM prodval(evrechardlimit)
  45. DIM goalval(evrechardlimit)
  46. DIM czf(evrechardlimit)
  47. REDIM ramu(incondtot)
  48. REDIM findTHISbyprodall(incondtot)
  49.  
  50. wh = incondtot
  51. IF outcondtot > wh THEN wh = outcondtot
  52. wl = inparthardlimit
  53. IF outparthardlimit > wh THEN wh = outparthardlimit
  54. DIM spr(wh, wl)
  55. RANDOMIZE TIMER
  56. GOSUB openmenu
  57. IF userflagx = 1 THEN 1199
  58. IF userflag = 0 THEN 1199
  59. GOSUB useru: CLOSE
  60. 1199 SCREEN 0: CLS
  61. GOSUB defaultpp: CLS
  62. GOSUB drawcirt
  63. 7011  IF aflag = 1 THEN 7777
  64. GOSUB sig
  65. IF tttflag = 1 THEN acnum = 2: actmax = 9
  66. GOSUB setusercondbypass
  67. FOR hfs = 1 TO incondtot
  68. ramu(hfs) = currin(hfs)
  69. NEXT hfs
  70. '              ***************  begin  MAIN LINE  **************
  71. 7777 GOSUB prntclean
  72. IF rndwithevnum = 1 THEN rndtop = histeventnum
  73. COLOR flash, flashback: GOSUB box1
  74. 7659 manpicked = 0
  75. 118 GOSUB setusercond
  76. IF rndrndon = 1 AND histeventnum < rndrndstop THEN GOSUB rndrnd
  77. IF tttflag = 1 THEN GOSUB tttdispl
  78.  
  79. FOR c = 1 TO 10
  80. choice$ = INKEY$
  81. IF choice$ = "z" THEN intrmflag = 1: GOTO 8422
  82. IF choice$ = "p" THEN crretflag = 1
  83. IF choice$ = "t" THEN GOSUB toglrnd
  84. LOCATE 5, 58
  85. IF toglrf = 1 THEN COLOR lred, blue: PRINT "Perform"
  86. IF toglrf = 0 THEN COLOR yel, blue: PRINT "Explore"
  87.  
  88. NEXT c
  89. COLOR flash, flashback: GOSUB box2
  90.                                   
  91. 7172 tryedsofar = 0: moveobflag = 0
  92. disapflag = 0: newrecflag = 0: crazyflag = 0: keyx = 0: goalvalhold = 0
  93. IF sugoflag = 1 THEN 4680
  94.  
  95. FOR qaz = 1 TO outcondtot
  96. currout(qaz) = 1
  97. NEXT qaz
  98.  
  99. IF nodefaultflag = 1 THEN GOSUB randaction
  100. IF likelinks = 1 THEN GOSUB sugglink
  101. winval = -3050: winact = 0: tryedsofar = 0: freshmade = 0: freshmadex = 0
  102. evcnt = evcnt + 1
  103. COLOR 6, 0: LOCATE 10, 70: PRINT evcnt: LOCATE 14, 35: PRINT actmax
  104.  
  105. REDIM outstacker(outcondtot, actmax)  ' begin an event
  106. COLOR flash, flashback: GOSUB box3
  107. COLOR flash, flashback: GOSUB box4
  108. FOR iew = 1 TO histeventnum
  109. FOR hfs = 1 TO incondtot
  110. IF NOT inhistory(hfs, iew) = currin(hfs) THEN 3527
  111. NEXT hfs
  112. GOTO 3528
  113.  
  114. 3527 NEXT iew
  115. IF tryedsofar = actmax THEN 2906
  116. COLOR flash, flashback: GOSUB box6
  117.  
  118. 2906 'all rec have been looked at, best are loaded
  119. IF tryedsofar < actmax THEN 4560
  120. GOTO 4561  ' skip rnd
  121.  
  122. 3528 IF outhistory(1, iew) = 0 THEN PRINT " ev rec with a zero win act? ": intrmflag = 1: GOTO 8422
  123. FOR wer = 1 TO actmax:
  124. ' grab bestscore and act; ' winval may be either goal val or prod VAL
  125.  
  126. IF goalval(iew) + convcost(iew) > winval THEN winval = goalval(iew) + convcost(iew): winact = outhistory(acnum, iew): FOR hfs = 1 TO outcondtot: currout(hfs) = outhistory(hfs, iew): NEXT hfs
  127. IF prodval(iew) < settlefor THEN 1171
  128. IF prodval(iew) > winval THEN winval = prodval(iew): winact = outhistory(acnum, iew): FOR hfs = 1 TO outcondtot: currout(hfs) = outhistory(hfs, iew): NEXT hfs
  129.                                                                        
  130. 1171 FOR hfs = 1 TO outcondtot
  131. IF NOT outhistory(hfs, iew) = outstacker(hfs, wer) THEN 6527
  132. NEXT hfs
  133. GOTO 3527
  134.  
  135. 6527 IF outstacker(1, wer) = 0 THEN tryedsofar = tryedsofar + 1: FOR hfs = 1 TO outcondtot: outstacker(hfs, wer) = outhistory(hfs, iew): NEXT hfs: GOTO 3527
  136. ' a new currout(1) is stacked
  137. NEXT wer
  138. LOCATE 6, 71: PRINT "rec outstack limit err"; actmax; acnum; wer: STOP
  139.  
  140. ' rnd constrant to provoke mutations
  141. 4560 IF winval > settlefor AND tryedsofar < actmax AND FIX(RND * rndtop) + 1 < rndrate + 1 THEN crazyflag = 9999: czf(histeventnum) = crazyflag: LOCATE 7, 59: COLOR red, blue: PRINT "║║║║": LOCATE 9, 59: COLOR red, blue: PRINT "║║║║": GOTO 4481
  142. IF winval > settlefor THEN 4679
  143.  
  144. 4569 IF outstacker(1, actmax) > 0 THEN 4561 ' all tried back in line dom b4 imp
  145. IF simselon = 1 THEN GOSUB simsel
  146. GOSUB prntrnswchs
  147. IF currout(1) > 0 THEN GOSUB checkifnew
  148. IF simnnon = 0 THEN 2799
  149. IF rndsimnnrate > FIX(RND * rndtop) + 1 THEN LOCATE 7, 59: COLOR 14, blue: PRINT "║║║║": LOCATE 9, 59: PRINT "║║║║": GOSUB simnn: GOTO 2722
  150. IF winner = 0 OR currout(1) = 0 OR currout(1) = 9999 THEN GOSUB simnn   ' rare gosub
  151. 2722 IF currout(1) > 0 THEN GOSUB checkifnew
  152. 2799  IF currout(1) = 0 THEN 4481
  153. IF currout(1) < 9999 THEN 4561
  154.  
  155. 4481 linktrycnt = 0: GOSUB randaction
  156. COLOR flash, flashback: GOSUB box9
  157. IF linktrycnt < linktrys THEN GOSUB sugglink:
  158.  
  159. GOSUB checkifnew
  160. COLOR flash, flashback: GOSUB box10
  161. IF currout(1) = 9999 AND tryedsofar < actmax THEN 4481
  162. ' fallthru top of all poss or untried
  163.  
  164. 4561 'begin selecting numneed to produce experimental creations without proven or known val of any kind
  165. COLOR flash, flashback: GOSUB box5
  166. IF numneedon = 0 THEN 4679
  167.  
  168. FOR fdr = 1 TO histeventnum
  169. FOR hfs = 1 TO incondtot
  170. IF NOT inhistory(hfs, fdr) = currin(hfs) THEN 4527 ' iew should fdr
  171. NEXT hfs
  172. IF numneed(fdr) < 1 THEN 4527
  173.  
  174. FOR irm = 1 TO outcondtot
  175. currout(irm) = outhistory(irm, fdr)
  176. NEXT irm
  177. GOTO 4679
  178. 4527 NEXT fdr
  179.  
  180. 4679 IF sugoflag = 1 OR dominaterndflag = 0 THEN 4680
  181. GOSUB domnrnd
  182. 4680 COLOR flash, flashback: GOSUB box11
  183. IF linkalways = 1 THEN GOSUB sugglink
  184. IF tttflag = 1 THEN GOSUB placettt: GOSUB tttdispl
  185.  
  186. '******  INTERFACE TERMINAL # 2 _ Shapers - OUT actions  ******
  187. GOSUB revalu  'IF condbyprodflag = 1 THEN GOSUB condbyprodset
  188. 1042 FOR exx = 1 TO histeventnum   ' ck for an exsiting rec
  189.  
  190. FOR hfs = 1 TO outcondtot
  191. IF NOT outhistory(hfs, exx) = currout(hfs) THEN 9527
  192. NEXT hfs
  193.  
  194. FOR hfs = 1 TO incondtot
  195. IF NOT inhistory(hfs, exx) = currin(hfs) THEN 9527
  196. NEXT hfs
  197. GOTO 4409
  198. 9527 NEXT exx
  199. newrecflag = 1
  200. GOTO 4544
  201.  
  202. 4409 newrecflag = 0  ' skip make new rec and numneed
  203. 4544 'new act and rec  ' below to stop record rec but cont to react, next dream!
  204. IF histeventnum > evrechardlimit - 2 THEN 4546
  205. histeventnum = histeventnum + 1
  206. 4546 GOSUB cleanrec
  207. FOR hfs = 1 TO incondtot
  208. inhistory(hfs, histeventnum) = currin(hfs)
  209. NEXT hfs
  210. IF currout(1) = 0 THEN PRINT " currout zero? ": STOP
  211. FOR hfs = 1 TO outcondtot
  212. outhistory(hfs, histeventnum) = currout(hfs)
  213. NEXT hfs
  214.  
  215. convcost(histeventnum) = enrgused
  216. goalval(histeventnum) = goalvalhold
  217. eventgrade2 = goalvalhold + enrgused
  218. IF NOT eventgrade2 = eventgrade THEN STOP
  219. COLOR flash, flashback: GOSUB box12
  220. IF freshmadex = disapearcode OR freshmadex = fleecode THEN 8789
  221. IF freshmade = 0 THEN GOTO 8789
  222. incondgift(objkey, freshmade) = incondgift(objkey, freshmade) + 1
  223. IF numneedon = 1 THEN numneed(histeventnum) = numneed(histeventnum) - 1
  224.  
  225. ' on top of below if no mm is 0 fm, below if fm is rec same as inconds
  226. FOR hfs = 1 TO incondtot
  227. byprod(hfs, histeventnum) = ramu(hfs)
  228. NEXT hfs
  229.  
  230. 'a new 1st creation of this obj 'main split here ' if falling thru then we have new OBJobj
  231. byprod(objkey, histeventnum) = freshmade
  232. IF freshmadex = disapearcode OR freshmadex = fleecode OR freshmadex = icc THEN 8789
  233. IF numneedon = 1 THEN numneed(histeventnum) = actmax
  234. sfor = inhistory(objkey, histeventnum): hdam = actmax:
  235. IF numneedon = 0 THEN actmax = 0
  236. IF retrogdupnn = 0 AND newrecflag = 0 THEN actmax = 0 ' activate this to prevent retro-grade of duplicate numneed
  237.  
  238. 9625 FOR eew = 1 TO histeventnum - 1
  239. IF sfor = byprod(objkey, eew) THEN numneed(eew) = numneed(eew) + actmax: sfor = inhistory(objkey, eew): GOTO 9625
  240. NEXT eew
  241. actmax = hdam
  242. GOTO 4545     ' if numneed skips retgrade since prod not yet goal valuble
  243.  
  244. 8789 'retrograde val to OBJobj chain
  245. FOR hfs = 1 TO incondtot
  246. findTHISbyprodall(hfs) = ramu(hfs)
  247. NEXT hfs
  248.  
  249. 3311 findTHISbyprod = currin(objkey)
  250. 3312 FOR fbi = 1 TO histeventnum - 1
  251. IF findTHISbyprod = icc THEN 4545
  252. IF findTHISbyprod = byprod(objkey, fbi) THEN 3313
  253. 3310 NEXT fbi
  254. GOTO 4545  'fall thru is not a known byprod, exit retrograde
  255.  
  256. 3313  IF matchallbyprod = 0 THEN 3314
  257. FOR hfs = 1 TO incondtot
  258. IF NOT ramu(hfs) = byprod(hfs, fbi) THEN 3310
  259. NEXT hfs
  260.  
  261. 3314 IF valdifxx + convcost(fbi) > prodval(fbi) THEN prodval(fbi) = valdifxx + convcost(fbi)
  262. valdifxx = prodval(fbi)
  263. findTHISbyprod = inhistory(objkey, fbi)
  264. IF matchallbyprod = 0 THEN 3312
  265.  
  266. FOR hfs = 1 TO incondtot
  267. findTHISbyprodall(hfs) = inhistory(hfs, fbi)
  268. NEXT hfs
  269. findTHISbyprod = findTHISbyprodall(objkey)
  270. GOTO 3312
  271.  
  272. 4545 ' end rec update
  273. IF crazyflag > 0 THEN czf(histeventnum) = crazyflag
  274. IF freshmadex > 0 THEN byprod(objkey, histeventnum) = freshmadex
  275. GOSUB prntcurr
  276. GOSUB dumpvals
  277. GOSUB getpartord
  278. GOSUB getpartordo
  279. IF histeventnum < 1 THEN 454
  280. IF noduprecs = 1 THEN 455
  281. 452 IF newrecflag = 0 THEN 453
  282. IF recvalonly = 0 THEN 454
  283. IF goalvalhold < recvalonly THEN 454
  284. IF goalvalhold > settlefor THEN 454
  285. IF NOT freshmade = 0 THEN 454
  286. 453 histeventnum = histeventnum - 1
  287. 454 FOR hfs = 1 TO incondtot
  288. currin(hfs) = ramu(hfs)
  289. NEXT hfs
  290.  
  291. IF suggflag = 0 AND crretflag = 0 THEN 63
  292.  
  293. DO: doj$ = INKEY$
  294. IF doj$ = "a" THEN crretflag = 0: GOTO 63
  295. LOOP UNTIL doj$ = CHR$(13)
  296.  
  297. 63 sugoflag = 0: sugiflag = 0: suggflag = 0' add opt to keep
  298. 414 manpicked = 0:
  299. GOTO 7777
  300. ' *****************    end mainline   *********************
  301.  
  302. 455 FOR exx = 1 TO histeventnum - 1
  303. FOR hfs = 1 TO outcondtot
  304. FOR coni = 1 TO incondtot    ' add swch later?
  305. IF condlinkfinal(coni) = hfs THEN 526
  306. NEXT coni
  307. IF NOT outhistory(hfs, exx) = currout(hfs) THEN 527
  308. 526 NEXT hfs
  309.  
  310. LOCATE 10, 1: PRINT goalval(exx); goalvalhold; currin(objkey); inhistory(objkey, exx); freshmade; byprod(objkey, exx)
  311. IF convcost(exx) = enrgused AND goalval(exx) = goalvalhold AND currin(objkey) = inhistory(objkey, exx) AND freshmade = byprod(objkey, exx) THEN 453
  312. IF convcost(exx) = enrgused AND goalval(exx) = goalvalhold AND currin(objkey) = inhistory(objkey, exx) AND freshmadex = byprod(objkey, exx) THEN 453
  313. 527 NEXT exx
  314. GOTO 452
  315.  
  316. simsel:
  317. IF sugoflag = 1 THEN RETURN
  318. IF histeventnum < 1 THEN RETURN
  319. COLOR flash, flashback: GOSUB box7
  320. IF goalvalflag = 0 AND prodvalflag = 0 AND byprodflag = 0 THEN 316
  321.  
  322. 315 FOR uhb = 1 TO incondtot
  323. srchE(uhb) = currin(uhb)
  324. NEXT uhb
  325.  
  326. REDIM t2(2, histeventnum + 1)
  327. bestyet = -99999: winner = 0: newlimit = histeventnum: stackcnt = 1: b1st = 1: b2nd = 2: cellcnt = 1
  328.  
  329. FOR ehd = 1 TO histeventnum: t2(b1st, ehd) = ehd: NEXT ehd
  330. FOR cellcnt = 1 TO incondtot
  331. FOR cy2 = 1 TO newlimit      ' sel either goalval or prodval as greater
  332. IF condlinkfinal(cellcnt) > 0 AND linkalways = 1 THEN GOTO 26
  333. IF goalval((t2(b1st, cy2))) + convcost((t2(b1st, cy2))) > prodval((t2(b1st, cy2))) AND inhistory((pinstk(cellcnt)), (t2(b1st, cy2))) = srchE(pinstk(cellcnt)) AND goalval((t2(b1st, cy2))) + convcost((t2(b1st, cy2))) > settlefor AND goalval((t2(b1st, cy2))) + convcost((t2(b1st, cy2))) > bestyet THEN t2(b2nd, stackcnt) = t2(b1st, cy2): stackcnt = stackcnt + 1: winner = (t2(b1st, cy2)): bestyet = goalval((t2(b1st, cy2))) + convcost((t2(b1st, cy2))): vflag = 1: GOTO 2388
  334. IF goalval((t2(b1st, cy2))) + convcost((t2(b1st, cy2))) = prodval((t2(b1st, cy2))) AND inhistory((pinstk(cellcnt)), (t2(b1st, cy2))) = srchE(pinstk(cellcnt)) AND goalval((t2(b1st, cy2))) + convcost((t2(b1st, cy2))) > settlefor AND goalval((t2(b1st, cy2))) + convcost((t2(b1st, cy2))) > bestyet THEN t2(b2nd, stackcnt) = t2(b1st, cy2): stackcnt = stackcnt + 1: winner = (t2(b1st, cy2)): bestyet = goalval((t2(b1st, cy2))) + convcost((t2(b1st, cy2))): vflag = 1
  335. IF prodval((t2(b1st, cy2))) > goalval((t2(b1st, cy2))) + convcost((t2(b1st, cy2))) AND inhistory((pinstk(cellcnt)), (t2(b1st, cy2))) = srchE(pinstk(cellcnt)) AND prodval((t2(b1st, cy2))) > settlefor AND prodval((t2(b1st, cy2))) > bestyet THEN t2(b2nd, stackcnt) = t2(b1st, cy2): stackcnt = stackcnt + 1: winner = (t2(b1st, cy2)): bestyet = prodval((t2(b1st, cy2))): vflag = 1
  336. 2388 NEXT cy2
  337.  
  338. 3444 IF vflag = 0 THEN 3556
  339. IF b1st = 1 THEN b1st = 2: b2nd = 1: GOTO 6036
  340. b1st = 1: b2st = 2
  341. 6036  newlimit = stackcnt
  342. stackcnt = 1: vflag = 0
  343. 3556 NEXT cellcnt
  344.  
  345. IF winner = 0 THEN RETURN
  346. COLOR flash, flashback: GOSUB box8
  347. FOR wsx = 1 TO outcondtot
  348. currout(wsx) = outhistory(wsx, winner)
  349. NEXT wsx
  350.  
  351. COLOR green, 0: LOCATE 3, 1: PRINT winner; "  ";
  352. FOR yt = 1 TO incondtot
  353. PRINT inhistory(yt, winner);
  354. NEXT yt
  355. PRINT "  ";
  356. FOR yt = 1 TO outcondtot
  357. PRINT outhistory(yt, winner);
  358. NEXT yt
  359. PRINT " "
  360. COLOR yel, 0: LOCATE 4, 1: PRINT cy1; cy2; "  "; goalval(winner); prodval(winner); numneed(winner); "  "; convcost(winner); byprod(objkey, winner)
  361. 316 RETURN
  362.  
  363. 26 IF goalval((t2(b1st, cy2))) + convcost((t2(b1st, cy2))) > prodval((t2(b1st, cy2))) AND goalval((t2(b1st, cy2))) + convcost((t2(b1st, cy2))) > settlefor AND goalval((t2(b1st, cy2))) + convcost((t2(b1st, cy2))) > bestyet THEN t2(b2nd, stackcnt) = t2(b1st, cy2): stackcnt = stackcnt + 1: winner = (t2(b1st, cy2)): bestyet = goalval((t2(b1st, cy2))) + convcost((t2(b1st, cy2))): vflag = 1: GOTO 2388
  364. IF goalval((t2(b1st, cy2))) + convcost((t2(b1st, cy2))) = prodval((t2(b1st, cy2))) AND goalval((t2(b1st, cy2))) + convcost((t2(b1st, cy2))) > settlefor AND goalval((t2(b1st, cy2))) + convcost((t2(b1st, cy2))) > bestyet THEN t2(b2nd, stackcnt) = t2(b1st, cy2): stackcnt = stackcnt + 1: winner = (t2(b1st, cy2)): bestyet = goalval((t2(b1st, cy2))) + convcost((t2(b1st, cy2))): vflag = 1
  365. IF prodval((t2(b1st, cy2))) > goalval((t2(b1st, cy2))) + convcost((t2(b1st, cy2))) AND prodval((t2(b1st, cy2))) > settlefor AND prodval((t2(b1st, cy2))) > bestyet THEN t2(b2nd, stackcnt) = t2(b1st, cy2): stackcnt = stackcnt + 1: winner = (t2(b1st, cy2)): bestyet = prodval((t2(b1st, cy2))): vflag = 1
  366. GOTO 2388
  367.  
  368. simnn:
  369. IF numneedon = 0 OR sugoflag = 1 THEN RETURN
  370. IF histeventnum < 1 THEN RETURN
  371. COLOR flash, flashback: GOSUB box7
  372. IF prodvalflag = 0 AND byprodflag = 0 THEN 716
  373. FOR uhb = 1 TO incondtot
  374. srchE(uhb) = currin(uhb)
  375. NEXT uhb
  376.  
  377. REDIM t2(2, histeventnum + 1)
  378. bestyet = -8844: winner = 0
  379. newlimit = histeventnum: stackcnt = 1: b1st = 1: b2nd = 2: cellcnt = 1
  380.  
  381. FOR ehd = 1 TO histeventnum: t2(b1st, ehd) = ehd: NEXT ehd
  382. FOR cellcnt = 1 TO incondtot
  383. FOR cy2 = 1 TO newlimit     ' sel either goalval or prodval as greater
  384. IF inhistory(1, (t2(b1st, cy2))) = 0 THEN 5388 ' necc?
  385. IF condlinkfinal(cellcnt) > 0 AND linkalways = 1 THEN GOTO 36
  386. IF inhistory((pinstk(cellcnt)), (t2(b1st, cy2))) = srchE(pinstk(cellcnt)) AND numneed((t2(b1st, cy2))) > 0 THEN t2(b2nd, stackcnt) = t2(b1st, cy2): stackcnt = stackcnt + 1: winner = (t2(b1st, cy2)): vflag = 1: GOTO 5388
  387. 5388 NEXT cy2
  388.  
  389. 5444 IF vflag = 0 THEN 7556
  390. IF b1st = 1 THEN b1st = 2: b2nd = 1: GOTO 5036
  391. b1st = 1: b2st = 2
  392. 5036  newlimit = stackcnt
  393. stackcnt = 1
  394. vflag = 0
  395. 7556 NEXT cellcnt
  396.  
  397. IF winner = 0 THEN RETURN
  398. COLOR flash, flashback: GOSUB box8
  399. FOR uhb = 1 TO outcondtot
  400. currout(uhb) = outhistory(uhb, winner)
  401. NEXT uhb
  402.  
  403. COLOR lmag, 0: LOCATE 5, 1
  404. PRINT winner; "  ";
  405. FOR yt = 1 TO incondtot
  406. PRINT inhistory(yt, winner);
  407. NEXT yt
  408. PRINT "  ";
  409. FOR yt = 1 TO outcondtot
  410. PRINT outhistory(yt, winner);
  411. NEXT yt
  412. PRINT " "
  413. COLOR lblue, 0: LOCATE 6, 1: PRINT cy1; cy2; "  "; goalval(winner); prodval(winner); numneed(winner); "  "; convcost(winner); byprod(objkey, winner)
  414. 716 RETURN
  415.  
  416. 36 IF numneed((t2(b1st, cy2))) > 0 THEN t2(b2nd, stackcnt) = t2(b1st, cy2): stackcnt = stackcnt + 1: winner = (t2(b1st, cy2)): vflag = 1: GOTO 5388
  417. GOTO 5388
  418.  
  419. defaultpp:
  420. FOR ijn = 1 TO incondtot
  421. pinstk(ijn) = ijn
  422. NEXT ijn
  423. RETURN
  424.  
  425. defaultppok:
  426. pinstk(1) = objkey
  427. RETURN
  428.  
  429. getpartord:
  430. IF histeventnum < 3 THEN RETURN
  431. IF prodvalflag = 0 AND goalvalflag = 0 AND byprodflag = 0 THEN GOSUB defaultpp: GOTO 2037
  432. IF compglobalppflag = 1 THEN 8404
  433. REDIM ippnt(incondtot)
  434. 8404 FOR ii = 1 TO incondtot: rvr(ii) = ii: NEXT ii
  435.  
  436. FOR rvcnt = 1 TO incondtot
  437. IF compglobalppflag = 1 THEN mse = histeventnum: GOTO 8405
  438. FOR mse = 1 TO histeventnum     'grab a search record
  439. 8405 FOR foc = 1 TO histeventnum  'look at all else
  440. IF foc = mse THEN 117
  441. IF calcnnppalso = 1 AND numneed(foc) > 0 THEN 127
  442. IF calcpospponly = 1 AND prodval(foc) < 1 AND goalval(foc) + convcost(foc) < settlefor THEN 117
  443. IF calcpospponly = 2 AND prodval(foc) < 1 AND goalval(foc) + convcost(foc) < 0 THEN 117
  444. 127 IF inhistory((rvr(1)), mse) = inhistory((rvr(1)), foc) THEN 117
  445.  
  446. FOR jgd = 2 TO incondtot
  447. IF NOT inhistory((rvr(jgd)), mse) = inhistory((rvr(jgd)), foc) OR NOT goalval(mse) + convcost(mse) = goalval(foc) + convcost(foc) OR NOT byprod(objkey, mse) = byprod(objkey, foc) THEN 117 ' NEXT foc
  448. NEXT jgd 'fall thru is an isomer particle of the search rec (mse)
  449.  
  450. ippnt(rvr(1)) = ippnt(rvr(1)) + 1
  451. 117 NEXT foc
  452. IF compglobalppflag = 1 THEN 8406
  453. NEXT mse
  454.  
  455. 8406 FOR rx = 1 TO incondtot  'turn ip revolver
  456. rvr(rx) = rvr(rx) + 1:
  457. IF rvr(rx) > incondtot THEN rvr(rx) = 1
  458. 119 NEXT rx
  459. NEXT rvcnt
  460.  
  461. FOR lll = 1 TO incondtot
  462. ippntdv(lll) = ippnt(lll)
  463. IF inpartspectrumtot(lll) = 0 THEN 16
  464. ippntdv(lll) = ippntdv(lll) / inpartspectrumtot(lll)
  465. 16 winstkdv(lll) = winstk(lll)
  466. NEXT lll
  467. LOCATE 1, 1
  468.  
  469. FOR lat = 1 TO incondtot
  470. COLOR 0, green
  471. PRINT ippnt(lat);
  472. COLOR 0, white
  473. PRINT ippntdv(lat);
  474. COLOR 0, brown
  475. PRINT inpartspectrumtot(lat);
  476. NEXT lat
  477.  
  478. FOR wee = 1 TO incondtot    ' stack conditions in pri order
  479. ipbest = 999933: ipwin = 0
  480.  
  481. FOR ooy = 1 TO incondtot
  482. IF ippntdv(ooy) < ipbest THEN ipbest = ippntdv(ooy): ipwin = ooy
  483. NEXT ooy
  484.  
  485. winstkdv(wee) = ipwin: ippntdv(ipwin) = 999933
  486. NEXT wee
  487.  
  488. 'fall thru with pripart in winstk(1)etc...
  489. IF usevalppflag = 0 THEN RETURN
  490. IF beginpp > histeventnum THEN RETURN
  491.  
  492. FOR mmm = 1 TO incondtot
  493. pinstk(mmm) = winstkdv(mmm)
  494. NEXT mmm
  495. 2037
  496.  
  497. LOCATE 7, 1: COLOR lcyan, 0
  498. PRINT "                                            "
  499. LOCATE 7, 1: COLOR lcyan, 0
  500. FOR wx = 1 TO incondtot
  501. PRINT pinstk(wx);
  502. NEXT wx
  503. IF ippnt(objkey) = 0 OR forceobjkeypp = 1 THEN GOSUB defaultppok
  504. RETURN
  505.  
  506. defaultppo:
  507. FOR ijn = 1 TO outcondtot
  508. poutstk(ijn) = ijn
  509. NEXT ijn
  510. actkey = 1
  511. poutstk(1) = actkey
  512. RETURN
  513.  
  514. getpartordo:
  515. IF histeventnum < 3 THEN RETURN
  516. IF prodvalflag = 0 AND goalvalflag = 0 AND byprodflag = 0 THEN GOSUB defaultppo: GOTO 9037
  517. IF compglobalppflag = 1 THEN 9404
  518. REDIM oppnt(outcondtot)
  519. 9404 FOR ii = 1 TO outcondtot: rvr(ii) = ii: NEXT ii
  520.  
  521. FOR rvcnt = 1 TO outcondtot
  522. IF compglobalppflag = 1 THEN mse = histeventnum: GOTO 9405
  523. FOR mse = 1 TO histeventnum     'grab a search record
  524. 9405 FOR foc = 1 TO histeventnum  'look at all else
  525. IF foc = mse THEN 917
  526. IF calcnnppalso = 1 AND numneed(foc) > 0 THEN 927
  527. IF calcpospponly = 1 AND prodval(foc) < 1 AND goalval(foc) + convcost(foc) < settlefor THEN 917
  528. IF calcpospponly = 2 AND prodval(foc) < 1 AND goalval(foc) + convcost(foc) < 0 THEN 917
  529. 927 IF outhistory((rvr(1)), mse) = outhistory((rvr(1)), foc) THEN 917
  530.  
  531. FOR jgd = 2 TO outcondtot
  532. IF NOT outhistory((rvr(jgd)), mse) = outhistory((rvr(jgd)), foc) OR NOT goalval(mse) = goalval(foc) OR NOT byprod(objkey, mse) = byprod(objkey, foc) THEN 917 ' NEXT foc
  533. NEXT jgd 'fall thru is an isomer particle of the search rec (mse)
  534.  
  535. oppnt(rvr(1)) = oppnt(rvr(1)) + 1
  536.  
  537. 917 NEXT foc
  538. IF compglobalppflag = 1 THEN 9406
  539. NEXT mse
  540.  
  541. 9406 FOR rx = 1 TO outcondtot  'turn ip revolver
  542. rvr(rx) = rvr(rx) + 1
  543. IF rvr(rx) > outcondtot THEN rvr(rx) = 1
  544. 919 NEXT rx
  545. NEXT rvcnt
  546.  
  547. FOR lll = 1 TO outcondtot
  548. oppntdv(lll) = oppnt(lll)
  549. IF outpartspectrumtot(lll) = 0 THEN 169    'in case corrupt file
  550. oppntdv(lll) = oppntdv(lll) / outpartspectrumtot(lll)
  551. 169 owinstkdv(lll) = owinstk(lll)
  552. NEXT lll
  553. LOCATE 11, 1
  554.  
  555. FOR lat = 1 TO outcondtot
  556. COLOR 4, green
  557. PRINT oppnt(lat);
  558. COLOR 4, white
  559. PRINT oppntdv(lat);
  560. COLOR 4, brown
  561. PRINT outpartspectrumtot(lat);
  562. NEXT lat
  563.  
  564. FOR wee = 1 TO outcondtot    ' stack conditions in pri order
  565. ipbest = 999933: ipwin = 0
  566.  
  567. FOR ooy = 1 TO outcondtot
  568. IF oppntdv(ooy) < ipbest THEN ipbest = oppntdv(ooy): ipwin = ooy
  569. NEXT ooy
  570.  
  571. owinstkdv(wee) = ipwin: oppntdv(ipwin) = 999933
  572. NEXT wee
  573.  
  574. 'fall thru with pripart in owinstk(1)etc...
  575. IF usevalppflag = 0 THEN RETURN
  576. IF beginpp > histeventnum THEN RETURN
  577. FOR mmm = 1 TO outcondtot
  578. poutstk(mmm) = owinstkdv(mmm)
  579. NEXT mmm
  580. LOCATE 8, 1: COLOR lred, 0
  581. 9037 FOR wx = 1 TO outcondtot
  582. PRINT poutstk(wx);
  583. NEXT wx
  584. RETURN
  585.  
  586. ttt:
  587. GOSUB tttset
  588. 96 hu = (INT(RND * 9) + 1)
  589. IF NOT t(hu) = 3 THEN 96
  590. t(hu) = 2
  591. FOR tts = 1 TO 9
  592. currin(tts) = t(tts)
  593. NEXT tts
  594. RETURN
  595.  
  596. setusercond:   '******  INTERFACE TERMINAL # 1 _ Sensors - IN conditions  ******
  597. IF sugiflag = 1 THEN RETURN
  598. IF tttflag = 1 THEN GOSUB ttt: RETURN
  599. IF appearnowonly = 1 THEN RETURN
  600. setusercondbypass:
  601. FOR lkj = 1 TO incondtot
  602. currin(lkj) = FIX(RND * inpartspectrumtot(lkj)) + 1
  603. NEXT lkj
  604.  
  605. 307 currin(objkey) = INT(RND * inpartspectrumtot(objkey)) + 1
  606. COLOR 6, 0: LOCATE 14, 1
  607. PRINT currin(objkey); freshmade; incondgift(objkey, (currin(objkey))); inpartspectrumtot(objkey)
  608. IF incondgift(objkey, (currin(objkey))) < 1 THEN 307
  609. IF appearnow = 1 AND NOT prodlink = 0 THEN currin(objkey) = prodlink
  610. prodlink = 0
  611. 807 RETURN
  612.  
  613. randaction:
  614. IF sugoflag = 1 THEN RETURN
  615. FOR lkj = 1 TO outcondtot
  616. currout(lkj) = FIX(RND * outpartspectrumtot(lkj)) + 1
  617. NEXT lkj
  618. RETURN
  619.  
  620. useru:
  621. CLS : COLOR 4, black
  622. PRINT "     Begin Universe creation sequence."
  623. PRINT "     To answer a yes-or-no question, use...  [cr] for yes.  n for no."
  624. PRINT " "
  625. INPUT "         Which is the main incoming condition in this universe"; objkey
  626. PRINT #1, 99766; objkey
  627.  
  628. FOR condcnt = 1 TO incondtot + 1
  629. PRINT #1, 99999
  630. PRINT ""
  631. PRINT #1, condcnt
  632.  
  633. FOR objccode = 1 TO inparthardlimit + 1
  634. PRINT ""
  635. PRINT #1, 99222; objccode
  636. IF objccode > 1 THEN 6704
  637. INPUT " Creators reference name for this IN condition field"; inconddiscribe$(condcnt)
  638. INPUT "   Prefix for this field in the event read out"; befincondtext$(condcnt)
  639. INPUT "   Suffix for this field in the event read out"; aftincondtext$(condcnt)
  640. WRITE #1, inconddiscribe$(condcnt), befincondtext$(condcnt), aftincondtext$(condcnt)
  641. 6704 PRINT "               "; objccode - 1; "objects defined so far."; : INPUT " Create another object.."; anser$
  642. PRINT ""
  643. IF anser$ = "n" THEN 7492
  644. IF anser$ = "x" THEN objccode = objccode - 1
  645. INPUT "                            Object name"; objname$(condcnt, objccode)
  646. IF NOT condcnt = objkey THEN 7431
  647. 473 IF condcnt = objkey THEN INPUT " How many of this object occur naturally in the opening universe"; incondgift(condcnt, objccode)
  648. IF condcnt = objkey THEN 7431
  649. PRINT #1, incondfreq(condcnt, objccode);  ' being skipped always
  650. 7431 WRITE #1, objname$(condcnt, objccode), spr(condcnt, objccode), spr(condcnt, objccode), spr(condcnt, objccode), incondgift(condcnt, objccode), incondord(condcnt, objccode)
  651. PRINT ""
  652. NEXT objccode
  653.  
  654. 7492 inpartspectrumtot(condcnt) = objccode - 1 'added - 1 v1360 ???
  655. PRINT "               "; condcnt; "INconds defined so far."; : INPUT " Create another INcond.."; anser$
  656. PRINT ""
  657. IF anser$ = "n" THEN 8431
  658. IF anser$ = "z" THEN intrmflag = 1: GOTO 8422
  659. IF anser$ = "x" THEN condcnt = condcnt - 1
  660. NEXT condcnt
  661.  
  662. 8431 CLS
  663. incondtot = condcnt
  664. PRINT #1, 99999
  665. PRINT #1, 44444
  666. qxflag = 1
  667. GOSUB dumpuser
  668. qxflag = 0: CLS
  669.  
  670. FOR condcnt = 1 TO outcondtot + 1
  671. COLOR 2, black
  672. PRINT ""
  673. WRITE #1, 99755, condcnt
  674.  
  675. FOR actccode = 1 TO outparthardlimit + 1
  676. WRITE #1, 99744, actccode
  677. IF actccode > 1 THEN 2704
  678. INPUT " Creators reference name for this OUT condition field"; outconddiscribe$(condcnt)
  679. INPUT "   Prefix for this field in the event read out"; befoutcondtext$(condcnt)
  680. INPUT "   Suffix for this field in the event read out"; aftoutcondtext$(condcnt)
  681. WRITE #1, outconddiscribe$(condcnt), befoutcondtext$(condcnt), aftoutcondtext$(condcnt)
  682. 2704 PRINT "               "; actccode - 1; "actions defined so far."; : INPUT " Create another action.."; anser$
  683. PRINT ""
  684. IF anser$ = "n" THEN 4431
  685. IF anser$ = "x" THEN actccode = actccode - 1
  686. INPUT "                            action name"; actname$(condcnt, actccode)
  687. IF NOT condcnt = 1 THEN 4418 ' act(1) will be like objkey soon
  688. 4418 INPUT " What is the Creator assigned value units cost of this action"; actenrgused(condcnt, actccode)
  689. WRITE #1, actname$(condcnt, actccode), spr(condcnt, actccode), spr(condcnt, actccode), spr(condcnt, actccode), actenrgused(condcnt, actccode)
  690. PRINT ""
  691. NEXT actccode
  692.  
  693. 4431 outpartspectrumtot(condcnt) = actccode - 1
  694. PRINT "               "; condcnt; "OUTconds defined so far."; : INPUT " Create another OUTcond.."; anser$
  695. PRINT ""
  696. IF anser$ = "n" THEN 1431
  697. IF anser$ = "z" THEN intrmflag = 1: GOTO 8422
  698. IF anser$ = "x" THEN condcnt = condcnt - 1
  699. NEXT condcnt
  700.  
  701. 1431 outcondtot = condcnt: CLS
  702. 6307 COLOR yel, 0
  703. GOSUB dumpuser
  704.  
  705. FOR rrec = 1 TO lawshardlimit + 1
  706. WRITE #1, 3333, rrec
  707. PRINT "               "; rrec - 1; "laws defined so far."; : INPUT " Create another law of universe.."; anser$
  708. PRINT ""
  709. IF anser$ = "n" THEN 2431
  710.  
  711. 3760 FOR tfc = 1 TO incondtot
  712. PRINT befincondtext$(tfc); aftincondtext$(tfc); inconddiscribe$(tfc)
  713.  
  714. 3768 PRINT "    Select object, l to link, or enter to include all objects in this law."
  715. INPUT "                            object"; hold$
  716. IF hold$ = "" THEN rrin(tfc, rrec) = icc: GOTO 1768
  717. IF hold$ = "l" THEN GOSUB assoconditionin: GOTO 1768 'link to opt
  718.  
  719. FOR mbc = 1 TO inpartspectrumtot(tfc)
  720. IF hold$ = objname$(tfc, mbc) THEN holdc = mbc: GOTO 3762
  721. NEXT mbc
  722. PRINT "Object not defined, spaces and cases must match.": GOTO 3768
  723. 3762 rrin(tfc, rrec) = holdc
  724. 1768 NEXT tfc
  725.  
  726. 1760 FOR tfc = 1 TO outcondtot
  727. PRINT befoutcondtext$(tfc); aftoutcondtext$(tfc); outconddiscribe$(tfc)
  728. 1788 PRINT "    Select action, l to link, or enter to include all actions in this law."
  729. INPUT "                            action "; hold$
  730. IF hold$ = "" THEN rrout(tfc, rrec) = icc: GOTO 1766
  731. IF hold$ = "l" THEN GOSUB assoconditionout: GOTO 1766
  732.  
  733. FOR mbc = 1 TO outpartspectrumtot(tfc)     ' spectrunlimit (range) of the this cond
  734. IF hold$ = actname$(tfc, mbc) THEN holdc = mbc: GOTO 1762
  735. NEXT mbc
  736. PRINT "Action not defined, spaces and cases must match.": GOTO 1788
  737. 1762 rrout(tfc, rrec) = holdc
  738. 1766 NEXT tfc
  739.  
  740. 2944 INPUT "                 Value to this event"; valaug(rrec)   '
  741. 6760 h = 0: INPUT "    Object created from this event; d to disappear, f to flee"; hold$
  742. IF hold$ = "" THEN mmgrant(rrec) = 0: GOTO 6768
  743. IF hold$ = "d" THEN mmgrant(rrec) = disapearcode: GOTO 6768
  744. IF hold$ = "f" THEN mmgrant(rrec) = fleecode: GOTO 6768
  745.  
  746. 9 IF matchallbyprod = 1 THEN INPUT "    Condition number of metmo"; h
  747. IF h = 0 THEN 98
  748. IF h < 1 OR h > incondtot THEN 9
  749. objkey = h ' changes objkey until next non zero entry in h
  750.  
  751. 98 FOR mbc = 1 TO inpartspectrumtot(objkey)
  752. IF hold$ = objname$(objkey, mbc) THEN holdc = mbc: GOTO 6762
  753. NEXT mbc
  754.  
  755. PRINT "Object not defined": GOTO 6760
  756. 6762 mmgrant(rrec) = holdc
  757. mmkey(rrec) = objkey
  758.  
  759. PRINT ""
  760. 6768 WRITE #1, 8876, incondtot
  761. FOR xfc = 1 TO incondtot
  762. PRINT #1, rrin(xfc, rrec);
  763. NEXT xfc
  764. WRITE #1, 6876, outcondtot
  765. FOR xfc = 1 TO outcondtot
  766. PRINT #1, rrout(xfc, rrec);
  767. NEXT xfc
  768.  
  769. WRITE #1, valaug(rrec), mmkey(rrec), mmgrant(rrec)
  770. NEXT rrec
  771.  
  772. 2431 WRITE #1, 868699
  773. GOSUB writeswch
  774. comandtot = rrec - 1  'ck last comand in??
  775. CLOSE
  776. COLOR lmag, 0
  777. GOSUB dumpuser
  778. GOSUB setactmax
  779. IF likelinks = 1 THEN GOSUB findlikelinks
  780. RETURN
  781.  
  782. assoconditionin:
  783. INPUT "Associate this with which out cond"; rrin(tfc, rrec)
  784. rrin(tfc, rrec) = rrin(tfc, rrec) * -1
  785. RETURN
  786. assoconditionout:
  787. INPUT "Associate this with which in cond"; rrout(tfc, rrec)
  788. rrout(tfc, rrec) = rrout(tfc, rrec) * -1
  789. RETURN
  790.  
  791. setactmax:
  792. keepw = 1
  793. FOR okm = 1 TO outcondtot
  794. IF outpartspectrumtot(okm) = 0 THEN 2253
  795. actmax = outpartspectrumtot(okm) * keepw: keepw = actmax
  796. 2253 NEXT okm
  797. IF actmax > actmaxlimit THEN actmax = actmaxlimit
  798. RETURN
  799.  
  800. readfile:
  801. INPUT "Enter Filename: "; b$
  802. readfilex:
  803. 2631 OPEN b$ FOR INPUT AS #1
  804. 267 INPUT #1, a
  805. IF a = 99766 THEN GOSUB setobjkey: GOTO 268
  806. GOTO 267
  807.  
  808. getswch:
  809. INPUT #1, histeventnum, prodvalflag, goalvalflag, byprodflag, actmax, toglrf
  810. INPUT #1, dominaterndflag, bailaftmmordisapr, forcefieldlink, actmaxlimit, settlefor, evrechardlimit, incondtot, outcondtot, inparthardlimit, outparthardlimit, lawshardlimit, evcnt, nodefaultflag, tttflag, rndrate, calcpospponly, calcnnppalso, usevalppflag, compglobalppflag, simnnon, beginpp, boxstall, noduprecs, useppout, bailaftval, fulpartrnd, maxminmute, linktrys, likelinks, simselon, linkalways, dominaterndrate, rndsimnnrate, numneedon, comandtot, rndrndon, rndrndstop, rndwithevnum, rndtop, supcnd, forceobjkeypp, recvalonly, appearnowonly, appearnow, matchallbyprod, retrogdupnn
  811. RETURN
  812.  
  813. 268
  814. IF a = 99999 THEN GOSUB newincond
  815. IF a = 99222 THEN GOSUB newinpart
  816. IF a = 99755 THEN GOSUB newoutcond
  817. IF a = 99744 THEN GOSUB newoutpart
  818. IF a = 3333 THEN GOSUB newlaw
  819. IF a = 8876 THEN GOSUB inlaws
  820. IF a = 6876 THEN GOSUB outlaws
  821. IF a = 868699 THEN GOSUB getswch: CLOSE : GOTO 269
  822. GOTO 268
  823.  
  824. 269 comandtot = rrec
  825. GOSUB setactmax
  826. IF likelinks = 1 THEN GOSUB findlikelinks
  827. RETURN
  828.  
  829. findlikelinks:
  830. FOR cono = 1 TO outcondtot
  831. FOR coni = 1 TO incondtot
  832. hldtot = 0
  833. FOR prti = 1 TO inpartspectrumtot(coni)
  834. FOR prto = 1 TO outpartspectrumtot(cono)
  835. IF objname$(coni, prti) = actname$(cono, prto) THEN hldtot = hldtot + 1
  836. NEXT prto
  837. NEXT prti
  838. conlink(coni, cono) = hldtot
  839. NEXT coni
  840. NEXT cono
  841.  
  842. FOR coni = 1 TO incondtot
  843. FOR cono = 1 TO outcondtot
  844. NEXT cono
  845. NEXT coni
  846. FOR coni = 1 TO incondtot
  847. bestt = 0: winz = 0
  848. FOR cono = 1 TO outcondtot
  849. IF conlink(coni, cono) > bestt THEN bestt = conlink(coni, cono): winz = cono
  850. NEXT cono
  851. condlinkfinal(coni) = winz
  852. NEXT coni
  853. FOR coni = 1 TO incondtot
  854. NEXT coni
  855. RETURN
  856.  
  857. setobjkey:
  858. INPUT #1, objkey
  859. INPUT #1, a
  860. RETURN
  861.  
  862. newincond:
  863. INPUT #1, b
  864. IF b = 99755 THEN 5902
  865. IF b = 44444 THEN incondtot = condcnt - 1: GOTO 5901
  866. condcnt = b
  867. 5901 INPUT #1, a
  868. 5902 RETURN
  869.  
  870. newoutcond:
  871. INPUT #1, condcnt
  872. INPUT #1, a
  873. RETURN
  874. INPUT #1, a
  875.  
  876. newinpart:
  877. INPUT #1, objccode
  878. IF objccode = 1 THEN INPUT #1, inconddiscribe$(condcnt), befincondtext$(condcnt), aftincondtext$(condcnt)
  879. INPUT #1, obn$
  880. IF obn$ = "99999" THEN a = 99999: inpartspectrumtot(condcnt) = objccode - 1: GOTO 6204
  881. INPUT #1, spr(condcnt, objccode), spr(condcnt, objccode), spr(condcnt, objccode), incondgift(condcnt, objccode), incondord(condcnt, objccode)
  882. objname$(condcnt, objccode) = obn$
  883. INPUT #1, a
  884. 6204 RETURN
  885.  
  886. newoutpart:
  887. INPUT #1, actccode
  888. IF actccode = 1 THEN INPUT #1, outconddiscribe$(condcnt), befoutcondtext$(condcnt), aftoutcondtext$(condcnt)
  889. INPUT #1, obn$
  890. IF obn$ = "99755" THEN a = 99755: outpartspectrumtot(condcnt) = actccode - 1: GOTO 6207
  891. IF obn$ = "3333" THEN a = 3333: outpartspectrumtot(condcnt) = actccode - 1: GOTO 6207
  892. INPUT #1, spr(condcnt, actccode)
  893. INPUT #1, spr(condcnt, actccode)
  894. INPUT #1, spr(condcnt, actccode)
  895. INPUT #1, actenrgused(condcnt, actccode)
  896. actname$(condcnt, actccode) = obn$
  897. INPUT #1, a
  898. 6207 RETURN
  899.  
  900. newlaw:
  901. INPUT #1, rrec
  902. INPUT #1, a
  903. RETURN
  904.  
  905. inlaws:
  906. INPUT #1, incondtot
  907. FOR xfc = 1 TO incondtot
  908. INPUT #1, rrin(xfc, rrec)
  909. NEXT xfc
  910. INPUT #1, a
  911. RETURN
  912.  
  913. outlaws:
  914. INPUT #1, outcondtot
  915. FOR xfc = 1 TO outcondtot
  916. INPUT #1, rrout(xfc, rrec)
  917. NEXT xfc
  918.  
  919. INPUT #1, valaug(rrec), mmkey(rrec), mmgrant(rrec)
  920. INPUT #1, a
  921. RETURN
  922.  
  923. openmenu:
  924. 8422 COLOR lred, yel
  925. CLS
  926. COLOR dblue, yel
  927. PRINT ""
  928. PRINT "                                   AI~WHEEL"
  929. COLOR dblue, yel
  930. PRINT "                     -----------  Main  Menu  -----------"
  931. COLOR white, yel
  932. PRINT "                     Create your own Universe    .unv  (c)"
  933. PRINT "                     Load Universe from Disk     .unv  (d)"
  934. PRINT "                     Load Intelligence from Disk .int  (u)"
  935. PRINT "                     Save Intelligence to Disk   .int  (j)"
  936. PRINT "                     Print Universe to Disk      .txt  (t)"
  937. PRINT "                     Print History to file       .txt  (f)"
  938. 'PRINT "                     Sound         Off (o)             (s)"
  939. PRINT "                     Back to Current universe          (b)"
  940. PRINT "                     Suggest an Encounter              (e)"
  941. PRINT "                     Suggest an Action                 (x)"
  942. PRINT "                     Force Link of UnEqual I/O Conds.  (F)"
  943. PRINT "                     Hardware Limits Menu              (h)"
  944. PRINT "                     Set User Parameters               (m)"
  945. COLOR blue, yel
  946. PRINT "                       Select an AUTO Universe (optional)"
  947. PRINT "          1 for cmpxlife.unv   2 for farmer.unv     3 for simplife.unv"
  948. PRINT "          4 for at-gaurd.unv   5 for roboship.unv   6 for easytest.unv"
  949. PRINT "                                                   (use Default Alt #1)"
  950. COLOR red, yel
  951. PRINT "                    Then Select Some Intelligence (optional)"
  952. PRINT "          A for cmpxlife.int   B for farmer.int     C for simplife.int"
  953. PRINT "          D for at-guard.int   E for roboship.int   G for easytest.int"
  954. COLOR dblue, yel
  955. PRINT "                     RESET to NEW AI~WHEEL             (r)"
  956. PRINT "                     Quit ---------------------------- (q)"
  957. 7127 DO
  958. choice0$ = INKEY$
  959. IF choice0$ = "s" THEN z = 1: soundflag = 1
  960. IF choice0$ = "o" THEN z = 0: soundflag = 0
  961. IF choice0$ = "c" THEN userflag = 1: manu = 1: GOTO 7025
  962. IF choice0$ = "4" THEN b$ = "at-guard.unv": GOSUB readfilex: GOTO 7126
  963. IF choice0$ = "2" THEN b$ = "farmer.unv": GOSUB readfilex: GOTO 7126
  964. IF choice0$ = "3" THEN b$ = "simplife.unv": GOSUB readfilex: GOTO 7126
  965. IF choice0$ = "1" THEN b$ = "cmpxlife.unv": GOSUB readfilex: GOTO 7126
  966. IF choice0$ = "5" THEN b$ = "roboship.unv": GOSUB readfilex: GOTO 7126
  967. IF choice0$ = "6" THEN b$ = "easytest.unv": GOSUB readfilex: GOTO 7126
  968. 'IF choice0$ = "0" THEN b$ = "ttt.unv": GOSUB readfilex: GOTO 7126
  969. IF choice0$ = "G" THEN n$ = "easytest.int": GOSUB upbrainsb: choice0$ = "b"
  970. IF choice0$ = "A" THEN n$ = "cmpxlife.int": GOSUB upbrainsb: choice0$ = "b"
  971. IF choice0$ = "D" THEN n$ = "at-guard.int": GOSUB upbrainsb: choice0$ = "b"
  972. IF choice0$ = "B" THEN n$ = "farmer.int": GOSUB upbrainsb: choice0$ = "b"
  973. IF choice0$ = "C" THEN n$ = "simplife.int": GOSUB upbrainsb: choice0$ = "b"
  974. IF choice0$ = "E" THEN n$ = "roboship.int": GOSUB upbrainsb: choice0$ = "b"
  975. IF choice0$ = "r" THEN RUN
  976. IF choice0$ = "d" THEN userflagx = 1: manu = 1: GOSUB readfile
  977. IF choice0$ = "t" THEN GOSUB dumpuserf
  978. 8 IF choice0$ = "b" THEN COLOR 0, 0: CLS : GOSUB drawcirt: GOSUB sig: GOTO 7777
  979. IF choice0$ = "f" THEN GOSUB prntcurrf
  980. IF choice0$ = "m" THEN GOSUB menusub2: GOTO 8422
  981. IF choice0$ = "h" THEN GOSUB menusub3: GOTO 8422
  982. IF choice0$ = "e" THEN suggflag = 1: GOSUB sugi: GOTO 8422
  983. IF choice0$ = "x" THEN suggflag = 1: GOSUB sugo: GOTO 8422
  984. IF choice0$ = "j" THEN GOSUB dumpbrains
  985. IF choice0$ = "u" THEN GOSUB upbrains
  986. IF choice0$ = "F" THEN GOSUB forcefalselink
  987. LOOP UNTIL choice0$ = "q"
  988. END
  989.  
  990. 7126 IF intrmflag = 1 THEN 8422
  991. COLOR gray, black
  992. RETURN
  993.  
  994. sugi:
  995. CLS
  996. FOR mmx = 1 TO incondtot
  997. PRINT "Example using entry #1: "; befincondtext$(mmx); " "; objname$(mmx, 1); " "; aftincondtext$(mmx); " ["; inconddiscribe$(mmx); "]"
  998. FOR oox = 1 TO inpartspectrumtot(mmx)
  999. PRINT objname$(mmx, oox); ", ";
  1000. NEXT oox
  1001. PRINT " "
  1002. PRINT " "
  1003. 2768 PRINT " enter forced "; inconddiscribe$(mmx);
  1004. INPUT " condition "; hold$
  1005. IF hold$ = "" THEN currin(mmx) = FIX(RND * inpartspectrumtot(mmx)) + 1: GOTO 4768
  1006. IF hold$ = CHR$(27) THEN 4768
  1007. FOR mbc = 1 TO inpartspectrumtot(mmx)
  1008. IF hold$ = objname$(mmx, mbc) THEN holdc = mbc: GOTO 2762
  1009. NEXT mbc
  1010. PRINT "object not defined, spaces and cases must match.": GOTO 2768
  1011. 2762 currin(mmx) = holdc
  1012. 4768 PRINT " "
  1013. NEXT mmx
  1014. sugiflag = 1
  1015. RETURN
  1016.  
  1017. sugo:
  1018. CLS
  1019. FOR mmx = 1 TO outcondtot
  1020. PRINT "Example using entry #1: "; befoutcondtext$(mmx); " "; actname$(mmx, 1); " "; aftoutcondtext$(mmx); " ["; outconddiscribe$(mmx); "]"
  1021. FOR oox = 1 TO outpartspectrumtot(mmx)
  1022. PRINT actname$(mmx, oox); ", ";
  1023. NEXT oox
  1024. PRINT " "
  1025. PRINT " "
  1026. 27 PRINT " enter forced "; outconddiscribe$(mmx);
  1027. INPUT " condition "; hold$
  1028. IF hold$ = "" THEN currout(mmx) = FIX(RND * outpartspectrumtot(mmx)) + 1: GOTO 47
  1029. IF hold$ = CHR$(27) THEN 47
  1030. FOR mbc = 1 TO outpartspectrumtot(mmx)
  1031. IF hold$ = actname$(mmx, mbc) THEN holdc = mbc: GOTO 4127
  1032. NEXT mbc
  1033. PRINT "action not defined, spaces and cases must match.": GOTO 27
  1034. 4127 currout(mmx) = holdc
  1035. 47 PRINT " "
  1036. NEXT mmx
  1037. sugoflag = 1
  1038. RETURN
  1039.  
  1040. 7025  INPUT "Output Filename: "; n$
  1041. OPEN n$ FOR OUTPUT AS #1
  1042. GOTO 7126
  1043.  
  1044. checkifnew:
  1045. IF sugoflag = 1 THEN RETURN
  1046. FOR poi = 1 TO tryedsofar
  1047. FOR hfs = 1 TO outcondtot
  1048. IF NOT currout(hfs) = outstacker(hfs, poi) THEN 3926
  1049. NEXT hfs
  1050. currout(1) = 9999:
  1051. GOTO 4926
  1052. 3926 NEXT poi
  1053. 4926 RETURN
  1054.  
  1055. prntobj:
  1056. PRINT objname$(objkey, currin(objkey))
  1057. RETURN
  1058.  
  1059. revalu: '******  INTERFACE TERMINAL # 3 _ Sensors/Value - IN conditions are reread
  1060. ' (perceived again) and any difference and/or metamorphisis may be assoiciated
  1061. ' with value augmentation by the user; ie, a value assingment may be injected
  1062. ' at this point by the creator, either as a coded law or an in-line reference
  1063. ' to another source of value designation.  ******
  1064. valu = 0
  1065. befval = totalscore   ' inflict laws of universe and fix val
  1066. enrgused = 0
  1067. rawsource = currin(objkey)
  1068. FOR mm = 1 TO outcondtot
  1069. enrgused = enrgused + actenrgused(mm, currout(mm))
  1070. NEXT mm
  1071.  
  1072. FOR cmt = 1 TO comandtot 'rrec in user
  1073. FOR isr = 1 TO incondtot
  1074. IF rrin(isr, cmt) = icc THEN 8633
  1075. passflag = 0
  1076. IF rrin(isr, cmt) < 0 THEN GOSUB assocondinrval
  1077. IF passflag = 1 THEN 8633
  1078. IF passflag = 9 THEN 8644
  1079. IF rrin(isr, cmt) = currin(isr) THEN 8633
  1080. GOTO 8644
  1081. 8633 NEXT isr
  1082.  
  1083. FOR isr = 1 TO outcondtot
  1084. IF rrout(isr, cmt) = icc THEN 8622
  1085. passflag = 0
  1086. IF rrout(isr, cmt) < 0 THEN GOSUB assocondoutrval
  1087. IF passflag = 1 THEN 8622
  1088. IF passflag = 9 THEN 8644
  1089.  
  1090. IF rrout(isr, cmt) = currout(isr) THEN 8622
  1091. GOTO 8644
  1092. 8622 NEXT isr
  1093.  
  1094. valu = valu + valaug(cmt)
  1095. goalvalhold = goalvalhold + valaug(cmt)
  1096. freshmadex = mmgrant(cmt)
  1097. IF mmgrant(cmt) = fleecode THEN moveobflag = 1: GOTO 8344
  1098. IF mmgrant(cmt) = disapearcode THEN incondgift(objkey, (currin(objkey))) = incondgift(objkey, (currin(objkey))) - 1: disapflag = 1: GOTO 8344
  1099. freshmadex = 0
  1100. freshmade = mmgrant(cmt)
  1101. ramu(mmkey(cmt)) = mmgrant(cmt)
  1102. 31 IF bailaftval = 1 AND NOT valaug(cmt) = 0 THEN 8345
  1103. IF mmgrant(cmt) > 0 THEN 8344
  1104. 8644
  1105. 28 NEXT cmt
  1106. 8345 IF freshmade > 0 THEN prodvalflag = 1: byprodflag = 1: prodlink = freshmade
  1107. IF eventgrade > settlefor THEN goalvalflag = 1
  1108. 818 totalscore = totalscore + valu + enrgused
  1109. eventgrade = totalscore - befval
  1110. LOCATE 14, 73: COLOR whiteh, 0: PRINT eventgrade
  1111. LOCATE 14, 58: COLOR gray, 0: PRINT totalscore
  1112. valdifxx = eventgrade
  1113. GOSUB printevrec
  1114. RETURN
  1115.  
  1116. assocondinrval:
  1117. IF currout(rrin(isr, cmt) * -1) = currin(isr) THEN passflag = 1: RETURN
  1118. passflag = 9
  1119. RETURN
  1120.  
  1121. assocondoutrval:
  1122. IF currin(rrout(isr, cmt) * -1) = currout(isr) THEN passflag = 1: RETURN
  1123. passflag = 9
  1124. RETURN
  1125.  
  1126. 8344 IF bailaftmmordisapr = 1 THEN 8345
  1127. GOTO 28
  1128.  
  1129. prntcurr:
  1130. COLOR green, 0:
  1131. FOR rla = 16 TO 23: LOCATE rla, 1: PRINT "                                                                                ": NEXT rla
  1132. LOCATE 16, 1
  1133. FOR mby = 1 TO incondtot
  1134. PRINT befincondtext$(mby); " "; objname$(mby, currin(mby)); " "; aftincondtext$(mby);
  1135. NEXT mby
  1136. IF paraflag = 0 THEN PRINT " "
  1137. COLOR red, 0:
  1138. FOR mby = 1 TO outcondtot
  1139. IF mby = 1 THEN PRINT befoutcondtext$(mby); " "; actname$(mby, currout(mby)); " "; aftoutcondtext$(mby); " ";
  1140. IF mby = 1 THEN COLOR green, 0: PRINT objname$(objkey, currin(objkey)); " ";
  1141. COLOR red, 0
  1142.  
  1143. IF mby > 1 THEN PRINT befoutcondtext$(mby); " "; actname$(mby, currout(mby)); " "; aftoutcondtext$(mby);
  1144. NEXT mby
  1145. IF paraflag = 0 THEN PRINT " "
  1146. COLOR yel, 0
  1147. IF freshmade > 0 THEN PRINT "A"; " "; objname$(objkey, freshmade); " "; "was created.": GOTO 303
  1148. 42 IF moveobflag = 1 THEN PRINT "The"; " "; objname$(objkey, currin(objkey)); " "; "moved.": GOTO 303
  1149. IF disapflag = 1 THEN PRINT "The"; " "; objname$(objkey, currin(objkey)); " "; "disappeared.": GOTO 303
  1150. PRINT " "
  1151.  
  1152. 303 COLOR 3, 0
  1153. PRINT "Total Score:"; totalscore; "  ";
  1154. COLOR 8, 0
  1155. PRINT "Tried:"; tryedsofar; "  ";
  1156. COLOR 6, 0
  1157. PRINT "Event #:"; histeventnum; "  ";
  1158. COLOR 13, 0
  1159. PRINT "Event Grade:"; eventgrade
  1160.  
  1161. COLOR 10, 0
  1162. PRINT "goalval:"; goalval(histeventnum); "  ";
  1163. COLOR 9, 0
  1164. PRINT "Prodval:"; prodval(histeventnum); "  ";
  1165. COLOR 7, 0
  1166. PRINT "Numneed:"; numneed(histeventnum); "  ";
  1167. COLOR 2, 0
  1168. PRINT "Convcost:"; convcost(histeventnum); "   ";
  1169. COLOR 4, 0
  1170. PRINT " "
  1171. IF crazyflag = 9999 THEN PRINT "Forced RND MNMutant Conds: ALL RND"; : RETURN
  1172. IF crazyflag > 0 THEN PRINT "Forced RND MNMutant Cond: "; crazyflag; outconddiscribe$(crazyflag);
  1173. RETURN
  1174.  
  1175. dumpuser:
  1176. COLOR lblue, 0
  1177. FOR mmx = 1 TO incondtot
  1178. PRINT "Example using entry #1: "; befincondtext$(mmx); " "; objname$(mmx, 1); " "; aftincondtext$(mmx); " ["; inconddiscribe$(mmx); "]"
  1179. FOR oox = 1 TO inpartspectrumtot(mmx)
  1180. PRINT objname$(mmx, oox); ", ";
  1181. NEXT oox
  1182. PRINT " "
  1183. PRINT " "
  1184. NEXT mmx
  1185.  
  1186. IF qxflag = 1 THEN 1709
  1187. COLOR lred, 0
  1188. FOR mm = 1 TO outcondtot
  1189. PRINT "Example using entry #1: "; befoutcondtext$(mm); " "; actname$(mm, 1); " "; aftoutcondtext$(mm); " ["; outconddiscribe$(mm); "]"
  1190. FOR oo = 1 TO outpartspectrumtot(mm)
  1191. PRINT actname$(mm, oo); ", ";
  1192. NEXT oo
  1193. PRINT " "
  1194. PRINT " "
  1195. NEXT mm
  1196.  
  1197. FOR rrecz = 1 TO comandtot
  1198. FOR xfc = 1 TO incondtot
  1199. IF (rrin(xfc, rrecz)) = icc THEN PRINT "{ANY}"; " ";
  1200. IF (rrin(xfc, rrecz)) < 0 THEN PRINT "{in COND}"; " ";
  1201. IF rrin(xfc, rrecz) < 0 THEN 1206
  1202.  
  1203. IF rrin(xfc, rrecz) = icc THEN 1206
  1204. PRINT objname$(xfc, (rrin(xfc, rrecz))); " ";
  1205. 1206 NEXT xfc
  1206. PRINT " "
  1207. FOR xfc = 1 TO outcondtot
  1208. IF rrout(xfc, rrecz) = icc THEN PRINT "{ANY}"; " ";
  1209. IF (rrout(xfc, rrecz)) < 0 THEN PRINT "{out COND}"; " ";
  1210. IF rrout(xfc, rrecz) < 0 THEN 1208
  1211. IF rrout(xfc, rrecz) = icc THEN 1208
  1212. PRINT actname$(xfc, (rrout(xfc, rrecz))); " ";
  1213. 1208 NEXT xfc
  1214. PRINT " "
  1215. PRINT "Value granted"; valaug(rrecz); " ";
  1216. IF mmgrant(rrecz) = disapearcode THEN PRINT "disappear"
  1217. IF mmgrant(rrecz) = disapearcode THEN 1708
  1218. IF mmgrant(rrecz) = fleecode THEN PRINT "flee": GOTO 1708
  1219. PRINT objname$(objkey, mmgrant(rrecz))
  1220. 1708 PRINT " "
  1221. NEXT rrecz
  1222. 1709 RETURN
  1223.  
  1224. dumpvals:
  1225. 333 kk = kk + 1
  1226. COLOR 11, 6
  1227. hh = 41: pnum = 16
  1228. IF kk > pnum THEN kk = 13: GOTO 333
  1229. IF histeventnum = 1 THEN 515
  1230. 515 kk = 14
  1231. LOCATE kk, hh + 13
  1232. 7003
  1233. COLOR whiteh, black
  1234. LOCATE kk, hh
  1235. PRINT histeventnum
  1236. evrecnumhold = histeventnum
  1237. RETURN
  1238.  
  1239. printevrec:
  1240. tt = 41
  1241. IF jj = 16 THEN jj = 13
  1242. jj = jj + 1
  1243. hh = 33
  1244. LOCATE jj, tt + 5
  1245. COLOR black, black
  1246. LOCATE jj, tt
  1247. COLOR gray, black
  1248. LOCATE jj, tt + 7
  1249. holdev = histeventnum
  1250. IF newrecflag = 0 THEN histeventnum = exx
  1251. LOCATE 13, 1
  1252. PRINT byprod(objkey, histeventnum); prodval(histeventnum); numneed(histeventnum); convcost(histeventnum); histeventnum
  1253. histeventnum = holdev
  1254. RETURN
  1255.  
  1256. drawcirt:
  1257. 7001
  1258. GOSUB CLEANbox
  1259. GOSUB drawbox
  1260. GOSUB box1
  1261. GOSUB box2
  1262. GOSUB line2x3
  1263. IF randy = 1 THEN 9172
  1264. GOSUB box3
  1265. GOSUB box4
  1266. GOSUB line4x5
  1267. GOSUB box5
  1268. GOSUB line5x11
  1269. 9172 IF randy = 1 THEN GOSUB linerx1
  1270. GOSUB line3x4
  1271. IF randy = 1 THEN GOSUB linerx2
  1272. GOSUB line4x6
  1273. GOSUB line4x9
  1274. GOSUB box6
  1275. GOSUB line6x7
  1276. GOSUB box7
  1277. GOSUB line7x8
  1278. GOSUB box8
  1279. GOSUB line8x10
  1280. 3131 GOSUB line6x9
  1281. GOSUB box9
  1282. GOSUB box10
  1283. GOSUB line10x11
  1284. 7654 GOSUB box11
  1285. GOSUB line11x12
  1286. IF randy = 1 THEN 8612
  1287. GOSUB box12
  1288. 8612 IF randy = 1 THEN GOSUB linerx3
  1289. GOSUB line12x1
  1290. IF sek = 1 OR randy = 1 THEN GOSUB line9x8
  1291. COLOR m, fff
  1292. 9898
  1293. RETURN
  1294.  
  1295. CLEANbox:
  1296. COLOR 1, back
  1297. FOR fxdf = 1 TO 16
  1298. FOR fdf = 1 TO 10
  1299. LOCATE rrr + raug + (fdf - 1), ccc + 1 + caug + fxdf
  1300. PRINT CHR$(219)
  1301. NEXT fdf
  1302. NEXT fxdf
  1303. RETURN
  1304.  
  1305. drawbox:
  1306. COLOR back, box
  1307. FOR fdf = 1 TO 9
  1308. LOCATE rrr + raug + 1 + (fdf - 1), ccc + caug + 1
  1309. PRINT CHR$(186)
  1310. LOCATE rrr + raug + 1 + (fdf - 1), ccc + caug + 18
  1311. PRINT CHR$(186)
  1312. NEXT fdf
  1313.  
  1314. FOR fdf = 1 TO 16
  1315. LOCATE rrr + raug, ccc + caug + 2 + (fdf - 1)
  1316. PRINT CHR$(205)
  1317. LOCATE rrr + raug + 10, ccc + caug + 2 + (fdf - 1)
  1318. PRINT CHR$(205)
  1319. NEXT fdf
  1320. LOCATE rrr + raug, ccc + caug + 1
  1321. PRINT CHR$(201)
  1322. LOCATE rrr + raug + 10, ccc + caug + 18
  1323. PRINT CHR$(188)
  1324. LOCATE rrr + raug + 10, ccc + caug + 1
  1325. PRINT CHR$(200)
  1326. LOCATE rrr + raug, ccc + caug + 18
  1327. PRINT CHR$(187)
  1328. RETURN
  1329.  
  1330. box1:
  1331. LOCATE rrr + raug + 1, ccc + caug + 3
  1332. PRINT "███"
  1333. LOCATE rrr + raug + 1, ccc + caug + 6
  1334. PRINT CHR$(16)
  1335. IF tf = 0 THEN tf = 1: GOTO 5551
  1336. scale$ = "c": IF soundflag = 1 THEN PLAY nt$: PLAY "O" + STR$(ot): PLAY "X" + VARPTR$(scale$)
  1337. tf = 0: RETURN
  1338. 5551 FOR we = 1 TO boxstall: NEXT we
  1339. COLOR back, box: GOTO box1
  1340.                         
  1341. box2:
  1342. LOCATE rrr + raug + 1, ccc + caug + 7
  1343. PRINT CHR$(17)
  1344. LOCATE rrr + raug + 1, ccc + caug + 8
  1345. PRINT "███"
  1346. LOCATE rrr + raug + 1, ccc + caug + 11
  1347. PRINT CHR$(16)
  1348. IF tf = 0 THEN tf = 1: GOTO 5552
  1349. scale$ = "d": IF soundflag = 1 THEN PLAY nt$: PLAY "O" + STR$(ot): PLAY "X" + VARPTR$(scale$)
  1350.  
  1351. tf = 0: RETURN
  1352. 5552 FOR we = 1 TO boxstall: NEXT we
  1353. COLOR back, box: GOTO box2
  1354.  
  1355. line2x3:
  1356. LOCATE rrr + raug + 1, ccc + caug + 12
  1357. PRINT "───"
  1358. LOCATE rrr + raug + 1, ccc + caug + 15
  1359. PRINT CHR$(191)
  1360. LOCATE rrr + raug + 2, ccc + caug + 15
  1361. PRINT CHR$(25)
  1362. RETURN
  1363.  
  1364. box3:
  1365. LOCATE rrr + raug + 3, ccc + caug + 13
  1366. PRINT "████"
  1367. IF tf = 0 THEN tf = 1: GOTO 5553
  1368. scale$ = "e": IF soundflag = 1 THEN PLAY nt$: PLAY "O" + STR$(ot): PLAY "X" + VARPTR$(scale$)
  1369. tf = 0: RETURN
  1370. 5553 FOR we = 1 TO boxstall: NEXT we
  1371. COLOR back, box: GOTO box3
  1372.  
  1373. line3x4:
  1374. LOCATE rrr + raug + 4, ccc + caug + 15
  1375. PRINT CHR$(25)
  1376. RETURN
  1377.  
  1378. box4:
  1379. LOCATE rrr + raug + 5, ccc + caug + 13
  1380. PRINT CHR$(17)
  1381. LOCATE rrr + raug + 5, ccc + caug + 14
  1382. PRINT "███"
  1383. LOCATE rrr + raug + 5, ccc + caug + 17
  1384. PRINT CHR$(16)
  1385. IF tf = 0 THEN tf = 1: GOTO 5554
  1386. scale$ = "f": IF soundflag = 1 THEN PLAY nt$: PLAY "O" + STR$(ot): PLAY "X" + VARPTR$(scale$)
  1387. tf = 0: RETURN
  1388. 5554 FOR we = 1 TO boxstall: NEXT we
  1389. COLOR back, box: GOTO box4
  1390.  
  1391. line4x6:
  1392. LOCATE rrr + raug + 6, ccc + caug + 15
  1393. PRINT CHR$(25)
  1394. RETURN
  1395. line4x9:
  1396. LOCATE rrr + raug + 7, ccc + caug + 15
  1397. PRINT CHR$(25)
  1398. RETURN
  1399.  
  1400. line4x5:
  1401. LOCATE rrr + raug + 5, ccc + caug + 12
  1402. PRINT CHR$(27)
  1403. RETURN
  1404.  
  1405. box5:
  1406. LOCATE rrr + raug + 5, ccc + caug + 8
  1407. PRINT "████"
  1408. IF tf = 0 THEN tf = 1: GOTO 5555
  1409. scale$ = "g": IF soundflag = 1 THEN PLAY nt$: PLAY "O" + STR$(ot): PLAY "X" + VARPTR$(scale$)
  1410. tf = 0: RETURN
  1411. 5555 FOR we = 1 TO boxstall: NEXT we
  1412. COLOR back, box: GOTO box5
  1413.  
  1414. line5x11:
  1415. LOCATE rrr + raug + 5, ccc + caug + 7
  1416. PRINT CHR$(27)
  1417. RETURN
  1418.  
  1419. box11:
  1420. LOCATE rrr + raug + 5, ccc + caug + 3
  1421. PRINT "████"
  1422. IF tf = 0 THEN tf = 1: GOTO 55511
  1423. scale$ = "f": IF soundflag = 1 THEN PLAY nt$: PLAY "O" + STR$(ot + 1): PLAY "X" + VARPTR$(scale$)
  1424. tf = 0: RETURN
  1425. 55511 FOR we = 1 TO boxstall: NEXT we
  1426. COLOR back, box: GOTO box11
  1427.  
  1428. box6:
  1429. LOCATE rrr + raug + 7, ccc + caug + 13
  1430. PRINT "████"
  1431.  
  1432. IF tf = 0 THEN tf = 1: GOTO 5556
  1433. scale$ = "a": IF soundflag = 1 THEN PLAY nt$: PLAY "O" + STR$(ot): PLAY "X" + VARPTR$(scale$)
  1434. tf = 0: RETURN
  1435. 5556 FOR we = 1 TO boxstall: NEXT we
  1436. COLOR back, box: GOTO box6
  1437.  
  1438. line6x7:
  1439. LOCATE rrr + raug + 7, ccc + caug + 12
  1440. PRINT CHR$(27)
  1441. RETURN
  1442.  
  1443. box7:
  1444. LOCATE rrr + raug + 7, ccc + caug + 8
  1445. PRINT "████"
  1446. IF tf = 0 THEN tf = 1: GOTO 5557
  1447. scale$ = "b": IF soundflag = 1 THEN PLAY nt$: PLAY "O" + STR$(ot): PLAY "X" + VARPTR$(scale$)
  1448. tf = 0: RETURN
  1449. 5557 FOR we = 1 TO boxstall: NEXT we
  1450. COLOR back, box: GOTO box7
  1451.  
  1452. line7x8:
  1453. LOCATE rrr + raug + 7, ccc + caug + 7
  1454. PRINT CHR$(27)
  1455. RETURN
  1456.  
  1457. box8:
  1458. LOCATE rrr + raug + 7, ccc + caug + 3
  1459. PRINT "████"
  1460. IF tf = 0 THEN tf = 1: GOTO 5558
  1461. scale$ = "c": IF soundflag = 1 THEN PLAY nt$: PLAY "O" + STR$(ot + 1): PLAY "X" + VARPTR$(scale$)
  1462. tf = 0: RETURN
  1463. 5558 FOR we = 1 TO boxstall: NEXT we
  1464. COLOR back, box: GOTO box8
  1465.  
  1466. line8x10:
  1467. LOCATE rrr + raug + 8, ccc + caug + 4
  1468. PRINT CHR$(25)
  1469. RETURN
  1470.  
  1471. line6x9:
  1472. LOCATE rrr + raug + 9, ccc + caug + 12
  1473. PRINT CHR$(27)
  1474. LOCATE rrr + raug + 9, ccc + caug + 13
  1475. PRINT "──"
  1476. LOCATE rrr + raug + 9, ccc + caug + 15
  1477. PRINT CHR$(217)
  1478. LOCATE rrr + raug + 8, ccc + caug + 15
  1479. PRINT CHR$(25)
  1480. RETURN
  1481.  
  1482. box9:
  1483. LOCATE rrr + raug + 9, ccc + caug + 7
  1484. PRINT CHR$(17)
  1485. LOCATE rrr + raug + 9, ccc + caug + 8
  1486. PRINT "████"
  1487. IF tf = 0 THEN tf = 1: GOTO 5559
  1488. scale$ = "d": IF soundflag = 1 THEN PLAY nt$: PLAY "O" + STR$(ot + 1): PLAY "X" + VARPTR$(scale$)
  1489. tf = 0: RETURN
  1490. 5559 FOR we = 1 TO boxstall: NEXT we
  1491. COLOR back, box: GOTO box9
  1492.  
  1493. box10:
  1494. LOCATE rrr + raug + 9, ccc + caug + 3
  1495. PRINT "███"
  1496. LOCATE rrr + raug + 9, ccc + caug + 6
  1497. PRINT CHR$(16)
  1498. IF tf = 0 THEN tf = 1: GOTO 55510
  1499. scale$ = "e": IF soundflag = 1 THEN PLAY nt$: PLAY "O" + STR$(ot + 1): PLAY "X" + VARPTR$(scale$)
  1500. tf = 0: RETURN
  1501. 55510 FOR we = 1 TO boxstall: NEXT we
  1502. COLOR back, box: GOTO box10
  1503.  
  1504. line10x11:
  1505. LOCATE rrr + raug + 5, ccc + caug + 2
  1506. PRINT CHR$(218)
  1507. LOCATE rrr + raug + 9, ccc + caug + 2
  1508. PRINT CHR$(192)
  1509. LOCATE rrr + raug + 8, ccc + caug + 2
  1510. PRINT CHR$(179)
  1511. LOCATE rrr + raug + 7, ccc + caug + 2
  1512. PRINT CHR$(179)
  1513. LOCATE rrr + raug + 6, ccc + caug + 2
  1514. PRINT CHR$(179)
  1515. RETURN
  1516.  
  1517. box12:
  1518. LOCATE rrr + raug + 3, ccc + caug + 3
  1519. PRINT "███"
  1520. IF tf = 0 THEN tf = 1: GOTO 55512
  1521. scale$ = "g": IF soundflag = 1 THEN IF soundflag = 1 THEN PLAY nt$:  PLAY "O" + STR$(ot + 1): PLAY "X" + VARPTR$(scale$)
  1522. tf = 0: RETURN
  1523. 55512 FOR we = 1 TO boxstall: NEXT we
  1524. COLOR back, box: GOTO box12
  1525.  
  1526. line11x12:
  1527. LOCATE rrr + raug + 4, ccc + caug + 4
  1528. PRINT CHR$(24)
  1529. RETURN
  1530.  
  1531. line12x1:
  1532. LOCATE rrr + raug + 2, ccc + caug + 4
  1533. PRINT CHR$(24)
  1534. RETURN
  1535.  
  1536. line9x8:
  1537. LOCATE rrr + raug + 9, ccc + caug + 6
  1538. PRINT CHR$(196)
  1539. LOCATE rrr + raug + 9, ccc + caug + 5
  1540. PRINT CHR$(196)
  1541. LOCATE rrr + raug + 9, ccc + caug + 4
  1542. PRINT CHR$(192)
  1543. LOCATE rrr + raug + 8, ccc + caug + 4
  1544. PRINT CHR$(24)
  1545. LOCATE rrr + raug + 7, ccc + caug + 4
  1546. PRINT CHR$(24)
  1547. LOCATE rrr + raug + 6, ccc + caug + 4
  1548. PRINT CHR$(24)
  1549. RETURN
  1550.  
  1551. linerx1:
  1552. LOCATE rrr + raug + 3, ccc + caug + 15
  1553. PRINT CHR$(25)
  1554. RETURN
  1555.  
  1556. linerx2:
  1557. LOCATE rrr + raug + 5, ccc + caug + 15
  1558. PRINT CHR$(25)
  1559. RETURN
  1560.  
  1561. linerx3:
  1562. LOCATE rrr + raug + 3, ccc + caug + 4
  1563. PRINT CHR$(24)
  1564. RETURN
  1565.  
  1566. prntclean:
  1567. LOCATE 7, 59: COLOR blue, blue: PRINT "    "
  1568. LOCATE 9, 59: COLOR blue, blue: PRINT "    "
  1569. RETURN
  1570.  
  1571. prntcurrf:
  1572. INPUT "Output Filename: "; n$
  1573. OPEN n$ FOR OUTPUT AS #1
  1574.  
  1575. FOR erk = 1 TO histeventnum
  1576. FOR mby = 1 TO incondtot
  1577. PRINT #1, befincondtext$(mby); " "; objname$(mby, inhistory(mby, erk)); " "; aftincondtext$(mby);
  1578. NEXT mby
  1579. IF paraflag = 0 THEN PRINT #1, " "
  1580. COLOR red, 0:
  1581. FOR mby = 1 TO outcondtot
  1582. IF mby = 1 THEN PRINT #1, befoutcondtext$(mby); " "; actname$(mby, outhistory(mby, erk)); " "; aftoutcondtext$(mby); " ";
  1583. IF mby = 1 THEN COLOR green, 0: PRINT #1, objname$(objkey, inhistory(objkey, erk)); " ";
  1584. COLOR red, 0
  1585.  
  1586. IF mby > 1 THEN PRINT #1, befoutcondtext$(mby); " "; actname$(mby, outhistory(mby, erk)); " "; aftoutcondtext$(mby);
  1587. NEXT mby
  1588. IF paraflag = 0 THEN PRINT #1, " "
  1589. COLOR yel, 0
  1590. IF byprod(objkey, erk) = fleecode THEN PRINT #1, "The"; " "; objname$(objkey, inhistory(objkey, erk)); " "; "moved.": GOTO 43
  1591. IF byprod(objkey, erk) = disapearcode THEN PRINT #1, "The"; " "; objname$(objkey, inhistory(objkey, erk)); " "; "disappeared.": GOTO 43
  1592. IF byprod(objkey, erk) > 0 THEN PRINT #1, "A"; " "; objname$(objkey, byprod(objkey, erk)); " "; "was created."
  1593.  
  1594. 43 COLOR blue, 0
  1595. PRINT #1, "Total Score: NA   ";
  1596. COLOR 8, 0
  1597. PRINT #1, "Tried: NA   ";
  1598. COLOR 6, 0
  1599. PRINT #1, "Event #:"; erk; "  ";
  1600. COLOR 13, 0
  1601. PRINT #1, "Event Grade:"; goalval(erk) + convcost(erk)
  1602.  
  1603. COLOR blue, 0
  1604. PRINT #1, "Goalval:"; goalval(erk); "  ";
  1605. COLOR 8, 0
  1606. PRINT #1, "Prodval:"; prodval(erk); "  ";
  1607. COLOR 6, 0
  1608. PRINT #1, "Numneed:"; numneed(erk); "  ";
  1609. COLOR 13, 0
  1610. PRINT #1, "Convcost:"; convcost(erk); "  ";
  1611. IF czf(erk) = 9999 THEN PRINT #1, "RND MNM Conds: ALL RND"; : GOTO 22
  1612. IF czf(erk) > 0 THEN PRINT #1, "RND MNM Cond: "; czf(erk); outconddiscribe$(czf(erk));
  1613. 22 PRINT #1, " "
  1614. PRINT #1, " "
  1615. NEXT erk
  1616. choice0$ = ""
  1617. CLOSE
  1618. RETURN
  1619.  
  1620. sig:
  1621. COLOR 6, blue
  1622. LOCATE 11, 57: PRINT "AI~WHEEL"
  1623. LOCATE 13, 41: PRINT "  Copyright 1996 by David A. Harrell   "
  1624. LOCATE 12, 41: PRINT "     Universal Robotic Brain Cell"
  1625. COLOR brown, blue
  1626. LOCATE 12, 1: PRINT " ════════ Press z for Main Menu ═══════ "
  1627. RETURN
  1628.  
  1629. toglrnd:
  1630. IF toglrf = 1 THEN 3952
  1631.  
  1632.  i1 = dominaterndflag
  1633.  i2 = dominaterndrate
  1634.  i3 = rndrate
  1635.  i4 = rndrndon
  1636.  i5 = rndrndstop
  1637.  i6 = rndwithevnum
  1638.  i7 = rndtop
  1639.  i8 = simnnon
  1640.  
  1641.  dominaterndflag = 0
  1642.  dominaterndrate = 0
  1643.  rndrate = 0
  1644.  rndrndon = 0
  1645.  rndrndstop = 0
  1646.  rndwithevnum = 0
  1647.  rndtop = 0
  1648.  simnnon = 0
  1649.  simselon = 1
  1650. toglrf = 1
  1651. GOTO 3959
  1652.  
  1653. 3952
  1654.  dominaterndflag = i1
  1655.  dominaterndrate = i2
  1656.  rndrate = i3
  1657.  rndrndon = i4
  1658.  rndrndstop = i5
  1659.  rndwithevnum = i6
  1660.  rndtop = i7
  1661.  simnnon = i8
  1662.  
  1663. toglrf = 0
  1664.  
  1665. simnnon = 1
  1666. simselon = 1
  1667. fulpartrnd = 1
  1668. useppout = 1
  1669. dominaterndflag = 1
  1670. forceobjkeypp = 1
  1671. 3959 RETURN
  1672.  
  1673. menusub2:
  1674. COLOR 0, blue
  1675. CLS
  1676. COLOR 0, blue
  1677. PRINT "     ---- User Entry Parameters and Cognitive Track Switches Menu ----"
  1678. COLOR white, blue
  1679. PRINT " (1) Last Law on Value Min.      "; bailaftval
  1680. PRINT " (b) Last Law on Metmophisis     "; bailaftmmordisapr
  1681. PRINT " (d) Forced Act Limit            "; actmaxlimit
  1682. PRINT " (e) Minimum Value is:           "; settlefor
  1683. PRINT " (8) Select Similes              "; simselon
  1684. PRINT " (v) Box Lights Duration         "; boxstall
  1685. PRINT " (x) Augment Duplicate Expr Need "; retrogdupnn
  1686. PRINT " (5) Maxinmum Minimal Mutation "; maxminmute
  1687. PRINT " (4) Choose ALL Particles @Random"; fulpartrnd
  1688. PRINT " (n) Tic Tac Toe Switch          "; tttflag
  1689. PRINT " (p) Priority (+) Particles Only "; calcpospponly
  1690. PRINT " (3) Use Condition Priority Out  "; useppout
  1691. PRINT " (r) In and Out Cond Pri   On/Off"; usevalppflag
  1692. PRINT " (t) Produce Similar Experments  "; simnnon
  1693. PRINT " (7) Auto Check For Equal Fields "; likelinks
  1694. PRINT " (9) Always Link Like (=) Fields "; linkalways
  1695. PRINT " (6) Attempt Tries to Force Link "; linktrys
  1696. PRINT " (c) Force Link Between un= Conds"; forcefieldlink
  1697. PRINT " (g) Produce Experimental Objects"; numneedon
  1698. PRINT " (j) Number of Laws              "; comandtot
  1699. PRINT " (R) Expirimental Production Rate"; rndsimnnrate
  1700. COLOR 6, blue
  1701. LOCATE 2, 40: PRINT "(G) Record Value/Production Only "; supcnd
  1702. LOCATE 4, 40: PRINT "(H) #1 Priority to Main Object   "; forceobjkeypp
  1703. LOCATE 3, 40: PRINT "(I) Low Accepted Limit to Record "; recvalonly
  1704. LOCATE 5, 40: PRINT "(J) Closed (reCycled) Universe   "; appearnowonly
  1705. LOCATE 6, 40: PRINT "(K) Encounter a New Creation Next"; appearnow
  1706. LOCATE 7, 40: PRINT "(L) Expand Byproduct to All Cond."; matchallbyprod
  1707. LOCATE 8, 40: PRINT "(m) Entry Order Pri Deflt Release"; nodefaultflag
  1708. LOCATE 9, 40: PRINT "(i) Soft Action Limit            "; actmax
  1709. LOCATE 10, 40: PRINT "(q) PartPri for Experimental Need"; calcnnppalso
  1710. LOCATE 11, 40: PRINT "(s) ReCompute Cond Pri Each Cycle"; compglobalppflag
  1711. LOCATE 12, 40: PRINT "(u) Begin Using CondPri on Recd# "; beginpp
  1712. LOCATE 13, 40: PRINT "(w) Don't Make Duplicate Records "; noduprecs
  1713. LOCATE 14, 40: PRINT "(2) Current Event Number         "; histeventnum
  1714. LOCATE 15, 40: PRINT "(a) Manual Random Action         "; dominaterndflag
  1715. LOCATE 16, 40: PRINT "(0) Manual Random Rate           "; dominaterndrate
  1716. LOCATE 17, 40: PRINT "(o) Rate of Random Action        "; rndrate
  1717. LOCATE 18, 40: PRINT "(A) Randomized Random Switches   "; rndrndon
  1718. LOCATE 19, 40: PRINT "(B) Stop Randomizing Rnd Switches"; rndrndstop
  1719. LOCATE 20, 40: PRINT "(C) Taper Random Rate w/Experince"; rndwithevnum
  1720. LOCATE 21, 40: PRINT "(D) Float w/Event # Random Rate  "; rndtop
  1721. LOCATE 22, 40: PRINT "(y) open brain surgery"
  1722. COLOR 0, 1
  1723. LOCATE 23, 28: PRINT "(z)  Back to main menu"
  1724. DO
  1725. 3371 ch$ = INKEY$
  1726. IF ch$ = "a" THEN INPUT " set dominaterndflag"; dominaterndflag
  1727. IF ch$ = "b" THEN INPUT " set bailaftmmordisapr"; bailaftmmordisapr
  1728. IF ch$ = "c" THEN INPUT " set forcefieldlink"; forcefieldlink
  1729. IF ch$ = "d" THEN INPUT " set actmaxlimit"; actmaxlimit
  1730. IF ch$ = "e" THEN INPUT " set settlefor"; settlefor
  1731. IF ch$ = "m" THEN INPUT " set nodefaultflag"; nodefaultflag
  1732. IF ch$ = "n" THEN INPUT " set tttflag"; tttflag
  1733. IF ch$ = "o" THEN INPUT " set rndrate"; rndrate
  1734. IF ch$ = "p" THEN INPUT " set calcpospponly"; calcpospponly
  1735. IF ch$ = "q" THEN INPUT " set calcnnppalso"; calcnnppalso
  1736. IF ch$ = "r" THEN INPUT " set usevalppflag"; usevalppflag
  1737. IF ch$ = "s" THEN INPUT " set compglobalppflag"; compglobalppflag
  1738. IF ch$ = "t" THEN INPUT " set simnnon"; simnnon
  1739. IF ch$ = "u" THEN INPUT " set beginpp"; beginpp
  1740. IF ch$ = "v" THEN INPUT " set boxstall"; boxstall
  1741. IF ch$ = "w" THEN INPUT " set noduprecs"; noduprecs
  1742. IF ch$ = "1" THEN INPUT "set bailaftval"; bailaftval
  1743. IF ch$ = "4" THEN INPUT "set fulpartrnd"; fulpartrnd
  1744. IF ch$ = "5" THEN INPUT "set maxminmute"; maxminmute
  1745. IF ch$ = "6" THEN INPUT "set linktrys"; linktrys
  1746. IF ch$ = "7" THEN INPUT "set likelinks"; likelinks
  1747. IF ch$ = "8" THEN INPUT "set simselon"; simselon
  1748. IF ch$ = "9" THEN INPUT "set linkalways"; linkalways
  1749. IF ch$ = "0" THEN INPUT "set dominaterndrate"; dominaterndrate
  1750. IF ch$ = "x" THEN INPUT "set retrogdupnn"; retrogdupnn
  1751. IF ch$ = "R" THEN INPUT "set rndsimnnrate"; rndsimnnrate
  1752. IF ch$ = "2" THEN INPUT "set histeventnum"; histeventnum
  1753. IF ch$ = "g" THEN INPUT "set numneedon"; numneedon
  1754. IF ch$ = "j" THEN INPUT "set comandtot"; comandtot
  1755. IF ch$ = "j" THEN INPUT "set actmax"; actmax
  1756. IF ch$ = "A" THEN INPUT "set rndrndon"; rndrndon
  1757. IF ch$ = "B" THEN INPUT "set rndrndstop"; rndrndstop
  1758. IF ch$ = "C" THEN INPUT "set rndwithevnum"; rndwithevnum
  1759. IF ch$ = "D" THEN INPUT "set rndtop"; rndtop
  1760. IF ch$ = "y" THEN ch$ = "": STOP
  1761. IF ch$ = "3" THEN INPUT " set useppout"; useppout
  1762. IF ch$ = "G" THEN INPUT "set supcnd"; supcnd
  1763. IF ch$ = "H" THEN INPUT "set  forceobjkeypp"; forceobjkeypp
  1764. IF ch$ = "I" THEN INPUT "set  recvalonly"; recvalonly
  1765. IF ch$ = "J" THEN INPUT "set  appearnowonly"; appearnowonly
  1766. IF ch$ = "K" THEN INPUT "set  appearnow"; appearnow
  1767. IF ch$ = "L" THEN INPUT "set  matchallbyprod"; matchallbyprod
  1768. LOOP UNTIL ch$ = "z"
  1769. RETURN
  1770.  
  1771. forcefalselink:
  1772. INPUT "Set forced link: in condition #"; lcv
  1773. INPUT "is associated with out condition #"; condlinkfinal(lcv)
  1774. forcefieldlink = 1
  1775. RETURN
  1776.  
  1777. writeswch:
  1778. : PRINT #1, histeventnum; prodvalflag; goalvalflag; byprodflag; actmax; toglrf
  1779. PRINT #1, dominaterndflag; bailaftmmordisapr; forcefieldlink; actmaxlimit; settlefor; evrechardlimit; incondtot; outcondtot; inparthardlimit; outparthardlimit; lawshardlimit; evcnt; nodefaultflag; tttflag; rndrate; calcpospponly; calcnnppalso; usevalppflag; compglobalppflag; simnnon; beginpp; boxstall; noduprecs; useppout; bailaftval; fulpartrnd; maxminmute; linktrys; likelinks; simselon; linkalways; dominaterndrate; rndsimnnrate; numneedon; comandtot; rndrndon; rndrndstop; rndwithevnum; rndtop; supcnd; forceobjkeypp; recvalonly; appearnowonly; appearnow; matchallbyprod; retrogdupnn
  1780. RETURN
  1781.  
  1782. dumpbrains:
  1783. INPUT "Output Filename: "; n$
  1784. OPEN n$ FOR OUTPUT AS #1
  1785. PRINT #1, incondtot;
  1786. FOR iux = 1 TO incondtot
  1787. PRINT #1, inpartspectrumtot(iux);
  1788. PRINT #1, ippnt(iux);
  1789. PRINT #1, pinstk(iux);
  1790. NEXT iux
  1791. PRINT #1, " "
  1792. PRINT #1, outcondtot;
  1793. FOR iux = 1 TO outcondtot
  1794. PRINT #1, outpartspectrumtot(iux);
  1795. PRINT #1, oppnt(iux);
  1796. PRINT #1, poutstk(iux);
  1797. NEXT iux
  1798. PRINT #1, " "
  1799. GOSUB writeswch
  1800.  
  1801. FOR ick = 1 TO histeventnum
  1802. PRINT #1, ick; byprod(objkey, ick); convcost(ick); numneed(ick); prodval(ick); goalval(ick); czf(ick)
  1803. FOR iux = 1 TO incondtot
  1804. PRINT #1, inhistory(iux, ick);
  1805. NEXT iux
  1806. PRINT #1, " "
  1807.  
  1808. FOR iux = 1 TO outcondtot
  1809. PRINT #1, outhistory(iux, ick);
  1810. NEXT iux
  1811. PRINT #1, " "
  1812. NEXT ick
  1813. CLOSE
  1814. RETURN
  1815.  
  1816. upbrains:
  1817. INPUT "Input Filename _________.int: "; n$
  1818. upbrainsb:
  1819. OPEN n$ FOR INPUT AS #1
  1820. INPUT #1, incondtot
  1821. FOR iux = 1 TO incondtot
  1822.  
  1823. INPUT #1, inpartspectrumtot(iux)
  1824. INPUT #1, ippnt(iux)
  1825. INPUT #1, pinstk(iux)
  1826. NEXT iux
  1827.  
  1828. INPUT #1, outcondtot
  1829. FOR iux = 1 TO outcondtot
  1830.  
  1831. INPUT #1, outpartspectrumtot(iux)
  1832. INPUT #1, oppnt(iux)
  1833. INPUT #1, poutstk(iux)
  1834.  
  1835. NEXT iux
  1836. GOSUB getswch
  1837. FOR ick = 1 TO histeventnum
  1838. INPUT #1, ick, byprod(objkey, ick), convcost(ick), numneed(ick), prodval(ick), goalval(ick), czf(ick)
  1839.  
  1840. FOR iux = 1 TO incondtot
  1841. INPUT #1, inhistory(iux, ick)
  1842. NEXT iux
  1843.  
  1844. FOR iux = 1 TO outcondtot
  1845. INPUT #1, outhistory(iux, ick)
  1846. NEXT iux
  1847.  
  1848. NEXT ick
  1849. CLOSE
  1850. RETURN
  1851.  
  1852. dumpuserf:
  1853. INPUT "Output Filename: "; n$
  1854. OPEN n$ FOR OUTPUT AS #1
  1855. COLOR lblue, 0
  1856. FOR mmx = 1 TO incondtot
  1857. PRINT #1, "Example using entry #1: "; befincondtext$(mmx); " "; objname$(mmx, 1); " "; aftincondtext$(mmx); " ["; inconddiscribe$(mmx); "]"
  1858. FOR oox = 1 TO inpartspectrumtot(mmx)
  1859. PRINT #1, objname$(mmx, oox); ", ";
  1860. NEXT oox
  1861. PRINT #1, " "
  1862. PRINT #1, " "
  1863. NEXT mmx
  1864.  
  1865. IF qxflag = 1 THEN 709
  1866. COLOR lred, 0
  1867. FOR mm = 1 TO outcondtot
  1868. PRINT #1, "Example using entry #1: "; befoutcondtext$(mm); " "; actname$(mm, 1); " "; aftoutcondtext$(mm); " ["; outconddiscribe$(mm); "]"
  1869. FOR oo = 1 TO outpartspectrumtot(mm)
  1870. PRINT #1, actname$(mm, oo); ", ";
  1871. NEXT oo
  1872. PRINT #1, " "
  1873. PRINT #1, " "
  1874. NEXT mm
  1875.  
  1876. FOR rrecz = 1 TO comandtot
  1877. FOR xfc = 1 TO incondtot
  1878.  
  1879. IF (rrin(xfc, rrecz)) = icc THEN PRINT #1, befincondtext$(xfc); " "; "{ANY}"; " "; " "; aftincondtext$(xfc);
  1880. IF rrin(xfc, rrecz) = icc THEN 206
  1881. IF (rrin(xfc, rrecz)) < 0 THEN PRINT #1, befincondtext$(xfc); " "; "{in COND}"; " "; " "; aftincondtext$(xfc);
  1882. IF rrin(xfc, rrecz) < 0 THEN 206
  1883.  
  1884. PRINT #1, befincondtext$(xfc); " "; objname$(xfc, (rrin(xfc, rrecz))); " "; aftincondtext$(xfc);
  1885. 206 NEXT xfc
  1886. PRINT #1, " "
  1887. FOR xfc = 1 TO outcondtot
  1888.  
  1889. IF rrout(xfc, rrecz) = icc THEN PRINT #1, befoutcondtext$(xfc); " "; "{ANY}"; " "; aftoutcondtext$(xfc); " ";
  1890. IF rrout(xfc, rrecz) = icc THEN 208
  1891. IF rrout(xfc, rrecz) < 0 THEN PRINT #1, befoutcondtext$(xfc); " "; "{out COND}"; " "; aftoutcondtext$(xfc); " ";
  1892. IF rrout(xfc, rrecz) < 0 THEN 208
  1893.  
  1894. IF xfc = 1 THEN PRINT #1, befoutcondtext$(xfc); " "; actname$(xfc, (rrout(xfc, rrecz))); " "; aftoutcondtext$(xfc); " "; objname$(objkey, rrin(objkey, rrecz)); " "; : GOTO 208
  1895. PRINT #1, befoutcondtext$(xfc); " "; actname$(xfc, (rrout(xfc, rrecz))); " "; aftoutcondtext$(xfc); " ";
  1896.  
  1897. 208 NEXT xfc
  1898. PRINT #1, " "
  1899. PRINT #1, "Value granted"; valaug(rrecz); " ";
  1900. IF mmgrant(rrecz) = disapearcode THEN PRINT #1, "disappear";
  1901. IF mmgrant(rrecz) = disapearcode THEN 708
  1902. IF mmgrant(rrecz) = fleecode THEN PRINT #1, "flee"; : GOTO 708
  1903. PRINT #1, objname$(objkey, mmgrant(rrecz));
  1904. 708 PRINT #1, "  Law #: "; rrecz
  1905. PRINT #1, " "
  1906. NEXT rrecz
  1907. 709 CLOSE
  1908. RETURN
  1909.  
  1910. sugglink:
  1911. linktrycnt = linktrycnt + 1
  1912. FOR coni = 1 TO incondtot
  1913. IF NOT condlinkfinal(coni) > 0 THEN 12
  1914. FOR prto = 1 TO outpartspectrumtot(condlinkfinal(coni))
  1915. IF actname$((condlinkfinal(coni)), prto) = objname$(coni, currin(coni)) THEN currout((condlinkfinal(coni))) = prto
  1916. IF forcefieldlink = 1 THEN currout(condlinkfinal(coni)) = currin(coni)
  1917. NEXT prto
  1918. 12 NEXT coni
  1919. RETURN
  1920.  
  1921. menusub3:
  1922. COLOR 0, 4
  1923. CLS
  1924. COLOR 0, 4
  1925. PRINT ""
  1926. PRINT "       --------- User Entry AI~WHEEL HARDWARE Parameters Menu ---------"
  1927. COLOR white, 4
  1928. LOCATE 4, 26: PRINT "(f) Event Record Limit "; evrechardlimit
  1929. LOCATE 7, 26: PRINT "(h) Out Condition Limit "; outcondtot
  1930. LOCATE 6, 26: PRINT "(i) In Particle Limit   "; inparthardlimit
  1931. LOCATE 8, 26: PRINT "(j) Out Particle Limit  "; outparthardlimit
  1932. LOCATE 9, 26: PRINT "(k) Laws Hard Limit     "; lawshardlimit
  1933. LOCATE 5, 26: PRINT "(g) In Condition Limit  "; incondtot
  1934. LOCATE 11, 10: PRINT " (a) Default Alternate #1  (Use this for Auto-Universe 6)"
  1935.  
  1936. COLOR 0, 4
  1937. LOCATE 23, 9
  1938. PRINT " Copyright 1996 by David Albert Harrell - All Rights Reserved"
  1939. COLOR 4, 0
  1940. LOCATE 17, 27: PRINT " (z)  Proceed to Main Menu "
  1941. DO
  1942. ch$ = INKEY$
  1943. IF ch$ = "f" THEN INPUT " set Event Record Limit "; evrechardlimit
  1944. IF ch$ = "g" THEN INPUT " set In Condition Limit "; incondtot
  1945. IF ch$ = "h" THEN INPUT " set Out Condition Limit"; outcondtot
  1946. IF ch$ = "i" THEN INPUT " set In Particle Limit  "; inparthardlimit
  1947. IF ch$ = "j" THEN INPUT " set Out Particle Limit "; outparthardlimit
  1948. IF ch$ = "k" THEN INPUT " set Laws Hard Limit    "; lawshardlimit
  1949. IF ch$ = "a" THEN evrechardlimit = 600: incondtot = 4: outcondtot = 3: inparthardlimit = 5: outparthardlimit = 5: lawshardlimit = 6: LOCATE 11, 10: PRINT " set "
  1950. LOOP UNTIL ch$ = "z"
  1951. RETURN
  1952.  
  1953. tttdispl:
  1954. COLOR 4, 0: LOCATE 9, 30: PRINT "Wins:"; nttwins
  1955. COLOR 6, 0: LOCATE 10, 30: PRINT "Game:"; tttgamecnt
  1956. COLOR 2, 0: LOCATE 11, 30: PRINT "Loss:"; nttloss
  1957.  
  1958. COLOR lred, 0: LOCATE 9, 43
  1959. IF t(1) = 1 THEN PRINT "X"
  1960. IF t(1) = 2 THEN PRINT "O"
  1961. IF t(1) = 3 THEN PRINT " "
  1962.  
  1963. LOCATE 9, 45
  1964. IF t(2) = 1 THEN PRINT "X"
  1965. IF t(2) = 2 THEN PRINT "O"
  1966. IF t(2) = 3 THEN PRINT " "
  1967.  
  1968. LOCATE 9, 47
  1969. IF t(3) = 1 THEN PRINT "X"
  1970. IF t(3) = 2 THEN PRINT "O"
  1971. IF t(3) = 3 THEN PRINT " "
  1972.  
  1973. LOCATE 10, 43
  1974. IF t(4) = 1 THEN PRINT "X"
  1975. IF t(4) = 2 THEN PRINT "O"
  1976. IF t(4) = 3 THEN PRINT " "
  1977.  
  1978. LOCATE 10, 45
  1979. IF t(5) = 1 THEN PRINT "X"
  1980. IF t(5) = 2 THEN PRINT "O"
  1981. IF t(5) = 3 THEN PRINT " "
  1982.  
  1983. LOCATE 10, 47
  1984. IF t(6) = 1 THEN PRINT "X"
  1985. IF t(6) = 2 THEN PRINT "O"
  1986. IF t(6) = 3 THEN PRINT " "
  1987.  
  1988. LOCATE 11, 43
  1989. IF t(7) = 1 THEN PRINT "X"
  1990. IF t(7) = 2 THEN PRINT "O"
  1991. IF t(7) = 3 THEN PRINT " "
  1992.  
  1993. LOCATE 11, 45
  1994. IF t(8) = 1 THEN PRINT "X"
  1995. IF t(8) = 2 THEN PRINT "O"
  1996. IF t(8) = 3 THEN PRINT " "
  1997.  
  1998. LOCATE 11, 47
  1999. IF t(9) = 1 THEN PRINT "X"
  2000. IF t(9) = 2 THEN PRINT "O"
  2001. IF t(9) = 3 THEN PRINT " "
  2002. RETURN
  2003.  
  2004. tttset:
  2005. FOR tts = 1 TO 9
  2006. IF t(tts) = 3 THEN 19
  2007. NEXT tts
  2008. 17 IF winf = 1 THEN nttwins = nttwins + 1
  2009. IF winf = 2 THEN nttloss = nttloss + 1
  2010. winf = 0
  2011. tttgamecnt = tttgamecnt + 1
  2012. FOR tts = 1 TO 9
  2013. t(tts) = 3
  2014. NEXT tts
  2015. GOTO 104
  2016.  
  2017. 19 winf = 0
  2018. IF t(1) = t(2) AND t(2) = t(3) AND NOT t(3) = 3 THEN winf = t(3): GOTO 17
  2019. IF t(4) = t(5) AND t(5) = t(6) AND NOT t(6) = 3 THEN winf = t(6): GOTO 17
  2020. IF t(7) = t(8) AND t(8) = t(9) AND NOT t(9) = 3 THEN winf = t(9): GOTO 17
  2021. IF t(1) = t(5) AND t(5) = t(9) AND NOT t(9) = 3 THEN winf = t(9): GOTO 17
  2022. IF t(3) = t(5) AND t(5) = t(7) AND NOT t(7) = 3 THEN winf = t(7): GOTO 17
  2023. IF t(1) = t(4) AND t(4) = t(7) AND NOT t(7) = 3 THEN winf = t(7): GOTO 17
  2024. IF t(2) = t(5) AND t(5) = t(8) AND NOT t(8) = 3 THEN winf = t(8): GOTO 17
  2025. IF t(3) = t(6) AND t(6) = t(9) AND NOT t(9) = 3 THEN winf = t(9): GOTO 17
  2026. 104 RETURN
  2027.  
  2028.  
  2029. placettt:
  2030. GOSUB tttset
  2031. 10 IF NOT t(currout(2)) = 3 THEN currout(2) = (INT(RND * 9) + 1): GOTO 10
  2032. t(currout(2)) = 1
  2033. RETURN
  2034.  
  2035. rndrnd:
  2036. IF firsttime = 0 THEN firsttime = 1: GOSUB grabswchs
  2037. IF histeventnum = rndrndstop - 1 THEN GOSUB restoreswchs: RETURN
  2038. simnnon = FIX(RND * 2)
  2039. simselon = FIX(RND * 2)
  2040. fulpartrnd = FIX(RND * 2)
  2041. useppout = FIX(RND * 2)
  2042. dominaterndflag = FIX(RND * 2)
  2043. forceobjkeypp = FIX(RND * 2)
  2044. maxminmute = FIX(RND * outcondtot) + 1
  2045. RETURN
  2046.  
  2047. restoreswchs:
  2048. simnnon = hsimnnon
  2049. simselon = hsimselon
  2050. fulpartrnd = hfulpartrnd
  2051. useppout = huseppout
  2052. dominaterndflag = hdominaterndflag
  2053. forceobjkeypp = hforceobjkeypp
  2054. maxminmute = hmaxminmute
  2055. RETURN
  2056.  
  2057. grabswchs:
  2058. hsimnnon = simnnon
  2059. hsimselon = simselon
  2060. hfulpartrnd = fulpartrnd
  2061. huseppout = useppout
  2062. hdominaterndflag = dominaterndflag
  2063. hforceobjkeypp = forceobjkeypp
  2064. hmaxminmute = maxminmute
  2065. RETURN
  2066.  
  2067. prntrnswchs:
  2068. COLOR 4, 0
  2069. LOCATE 1, 72: PRINT rndrndstop
  2070. COLOR 8, 0
  2071. LOCATE 2, 71: PRINT "simVL"
  2072. LOCATE 3, 71: PRINT "simXP"
  2073. LOCATE 4, 71: PRINT "DmRND"
  2074. LOCATE 5, 71: PRINT "fpRND"
  2075. LOCATE 6, 71: PRINT "PPout"
  2076. LOCATE 7, 71: PRINT "ObjKy"
  2077. LOCATE 8, 71: PRINT "OMuta"
  2078. COLOR 14, 0
  2079. LOCATE 2, 76: PRINT simselon
  2080. LOCATE 3, 76: PRINT simnnon
  2081. LOCATE 4, 76: PRINT dominaterndflag
  2082. LOCATE 5, 76: PRINT fulpartrnd
  2083. LOCATE 6, 76: PRINT useppout
  2084. LOCATE 7, 76: PRINT forceobjkeypp
  2085. LOCATE 8, 76: PRINT maxminmute
  2086. RETURN
  2087.  
  2088. cleanrec:
  2089. numneed(histeventnum) = 0
  2090. byprod(objkey, histeventnum) = 0
  2091. prodval(histeventnum) = 0
  2092. czf(histeventnum) = 0
  2093. RETURN
  2094.  
  2095. domnrnd:
  2096. IF dominaterndflag = 1 AND NOT dominaterndrate > FIX(RND * rndtop) + 1 THEN 4678
  2097. LOCATE 7, 59: COLOR lblue, blue: PRINT "║║║║": LOCATE 9, 59: PRINT "║║║║"
  2098. IF useppout = 0 THEN 46
  2099. IF maxminmute = 8888 THEN keyx = poutstk(1): GOTO 468
  2100. IF maxminmute = 9999 THEN keyx = poutstk(outcondtot): GOTO 468
  2101. IF maxminmute > 0 THEN keyx = maxminmute: GOTO 468
  2102.  
  2103. 46 IF fulpartrnd = 1 THEN GOSUB randaction: crazyflag = 9999: GOTO 4678
  2104. keyx = FIX(RND * outcondtot) + 1
  2105. IF useppout = 1 THEN keyx = poutstk(1)
  2106. 468 crazyflag = keyx: czf(histeventnum) = crazyflag
  2107. currout(keyx) = FIX(RND * outpartspectrumtot(keyx)) + 1
  2108. IF currout(keyx) = 0 THEN PRINT " currout key zero? ": END
  2109. 4678 RETURN
  2110.  
  2111.