Keskustelu: Koodit: Hikiliikkuja-demo (GW-Basic)

1 REM   HIKILIIKKUJA - PERSPIRATUAL MOTION MACHINE
2 REM   tAAt 2004 - http://tAAt.fi
3 REM
4 REM   Basic interpreter:  GWBASIC
5 REM
6 REM   Recommended: 256KB EGA adaptor and
7 REM                AdLib/SB card for music.
8 REM                (Use VDMSound with Win2K/XP)
9 REM
10 KEY OFF:RANDOMIZE 14
20 DEFINT A-Z:DEFDBL T
30 SCREEN 7,,0,0:CLS
35 GOSUB 10300
40 GOSUB 1010
50 C=2:Y=11:A$="WELCOME TO THE":GOSUB 500
60 C=2:Y=14:A$="WORLD OF BASIC":GOSUB 500
65 GOSUB 1020:CLS:GOSUB 1020
70 C=4:Y=8:A$="TAAT 2004":GOSUB 500
80 C=4:Y=10:A$="GW-BASIC DEMO":GOSUB 500
85 GOSUB 1010
90 C=5:Y=14:A$="HIKILIIKKUJA":GOSUB 500
100 C=5:Y=16:A$="PERSPIRATUAL MOTION MACHINE":GOSUB 500
105 GOSUB 1020:CLS:GOSUB 1020
110 C=6:Y=12:A$="IN EGA":GOSUB 500
120 C=6:Y=13:A$="WITH FREQUENCY MODULATION":GOSUB 500
125 GOSUB 1010:CLS:GOSUB 1010
130 C=3:Y=12:A$="LET'S START WITH SOMETHING NEAT":GOSUB 500
135 GOSUB 1010
140 C=3:Y=14:A$="VECTOR BALLS AND LINES":GOSUB 500
145 GOSUB 1020:CLS:GOSUB 1010
150 GOSUB 4000:SCREEN 7,,1,1:CLS:SCREEN 7,,0,0:CLS
155 GOSUB 1020:CLS:GOSUB 1010
160 C=1:Y=12:A$="INTERFERENCE CIRCLES":GOSUB 500
170 C=1:Y=14:A$="GW-BASIC MAKES IT POSSIBLE":GOSUB 500
175 GOSUB 1020:CLS:GOSUB 1010
180 GOSUB 2000:SCREEN 7,,0,0:CLS
185 GOSUB 1020:CLS:GOSUB 1010
190 C=6:Y=2:A$="TRIVIA":GOSUB 500
200 C=6:Y=8:A$="GW-BASIC was named after Greg Whitten":GOSUB 500
210 C=6:Y=10:A$="(employee of MS)":GOSUB 500
220 C=6:Y=15:A$="It is also widely said that GW-BASIC":GOSUB 500
230 C=6:Y=17:A$="stands for Gee Whiz BASIC.":GOSUB 500
235 GOSUB 1050:CLS:GOSUB 1010
240 C=1:Y=2:A$="INSERT CREDIT(S)":GOSUB 500
250 C=1:Y=10:A$="DEMO REALIZATION BY TARZAN":GOSUB 500
260 C=1:Y=12:A$="WITH INPUT$ FROM":GOSUB 500
261 C=1:Y=14:A$="PAPARAZZI AND KELMUHARPPU":GOSUB 500
265 GOSUB 1040
270 C=4:Y=16:A$="BASIC MAKES IT EASY":GOSUB 500
275 GOSUB 1020:CLS:GOSUB 1010
280 C=4:Y=16:A$="BASIC A DAY KEEPS THE DOCTOR AWAY":GOSUB 500
285 GOSUB 1020:CLS:GOSUB 1010
498 SCREEN 0:WIDTH 80:END
499 '
500 X=(40-LEN(A$))/2
510 COLOR C:LOCATE Y,X:PRINT A$;:GOSUB 1000
520 COLOR C+8:LOCATE Y,X:PRINT A$;:GOSUB 1000
530 COLOR 15:LOCATE Y,X:PRINT A$;:GOSUB 1010
540 RETURN
999 '
1000 T=TIMER:WHILE TIMER<T+.3:GOSUB 10500:WEND:RETURN
1010 T=TIMER:WHILE TIMER<T+1:GOSUB 10500:WEND:RETURN
1020 T=TIMER:WHILE TIMER<T+2:GOSUB 10500:WEND:RETURN
1030 T=TIMER:WHILE TIMER<T+4:GOSUB 10500:WEND:RETURN
1040 T=TIMER:WHILE TIMER<T+5:GOSUB 10500:WEND:RETURN
1050 T=TIMER:WHILE TIMER<T+9:GOSUB 10500:WEND:RETURN
1990 '
2000 ' INTERFERENCE CIRCLES
2005 '
2010 SCREEN 7,,0,1
2020 P1=0:P2=1:DIM G(9362)
2030 FOR A=22 TO 1 STEP -1
2040 C=15*(A MOD 2)
2050 CIRCLE(160,100),A*7,C
2060 PAINT(160,100),C
2070 NEXT
2080 GET(40,25)-(279,174),G
2090 LINE(0,0)-(319,199),0,BF
2100 TB=TIMER-.1:T=.1
2110 SCREEN 7,,P1,P2
2115 GOSUB 10500
2120 SWAP P1,P2
2130 WHILE TIMER<T+.02:WEND
2140 T=(T*3+(TIMER-TB))/4
2150 LINE(0,0)-(319,199),0,BF
2160 PUT(40+39*COS(T*1.4),25+24*SIN(T*1.1)),G,PSET
2170 PUT(40+39*COS(T*.6),25+24*SIN(T*.8)),G,XOR
2180 LINE(0,0)-(319,49),0,BF:LINE(0,150)-(319,199),0,BF
2190 LINE(0,50)-(79,149),0,BF:LINE(240,50)-(319,149),0,BF
2195 IF TIMER>TB+40 THEN GOTO 2210
2200 K$=INKEY$:IF LEN(K$)=0 THEN GOTO 2110
2210 RETURN
2220 '
4000 ' VECTOR BALLS AND LINES
4010 '
4020 PTS=32:PAGES=PEEK(2713)+1
4025 DEFDBL O,N,X,Y,Z,S,T
4030 DIM ORX(PTS):DIM ORY(PTS):DIM ORZ(PTS)
4040 DIM NX(PTS):DIM NY(PTS):DIM NZ(PTS):DIM NC(PTS)
4050 DIM XP(PTS):DIM YP(PTS)
4060 GMODE=0:C=0:CT=0
4070 SCREEN 7,,0,1
4080 FOR D=1 TO PTS
4090 ORX(D)=RND-.5:ORY(D)=RND-.5:ORZ(D)=RND-.5
4100 TDIS=SQR(ORX(D)*ORX(D)+ORY(D)*ORY(D)+ORZ(D)*ORZ(D))
4110 ORX(D)=ORX(D)/TDIS:ORY(D)=ORY(D)/TDIS:ORZ(D)=ORZ(D)/TDIS
4120 ORX(D)=ORX(D)*3:ORY(D)=ORY(D)*3:ORZ(D)=ORZ(D)*3
4130 NX(D)=0:NY(D)=0:NZ(D)=0
4140 NEXT
4150 DIM GA(108)
4160 DIM G1(108):DIM G2(108):DIM G3(108):DIM G4(108):DIM G5(108)
4170 SCREEN 7,,0,1:CLS:GB=1
4180 CIRCLE(8,8),8,15:PAINT(8,8),15,15
4190 GET(0,0)-(16,16),GA
4200 PUT(0,0),GA,PRESET
4210 GET(0,0)-(16,16),GA
4220 CLS:CIRCLE(8,8),7,GB
4230 PAINT(8,8),GB+8,GB
4240 CIRCLE(6,6),1,15:PSET(6,6),15
4250 IF GB=1 THEN GET(0,0)-(16,16),G1
4260 IF GB=2 THEN GET(0,0)-(16,16),G2
4270 IF GB=3 THEN GET(0,0)-(16,16),G3
4280 IF GB=4 THEN GET(0,0)-(16,16),G4
4290 IF GB=5 THEN GET(0,0)-(16,16),G5
4295 GOSUB 10500
4300 CLS:GB=GB+1:IF GB<6 THEN GOTO 4220
4310 GOSUB 5000
4320 P1=0:P2=1
4330 ZDIS=.06:YROT=0
4340 SC=.05
4350 TB=TIMER
4360 SCREEN ,,P2,P1
4361 GOSUB 10500
4362 IF TIMER>TB+25 THEN GMODE=1
4363 IF TIMER>TB+50 THEN GMODE=2
4365 GOSUB 5500
4370 P1=P2:P2=(P2+1) MOD PAGES
4380 LINE(100,36)-(234,164),0,BF
4390 TBI=(TBI*3+(TIMER-TB))/4
4400 YROT=TBI*15
4410 YSC=YROT*SC
4420 YC=COS(YSC)
4430 YS=SIN(YSC)
4440 FOR A=1 TO PTS
4450 NX(A)=YC*ORX(A)+YS*ORZ(A)
4460 NY(A)=ORY(A)
4470 NZ(A)=-YS*ORX(A)+YC*ORZ(A)
4480 NZ(A)=NZ(A)/128+ZDIS
4490 IF NZ(A)=0 THEN NZ(A)=1
4500 XP(A)=NX(A)/NZ(A)+160
4510 YP(A)=NY(A)/NZ(A)+90
4520 NC(A)=A MOD 5
4530 NEXT A
4540 AE=PTS
4550 FOR A=-1 TO 0
4560 FOR AI=1 TO AE-1
4570 IF NZ(AI+1)<=NZ(AI) THEN GOTO 4590
4580 SWAP NZ(AI),NZ(AI+1):SWAP XP(AI),XP(AI+1):SWAP YP(AI),YP(AI+1):SWAP NC(AI),NC(AI+1):AE=AI
4590 NEXT:A=AE<AI
4600 NEXT
4610 '
4620 FOR A=1 TO PTS
4630 GI=NC(A)+1
4640 IF GMODE=0 THEN PUT(XP(A),YP(A)),GA,AND
4650 ON GMODE GOTO 4660,4720
4660 ON GI GOTO 4670,4680,4690,4700,4710
4670 PUT(XP(A),YP(A)),G1,OR:GOTO 4780
4680 PUT(XP(A),YP(A)),G2,OR:GOTO 4780
4690 PUT(XP(A),YP(A)),G3,OR:GOTO 4780
4700 PUT(XP(A),YP(A)),G4,OR:GOTO 4780
4710 PUT(XP(A),YP(A)),G5,OR:GOTO 4780
4720 ON GI GOTO 4730,4740,4750,4760,4770
4730 PUT(XP(A),YP(A)),G1,XOR:GOTO 4780
4740 PUT(XP(A),YP(A)),G2,XOR:GOTO 4780
4750 PUT(XP(A),YP(A)),G3,XOR:GOTO 4780
4760 PUT(XP(A),YP(A)),G4,XOR:GOTO 4780
4770 PUT(XP(A),YP(A)),G5,XOR:GOTO 4780
4780 NEXT A
4785 IF TIMER>TB+65 THEN GOTO 4800
4790 K$=INKEY$:IF LEN(K$)=0 THEN GOTO 4360
4800 DEFINT A-Z:DEFDBL T
4810 RETURN
4820 '
5000 P=0
5010 SCREEN 7,0,1:CLS
5020 DIM GL1(164)
5030 LINE(0,0)-(319,0),6:GET(0,0)-(319,0),GL1:CLS
5040 SCREEN ,,P,7:CLS
5050 FOR A=0 TO 319 STEP 8
5060 LINE(A+P,165)-((A+P-160)*4+160,199),14
5070 NEXT
5080 FOR A=165 TO 199 STEP 8:PUT(0,A),GL1,AND:NEXT
5090 FOR A=166 TO 182 STEP 4:PUT(0,A),GL1,AND:NEXT
5100 FOR A=167 TO 173 STEP 2:PUT(0,A),GL1,AND:NEXT
5110 LINE(0,165)-(319,165),8,,&HAAAA
5120 P=P+1:IF P<PAGES THEN GOTO 5040
5130 ERASE GL1
5140 RETURN
5150 '
5500 IF TIMER>TB+23 AND CT=0 THEN CT=1:C=8
5505 IF TIMER>TB+30 AND CT=1 THEN CT=2:C=8
5508 IF TIMER>TB+45 AND CT=2 THEN CT=3:C=8
5510 IF TIMER>TB+47 AND CT=3 THEN CT=4:C=8
5515 IF TIMER>TB+55 AND CT=4 THEN CT=5:C=8
5520 IF C=0 THEN RETURN
5530 IF (CT=3 OR CT=5) AND C>0 THEN C=C-1:LINE(0,0)-(319,35),0,BF:RETURN
5535 ON CT GOTO 5540,5570,5570,5600
5540 COLOR 7:LOCATE 2,5
5550 PRINT "LET'S MAKE THEM TRANSPARENT..."
5560 RETURN
5570 COLOR 14:LOCATE 18,6
5580 PRINT "OOH!"
5590 RETURN
5600 COLOR 7:LOCATE 2,5
5610 PRINT "NOW TRY SOMETHING ALTERNATIVE."
5620 RETURN
9998 END
10000 AREG=&H20:AVAL=&H11:GOSUB 11000 '11
10010 AREG=&H40:AVAL=5:GOSUB 11000
10020 AREG=&H60:AVAL=&H12:GOSUB 11000 'f9
10030 AREG=&H80:AVAL=&H22:GOSUB 11000 '25
10040 AREG=&HE0:AVAL=0:GOSUB 11000
10050 AREG=&H23:AVAL=&H31:GOSUB 11000
10060 AREG=&H43:AVAL=0:GOSUB 11000
10070 AREG=&H63:AVAL=&H11:GOSUB 11000 'f1
10080 AREG=&H83:AVAL=&H34:GOSUB 11000
10090 AREG=&HE3:AVAL=0:GOSUB 11000
10100 AREG=&HC0:AVAL=&HA:GOSUB 11000
10110 GOSUB 11150
10120 RETURN
10130 '
10300 DEFINT A:DEFDBL T:TMB=TIMER:AMO=0:APO=1:TTEM=4:TMB=TMB-TTEM
10310 DIM ANTS(12)
10320 ANTS(1)=&H14F:ANTS(2)=&H16B:ANTS(3)=&H181:ANTS(4)=&H198
10330 ANTS(5)=&H1B0:ANTS(6)=&H1CA:ANTS(7)=&H1E5:ANTS(8)=&H202
10340 ANTS(9)=&H220:ANTS(10)=&H241:ANTS(11)=&H263:ANTS(12)=&H287
10350 M$="J.-J>C<-EF-H.-J>C<-JH-FK-JE-"
10360 GOSUB 10000
10370 RETURN
10380 '
10500 IF TIMER<TMB+TTEM THEN RETURN
10510 MC$=MID$(M$,APO,1):APO=APO+1:IF APO>LEN(M$) THEN APO=1:AMO=0
10520 IF MC$=">" THEN AMO=AMO+1:GOTO 10510
10530 IF MC$="<" THEN AMO=AMO-1:GOTO 10510
10535 IF MC$="-" THEN GOSUB 11150:RETURN
10540 TMB=TMB+TTEM
10550 IF MC$="." THEN RETURN
10560 ACN=ASC(MC$)-64
10570 'GOSUB 11150
10580 ANOTE=ANTS(ACN):AOCT=AMO
10590 GOSUB 11100
10600 RETURN
10610 '
11000 OUT &H388,AREG
11010 FOR AX=0 TO 5:ATMP=INP(&H388):NEXT AX
11020 OUT &H389,AVAL
11030 FOR AX=0 TO 34:ATMP=INP(&H388):NEXT AX
11040 RETURN
11050 '
11100 AREG=&HA0:AVAL=ANOTE AND &HFF:GOSUB 11000
11110 AREG=&HB0:AVAL=32+((AOCT*4) AND &H1C)+((ANOTE\256) AND 3):GOSUB 11000
11120 RETURN
11130 '
11150 AREG=&HB0:AVAL=0:GOSUB 11000
11160 RETURN
11170 '