This program is by Paul Dale and is used here by permission.
This program is supplied without representation or warranty of any kind. Paul Dale and The Museum of HP Calculators therefore assume no responsibility and shall have no liability, consequential or otherwise, of any kind arising from the use of this program material or any part thereof.
To initialise the deck GSB A.
To draw a card from the deck GSB B. Repeat this step as many times as desired.
Once all cards are drawn the display will show -1, successive GSB B executions just decrement this value further negative. Press GSB A again to reshuffle.
Cards are displayed in the form nn.s where:
001-42,21,11 f LBL A Initialization entry 002- 5 5 Cards are 0 through 51 = 52 in total 003- 1 1 004-42,23,24 f DIM (i) Make sure there are enough registers 005- 42 34 f CLEAR REG 006-42, 7, 1 f FIX 1 Set the display for later 007- 44 25 STO I 008-42,21, 0 f LBL 0 Loop over all the cards storing their 009- 45 25 RCL I values in the registers 010- 44 24 STO (i) 011-42, 5,25 f DSE I 012- 22 0 GTO 0 013- 5 5 Initialize I for drawing from the deck 014- 2 2 015- 44 25 STO I 016- 43 35 g CLx Clean up and return 017- 43 32 g RTN 018-42,21,12 f LBL B Draw a card entry 019- 1 1 020-44,30,25 STO- I Reduce the number of cards by one 021- 45 25 RCL I 022-43,30, 2 g TEST 2 x<0? Check if all cards have been drawn 023- 43 32 g RTN 024- 45 24 RCL (i) Grab the top card in highest register 025- 34 x⇔y 026- 42 36 f RAN# Pick a random card to display 027- 20 × 028- 1 1 029- 40 + 030- 43 44 g INT 031-42, 4,25 f x⇔ I Index the random card 032- 34 x⇔y 033-42, 4,24 f x⇔ (i) Swap highest card with random card 034- 34 x⇔y 035-42, 4,25 f x⇔ I Restore the index/counter register 036- 34 x⇔y Get card value and convert for display 037- 1 1 Start with the value component 038- 3 3 039- 10 ÷ 040- 36 ENTER 041- 42 44 f FRAC 042- 1 1 043- 3 3 044- 20 × 045- 43 34 g RND 046- 1 1 047- 40 + 048- 34 x⇔y Now work out the suit 049- 43 44 g INT 050- 1 1 051- 40 + 052- 1 1 053- 0 0 054- 10 ÷ 055- 40 + Combine value and suit and return 056- 43 32 g RTN