Compucolor.org – Virtual Media

Listing of file='LATION.BAS;01' on disk='vmedia/games2-sector.ccvf'

0 CLEAR 1000
10 OUT 8,255:OUT 8,247
20 PLOT 6,2,12,27,24,15
30 DIM DK(52),KD(52),FO(4),FC(4),NF(4),TB(4,22),T(1),S(48),SC(1)
31 DIM W(52)
32 W(1)= 11:W(2)= 9:W(3)= 14:W(4)= 21:W(5)= 28:W(6)= 44:W(7)= 12:W(8)= 17:W(9)= 34:W(10)= 27
33 W(11)= 33:W(12)= 45:W(13)= 26:W(14)= 31:W(15)= 41:W(16)= 38:W(17)= 8:W(18)= 19:W(19)= 39:W(20)= 24
34 W(21)= 46:W(22)= 47:W(23)= 23:W(24)= 6:W(25)= 40:W(26)= 50:W(27)= 25:W(28)= 3:W(29)= 4:W(30)= 16
35 W(31)= 30:W(32)= 18:W(33)= 37:W(34)= 13:W(35)= 32:W(36)= 36:W(37)= 2:W(38)= 10:W(39)= 7:W(40)= 49
36 W(41)= 35:W(42)= 20:W(43)= 48:W(44)= 51:W(45)= 52:W(46)= 22:W(47)= 5:W(48)= 42:W(49)= 43:W(50)= 29
37 W(51)= 15:W(52)= 1
40 GOSUB 1000
50 GOSUB 2000
60 PLOT 6,2,15,3,34,13:PRINT "                            "
90 GOTO 4000
991 OUT 8,255
992 PLOT 6,2,27,11,15
993 END
1000 REM  BUILD SCREEN
1010 A= PEEK (33209)
1012 FOR B= 0TO A
1018 NEXT B
1020 PLOT 6,4
1030 PLOT 2,0,0,242,0,127,127,127,127,0,0,0,255
1040 PLOT 6,6,15,3,34,13
1050 PRINT "COPYRIGHT 1979 BY D R MILLER"
1060 PLOT 14,6,56,3,10,27
1070 PRINT " C A L C U L A T I O N "
1080 PLOT 6,1,15,3,4,1
1090 PRINT "F O U N D A T I O N"
1100 PLOT 14,3,4,11:PRINT "1     2     3     4"
1110 PLOT 14,6,6,3,38,2:PRINT "A      B      C      D"
1120 PLOT 6,3
1125 PLOT 15,3,4,2:PRINT "2     4     6     8"
1130 NF(1)= 2:NF(2)= 4:NF(3)= 6:NF(4)= 8
1140 PLOT 6,7,15,3,25,2
1150 PRINT "<---"
1160 PLOT 3,25,3:PRINT "NEXT"
1170 PLOT 3,25,4:PRINT "CARD"
1180 SC= 48
1185 S3= 0
1186 T5= 0
1190 PLOT 6,5,15,3,1,23
1192 PRINT RIGHT$ ((STR$ (SC)),2)
1195 PLOT 27,10
1200 PLOT 14,6,3,3,7,13:PRINT "RETURN"
1205 PLOT 27,24
1210 PLOT 15,27,10,6,7
1230 PLOT 3,62,5:PRINT "WASTE"
1240 PLOT 3,1,13:PRINT "TURN UP"
1250 PLOT 3,1,25:PRINT "STOCK"
1270 PLOT 27,24
1280 PLOT 6,2,15,3,10,29
1290 PRINT "FROMo l TOo l MOVESo   l"
1300 PLOT 3,15,28
1310 PRINT "_     _        ___"
1320 PLOT 3,15,30
1330 PRINT "e     e        eee"
1400 PLOT 6,3,15,3,34,15
1410 PRINT "OBJECT: BUILD UP FOUNDATION"
1420 PLOT 3,34,16
1430 PRINT "(1-4),IGNORING SUIT,FROM TURN"
1440 PLOT 3,34,17
1450 PRINT "UP(RET) OR WASTE(A-D), 1 CARD"
1460 PLOT 3,34,18
1470 PRINT "AT A TIME.WASTE TO FOUNDATION"
1480 PLOT 3,34,19
1490 PRINT "ONLY, NO WASTE TO WASTE."
1500 PLOT 3,34,20
1510 PRINT "NOTE NEXT CARD INDICATOR"
1520 PLOT 3,34,21
1530 PRINT "ABOVE EACH FOUNDATION PILE."
1540 PLOT 3,34,23
1550 PRINT "FOUNDATIONS MUST BE BUILT UP"
1560 PLOT 3,34,24
1570 PRINT "AS FOLLOWS:"
1575 PLOT 6,7
1580 PLOT 3,34,27
1590 PRINT "#1  A-2-3-4-5-6-7-8-9-T-J-Q-K"
1600 PLOT 3,34,28
1610 PRINT "#2  2-4-6-8-T-Q-A-3-5-7-9-J-K"
1630 PLOT 3,34,29
1640 PRINT "#3  3-6-9-Q-2-5-8-J-A-4-7-T-K"
1650 PLOT 3,34,30
1660 PRINT "#4  4-8-Q-3-7-J-2-6-T-A-5-9-K"
1670 PLOT 6,3,3,34,22:PRINT "ENTER Q AND Q TO QUIT."
1700 Y9= 3:FOR X9= 2TO 20STEP 6:GOSUB 40400:NEXT X9
1710 Y9= 4:FOR X9= 36TO 57STEP 7:GOSUB 40400:NEXT X9
1720 X9= 2:FOR Y9= 13TO 24STEP 11:GOSUB 40400:NEXT Y9
1730 MO= - 1
1990 PLOT 27,24,15
1999 RETURN
2000 REM  CALL FOR SHUFFLE
2001 IF SW= 20THEN SW= 0:GOTO 2140
2002 OUT 8,255:PLOT 14,6,3,3,1,21
2003 INPUT "SHUFFLE(RETURN) OR DECK (A) ?";Q$
2004 OUT 8,247:Q$= LEFT$ (Q$,1)
2005 PLOT 3,1,21:PRINT "      R                         "
2006 IF Q$< > "A"THEN 2010
2007 FOR I= 1TO 52:DK(I)= W(I):NEXT I
2009 GOTO 2140
2010 OUT 8,255
2020 PLOT 14,6,65,3,9,21
2030 PRINT "HIT RETURN"
2040 POKE 33278,0
2050 I= RND (1)
2060 IF PEEK (33278)= 0THEN 2050
2070 OUT 8,247
2080 PLOT 14,6,6,3,9,21
2090 PRINT " SHUFFLING "
2100 PLOT 3,64,0
2110 GOSUB 40500
2120 PLOT 3,9,21
2130 PRINT "              "
2140 PLOT 15
2200 REM  POST CARD VALUES
2210 FO(1)= 1:FO(2)= 15:FO(3)= 29:FO(4)= 43
2211 FC(1)= 2:FC(2)= 4:FC(3)= 6:FC(4)= 8
2212 TC(1)= 0:TC(2)= 0:TC(3)= 0:TC(4)= 0
2215 B= 1
2220 FOR A= 52TO 1STEP - 1
2230 IF DK(A)= 1OR DK(A)= 15OR DK(A)= 29OR DK(A)= 43THEN 2300
2240 S(B)= DK(A)
2250 B= B+ 1
2300 NEXT A
2310 BC$= "`"
2315 PLOT 6,38
2320 X9= 2:Y9= 24:GOSUB 40300
2330 X= FO(1):X9= 2:Y9= 3:GOSUB 40000
2340 X= FO(2):X9= 8:Y9= 3:GOSUB 40000
2350 X= FO(3):X9= 14:Y9= 3:GOSUB 40000
2360 X= FO(4):X9= 20:Y9= 3:GOSUB 40000
2999 RETURN
3000 REM  MAIN ROUTINE
3010 REM
3020 REM  CHECK FOR WINNER
3030 FOR L1= 1TO 4
3040 IF FO(L1)= 0THEN 3060
3050 IF FO(L1)/ 13= INT (FO(L1)/ 13)THEN 3070
3060 GOTO 3200
3070 NEXT L1
3080 REM  A WINNER
3090 PLOT 6,65,14,3,9,21
3100 PRINT "YOU WIN  !!!!"
3110 FOR L1= 0TO 999:NEXT L1
3120 PLOT 3,9,21:PRINT "              "
3130 GOTO 9000
3200 REM  REQUEST INPUT
3210 MO= MO+ 1
3215 IF S3= 1THEN 3280
3220 FOR L1= 1TO 4
3221 IF TC(L1)= 5THEN 3225
3222 NEXT L1
3223 GOTO 3280
3225 S3= 1
3230 PLOT 6,2
3240 FOR L1= 15TO 24
3250 PLOT 3,34,L1
3260 PRINT "                             "
3270 NEXT L1
3280 PLOT 6,3,15,3,30,29
3290 PRINT RIGHT$ ((STR$ (MO)),3)
3300 PLOT 6,1,14,3,9,21
3310 OUT 8,255
3320 INPUT "FROM: ";Q1$
3330 OUT 8,247
3340 Q1$= LEFT$ (Q1$,1)
3350 PLOT 3,9,21:PRINT "            "
3360 PLOT 15,6,1,3,15,29:PRINT Q1$
3380 PLOT 6,6,14,3,9,21
3390 OUT 8,255
3400 INPUT "TO: ";Q2$
3410 OUT 8,247
3420 Q2$= LEFT$ (Q2$,1)
3430 PLOT 3,9,21:PRINT "            "
3440 PLOT 15,6,6,3,21,29:PRINT Q2$
3450 IF Q1$= "Q"AND Q2$= "Q"THEN 3900
3460 IF Q1$> "@"AND Q1$< "E"THEN 3600
3470 IF Q1$= "0"THEN 3600
3490 SW= 1:GOTO 8000
3600 IF Q2$> "@"AND Q2$< "E"THEN 3700
3610 IF Q2$> "0"AND Q2$< "5"THEN 3700
3620 SW= 2:GOTO 8000
3700 REM  INPUT OK, NOW CROSS CHECK
3710 IF Q1$= "0"THEN 5000
3715 IF Q2$= "0"THEN SW= 6:GOTO 8000
3730 GOTO 6000
3900 PLOT 6,1,14,3,9,21:PRINT "YOU QUIT  !!!"
3910 FOR L1= 0TO 999:NEXT L1
3920 PLOT 3,9,21:PRINT "              "
3930 GOTO 9020
4000 REM  MOVE CARD FROM STOCK TO TURN UP
4002 IF T5= 1THEN 3000
4010 IF SC= 0THEN T5= 1:SW= 3:GOTO 8000
4020 IF T< > 0THEN SW= 4:GOTO 8000
4030 SC= SC- 1
4040 PLOT 6,5,15,3,1,23
4050 PRINT RIGHT$ ((STR$ (SC)),2)
4060 T= S(SC+ 1)
4070 X= T:X9= 2:Y9= 13:GOSUB 40000
4080 X9= 2:Y9= 24
4090 BC$= " "
4100 PLOT 6,2
4110 GOSUB 40300
4120 IF SC= 0THEN 4999
4130 BC$= "`"
4140 PLOT 6,38
4150 GOSUB 40300
4999 GOTO 3000
5000 REM  MOVE CARD FROM TURN UP TO SOMEWHERE
5002 IF T= 0THEN SW= 9:GOTO 8000
5010 IF Q2$< "5"AND Q2$> "0"THEN 5500
5015 REM  CARD TO WASTE
5020 TR= ASC (Q2$)- 64
5030 IF TC(TR)> 21THEN SW= 5:GOTO 8000
5040 TC(TR)= TC(TR)+ 1
5050 TB(TR,TC(TR))= T
5060 X= T:Y9= 3+ TC(TR):X9= TR* 7+ 29
5070 GOSUB 40000
5080 T= 0
5090 BC$= " ":PLOT 6,2:X9= 2:Y9= 13:GOSUB 40300
5110 GOTO 5900
5499 REM  CARD TO FOUNDATION
5500 TR= ASC (Q2$)- 48
5510 F= T
5511 GOSUB 5520
5512 GOTO 5710
5520 F1= F
5530 FOR L1= 1TO 3
5540 IF F1> 13THEN F1= F1- 13
5550 NEXT L1
5560 IF F1< > FC(TR)THEN SW= 7:GOTO 8000
5570 FO(TR)= F
5580 FC(TR)= FC(TR)+ TR:REM  TR JUST HAPPENS TO BE CORRECT SKIP
5590 IF FC(TR)> 13THEN FC(TR)= FC(TR)- 13
5592 IF FC(TR)= TRTHEN FC(TR)= 14:REM  SIGNALS END OF FOUNDATION PILE REACHED
5600 PLOT 6,3,15,3,TR* 6- 2,2
5610 IF FC(TR)= 1THEN PRINT "A ":GOTO 5700
5620 IF FC(TR)= 10THEN PRINT "T ":GOTO 5700
5630 IF FC(TR)= 11THEN PRINT "J ":GOTO 5700
5640 IF FC(TR)= 12THEN PRINT "Q ":GOTO 5700
5650 IF FC(TR)= 13THEN PRINT "K ":GOTO 5700
5655 IF FC(TR)= 14THEN PRINT "  ":GOTO 5700
5660 PRINT RIGHT$ ((STR$ (FC(TR))),1)
5700 X= F:X9= TR* 6- 4:Y9= 3:GOSUB 40000
5705 RETURN
5710 T= 0:X9= 2:Y9= 13
5720 BC$= " ":PLOT 6,2:GOSUB 40300
5900 IF T< > 0THEN 3000
5910 GOTO 4000
6000 REM  MOVE CARD FROM WASTE TO FOUNDATION
6002 IF Q2$< "E"AND Q2$> "@"THEN SW= 10:GOTO 8000
6010 TR= ASC (Q2$)- 48:REM  TR HOLDS FOUNDATION ADDRESS
6020 T1= ASC (Q1$)- 64:REM  T1 HOLDS WASTE ADDRESS
6030 F= TB(T1,TC(T1))
6035 IF F= 0THEN SW= 8:GOTO 8000
6040 GOSUB 5520
6050 TB(T1,TC(T1))= 0
6060 TC(T1)= TC(T1)- 1
6070 BC$= " ":PLOT 6,2:X9= T1* 7+ 29:Y9= 4+ TC(T1)
6080 GOSUB 40300
6100 X= TB(T1,TC(T1))
6101 IF X= 0THEN GOSUB 40400:GOTO 6999
6102 X9= T1* 7+ 29
6104 Y9= 3+ TC(T1)
6106 GOSUB 40000
6999 GOTO 5900
8000 REM  HANDLE ERRORS
8002 IF MO< 0THEN 8010
8004 MO= MO- 1
8010 PLOT 6,57+ 64,14,3,9,21
8020 ON SWGOTO 8100,8110,8120,8130,8140,8150,8160,8170,8180,8190,8200
8100 PRINT "'FROM' NOT A-D OR RET"
8105 GOTO 8200
8110 PRINT "'TO' NOT A-D OR 1-4"
8115 GOTO 8200
8120 PRINT "STOCK EMPTY":GOTO 8200
8130 PRINT "PLAY TURN UP CARD":GOTO 8200
8140 PRINT "NO MORE ROOM PILE ";Q2$:GOTO 8200
8150 PRINT "FROM/TO COMBO NO GOOD":GOTO 8200
8160 PRINT "CARD SEQUENCE NO GOOD":GOTO 8200
8170 PRINT "WASTE STACK IS EMPTY":GOTO 8200
8180 PRINT "TURN UP EMPTY":GOTO 8200
8190 PRINT "ILLEGAL MOVE IN WASTE":GOTO 8200
8200 FOR L1= 0TO 500:NEXT L1
8205 PLOT 6,2,14
8210 PLOT 3,9,21:PRINT "                         "
8980 SW= 0
8990 GOTO 3000
9000 REM  END OF GAME
9010 FOR L1= 1TO 999:NEXT L1
9020 PLOT 14,6,70,3,9,21
9030 OUT 8,255
9040 INPUT "PLAY AGAIN (Y/N) ? ";Q$
9050 OUT 8,247
9060 Q$= LEFT$ (Q$,1)
9070 PLOT 3,9,21:PRINT "                         "
9080 IF Q$< > "Y"THEN 9900
9081 PLOT 14,6,65,3,9,21
9082 OUT 8,255
9083 INPUT "SAME DECK (Y/N) ? ";Q$
9084 OUT 8,247
9085 Q$= LEFT$ (Q$,1)
9086 IF Q$< > "Y"THEN 9090
9087 PLOT 3,9,21:PRINT "                     "
9088 SW= 20
9089 GOTO 9100
9090 FOR L1= 1TO 52:KD(L1)= 0:NEXT L1
9100 T= 0:MO= 0
9120 FOR L1= 1TO 4:FOR L2= 1TO 22:TB(L1,L2)= 0:NEXT L2,L1
9130 PLOT 6,2,12
9200 GOTO 40
9900 REM  END IT
9910 PLOT 6,2,12,27,11,15
9915 OUT 8,255
9920 LOAD "MENU":RUN
9930 END
40000 REM  DRAW CARD AT X9,Y9, FROM X (1-52)
40005 IF X> 39THEN Q= X- 39:P$= "c":PLOT 6,56:GOTO 40040
40010 IF X> 26THEN Q= X- 26:P$= "h":PLOT 6,57:GOTO 40040
40020 IF X> 13THEN Q= X- 13:P$= "d":PLOT 6,57:GOTO 40040
40030 Q= X:P$= "s":PLOT 6,56
40040 PLOT 27,10:FOR II= 0TO 4:PLOT 3,X9+ II,Y9:PRINT "       ":NEXT II
40050 IF Q> 9THEN 40120
40060 IF Q> 5THEN 40130
40070 IF Q> 3THEN 40140
40080 IF Q= 1OR Q= 5OR Q= 7THEN 40150
40090 IF Q= 2OR Q= 8THEN 40160
40100 IF Q= 3OR Q= 9OR Q> 10THEN 40170
40110 GOTO 40180
40120 PLOT 3,X9+ 1,Y9+ 1:PRINT P$;P$;P$;P$;P$:PLOT 3,X9+ 3,Y9+ 1:PRINT P$;P$;P$;P$;P$:GOTO 40100
40130 PLOT 3,X9+ 1,Y9+ 1:PRINT P$" "P$" "P$:PLOT 3,X9+ 3,Y9+ 1:PRINT P$" "P$" "P$:GOTO 40080
40140 PLOT 3,X9+ 1,Y9+ 1:PRINT P$"   "P$:PLOT 3,X9+ 3,Y9+ 1:PRINT P$"   "P$:GOTO 40080
40150 PLOT 3,X9+ 2,Y9+ 3:PRINT P$:GOTO 40180
40160 PLOT 3,X9+ 2,Y9+ 2:PRINT P$" "P$:GOTO 40180
40170 PLOT 3,X9+ 2,Y9+ 1:PRINT P$" "P$" "P$
40180 IF Q= 1THEN PLOT 3,X9,Y9:PRINT "A":PLOT 3,X9+ 4,Y9+ 6:PRINT "A":GOTO 40270
40190 IF Q> 9THEN 40210
40200 PLOT 3,X9,Y9:PRINT RIGHT$ ((STR$ (Q)),1):PLOT 3,X9+ 4,Y9+ 6:PRINT RIGHT$ ((STR$ (Q)),1):GOTO 40270
40210 PLOT 27,24:IF Q> 10THEN 40230
40220 PLOT 3,X9,Y9:PRINT RIGHT$ ((STR$ (Q)),2):PLOT 3,X9+ 3,Y9+ 6:PRINT RIGHT$ ((STR$ (Q)),2):GOTO 40270
40230 IF Q= 11THEN CD$= "J":GOTO 40260
40240 IF Q= 12THEN CD$= "Q":GOTO 40260
40250 CD$= "K"
40260 PLOT 3,X9,Y9:PRINT CD$:PLOT 3,X9+ 4,Y9+ 6:PRINT CD$:PLOT 3,X9+ 2,Y9+ 3:PRINT CD$
40270 PLOT 27,24,3,X9+ 4,Y9:PRINT P$:PLOT 3,64,0:RETURN
40300 REM  DRAW BACK OF CARD FROM X9,Y9,BC$(PATTERN)
40310 BC$= BC$+ BC$+ BC$+ BC$+ BC$
40320 FOR I= 0TO 6
40330 PLOT 3,X9,Y9+ I
40340 PRINT BC$
40350 NEXT I
40355 PLOT 3,64,0
40360 RETURN
40400 REM  DRAW BLUE BORDER AROUND EMPTY CARD FROM X9,Y9
40410 PLOT 6,6
40420 PLOT 3,X9,Y9:PRINT "neeeo"
40430 PLOT 3,X9,Y9+ 6:PRINT "lm"
40440 PLOT 27,10
40450 PLOT 3,X9,Y9+ 1:PRINT "aaaaa"
40460 PLOT 3,X9+ 4,Y9+ 1:PRINT "bbbbb"
40465 PLOT 27,24,3,64,0
40470 RETURN
40480 REM  SHUFFLE DECK INTO DK(1-52), USE KD TO STOCK DUPES
40500 FOR I= 1TO 52
40520 DK(I)= INT (52* RND (1)+ 1)
40530 IF KD(DK(I))= 1THEN 40520
40540 KD(DK(I))= 1
40545 PLOT 3,20,21:PRINT I
40547 IF I= DK(I)THEN L1= RND (- 1)
40550 NEXT I
40560 RETURN