1000 REM LUSCHER COLOUR TEST 1010 REM 1020 REM BASED ON THE ENGLISH TRANS- 1030 REM LATION OF THE ORIGINAL GERMAN 1040 REM TEXT BY DR. MAX LUSCHER. 1050 REM 1060 REM READ THE FOLLOWING PAPERBACK: 1070 REM "THE LUSCHER COLOUR TEST" 1080 REM TRANSLATED AND EDITTED BY IAN SCOTT 1090 REM SBN 671-78073-5 1100 REM POCKET BOOK EDITION SEPT.1971 1110 REM 1120 REM PROGRAM WRITTEN BY: 1130 REM GLEN C. BODIE 1140 REM 90 KINGSMOUNT PK RD 1150 REM TORONTO, ONTARIO 1160 REM (416)461-3483 1170 REM 1180 REM ****************************** 1190 REM * PERMISSION GRANTED TO USE, * 1200 REM * COPY AND DISTRIBUTE BUT NOT* 1210 REM * FOR PROFIT OF ANY KIND. * 1220 REM ****************************** 1230 REM 1240 REM INITIALIZATION 1250 POKE 53280,1: POKE 53281,1: Z=0 1260 DIM BC(1,7) 1270 FOR I=0 TO 7: READ BC(0,I): NEXT 1280 DATA 152,31,30,129,158,156,149,144 1290 PRINT "[147][144]DO YOU WANT OUTPUT ON THE SCREEN (S)" 1300 PRINT "OR ON THE TYPER (T)? ";: D=4 1310 GET K$: IF K$="" THEN GOTO 1310 1320 IF K$="S" THEN D=3: GOTO 1340 1330 IF K$<>"T" THEN GOTO 1310 1340 PRINT K$: OPEN 1,D: GOSUB 3000 1350 PRINT "DO YOU NEED INSTRUCTIONS (Y OR N)? "; 1360 GET K$: IF K$="" THEN GOTO 1360 1370 IF K$="Y" THEN GOSUB 2350: GOTO 1400 1380 IF K$<>"N" THEN GOTO 1360 1390 PRINT K$ 1400 INPUT "ENTER YOUR NAME, PLEASE:";N$ 1410 POKE 198,1: POKE 631,34: INPUT "AND THE DATE:";D$ 1420 GOSUB 3040: T=0: X=RND(-TI) 1430 REM WRITE THE EIGHT COLOUR BARS 1440 GOSUB 3000 1450 FOR I=0 TO 7: BC(1,I)=-1: T(T,I)=-1: NEXT 1460 PRINT "[147]";: FOR I=0 TO 7 1470 X=INT(RND(1)*8): IF BC(1,X)>=0 THEN GOTO 1470 1480 BC(1,X)=I: J=FNJ(I): K=FNK(I) 1490 PRINT "";: FOR N=1 TO K: PRINT "";: NEXT N 1500 FOR N=1 TO 6: PRINT TAB(J)CHR$(BC(0,X))" ": NEXT N 1510 PRINT TAB(J+2)"[144]"CHR$(65+I): NEXT I 1520 REM GET THE USER'S SELECTION 1530 PRINT "[144]CHOOSE THE COLOUR (LETTER A TO H) FOR" 1540 PRINT "WHICH YOU HAVE THE MOST SYMPATHY" 1550 FOR I=0 TO 7 1560 POKE 198,0 1570 GET K$: IF K$="" THEN GOTO 1570 1580 IF K$<"A" OR K$>"H" THEN GOTO 1560 1590 K=ASC(K$)-65: FOR X=0 TO 7: IF BC(1,X)=K THEN GOTO 1610 1600 NEXT X: GOTO 1560 1610 T(T,I)=X: BC(1,X)=-1: J=FNJ(K): K=FNK(K) 1620 PRINT "";: FOR N=1 TO K: PRINT "";: NEXT N 1630 FOR N=1 TO 8: PRINT TAB(J)" ": NEXT N 1640 NEXT I: IF T=1 THEN GOTO 1710 1650 T=1: PRINT "[147][144]LET'S TRY IT ONCE MORE........" 1660 PRINT "REMEMBER - DON'T TRY TO CONSCIOUSLY" 1670 PRINT "REPEAT OR NOT REPEAT THE FIRST CHOICES." 1680 PRINT "TREAT THIS AS IF IT WAS THE FIRST TIME." 1690 FOR I=1 TO 7500: NEXT: GOTO 1440 1700 REM ECHO COLOUR NUMBERS CHOSEN 1710 Z=1: GOSUB 3000: FOR T=0 TO 1: PRINT#1,"TEST #"(T+1)": "; 1720 FOR I=0 TO 7: PRINT#1,T(T,I);: NEXT: PRINT 1730 PRINT#1,SPC(13)"[173][195][195][195][195][189][173][195][195][195][195][189][173][195][195][195][195][189][173][195][195][195][195][189]": NEXT 1740 PRINT#1,SPC(13)" + X = -" 1750 PRINT#1,"COLOURS: 0 = GREY "SPC(6)"1 = BLUE" 1760 PRINT#1,SPC(10)"2 = GREEN "SPC(6)"3 = RED" 1770 PRINT#1,SPC(10)"4 = YELLOW"SPC(6)"5 = PURPLE" 1780 PRINT#1,SPC(10)"6 = BROWN "SPC(6)"7 = BLACK" 1790 PRINT#1,"THE DIFFERENT GROUPINGS ARE DESIGNATED:" 1800 FOR A=0 TO 3: PRINT#1," "I$(0,A)" "D$(A): NEXT 1810 PRINT#1," +/- "D$(4) 1820 OPEN 15,8,15 1830 FOR A=0 TO 4: FL$="LUSCHER.TEXT"+CHR$(48+A) 1840 OPEN 2,8,2,"0:"+FL$+",S,R": INPUT#15,EN: IF EN<>0 THEN GOTO 3320 1850 FOR I=0 TO 63: FOR L=0 TO 3: INPUT#2,A$(L,I): NEXT L: NEXT I 1860 CLOSE 2 1870 FOR T=0 TO 1: IF A=4 THEN C1=T(T,0): C2=T(T,7): GOTO 1890 1880 C1=T(T,A*2): C2=T(T,A*2+1) 1890 GOSUB 2970: PRINT#1,""D$(A)":" 1900 PRINT#1,SPC(10)"TEST #"(T+1)": "I$(0,A)C1;I$(1,A)C2"" 1910 I=C1*8+C2: FOR L=0 TO 3: IF A$(L,I)="*" THEN A$(L,I)=" " 1920 PRINT#1,A$(L,I): NEXT 1930 ON A+1 GOTO 1940,1960,1990,1940,1990 1940 PRINT#1,"PERCENTAGE OF POPULATION WHICH CHOSE" 1950 PRINT#1,"THIS COLOUR PAIR IN THIS POSITION:"P(A/3,I)"[157]%": GOTO 1990 1960 PRINT#1,"THE PREVIOUSLY DESCRIBED +/+ FUNCTION" 1970 PRINT#1,"IS AN ATTEMPT TO COMPENSATE FOR THE" 1980 PRINT#1,"CONFLICT WHICH MAY BE DESCRIBED HERE." 1990 NEXT T: NEXT A 2000 GOSUB 2970: PRINT#1,""SPC(10)"STRESS CALCULATIONS" 2010 FOR T=0 TO 1: IF T=1 THEN X=S 2020 S=0: IF T(T,0)=0 OR T(T,0)>=6 THEN S=S+3 2030 IF T(T,1)=0 OR T(T,1)>=6 THEN S=S+2 2040 IF T(T,2)=0 OR T(T,2)>=6 THEN S=S+1 2050 IF T(T,5)>=1 AND T(T,5)<=4 THEN S=S+1 2060 IF T(T,6)>=1 AND T(T,6)<=4 THEN S=S+2 2070 IF T(T,7)>=1 AND T(T,7)<=4 THEN S=S+3 2080 PRINT#1,"TEST #"(T+1)":"ST(S)"[157]% OF THE POPULATION" 2090 PRINT#1,SPC(17)"HAD LESS STRESS.": NEXT 2100 IF S<=X THEN GOTO 2140 2110 PRINT#1,"THIS INCREASE IN STRESS BETWEEN THE TWO" 2120 PRINT#1,"TESTS MAY INDICATE A PROBLEM WHICH WILL" 2130 PRINT#1,"BE QUITE DIFFICULT TO RESOLVE." 2140 GOSUB 2970 2150 PRINT#1,"WHERE THE TWO TESTS PRODUCED SIGNIF-" 2160 PRINT#1,"ICANTLY DIFFERENT RESULTS, THE SECOND" 2170 PRINT#1,"ONE IS EXPECTED TO BE MORE CORRECT." 2180 PRINT#1,"IN ALL CASES, THE ANALYSIS OF THE" 2190 PRINT#1,"COLOURS SELECTED SHOULD ONLY BE TREATED" 2200 PRINT#1,"AS INDICATORS OF AREAS WHERE PROFESS-" 2210 PRINT#1,"IONAL ASSISTANCE SHOULD BE CONSIDERED." 2220 PRINT#1,"THIS PROGRAM HAS ONLY BEEN GIVEN THE" 2230 PRINT#1,"ABILITY TO DO VERY SIMPLEX ANALYSES." 2240 PRINT#1,"WHERE MORE DETAIL IS DESIRED IN TERMS" 2250 PRINT#1,"OF THE INTERACTIONS OF THE COLOURS SEL-" 2260 PRINT#1,"ECTED OR THE DIFFERENCES BETWEEN THE" 2270 PRINT#1,"TWO SELECTIONS, THE USER IS ADVISED TO" 2280 PRINT#1,"READ THE FOLLOWING BOOK:" 2290 PRINT#1," THE LUSCHER COLOUR TEST" 2300 PRINT#1," TRANSLATED & EDITTED BY IAN SCOTT" 2310 PRINT#1," RANDOM HOUSE, NOV. 1969" 2320 PRINT#1," SBN 671-78073-5" 2330 CLOSE1: END 2340 REM INSTRUCTIONS............. 2350 GOSUB 3000 2360 PRINT#1,"WHEN THE EIGHT COLOUR BARS APPEAR ON" 2370 PRINT#1,"THE SCREEN, LOOK THEM OVER AND DECIDE" 2380 PRINT#1,"WHICH COLOUR YOU LIKE THE BEST. DO" 2390 PRINT#1,"NOT TRY TO ASSOCIATE THE COLOUR WITH" 2400 PRINT#1,"SOMETHING ELSE[146], SUCH AS A CAR OR A " 2410 PRINT#1,"DRESS. JUST CHOOSE THE COLOUR FOR WHICH" 2420 PRINT#1,"YOU FEEL THE MOST SYMPATHY. PRESS THE" 2430 PRINT#1,"KEY CORRESPONDING TO THE LETTER UNDER" 2440 PRINT#1,"YOUR SELECTED COLOUR AND THE COLOUR BAR" 2450 PRINT#1,"WILL BE ERASED TO SHOW THAT YOU HAVE" 2460 PRINT#1,"CHOSEN THAT COLOUR. NOW LOOK AT THE" 2470 PRINT#1,"REMAINING COLOURS. CHOOSE THE ONE WHICH" 2480 PRINT#1,"YOU NOW LIKE THE BEST AND SELECT IT AS" 2490 PRINT#1,"BEFORE. CONTINUE CHOOSING COLOURS UNTIL" 2500 PRINT#1,"THEY ARE ALL GONE." 2510 GOSUB 2970 2520 PRINT#1,"WHEN YOU HAVE COMPLETED THE FIRST SEL-" 2530 PRINT#1,"ECTION, YOU WILL BE ASKED TO DO IT ALL" 2540 PRINT#1,"OVER AGAIN. DO NOT CONSCIOUSLY TRY TO" 2550 PRINT#1,"REPRODUCE YOUR FIRST SELECTION. DO NOT" 2560 PRINT#1,"CONSCIOUSLY TRY NOT TO REPRODUCE YOUR" 2570 PRINT#1,"FIRST SELECTION. JUST CHOOSE THE" 2580 PRINT#1,"COLOURS AS IF YOU WERE SEEING THEM FOR" 2590 PRINT#1,"THE FIRST TIME. WHEN YOU HAVE COMPLETED" 2600 PRINT#1,"THE SECOND SELECTION, YOU WILL BE GIVEN" 2610 PRINT#1,"A VERY ROUGH ANALYSIS OF YOUR COLOUR" 2620 PRINT#1,"PREFERENCES." 2630 GOSUB 2970 2640 PRINT#1,"THE PRICIPLE OF THE LUSCHER COLOUR TEST" 2650 PRINT#1,"IS THAT ACCURATE PSYCHOLOGICAL INFORM-" 2660 PRINT#1,"ATION CAN BE GAINED ABOUT A PERSON THRU" 2670 PRINT#1,"HIS CHOICES AND REJECTIONS OF COLOURS." 2680 PRINT#1,"A SIMPLIFIED VERSION OF THE TEST MAY BE" 2690 PRINT#1,"TAKEN AND INTERPRETED QUICKLY. HOWEVER" 2700 PRINT#1,"DESPITE THE EASE AND SPEED WITH WHICH" 2710 PRINT#1,"IT CAN BE ADMINISTERED, IT IS A 'DEEP'" 2720 PRINT#1,"PSYCHOLOGICAL TEST DEVELOPED FOR THE" 2730 PRINT#1,"USE OF PSYCHIATRISTS, PSYCHOLOGISTS," 2740 PRINT#1,"PHYSICIANS AND THOSE WHO ARE PROFESS-" 2750 PRINT#1,"IONALLY INVOLVED WITH THE CONSCIOUS AND" 2760 PRINT#1,"UNCONSCIOUS CHARACTERISTICS AND MOTIV-" 2770 PRINT#1,"ATIONS OF OTHERS. IT IS NOT[146] A" 2780 PRINT#1,"PARLOUR GAME, AND MOST EMPHATICALLY IT" 2790 PRINT#1,"IS NOT A WEAPON TO BE USED IN A GENERAL" 2800 PRINT#1,"CONTEST OF 'ONE-UPMANSHIP'." 2810 GOSUB 2970 2820 PRINT "FOR ACCURACY OF RESULTS, PLEASE ADJUST" 2830 PRINT "THE TINT, COLOUR, BRIGHTNESS & CONTRAST" 2840 PRINT "CONTROLS OF YOUR TELEVISION SO THAT THE" 2850 PRINT "FOLLOWING COLOURS APPEAR CORRECTLY." 2860 PRINT CHR$(BC(0,0))"GREY "SPC(5)" " 2870 PRINT CHR$(BC(0,1))"BLUE "SPC(5)" " 2880 PRINT CHR$(BC(0,2))"GREEN "SPC(5)" " 2890 PRINT CHR$(BC(0,3))"RED "SPC(5)" " 2900 PRINT CHR$(BC(0,4))"YELLOW "SPC(5)" " 2910 PRINT CHR$(BC(0,5))"PURPLE "SPC(5)" " 2920 PRINT CHR$(BC(0,6))"BROWN "SPC(5)" " 2930 PRINT CHR$(BC(0,7))"BLACK "SPC(5)" [144]" 2940 GOSUB 2970 2950 RETURN 2960 REM CONTINUE & WRITE HEADING 2970 IF D=4 THEN GOTO 3000 2980 PRINT#1,"PRESS ANY KEY TO CONTINUE........": POKE 198,0 2990 GET K$: IF K$="" THEN GOTO 2990 3000 PRINT#1,"[147][144]"SPC(10)"LUSCHER COLOUR TEST" 3010 PRINT#1,SPC(10)"[183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183]": IF Z=0 THEN RETURN 3020 PRINT#1,"RESULTS FOR "N$SPC(5)D$: RETURN 3030 REM DEFINE DATA 3040 PRINT "WAIT WHILE DATA IS INITIALIZED." 3050 DIM T(1,7),ST(13),I$(1,4),D$(4),A$(3,63),P(1,63) 3060 DEF FN J(I)=(I-INT(I/4)*4)*10+2 3070 DEF FN K(I)=INT(I/4)*9+3 3080 FOR I=0 TO 4: READ D$(I): NEXT 3090 DATA "DESIRED OBJECTIVES","EXISTING SITUATION" 3100 DATA "RESTRAINED CHARACTERISTICS","REJECTED CHARACTERISTICS" 3110 DATA "THE ACTUAL PROBLEM" 3120 FOR I=0 TO 4: FOR J=0 TO 1: READ I$(J,I): NEXT J: NEXT I 3130 DATA "+","+","X","X","=","=","-","-","+","-" 3140 FOR I=0 TO 12: READ ST(I): NEXT 3150 DATA 0,25.9,38.1,52.4,64.1,72.7,81.8,87.3,92.1,95.5,97.9,99.3,99.9 3160 REM +?+? FUNCTIONS PROBABILITIES 3170 FOR J=0 TO 7: FOR K=0 TO 7: L=J*8+K: READ P(0,L): NEXT K: NEXT J 3180 DATA 2.7,0.6,0.4,0.5,0.3,0.2,0.6,0.2,1.2,15.9,3.8,3.6,1.4,4.4,1.1,0.5 3190 DATA 0.7,3.5,18.1,5.2,2.3,4.2,1.8,0.5,0.9,4.4,6.6,28.9,11.0,3.5,2.1,0.3 3200 DATA 0.5,1.2,2.2,6.7,12.5,1.2,0.6,0.3,0.3,4.1,4.8,3.3,1.8,15.3,0.6,0.4 3210 DATA 0.6,0.7,1.2,1.1,0.5,0.4,4.7,0.2,0.3,0.4,0.3,0.2,0.3,0.2,0.1,1.8 3220 REM X?X? FUNCTIONS - NO DATA 3230 REM =?=? FUNCTIONS - NO DATA 3240 REM -?-? FUNCTIONS 3250 FOR J=0 TO 7: FOR K=0 TO 7: L=J*8+K: READ P(1,L): NEXT K: NEXT J 3260 DATA 23.1,0.9,0.4,0.5,1.7,1.7,3.8,15.3,1.5,4.7,0.2,0.2,0.3,2.0,0.6,4.9 3270 DATA 0.7,0.3,2.8,0.2,0.4,1.0,0.7,1.7,0.8,0.2,0.1,3.4,1.5,0.8,0.7,0.9 3280 DATA 2.1,0.2,0.2,0.9,8.6,1.2,1.1,3.4,1.7,0.9,0.5,0.3,0.9,11.0,1.0,3.6 3290 DATA 5.8,0.5,0.2,0.6,1.3,1.5,11.4,5.3,10.5,1.7,0.8,0.7,2.5,3.0,3.5,35.1 3300 REM +?-? FUNCTIONS - NO DATA 3310 RETURN 3320 PRINT "DISK ERROR #"EN: CLOSE1: CLOSE2: CLOSE15: END