10 '
20 ' SKUNK.BAS
30 '

31 ' v 1.6d - 11/22/2016 - tuned up delay logic a bit - had to
32 ' reassemble Z3HDR.MAC - added "Altair" environment address
33 ' renumbered 

40 ' v 1.6c - 4/2-4/2006 - changed comments on how to compile
50 ' "re-fixed" speed (overrode 2/4/2000 adjustment to DL setting)
60 ' removed leading blank in program name - get name from External
70 ' FCB if available - renumbered under MBASIC
80 '
90 ' v 1.6A - 4/12/93 - Lee Bradley
100 '
110 ' works under MBASIC now.
120 ' {/}o command tail support for Kaypro and Royal under CP/M 2.2
130 '
140 ' v 1.6 - 3/12/93 - Lee Bradley
150 '
160 ' added character graphics, external luminary file, etc.
170 '
180 ' Original author unknown. Z-ified by Lee Bradley. 6/7/90 
190 '
200 ' Skunk is a dice game. The dice are rolled and the total added to
210 ' the player's score (unless a skunk appears, which blows that turn,
220 ' or a double skunk, which blows the cumulative score.)
230 '
240 ' To compile, link and go ...
250 '
260 ' BASCOM =SKUNK/Z/O
270 ' L80 Z3HDR,CMD,SKUNK,SKUNK/N/E
280 ' SKUNK {/}o
290 '
300 ' Z3HDR.REL is the Microsoft REL file derived from the following:
310 '
320 '  CSEG ! DEFB 'Z3ENV' ! DEFB 1 ! DEFW 0 ! END
330 '
340 ' CMD.REL is a command tail grabbing routine by Pete Motyl
350 '  
360 MBASIC$="NO" ' set to "NO" if compiling, to "ON" if using MBASIC
370 ' MBASIC$="ON" 
380 GOSUB 3300 ' Get Z3 environment address
390 PNAME$="SKUNK"
400 IF ENV<>0 THEN 470
410 IF MBASIC$="NO" THEN 440
420 INPUT "(K)aypro or (R)oyal (K/R) ";KR$
430 GOTO 470
440 CALL CMD(TAIL$)
450 IF LEN(TAIL$)=0 THEN 570
460 KR$=MID$(TAIL$,INSTR(TAIL$,"/")+1,1)
470 VER$="1.6d"
480 DEFSTR S:DEFINT I-N
490 DIM SPLAY(4),PSCORE(4),GAMESW(4),BOWTIE$(64),G$(13)
500 DEF FNIVAL=INT(6*RND)+1
510 OPEN "I", #1,"SKUNK.DAT"
520 FOR I=1 TO 64:INPUT #1,BOWTIE$(I):NEXT  ' Load luminaries
530 CLOSE #1
540 '
550 ' Set up default terminal strings
560 ' Change these for your terminal if running under MBASIC or non-Z-System
570 '
580 IF ENV<>0 THEN 850 ' Use Z-System if available
590 IF KR$="" THEN 610
600 IF INSTR("KR",KR$) <> 0 THEN 650
610 PRINT : PRINT "Usage: SKUNK {/}o"
620 PRINT "o may be K or R, for Kaypro or Royal"
630 SYSTEM
640 '
650 IF KR$="K" THEN 730
660   TID$="Royal-PC"
670   CL$=CHR$(27)+"T17"
680   CM$=CHR$(27)+"Y%+ %+ "
690   CE$=CHR$(27)+"K"
700   SO$=CHR$(28)
710   SE$=CHR$(18)
720   GOTO 800
730 '
740   TID$="Kaypro"
750   CL$=CHR$(26)
760   CM$=CHR$(27)+"=%+ %+ "
770   CE$=CHR$(24)
780   SO$=""
790   SE$=""
800 '
810 MHZ=4
820 UL$="+":UR$="+":LL$="+":LR$="+":VL$="|":HL$="-"
830 ' 
840 GOTO 1110 ' branch around Z-System stuff
850 '
860 GOSUB 4380 ' Get name of .COM file
870 PNAME$=EFCB$
880 GOSUB 4460 ' Get speed in MHz
890 TINDEX=0:GOSUB 3620:TID$=MID$(X$,1,INSTR(X$," ")-1)  ' Terminal Id
900 TINDEX=1:GOSUB 3620:CL$=X$   ' Clear screen
910 TINDEX=2:GOSUB 3620:CM$=X$   ' Cursor motion macro
920 TINDEX=3:GOSUB 3620:CE$=X$   ' Clear to end of line
930 TINDEX=4:GOSUB 3620:SO$=X$   ' Standout 
940 TINDEX=5:GOSUB 3620:SE$=X$   ' Standout end 
950 TINDEX=6:GOSUB 3620:TI$=X$   ' Terminal init
960 TINDEX=7:GOSUB 3620:TE$=X$   ' Terminal deinit
970 '
980 ' Get graphic strings and characters
990 '
1000 IF NOT (EXTCAPSW$="ON") THEN 1110
1010 GSW$="ON" ' Turn on graphics switch
1020 '
1030 TINDEX=1:GOSUB 3620:GO$=X$   ' Graphics on
1040 TINDEX=2:GOSUB 3620:GE$=X$   ' Graphics off
1050 TINDEX=3:GOSUB 3620:CDO$=X$   ' Cursor off
1060 TINDEX=4:GOSUB 3620:CDE$=X$   ' Cursor on
1070 ' Note: MUST collect cursor on for graphic char. collection to work
1080 FOR I=1 TO 13:G$(I)=CHR$(PEEK(ENV+EOFF+I)):NEXT ' Graphic characters
1090 UL$=G$(1):UR$=G$(2):LL$=G$(3):LR$=G$(4):HL$=G$(5):VL$=G$(6)
1100 ' 
1110 GOSUB 2490 ' Build dice strings
1120 PRINT CL$ ' Clear screen
1130 PRINT SO$;PNAME$;" Version ";VER$;" ";SE$:PRINT
1140 PRINT "Terminal Id: ";SO$;" ";TID$;" ";SE$:PRINT
1150 PRINT "Speed: ";SO$;MHZ;"MHz ";SE$:PRINT
1160 '
1170 PRINT "Welcome to Skunk! The object of the game is to amass 100 points"
1180 PRINT "first. You may roll the dice as many times as you wish each turn"
1190 PRINT "until a skunk or double skunk is rolled. A single skunk wipes"
1200 PRINT "out points acquired for that turn. A double skunk wipes out points"
1210 PRINT "for that turn and all other points."
1220 '
1230 GOSUB 3040 ' Establish upper limit and delay 
1240 ' Entry point for player name entry
1250 FOR P=1 TO 4:GAMESW(P)=0:NEXT
1260 PRINT CL$:PRINT:PRINT:PRINT "How many players ( 1 .. 4 ) ";
1270 S=INPUT$(1):IF NOT (S>"0" AND S<"5") THEN PRINT CL$:GOTO 1260
1280 NP=VAL(S):PRINT:PRINT
1290 FOR P=1 TO NP:PRINT "Player";P;"'s name ";:INPUT SPLAY(P): PRINT:NEXT
1300 IF NP>1 THEN 1350
1310 ' Only one player, other will be computer
1320 NP=2
1330 SPLAY(2)="Computer"
1340 ' Initialize screen
1350 PRINT CDO$ ' kill cursor
1360 GOSUB 2280
1370 R=1:C=0:GOSUB 3940 ' Position cursor
1380 PRINT CMO$;
1390 PRINT " ";SO$;" Score ";SE$;"  ";SO$;" Player ";SE$;
1400 PRINT "     ";SO$;" Games ";SE$
1410 R=22:C=60:GOSUB 3940:PRINT CMO$;SO$;" SKUNK ";VER$;" ";SE$
1420 GOSUB 2140 ' Print scores and names
1430 R=22:C=0:GOSUB 3940
1440 PRINT CMO$+"Any key = roll, <ret> = end turn, ESC = abort game ";
1450 ' Play the game
1460 P=0
1470 P=P+1
1480 GOSUB 1700 ' Play
1490 PSCORE(P)=PSCORE(P)+ITOT
1500 GOSUB 2140 ' Print scores and names
1510 IF PSCORE(P)>UL THEN 1560
1520 FOR DL1=1 TO 100*DL
1530 NEXT
1540 IF P=NP THEN 1460
1550 GOTO 1470
1560 ' Winner - Play again?
1570 FOR P1=1 TO 4:PSCORE(P1)=0:NEXT
1580 GAMESW(P)=GAMESW(P)+1
1590 R=22:C=0:GOSUB 3940 
1600 PRINT CMO$+CE$+CMO$;CDE$; ' clear line, turn cursor on
1610 PRINT "(S)ame / (N)ew players, (C)hange limit/delay, (Q)uit ";
1620 KK$=INPUT$(1):PRINT CL$
1630 PRINT ""
1640 IF INSTR("Ss",KK$)<>0 THEN 1340
1650 IF INSTR("Nn",KK$)<>0 THEN 1240
1660 IF INSTR("Cc",KK$)<>0 THEN GOSUB 3040:GOTO 1340
1670 IF INSTR("Qq",KK$)<>0 THEN 1690 
1680 PRINT CL$:PRINT:GOTO 1610
1690 PRINT CL$;CDE$:SYSTEM
1700 ' Play individual turn subroutine
1710 R=14:C=42:GOSUB 3940
1720 PRINT CMO$+CE$+CMO$+"Your turn, "+SPLAY(P)+" ";
1730 ITOT=0:NOSKU=0
1740 ' Just in case, remove last player's junk from Zilog SIO
1750 FOR II=1 TO 4:SS=INKEY$:NEXT
1760 GOTO 1820
1770 ' Display and turn loop
1780 R=14:C=42:GOSUB 3940
1790 FOR DL1=1 TO 100*DL
1800 NEXT
1810 PRINT CMO$+CE$+CMO$+SPLAY(P)+" ";
1820 IF SPLAY(P) = "Computer" THEN 1900
1830 ' Human input
1840 PRINT CDE$;
1850 SEL=INKEY$:X=RND:IF LEN(SEL)=0 THEN 1850  ' RND omize on user input
1860 PRINT CDO$;
1870 IF SEL=CHR$(13) THEN 2080
1880 IF SEL=CHR$(27) THEN 1690 ' quit
1890 GOTO 1950
1900 ' Computer input
1910 IF ITOT+PSCORE(2)>UL THEN 2080
1920 IF ITOT>20 THEN 2080 ' Quit
1930 IF NOSKU>4 THEN 2080 ' Quit
1940 ' Roll tally & check
1950 GOSUB 2530 ' Roll 'em
1960 ITOT=ITOT+JTOT
1970 IF NUM=1 THEN 2020
1980 IF NUMA=1 THEN 2020
1990 R=17:C=42:GOSUB 3940:PRINT CMO$+"Total so far ";ITOT
2000 GOTO 1770 ' End turn loop
2010 ' A Skunk
2020 ITOT=0
2030 NOSKU=0
2040 IF NUMA=NUM THEN PSCORE(P)=0
2050 FOR DL1=1 TO 100*DL
2060 NEXT
2070 ' End of turn, clear board
2080 C=42
2090 FOR R=14 TO 17 STEP 3:GOSUB 3940:PRINT CMO$+CE$:NEXT
2100 NUM=7
2110 GOSUB 2620 ' Clear upper di
2120 GOSUB 2630 ' Clear lower di
2130 RETURN
2140 ' Print scores and names subroutine
2150 FOR P1=1 TO NP
2160 C=0
2170 R=(P1*2)+2
2180 GOSUB 3940:PRINT CMO$;
2190 PRINT USING "#####";PSCORE(P1)
2200 C=11:GOSUB 3940
2210 PRINT CMO$;
2220 PRINT SPLAY(P1)
2230 C=25:GOSUB 3940
2240 PRINT CMO$;
2250 PRINT GAMESW(P1)
2260 NEXT
2270 RETURN
2280 ' Print dice subroutine
2290 PRINT CL$
2300 C=41
2310 FOR R=3 TO 11
2320 GOSUB 3940:PRINT CMO$;
2330 IF R = 3 THEN PRINT SL1:GOTO 2360
2340 IF R = 11 THEN PRINT SL3:GOTO 2360
2350 PRINT SL2
2360 NEXT R
2370 PRINT  ' A cr for MBASIC
2380 C=21
2390 FOR R=12 TO 20
2400 GOSUB 3940:PRINT CMO$;
2410 IF R = 12 THEN PRINT SL1:GOTO 2440
2420 IF R = 20 THEN PRINT SL3:GOTO 2440
2430 PRINT SL2
2440 NEXT R
2450 PRINT  ' A cr for MBASIC
2460 NUM=1
2470 RETURN
2480 ' Dice outline data subroutine
2490 SL1=GO$+UL$+STRING$(17,HL$)+UR$+GE$
2500 SL2=GO$+VL$+GE$+STRING$(17," ")+GO$+VL$+GE$
2510 SL3=GO$+LL$+STRING$(17,HL$)+LR$+GE$
2520 RETURN
2530 ' Roll 'em subroutine
2540 NOSKU=NOSKU+1:NUM=FNIVAL:JTOT=NUM:NUMA=NUM
2550 GOSUB 2620:GOSUB 2590
2560 NUM=FNIVAL:JTOT=JTOT+NUM:GOSUB 2630
2570 GOTO 2590 ' Use its return
2580 ' Further randomize
2590 FOR I=1 TO 4:X=RND:NEXT
2600 RETURN
2610 ' Dice values; upper right, lower left
2620 R=4:C=45:GOTO 2640
2630 R=13:C=25
2640 IF NUM = 1 THEN RESTORE 2830
2650 IF NUM = 2 THEN RESTORE 2860
2660 IF NUM = 3 THEN RESTORE 2890
2670 IF NUM = 4 THEN RESTORE 2920
2680 IF NUM = 5 THEN RESTORE 2950
2690 IF NUM = 6 THEN RESTORE 2980
2700 IF NUM = 7 THEN RESTORE 3010
2710 ' Print the value
2720 FOR ILIN=1 TO 7
2730 READ SLIN:GOSUB 3940
2740 IF NOT(ILIN=4 AND NUM=1) THEN 2770
2750 FOR X=1 TO RND*10:NEXT
2760 SLIN=SO$+BOWTIE$(INT(64*RND)+1)+SE$
2770 PRINT CMO$+SLIN;
2780 R=R+1
2790 NEXT
2800 PRINT
2810 RETURN
2820 ' Dice value data
2830 DATA "   /---\   ","  | @ @ |  ","   \ ~ /   ","CP/M LIVES!"
2840 DATA "  / *** \  "," /  ***  \ "," \==---==/ "
2850 ' ----- 2
2860 DATA "           ","**         ","           ","           "
2870 DATA "           ","         **","           "
2880 ' ----- 3
2890 DATA "           ","**         ","           ","    ***    "
2900 DATA "           ","         **","           "
2910 ' ----- 4
2920 DATA "           ","**       **","           ","           "
2930 DATA "           ","**       **","           "
2940 ' ----- 5
2950 DATA "           ","**       **","           ","    ***    "
2960 DATA "           ","**       **","           "
2970 ' ----- 6
2980 DATA "           ","**       **","           ","**       **"
2990 DATA "           ","**       **","           "
3000 ' ----- 7 spaces
3010 DATA "           ","           ","           ","           "
3020 DATA "           ","           ","           "
3030 ' 
3040 ' Establish upper limit and delay subroutine
3050 '
3060 UL=100:S1=""
3070 PRINT:PRINT "Enter upper limit ( 20 .. 300 ) ( <ret> for 100 ) ";
3080 S=INKEY$:IF LEN(S)=0 THEN 3080
3090 IF S=CHR$(13) THEN 3110
3100 PRINT S;:S1=S1+S:GOTO 3080
3110 IF LEN(S1)<>0 THEN UL=VAL(S1)
3120 UL=UL-1
3130 DL=250*MHZ/4
3140 PRINT:PRINT:PRINT "Enter delay factor ( 1 .. 9 ) ( <ret> for 1 ) "; 
3150 S=INKEY$:IF LEN(S)=0 THEN 3150
3160 IF S=CHR$(13) THEN 3180
3170 PRINT S;:DL=VAL(S)*DL
3180 PRINT:PRINT 
3190 PRINT "Strike Any Key ... ";
3200 SS=INKEY$
3210 X=RND ' Re-seed based on human's delay
3220 IF LEN(SS)=0 THEN 3200 ELSE RETURN
3230 '
3240 ' Exerpted from Z3BAS.LIB  
3250 '
3260 ' ---
3270 ' Load ENV with environment address.
3280 ' ---
3290 '
3300 Z3$=CHR$(PEEK(&H103))+CHR$(PEEK(&H104))
3310 IF Z3$="Z3" THEN 3450
3320 ' ==> NOTE! Edit &H value below. Will be used under MBASIC.
3330 ' ENV=&HD380+65536! ' Note need to make positive by adding 2^16
3340 ENV=&HEF80+65536! ' Altair simulator
3350 ' ENV=&HF700+65536! ' MYZ80's env. address 
3360 ' ENV=&HFE00+65536! ' ON!'s env. address 
3370 ENV1=PEEK(ENV+&H1B)+256*PEEK(ENV+&H1C)
3380 IF ENV1=ENV THEN 3520
3390 ENV=0
3400 PRINT:PRINT "If running ZCPR3, change statement"
3410 PRINT "ENV=&H ... "
3420 PRINT "Strike Any Key ... ";
3430 IF LEN(INKEY$)=0 THEN 3430
3440 GOTO 3520
3450 IF PEEK(&H10A)<> 0 THEN 3480
3460 PRINT "If not ZCPR3 version ZCPR33+ you must use Z3INS "
3470 PRINT "ZCPR33+ was not found.":ENV=0:GOTO 3420
3480 ENV=PEEK(&H109)+256*PEEK(&H10A)
3490 ENV1=PEEK(ENV+&H1B)+256*PEEK(ENV+&H1C)
3500 IF ENV1=ENV THEN 3520
3510 PRINT:PRINT "Environment self-reference error detected":END
3520 RETURN
3530 '
3540 ' ---
3550 ' Load X$ with tcap string based on TINDEX, a tcap string "index"
3560 ' and ENV, the environment address.
3570 ' X$ will hold terminal id string if TINDEX is 0
3580 ' X$ will hold clear screen string if TINDEX is 1. Etc.
3590 ' Support for character graphics.
3600 ' ---
3610 '
3620 EOFF=128                  ' Start at beginning of tcap segment
3630 IF GSW$="" THEN 3650 ' non graphic?
3640 EOFF=128+GOF+1 ' Start just past graphics delay
3650 IF TINDEX=0 THEN 3740 ' No need to skip anything if looking for id
3660 IF GSW$="" THEN EOFF=128+16+4+3 ' Get past id, arrow and delay bytes 
3670 IF TINDEX=1 THEN 3740 ' No need to skip any more if clear scr wanted
3680 FOR TSKIP=1 TO TINDEX-1    ' Skip the strings we don't want
3690 IF CHR$(PEEK(ENV+EOFF))<>"\" THEN 3710     ' Catch literals
3700 EOFF=EOFF+2                                    ' advance to next character 
3710 IF PEEK(ENV+EOFF)<>0 THEN EOFF=EOFF+1:GOTO 3690  ' Loop till null found
3720 EOFF=EOFF+1                  ' Advance and move to next string
3730 NEXT TSKIP
3740 ' Build tcap string
3750 X$=""                  ' Null out work string 
3760 IF CHR$(PEEK(ENV+EOFF))<>"\" THEN 3780     ' Catch literals
3770 EOFF=EOFF+1:GOTO 3840                         ' Advance to literal
3780 IF NOT (EOFF=128+13 AND TINDEX=0) THEN 3820 ' Get out if id complete
3790 GOF=PEEK(ENV+128+13) ' Save graphic offset
3800 IF PEEK(ENV+128+14)=&H80 THEN EXTCAPSW$="ON"
3810 RETURN
3820 IF PEEK(ENV+EOFF)<>0 OR TINDEX=0 THEN 3840    ' If null
3830 RETURN                                   ' return
3840 X$=X$+CHR$(PEEK(ENV+EOFF)):EOFF=EOFF+1:GOTO 3760 ' else, grab it and loop  
3850 '
3860 ' ---
3870 ' Cursor motion macro interpreter
3880 ' Input: R,C,CM$ (row,col,cursor motion macro)
3890 ' Output: CMO$ (string to output to the terminal)
3900 ' Ref: ZCPR3 The Manual, Richard Conn, Ch 22.
3910 ' ---
3920 '
3930 DIM OFFSET(2),PREINFIX$(2),RC(2),CMD$(2)
3940 WK$="":PCTR=0:I1=0:OFFSET(1)=0:OFFSET(2)=0 ' Initialize
3950 PREINFIX$(1) = "":PREINFIX$(2) = "":RC(1)=R:RC(2)=C ' Initialize 
3960 I1=I1+1:IF I1>LEN(CM$) THEN 4270  ' Top of loop
3970 CMC$=MID$(CM$,I1,1)                ' Load cursor motion macro char.
3980 IF CMC$<>"%" THEN 4240            ' If not a %, tack onto work string
3990 I1=I1+1:CMC$=MID$(CM$,I1,1)        ' Advance
4000 RI=INSTR("RrIi",CMC$)
4010 IF RI=1 OR RI=2 THEN CB4R$="ON":GOTO 3960 ' Handle R,I commands
4020 IF RI=3 OR RI=4 THEN HOME=1:GOTO 3960
4030 PCTR=PCTR+1                      ' Update % counter
4040 PREINFIX$(PCTR)=WK$              ' Save work string 
4050 WK$=""                           ' Null out for future build
4060 IF CMC$<>"." THEN 4090          ' Binary ?
4070 CMD$(PCTR)=CHR$(RC(PCTR)+HOME)
4080 GOTO 3960   ' Loop
4090 D23=INSTR("D23d",CMC$):IF D23=0 THEN 4150 ' Ascii?
4100 CMD$(PCTR)=MID$(STR$(RC(PCTR)+HOME),2)
4110 IF LEN(CMD$(PCTR))=1 AND D23=2 THEN CMD$(PCTR)="0"+CMD$(PCTR) ' Fix
4120 IF LEN(CMD$(PCTR))=1 AND D23=3 THEN CMD$(PCTR)="00"+CMD$(PCTR)
4130 IF LEN(CMD$(PCTR))=2 AND D23=3 THEN CMD$(PCTR)="0"+CMD$(PCTR)
4140 GOTO 3960  ' Loop
4150 IF CMC$<>"+" THEN 4200  ' Offset?
4160 I1=I1+1:CMC$=MID$(CM$,I1,1)
4170 OFFSET(PCTR)=ASC(CMC$)
4180 CMD$(PCTR)=CHR$(RC(PCTR)+HOME+OFFSET(PCTR))
4190 GOTO 3960  ' Loop
4200 IF CMC$<>">" THEN PRINT "Error in cursor motion macro ... ":END
4210 I1=I1+1:CMC1$=MID$(CM$,I1,1):I1=I1+1:CMC$=MID$(CM$,I1,1)
4220 IF CHR$(RC(PCTR))>CMC1$ THEN 4170 ELSE 4180
4230 ' Compute conditional offset, then use "+" code
4240 ' We have a character that's not part of a % command. Just add it
4250 WK$=WK$+CMC$
4260 GOTO 3960  ' Loop
4270 ' All done. Anything left (in WK$) is the postfix part.
4280 IF CB4R$="ON" THEN SWAP CMD$(1),CMD$(2)  ' If col before row, swap
4290 CMO$=PREINFIX$(1)+CMD$(1)+PREINFIX$(2)+CMD$(2)+WK$  ' Build CMO$
4300 RETURN
4310 '
4320 ' ---
4330 ' Load variables (QUIET, WHEEL etc.) based on ENV,
4340 ' the environment address. 
4350 ' ---
4360 '
4370 ' External File Control Block stuff
4380 EFCBA=PEEK(ENV+&H24)+256*PEEK(ENV+&H25)+1
4390 EFCB$=""
4400 IF CHR$(PEEK(EFCBA))<>" " AND LEN(EFCB$)<8 THEN EFCB$=EFCB$+CHR$(PEEK(EFCBA)):EFCBA=EFCBA+1:GOTO 4400
4410 RETURN
4420 ' Other stuff
4430 QUIET=PEEK(ENV+&H28):RETURN
4440 WHLA=PEEK(ENV+&H29)+256*PEEK(ENV+&H2A):RETURN
4450 WHEEL=PEEK(WHLA):RETURN
4460 MHZ=PEEK(ENV+&H2B):RETURN
4470 MAXD=PEEK(ENV+&H2C):RETURN
4480 MAXU=PEEK(ENV+&H2D):RETURN
4490 DUOK=PEEK(ENV+&H2E):RETURN
4500 '