人間の心とコンピュータが対話する可能性
【チップマンク・ベイシック用プログラム】
http://www.nicholson.com/rhn/basic/
◎カウンセリング対話プログラム「エリザ」 １８-１
＊人工知能の発端の一つとして有名な「エリザ」の改造版。
＊エリザはロジャーズ派の心理療法家。
＊入力は中学生程度の英語であればＯＫ。
＊プログラムから抜ける時はｓｈｕｔと打ち込む。
10 rem THIS IS ELIZA.
20 cls : rem RC = CMS('CLRSCRN')
30 rem ----- INITIALIZATION -----
40 dim s1(36),r(36),n(36)
50 n1 = 36
60 n2 = 14
70 n3 = 112
80 for x = 1 to n1+n2+n3
90 read z$
100 next x
110 rem SAME AS RESTORE
120 for x = 1 to n1
130 read s1(x),l
140 r(x) = s1(x)
150 n(x) = s1(x)+l-1
160 next x
170 print "HI! I'M ELIZA. WHAT'S YOUR PROBLEM?"
180 rem
190 rem ----- USER INPUT SECTION -----
200 rem
210 input i$
211 if i$ = ""
212 print "SPEAK UP. I CAN'T HEAR YOU."
213 goto 210
215 endif
220 i$ = " "+i$+" " : i$ = uprc$(" "+i$+" ")
221 rem for k=1 to len(l$) : if mid$(l$,k,1) >= "a" then mid$(l$,k,1) = chr$(asc(mid$(l$,k,1))-32)
222 rem next k
230 if idx(i$,"SHUT") > 0 then stop
232 rem IF instr(I$,'SHUT') > 0 THEN STOP
240 rem GET RID OF APOSTROPHES
250 i$ = srep$(i$,"'","")
260 if i$ = p$
270 print "I HEARD YOU THE FIRST TIME."
280 goto 180
290 endif
300 rem
310 rem ----- FIND KEYWORD IN I$ -----
320 rem
330 restore
340 s = 0
350 for k = 1 to n1
360 read k$
370 if s > 0 then 430
380 for l = 1 to len(i$)-len(k$)+1
390 if mstr$(i$,l,len(k$)) = k$ then s = k
400 t = l
410 f$ = k$
420 next l
430 next k
440 if s > 0 then k = s
450 if s > 0 then l = t
460 if s > 0 then goto 510
470 k = 36
480 goto 840
490 rem WE DID'NT FIND ANY KEYWORDS
500 rem **********************************************
510 rem * TAKE RIGHT PART OF STRING AND CONJUGATE IT *
520 rem * USING THE LIST OF STRINGS TO BE SWAPPED *
530 rem **********************************************
540 restore
550 for x = 1 to n1
560 read z$
570 next x
580 rem SKIP OVER KEYWORDS
590 x = len(i$)-len(f$)-l+1
600 c$ = " "+mstr$(i$,len(i$)-x+1,x)+" "
610 for x = 1 to n2/2
620 read s$,r$
630 for l = 1 to len(c$)
640 if l+len(s$) > len(c$) then 700
650 if mstr$(c$,l,len(s$)) <> s$ then 700
660 xx = len(c$)-l-len(s$)+1
670 c$ = mstr$(c$,1,l-1)+r$+mstr$(c$,len(c$)-xx+1,xx)
680 l = l+len(r$)
690 goto 750
700 if l+len(r$) > len(c$) then 750
710 if mstr$(c$,l,len(r$)) <> r$ then 750
720 xx = len(c$)-l-len(r$)+1
730 c$ = mstr$(c$,l,l-1)+s$+mstr$(c$,len(c$)-xx+1,xx)
740 l = l+len(s$)
750 next l
760 next x
770 if mstr$(c$,2,1) = " " then c$ = mstr$(c$,1,len(c$)-1)
780 rem ONLY 1 SPACE
790 for l = 1 to len(c$)
800 c$ = srep$(i$,"!","")
810 if mstr$(c$,l,1) = "!" then 800
820 next l
830 rem
840 rem NOW USING THE KEYWORD NUMBER(K) GET REPLY
850 rem
860 restore
870 for x = 1 to n1+n2
880 read z$
890 next x
900 for x = 1 to r(k)
910 read f$
920 next x
930 rem READ AND WRITE REPLY
940 r(k) = r(k)+1
950 if r(k) > n(k) then r(k) = s1(k)
960 if mstr$(f$,len(f$),1) <> "*" then print f$
970 if mstr$(f$,len(f$),1) <> "*" then p$ = i$
980 if mstr$(f$,len(f$),1) <> "*" then 180
990 print mstr$(f$,1,len(f$)-1);c$
1000 p$ = i$
1010 goto 180
1020 rem
1030 rem ----- PROGRAM DATA FOLLOWS -----
1040 rem
1050 rem KEYWORDS
1060 rem
1070 data "CAN YOU","CAN I","YOU ARE","YOURE","I DONT","I FEEL"
1080 data "WHY DONT YOU","WHY CANT I","ARE YOU","I CANT","I AM","IM "
1090 data "YOU ","I WANT","WHAT","HOW","WHO","WHERE","WHEN","WHY"
1100 data "NAME","CAUSE","SORRY","DREAM","HELLO","HI ","MAYBE"
1110 data " NO","YOUR","ALWAYS","THINK","ALIKE","YES","FRIEND"
1120 data "COMPUTER","NOKEYFOUND"
1130 rem
1140 rem STRING DATA FOR CONJUGATIONS
1150 rem
1160 data " ARE "," AM ","WERE","WAS "," YOU "," I ","YOUR","MY "
1170 data " IVE "," YOUVE "," IM "," YOURE "
1180 data " ME "," IYOU "
1190 rem
1200 rem REPLIES
1210 rem
1220 data "DON'T YOU BELIEVE THAT I CAN*"
1230 data "PERHAPS YOU WOULD LIKE TO BE ABLE TO*"
1240 data "YOU WANT ME TO BE ABLE TO*"
1250 data "PERHAPS YOU DON'T WANT TO*"
1260 data "DO YOU WANT TO BE ABLE TO*"
1270 data "WHAT MAKES YOU THINK I AM*"
1280 data "DOES IT PLEASE YOU TO BELIEVE I AM*"
1290 data "PERHAPS YOU WOULD LIKE TO BE*"
1300 data "DO YOU SOMETIMES WISH YOU WERE*"
1310 data "DON'T YOU REALLY*"
1320 data "WHY DON'T YOU*"
1330 data "DO YOU WISH TO BE ABLE TO*"
1340 data "DOES THAT TROUBLE YOU?"
1350 data "TELL ME MORE ABOUT SUCH FEELINGS."
1360 data "DO YOU OFTEN FEEL*"
1370 data "DO YOU ENJOY FEELING*"
1380 data "DO YOU REALLY BELIEVE I DON'T*"
1390 data "PERHAPS IN GOOD TIME I WILL*"
1400 data "DO YOU WANT ME TO"
1410 data "DO YOU THINK YOU SHOULD BE ABLE TO*"
1420 data "WHY CAN'T YOU*"
1430 data "WHY ARE YOU INTERESTED IN WHETHER OR NOT I AM*"
1440 data "WOULD YOU PREFER IF I WERE NOT*"
1450 data "PERHAPS IN YOUR FANTASIES I AM*"
1460 data "HOW DO YOU KNOW YOU CAN'T*"
1470 data "HAVE YOU TRIED?"
1480 data "PERHAPS YOU CAN NOW*"
1490 data "DID YOU COME TO ME BECAUSE YOU ARE*"
1500 data "HOW LONG HAVE YOU BEEN*"
1510 data "DO YOU BELIEVE IT IS NORMAL TO BE*"
1520 data "DO YOU ENJOY BEING*"
1530 data "WE WERE DISCUSSING YOU -- NOT ME."
1540 data "OH, I*"
1550 data "YOU'RE NOT REALLY TALKING ABOUT ME, ARE YOU?"
1560 data "WHAT WOULD IT MEAN TO YOU IF YOU GOT*"
1570 data "WHY DO YOU WANT*"
1580 data "SUPPOSE YOU SOON GOT*"
1590 data "WHAT IF YOU NEVER GOT*"
1600 data "I SOMETIMES ALSO WANT*"
1610 data "WHY DO YOU ASK?"
1620 data "DOES THAT QUESTION INTEREST YOU?"
1630 data "WHAT ANSWER WOULD PLEASE YOU THE MOST?"
1640 data "WHAT DO YOU THINK?"
1650 data "ARE SUCH QUESTIONS ON YOU MIND OFTEN?"
1660 data "WHAT IS IT THAT YOU REALLY WANT TO KNOW?"
1670 data "HAVE YOU ASKED ANYONE ELSE?"
1680 data "HAVE YOU ASKED SUCH QUESTIONS BEFORE?"
1690 data "WHAT ELSE COMES TO MIND WHEN YOU ASK THAT?"
1700 data "NAMES DON'T INTEREST ME."
1710 data "I DON'T CARE ABOUT NAMES -- PLEASE GO ON."
1720 data "IS THAT THE REAL REASON?"
1730 data "DON'T ANY OTHER REASONS COME TO MIND?"
1740 data "DOES THAT REASON EXPLAIN ANYTHING ELSE?"
1750 data "WHAT OTHER REASONS MIGHT THERE BE?"
1760 data "PLEASE DON'T APOLOGIZE!"
1770 data "APOLOGIES ARE NOT NECESSARY."
1780 data "WHAT FEELINGS DO YOU HAVE WHEN YOU APOLOGIZE?"
1790 data "DON'T BE SO DEFENSIVE!"
1800 data "WHAT DOES THAT DREAM SUGGEST TO YOU?"
1810 data "DO YOU DREAM OFTEN?"
1820 data "WHAT PERSON APPEARS IN YOUR DREAMS?"
1830 data "ARE YOU DISTURBED BY YOUR DREAMS?"
1840 data "HOW DO YOU DO ... PLEASE STATE YOUR PROBLEM."
1850 data "YOU DON'T SEEM QUITE CERTAIN."
1860 data "WHY THE UNCERTAIN TONE?"
1870 data "CAN'T YOU BE MORE POSITIVE?"
1880 data "YOU AREN'T SURE?"
1890 data "DON'T YOU KNOW?"
1900 data "ARE YOU SAYING NO JUST TO BE NEGATIVE?"
1910 data "YOU ARE BEING A BIT NEGATIVE."
1920 data "WHY NOT?"
1930 data "ARE YOU SURE?"
1940 data "WHY NO?"
1950 data "WHY ARE YOU CONCERNED ABOUT MY*"
1960 data "WHAT ABOUT YOUR OWN*"
1970 data "CAN YOU THINK OF A SPECIFIC EXAMPLE?"
1980 data "WHEN?"
1990 data "WHAT ARE YOU THINKING OF?"
2000 data "REALLY, ALWAYS?"
2010 data "DO YOU REALLY THINK SO?"
2020 data "BUT YOU ARE NOT SURE YOU*"
2030 data "DO YOU DOUBT YOU*"
2040 data "IN WHAT WAY?"
2050 data "WHAT RESEMBLENCE DO YOU SEE?"
2060 data "WHAT DOES THE SIMILARITY SUGGEST TO YOU?"
2070 data "WHAT OTHER CONNECTIONS DO YOU SEE?"
2080 data "COULD THERE REALLY BE SOME CONNECTION?"
2090 data "HOW?"
2100 data "YOU SEEM QUITE POSITIVE."
2110 data "ARE YOU SURE?"
2120 data "I SEE."
2130 data "I UNDERSTAND."
2140 data "WHY DO YOU BRING UP THE TOPIC OF FRIENDS?"
2150 data "DO YOU FRIENDS WORRY YOU?"
2160 data "DO YOUR FRIENDS PICK ON YOU?"
2170 data "ARE YOU SURE YOU HAVE ANY FRIENDS?"
2180 data "DO YOU IMPOSE ON YOUR FRIENDS?"
2190 data "PERHAPS YOUR LOVE FOR FRIENDS WORRIES YOU."
2200 data "DO COMPUTERS WORRY YOU?"
2210 data "ARE YOU TALKING ABOUT ME IN PARTICULAR?"
2220 data "ARE YOU FRIGHTENED BY MACHINES?"
2230 data "WHY DO YOU MENTION COMPUTERS?"
2240 data "WHAT DO YOU THINK MACHINES HAVE TO DO WITH YOUR PROBLEM?"
2250 data "DON'T YOU THINK COMPUTERS CAN HELP PEOPLE?"
2260 data "WHAT IS IT ABOUT MACHINES THAT WORRIES YOU?"
2270 data "SAY, DO YOU HAVE ANY PSYCHOLOGICAL PROBLEMS?"
2280 data "WHAT DOES THAT SUGGEST TO YOU?"
2290 data "I SEE."
2300 data "I'M NOT SURE I UNDERSTAND YOU FULLY."
2310 data "COME COME ELUCIDATE YOUR THOUGHTS."
2320 data "CAN YOU ELABORATE ON THAT?"
2330 data "THAT IS QUITE INTERESTING."
2340 rem
2350 rem DATA FOR FINDING RIGHT REPLIES
2360 rem
2370 data 1,3,4,2,6,4,6,4,10,4,14,3,17,3,20,2,22,3,25,3
2380 data 28,4,28,4,32,3,35,5,40,9,40,9,40,9,40,9,40,9,40,9
2390 data 49,2,51,4,55,4,59,4,63,1,63,1,64,5,69,5,74,2,76,4
2400 data 80,3,83,7,90,3,93,6,99,7,106,6
8000 sub uprc$(a$,b$,i,c)
8010 b$ = ""
8020 for i = 1 to len(a$)
8030 c = asc(mid$(a$,i,1)) : if c > 96 then c = c-32
8040 b$ = b$+chr$(c)
8050 next i
8090 return (b$)
8100 sub idx(a$,b$,i)
8110 i = instr(a$,b$)
8190 return (i)
8200 sub srep$(a$,f$,t$,b$,i,c$)
8210 b$ = ""
8220 for i = 1 to len(a$)
8230 c$ = mid$(a$,i,1) : if c$ = f$ then c$ = t$
8240 b$ = b$+c$
8250 next i
8290 return (b$)
8300 sub mstr$(a$,b,n,r$)
8310 r$ = mid$(a$,b,n)
8390 return (r$)
9990 end
◎ショパン・前奏曲７番 １８-２
10 graphics 0
20 graphics color 0,100,100
30 graphics fillrect 0,0,500,500,1
40 sound 330,0.99,100
41 graphics color 0,100,100
42 graphics fillrect 0,0,500,500,1
43 sound 200,0.01,0
50 graphics color 100,100,0
60 graphics fillrect 0,0,500,500,1
70 sound 550,0.74,100
71 graphics color 100,100,0
72 graphics fillrect 0,0,500,500,1
73 sound 200,0.01,0
80 graphics color 0,100,0
90 graphics fillrect 0,0,500,500,1
100 sound 580,0.24,100
101 graphics color 0,100,0
102 graphics fillrect 0,0,500,500,1
103 sound 200,0.01,0
110 graphics color 100,50,0
120 graphics fillrect 0,0,500,500,1
130 sound 490,0.9,100
131 graphics color 100,50,0
132 graphics fillrect 0,0,500,500,1
133 sound 200,0.1,0
140 graphics color 100,50,0
150 graphics fillrect 0,0,500,500,1
160 sound 490,0.9,100
161 graphics color 100,50,0
162 graphics fillrect 0,0,500,500,1
163 sound 200,0.1,0
170 graphics color 100,50,0
180 graphics fillrect 0,0,500,500,1
190 sound 490,1.9,100
191 graphics color 100,50,0
192 graphics fillrect 0,0,500,500,1
193 sound 200,0.1,0
200 graphics color 0,0,100
210 graphics fillrect 0,0,500,500,1
220 sound 740,0.99,100
221 graphics color 0,0,100
222 graphics fillrect 0,0,500,500,1
223 sound 200,0.01,0
230 graphics color 0,100,50
240 graphics fillrect 0,0,500,500,1
250 sound 620,0.74,100
251 graphics color 0,100,50
252 graphics fillrect 0,0,500,500,1
253 sound 200,0.01,0
260 graphics color 50,100,100
270 graphics fillrect 0,0,500,500,1
280 sound 660,0.24,100
281 graphics color 50,100,100
282 graphics fillrect 0,0,500,500,1
283 sound 200,0.01,0
290 graphics color 100,50,50
300 graphics fillrect 0,0,500,500,1
310 sound 880,0.9,100
311 graphics color 100,50,50
312 graphics fillrect 0,0,500,500,1
313 sound 200,0.1,0
319 graphics color 100,50,50
320 graphics fillrect 0,0,500,500,1
330 sound 880,0.9,100
331 graphics color 100,50,50
332 graphics fillrect 0,0,500,500,1
333 sound 200,0.1,0
340 graphics color 100,50,50
350 graphics fillrect 0,0,500,500,1
360 sound 880,1.9,100
361 graphics color 100,50,50
362 graphics fillrect 0,0,500,500,1
363 sound 200,0.1,0
370 graphics color 100,100,0
380 graphics fillrect 0,0,500,500,1
390 sound 550,0.99,100
391 graphics color 100,100,0
392 graphics fillrect 0,0,500,500,1
393 sound 200,0.01,0
400 graphics color 100,25,0
410 graphics fillrect 0,0,500,500,1
420 sound 460,0.74,100
421 graphics color 100,25,0
422 graphics fillrect 0,0,500,500,1
423 sound 200,0.01,0
430 graphics color 100,50,0
440 graphics fillrect 0,0,500,500,1
450 sound 490,0.24,100
451 graphics color 100,50,0
452 graphics fillrect 0,0,500,500,1
453 sound 200,0.01,0
460 graphics color 0,100,0
470 graphics fillrect 0,0,500,500,1
480 sound 580,0.9,100
481 graphics color 0,100,0
482 graphics fillrect 0,0,500,500,1
483 sound 200,0.1,0
490 graphics color 0,100,0
500 graphics fillrect 0,0,500,500,1
510 sound 580,0.9,100
511 graphics color 0,100,0
512 graphics fillrect 0,0,500,500,1
513 sound 200,0.1,0
520 graphics color 0,100,0
530 graphics fillrect 0,0,500,500,1
540 sound 580,1.9,100
541 graphics color 0,100,0
542 graphics fillrect 0,0,500,500,1
543 sound 200,0.1,0
550 graphics color 100,0,100
560 graphics fillrect 0,0,500,500,1
570 sound 415,0.9,100
571 graphics color 100,0,100
572 graphics fillrect 0,0,500,500,1
573 sound 200,0.1,0
580 graphics color 100,0,100
590 graphics fillrect 0,0,500,500,1
600 sound 415,0.74,100
601 graphics color 100,0,100
602 graphics fillrect 0,0,500,500,1
603 sound 200,0.01,0
610 graphics color 100,0,0
620 graphics fillrect 0,0,500,500,1
630 sound 440,0.24,100
631 graphics color 100,0,0
632 graphics fillrect 0,0,500,500,1
633 sound 200,0.01,0
640 graphics color 100,100,0
650 graphics fillrect 0,0,500,500,1
670 sound 550,0.9,100
671 graphics color 100,100,0
672 graphics fillrect 0,0,500,500,1
673 sound 200,0.1,0
680 graphics color 100,100,0
690 graphics fillrect 0,0,500,500,1
700 sound 550,0.9,100
701 graphics color 100,100,0
702 graphics fillrect 0,0,500,500,1
703 sound 200,0.1,0
710 graphics color 100,100,0
720 graphics fillrect 0,0,500,500,1
730 sound 550,1.9,100
731 graphics color 100,100,0
732 graphics fillrect 0,0,500,500,1
733 sound 200,0.1,0
740 graphics color 0,100,100
750 graphics fillrect 0,0,500,500,1
760 sound 330,0.99,100
761 graphics color 0,100,100
762 graphics fillrect 0,0,500,500,1
763 sound 200,0.01,0
770 graphics color 100,100,0
780 graphics fillrect 0,0,500,500,1
790 sound 550,0.74,100
791 graphics color 100,100,0
792 graphics fillrect 0,0,500,500,1
793 sound 200,0.01,0
800 graphics color 0,100,0
810 graphics fillrect 0,0,500,500,1
820 sound 580,0.24,100
821 graphics color 0,100,0
822 graphics fillrect 0,0,500,500,1
823 sound 200,0.01,0
830 graphics color 100,50,0
840 graphics fillrect 0,0,500,500,1
850 sound 490,0.9,100
851 graphics color 100,50,0
852 graphics fillrect 0,0,500,500,1
853 sound 200,0.1,0
860 graphics color 100,50,0
870 graphics fillrect 0,0,500,500,1
880 sound 490,0.9,100
881 graphics color 100,50,0
882 graphics fillrect 0,0,500,500,1
883 sound 200,0.1,0
890 graphics color 100,50,0
900 graphics fillrect 0,0,500,500,1
910 sound 490,1.9,100
911 graphics color 100,50,0
912 graphics fillrect 0,0,500,500,1
913 sound 200,0.1,0
920 graphics color 0,0,100
930 graphics fillrect 0,0,500,500,1
940 sound 740,0.99,100
941 graphics color 0,0,100
942 graphics fillrect 0,0,500,500,1
943 sound 200,0.01,0
950 graphics color 0,100,50
960 graphics fillrect 0,0,500,500,1
970 sound 620,0.74,100
971 graphics color 0,100,50
972 graphics fillrect 0,0,500,500,1
973 sound 200,0.01,0
980 graphics color 50,100,100
990 graphics fillrect 0,0,500,500,1
1000 sound 660,0.24,100
1001 graphics color 50,100,100
1002 graphics fillrect 0,0,500,500,1
1003 sound 200,0.01,0
1010 graphics color 100,100,50
1020 graphics fillrect 0,0,500,500,1
1030 sound 1100,0.9,100
1031 graphics color 100,100,50
1032 graphics fillrect 0,0,500,500,1
1033 sound 200,0.1,0
1040 graphics color 100,100,50
1050 graphics fillrect 0,0,500,500,1
1060 sound 1100,1,100
1061 graphics color 100,100,50
1062 graphics fillrect 0,0,500,500,1
1063 sound 200,0.2,0
1070 graphics color 100,100,50
1080 graphics fillrect 0,0,500,500,1
1090 sound 1100,2.5,100
1091 graphics color 100,100,50
1092 graphics fillrect 0,0,500,500,1
1093 sound 200,1,0
1100 graphics color 100,100,0
1110 graphics fillrect 0,0,500,500,1
1120 sound 550,0.9,100
1121 graphics color 100,100,0
1122 graphics fillrect 0,0,500,500,1
1123 sound 200,0.1,0
1130 graphics color 100,100,0
1140 graphics fillrect 0,0,500,500,1
1150 sound 550,0.74,100
1151 graphics color 100,100,0
1152 graphics fillrect 0,0,500,500,1
1153 sound 200,0.01,0
1160 graphics color 100,50,0
1170 graphics fillrect 0,0,500,500,1
1180 sound 580,0.24,100
1181 graphics color 100,50,0
1182 graphics fillrect 0,0,500,500,1
1183 sound 200,0.01,0
1190 graphics color 0,0,100
1200 graphics fillrect 0,0,500,500,1
1210 sound 740,0.9,100
1211 graphics color 0,0,100
1212 graphics fillrect 0,0,500,500,1
1213 sound 200,0.1,0
1220 graphics color 0,0,100
1230 graphics fillrect 0,0,500,500,1
1240 sound 740,0.9,100
1241 graphics color 0,0,100
1242 graphics fillrect 0,0,500,500,1
1243 sound 200,0.1,0
1250 graphics color 0,0,100
1260 graphics fillrect 0,0,500,500,1
1270 sound 740,1.9,100
1271 graphics color 0,0,100
1272 graphics fillrect 0,0,500,500,1
1273 sound 200,0.1,0
1280 graphics color 100,0,100
1290 graphics fillrect 0,0,500,500,1
1300 sound 415,0.99,100
1301 graphics color 100,0,100
1302 graphics fillrect 0,0,500,500,1
1303 sound 200,0.01,0
1310 graphics color 100,50,0
1320 graphics fillrect 0,0,500,500,1
1330 sound 490,0.74,100
1331 graphics color 100,50,0
1332 graphics fillrect 0,0,500,500,1
1333 sound 200,0.01,0
1340 graphics color 100,0,0
1350 graphics fillrect 0,0,500,500,1
1360 sound 440,0.24,100
1361 graphics color 100,0,0
1362 graphics fillrect 0,0,500,500,1
1363 sound 200,0.01,0
1370 graphics color 100,50,50
1380 graphics fillrect 0,0,500,500,1
1390 sound 880,0.9,100
1391 graphics color 100,50,50
1392 graphics fillrect 0,0,500,500,1
1393 sound 200,0.1,0
1400 graphics color 100,50,50
1410 graphics fillrect 0,0,500,500,1
1420 sound 880,0.9,100
1421 graphics color 100,50,50
1422 graphics fillrect 0,0,500,500,1
1423 sound 200,0.1,0
1430 graphics color 100,50,50
1440 graphics fillrect 0,0,500,500,1
1450 sound 880,3,100
◎金魚 １８-３
100 rem kingyo
110 graphics 0
112 graphics color 0,17,38
113 graphics fillrect 0,0,500,500,1
117 graphics color 26,48,55
118 graphics fillrect 70,10,250,30,1
119 graphics fillrect 70,200,250,220,1
120 graphics fillrect 50,30,70,200,1
121 graphics fillrect 250,30,270,200,1
129 for i = 1 to 55
130 graphics color 76,90,100
131 graphics filloval 90,50,230,190,1
179 graphics color 100,0,0
180 graphics filloval 150+i,60+i,165+i,75+i
182 graphics moveto 150+i,55+i
183 graphics lineto 157+i,60+i
184 graphics moveto 150+i,79+i
185 graphics lineto 157+i,75+i
186 graphics moveto 142+i,62+i
187 graphics lineto 150+i,67.5+i
188 graphics moveto 142+i,67.5+i
189 graphics lineto 150+i,67.5+i
190 graphics moveto 142+i,73+i
191 graphics lineto 150+i,67.5+i
210 t0 = timer : while timer-t0 < 0.05 : wend
220 next i
221 for i = 1 to 55
222 graphics color 76,90,100
223 graphics filloval 90,50,230,190,1
226 graphics color 100,0,0
227 graphics filloval 205-i,115+i,220-i,130+i
228 graphics moveto 225-i,115+i
229 graphics lineto 220-i,122.5+i
230 graphics moveto 200-i,115+i
231 graphics lineto 205-i,122.5+i
232 graphics moveto 207-i,108+i
234 graphics lineto 212.5-i,115+i
235 graphics moveto 212.5-i,108+i
236 graphics lineto 212.5-i,115+i
237 graphics moveto 218-i,108+i
238 graphics lineto 212.5-i,115+i
239 t0 = timer : while timer-t0 < 0.05 : wend
240 next i
241 for i = 1 to 55
242 graphics color 76,90,100
243 graphics filloval 90,50,230,190,1
244 graphics color 100,0,0
245 graphics filloval 150-i,170-i,165-i,185-i
246 graphics moveto 157.5-i,170-i
247 graphics lineto 165-i,165-i
248 graphics moveto 157.5-i,185-i
249 graphics lineto 165-i,190-i
250 graphics moveto 165-i,177.5-i
251 graphics lineto 172-i,172-i
252 graphics moveto 165-i,177.5-i
253 graphics lineto 172-i,177.5-i
254 graphics moveto 165-i,177.5-i
255 graphics lineto 172-i,183-i
256 t0 = timer : while timer-t0 < 0.05 : wend
257 next i
258 for i = 1 to 55
259 graphics color 76,90,100
260 graphics filloval 90,50,230,190,1
261 graphics color 100,0,0
262 graphics filloval 95+i,115-i,110+i,130-i
263 graphics moveto 95+i,122.5-i
264 graphics lineto 90+i,130-i
265 graphics moveto 110+i,122.5-i
266 graphics lineto 115+i,130-i
267 graphics moveto 102.5+i,130-i
268 graphics lineto 97+i,137-i
269 graphics moveto 102.5+i,130-i
270 graphics lineto 102.5+i,137-i
271 graphics moveto 102.5+i,130-i
272 graphics lineto 108+i,137-i
273 t0 = timer : while timer-t0 < 0.05 : wend
274 next i
275 for i = 1 to 55
276 graphics color 76,90,100
277 graphics filloval 90,50,230,190,1
278 graphics color 100,0,0
279 graphics filloval 150,60+i,165,75+i
280 graphics moveto 145,60+i
281 graphics lineto 150,67.5+i
282 graphics moveto 170,60+i
283 graphics lineto 165,67.5+i
284 graphics moveto 157.5,60+i
285 graphics lineto 152,53+i
286 graphics moveto 157.5,53+i
287 graphics lineto 157.5,67+i
288 graphics moveto 157.5,60+i
289 graphics lineto 163,53+i
290 t0 = timer : while timer-t0 < 0.05 : wend
291 next i
292 for i = 1 to 70 step 20
293 r = rnd(100)
294 g = rnd(100)
295 b = rnd(100)
298 graphics color 26+r,48+g,55-b
299 graphics fillrect 70,10,250,30,i : print i
300 graphics fillrect 70,200,250,220,i : print i
301 graphics fillrect 50,30,70,200,i : print i
302 graphics fillrect 250,30,270,200,i : print i
403 graphics color 0,17,38
404 graphics filloval 155-i,115-i,165+i,125+i,1
405 graphics color 76,90,100
406 graphics filloval 157-i,117-i,163+i,123+i,1
407 graphics color 0,17,38
408 graphics filloval 165-i,125-i,155+i,115+i,1
409 graphics color 76,90,100
410 graphics filloval 167-i,127-i,153+i,113+i,1
411 graphics color 0,17,38
412 graphics filloval 180-i,140-i,141+i,101+i,1
413 graphics color 76,90,100
414 graphics filloval 182-i,142-i,139+i,99+i,1
415 t0 = timer : while timer-t0 < 0.2 : wend
416 s = rnd(13)*36+440 : t = rnd(1)+0.1 : v = rnd(10)*10
417 sound s,t,v
418 next i
419 for i = 1 to 70 step 11
420 graphics color 76,90,100
421 graphics filloval 90,50,230,190,1
422 graphics color 0,17,38
423 graphics filloval 165-i,125-i,155+i,115+i,1
424 graphics color 76,90,100
425 graphics filloval 167-i,127-i,153+i,113+i,1
433 graphics color 100,0,0
444 graphics filloval 150,115,165,130
445 graphics moveto 150,122.5
446 graphics lineto 145,130
447 graphics moveto 165,122.5
448 graphics lineto 170,130
449 graphics moveto 157.5,130
450 graphics lineto 152,137
451 graphics moveto 157.5,130
452 graphics lineto 157.5,137
453 graphics moveto 157.5,130
454 graphics lineto 163,137
455 t0 = timer : while timer-t0 < 0.2 : wend
456 next i
457 graphics color 26,48,55
458 graphics fillrect 70,10,250,30,1
459 graphics fillrect 70,200,250,220,1
460 graphics fillrect 50,30,70,200,1
461 graphics fillrect 250,30,270,200,1
480 for i = 1 to 55
481 graphics color 76,90,100
482 graphics filloval 90,50,230,190,1
483 graphics color 100,0,0
484 graphics filloval 150,115-i,165,130-i
485 graphics moveto 150,122.5-i
486 graphics lineto 145,130-i
487 graphics moveto 165,122.5-i
488 graphics lineto 170,130-i
489 graphics moveto 157.5,130-i
490 graphics lineto 152,137-i
491 graphics moveto 157.5,130-i
492 graphics lineto 157.5,137-i
493 graphics moveto 157.5,130-i
494 graphics lineto 163,137-i
495 t0 = timer : while timer-t0 < 0.05 : wend
496 next i
500 goto 110
このソフトは精神科医・町沢静夫氏による『ボーダーラインの心の病理』(創元社)の「ボーダーライン・スケール」を元に作成しました。あくまでもウェブ上でのカウンセリング・システムの一つの試みです。医学的診断をすることが目的ではありませんので、その点をご理解の上ご使用下さい。ページをリセットしたい時は、一度ウィンドウを閉じて、もう一度リンクをクリックして下さい。