!Solitare program for one player

!	Written by: 
!
!		George D. Peavy, 		06/22/88
!		MIO Frontiers, Inc.,  
!		PO Box 40159
!		Pasadena, CA  91104
!
!	COPYRIGHT (C) George D. Peavy, 1988; all rights reserved
!
!	Program inspired by a similar program written on an HP-2000 system
!	by Boyd Whitman, Sierra College, Rocklin, CA, March, 1980
!
!	Program available to members of Alpha Micro User's Society free of
!	charge, but may not be sold.
!
!	Route comments, complaints and suggestions via EMAIL to FI/AM
!	on the AMUS network
!
!	Program makes use of INKEY.SBR,  available on the AMUS network.....
!
!	This program was written on an AM-100/L system running AMOS/L 1.3, 
!	using a WYSE-50 terminal.  It should work on all releases of 
!	AMOS/L.  It has not been tested using other terminal drivers. Hence,
!	if you have other types of terminals (T950, VT-100, etc.), you may
!	need to alter the TCRT function calls to match your terminal driver.  
!	Cards turned face down should display as a solid block; that is, a 
!	space printed with reverse video.  Black cards display in reduced
!	intensity.
!
! UPDATE HISTORY:
! 
! [100] 06/22/88 Original program
! [101]	06/29/88 Added processing to display black cards in reduced 
!		 intensity video. (Thanks for suggestion from Bret Halle)  
! [102] 07/05/88 Display current winnings on screen, clean up displays
!		 so that only screen areas being updated are reprinted
!		 during a repaint.

	PROGRAM SOLIT1, 1.1(102)

	MAP1 ARRAYS
	    MAP2 DECK(52),F
	    MAP2 STACK(52),S,2
	    MAP2 BOARD(18,7,2),S,2
	    MAP2 SIDE(4),S,2
	    MAP2 SIDE1(4),F
	    MAP2 LENGTH(2,7),B
	    MAP2 RCOLS(7),S,1

	MAP1 FLOATS
	    MAP2 I,F
	    MAP2 J,F
	    MAP2 A,F
	    MAP2 B,F
	    MAP2 C,F
	    MAP2 STACK'POINT,F		! current card in stack
	    MAP2 TOP,F			! top card in stack
	    MAP2 DOLLARS,F,6,0		! total winnings
	    MAP2 CURR'DOLLARS,F,6,0	! winnings for this game
	    MAP2 UP'COUNT,F,6,0		! number of cards in pile turned up
	    MAP2 DOWN'COUNT,F,6,0	! number of cards in pile remaining
	    MAP2 BOARD'COUNT,F,6,21	! number of face-down cards on board
	    MAP2 DIF,F

	MAP1 BINARIES
	    MAP2 SUCCESS,B		! if successful, repaint
	    MAP2 CARD%,B
	    MAP2 CARD1%,B
	    MAP2 SUIT%,B
	    MAP2 SUIT1%,B

	MAP1 OTHERS
	    MAP2 MOVE,S,1		! move to be made
	    MAP2 MOVE1,F
	    MAP2 MOVE1S,S,1
	    MAP2 MOVE2,F
	    MAP2 MOVE2S,S,1
	    MAP2 CURR'CARD,S,2		! current card
START:
	MOVE=""
	FOR I=1 TO 7 : RCOLS(I)="+" : NEXT I
	FOR I=1 TO 18 
	    FOR J=1 TO 7 
		BOARD(I,J,1)="$$" 
		BOARD(I,J,2)=""
	    NEXT J
	NEXT I
	FOR I=1 TO 4 : SIDE(I)=".." : SIDE1(I)=0 : NEXT I
	FOR I=1 TO 7 : LENGTH(1,I)=I : LENGTH(2,I)=I : NEXT I

	RANDOMIZE
	FOR I=1 TO 52
	    DECK(I)=I
	NEXT I

	?TAB(-1,0)
	?"SHUFFLING THE CARDS....."
	FOR I=1 TO 52
	    A=INT(52*RND(0))+1
	    B=INT(52*RND(0))+1
	    C=DECK(A)
	    DECK(A)=DECK(B)
	    DECK(B)=C
	    ? TAB(10,40);I
	NEXT I
	FOR I=52 TO 1 STEP -1
	    A=INT(52*RND(0))+1
	    B=INT(52*RND(0))+1
	    C=DECK(A)
	    DECK(A)=DECK(B)
	    DECK(B)=C
	    ? TAB(10,40);I
	NEXT I
	FOR I=1 TO 52
	    CARD%=DECK(I)		! CARD NUMBER
	    IF CARD% <= 13 THEN STACK(I)="H" : GOTO DOWN
	    CARD%=CARD%-13
	    IF CARD% <= 13 THEN STACK(I)="D" : GOTO DOWN
	    CARD%=CARD%-13
	    IF CARD% <= 13 THEN STACK(I)="S" : GOTO DOWN
	    CARD%=CARD%-13
	    STACK(I)="C"
    DOWN:
	    IF CARD% > 1 AND CARD% < 10 THEN  &
		STACK(I)=STR(CARD%)+STACK(I) : GOTO DOWN1
	    IF CARD% = 1 THEN STACK(I) = "A" + STACK(I) : GOTO DOWN1
	    IF CARD% = 10 THEN STACK(I) = "0" + STACK(I) : GOTO DOWN1
	    IF CARD% = 11 THEN STACK(I) = "J" + STACK(I) : GOTO DOWN1
	    IF CARD% = 12 THEN STACK(I) = "Q" + STACK(I) : GOTO DOWN1
	    STACK(I) = "K" + STACK(I)
    DOWN1:
	NEXT I

	STACK'POINT=1
	FOR I=1 TO 7
	    FOR J=I TO 7

		BOARD(I,J,1)=STACK(STACK'POINT)
		IF J>I THEN BOARD(I,J,2)="-" ELSE &
		    BOARD(I,J,2)="+"	! "+"=SHOWING, "-"=DOWN
	  	STACK(STACK'POINT)="XX"
		STACK'POINT=STACK'POINT+1
	    NEXT J
	NEXT I

	UP'COUNT=1
	DOWN'COUNT=52-STACK'POINT
	TOP=STACK'POINT	
	CURR'DOLLARS=-52
	BOARD'COUNT=21
	?TAB(-1,0);
	?TAB(14,50);"N - Next card"
	?TAB(15,50);"M - Move cards from column"
	?TAB(16,50);"      to column"
	?TAB(17,50);"S - Move card from column"
	?TAB(18,50);"      to side piles"
	?TAB(19,50);"C - Move card from pile"
	?TAB(20,50);"      to column"
	?TAB(21,50);"P - Move card from pile"
	?TAB(22,50);"      to side piles"
	?TAB(23,50);"Q - Quit"
	CALL REPAINT

MOVE:
 	?TAB(16,5);"CARD = ";
	IF (STACK(STACK'POINT)[2,2]="S" OR STACK(STACK'POINT)[2,2]="C") AND &
		STACK'POINT#0 THEN ?TAB(-1,11);
	IF STACK'POINT#0 THEN  &
		? STACK(STACK'POINT); TAB(-1,12); ELSE ? "XX";TAB(-1,12);
	?TAB(18,5);"UP =";UP'COUNT;TAB(18,15);"DOWN = ";DOWN'COUNT
	!?TAB(19,5);"BOARD'COUNT = ";BOARD'COUNT	!!! for debugging
	?TAB(22,1);"                                     " ! clear prev msg
	IF STACK'POINT=0 AND BOARD'COUNT=0 THEN CURR'DOLLARS=208 : ?TAB(23,1); &
		"ALL CARDS ARE TURNED UP.  YOU WIN!"
	?TAB(20,5);"          ";TAB(20,5);"MOVE : ";
	MOVE=""
    WAIT0:
	XCALL INKEY,MOVE
	IF MOVE="" THEN GOTO WAIT0
	?TAB(23,1);"                                     " ! clear error msg
	MOVE=UCS(MOVE)
	?TAB(20,13);MOVE;
	IF MOVE = "N" THEN CALL NEXT'CARD ELSE &
	IF MOVE = "M" THEN CALL MOVE'CARDS ELSE &
	IF MOVE = "S" THEN CALL SIDE ELSE &
	IF MOVE = "C" THEN CALL CARDS ELSE &
	IF MOVE = "P" THEN CALL PILES ELSE &
	IF MOVE = "Q" THEN GOTO QUIT ELSE &
		?CHR(7);
	GOTO MOVE
QUIT:
	?TAB(22,1);"ARE YOU SURE YOU WANT TO QUIT? ";
	MOVE=""
    WAIT1:
	XCALL INKEY,MOVE
	IF MOVE="" THEN GOTO WAIT1
	?MOVE;
	IF UCS(MOVE)#"Y" THEN GOTO EXIT 
	?TAB(-1,0)
	DOLLARS=DOLLARS+CURR'DOLLARS
	?"WINNINGS FOR THIS GAME = ";CURR'DOLLARS
	?
	?"TOTAL WINNINGS = ";DOLLARS USING "$##,###"
	?
	?"DO YOU WANT TO PLAY AGAIN ? ";
	MOVE=""
    WAIT2:
	XCALL INKEY,MOVE
	IF MOVE="" THEN GOTO WAIT2
	?MOVE;
	IF UCS(MOVE)="Y" THEN GOTO START
	? : ? : ?
	END
    EXIT:
	?TAB(22,1);"                                     "
	GOTO MOVE

NEXT'CARD:
	CALL CHECK
	IF SUCCESS=1 THEN GOTO END'STACK
	IF STACK'POINT=52 THEN GOTO LAST'CARD
	STACK'POINT=STACK'POINT+1
	IF STACK(STACK'POINT)="XX" THEN GOTO NEXT'CARD
	UP'COUNT=UP'COUNT+1
	DOWN'COUNT=DOWN'COUNT-1
	GOTO END'STACK
LAST'CARD:
	IF STACK'POINT=0 THEN ?TAB(23,1);"STACK COMPLETELY EMPTY " : GOTO END'STACK
	IF STACK(STACK'POINT)="XX" THEN STACK'POINT=STACK'POINT-1 : GOTO LAST'CARD 
	?TAB(23,1);"END OF DECK -- NO MORE CARDS" 
END'STACK:
	RETURN

CHECK:
	IF STACK'POINT=0 THEN SUCCESS=0 : GOTO END'CHECK
	IF STACK(STACK'POINT)="XX" THEN SUCCESS=0 : GOTO END'CHECK
	PRINT TAB(24,1);
	CALL CHECK'MOVE
	IF CARD1%=13 THEN IF LENGTH(1,MOVE1)=1 THEN SUCCESS=0
	IF SUCCESS=0 THEN GOTO CHECK1
!!!	?TAB(20,20);"CARD% = ";CARD%;"   SUIT% = ";SUIT%
!!!	?TAB(21,20);"CARD1%= ";CARD1%;"   SUIT1%= ";SUIT1%
	?CHR(7);TAB(23,1);"You must move if you are able";
	GOTO END'CHECK
   CHECK1:
	CALL CARD'BOARD
	IF SUCCESS=0 THEN GOTO CHECK2
	?CHR(7);TAB(23,1);"You must move a card onto the board"
	GOTO END'CHECK
    CHECK2:
	CALL VER'SIDE
	IF SUCCESS=0 THEN GOTO CHECK3
	?CHR(7);TAB(23,1);"You must move a card to the side"
	GOTO END'CHECK
    CHECK3:
	CURR'CARD=STACK(STACK'POINT)
	CALL TO'NUMERIC
	CALL CHECK'SIDE
	IF SUCCESS=0 THEN GOTO END'CHECK
	?CHR(7);TAB(23,1);"YOU MUST MOVE THIS CARD TO SIDE PILES"
    END'CHECK:
	RETURN

CARD'BOARD:
	SUCCESS=0
	CURR'CARD=STACK(STACK'POINT)
	CALL TO'NUMERIC
	SUIT1%=SUIT%
	CARD1%=CARD%
	FOR I=1 TO 7
	    MOVE1=I
	    CALL CHECK'CARD
	    IF SUCCESS=1 THEN GOTO END'CARDB
	NEXT I
    END'CARDB:
	RETURN

CHECK'MOVE:
	SUCCESS=0
	FOR I=1 TO 7
	    MOVE1=I
	    IF LENGTH(1,MOVE1)=0 THEN GOTO NEXTII
	    FOR J=1 TO 7
		MOVE2=J
		IF I=J THEN GOTO SAME
		CURR'CARD=BOARD(LENGTH(1,MOVE1),MOVE1,1)
		CALL TO'NUMERIC
		SUIT1%=SUIT%
		CARD1%=CARD%
		CALL CHECK'MOVE1
		IF SUCCESS=1 THEN GOTO END'MOVEC
	SAME:
	    NEXT J
    NEXTII:
	NEXT I
    END'MOVEC:
	RETURN

VER'SIDE:
	SUCCESS=0
	FOR I=1 TO 7
	    IF LENGTH(1,I)=0 AND LENGTH(2,I)=0 THEN GOTO NEXTI
	    CURR'CARD=BOARD(LENGTH(2,I),I,1)
	    CALL TO'NUMERIC
	    CALL CHECK'SIDE
	    IF SUCCESS=1 THEN GOTO END'VER
    NEXTI:
	NEXT I
    END'VER:
	RETURN

MOVE'CARDS:
	MOVE1=0
	MOVE1S=""
	?TAB(22,1);"From which column? ";
	MOVE1S=""
    WAIT3:
	XCALL INKEY,MOVE1S
	IF MOVE1S="" THEN GOTO WAIT3
	?MOVE1S;
	MOVE1=VAL(MOVE1S)
	IF MOVE1=0 OR MOVE1 >7 THEN ?CHR(7) : GOTO MOVE'CARDS
	IF LENGTH(1,MOVE1)=0 THEN GOTO BAD2
	CURR'CARD=BOARD(LENGTH(1,MOVE1),MOVE1,1)
	CALL TO'NUMERIC
	SUIT1%=SUIT%
	CARD1%=CARD%
    UP0:
	MOVE2=0
	MOVE2S=""
	?TAB(22,1);"To which column?    ";
	MOVE2S=""
    WAIT4:
	XCALL INKEY,MOVE2S
	IF MOVE2S="" THEN GOTO WAIT4
	?MOVE2S;
	MOVE2=VAL(MOVE2S)
	IF MOVE2=0 OR MOVE2 >7 THEN ?CHR(7) : GOTO UP0
	CALL CHECK'MOVE1
	IF SUCCESS=0 THEN GOTO BAD2
	RCOLS(MOVE1)="+"	
	RCOLS(MOVE2)="+"
	DIF=LENGTH(2,MOVE1)-LENGTH(1,MOVE1)+1
	FOR I=1 TO DIF
	    BOARD(LENGTH(2,MOVE2)+I,MOVE2,1)=	&
		BOARD(LENGTH(1,MOVE1)+I-1,MOVE1,1)
	    BOARD(LENGTH(2,MOVE2)+I,MOVE2,2)="+"
	    BOARD(LENGTH(1,MOVE1)+I-1,MOVE1,1)="  "
	    BOARD(LENGTH(1,MOVE1)+I-1,MOVE1,2)=""
	NEXT I
	LENGTH(2,MOVE2)=LENGTH(2,MOVE2)+DIF
	LENGTH(1,MOVE1)=LENGTH(1,MOVE1)-1
	LENGTH(2,MOVE1)=LENGTH(1,MOVE1)
	IF LENGTH(1,MOVE1)>0 THEN BOARD(LENGTH(1,MOVE1),MOVE1,2)="+" : &
		BOARD'COUNT=BOARD'COUNT-1
	CALL REPAINT
	GOTO END'MOVE
    BAD2:
	?TAB(23,1);CHR(7);"Illegal move            "
    END'MOVE:
	RETURN

CHECK'MOVE1:
	IF CARD1%=13 AND LENGTH(2,MOVE2)=0 THEN SUCCESS=1 : GOTO END'CHECKM1
	IF LENGTH(2,MOVE2)=0 THEN GOTO BAD1
	CURR'CARD=BOARD(LENGTH(2,MOVE2),MOVE2,1)
	CALL TO'NUMERIC
	IF CARD1%+1#CARD% THEN GOTO BAD1
	IF SUIT%<=2 AND SUIT1%<=2 THEN GOTO BAD1
	IF SUIT%>=3 AND SUIT1%>=3 THEN GOTO BAD1
	SUCCESS=1
	GOTO END'CHECKM1
    BAD1:
	SUCCESS=0
    END'CHECKM1:
	RETURN

SIDE:
	MOVE1=0
	MOVE1S=""
	?TAB(22,1);"From which column? ";
	MOVE1S=""
    WAIT5:
	XCALL INKEY,MOVE1S
	IF MOVE1S="" THEN GOTO WAIT5
	?MOVE1S;
	MOVE1=VAL(MOVE1S)
	IF MOVE1=0 OR MOVE1>7 THEN ?CHR(7) : GOTO SIDE
	IF LENGTH(1,MOVE1)=0 AND LENGTH(2,MOVE1)=0 THEN GOTO BAD1
	CURR'CARD=BOARD(LENGTH(2,MOVE1),MOVE1,1)
	CALL TO'NUMERIC
	CALL TO'SIDE
	IF SUCCESS=0 THEN GOTO END'SIDE
	RCOLS(MOVE1)="+"
	BOARD(LENGTH(2,MOVE1),MOVE1,1)="  "
	BOARD(LENGTH(2,MOVE1),MOVE1,2)=""
	LENGTH(2,MOVE1)=LENGTH(2,MOVE1)-1
	IF LENGTH(2,MOVE1)=0 THEN LENGTH(1,MOVE1)=0 : GOTO END'CLEAR
	BOARD(LENGTH(2,MOVE1),MOVE1,2)="+"	
	IF LENGTH(2,MOVE1)<LENGTH(1,MOVE1) THEN &
		LENGTH(1,MOVE1)=LENGTH(2,MOVE1) : BOARD'COUNT=BOARD'COUNT-1
    END'CLEAR:
	CALL REPAINT
    END'SIDE:
	RETURN

CARDS:
	MOVE1=0
	MOVE1S=""
	?TAB(22,1);"To which column? ";
	MOVE1S=""
    WAIT6:
	XCALL INKEY,MOVE1S
	IF MOVE1S="" THEN GOTO WAIT6
	?MOVE1S;
	MOVE1=VAL(MOVE1S)
	IF MOVE1=0 OR MOVE1 >7 THEN ?CHR(7) : GOTO CARDS
	CURR'CARD=STACK(STACK'POINT)
	CALL TO'NUMERIC
	SUIT1%=SUIT%
	CARD1%=CARD%
	CALL CHECK'CARD
	IF SUCCESS=0 THEN GOTO BAD0
	RCOLS(MOVE1)="+"
	LENGTH(2,MOVE1)=LENGTH(2,MOVE1)+1
	BOARD(LENGTH(2,MOVE1),MOVE1,1)=STACK(STACK'POINT)
	BOARD(LENGTH(2,MOVE1),MOVE1,2)="+"
	CALL CARD'OFF
	CALL REPAINT
	GOTO END'CARDS
    BAD0:
	?TAB(23,1);CHR(7);"Illegal move        "
    END'CARDS:
	RETURN

CHECK'CARD:
	IF CARD1%=13 AND LENGTH(2,MOVE1)=0 THEN SUCCESS=1 : GOTO END'CHECKC
	IF LENGTH(2,MOVE1)=0 THEN GOTO BAD
	CURR'CARD=BOARD(LENGTH(2,MOVE1),MOVE1,1)
	CALL TO'NUMERIC
	IF CARD1%+1#CARD% THEN GOTO BAD
	IF SUIT%<=2 AND SUIT1%<=2 THEN GOTO BAD
	IF SUIT%>=3 AND SUIT1%>=3 THEN GOTO BAD
	SUCCESS=1
	GOTO END'CHECKC
    BAD:
	SUCCESS=0
    END'CHECKC:
	RETURN

PILES:
	CURR'CARD=STACK(STACK'POINT)
	CALL TO'NUMERIC
	CALL TO'SIDE
	IF SUCCESS=0 THEN GOTO END'PILES
	CALL CARD'OFF
	CALL REPAINT
    END'PILES:
	RETURN

REPAINT:
	?TAB(-1,1)
	? TAB(5);" 1     2     3     4     5     6     7"; &
		TAB(50);"SIDE PILES";TAB(63);"WINNINGS"
	? TAB(5);"----------------------------------------"; &
		TAB(50);"----------";TAB(63);"--------"
	? TAB(16,5);"                      "
	? TAB(18,5);"                      "
	? TAB(20,5);"                      "
	? TAB(22,1);"                           "
	FOR J=1 TO 7
	IF RCOLS(J)#"+" THEN GOTO OUT0:
	RCOLS(J)=""
	FOR I=1 TO 18
	?TAB(3+I,(6*J));	
	IF (BOARD(I,J,1)[2,2]="S" OR BOARD(I,J,1)[2,2]="C") AND &
		BOARD(I,J,2)="+" THEN ?TAB(-1,11); &
		ELSE ?TAB(-1,12);
	IF BOARD(I,J,2)="+" THEN ? " ";BOARD(I,J,1); ELSE &
		IF BOARD(I,J,2)="-" THEN ?TAB(-1,32);"  ";TAB(-1,33); &
	ELSE ? "   ";
	?TAB(-1,12);
	NEXT I
    OUT0:
	NEXT J
	?
	IF MOVE#"S" THEN IF MOVE#"P" THEN IF MOVE#""GOTO OUT1
	?TAB(5,55);SIDE(1)
	?TAB(7,55);SIDE(2)
	?TAB(9,55);TAB(-1,11);SIDE(3)
	?TAB(11,55);SIDE(4);TAB(-1,12);
	?TAB(5,64);"THIS GAME: ";CURR'DOLLARS USING "####"
	?TAB(7,64);"TOTAL    : ";DOLLARS+CURR'DOLLARS USING "####"
    OUT1:
	RETURN

TO'NUMERIC:
	IF CURR'CARD[2,2]="H" THEN SUIT%=1 ELSE &
	IF CURR'CARD[2,2]="D" THEN SUIT%=2 ELSE &
	IF CURR'CARD[2,2]="S" THEN SUIT%=3 ELSE &
		SUIT%=4
	IF CURR'CARD[1,1]="A" THEN CARD%=1 ELSE &
	IF CURR'CARD[1,1]="0" THEN CARD%=10 ELSE &
	IF CURR'CARD[1,1]="J" THEN CARD%=11 ELSE &
	IF CURR'CARD[1,1]="Q" THEN CARD%=12 ELSE &
	IF CURR'CARD[1,1]="K" THEN CARD%=13 ELSE &
		CARD%=VAL(CURR'CARD[1,1])
	RETURN

TO'SIDE:
	CALL CHECK'SIDE
	IF SUCCESS=0 THEN ?TAB(23,1); CHR(7); &
		"YOU CAN'T PUT THIS CARD ON THE PILE" : GOTO END'TO'SIDE
	SIDE1(SUIT%)=SIDE1(SUIT%)+1
	SIDE(SUIT%)=CURR'CARD
	CURR'DOLLARS=CURR'DOLLARS+5
    END'TO'SIDE:
	RETURN

CHECK'SIDE:
	SUCCESS=0
	IF SIDE1(SUIT%)=CARD%-1 THEN SUCCESS=1
	RETURN

CARD'OFF:
	STACK(STACK'POINT)="XX"
	IF STACK'POINT=TOP THEN TOP=TOP+1 : GOTO END'CARD'OFF
    UP1:
	STACK'POINT=STACK'POINT-1
	IF STACK'POINT=TOP THEN GOTO END'CARD'OFF
	IF STACK(STACK'POINT)="XX" THEN GOTO UP1
    END'CARD'OFF:
	UP'COUNT=UP'COUNT-1
	RETURN