!--------------------------!
!  AM-100 CLOCK SOLITAIRE  !
!--------------------------!

!  COPYRIGHT JAN 1983, BOB FOWLER
!  Dedicated to sister Doris, who first taught me to play this time-waster

!  Results of 4000 games:
!      Cards left :  0   1   2   3   4   5   6   7   8   9+
!      Games      : 302 294 278 236 271 234 202 165 183 1835

       MAP1 STACK(13)
               MAP2 STACK'CARD(5)
                       MAP3 STACK'CARD'NUM,B,1         ! =1-13
                       MAP3 STACK'CARD'DSP,S,3         ! "nns"
                       MAP3 STACK'CARD'DONE,S,1        ! "Y" if turned up
               MAP2 STACK'ROW,B,1      ! row of upper left hand of stack
               MAP2 STACK'COL,B,1      ! column

       MAP1 CARD
               MAP2 CARD'NUM,B,1
               MAP2 CARD'DSP,S,3
               MAP2 CARD'DONE,S,1

       MAP1 DECK'CARD(52),B,1
       MAP1 COMCOL,F,6,50              ! first column of comment area
       MAP1 COMROW1,F,6,3
       MAP1 COMROW2,F,6,9
       MAP1 NLOST,F,6,9                ! # of "lost" displays
       MAP1 CARDS'LEFT(10),F,6         ! # of cards turned down at game's end
       MAP1 GAME'NUMBER,F,6,1          ! Index of game
       MAP1 GAMES'LEFT,F,6
       MAP1 GAMES'PLAYED,F,6
       MAP1 HYPHENS,S,80,"-"
       FOR I=1 TO 7 : HYPHENS=HYPHENS+HYPHENS : NEXT I

       FOR I=1 TO 13
               STACK'ROW(I)=VAL(("-7-4 0 4 7 8 7 4 0-4-7-8 0")[I*2;-2]) + 11
               STACK'COL(I)=VAL((" 10 16 21 16 10 00-10-16-21-16-10 00 00")[I*3;-3]) + 23
       NEXT I
       FOR I=1 TO 10 : CARDS'LEFT(10)=0 : NEXT I

! One-time Initialization
       PRINT TAB(-1,0); TAB(1,8); "WELCOME TO AM-100 CLOCK SOLITAIRE"

       PRINT TAB(COMROW1,COMCOL); "Current game #";
       PRINT TAB(COMROW1+1,COMCOL); "Current move #";
       PRINT TAB(COMROW1+2,COMCOL); "Games left";
       PRINT TAB(COMROW1+3,COMCOL); "Last game took      seconds";
       PRINT TAB(COMROW1+4,COMCOL); "Last game left    cards";

       PRINT TAB(COMROW2,COMCOL); "Games played  : 00000";
       FOR I=0 TO NLOST-1
               PRINT TAB(COMROW2+1+I,COMCOL); " "; STR(I); " Cards Left : 00000";
       NEXT I
       PRINT TAB(COMROW2+1+NLOST,COMCOL); STR(NLOST); "+ Cards Left : 00000";

       PRINT TAB(2,1); HYPHENS[01,79];
       FOR ROW=3 TO 22
               PRINT TAB(ROW,1); "|";
               PRINT TAB(ROW,COMCOL-2); "|";
               PRINT TAB(ROW,79); "|";
       NEXT ROW
       PRINT TAB(23,1); HYPHENS[01,79];

NEXT'QUERY:
       PRINT TAB(24,1); "Return for next game or enter own game # (0 to end)";
       PRINT TAB(COMROW1,COMCOL+16); TAB(-1,11); STR(GAME'NUMBER);
       PRINT TAB(COMROW1,COMCOL+16); TAB(-1,12);
       DUMMY=-1
       INPUT "" DUMMY
       PRINT TAB(24,1); TAB(-1,9);
       IF DUMMY=0 THEN GOTO END
       IF DUMMY=-1 THEN DUMMY=GAME'NUMBER
       GAME'NUMBER=DUMMY MAX 1

       PRINT TAB(24,1); "Enter # of games to play without interruption : 1";
       PRINT TAB(COMROW1+2,COMCOL+16); "1"; CHR(8);
       DUMMY=1
       INPUT "" DUMMY
       PRINT TAB(24,1); TAB(-1,9);
       GAMES'LEFT=DUMMY MAX 1

NEXT'GAME:
       T1=TIME
       PRINT TAB(COMROW1+2,COMCOL+16); STR(GAMES'LEFT); SPACE(6);
       PRINT TAB(COMROW1,COMCOL+16);
       IF GAMES'LEFT=0 THEN PRINT SPACE(6); : GOTO NEXT'QUERY
       PRINT STR(GAME'NUMBER); SPACE(6);
       ! reproducible randomized game seed expression follows
       DUMMY=RND(-SIN(GAME'NUMBER*SQR(2)))

       ! Clear Display
       IF GAMES'PLAYED=0 THEN GOTO SHUFFLE
       FOR ROW=3 TO 22
               PRINT TAB(ROW,2); SPACE(COMCOL-4);
       NEXT ROW

SHUFFLE:
       FOR I=1 TO 52 : DECK'CARD(I)=I : NEXT I
       UNSHUFFLED=52
       FOR I=1 TO 4
               FOR ISTACK=1 TO 13
                       POSITION=INT(RND(1)*(UNSHUFFLED-.000001))
                       PICK=DECK'CARD(POSITION+1)-1
                       DECK'CARD(POSITION+1)=DECK'CARD(UNSHUFFLED)
                       UNSHUFFLED=UNSHUFFLED-1
                       NUM=INT(PICK/4)+1
                       SUIT=PICK-4*(NUM-1)+1
                       STACK'CARD'NUM(ISTACK,I)=NUM
                       STACK'CARD'DSP(ISTACK,I)=(" A 2 3 4 5 6 7 8 910 J Q K")[NUM*2;-2]+(" H D C S")[SUIT*2;-1]
                       STACK'CARD'DONE(ISTACK,I)="N"
                       GOSUB DISPLAY'CARD
               NEXT ISTACK
       NEXT I
       MOVE=0
       CARD=STACK'CARD(13,4)           ! pick up top card of King Stack (#13)
       STACK'CARD'DSP(13,4)="   "      ! and blank out display
       ISTACK=13 : I=4 : GOSUB DISPLAY'CARD    ! display it

NEXT'MOVE:
       MOVE=MOVE+1
       PRINT TAB(-1,12); TAB(COMROW1+1,COMCOL+16); MOVE USING "#Z";
       ISTACK=CARD'NUM                 ! destination stack #
       FOR I=4 TO 1   STEP -1          ! move stack up
               STACK'CARD(ISTACK,I+1)=STACK'CARD(ISTACK,I)
       NEXT I
       STACK'CARD(ISTACK,1)=CARD       ! put in bottom card
       STACK'CARD'DONE(ISTACK,1)="Y"   ! it is now face up
       IF ISTACK#13 THEN GOTO NON'KING
! King Found
       IF STACK'CARD'DONE(13,4)="N" THEN GOTO NOT'LOST
! 4th King Found
       GOSUB DISPLAY'STACK
       GOTO GAME'OVER
NOT'LOST:
       CARD=STACK'CARD(13,4)           ! pick up top card
       STACK'CARD'DSP(13,4)="   "
       GOSUB DISPLAY'STACK
       GOTO NEXT'MOVE
NON'KING:
       CARD=STACK'CARD(ISTACK,5)       ! pick up top card
       GOSUB DISPLAY'STACK
       GOTO NEXT'MOVE

GAME'OVER:
       PRINT TAB(-1,12);
       DOWN=52-MOVE
       DOWN=DOWN MIN NLOST
       CARDS'LEFT(DOWN+1)=CARDS'LEFT(DOWN+1)+1
       GAMES'PLAYED=GAMES'PLAYED+1
       PRINT TAB(COMROW2,COMCOL+15); GAMES'PLAYED USING "######";
       FOR I=0 TO NLOST
               PRINT TAB(COMROW2+1+I,COMCOL+15);
               PRINT CARDS'LEFT(I+1) USING "######"; " ";
               PRINT CARDS'LEFT(I+1)/GAMES'PLAYED*100 USING "###.##"; "%";
       NEXT I

       GAME'NUMBER=GAME'NUMBER+1
       GAMES'LEFT=GAMES'LEFT-1
       T2=TIME
       PRINT TAB(COMROW1+3,COMCOL+15); (T2-T1)/60 USING "#Z.#";
       PRINT TAB(COMROW1+4,COMCOL+15); DOWN USING "#Z";
       GOTO NEXT'GAME

DISPLAY'STACK:
       FOR I=1 TO 4            ! display all 4
               GOSUB DISPLAY'CARD
       NEXT I
       RETURN

DISPLAY'CARD:
       IF STACK'CARD'DONE(ISTACK,I)="N" PRINT TAB(-1,11); ELSE PRINT TAB(-1,12);
       PRINT TAB(STACK'ROW(ISTACK)+I-1,STACK'COL(ISTACK));
       PRINT STACK'CARD'DSP(ISTACK,I);
       RETURN

END:
       PRINT TAB(24,36); "[Bye now]"; TAB(23,1)
       END

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.