100 PROGRAM "3D_4row.bas"
  110 ! programmeret af Erik Christensen
  120 RANDOMIZE 
  130 SET STATUSOFF
  140 DIM YY(4),ZZ(4),KOX(4,16),KOY(4,16),XR(4,16),YR(4,16),ZR(4,16)
  150 DIM X6(4),Y6(4),CC(4,16),VV(4,16),RX(4,4),RY(4,4)
  160 NUMERIC A,B,C,A1,B1,C1,BC,BC1
  170 RESTORE  220
  180 FOR I=0TO4
  190   READ YY(I),ZZ(I)
  200   LET YY(I)=YY(I)-4:LET ZZ(I)=ZZ(I)-3.8
  210 NEXT 
  220 DATA 0,0,8,0,8,8,0,8,0,0
  230 OPTION ANGLEDEGREES
  240 LET RHO=60:LET TH=110:LET PH=90:LET D=4600:LET S1=SIN(TH):LET C3=COS(TH):LET S2=SIN(PH):LET C2=COS(PH)
  250 LET EA=C3*C2:LET EB=S1*C2:LET EC=S2*C3:LET ED=S2*S1
  260 LET CX=640:LET CY=360:LET SX=0:LET SY=0
  270 TEXT 40
  280 PRINT :PRINT "Velkommen til tredimensionalt fire p} stribe.":PRINT :PRINT " Programmeret af Erik Christensen":PRINT 
  290 CALL RAMMER:CALL INITPKT
  300 LET G=1:LET M=0
  310 FOR A=1TO4
  320   FOR B=1TO4
  330     FOR C=1TO4
  340       LET V=0:LET BC=B*4-4+C
  350       IF A=BANDA=CTHENLET V=10
  360       IF A=CANDA=5-BTHENLET V=10
  370       IF A=5-CANDB=CTHENLET V=10
  380       IF A=BANDA=5-CTHENLET V=10
  390       LET VV(A,BC)=V:LET CC(A,BC)=1
  400     NEXT 
  410   NEXT 
  420 NEXT 
  430 GRAPHICS HIRES2
  440 CALL PLRAM:CALL PLPKT
  450 CALL TRAEK
  460 END 
  470 DEF LV
  480   NUMERIC F,T,Z,FL
  490   LET A1=A:LET B1=B:LET C1=C:LET Z=0:LET FL=0
  500   FOR F=1TO2
  510     FOR T=1TO4
  520       SELECT CASEV
  530       CASE 1
  540         LET A1=T
  550       CASE 2
  560         LET B1=T
  570       CASE 3
  580         LET C1=T
  590       CASE 4
  600         LET A1,B1=T
  610       CASE 5
  620         LET A1,C1=T
  630       CASE 6
  640         LET B1,C1=T
  650       CASE 7
  660         LET A1=T:LET B1=5-T
  670       CASE 8
  680         LET A1=T:LET C1=5-T
  690       CASE 9
  700         LET B1=T:LET C1=5-T
  710       CASE 10
  720         LET A1,B1=T:LET C1=5-T
  730       CASE 11
  740         LET A1,C1=T:LET B1=5-T
  750       CASE 12
  760         LET A1=T:LET B1,C1=5-T
  770       CASE 13
  780         LET A1,B1,C1=T
  790       END SELECT 
  800       LET BC1=B1*4-4+C1
  810       IF F=2THEN
  820         LET VV(A1,BC1)=VV(A1,BC1)+Z
  830         IF FL>0THENLET X6(T)=A1:LET Y6(T)=BC1
  840       END IF 
  850       IF F=1THENLET G=G*CC(A1,BC1)
  860     NEXT T
  870     IF F=1THEN
  880       CALL VALU(FL)
  890     ELSE 
  900       IF FL>0THENCALL VIND
  910     END IF 
  920   NEXT F
  930 END DEF 
  940 DEF LC
  950   NUMERIC V
  960   FOR V=1TO3
  970     CALL LV
  980   NEXT 
  990   IF A=BTHEN
 1000     LET V=4:CALL LV
 1010     IF A=5-CTHENLET V=10:CALL LV
 1020     IF B=CTHENLET V=13:CALL LV
 1030   END IF 
 1040   IF A=CTHEN
 1050     LET V=5:CALL LV
 1060     IF A=5-BTHENLET V=11:CALL LV
 1070   END IF 
 1080   IF B=CTHEN
 1090     LET V=6:CALL LV
 1100     IF A=5-CTHENLET V=12:CALL LV
 1110   END IF 
 1120   IF A=5-BTHENLET V=7:CALL LV
 1130   IF A=5-CTHENLET V=8:CALL LV
 1140   IF B=5-CTHENLET V=9:CALL LV
 1150 END DEF 
 1160 DEF VALU(REFFL)
 1170   NUMERIC N
 1180   LET BC=B*4-4+C
 1190   SELECT CASEG
 1200   CASE 2
 1210     LET Z=14
 1220   CASE 3
 1230     LET Z=10
 1240   CASE 4
 1250     LET Z=100
 1260   CASE 6
 1270     LET Z=-14
 1280     IF CC(A,BC)=2THENLET Z=-10
 1290   CASE 8
 1300     LET Z=1000
 1310   CASE 9
 1320     LET Z=98
 1330   CASE 12
 1340     LET Z=-100
 1350     IF CC(A,BC)=2THENLET Z=0
 1360   CASE 16
 1370     LET FL=1
 1380   CASE 18
 1390     LET Z=-98
 1400     IF CC(A,BC)=3THENLET Z=0
 1410   CASE 27
 1420     LET Z=900
 1430   CASE 81
 1440     LET FL=2
 1450   CASE ELSE
 1460     LET Z=0
 1470   END SELECT 
 1480   LET G=1
 1490 END DEF 
 1500 DEF MAXI
 1510   NUMERIC H,J
 1520   LET H=0
 1530   FOR A=1TO4
 1540     FOR B=1TO4
 1550       FOR C=1TO4
 1560         LET BC=B*4-4+C:LET J=VV(A,BC)
 1570         IF CC(A,BC)=1ANDJ>=HTHEN
 1580           IF J>HOR(J=HANDRND>.5)THENLET H=J:LET A1=A:LET B1=B:LET C1=C
 1590         END IF 
 1600       NEXT 
 1610     NEXT 
 1620   NEXT 
 1630   LET A=A1:LET B=B1:LET C=C1:LET BC=B*4-4+C
 1640 END DEF 
 1650 DEF RAMMER
 1660   LET J=1
 1670   FOR X=-6TO6STEP4
 1680     FOR I=0TO4
 1690       LET Y=YY(I):LET Z=ZZ(I):CALL CALC:LET RX(J,I)=SX:LET RY(J,I)=SY
 1700     NEXT 
 1710     LET J=J+1
 1720   NEXT 
 1730 END DEF 
 1740 DEF PLRAM
 1750   FOR J=1TO4
 1760     FOR I=0TO4
 1770       PLOT RX(J,I),RY(J,I);
 1780     NEXT 
 1790     SET BEAMOFF
 1800   NEXT 
 1810 END DEF 
 1820 DEF PLPKT
 1830   FOR I=1TO4
 1840     FOR J=1TO16
 1850       PLOT KOX(I,J),KOY(I,J)
 1860     NEXT 
 1870   NEXT 
 1880 END DEF 
 1890 DEF INITPKT
 1900   RESTORE  3160
 1910   LET Z=-3
 1920   FOR A=1TO4
 1930     LET X=6
 1940     FOR B=1TO4
 1950       LET Y=3
 1960       FOR C=1TO4
 1970         LET BC=B*4-4+C:CALL CALC:LET XPL=INT(SX/2)*2:LET YPL=INT(SY/4)*4
 1980         LET KOX(A,BC)=XPL:LET KOY(A,BC)=YPL:LET XR(A,BC)=X:LET YR(A,BC)=Y:LET ZR(A,BC)=Z
 1990         LET Y=Y-2
 2000         READ U$
 2010         PRINT U$&" ";
 2020       NEXT 
 2030       LET X=X-4
 2040     NEXT 
 2050     LET Z=Z+2
 2060   NEXT 
 2070 END DEF 
 2080 DEF CALC
 2090   LET XE=-X*S1+Y*C3:LET YE=-X*EA-Y*EB+Z*S2:LET ZE=-X*EC-Y*ED-Z*C2+RHO
 2100   LET SX=D*XE/ZE+CX:LET SY=D*YE/ZE+CY
 2110 END DEF 
 2120 DEF TAL(T)
 2130   NUMERIC K,L,J
 2140   LET K=LEN(STR$(T))
 2150   LET L=.2
 2160   IF K=2THENLET L=.6
 2170   FOR J=1TOK
 2180     LET Y=YR(A,BC)+L:LET Z=ZR(A,BC)+1:CALL CALC
 2190     PLOT SX,SY,
 2200     PRINT #101:STR$(T)(J:J)
 2210     LET L=L-.7
 2220   NEXT 
 2230 END DEF 
 2240 DEF TEGN
 2250   LET SX1=KOX(A,BC):LET SY1=KOY(A,BC)
 2260   SET LINEMODE3
 2270   PLOT SX1,SY1
 2280   SET LINEMODE0
 2290   LET X=XR(A,BC):LET Y=YR(A,BC):LET Z=ZR(A,BC)+.58
 2300   CALL CALC
 2310   LET SY2=SY:LET Y=Y+.58:LET Z=Z-.58
 2320   CALL CALC
 2330   PLOT ELLIPSEABS(SX1-SX),ABS(SY1-SY2),
 2340   IF MOD(M,2)=1THENPLOT PAINT
 2350   CALL TAL(M)
 2360 END DEF 
 2370 DEF TRAEK
 2380   NUMERIC X,Y,XI,YI,JY
 2390   STRING I$
 2400   LET I$=""
 2410   DO 
 2420     CLEAR TEXT
 2430     PRINT "Din tur til at tr{kke !"
 2440     SET LINEMODE3
 2450     LET YI=2:LET XI=9
 2460     LET X=KOX(YI,XI):LET Y=KOY(YI,XI)
 2470     DO 
 2480       DO 
 2490         PLOT X-4,Y+16,
 2500         PRINT #101:"*"
 2510         LET I$=INKEY$
 2520         PLOT X-4,Y+16,
 2530         PRINT #101:"*"
 2540         IF I$=""THENLET I$=INKEY$
 2550       LOOP UNTILI$<>""
 2560       SELECT CASEORD(UCASE$(I$))
 2570       CASE 176
 2580         LET YI=MOD(YI,4)+1
 2590       CASE 180
 2600         LET YI=MOD(YI-2,4)+1
 2610       CASE 184
 2620         LET XI=MOD(XI-2,16)+1
 2630       CASE 188
 2640         LET XI=MOD(XI,16)+1
 2650       CASE ELSE
 2660         LET FILL=0
 2670       END SELECT 
 2680       LET X=KOX(YI,XI):LET Y=KOY(YI,XI)
 2690     LOOP UNTILI$=CHR$(13)
 2700     IF I$=CHR$(13)THEN
 2710       SET LINEMODE0
 2720       LET BC=XI:LET A=YI
 2730       IF CC(A,BC)<>1THENPRINT "plads besat":GOTO  2830
 2740       LET M=M+1:LET B=INT((XI-1)/4)+1:LET C=MOD((XI-1),4)+1:LET A=YI:LET CC(A,BC)=3
 2750       CALL TEGN
 2760       CLEAR TEXT
 2770       PRINT "ENTERPRISE t{nker"
 2780       CALL LC:CALL MAXI:LET CC(A,BC)=2:LET M=M+1
 2790       PING 
 2800       CALL TEGN
 2810       PRINT "ENTERPRISE har nu trukket"
 2820       CALL LC
 2830       PING 
 2840     END IF 
 2850   LOOP 
 2860 END DEF 
 2870 DEF VIND
 2880   IF FL=2THENCALL VIND2
 2890   IF FL=1THENCALL VIND1
 2900   SET LINEMODE3
 2910   DO UNTILI$=" "
 2920     FOR J=1TO2
 2930       FOR I=1TO4
 2940         PLOT KOX(X6(I),Y6(I))-6,KOY(X6(I),Y6(I))+12,
 2950         PRINT #101:"+"
 2960         IF I$<>" "THENLET I$=INKEY$
 2970       NEXT 
 2980     NEXT 
 2990     IF I$<>" "THENLET I$=INKEY$
 3000   LOOP 
 3010   SET LINEMODE0
 3020   CLEAR SCREEN
 3030   PRINT :PRINT "Jeg lader lige op til n{ste spil. Det tager et |jeblik."
 3040   GOTO  300
 3050 END DEF 
 3060 DEF VIND2
 3070   PRINT "BRAVO.   Du vandt over ENTERPRISE."
 3080   PRINT "Det var godt klaret."
 3090   PRINT "tryk <space>"
 3100 END DEF 
 3110 DEF VIND1
 3120   PRINT "ENTERPRISE vandt over dig."
 3130   PRINT "Tab ikke modet.  Pr|v igen."
 3140   PRINT "tryk <space>"
 3150 END DEF 
 3160 DATA Dette,spil,g}r,ud,p},at,placere,fire,cirkler,p},en,ret,linie,d.v.s.,enten,vandret,lodret,eller,p},skr}.,Cirklerne,skal,placeres,i,en,terning,der,m}ler,fire,p},hver,led.
 3170 DATA Du,placerer,curseren,p},det,sted,hvor,cirklen,skal,placeres,og,derefter,trykker,du,p},ENTER.,Du,og,computeren,skiftes,til,at,tr{kke.,Du,skal,spille,godt,for,at,sl},computeren.,God forn|jelse.