! SoliTree  -  A GBBS game module
! A Wabbit Production 
! February 24, 1991

! Converted to METAL by Doctor Quack
! on April 4, 1992

! Last Modification
! 11/09/92 06:51 by Arc Angel

! Length 12869 bytes
! ******************

link_main
 gosub cleanup
 run "1/main","GameRoomEnter"
link_term
 gosub cleanup
 run "1/main","Term0"
link_clock
 gosub cleanup
 run "1/main","TimeOut"

cleanup
 gosub window                ! see STND.SUBS for this routine...
 vid(15)=vd15
 unhide                      ! Now this is one HANDY COMMAND! :)
 return

settraps
 trap modem=6 goto link_term
 trap syserr goto SystemCrash
 trap clock(1) goto link_clock
 trap clock(5) goto link_term
 return
CrashRecover
 gosub settraps:goto Enter2

Enter global
 hide                      ! Our first & Favorite command, thanks Tc!
 vd15=vid(15):vid(15)=0    ! turn off page pausing, save value
 gosub settraps

 if fsed or (term>1) or (term<5) goto Enter2        ! Taken from Global War!
 print "
______________________________________________________________________________

We are sorry, but the terminal emulation that you are currently using is not
supported by this game. In order to play this game, you must have a terminal
emulation that is capable of using the Full Screen Editor, such as ProTERM
Special or ANSI/VT100.
______________________________________________________________________________

Press RETURN to exit: ";
 input i$
 goto link_main

Enter2
 clear vid
 prefix$(22)="2/cardgames/"   ! Modify this prefix if you want for your system
 mo$=chr$(16)
 in$=chr$(15)
 no$=chr$(14)
 rp$=chr$(18)
Menu
 text
 clear vid
 xx$="":xy$="":sd$=""
 if fileinfo$("22/st.users")="" then create "22/st.users",4
 open#1, "22/st.users"
 position#1,64,user
 input#1,x$\p1,p2,t,tg,w
 if x$="" then p1=0:p2=0:t=0:tg=0:w=0
 close#1
 print @(32,6)"SOLITREE- Metal";
 print @(27,8)"A Doctor Quack Production";
 print @(30,9)"Of a game by Wabbit";
 if date$<>x$ t=0:p1=0:tg==+1
 if t>3 goto write4a
begin
 long if fileinfo$("22/cards")=""
      ! Generates a deck of cards.
      xc$=" 2C3C4C5C6C7C8C9C1CJCQCKCAC"
      xd$="2D3D4D5D6D7D8D9D1DJDQDKDAD"
      xh$="2H3H4H5H6H7H8H9H1HJHQHKHAH"
      xs$="2S3S4S5S6S7S8S9S1SJSQSKSAS"
      xx$=xc$+xd$+xh$+xs$:xc$="":xd$="":xh$="":xs$=""
      create "22/cards",4:open#1,"22/cards":print#1,xx$:close#1
 end if
 open#1,"22/st.data":input#1,dh\pl$\pe$\ph\ph$\sm$\aw$\as$\ww:close#1
 if left$(x$,2)<>left$(date$,2) then p2=0:p1=0:w=0:tg=1
 if date$<>pl$ gosub nd
 dqt=dh:gosub SpicyOutput:dh$=dqt$
 dqt=ph:gosub SpicyOutput:di$=dqt$
 print @(7,4)"Last month's winner was "aw$" with ";
 print in$;" ";as$;" ";no$;" points and "ww" wins.";
 print @(21,18)"Today's high score is "dh$;
 print @(21,19)"      by "pe$;
 print @(18,20)"Yesterday's high score was "di$;
 print @(21,21)"      by "ph$;

choice
 print @(32,11);in$;"P";no$;"lay";
 print @(32,12);in$;"V";no$;"iew top scores";
 print @(32,13);in$;"I";no$;"nstructions";
 print @(32,14);in$;"Q";no$;"uit";
 print @(29,16);"What's your pleasure? ";
choice2
 gosub getkey
 if i$="P" then ve=22:ho=4:goto begin2
 if i$="V" then gosub top:clear vid:goto Menu
 long if i$="I"
    f$="22/st.help"
    gosub show_file
    input mode("U") i$
    clear vid
    goto Menu
 end if
 if i$="Q" goto write6
 goto choice2

begin2
 nc=56
 open#1,"22/cards":input#1,xx$:close#1
 xy$=xx$:sd$=""
 print @(ho,ve);
 input mode("U") "Press RETURN ";i$
 print @(ho,ve);"Shuffling . ";:free
 gosub shuffle
 xy$=" "+sd$:swapvar xy$,sd$    ! <-- replaces --> xx$=xy$:sd$=xy$
 open#1,"22/cards":print#1,sd$:close#1
start
 gosub drawboard
 bd$="1121231234123451234561234567 ":co$="A234567891JQKA2"
 gosub stack
 ve=3*x+1:i=3*x+1:ho=(md-i)-1:cl=7:cl$=bd$[22,cl]:p=1:lo=7
 goto move
 goto begin

shuffle
 free
 for y=1 to 52
 if (y mod 13=0) print ". ";
 gosub shuffle1
 next
 return

shuffle1
 l=len(xy$):x=l/2
 cd=random(x)+1
 cd==*2
 cd$=xx$[cd,2]
 sd$=cd$+sd$
 gosub cutcard
 xx$="":xx$=xy$
 return

cutcard
 if cd$=left$(xx$,2) then xy$=" "+right$(xx$,l-2):return
 if cd$=right$(xx$,2) then xy$=left$(xx$,l-2):return
 c=cd-1
 xl$=left$(xx$,c)
 c==+2:xr$=right$(xx$,l-c)
 xy$=xl$+xr$
 return

drawboard
 clear vid
 md=58:y=0
 for x=1 to 7
 i=3*x
 ho=md-i-1:ve=i
 gosub drawcard
 next
 x==-1
 return
drawcard
 for a=1 to x
 y==+2:c$=sd$[y,2]
 if c$="00" ho==+6:next:return
 if left$(c$,1)="1" then c$="1O"+right$(c$,1)
 cd$=left$(c$+"   ",5)
 print @(ho,ve);in$;cd$;
 ve==+1:print @(ho,ve);"     ";:ve==+1
 cd$=right$("    "+c$,5)
 print @(ho,ve);cd$;no$;
 ve==-2:ho==+6
 next
 return

move
 push move
 print @(ho,ve);mo$;"U";no$;
move1
 gosub getkey
 if (i$=chr$(13)) and (rm>0) then h=ho:v=ve:goto nextcard
 if i$=chr$(32) print @(ho,ve)" ";:goto find
 if i$=chr$(27) goto redraw
 if i$="D" goto finished
 if cl<2 goto move1
 if i$=chr$(21) print @(ho,ve)" ";:p==+1:goto curliner
 if i$=chr$(8) print @(ho,ve)" ";:p==-1:goto curlinel
 for zz=1 to 100:next:clear input             ! Help prevent line noise mishap
 goto move1

curliner
 if lo=1 ho==+6:return
 if (p>cl) goto nextline
 if cl$[p,1]="0" p==+1:ho==+6:goto curliner
 gosub chkcard
 if (cl$[p,1]<>"0") and (ch=1) ho==+6:return
 p==+1:ho==+6:goto curliner
curlinel
 if (p<1) goto nextline
 if cl$[p,1]="0" p==-1:ho==-6:goto curlinel
 gosub chkcard
 if (cl$[p,1]<>"0") and (ch=1) ho==-6:return
 p==-1:ho==-6:goto curlinel
chkcard
 if cl=lo ch=1:return
 y=cl-1*cl/2
 y==+p
 ch=0
 if bd$[y+cl,2]="00" then ch=1
 return
nextline
 if not instring("00",cl$) gosub findlo:return
 gosub moveup:if (i$=chr$(21)):ho==+6:goto curlinel
 ho==-6:goto curliner

findlo
 y=lo-1*lo/2
 y==+1
 cl$=bd$[y,lo]
 y=1
 if (i$=chr$(8)):y=lo:goto findlol
 goto findlor
findlor
 if cl$[y,1]="0" y==+1:goto findlor
 p=y:cl=lo:ve=lo*3+1:i=3*lo:ho=md-i
 i=p-1:a=6*i:ho==+a:ho==-2
 return
findlol
 if cl$[y,1]="0" y=y-1:goto findlol
 p=y:cl=lo:ve=lo*3+1:i=3*lo:ho=md-i
 i=p-1:a=6*i:ho==+a:ho==-2
 return

remove
 h=ho:v=ve
 p2==+1:p1==+1:gosub points
 long if lo=1
     ve=2:ho=md-4:gosub topcard
     cl=lo:gosub ptline:w==+1:goto finished
 end if
 ve==-1
 for a=1 to 3
 print @(ho,ve);rp$;" ";chr$(6);
 ve==+1
 next
 nc$=c$
 gosub nextcd2
 cl$[p,1]="0"
remove3
 y=cl-1*cl/2
 y==+p
 bd$=left$(bd$,y-1)+"0"+right$(bd$,29-y)
 if cl$=repeat$("0",cl) then lo==-1:gosub ptline:goto moveup
 ho=h:ve=v
 if (i$=chr$(8)) p==-1:goto curlinel
 p==+1:goto curliner
ptline
 ho=md-13:ve=cl*3+2:print @(ho,ve);
 if cl>3 print "-----  1,000 Points  -----";:p2==+10:p1==+10
 if cl=3 print "-----  2,000 Points  -----":p2==+20:p1==+20
 if cl=2 print "-----  5,000 Points  -----":p2==+50:p1==+50
 long if cl=1
      print "-----";in$;" 10,000 Points ";no$;
      print "------":p2==+100:p1==+100
 end if
 gosub points
 return
moveup
 cl==-1:if cl=1:p=1:cl$="1":gosub moveup3:pop:goto move
 y=cl-1*cl/2
 y==+1
 cl$=bd$[y,cl]
 if (i$=chr$(8)) y=cl:p=cl:goto moveup4
 y=1:p=1
moveup2
 y=p:if y>cl goto nextline
 if cl$[y,1]="0" p==+1:goto moveup2
 gosub chkcard
 if (cl$[p,1]<>"0") and (ch=1) goto moveup3
 p==+1:goto moveup2
moveup3
 ve=cl*3+1:i=3*cl:ho=md-i
 i=p-1:a=6*i:ho==+a:ho==-2
 return
moveup4
 y=p:if y<1 goto nextline
 if cl$[y,1]="0" p==-1:goto moveup4
 gosub chkcard
 if (cl$[p,1]<>"0") and (ch=1) goto moveup5
 p==-1:goto moveup4
moveup5
 ve=cl*3+1:i=3*cl:ho=md-i
 i=p-1:a=6*i:ho==+a:ho==-2
 return
find
 if cl=1 y=1:goto find2
 y=cl-1*cl/2
 y==+p
find2
 c$=sd$[y*2,2]
 cd$=left$(c$,1)
 c=instring(cd$,co$)
 if c=1 then c=14
 if (n$=co$[c-1,1]) or (n$=co$[c+1,1]) goto find3
 return
find3
 a=y*2:s1$=left$(sd$,a-1)+"00"+right$(sd$,104-a):sd$=s1$
 goto remove

stack
 gosub border
 print @(6,17)" ";rp$;"_";chr$(5);
 for a=18 to 20
 print @(6,a);mo$;"ZVWVWV_";no$;
 next
 print @(6,21)" "mo$;rp$;"L";chr$(5);no$;
 print @(14,17)" ";rp$;"_";chr$(5);
 for a=18 to 20
 print @(14,a);mo$;"Z";no$;in$;rp$;" ";chr$(5);mo$;"_";no$;
 next
 print @(14,21);" ";mo$;rp$;"L";chr$(5);no$;
 print @(3,7)"Points:";
 gosub points
 print @(3,10)"[Space]  = Play card";
 print @(3,11)"[Return] = Next deck card";
 print @(3,12)"[D]one   = Done";
 print @(3,13);mo$;" H  U ";no$;"   = Move cursor";
 a=3-t:i$="s":if a=1 i$=""
 print @(4,15)a" game"i$" remaining ";
 dqt=dh:gosub SpicyOutput:dh$=dqt$
 print @(3,5)"Today's high: ";in$;" ";dh$;" ";no$;
nextcard
 nc==+2
 a=104-nc:rm=a/2
 print @(8,16);:a$="":if rm>1 a$="s"
 if rm print rm;" card"a$" left ";
 if rm=0 print "No cards left";:gosub nomore
 nc$=sd$[nc,2]
nextcd2
 n$=left$(nc$,1)
 if n$="1" then nc$="10"+right$(nc$,1)
 pc$=left$(nc$+"    ",5)
 print @(15,18);in$;pc$;
 cd$=right$("    "+nc$,5)
 print @(15,20);cd$;no$;
 ho=h:ve=v:print @(ho,ve);
 return
nomore
 for a=17 to 21
 print @(6,a);rp$;" ";chr$(7);
 next
 ho=h:ve=v:print @(ho,ve);
 return
topcard
 for a=1 to 3
 ve==+1:print @(ho,ve);rp$;" ";chr$(5);
 next
 return
points
 h=ho:v=ve
 dqt=p1:gosub SpicyOutput:p1$=dqt$
 p1$=right$("          "+p1$,9)
 print @(10,7);p1$;
 dqt=p2:gosub SpicyOutput:p2$=dqt$
 p2$=right$("          "+p2$,9)
 print @(10,8);p2$;
 ho=h:ve=v
 return
finished
 print @(3,21);
 t==+1:if (t<4) print "Play another? (Y/N) ";:else goto finish3
finish2
 gosub getkey
 if i$="Y" print"Yes":pop:ve=8:ho=31:goto begin2
 if i$="N" print @(3,21);:goto finish3
 goto finish2
finish3
 print "Saving your stats...";
 pop
 if p1<=dh goto save
 dh=p1
 delete "22/st.data":create "22/st.data",4
 open#1,"22/st.data":print#1,dh\date$\usr$(1)\ph\ph$\date$\aw$\as$\ww:close#1
save
 open#1, "22/st.users"
 position#1,64,user
 print #1,date$\p1,p2,t,tg,w
 close#1

write
 delete "9/temp":create "9/temp",4
 open #2,"9/temp"
 j=0:open #1,"22/st.stats"
write1
 input #1,a$\b\c\d\e
 if (p2>c) and not (j) print #2,usr$(1)\p1\p2\tg\w:j=1:goto write2
 if (usr$(1)=a$) and (p2<c) and (j>0) goto write2
write2
 if a$="" goto write4
 if (usr$(1)=a$) and (j>0) goto write3
 if (usr$(1)=a$) then b=p1:c=p2:d=tg:e=w
 print #2,a$\b\c\d\e:if a$=usr$(1) j=1
write3
 if a$="" goto write4
 goto write1
write4
 close:delete "22/st.stats":create "22/st.stats",4
 open #1,"22/st.stats":open #2,"9/temp":tcopy #2 to #1
 close
write4a
 print @(5,23);"View top scores? ";
write5
 gosub getkey
 if i$="Y" gosub top:gosub hmany:goto write6
 if i$="N" gosub hmany:goto write6
 goto write5
write6
 goto link_main

hmany
 if t>3 input mode("U") \\"         Sorry, only four games a day. "i$
 return

getkey
 get mode(1) i$
 return

show_file
 print chr$(12);
 abort$=" "
 tcopy f$
 abort$=""
 return

top
 clear vid
 print \\rp$;" ";chr$(8);"Name";rp$;" ";chr$(21);"Daily";
 print rp$;" ";chr$(7);"Monthly    Played   Wins"
 print " ";rp$;chr$(95);chr$(70);" "
 print mo$;"Z";no$;rp$;" ";chr$(70);mo$;"_";no$
 xx=0
 open #1,"22/st.stats"
top2
 xx=xx+1
 input #1,a$\b\c\d\e
 if a$="" goto top3
 dqt=b:gosub SpicyOutput:b1$=dqt$
 b1$=right$("          "+b1$,9)
 dqt=c:gosub SpicyOutput:b2$=dqt$
 b2$=right$("          "+b2$,9)
 xx$=right$("  "+str$(xx),2)
 i$=xx$+". "+a$:tg$=right$("  "+str$(d),2)
 w$=right$("  "+str$(e),2)
 printmo$;"Z";no$;i$;:ax=len(i$):bx=29-ax:print repeat$(" ",bx);b1$;
 ax=len(b1$):bx=13-ax:print repeat$(" ",bx);b2$;
 ax=len(b2$):bx=15-ax:print repeat$(" ",bx);tg$;
 ax=len(tg$):bx=8-ax:print repeat$(" ",bx);w$"   "mo$"_";no$
 if a$="" goto top3
 goto top2
top3
 close #1
 print mo$;"Z";no$;rp$;chr$(95);chr$(70);mo$;"_";no$\
 print rp$;" ";chr$(25);"[ Press ";mo$;"M";no$;" ]";repeat$(chr$(8),3);
 gosub getkey
 return

reset
 p1=0:p2=0:t=0:tg=1:w=0
 open #1,"22/st.stats"
 input #1,aw$\b\c\d\e
 close #1
 dqt=c:gosub SpicyOutput:as$=dqt$
 if aw$="" then aw$="nobody"
 delete "22/st.data":create "22/st.data",4
 delete "22/st.stats":create "22/st.stats",4
reset_nd
 ph=dh:ph$=pe$
 dh=0:pe$="nobody"
 open#1,"22/st.data":print#1,dh\date$\pe$\ph\ph$\date$\aw$\as$\e:close#1
 return

nd
 open #1, "22/st.stats"
 delete "9/temp":create "9/temp",4
 open #2, "9/temp"
nd1                                      ! Primary Loop; Resets daily score
 input #1, a$\b\c\d\e
 if a$="" then close: goto nd2
 b=0
 print #2, a$\b\c\d\e
 goto nd1

nd2
 close
 delete "22/st.stats"
 fcopy "9/temp" to "22/st.stats" mode(2)
 qy$=date$
 if left$(qy$,2)<>left$(sm$,2) then gosub reset:return
 gosub reset_nd
 return

SpicyOutput
! Input: DQT: Score
! Output: DQT$: "Spiced Up Score"
 pushvar p$,i$
 p$=str$(dqt)
 dqt$=right$("      "+p$,5)+"00"
 if dqt$[4,1]<>" " then i$=dqt$[1,4]+","+right$(dqt$,3):dqt$=i$
 if dqt$[1,1]<>" " then i$=dqt$[1,1]+","+right$(dqt$,7):dqt$=i$
 if dqt=0 then dqt$="0"
 pullvar i$,p$
 return

redraw
 clear vid
 gosub drawboard
 cp$=nc$
 nc==-2:gosub stack
 nc$=cp$:n$=left$(nc$,1)
 pc$=left$(nc$+"    ",5)
 print @(15,18);in$;pc$;
 pc$=right$("    "+nc$,5)
 print @(15,20);pc$;no$;
 gosub findlo
 return
border
 print @(1,4);rp$;chr$(95);chr$(28);
 for a=5 to 21
 print @(0,a);mo$;"Z";@(29,a);"_";
 next
 print @(1,6);rp$;chr$(83);chr$(28);
 print @(1,9);rp$;chr$(83);chr$(28);
 print @(1,14);rp$;chr$(83);chr$(28);
 print @(1,22);rp$;chr$(76);chr$(28);no$;
 return

.include 1/i/stnd.subs