home *** CD-ROM | disk | FTP | other *** search
/ RUN Flagazine: Run 12 / run12.zip / 6HOEK.BAS < prev    next >
BASIC Source File  |  1993-03-09  |  3KB  |  47 lines
  1. 100 REM GAME 6HOEK.BAS GWBASIC CGA/EGA (C) KOOS VAN EGMOND/RUN FLAGAZINE
  2. 110 KEY OFF:CLS:SC=9:ON ERROR GOTO 130
  3. 120 SCREEN SC:IF SC<7 THEN SC=1:SCREEN SC:COLOR 0,2:GOTO 140 ELSE GOTO 140
  4. 130 SC=SC-1:IF SC<1 THEN CLS:PRINT "Geen kleuren-PC":END ELSE RESUME 120
  5. 140 ON ERROR GOTO 0:WINDOW SCREEN (-4,-2.5)-(4,3.5):PI=4*ATN(1)
  6. 150 DIM PTN(6,1),LN$(15,1):SR=0:SG=0:IF SC<8 THEN XLOC=1 ELSE XLOC=2
  7. 160 CLS:P=0:LIJN=0:FOR N=1 TO 15:LN$(N,0)="":LN$(N,1)="":NEXT N
  8. 170 LINE(-4,-2.5)-(4,2.5),3,B:IF SC>6 THEN COLOR 15
  9. 180 FOR H=-PI/3 TO PI*1.5 STEP PI/3:X=2*COS(H):Y=2*SIN(H)
  10. 190 CIRCLE(X,Y),.1,7:PAINT(X,Y),9,7:P=P+1:PTN(P,0)=X:PTN(P,1)=Y
  11. 200 P$=MID$(STR$(P),2,1):LOCATE 11+Y*5,20.5*XLOC+X*6.5*XLOC:PRINT P$:NEXT H
  12. 210 LK(1)=10:LK(2)=12:KT$(1)="GROEN":KT$(2)="ROOD":IF SC<7 THEN LK(1)=1:LK(2)=2
  13. 220 LOCATE 2,3:PRINT "Score":LOCATE 3,3:PRINT "groen"
  14. 230 LOCATE 2,34+40*(XLOC-1):PRINT "Score":LOCATE 3,35+40*(XLOC-1):PRINT "rood"
  15. 240 GOSUB 490:LIJN=LIJN+1:IF BEURT=1 THEN BEURT=2 ELSE BEURT=1
  16. 250 LOCATE 24,2+20*(XLOC-1):IF SC>6 THEN COLOR LK(BEURT)
  17. 260 PRINT "Beurt voor ";KT$(BEURT);". Geef twee punten op. ";
  18. 270 LOCATE 22,20*XLOC:PRINT SPACE$(2):LOCATE 22,20*XLOC
  19. 280 P1$="":WHILE P1$<"1" OR P1$>"6":P1$=INKEY$:WEND:PRINT P1$;
  20. 290 P2$="":WHILE P2$<"1" OR P2$>"6":P2$=INKEY$:WEND:PRINT P2$
  21. 300 IF P1$=P2$ THEN BEEP:GOTO 270 ELSE IF P1$>P2$ THEN SWAP P1$,P2$
  22. 310 F=0:FOR N=1 TO 15:IF LN$(N,0)=P1$+P2$+P1$ THEN F=1
  23. 320 NEXT N:IF F=1 THEN BEEP:GOTO 270
  24. 330 LN$(LIJN,0)=P1$+P2$+P1$:LN$(LIJN,1)=MID$(STR$(BEURT),2,1):P1=VAL(P1$)
  25. 350 P2=VAL(P2$):LINE(PTN(P1,0),PTN(P1,1))-(PTN(P2,0),PTN(P2,1)),LK(BEURT)
  26. 360 KL=0:FOR N=1 TO 6:HLP$=MID$(STR$(N),2,1):IF HLP$=P1$ OR HLP$=P2$ THEN 420
  27. 370 DH=0:FOR M=1 TO 15:HLP2$=LN$(M,0):HLP=VAL(LN$(M,1))
  28. 380 IF INSTR(HLP2$,HLP$+P1$)>0 AND HLP=BEURT THEN DH=DH+1
  29. 390 IF INSTR(HLP2$,HLP$+P2$)>0 AND HLP=BEURT THEN DH=DH+1
  30. 400 IF DH=2 THEN KL=1:P3$=MID$(STR$(N),2,1)
  31. 410 NEXT M
  32. 420 NEXT N:IF KL=0 THEN GOTO 240 ELSE IF SC>6 THEN COLOR 14
  33. 430 LOCATE 22,3+20*(XLOC-1):IF BEURT=1 THEN SR=SR+1 ELSE SG=SG+1
  34. 440 PRINT "OEPS... Een punt voor de tegenpartij":LOCATE 23,1+20*(XLOC-1)
  35. 450 PRINT "Driehoek gevormd door de punten ";P1$;",";P2$;" en ";P3$;
  36. 460 LOCATE 24,2+20*(XLOC-1):PRINT "<Spatiebalk>=Doorgaan    <Esc>=Stoppen";
  37. 470 GOSUB 490:I$="":WHILE I$<>CHR$(27) AND I$<>CHR$(32):I$=INKEY$:WEND
  38. 480 IF I$=CHR$(27) THEN END ELSE GOTO 160
  39. 490 L=LEN(STR$(SR)):LOCATE 4,2:IF SC>6 THEN COLOR 10:PRINT SG ELSE PRINT SG
  40. 500 LOCATE 4,39+40*(XLOC-1)-L:IF SC>6 THEN COLOR 12:PRINT SR ELSE PRINT SR
  41. 510 RETURN
  42. 520 REM /* 40/.2132,4145,4482,3401,3759,3395,2543,3101,3691,4259
  43. 530 REM /*/....4262,3322,4664,3644,3075,4133,3112,3324,3270,3472
  44. 540 REM /*/....2689,1889,4086,4156,4099,2959,3186,3187,2210,0396
  45. 550 REM /*/....3117,3544,4845,4578,5115,3835,2035,4323,4166,0480
  46. 560 REM Checksum...............:  136081
  47.