home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 161 / 161.d81 / parapsychologist (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  10KB  |  285 lines
  1. 10 poke51,0:poke52,144:poke55,0:poke56,144:clr:ft=2048:sp=8192
  2. 20 cd=4712:mo=49152:v=mo+111:rd=mo+1361:hi=int(rd/256):lo=rd-hi*256:cm=mo+1588
  3. 30 mx=250:mt=36864:dimx(25),s(25),r(25),ms(4),is(mx,2),f$(297):box=mo+30
  4. 40 sd=54272:ps=5:dv=peek(186):ifdv<8thendv=8
  5. 50 sys57812"mou-rnd-copym",dv,0:poke780,0:poke781,0:poke782,192:sys65493
  6. 60 sysmo+54,"para.font",dv,ft
  7. 62 sysmo+54,"para.tile",dv,ft+250*8
  8. 70 sysmo+54,"para.spr",dv,sp
  9. 80 sysmo+54,"para.cards",dv,cd
  10. 85 sysmo+54,"toolkit 9000",dv,36864
  11. 86 sysmo+54,"input dir 9600",dv,36864+6*256
  12. 87 pokev+11,64:pokev+12,64:pokev+13,93:pokev+14,93:pokev+10,0
  13. 88 pokev+15,112:pokev+16,110:pokev+17,109:pokev+18,125
  14. 90 sysmo:pokev,31:poke53280,0:poke53281,0
  15. 100 s$="-stats.":co(1)=15:co(2)=5:co(3)=2:
  16. 110 p1$="date  subject  random  expectation":yn$="[y] yes / [n] no"
  17. 120 gosub2210:pokesd+24,15:poke53371,0
  18. 130 forr=1to5:poke2040+r,127+r:next
  19. 140 t$="p a r a p s y c h o l o g i[160]s t":a$(1)="precognition (rhine)"
  20. 150 a$(2)="precognition (modified)":a$(3)="telepathy (rhine)"
  21. 160 a$(4)="telepathy (modified)":a$(5)="review stats"
  22. 170 a$(6)="quit to loadstar":a$(7)="[168]123456"
  23. 190 print"[147]"chr$(142)chr$(8):poke53272,19
  24. 192 sysbo,0,39,0,24,0,7+16:sysbo,4,36,2,4,160,7
  25. 193 sysbo,1,38,1,23,250,3+32:sysbo,7,33,7,16,160,7+16
  26. 194 sysbo,8,32,8,15,160,3
  27. 195 fori=1to6:sysmo+12,9,8+i,"[159]"+a$(i):next:sysbo,4,36,3,3,160,3
  28. 196 sysbo,3,37,2,4,160,7+16
  29. 197 print"[159]";:sys36864+9,3,t$
  30. 198 sys36864+9,22," crsr/return or click to select "
  31. 200 syscm,3072,4096,616
  32. 210 sysmo+39,208
  33. 220 sysmo+42,208:sysmo+18,0,39,0,24:sysmo+6:sys36864,9,8,32,6,3,1,0:getf%
  34. 230 ifdt$=""andf%<6thentp=f%:gosub960:f%=tp
  35. 240 onf%goto260,340,420,500,580,930
  36. 250 :
  37. 260 m$="1":m=1:bc=2:gosub1020:ifflthen220
  38. 270 gosub1040:gosub1390
  39. 280 gosub1870:sysmt+9,22,"[146]visualize the deck and attempt":print
  40. 290 print"to identify the order of the cards."
  41. 300 gosub1110:gosub1870
  42. 310 gosub1160
  43. 320 oncr%goto270,220
  44. 330 :
  45. 340 n=5:m$="2":m=2:bc=10:gosub1020:ifflthen220
  46. 350 gosub1040
  47. 360 gosub1870:sysmt+9,22,"[146]visualize the card and attempt":print
  48. 370 printtab(8)"to identify the symbol."
  49. 380 gosub1110:gosub1870
  50. 390 gosub1160
  51. 400 oncr%goto350,220
  52. 410 :
  53. 420 m$="3":m=3:bc=14:gosub1020:ifflthen220
  54. 430 gosub1040:gosub1390
  55. 440 gosub1870:sysmt+9,22,"[146] concentrate on the displayed symbol":print
  56. 450 print"and record the subject's response."
  57. 460 gosub1110:gosub1870
  58. 470 gosub1160
  59. 480 oncr%goto270,220
  60. 490 :
  61. 500 n=5:m$="4":m=4:bc=14:gosub1020:ifflthen220
  62. 510 gosub1040
  63. 520 gosub1870:sysmt+9,22,"[146] concentrate on the displayed symbol":print
  64. 530 print"and record the subject's response."
  65. 540 gosub1110:gosub1870
  66. 550 gosub1160
  67. 560 oncr%goto510,220
  68. 570 :
  69. 580 m=5:bc=5:gosub1360
  70. 590 fl=0:wc$="$0:1-s*,2-s*,3-s*,4-s*":gosub3000:gosub4000:iff%>0then610
  71. 600 sysmo+12,13,22,"[146][159]no files found":gosub1910:goto220
  72. 610 w$=f$(f%)
  73. 630 remsysmt+9,7,"[156]prefixes":print:forr=1to4:printtab(6)r"= "a$(r):next
  74. 650 m$=left$(w$,1):m=val(m$):w$="m-stats."+mid$(w$,9,8):gosub1560:ifflthen220
  75. 660 gosub1840:sysmt+9,22,"send output to:"
  76. 670 sysmt+9,23,"[s] screen / [p] printer":sysmt+3,"sp":getf%:x=0:onf%goto680,780
  77. 680 gosub1870:sysmt+9,7,""+mid$(w$,9,16)+" / "+a$(m):print"":print""p1$
  78. 690 sysmo+12,0,9,"":forr=1to8:ifr+x*8>nsthenr=8:next:goto750
  79. 700 iflen(str$(is(r+x*8,0)))=7then720
  80. 710 print"0"right$(str$(is(r+x*8,0)),5);:goto730
  81. 720 print""right$(str$(is(r+x*8,0)),6);
  82. 730 print"   "is(r+x*8,1),is(r+x*8,2)," 5":next:ifr-1+x*8=nsthen750
  83. 740 sysmt+9,22,"[154]more":sysmt+9,23,yn$:sysmt+3,"yn":getf%:x=x+1:xx=1
  84. 745 onf%goto770,220
  85. 750 print:printtab(11)is(0,1),is(0,2),ns*5:gosub1870:xx=2
  86. 760 sysmt+9,22,"[154]again":sysmt+9,23,yn$:sysmt+3,"yn":getf%:x=0:onf%goto770,220
  87. 770 tr=9:br=19:gosub1860:gosub1870:onxxgoto680,660
  88. 780 gosub1870:sysmt+9,12,"[158]check printer and paper supply":print
  89. 790 printtab(10)"[p] print / [^] abort":sysmt+3,"p^":getf%:onf%goto800,220
  90. 800 gosub4100
  91. 805 open4,4,0:forr=1toint(18-(len(mid$(w$,9,16)+a$(m))/2)):print#4," ";:next
  92. 810 :print#4,mid$(w$,9,16)" / "a$(m):print#4:print#4:print#4,"  "p1$:print#4
  93. 820 forr=1tons:iflen(str$(is(r,0)))=7then840
  94. 830 print#4,"0"right$(str$(is(r,0)),5);:goto850
  95. 840 print#4,right$(str$(is(r,0)),6);
  96. 850 print#4,"    "is(r,1);:print#4,"     ";:ifis(r,1)<10thenprint#4," ";
  97. 860 print#4,is(r,2);:print#4,"       ";:ifis(r,2)<10thenprint#4," ";
  98. 870 print#4,"5":next:print#4:print#4,"          "is(0,1);
  99. 880 print#4,"     ";:ifis(0,1)<10thenprint#4," ";
  100. 890 print#4,is(0,2);:print#4,"      ";:ifis(o,2)<10thenprint#4," ";
  101. 900 print#4,ns*5:print#4:print#4:print#4:close4:gosub4110
  102. 910 poke186,dv:tr=9:br=19:gosub1860:goto760
  103. 920 :
  104. 930 sysbo,9,31,10,15,32,0:sysbo,9,31,10,15,0,7+16:print"[146]":poke646,1
  105. 940 sysmt+9,12,"quit":sysmt+9,13,yn$:sysmt+3,"yn":getf%:onf%goto40000,220
  106. 950 :
  107. 960 sysbo,9,31,10,15,32,0:sysbo,9,31,10,15,0,7+16:print"[146]":poke646,1
  108. 970 sysmt+9,11,"enter today's date":sysmt+9,12,"mmddyy"
  109. 980 print:printtab(17):sysmo+51,3,3,6:dt$=w$:
  110. 990 forr=1to6:ifmid$(dt$,r,1)<"0"ormid$(dt$,r,1)>"9"thenr=6:next:goto930
  111. 1000 next:return
  112. 1010 :
  113. 1020 gosub1360:gosub1430:return
  114. 1030 :
  115. 1040 gosub1850:print"sets:"spc(8)"expectation:"
  116. 1050 print"hits/"sn$"       hits/rnd:[158]":cc=29:cr=6
  117. 1060 sysmo+12,9,2,str$(ms(m)):sysmo+12,29,2,str$(ms(m)*5)
  118. 1070 sysmo+12,16,3,str$(is(0,1)):sysmo+12,32,3,str$(is(0,2))
  119. 1080 forr=1to25:s(r)=0:r(r)=0:next:sysmo+12,2,6,"[155]         1111111111222222"
  120. 1090 print:print"1234567890123456789012345":gosub1960:return
  121. 1100 :
  122. 1110 forrp=1to25:onmgosub2260,2310,2260,2310
  123. 1120 ifrp>1thengosub1870:d=2:gosub1920:sysmt+9,22,"next"
  124. 1130 gosub2010:x(rp)=dk:s(rp)=cr%:sysmo+12,1+rp,11,"\":
  125. 1140 r(rp)=int(rnd(0)*5)+1:sysmo+12,1+rp,12,"\":next:return
  126. 1150 :
  127. 1160 sh=0:rh=0:gosub2060
  128. 1170 forrp=1to25:gosub1200:next
  129. 1180 gosub2060:gosub1870:gosub1270:gosub1330:return
  130. 1190 :
  131. 1200 dk=x(rp):gosub2080:poke646,7:sysmo+12,1+rp,10,right$(str$(x(rp)),1)
  132. 1210 co=1:ifs(rp)=dkthenco=2:sh=sh+1
  133. 1220 poke646,co(co):sysmo+12,1+rp,11,right$(str$(s(rp)),1)
  134. 1230 oncogosub2170,2190
  135. 1240 co=1:ifr(rp)=dkthenco=3:rh=rh+1
  136. 1250 poke646,co(co):sysmo+12,1+rp,12,right$(str$(r(rp)),1):gosub1920:return
  137. 1260 :
  138. 1270 poke646,co(2):sysmo+12,1+rp,11," ="+str$(sh)
  139. 1280 poke646,co(3):sysmo+12,1+rp,12," ="+str$(rh)
  140. 1290 ns=ms(m)+1:ms(m)=ns:is(0,1)=is(0,1)+sh:is(0,2)=is(0,2)+rh
  141. 1300 is(ns,0)=val(dt$):is(ns,1)=sh:is(ns,2)=rh
  142. 1310 gosub1660:syscm,4096,3072,616:return
  143. 1320 :
  144. 1330 gosub1870:sysmt+9,22,"[146][159]another?   1= yes 2= no":gosub2230:ps=2
  145. 1340 gosub2010:poke53269,0:ps=5:return
  146. 1350 :
  147. 1360 print"[147]":sysbo,0,39,0,4,0,bc+16
  148. 1370 sysbo,0,39,5,20,0,31:sysbo,0,39,21,24,0,7+16:sysmt+9,1,""+a$(m):return
  149. 1380 :
  150. 1390 gosub1870:sysmt+9,22,"[159]shuffling":sysmt+9,23,"deck  ":n=25:gosub1890
  151. 1400 gosub2210:fori=1ton:pokesd+4,0:pokesd+5,17
  152. 1410 pokesd,50:pokesd+1,58:pokesd+24,15:pokesd+4,129:next:poke53371,0:return
  153. 1420 :
  154. 1430 fl=0:wc$="$0:m"+s$+"*":gosub3000:gosub4000:w$=f$(f%):iff%>0then1530
  155. 1440 sysmo+12,13,22,"[146][159]no files found":gosub1910:gosub1870
  156. 1450 sysmo+12,2,22,"[159]enter [158]filename[159] or press [158][^][159] to abort"
  157. 1460 sysmt+9,23,"  press [158][return][159] when done
  158. 1470 [158]mo[170]12,12,7,"m-stats.":[153];
  159. 1480 [158]mo[170]51,1,1,8:n$[178]w$:[139]w$[178]"^"[176]w$[178]""[167]fl[178]1:[142]
  160. 1490 sn$[178][200](n$[170]":       ",9):[142]
  161. 1500 :
  162. 1530 [139][200](w$,2)[178]"m-"[167]1550
  163. 1540 [141]1840:[137]1450
  164. 1550 n$[178][202](w$,9,8):[141]1490
  165. 1560 [141]4100:[159]15,dv,15:[159]8,dv,8,"0:"[170]w$[170]",s,r":[141]1750
  166. 1570 [139]en[179][177]0[175]en[179][177]63[167][141]1810:[137]1730
  167. 1580 [132]8,ms(1),ms(2),ms(3),ms(4):[160]8:[160]15:ns[178]ms([197](m$))
  168. 1590 [139]ns[167]1620
  169. 1600 [141]1870:[158]mt[170]9,22,"clrinitializing, please wait...."
  170. 1610 [129]i[178]0[164]mx:[129]j[178]0[164]2:is(i,j)[178]0:[130]:[130]:[137]1730
  171. 1620 [141]4100:[159]15,dv,15:[159]8,dv,8,"0:"[170]m$[170][202](w$,2,15)[170]",s,r":[141]1750
  172. 1630 [139]en[179][177]0[175]en[179][177]63[167][141]1810:[137]1730
  173. 1640 [129]r[178]0[164]ns:[132]8,is(r,0):[132]8,is(r,1):[132]8,is(r,2):[130]:[137]1730
  174. 1650 :
  175. 1660 [151]53269,0:[141]1860:[158]mt[170]9,22,"opensaving stats":[141]1910
  176. 1670 [141]4100:[159]15,dv,15,"s0:m"[170]s$[170]n$:[159]8,dv,8,"0:m"[170]s$[170]