home *** CD-ROM | disk | FTP | other *** search
/ PDA Software Library / pdasoftwarelib.iso / PSION / GAMES / SOLO / OPL / SOLO.OPL next >
Encoding:
Text File  |  1993-01-05  |  19.8 KB  |  1,107 lines
  1. REM Solo 1.0 : Solitaire Card game
  2. REM (c) 1993 Steve Hawtin
  3. REM This game may be freely 
  4. REM distributed provided
  5. REM  1) All the files are copied 
  6. REM     unmodified
  7. REM  2) The distributor charges no more
  8. REM     than a reasonable copy fee
  9.  
  10. APP solo
  11.     TYPE 3
  12.      ICON "\OPD\SOLO.PIC"
  13.      PATH "\APP\SOLO"
  14.     EXT "SOL"
  15. ENDA
  16.  
  17. PROC solo:
  18.     REM Reserve some space
  19.     GLOBAL filName$(128),saveIt%
  20.     GLOBAL space%(300)
  21.     GLOBAL img%,game%
  22.     REM Symbolic names for offsets
  23.     GLOBAL ofSeed%,oUsTime%,ofTurn%
  24.     GLOBAL oDrSuit%,ofdrNum%,oDrPict%
  25.     GLOBAL ofLeft%,oftLft%,oPileSz%
  26.     GLOBAL ofState%,ofKings%,ofMatch%
  27.     GLOBAL offPack%,offSuit%,offPile%
  28.     GLOBAL offSrc%,offHide%,offEnd%
  29.     LOCAL k%
  30.  
  31.     game% = ADDR(space%())
  32.     REM ONERR errLab
  33.     init:
  34.  
  35.     DO
  36.         CLS
  37.         runProg:
  38.         DO
  39.             k% = mGET%:
  40.         UNTIL k%=%q OR k%=%  OR k%=%o
  41.     UNTIL 0
  42.  
  43.     REM Error handling
  44. errLab::
  45.     ONERR OFF
  46.     msgPrep:
  47.     PRINT "Error - ";err$(err)
  48.     msgAck%:
  49. ENDP
  50.  
  51. PROC init:
  52.     filName$ = "\APP\SOLO\*.sol"
  53.     oDrSuit% = 8
  54.     ofdrNum% = 9
  55.     oDrPict% = 10
  56.     oUsTime% = 11
  57.     ofSeed%  = 12
  58.     ofTurn%  = 14
  59.     ofLeft%  = 15
  60.     oftLft%  = 16
  61.     oPileSz% = 17
  62.     ofMatch% = 18
  63.     ofKings% = 19
  64.     ofState% = 20
  65.     
  66.     offPack% = 22
  67.     POKEB game%+offPack%,52
  68.     POKEB game%+ofState%,1
  69.  
  70.     POKEB game%,7
  71.     POKEB game%+ofTurn%,3
  72.     POKEB game%+ofLeft%,255
  73.     POKEB game%+oPileSz%,255
  74.     POKEB game%+ofMatch%,1
  75.     POKEB game%+ofKings%,1
  76.     POKEB game%+oUsTime%,1
  77.     POKEW game%+ofSeed%,1
  78.     POKEB game%+oDrSuit%,1
  79.     POKEB game%+ofdrNum%,0
  80.     POKEB game%+oDrPict%,1
  81.     ONERR errEnd
  82.     img% = gLOADBIT("\app\solo\images.pic")
  83.     ONERR OFF
  84.     gUSE 1
  85.     STATUSWIN OFF
  86.     SCREEN 40,9,1,1
  87.     gSETWIN 0,0,240,80
  88.     filName$ = CMD$(2)
  89.     IF CMD$(3)="O"
  90.         openF:
  91.         saveIt% = 0
  92.     ELSEIF CMD$(2)="C"
  93.         saveIt% = 1
  94.     ENDIF
  95.     RETURN
  96. errEnd::
  97.     IF ERR = -33
  98.         img% = 0
  99.     ENDIF
  100.     ONERR OFF
  101. ENDP
  102.  
  103. PROC msgPrep:
  104.     gAT 0,0
  105.     gFILL 25*6-1,2*9-1,1
  106.     AT 1,1
  107. ENDP
  108.  
  109. PROC msgAck%:
  110.     LOCAL k%
  111.     k% = mGET%:
  112.     msgPrep:
  113.     RETURN k%
  114. ENDP
  115.  
  116. PROC mGET%:
  117.     LOCAL chr%
  118.     LOCAL a%(6),cmdStr$(255)
  119.  
  120.     DO
  121.         GETEVENT a%()
  122.         IF (a%(1) AND $400)=0
  123.             chr% = a%(1)
  124.         ELSEIF a%(1)=$401 OR a%(1)=$402 OR a%(1)=$403
  125.             chr% = 0
  126.         ELSEIF a%(1)=$404
  127.             cmdStr$ = GETCMD$
  128.             IF LEFT$(cmdStr$,1)="C"
  129.                 saveF:
  130.                 filName$=MID$(cmdStr$,2,128)
  131.                 saveIt%=1
  132.                 chr%=%A
  133.             ELSEIF LEFT$(cmdStr$,1)="O"
  134.                 saveF:
  135.                 filName$=MID$(cmdStr$,2,128)
  136.                 openF:
  137.                 chr%=%O
  138.             ELSEIF LEFT$(cmdStr$,1)="X"
  139.                 saveF:
  140.                 STOP
  141.             ELSE
  142.                 msgPrep:
  143.                 PRINT "File event ";cmdStr$
  144.                 chr%=0
  145.             ENDIF
  146.         ELSE
  147.             msgPrep:
  148.             PRINT "Event ";a%(1);" ?"
  149.             chr%=0
  150.         ENDIF
  151.         IF chr%=$122
  152.              mINIT
  153.             IF PEEKB(game%+ofState%)=1
  154.                  mCARD "File","Open",%O,"Save As",%A,"About",%B,"Help",%?,"Seed",%S,"Start",%Q
  155.                  mCARD "Special","Drawing",%I,"Options",%P,"Exit",%X
  156.              ELSE
  157.                  mCARD "File","Open",%O,"Save As",%A,"About",%B,"Help",%?,"Stop",%Q
  158.                  mCARD "Play","Turn",%T,"To Spades",%S,"To Diamonds",%D,"To Hearts",%H,"To Clubs",%C
  159.                 mCARD "Pile","One",%1,"Two",%2,"Three",%3,"Four",%4,"Five",%5,"Six",%6
  160.                  mCARD "Special","Drawing",%I,"Refresh",%R,"Exit",%X
  161.              ENDIF
  162.             chr%=MENU+512
  163.             IF chr%=512
  164.                 chr%=0
  165.             ENDIF
  166.         ENDIF
  167.         IF chr%=(512+%b)
  168.             dINIT "About Game"
  169.             dTEXT "Solitaire","1.0 (Jan 1993)"
  170.             dTEXT "Author","Steve Hawtin"
  171.             dTEXT "Tested by","Angela Beasley"
  172.             DIALOG
  173.             chr%=0
  174.         ELSEIF chr%=(512+%i)
  175.             setDraw:
  176.         ELSEIF chr%=(512+%o)
  177.             openD:
  178.         ELSEIF chr%=(512+%a)
  179.             saveD:
  180.             chr%=0
  181.         ELSEIF chr%=(512+%x)
  182.             STOP
  183.         ELSEIF chr%=(512+%?) OR chr%=291
  184.             doHelp:
  185.             chr% = 0
  186.         ENDIF
  187.         IF PEEKB(game%+ofState%)=1
  188.             IF chr%=(512+%p)
  189.                 setOpts:
  190.                 chr%=0
  191.             ELSEIF chr%=(512+%s)
  192.                 setSOpts:
  193.                 chr%=0
  194.             ENDIF
  195.         ENDIF
  196.     UNTIL chr%<>0
  197.     IF chr%>=512
  198.         chr% = chr%-512
  199.     ENDIF
  200.     RETURN chr%
  201. ENDP
  202.  
  203. PROC saveD:
  204.     dINIT "Save as"
  205.     dFILE filName$,"File",$11
  206.     IF DIALOG=0
  207.         RETURN
  208.     ENDIF
  209.     saveF:
  210. ENDP
  211.  
  212. PROC saveF:
  213.     LOCAL file%,ret%
  214.  
  215.     BUSY "Saving..."
  216.     ret%=IOOPEN(file%,filName$,$0102)
  217.     IF fileErr%:(ret%)
  218.         BUSY OFF
  219.         RETURN
  220.     ENDIF
  221.     ret%=IOWRITE(file%,game%,offEnd%)
  222.     IF fileErr%:(ret%)
  223.         BUSY OFF
  224.         RETURN
  225.     ENDIF
  226.     ret%=IOCLOSE(file%)
  227.     IF fileErr%:(ret%)
  228.         BUSY OFF
  229.         RETURN
  230.     ENDIF
  231.     BUSY OFF
  232. ENDP
  233.  
  234. PROC openD:
  235.     LOCAL c%
  236.     dINIT "Load game"
  237.     dFILE filName$,"File",$10
  238.     c% = 1
  239.     dCHOICE c%,"Current Game","Abandon,Save"
  240.     IF DIALOG=0
  241.         RETURN
  242.     ENDIF
  243.     IF c%=2
  244.         saveD:
  245.     ENDIF
  246.     openF:
  247. ENDP
  248.  
  249. PROC openF:
  250.     LOCAL file%,ret%,c%,g%(10)
  251.  
  252.     BUSY "Loading..."
  253.     ret%=IOOPEN(file%,filName$,$0000)
  254.     IF fileErr%:(ret%)
  255.         BUSY OFF
  256.         RETURN
  257.     ENDIF
  258.     c%=0
  259.     DO
  260.         ret%=IOREAD(file%,ADDR(g%()),1)
  261.         POKEB game%+c%,PEEKB(ADDR(g%()))
  262.         c%=c%+1
  263.     UNTIL ret%<0
  264.     IF ret%<>-36 
  265.         IF fileErr%:(ret%)
  266.             BUSY OFF
  267.             RETURN
  268.         ENDIF
  269.     ENDIF
  270.     ret%=IOCLOSE(file%)
  271.     IF fileErr%:(ret%)
  272.         BUSY OFF
  273.         RETURN
  274.     ENDIF
  275.     initOffs:
  276.     BUSY OFF
  277. ENDP
  278.  
  279. PROC fileErr%:(r%)
  280.     IF r%>=0
  281.         RETURN 0
  282.     ENDIF
  283.     GIPRINT ERR$(r%),1
  284.     RETURN -1
  285. ENDP
  286.  
  287. PROC doHelp:
  288.     LOCAL n%,c%
  289.     LOCAL l1$(80),l2$(80),l3$(80),l4$(80)
  290.     LOCAL title$(80),link$(255)
  291.     LOCAL t$(255)
  292.  
  293.     ONERR errEnd1
  294.     OPEN "\app\solo\help.dbf",A,title$,l1$,l2$,l3$,l4$,link$
  295.     ONERR OFF
  296.     title$ = "PgIntroduction"
  297.     DO
  298.         FIRST
  299.         IF FIND(title$)=0
  300.             l1$="Missing page "+title$
  301.             t$ = "Return to game,Introduction"
  302.         ELSE
  303.             l1$= A.l1$
  304.             t$ = "Return to game,"+A.link$
  305.         ENDIF
  306.         title$ = "Soliaire help : "+MID$(title$,3,255)
  307.         dINIT title$
  308.         dTEXT ""," "
  309.         IF l1$<>""
  310.             dTEXT "",l1$
  311.         ENDIF
  312.         IF A.l2$<>""
  313.             dTEXT "",A.l2$
  314.         ENDIF
  315.         IF A.l3$<>""
  316.             dTEXT "",A.l3$
  317.         ENDIF
  318.         IF A.l4$<>""
  319.             dTEXT "",A.l4$
  320.         ELSE
  321.             dTEXT ""," "
  322.         ENDIF
  323.         n%=2
  324.         dCHOICE n%,"<Enter> for ",t$
  325.         IF DIALOG=0
  326.             BREAK
  327.         ENDIF
  328.         IF n%>1
  329.             c%=1
  330.             DO
  331.                 IF MID$(t$,c%,1)=","
  332.                     n% = n%-1
  333.                 ENDIF
  334.                 c%=c%+1
  335.             UNTIL n%=1
  336.             link$ = MID$(t$,c%,255)
  337.             c%=1
  338.             DO
  339.                 c%=c%+1
  340.             UNTIL c%=LEN(link$) OR MID$(link$,c%,1)=","
  341.             IF c%=LEN(link$)
  342.                 title$ = "Pg"+LEFT$(link$,c%)
  343.             ELSE
  344.                 title$ = "Pg"+LEFT$(link$,c%-1)
  345.             ENDIF
  346.             n%=5
  347.         ENDIF
  348.     UNTIL n%=1
  349.     CLOSE
  350.     RETURN
  351. errEnd1::
  352.     IF ERR = -33
  353.         dINIT "Soliaire help"
  354.         dTEXT "","Help file missing"
  355.         DIALOG
  356.     ELSE
  357.         dINIT "Soliaire help"
  358.         dTEXT "","Problem with help file"
  359.         DIALOG
  360.     ENDIF
  361.     ONERR OFF
  362. ENDP
  363.  
  364. PROC setSOpts:
  365.     LOCAL l&,a%
  366.  
  367.     dINIT "Seed Options"
  368.     a% = PEEKB(game%+oUsTime%)
  369.     dCHOICE a%,"Use","Time,Seed"
  370.     l& = PEEKB(game%+ofSeed%)
  371.     dLONG l&,"Seed",1,9999
  372.     DIALOG
  373.     POKEB game%+oUsTime%,a%
  374.     POKEW game%+ofSeed%,l&
  375. ENDP
  376.  
  377. PROC setDraw:
  378.     LOCAL a%,b%
  379.     dINIT "Drawing options"
  380.     b% = PEEKB(game%+oDrSuit%)
  381.     dCHOICE b%,"Suits","Image,Text"
  382.     a% = 1+PEEKB(game%+ofdrNum%)+2*PEEKB(game%+oDrPict%)
  383.     dCHOICE a%,"Numbers","Text,Numbers,Pictures,Both"
  384.     IF DIALOG=0
  385.         RETURN 0
  386.     ENDIF
  387.     POKEB game%+oDrSuit%,b%
  388.     a% = a%-1
  389.     POKEB game%+oDrPict%,a%/2
  390.     POKEB game%+ofdrNum%,a%-2*PEEKB(game%+oDrPict%)
  391. ENDP
  392.  
  393. PROC setOpts:
  394.     LOCAL a%,b%,c%,d%,e%,f%
  395.  
  396.     dINIT "Solitaire Options"
  397.     a% = PEEKB(game%)-4
  398.     dCHOICE a%,"Piles","5,6,7,8,9"
  399.     d% = PEEKB(game%+ofTurn%)
  400.     dCHOICE d%,"Cards","1,2,3,4"
  401.     IF PEEKB(game%+ofLeft%)=255
  402.         b%=1
  403.     ELSE
  404.         b%=(PEEKB(game%+ofLeft%)-1)/2+1
  405.     ENDIF
  406.     dCHOICE b%,"Packs","Unlimited,1,3,5,7"
  407.     IF PEEKB(game%+oPileSz%)=255
  408.         c%=1
  409.     ELSE
  410.         c%=PEEKB(game%+oPileSz%)+1
  411.     ENDIF
  412.     dCHOICE c%,"Pile Size","Ascending,1,2,3,4,5"
  413.     e% = PEEKB(game%+ofMatch%)
  414.     dCHOICE e%,"Colours","Alternate,Any,Same Colour,Same Suit"
  415.     f% = PEEKB(game%+ofKings%)
  416.     dCHOICE f%,"Empty piles","Kings,Any"
  417.     IF DIALOG=0
  418.         RETURN 0
  419.     ENDIF
  420.     POKEB game%,a%+4
  421.     POKEB game%+ofMatch%,e%
  422.     POKEB game%+ofTurn%,d%
  423.     POKEB game%+ofKings%,f%
  424.     IF b%=1
  425.         POKEB game%+ofLeft%,255
  426.     ELSE
  427.         POKEB game%+ofLeft%,(b%-1)*2+1
  428.     ENDIF
  429.     IF c%=1
  430.         POKEB game%+oPileSz%,255
  431.     ELSE
  432.         POKEB game%+oPileSz%,c%-1
  433.     ENDIF
  434. ENDP
  435.  
  436. PROC setSeed%:
  437.   LOCAL s&
  438.   
  439.   IF PEEKB(game%+oUsTime%)=1
  440.     s& = 60*SECOND + MINUTE + RND*24*60
  441.   ELSE
  442.     s& = PEEKW(game%+ofSeed%)
  443.   ENDIF
  444.   RANDOMIZE s&
  445. ENDP
  446.  
  447. PROC initOffs:
  448.     LOCAL ps%,numPile%
  449.  
  450.     ps% = PEEKB(game%+offPack%)
  451.     numPile% = PEEKB(game%)
  452.   offHide% = offPack%+ps%+2
  453.   offSuit% = offHide%+(numPile%+2)*numPile%
  454.   offPile% = offSuit%+15*4
  455.   offSrc%  = offPile%+15*numPile%
  456.   offEnd%  = offSrc%+ps%+2
  457. ENDP
  458.  
  459. PROC shuffle:
  460.     REM Set up a new pack and clear table
  461.     LOCAL cnt%,ps%,numPile%
  462.  
  463.     REM Size of pack
  464.     initOffs:
  465.     ps% = PEEKB(game%+offPack%)
  466.     numPile% = PEEKB(game%)
  467.     POKEB game%+1,0
  468.     REM Current highlight
  469.     POKEB game%+2,0
  470.     POKEB game%+3,0
  471.     REM Need Redraw
  472.     POKEB game%+4,1
  473.     POKEB game%+5,1
  474.     POKEB game%+6,255
  475.     POKEB game%+7,255
  476.     
  477.   POKEB game%+offPack%,ps%
  478.   newPack:(game%+offPack%)
  479.   cnt% = 0
  480.   DO
  481.       POKEB game%+offHide%+cnt%*(numPile%+2),numPile%
  482.       POKEB game%+offHide%+1+cnt%*(numPile%+2),0
  483.       cnt% = cnt% + 1
  484.   UNTIL cnt% >= numPile%
  485.   cnt% = 0
  486.   DO
  487.       POKEB game%+offSuit%+cnt%*15,13
  488.       POKEB game%+offSuit%+1+cnt%*15,0
  489.       cnt% = cnt%+1
  490.   UNTIL cnt% = 4
  491.   cnt% = 0
  492.   DO
  493.       POKEB game%+offPile%+cnt%*15,13
  494.       POKEB game%+offPile%+1+cnt%*15,0
  495.       cnt% = cnt%+1
  496.   UNTIL cnt% = numPile%
  497.   POKEB game%+offSrc%,ps%
  498.   POKEB game%+offSrc%+1,0
  499.   IF offEnd% > 300*2
  500.       msgPrep:
  501.       PRINT "Need ";offEnd%;" bytes space"
  502.       msgAck:
  503.       STOP
  504.   ENDIF
  505. ENDP
  506.  
  507. PROC newPack:(pack%)
  508.     REM Shuffle the cards in the pack
  509.     LOCAL ordered%(53)
  510.     LOCAL count%,c2%,n%
  511.  
  512.   count% = 1
  513.   DO
  514.     ordered%(count%) = count%-1
  515.     count% = count%+1
  516.   UNTIL count% > PEEKB(pack%)
  517.  
  518.   count% = count%-1
  519.   DO
  520.     n% = 1+RND*(count%)
  521.     POKEB pack%+2+count%-1,ordered%(n%)
  522.     c2% = n%
  523.     DO
  524.       ordered%(c2%) = ordered%(c2%+1)
  525.       c2% = c2%+1
  526.     UNTIL c2% >= count%
  527.     count% = count%-1
  528.   UNTIL count%<0
  529.   POKEB pack%+1,PEEKB(pack%)
  530.   REM showPack:(pack%)
  531. ENDP
  532.  
  533. PROC showPack:(p%)
  534.     LOCAL c%,x%,y%
  535.     CLS
  536.     msgPrep:
  537.     PRINT "Pack"
  538.     c% = 0
  539.     x% = 1
  540.     y% = 2
  541.     DO
  542.         putCard:(PEEKB(p%+2+c%),x%,y%)
  543.         c% = c%+1
  544.         x% = x%+3
  545.         IF x%>35
  546.             x% = 1
  547.             y% = y%+1
  548.         ENDIF
  549.     UNTIL c%>=PEEKB(p%+1)
  550.     msgAck:
  551.     CLS
  552. ENDP
  553.  
  554. PROC deal:
  555.     REM Deal from the pack
  556.     LOCAL cnt%
  557.     
  558.     cnt% = 0
  559.     DO
  560.         IF PEEKB(game%+oPileSz%)=255
  561.             s2eMvS:(game%+offPack%,game%+offHide%+cnt%*(PEEKB(game%)+2),cnt%)
  562.         ELSE
  563.             s2eMvS:(game%+offPack%,game%+offHide%+cnt%*(PEEKB(game%)+2),PEEKB(game%+oPileSz%))
  564.         ENDIF
  565.         s2eMvS:(game%+offPack%,game%+offPile%+cnt%*15,1)
  566.         cnt% = cnt%+1
  567.     UNTIL cnt% = PEEKB(game%)
  568. ENDP
  569.  
  570. PROC s2sMvS:(src%,dest%,num%)
  571.     REM Move cards between packs
  572.     IF num% > 0
  573.         mvCards:(src%,dest%,num%,0,0)
  574.     ENDIF
  575. ENDP
  576.  
  577. PROC s2eMvS:(src%,dest%,num%)
  578.     REM Move cards between packs
  579.     IF num% > 0
  580.         mvCards:(src%,dest%,num%,0,1)
  581.     ENDIF
  582. ENDP
  583.  
  584. PROC e2sMvS:(src%,dest%,num%)
  585.     REM Move cards between packs
  586.     IF num% > 0
  587.         mvCards:(src%,dest%,num%,1,0)
  588.     ENDIF
  589. ENDP
  590.  
  591. PROC e2eMvS:(src%,dest%,num%)
  592.     REM Move cards between packs
  593.     IF num% > 0
  594.         mvCards:(src%,dest%,num%,1,1)
  595.     ENDIF
  596. ENDP
  597.  
  598. PROC mvCards:(src%,dest%,num%,from%,to%)
  599.     REM Move cards between packs
  600.     LOCAL temp%(100),t%,cnt%,t2%
  601.     t% = ADDR(temp%())
  602.     
  603.     IF PEEKB(src%+1) < num%
  604.         GIPRINT "Empty Pile",1
  605.         RETURN
  606.     ENDIF
  607.     IF num% > PEEKB(dest%)-PEEKB(dest%+1)
  608.         GIPRINT "Full Pile",1
  609.         RETURN
  610.     ENDIF
  611.     IF from% = 0
  612.         cnt%=0
  613.         DO
  614.             POKEB t%+cnt%,PEEKB(src%+2+cnt%)
  615.             cnt% = cnt%+1
  616.         UNTIL cnt% = num%
  617.         DO
  618.             POKEB src%+cnt%-num%+2,PEEKB(src%+cnt%+2)
  619.             cnt% = cnt%+1
  620.         UNTIL cnt% >= PEEKB(src%+1)
  621.         POKEB src%+1,PEEKB(src%+1)-num%
  622.     ELSE
  623.         t% = src%+2+PEEKB(src%+1)-num%
  624.         POKEB src%+1,PEEKB(src%+1)-num%
  625.     ENDIF
  626.     IF to% = 0
  627.         cnt%=0
  628.         DO
  629.             POKEB dest%+2+num%+cnt%,PEEKB(dest%+2+cnt%)
  630.             cnt% = cnt%+1
  631.         UNTIL cnt% >= PEEKB(dest%+1)
  632.         cnt%=0
  633.         DO
  634.             POKEB dest%+2+cnt%,PEEKB(t%+cnt%)
  635.             cnt% = cnt%+1
  636.         UNTIL cnt% >= num%
  637.         POKEB dest%+1,PEEKB(dest%+1)+num%
  638.     ELSE
  639.         cnt%=0
  640.         DO
  641.             POKEB dest%+2+cnt%+PEEKB(dest%+1),PEEKB(t%+cnt%)
  642.             cnt% = cnt%+1
  643.         UNTIL cnt% >= num%
  644.         POKEB dest%+1,PEEKB(dest%+1)+num%
  645.     ENDIF
  646. ENDP
  647.  
  648. PROC runProg:
  649.     LOCAL k%,nothing%,t%
  650.     
  651.     IF PEEKB(game%+ofState%)<>0
  652.         BUSY "Dealing..."
  653.       setSeed%:
  654.       shuffle:
  655.       deal:
  656.     ENDIF
  657.     nothing%=0
  658.     POKEB game%+ofState%,0
  659.     POKEB game%+oftLft%,PEEKB(game%+ofLeft%)
  660.     POKEB game%+4,1
  661.     POKEB game%+5,1
  662.     showGame:
  663.     BUSY OFF
  664.     DO
  665.         IF saveIt%<>0
  666.             REM saveF:
  667.             saveIt% = 0
  668.             msgPrep:
  669.         ENDIF
  670.         k% = mGET%:
  671.         IF k%>=%a AND k%<=%z
  672.             k%=k%+%A-%a
  673.         ENDIF
  674.         IF k%>=%1 AND k%<(%1+PEEKB(game%))
  675.             toPile:(k%-%1)
  676.         ELSEIF k%=%T OR k%=% 
  677.             POKEB game%+6,0
  678.             IF PEEKB(game%+offPack%+1)=0
  679.                 POKEB game%+oftLft%,PEEKB(game%+oftLft%)-1
  680.                 IF PEEKB(game%+oftLft%)>200
  681.                     POKEB game%+oftLft%,255
  682.                 ELSEIF PEEKB(game%+oftLft%) = 0
  683.                     GIPRINT "No more pack turns",1
  684.                     POKEB game%+ofState%,1
  685.                 ENDIF
  686.                 s2eMvS:(game%+offSrc%,game%+offPack%,PEEKB(game%+offSrc%+1))
  687.             ELSEIF PEEKB(game%+offPack%+1) < PEEKB(game%+ofTurn%)
  688.                 s2eMvS:(game%+offPack%,game%+offSrc%,PEEKB(game%+offPack%+1))
  689.             ELSE
  690.                 s2eMvS:(game%+offPack%,game%+offSrc%,PEEKB(game%+ofTurn%))
  691.             ENDIF
  692.         ELSEIF k%=%O
  693.             IF PEEKB(game%+ofState%)<>0
  694.                 CLS
  695.                 AT 5,5
  696.                 PRINT "No game in progress"
  697.             ELSE
  698.                 POKEB game%+4,1
  699.                 POKEB game%+5,1
  700.             ENDIF
  701.         ELSEIF k%=%R OR k%=%I OR k%=13
  702.             POKEB game%+4,1
  703.             POKEB game%+5,1
  704.         ELSEIF k%=%S OR k%=%D OR k%=%C OR k%=%H
  705.             toSuit:(k%)
  706.         ELSEIF k%=258 OR k%=259
  707.             k%= 1-2*(k%-258)
  708.             t% = PEEKB(game%+2)+k%
  709.             IF t%<0
  710.                 t% = PEEKB(game%)
  711.             ELSEIF t%>PEEKB(game%)
  712.                 t% = 0
  713.             ENDIF
  714.             IF PEEKB(game%+3)=0
  715.                 nothing%=1
  716.             ELSE
  717.                 POKEB game%+6,t%
  718.                 POKEB game%+7,PEEKB(game%+2)
  719.             ENDIF
  720.             showHlt:
  721.             POKEB game%+2,t%
  722.             POKEB game%+3,0
  723.             showHlt:
  724.         ELSEIF k%=256 OR k%=257
  725.             srcUp:(k%-256,0)
  726.             POKEB game%+6,PEEKB(game%+2)
  727.         ELSEIF k%=260 OR k%=261
  728.             srcUp:(k%-260,1)
  729.             POKEB game%+6,PEEKB(game%+2)
  730.         ELSEIF k%=%Q
  731.             CLS
  732.             AT 5,5
  733.             PRINT "Game abandoned"
  734.             POKEB game%+ofState%,1
  735.         ELSE
  736.             msgPrep:
  737.             PRINT "Key <";k%;"> not used"
  738.             PRINT "Try <Help> or <Menu>"
  739.             nothing%=1
  740.         ENDIF
  741.         IF gameOvr%:
  742.             POKEB game%+ofState%,1
  743.         ELSEIF nothing%=0
  744.             showGame:
  745.         ENDIF
  746.         nothing%=0
  747.     UNTIL PEEKB(game%+ofState%)<>0
  748. endGame::
  749.     msgPrep:
  750.     PRINT "<Space> for another"
  751. ENDP
  752.  
  753. PROC gameOvr%:
  754.     LOCAL k%
  755.     k%=0
  756.     DO
  757.         IF PEEKB(game%+offSuit%+k%*15+1)<>13
  758.             RETURN 0
  759.         ENDIF
  760.         k% = k%+1
  761.     UNTIL k%>=4
  762.     CLS
  763.     k%=0
  764.     AT 1,3
  765.     DO
  766.         PRINT "You win!  ";
  767.         k%=k%+1
  768.     UNTIL k%>=20
  769.     GIPRINT "Completed",1
  770.     RETURN 1
  771. ENDP
  772.  
  773. PROC toPile:(n%)
  774.     LOCAL card%,dcard%,d%,t%,s1%,s2%
  775.     GLOBAL s%
  776.     
  777.     card% = srcCard%:
  778.     d% = game%+offPile%+15*n%
  779.     dcard% = PEEKB(d%+1+PEEKB(d%+1))
  780.     s1% = (card%/13)
  781.     s2% = (dcard%/13)
  782.     t% = s1%+s2%
  783.     IF PEEKB(d%+1)=0
  784.         IF PEEKB(game%+ofKings%)=1 AND (card%-s1%*13)<>12
  785.             GIPRINT "Must be King",1
  786.             RETURN
  787.         ENDIF
  788.     ELSEIF (dcard%-s2%*13)<>(1+card%-s1%*13)
  789.         GIPRINT "Wrong value",1
  790.         RETURN
  791.     ELSEIF PEEKB(game%+ofMatch%)=1 AND (t%=0 OR t%=2 OR t%=4 OR t%=6)
  792.         GIPRINT "Wrong colour",1
  793.         RETURN
  794.     ELSEIF PEEKB(game%+ofMatch%)=3 AND (t%=1 OR t%=3 OR t%=5)
  795.         GIPRINT "Wrong colour",1
  796.         RETURN
  797.     ELSEIF PEEKB(game%+ofMatch%)=4 AND s1%<>s2%
  798.         GIPRINT "Different suit",1
  799.         RETURN
  800.     ENDIF
  801.     POKEB game%+6,PEEKB(game%+2)
  802.     POKEB game%+7,n%+1
  803.     e2eMvS:(s%,game%+offPile%+15*n%,PEEKB(game%+3)+1)
  804.     POKEB game%+3,0
  805.     chkSrc:
  806. ENDP
  807.  
  808. PROC toSuit:(key%)
  809.     LOCAL k%,card%
  810.     GLOBAL s%
  811.  
  812.     k% = suitOf%:(key%)
  813.     card% = srcCard%:
  814.     IF card%= -1
  815.         GIPRINT "Pile empty",1
  816.         RETURN
  817.     ELSEIF PEEKB(game%+3)<>0
  818.         GIPRINT "One card only",1
  819.         RETURN
  820.     ELSEIF (card%/13)<>k%
  821.         GIPRINT "Wrong suit",1
  822.         RETURN
  823.     ELSEIF (card%-k%*13)<>PEEKB(game%+offSuit%+k%*15+1)
  824.         GIPRINT "Wrong value",1
  825.         RETURN
  826.     ENDIF
  827.     POKEB game%+6,PEEKB(game%+2)
  828.     POKEB game%+4,1
  829.     e2sMvs:(s%,game%+offSuit%+k%*15,1)
  830.     chkSrc:
  831. ENDP
  832.  
  833. PROC chkSrc:
  834.     REM Check the curent src pile
  835.     LOCAL s%,n%
  836.     
  837.     n% = PEEKB(game%+2)
  838.     IF n%<>0
  839.         s% = game%+offPile%+15*(n%-1)
  840.         IF PEEKB(s%+1)<>0
  841.             RETURN
  842.         ENDIF
  843.         IF PEEKB(game%+offHide%+1+(PEEKB(game%)+2)*(n%-1))=0
  844.             RETURN
  845.         ENDIF
  846.         e2sMvs:(game%+offHide%+(PEEKB(game%)+2)*(n%-1),s%,1)
  847.     ENDIF
  848. ENDP
  849.  
  850. PROC srcCard%:
  851.     GLOBAL n2%,x%,y%,l%,hid%,src%
  852.     GLOBAL from%
  853.     LOCAL p%,yOff%
  854.  
  855.     p% = PEEKB(game%+2)
  856.     yOff% = PEEKB(game%+3)
  857.     getP:(p%)
  858.     IF n2%<=0
  859.         RETURN -1
  860.     ELSE
  861.         RETURN PEEKB(s%+2+n2%-yOff%-1)
  862.     ENDIF
  863. ENDP
  864.  
  865. PROC srcUp:(up%,all%)
  866.     REM move source up
  867.     GLOBAL n2%,x%,y%,l%,hid%,s%,src%
  868.     GLOBAL from%
  869.     LOCAL p%,yOff%
  870.  
  871.     p% = PEEKB(game%+2)
  872.     yOff% = PEEKB(game%+3)
  873.     getP:(p%)
  874.     IF p%=0
  875.         RETURN
  876.     ELSEIF up%=0 AND yOff%>=n2%-1
  877.         RETURN
  878.     ELSEIF up%<>0 AND yOff%<=0
  879.         RETURN
  880.     ENDIF
  881.     IF all%=0
  882.         IF up%<>0
  883.             yOff% = yOff%-1
  884.         ELSE
  885.             yOff% = yOff%+1
  886.         ENDIF
  887.     ELSE
  888.         IF up%<>0
  889.             yOff% = 0
  890.         ELSE
  891.             yOff% = n2%-1
  892.         ENDIF
  893.     ENDIF
  894.     POKEB game%+3,yOff%
  895. ENDP
  896.  
  897. PROC suitOf%:(k%)
  898.     REM Get suit num from key
  899.     IF k%>%D
  900.         IF k%=%H
  901.             RETURN 3
  902.         ELSE
  903.             RETURN 0
  904.         ENDIF
  905.     ELSE
  906.         IF k%=%C
  907.             RETURN 2
  908.         ELSE
  909.             RETURN 1
  910.         ENDIF
  911.     ENDIF
  912. ENDP
  913.  
  914. PROC showGame:
  915.     REM Show the various bits
  916.     LOCAL cnt%
  917.     
  918.     gUPDATE OFF
  919.     cnt% = 0
  920.     IF PEEKB(game%+4)<>0
  921.         gAT 25*6,0
  922.         gFILL 90,2*9-1,1
  923.         DO
  924.             showSuit:(cnt%)
  925.             cnt% = cnt% + 1
  926.         UNTIL cnt%=4
  927.         POKEB game%+4,0
  928.     ENDIF
  929.     IF PEEKB(game%+5)<>0
  930.         gAT 0,2*9-1
  931.         gFILL 240,60+1,1
  932.         cnt% = 0
  933.         DO
  934.             showPile:(cnt%,0)
  935.             cnt% = cnt% + 1
  936.         UNTIL cnt% >= PEEKB(game%)+1
  937.         showHlt:
  938.         POKEB game%+5,0
  939.     ELSEIF PEEKB(game%+6)<>255
  940.         showPile:(PEEKB(game%+6),1)
  941.         IF PEEKB(game%+7)<>255
  942.             showPile:(PEEKB(game%+7),1)
  943.             POKEB game%+7,255
  944.             IF PEEKB(game%+2)=PEEKB(game%+7)
  945.                 showHlt:
  946.             ENDIF
  947.         ENDIF
  948.         IF PEEKB(game%+2)=PEEKB(game%+6)
  949.             showHlt:
  950.         ENDIF
  951.         POKEB game%+6,255
  952.     ENDIF
  953.     gUPDATE ON
  954. ENDP
  955.  
  956. PROC showHlt:
  957.     GLOBAL n2%,x%,y%,l%,hid%,s%,src%
  958.     GLOBAL from%
  959.     LOCAL y2%,p%
  960.  
  961.     p% = PEEKB(game%+2)
  962.     y2% = PEEKB(game%+3)
  963.     getP:(p%)
  964.     IF n2%=0
  965.         gAT 6*(x%-1)-1,9*(y%-1)-1
  966.         gGMODE 2
  967.         gBOX 13,9
  968.         gGMODE 0
  969.         RETURN
  970.     ENDIF
  971.     y% = y%+n2%-from%-y2%
  972.     gAT 6*(x%-1)-1,9*(y%-1)-1
  973.     gFILL 13,9,2
  974. ENDP
  975.  
  976. PROC showSuit:(n%)
  977.     IF 0 = PEEKB(game%+offSuit%+1+15*n%)
  978.         RETURN
  979.     ENDIF
  980.     putCard:(PEEKB(game%+offSuit%+2+15*n%),26+n%*4,1)
  981. ENDP
  982.  
  983. PROC getP:(n%)
  984.     IF n% > 0
  985.     x% = 38+4*(n%-PEEKB(game%))
  986.         y% = 3
  987.         l% = 6
  988.         hid% = PEEKB(game%+offHide%+1+(PEEKB(game%)+2)*(n%-1))
  989.         s% = game%+offPile%+15*(n%-1)
  990.         src% = PEEKB(game%+2)
  991.     ELSE
  992.         x% = 2
  993.         y% = 3
  994.         l% = 4
  995.         hid% = PEEKB(game%+offPack%+1)
  996.         s% = game%+offSrc%
  997.         src% = 1
  998.     ENDIF
  999.     n2% = PEEKB(s%+1)
  1000.     IF src%=n% AND PEEKB(game%+3)>=l%-1
  1001.         from% = n2%-PEEKB(game%+3)-2
  1002.         IF from%<0
  1003.             from%=0
  1004.         ENDIF
  1005.     ELSEIF n2%>l%
  1006.         from% = n2%-l%
  1007.     ELSE
  1008.         from% = 0
  1009.     ENDIF
  1010. ENDP
  1011.  
  1012. PROC showPile:(n%,clear%)
  1013.     GLOBAL n2%,x%,y%,l%,hid%,s%,src%
  1014.     GLOBAL from%
  1015.  
  1016.     getP:(n%)
  1017.     IF clear%<>0
  1018.         gAT 6*(x%-1)-1,2*9-1
  1019.         gFILL 13,63,1
  1020.     ENDIF
  1021.     AT x%,y%
  1022.     PRINT hid%
  1023.     IF 0 = n2%
  1024.         RETURN
  1025.     ENDIF
  1026.     IF from%<>0
  1027.         y% = y%+1
  1028.         putCard:(-1,x%,y%)
  1029.         from% = from%+1
  1030.         l% = l% - 1
  1031.     ENDIF
  1032.     DO
  1033.         y% = y%+1
  1034.         putCard:(PEEKB(s%+2+from%),x%,y%)
  1035.         from% = from%+1
  1036.         l% = l% - 1
  1037.     UNTIL (from%+1)>=n2% OR l%<=1
  1038.     y% = y%+1
  1039.     IF (from%+1)=n2%
  1040.         putCard:(PEEKB(s%+2+from%),x%,y%)
  1041.     ELSEIF from%<n2%
  1042.         putCard:(-1,x%,y%)
  1043.     ENDIF
  1044. ENDP
  1045.  
  1046. PROC putCard:(card%,x%,y%)
  1047.     LOCAL drSuit%,drNum%,drPict%
  1048.     LOCAL suit%,value%,name$(2),pict%
  1049.  
  1050.     drSuit% = PEEKB(game%+oDrSuit%)
  1051.     drNum%  = PEEKB(game%+ofdrNum%)
  1052.     drPict% = PEEKB(game%+oDrPict%)
  1053.     suit%=4
  1054.     value%=13
  1055.     IF (card% >= 52)
  1056.         name$ = "??"
  1057.         GIPRINT "Bad Card",1
  1058.         AT 1,1
  1059.         PRINT "<";card%;">";
  1060.     ELSEIF card%>=0
  1061.         suit% = INT(card% / 13)
  1062.         value% = card% - 13*suit%
  1063.         name$ = MID$("A23456789TJQK",value%+1,1)+MID$("SDCH",suit%+1,1)
  1064.     ELSEIF card%=-1
  1065.         AT x%,y%
  1066.         PRINT "--";
  1067.         RETURN
  1068.     ELSE
  1069.         name$ = "-?"
  1070.     ENDIF
  1071.     IF img%=0 OR value%<0 OR value%>12
  1072.         pict%=0
  1073.     ELSEIF value%>0 AND value%<9
  1074.         IF drNum%
  1075.             pict%=1
  1076.         ELSE
  1077.             pict%=0
  1078.         ENDIF
  1079.     ELSE
  1080.         IF drPict%
  1081.             pict%=1
  1082.         ELSE
  1083.             pict%=0
  1084.         ENDIF
  1085.     ENDIF
  1086.     IF img%<>0 AND value%=0 AND pict%=1 AND drSuit%=1
  1087.         gAT x%*6-3,(y%-1)*9
  1088.         gCOPY img%,5*suit%,0,5,7,0
  1089.         RETURN
  1090.     ENDIF
  1091.     IF pict%
  1092.         gAT (x%-1)*6,(y%-1)*9
  1093.         gCOPY img%,25+5*value%,0,5,7,0
  1094.     ELSE
  1095.         AT x%,y%
  1096.         PRINT MID$(name$,1,1);
  1097.     ENDIF
  1098.     IF img%<>0 AND drSuit%=1
  1099.         gAT x%*6,(y%-1)*9
  1100.         gCOPY img%,5*suit%,0,5,7,0
  1101.     ELSE
  1102.         AT x%+1,y%
  1103.         PRINT MID$(name$,2,1);
  1104.     ENDIF
  1105. ENDP
  1106.  
  1107.