rem Patience .......... Rev 2.2
      rem A J Tooth // May 2005
      
      rem Sleep periods incorporated
      
      rem Setup
      proc_setup
      
      rem Shuffle the deck
      proc_shuffle
      
      rem Set out the cards
      proc_setout
      
      Ex%=0
      repeat
        rem Mouse tracking
        M%=0 : proc_mowsetrac(M%)
        
        rem Move card
        if Ex%=0 then proc_movcard(M%)
        
      until (Ex%=1 or Ex%=2 or Ex%=3)
      
      if Ex%=2 then
        *FONT Verdana,16
        colour 3:print tab(10,10);"COMPLETE!!!!"
        *REFRESH
        a$=inkey$(200) : run
      endif
      
      if Ex%=3 then run else quit
      end
      rem End of Program ===================================================
      rem ==================================================================
      
      rem Setup fullscreen
      def  proc_fullscreen
      sys "GetSystemMetrics", 0 to xscreen%
      sys "GetSystemMetrics", 1 to yscreen%
      sys "SetWindowLong",@hwnd%,-16,&16000000
      sys "SetWindowPos",@hwnd%,-1,0,0,xscreen%,yscreen%,0
      vdu 23,22,xscreen%;yscreen%;8,16,16,1 : rem Set fullscreen mode
      off
      endproc
      rem ==================================================================
      
      rem Setup
      def proc_setup
      proc_fullscreen
      rem Colour 10 = Green Beize
      colour 10,0,70,0 : colour 138,0,70,0 : colour 138 : cls
      
      path$=@dir$+"Cards\"
      command$="CD "+chr$(34)+path$+chr$(34)
      oscli command$
      
      dim spot$(4), num$(13), shfl%(52), crds%(52), plc%(11)
      dim colm%(11,52,4), gen$(4)
      
      gen$()="genc","gend","genh","gens"
      spot$()="c","d","h","s"
      num$()="a","2","3","4","5","6","7","8","9","t","j","q","k"
      *REFRESH OFF
      endproc
      rem ==================================================================
      
      rem Shuffle the deck
      def proc_shuffle
      local c%, cnt%, pt%, pick%
      
      crds%()=0 : rem Gets set to a 1 if a card is chosen already
      for c%=1 to 52
        if c%<52 then pick%=rnd(53-c%) else pick%=1
        cnt%=0 : pt%=0
        repeat
          pt%+=1
          if crds%(pt%)=0 then cnt%+=1
        until cnt%=pick%
        crds%(pt%)=1 : shfl%(c%)=pt%
      next c%
      endproc
      rem ==================================================================
      
      rem Set out the cards
      def proc_setout
      local pt%, lm%, i%, xpos%, ypos%, j%
      
      plc%()=0  : rem Initialise record of each column occupancy
      colm%()=0 : rem Initialise the columns
      pt%=1     : rem Initialise the pointer
      
      rem Assign the cards sequentially to a column
      for lm%=8 to 2 step -1
        for i%=1 to lm%
          colm%(lm%-1,i%,2)=shfl%(pt%)
          plc%(lm%-1)+=1
          if i%<lm% then
            colm%(lm%-1,i%,1)=1 : rem Face down
          else
            colm%(lm%-1,i%,1)=2 : rem Face up
          endif
          if lm%>1 then
            if colm%(lm%-1,i%,1)=2 then
              pick%=colm%(lm%-1,i%,2) - 1
              spot%=(pick% div 13)
              num%=(pick% mod 13)
              bmpfile$=num$(num%)+spot$(spot%)+".bmp"
            else
              bmpfile$="back.bmp"
            endif
            rem Predefined initial positions on screen
            xpos%=200+250*(8-lm%) : ypos%=1000-50*i%
            oscli "DISPLAY "+bmpfile$+" "+str$(xpos%)+","+str$(ypos%)
            rem Save the position of the card on the screen
            colm%(lm%-1,i%,3)=xpos% : colm%(lm%-1,i%,4)=ypos%
          endif
          pt%+=1
        next i%
      next lm%
      
      rem Takes care of the 17 cards left over, shown along the top
      for i%=1 to 17
        colm%(0,i%,2)=shfl%(pt%)
        rem Regarded as being in column 0
        plc%(0)+=1
        if i%<17 then
          colm%(0,i%,1)=1
        else
          colm%(0,i%,1)=2
        endif
        
        if colm%(0,i%,1)=2 or colm%(0,i%,1)=1 then
          pick%=colm%(0,i%,2) - 1
          spot%=(pick% div 13)
          num%=(pick% mod 13)
          bmpfile$=num$(num%)+spot$(spot%)+".bmp"
        else
          bmpfile$="back.bmp"
        endif
        xpos%=200+50*i% : ypos%=1300
        oscli "DISPLAY "+bmpfile$+" "+str$(xpos%)+","+str$(ypos%)
        rem Save the position of the card on the screen
        colm%(0,i%,3)=xpos% : colm%(0,i%,4)=ypos%
        pt%+=1
      next i%
      
      rem Initialise the final stacks
      for j%=0 to 3
        xpos%=1400+150*j% : ypos%=1300
        colm%(8+j%,1,3)=xpos% : colm%(8+j%,1,4)=ypos%
        plc%(8+j%)=0
        bmpfile$=gen$(j%)+".bmp"
        oscli "DISPLAY "+bmpfile$+" "+str$(xpos%)+","+str$(ypos%)
      next j%
      
      rem Prints a coloured button to the screen
      proc_box(3,10,1300,150,"EXIT",50,0,0)
      proc_box(3,10,1100,150,"PLAY",0,0,50)
      rem Display my Icon in compiled version
      proc_AJTicon(10,700)
      
      *REFRESH
      endproc
      rem ==================================================================
      
      rem Reset the picture, omitting the selected card
      rem and any others below it in a column
      def proc_reset(cr%,cp%)
      local lm%, i%, pick%, spot%, num%, j%
      
      for lm%=8 to 2 step -1
        if plc%(lm%-1)>0 then
          for i%=1 to plc%(lm%-1)
            if (lm%>1 and not(cr%=lm%-1 and cp%<=i%)) then
              if colm%(lm%-1,i%,1)=2 then
                pick%=colm%(lm%-1,i%,2) - 1
                spot%=(pick% div 13)
                num%=(pick% mod 13)
                bmpfile$=num$(num%)+spot$(spot%)+".bmp"
              else
                bmpfile$="back.bmp"
              endif
              xpos%=colm%(lm%-1,i%,3) : ypos%=colm%(lm%-1,i%,4)
              oscli "DISPLAY "+bmpfile$+" "+str$(xpos%)+","+str$(ypos%)
            endif
          next i%
        endif
      next lm%
      
      rem plc%(0) retains the number of cards remaining along the top
      if plc%(0)>0 then
        for i%=1 to plc%(0)
          if not(cr%=0 and cp%=i%) then
            rem Cards along the top are all displayed face up
            rem even if "officially" face down
            rem Only the last in line is "offcially" face up, and therefore selectable
            if colm%(0,i%,1)=2 or colm%(0,i%,1)=1 then
              pick%=colm%(0,i%,2) - 1
              spot%=(pick% div 13)
              num%=(pick% mod 13)
              bmpfile$=num$(num%)+spot$(spot%)+".bmp"
            else
              bmpfile$="back.bmp"
            endif
            xpos%=colm%(0,i%,3) : ypos%=colm%(0,i%,4)
            oscli "DISPLAY "+bmpfile$+" "+str$(xpos%)+","+str$(ypos%)
          endif
        next i%
      endif
      
      rem Display stacked cards, if any yet
      for j%=0 to 3
        xpos%=colm%(8+j%,1,3) : ypos%=1300
        if plc%(8+j%)>0 then
          pick%=colm%(8+j%,plc%(8+j%),2) - 1
          spot%=(pick% div 13)
          num%=(pick% mod 13)
          bmpfile$=num$(num%)+spot$(spot%)+".bmp"
        else
          bmpfile$=gen$(j%)+".bmp"
        endif
        oscli "DISPLAY "+bmpfile$+" "+str$(xpos%)+","+str$(ypos%)
      next j%
      
      rem Prints a coloured button to the screen
      proc_box(3,10,1300,150,"EXIT",50,0,0)
      proc_box(3,10,1100,150,"PLAY",0,0,50)
      rem Display my Icon in compiled version
      proc_AJTicon(10,700)
      
      endproc
      rem ==================================================================
      
      rem Mouse tracking
      def proc_mowsetrac(return m%)
      local x%,y%,t%,s%,xpos%,ypos%,p%
      
      rem Ensures mouse button debounce is taken care of
      repeat
        mouse x%,y%,p%
      until p%=0
      
      rem On exit (curcol%, curplc%) defines the card selected for movement
      rem which then moves with the mouse
      repeat
        sys "Sleep",10
        mouse x%,y%,m%
        Flg%=0
        for t%=0 to 7
          if plc%(t%)>0 then
            for s%=1 to plc%(t%)
              if colm%(t%,s%,1)=2 then
                xpos%=colm%(t%,s%,3) : ypos%=colm%(t%,s%,4)
                if (x%>=xpos% and x%<xpos%+146 and y%>=ypos% and y%<ypos%+194) then
                  Flg%=1
                  curcol%=t% : curplc%=s% : xff%=x%-xpos% : yff%=y%-ypos%
                endif
              endif
            next s%
          endif
        next t%
        
        rem Check whether the mouse is in the control boxes
        if (x%>10 and x%<160 and y%>1300 and y%<1450) then Flg%=2
        if (x%>10 and x%<160 and y%>1100 and y%<1250) then Flg%=3
        
        case Flg% of
          when 1: mouse on 137
          when 0:
            mouse on 136
            curcol%=-1 : curplc%=-1
          when 2,3: mouse on 137
        endcase
      until (m%=4 or m%=1)
      
      rem Exit control
      case Flg% of
        when 2:
          Ex%=1
          proc_box(5,10,1300,150,"EXIT",50,0,0)
          *REFRESH
          a$=inkey$(50)
        when 3:
          Ex%=3
          proc_box(5,10,1100,150,"PLAY",0,0,50)
          *REFRESH
          a$=inkey$(50)
        otherwise
          rem Do nothing
      endcase
      endproc
      rem ==================================================================
      
      rem Move card
      def proc_movcard(return m%)
      local x%,y%,n%,dum%,pick%,spot%,num%,j%
      local pickg%,spotg,numg%,chk%
      
      n%=m% : m%=0
      if Flg%=1 then
        if n%=4 then
          repeat
            cls:proc_reset(curcol%,curplc%)
            sys "Sleep",10
            mouse x%,y%,m%
            rem Identify and keep the details for the selected card
            pickf%=colm%(curcol%,curplc%,2) - 1
            spotf%=(pickf% div 13)
            numf%=(pickf% mod 13)
            
            rem Cater for all cards in the column below the selected one
            for j%=curplc% to plc%(curcol%)
              xtpos%=x% - xff% : ytpos%=y% - yff% - 50*(j%-curplc%)
              pick%=colm%(curcol%,j%,2) - 1
              spot%=(pick% div 13)
              num%=(pick% mod 13)
              bmpfile$=num$(num%)+spot$(spot%)+".bmp"
              oscli "DISPLAY "+bmpfile$+" "+str$(xtpos%)+","+str$(ytpos%)
            next j%
            
            *REFRESH
          until m%=1 or m%=2
        endif
        
        rem Rotate the top line of cards
        if (n%=1 and curcol%=0) then
          dum%=colm%(0,plc%(0),2)
          for i%=plc%(0) to 2 step -1
            colm%(0,i%,2)=colm%(0,i%-1,2)
          next i%
          colm%(0,1,2)=dum%
          cls:proc_reset(-1,-1)
          *REFRESH
        endif
        
        rem Transfer a card to the stack, if acceptable
        if (n%=1 and curcol%>0 and curcol%<8 and curplc%=plc%(curcol%)) then
          rem Identify and keep the details for the selected card
          pickg%=colm%(curcol%,curplc%,2) - 1
          spotg%=(pickg% div 13)
          numg%=(pickg% mod 13)
          
          chk%=plc%(8+spotg%)
          if numg%=chk% then
            rem Adjust length of columns accordingly
            plc%(curcol%)-=1 : plc%(8+spotg%)+=1
            
            old%=curplc%
            new%=plc%(8+spotg%)
            rem Transfer card details to new column place
            colm%(8+spotg%,new%,2)=colm%(curcol%,old%,2)
            colm%(8+spotg%,new%,1)=1
            rem Delete card details from old position
            colm%(curcol%,old%,2)=0 : colm%(curcol%,old%,1)=0
            
            rem Reposition the card at its new place in the new column
            xpos%=colm%(8+spotg%,1,3) : ypos%=colm%(8+spotg%,1,4)
            colm%(8+spotg%,new%,3)=xpos% : colm%(8+spotg%,new%,4)=ypos%
            
            rem Permit access to the next card up (if any) in the old column
            rem and turn it face up
            if plc%(curcol%)>0 then colm%(curcol%,plc%(curcol%),1)=2
          endif
          nd%=0
          for y%=0 to 3
            nd%+=plc%(8+y%)
          next y%
          if nd%=52 then Ex%=2
        endif
        
        if m%=1 then
          rem Test whether the card is in an acceptable position for replacement
          proc_postst
        endif
        cls:proc_reset(-1,-1)
      endif
      *REFRESH
      Flg%=0
      endif
      endproc
      rem ==================================================================
      
      rem Test whether the card is in an acceptable position for replacement
      def proc_postst
      local t%,s%,xtpos%,ytpos%,pickt%,spott%,numt%
      local tstbr%,tstrb%,dd%,Flgt%,j%,old%,new%
      
      Flgt%=0 : t%=0
      repeat
      if plc%(t%)>0 then
        s%=0
        repeat
          s%+=1
          if colm%(t%,s%,1)=2 then
            xtpos%=colm%(t%,s%,3) : ytpos%=colm%(t%,s%,4)
            if (x%>=xtpos% and x%<xtpos%+146 and y%>=ytpos% and y%<ytpos%+194) then
              curcolt%=t% : curplct%=s%
              pickt%=colm%(curcolt%,curplct%,2) - 1
              spott%=(pickt% div 13)
              numt%=(pickt% mod 13)
              rem Check that the new position would be red-on-black or vice-versa
              tstbr%=(spotf%=0 or spotf%=3) and (spott%=1 or spott%=2)
              tstrb%=(spotf%=1 or spotf%=2) and (spott%=0 or spott%=3)
              if tstbr% or tstrb% then
                rem If so, check that the card would be in sequence at the new position
                if (numf%=numt%-1 and curcolt%<>curcol%) then Flgt%=1
              endif
            endif
          endif
        until (s%=plc%(t%) or Flgt%=1)
      else
        xtpos%=colm%(t%,1,3) : ytpos%=colm%(t%,1,4)
        if (x%>=xtpos% and x%<xtpos%+146 and y%>=ytpos% and y%<ytpos%+194) then
          if numf%=12 then Flgt%=1 : curcolt%=t% : curplct%=0
        endif
      endif
      t%+=1
      until (t%>7 or Flgt%=1)
      
      if Flgt%=1 then
      rem Identify number of cards to transfer to the new column
      dd%=1 + plc%(curcol%) - curplc%
      rem Adjust length of columns accordingly
      plc%(curcol%)-=dd% : plc%(curcolt%)+=dd%
      for j%=0 to dd%-1
        old%=curplc%+j%
        new%=curplct%+j%+1
        rem Transfer card details to new column place
        colm%(curcolt%,new%,2)=colm%(curcol%,old%,2)
        colm%(curcolt%,new%,1)=2
        rem Delete card details from old position
        colm%(curcol%,old%,2)=0 : colm%(curcol%,old%,1)=0
        rem Reposition the card at its new place in the new column
        xpos%=xtpos%
        if curplct%>0 then ypos%=ytpos% - 50*(j%+1) else ypos%=ytpos% - 50*j%
        colm%(curcolt%,new%,3)=xpos% : colm%(curcolt%,new%,4)=ypos%
      next j%
      rem Permit access to the next card up (if any) in the old column
      rem and turn it face up
      if plc%(curcol%)>0 then colm%(curcol%,plc%(curcol%),1)=2
      endif
      endproc
      rem ==================================================================
      
      rem Prints a coloured button to the screen
      def proc_box(Mul%,Xpos%,Ypos%,Ws%,Msg$,re%,gr%,bl%)
      local h%
      vdu 5
      for h%=0 to 30
      colour 8,Mul%*h%*re%/30,Mul%*h%*gr%/30,Mul%*h%*bl%/30
      gcol 8 : rectangle fill (Xpos%+2*h%),(Ypos%+2*h%),(Ws%-4*h%),(150-4*h%)
      next h%
      gcol 3 : move (Xpos%+45),(Ypos%+90) : print;Msg$;
      vdu 4
      endproc
      rem ========================================================================
      
      rem Displays my Icon in .exe version
      def proc_AJTicon(i%,j%)
      sys "GetModuleHandle", 0 to hm%
      sys "LoadImage", hm%, "BBCWrun", 1, 32, 32, 0 to hicon%
      w% = 32
      h% = 32
      sys "DrawIconEx", @memhdc%, i%, j%, hicon%, w%, h%, 0, 0, 3
      sys "InvalidateRect", @hwnd%, 0, 0
      endproc
      rem ========================================================================