home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 1B / DATAFILE_PDCD1B.iso / _pocketbk / pocketbook / 003 / solo_zip / opl / solo.opl next >
Text File  |  1993-01-05  |  20KB  |  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% = offS