10 '
20 ' SKUNK152.BAS
30 '
40 ' Original author unknown.  Z-ified by Lee Bradley.  6/7/90 
50 '
60 ' Skunk is a dice game. The dice are rolled and the total added to
70 ' the player's score (unless a skunk appears, which blows that turn,
80 ' or a double skunk, which blows the cumulative score).
90 '
100 ' To compile, link and go ...
110 '
120 ' BASCOM =SKUNK152/Z
130 ' L80 Z3HDR,SKUNK152,SKUNK152/N/E
140 ' SKUNK152
150 '
160 ' Z3HDR.REL is the Microsoft REL file derived from the following:
170 '
180 '  CSEG
190 '  DEFB 'Z3ENV'
200 '  DEFB 1
210 '  DEFW 0
220 '  END
230 ' 
240 VER$="1.52"
250 DEFSTR S:DEFINT I-N
260 DIM SPLAY(4),PSCORE(4),GAMESW(4),BOWTIE$(36)
270 DEF FNIVAL=INT(6*RND)+1
280 FOR I=1 TO 36:READ BOWTIE$(I):NEXT  ' Load messages
290 '
300 ' Set up default terminal strings
310 ' Change these for your terminal if running under MBASIC
320 '
330 TID$="alphaTronic PC "
340 CL$=CHR$(27)+"T37"
350 CM$=CHR$(27)+"Y%+ %+ "
360 CE$=CHR$(27)+"K"
370 SO$=CHR$(28)
380 SE$=CHR$(18)
390 '
400 GOSUB 2700 ' Get Z3 environment address
410 IF ENV=0 THEN 500 ' Use defaults if needed
420 TINDEX=0:GOSUB 2930:TID$=X$  ' Terminal Id
430 TINDEX=1:GOSUB 2930:CL$=X$   ' Clear screen
440 TINDEX=2:GOSUB 2930:CM$=X$   ' Cursor motion macro
450 TINDEX=3:GOSUB 2930:CE$=X$   ' Clear to end of line
460 TINDEX=4:GOSUB 2930:SO$=X$   ' Standout 
470 TINDEX=5:GOSUB 2930:SE$=X$   ' Standout end 
480 TINDEX=6:GOSUB 2930:TI$=X$   ' Terminal init
490 TINDEX=7:GOSUB 2930:TE$=X$   ' Terminal deinit
500 '
510 PRINT CL$
520 PRINT SO$+"SKUNK, Version "+VER$+SE$:PRINT
530 PRINT "Terminal Id:"+SO$+TID$+SE$:PRINT
540 '
550 PRINT "Welcome to Skunk! The object of the game is to amass 100 points"
560 PRINT "first.  You may roll the dice as many times as you wish each turn"
570 PRINT "until a skunk or double skunk is rolled.  A single skunk wipes"
580 PRINT "out points acquired for that turn. A double skunk wipes out points"
590 PRINT "for that turn and all other points."
600 '
610 GOSUB 2360 ' Establish upper limit and delay 
620 ' Entry point for player name entry
630 FOR P=1 TO 4:GAMESW(P)=0:NEXT
640 PRINT CL$:PRINT:PRINT:PRINT "How many players ( 1 .. 4 ) ";
650 S=INPUT$(1):IF NOT (S>"0" AND S<"5") THEN PRINT CL$:GOTO 640
660 NP=VAL(S):PRINT:PRINT
670 FOR P=1 TO NP:PRINT "Player";P;"'s name ";:INPUT SPLAY(P): PRINT:NEXT
680 IF NP>1 THEN 730
690 ' Only one player, other will be computer
700 NP=2
710 SPLAY(2)="Computer"
720 ' Initialize screen
730 GOSUB 1590
740 R=1:C=0:GOSUB 3200 ' Position cursor
750 PRINT CMO$;
760 PRINT " "+SO$+"Score"+SE$+"  "+SO$+"Player"+SE$+"     "+SO$+"Games"+SE$
770 R=22:C=60:GOSUB 3200:PRINT CMO$+SO$+"SKUNK "+VER$+SE$
780 GOSUB 1450 ' Print scores and names
790 R=22:C=0:GOSUB 3200
800 PRINT CMO$+"Any key = roll, <ret> = end turn, ESC = abort game ";
810 ' Play the game
820 P=0
830 P=P+1
840 GOSUB 1050 ' Play
850 PSCORE(P)=PSCORE(P)+ITOT
860 GOSUB 1450 ' Print scores and names
870 IF PSCORE(P)>UL THEN 910
880 FOR DL1=1 TO DL:NEXT
890 IF P=NP THEN 820
900 GOTO 830
910 ' Winner - Play again?
920 FOR P1=1 TO 4:PSCORE(P1)=0:NEXT
930 GAMESW(P)=GAMESW(P)+1
940 R=22:C=0:GOSUB 3200 
950 PRINT CMO$+CE$+CMO$;
960 PRINT "(S)ame / (N)ew players, (C)hange limit/delay, (Q)uit ";
970 KK$=INPUT$(1):PRINT CL$
980 PRINT ""
990 IF INSTR("Ss",KK$)<>0 THEN 730
1000 IF INSTR("Nn",KK$)<>0 THEN 620
1010 IF INSTR("Cc",KK$)<>0 THEN GOSUB 2360:GOTO 730
1020 IF INSTR("Qq",KK$)<>0 THEN 1040 
1030 PRINT CL$:PRINT:GOTO 960
1040 END
1050 ' Play individual turn subroutine
1060 R=14:C=42:GOSUB 3200
1070 PRINT CMO$+CE$+CMO$+"Your turn, "+SPLAY(P)+" ";
1080 ITOT=0:NOSKU=0
1090 ' Just in case, remove last player's junk from Zilog SIO
1100 FOR II=1 TO 4:SS=INKEY$:NEXT
1110 GOTO 1160
1120 ' Display and turn loop
1130 R=14:C=42:GOSUB 3200
1140 FOR DL1=1 TO DL:NEXT
1150 PRINT CMO$+CE$+CMO$+SPLAY(P)+" ";
1160 IF SPLAY(P) = "Computer" THEN 1220
1170 ' Human input
1180 SEL=INKEY$:X=RND:IF LEN(SEL)=0 THEN 1180  ' RND omize on user input
1190 IF SEL=CHR$(13) THEN 1390
1200 IF SEL=CHR$(27) THEN PRINT CL$:END
1210 GOTO 1270
1220 ' Computer input
1230 IF ITOT+PSCORE(2)>UL THEN 1390
1240 IF ITOT>20 THEN 1390 ' Quit
1250 IF NOSKU>4 THEN 1390 ' Quit
1260 ' Roll tally & check
1270 GOSUB 1850 ' Roll 'em
1280 ITOT=ITOT+JTOT
1290 IF NUM=1 THEN 1340
1300 IF NUMA=1 THEN 1340
1310 R=17:C=42:GOSUB 3200:PRINT CMO$+"Total so far ";ITOT
1320 GOTO 1120 ' End turn loop
1330 ' A Skunk
1340 ITOT=0
1350 NOSKU=0
1360 IF NUMA=NUM THEN PSCORE(P)=0
1370 FOR X=1 TO DL:NEXT ' Delay
1380 ' End of turn, clear board
1390 C=42
1400 FOR R=14 TO 17 STEP 3:GOSUB 3200:PRINT CMO$+CE$:NEXT
1410 NUM=7
1420 GOSUB 1940 ' Clear upper di
1430 GOSUB 1950 ' Clear lower di
1440 RETURN
1450 ' Print scores and names subroutine
1460 FOR P1=1 TO NP
1470 C=0
1480 R=(P1*2)+2
1490 GOSUB 3200:PRINT CMO$;
1500 PRINT USING "#####";PSCORE(P1)
1510 C=8:GOSUB 3200
1520 PRINT CMO$;
1530 PRINT SPLAY(P1)
1540 C=20:GOSUB 3200
1550 PRINT CMO$;
1560 PRINT GAMESW(P1)
1570 NEXT
1580 RETURN
1590 ' Set up board subroutine
1600 PRINT CL$
1610 RESTORE 1820
1620 C=41
1630 FOR R=3 TO 11:READ SLIN:GOSUB 3200:PRINT CMO$+SLIN;:NEXT
1640 PRINT  ' A cr for MBASIC
1650 RESTORE 1820
1660 C=21
1670 FOR R=12 TO 20:READ SLIN:GOSUB 3200:PRINT CMO$+SLIN;:NEXT
1680 PRINT  ' A cr for MBASIC
1690 NUM=1
1700 RETURN
1710 ' Bow Tie data
1720 DATA "CP/M LIVES!"," 8 IS ENUF "," Z FOREVER ","LEE BRADLEY"
1730 DATA " JAY  SAGE ","H GOLDSTEIN"," J. TAYLOR ","B NALEWAJEK"
1740 DATA " A HATHWAY "," R SWENTON ","B. MITCHELL"," AL HAWLEY "
1750 DATA "JOE  WRIGHT","CAM COTRILL","I. COTTRELL"," RON  CAIN "
1760 DATA " BOB  DEAN "," B. MORGEN "," C. MCEWEN ","S. GRISWOLD"
1770 DATA " G KILDALL ","  WARD C.  "," R  FOWLER "," IRV  HOFF "
1780 DATA "   YOU ?   ","  DARYL G  "," HAL BOWER "," C. WILSON "
1790 DATA "  E MEYER  "," W WHEELER ","C. FALCONER","S GREENBERG"
1800 DATA " S. HOLDEN ","  T VEILE  "," D  MCCORD ","  R. CONN  "
1810 ' Dice outline data
1820 DATA "+-----------------+","|                 |","|                 |"
1830 DATA "|                 |","|                 |","|                 |"
1840 DATA "|                 |","|                 |","+-----------------+"
1850 ' Roll 'em subroutine
1860 NOSKU=NOSKU+1:NUM=FNIVAL:JTOT=NUM:NUMA=NUM
1870 GOSUB 1940:GOSUB 1910
1880 NUM=FNIVAL:JTOT=JTOT+NUM:GOSUB 1950
1890 GOTO 1910 ' Use its return
1900 ' Further randomize
1910 FOR I=1 TO 4:X=RND:NEXT
1920 RETURN
1930 ' Dice values; upper right, lower left
1940 R=4:C=45:GOTO 1960
1950 R=13:C=25
1960 IF NUM = 1 THEN RESTORE 2150
1970 IF NUM = 2 THEN RESTORE 2180
1980 IF NUM = 3 THEN RESTORE 2210
1990 IF NUM = 4 THEN RESTORE 2240
2000 IF NUM = 5 THEN RESTORE 2270
2010 IF NUM = 6 THEN RESTORE 2300
2020 IF NUM = 7 THEN RESTORE 2330
2030 ' Print the value
2040 FOR ILIN=1 TO 7
2050 READ SLIN:GOSUB 3200
2060 IF NOT(ILIN=4 AND NUM=1) THEN 2090
2070 FOR X=1 TO RND*10:NEXT
2080 SLIN=SO$+BOWTIE$(INT(36*RND)+1)+SE$
2090 PRINT CMO$+SLIN;
2100 R=R+1
2110 NEXT
2120 PRINT
2130 RETURN
2140 ' Dice value data
2150 DATA "   /---\   ","  | @ @ |  ","   \ ~ /   ","CP/M LIVES!"
2160 DATA "  / *** \  "," /  ***  \ "," \==---==/ "
2170 ' ----- 2
2180 DATA "           ","**         ","           ","           "
2190 DATA "           ","         **","           "
2200 ' ----- 3
2210 DATA "           ","**         ","           ","    ***    "
2220 DATA "           ","         **","           "
2230 ' ----- 4
2240 DATA "           ","**       **","           ","           "
2250 DATA "           ","**       **","           "
2260 ' ----- 5
2270 DATA "           ","**       **","           ","    ***    "
2280 DATA "           ","**       **","           "
2290 ' ----- 6
2300 DATA "           ","**       **","           ","**       **"
2310 DATA "           ","**       **","           "
2320 ' ----- 7 spaces
2330 DATA "           ","           ","           ","           "
2340 DATA "           ","           ","           "
2350 ' 
2360 ' Establish upper limit and delay subroutine
2370 '
2380 UL=100:S1=""
2390 PRINT:PRINT "Enter upper limit ( 20 .. 300 ) ( <ret> for 100 ) ";
2400 S=INKEY$:IF LEN(S)=0 THEN 2400
2410 IF S=CHR$(13) THEN 2430
2420 PRINT S;:S1=S1+S:GOTO 2400
2430 IF LEN(S1)<>0 THEN UL=VAL(S1)
2440 UL=UL-1
2450 DL=250
2460 PRINT:PRINT:PRINT "Enter delay factor ( 1 .. 9 ) ( <ret> for 1 ) "; 
2470 S=INKEY$:IF LEN(S)=0 THEN 2470
2480 IF S=CHR$(13) THEN 2500
2490 PRINT S;:DL=VAL(S)*250
2500 PRINT:PRINT 
2510 PRINT "Strike Any Key ... ";
2520 SS=INKEY$
2530 X=RND ' Re-seed based on human's delay
2540 IF LEN(SS)=0 THEN 2520 ELSE RETURN
2550 '
2560 ' Z3BAS.LIB
2570 '
2580 ' Version: 1.0.  Date: 6/7/90
2590 ' Author: Lee Bradley, Sysop, Z-Node 12, 203-665-1100
2600 '
2610 ' Include these routines in your program and reference them
2620 ' when you need to determine environment address, load a tcap 
2630 ' string, position the cursor, determine the status of the 
2640 ' wheel byte, quiet flag etc.
2650 '
2660 ' ---
2670 ' Load ENV with environment address.
2680 ' ---
2690 '
2700 IF CHR$(PEEK(&H103))+CHR$(PEEK(&H104))="Z3" THEN 2770
2710 ' ==> NOTE! Edit &H value below. Will be used under MBASIC.
2720 ENV=&HE780+65536! ' Note need to make positive by adding 2^16
2730 ENV1=PEEK(ENV+&H1B)+256*PEEK(ENV+&H1C)
2740 IF ENV1=ENV THEN 2840
2750 PRINT:PRINT "ZCPR3 required. If running ZCPR3, change statement"
2760 PRINT "ENV=&H ...  above.":SYSTEM
2770 IF PEEK(&H10A)<> 0 THEN 2800
2780 PRINT "If not ZCPR3 version ZCPR33+ you must use Z3INS "
2790 PRINT "ZCPR33+ was not found. ":ENV=0:GOTO 2840
2800 ENV=PEEK(&H109)+256*PEEK(&H10A)
2810 ENV1=PEEK(ENV+&H1B)+256*PEEK(ENV+&H1C)
2820 IF ENV1=ENV THEN 2840
2830 PRINT:PRINT "Environment self-reference error detected":END
2840 RETURN
2850 '
2860 ' ---
2870 ' Load X$ with tcap string based on TINDEX, a tcap string "index"
2880 ' and ENV, the environment address.
2890 ' X$ will hold terminal id string if TINDEX is 0
2900 ' X$ will hold clear screen string if TINDEX is 1. Etc.
2910 ' ---
2920 '
2930 J=128                  ' Start at beginning of tcap segment
2940 IF TINDEX=0 THEN 3030 ' No need to skip anything if looking for id
2950 J=J+16+4+3             ' Get past id, arrow and delay bytes 
2960 IF TINDEX=1 THEN 3030 ' No need to skip any more if clear scr wanted
2970 FOR I=1 TO TINDEX-1    ' Skip the strings we don't want
2980 IF CHR$(PEEK(ENV+J))<>"\" THEN 3000     ' Catch literals
2990 J=J+2                                    ' advance to next character 
3000 IF PEEK(ENV+J)<>0 THEN J=J+1:GOTO 2980  ' Loop till null found
3010 J=J+1                  ' Advance and move to next string
3020 NEXT
3030 ' Build tcap string
3040 X$=""                  ' Null out work string 
3050 IF CHR$(PEEK(ENV+J))<>"\" THEN 3070     ' Catch literals
3060 J=J+1:GOTO 3100                         ' Advance to literal
3070 IF J=128+13 AND TINDEX=0 THEN RETURN     ' Get out if id complete
3080 IF PEEK(ENV+J)<>0 THEN 3100             ' If null
3090 RETURN                                   ' return
3100 X$=X$+CHR$(PEEK(ENV+J)):J=J+1:GOTO 3050 ' else, grab it and loop  
3110 '
3120 ' ---
3130 ' Cursor motion macro interpreter
3140 ' Input: R,C,CM$ (row,col,cursor motion macro)
3150 ' Output: CMO$ (string to output to the terminal)
3160 ' Ref: ZCPR3 The Manual, Richard Conn, Ch 22.
3170 ' ---
3180 '
3190 DIM OFFSET(2),PREINFIX$(2),RC(2),CMD$(2)
3200 WK$="":PCTR=0:I1=0:OFFSET(1)=0:OFFSET(2)=0 ' Initialize
3210 PREINFIX$(1) = "":PREINFIX$(2) = "":RC(1)=R:RC(2)=C ' Initialize 
3220 I1=I1+1:IF I1>LEN(CM$) THEN 3530  ' Top of loop
3230 CMC$=MID$(CM$,I1,1)                ' Load cursor motion macro char.
3240 IF CMC$<>"%" THEN 3500            ' If not a %, tack onto work string
3250 I1=I1+1:CMC$=MID$(CM$,I1,1)        ' Advance
3260 RI=INSTR("RrIi",CMC$)
3270 IF RI=1 OR RI=2 THEN CB4R$="ON":GOTO 3220 ' Handle R,I commands
3280 IF RI=3 OR RI=4 THEN HOME=1:GOTO 3220
3290 PCTR=PCTR+1                      ' Update % counter
3300 PREINFIX$(PCTR)=WK$              ' Save work string 
3310 WK$=""                           ' Null out for future build
3320 IF CMC$<>"." THEN 3350          ' Binary ?
3330 CMD$(PCTR)=CHR$(RC(PCTR)+HOME)
3340 GOTO 3220   ' Loop
3350 D23=INSTR("D23d",CMC$):IF D23=0 THEN 3410 ' Ascii?
3360 CMD$(PCTR)=MID$(STR$(RC(PCTR)+HOME),2)
3370 IF LEN(CMD$(PCTR))=1 AND D23=2 THEN CMD$(PCTR)="0"+CMD$(PCTR) ' Fix
3380 IF LEN(CMD$(PCTR))=1 AND D23=3 THEN CMD$(PCTR)="00"+CMD$(PCTR)
3390 IF LEN(CMD$(PCTR))=2 AND D23=3 THEN CMD$(PCTR)="0"+CMD$(PCTR)
3400 GOTO 3220  ' Loop
3410 IF CMC$<>"+" THEN 3460  ' Offset?
3420 I1=I1+1:CMC$=MID$(CM$,I1,1)
3430 OFFSET(PCTR)=ASC(CMC$)
3440 CMD$(PCTR)=CHR$(RC(PCTR)+HOME+OFFSET(PCTR))
3450 GOTO 3220  ' Loop
3460 IF CMC$<>">" THEN PRINT "Error in cursor motion macro ... ":END
3470 I1=I1+1:CMC1$=MID$(CM$,I1,1):I1=I1+1:CMC$=MID$(CM$,I1,1)
3480 IF CHR$(RC(PCTR))>CMC1$ THEN 3430 ELSE 3440
3490 ' Compute conditional offset, then use "+" code
3500 ' We have a character that's not part of a % command. Just add it
3510 WK$=WK$+CMC$
3520 GOTO 3220  ' Loop
3530 ' All done. Anything left (in WK$) is the postfix part.
3540 IF CB4R$="ON" THEN SWAP CMD$(1),CMD$(2)  ' If col before row, swap
3550 CMO$=PREINFIX$(1)+CMD$(1)+PREINFIX$(2)+CMD$(2)+WK$  ' Build CMO$
3560 RETURN
3570 '
3580 ' ---
3590 ' Load variables (QUIET, WHEEL etc.) based on ENV,
3600 ' the environment address. 
3610 ' ---
3620 '
3630 QUIET=PEEK(ENV+&H28):RETURN
3640 WHLA=PEEK(ENV+&H29)+256*PEEK(ENV+&H2A):RETURN
3650 WHEEL=PEEK(WHLA):RETURN
3660 MHZ=PEEK(ENV+&H2B):RETURN
3670 MAXD=PEEK(ENV+&H2C):RETURN
3680 MAXU=PEEK(ENV+&H2D):RETURN
3690 DUOK=PEEK(ENV+&H2E):RETURN
3700 '