Monday, July 28, 2014

RC Craps for Atari 800/X-Forth

To recap - for this year's summer Retrochallenge, I want to write 9 games - 3 each on 3 different platform/language combinations. Two of the nine are complete! And with a recent time extension granted by our illustrious organizer, I might just get all 9 done.

This blog post documents Craps on the Atari 800, using the X-Forth language.

X-Forth is a derivative of figForth, but intends to be more compatible with the ANSI Forth standard. However, it's not completely ANSI-compatible yet. This means it can take some digging and trial and error to figure out which Forth words are implemented, and whether their behavior is figForth or ANSI. While there is no manual, there are a couple of sample programs that helped me riddle this all out.

I'd like to go more into details on some of the things I learned, but while I go write the deep-dive, here's a video demo of the program, and the source code. Note that neither are incredibly impressive. There is no color, sound or graphics - weird for a game on the Atari. Right now, it's all text. However, when you look at how a Forth program is unpacked - words within words, culminating in atomic definitions - it won't be hard to modify the program in a modular fashion to get some more exciting UI implemented.

Here's the video:


And here's the source code:

( RC-CRAPS for Atari 800/X-Forth )
( Version 0.1 )
( Licensed under Creative Commons )
( BY-NC-SA 3.0 )
( By Earl Evans )
( www.retrobits.com )
( for Retrochallenge SC 2014! )

( TO-DO: )
( Add graphics and sound! )
( Find better psuedo-random )
( number generator. )
( Make input routines more )
( bulletproof, perhaps with )
( assembly-language words. )

125 EMIT ( Clear screen )

CR
." RC-CRAPS for Atari 800/X-Forth." CR
." Version 0.1"
." Licensed under Creative Commons" CR
." creativecommons.org/licenses/" CR
."      by-nc-sa/3.0/" CR CR
." RANDOM word courtesy of" CR
." James M. Reneau, Ph.D. via Creative" CR
." Commons at:" CR
." www.renejm.net/" CR
."      6502FIGForthHandyRandom" CR

CR
." Initializing variables"

1000 VARIABLE BANKROLL
0 VARIABLE BET
21 CONSTANT NAME-LEN
-1 VARIABLE PLAYER NAME-LEN ALLOT
PLAYER NAME-LEN 32 FILL
0 VARIABLE POINT
0 VARIABLE SEEDHIGH
0 VARIABLE SEEDLOW
0 VARIABLE RANDOMSEED
0 VARIABLE RANDOMKICK

CR
." Loading Utility Functions"

: WAITKEY ( -- )
    ( Waits for a keypress )
    KEY DROP ;

: CLS ( -- )
    ( Clears the Atari screen )
    125 EMIT ;

: PRINT ( addr -- )
    ( Prints chars starting at )
    ( addr until reaches null )
    ( Better than TYPE, which )
    ( outputs the nulls and )
    ( other junk in the string )
    ( area. )
    BEGIN DUP C@ 0= IF
        DROP 1
    ELSE
        DUP C@ EMIT 1 + 0 THEN
    UNTIL
    ;

: POKEY-RND ( -- n )
    ( Gets a psuedo random value )
    ( from the Atari 800 POKEY )
    ( chip, leaves on stack. )
    53770 C@
    ;

CR
." Loading RANDOM"

: RANDOM ( M -- N )
  ( RETURN A RANDOM INTEGER FROM 0 TO M-1 )
  ( NOT VERY GOOD AND WILL CYCLE FOR VALUES )
  (   - WORKS OK WITH 100, AND 10)
  ( BY JAMES RENEAU - 2012-05-12 )
  (   - LICENSED UNDER CREATIVE COMMONS A-NC-SA )
  RANDOMSEED @
  67 * 103 + ABS 16383 MOD
  DUP RANDOMSEED !
  RANDOMKICK @
  101 + ABS 16383 MOD
  DUP RANDOMKICK !
  + SWAP MOD
;

CR
." Loading ASK-NAME"

: ASK-NAME ( -- )
    ( Asks for player name, places in PLAYER )
    CR ." Please enter your name: "
    PLAYER NAME-LEN EXPECT
    ;

CR
." Loading ASK-YN"

: ASK-YN ( -- n )
    ( Asks yes or no, if y or Y leaves 1 on
    ( the stack, 0 otherwise )
    KEY DUP 89 = SWAP 121 = OR IF 1 ELSE 0 THEN
    ;

CR
." Loading ASK-BET"

: ASK-BET ( -- n )
    ( Asks for a bet amount 1 - 50, leaves )
    ( on stack )
    CR ." Enter bet: "
    QUERY BL WORD HERE NUMBER DROP SWAP DROP
    BET !
    ;

CR
." Loading GET-RN"

: GET-RN ( -- n )
    ( Leaves random number 1 to 6 on stack )
    6 RANDOM 1 +
    ;

CR
." Loading SHOW-HELP"

: SHOW-HELP ( -- )
    ( Displays help for playing the game )
    CLS
    ." Make a bet $1-$50." CR
    ." Throw the first roll." CR
    ." 7 or 11 wins. 2 or 3 loses." CR
    ." 12 pushes." CR CR
    ." Any other roll becomes your 'point'." CR
    ." Roll until you get your point (win)" CR
    ." or get a 7 (lose)." CR CR
    ." Press any key to continue..."
    WAITKEY
    CLS
    ;

CR
." Loading INTRO"

: INTRO ( -- )
    ( Provides an intro to the game )
    CLS CR
    ." Welcome to RC-CRAPS version 0.1!" CR
    ." Would you like instructions (Y/N)? "
    ASK-YN IF SHOW-HELP THEN
    ;

CR
." Loading ROLL"

: ROLL ( -- n )
    ( One roll of the dice, leaves )
    ( dice total on stack )
    CR
    ." Press any key to roll dice..."
    WAITKEY
    GET-RN GET-RN
    CR ." You rolled " DUP . ." + " SWAP DUP . ." = " + DUP .
    POINT @ DUP 0= IF
        DROP
    ELSE
        CR ." You are trying for a " .
    THEN
    ;

CR
." Loading CHECK-WIN"

: CHECK-WIN ( n -- n )
    ( Expects total of latest roll )
    ( on the stack. Leaves a code )
    ( on the stack of 0=roll again, )
    ( 1=win, 2=loss, 3=tie. )
    POINT @ 0= IF ( First roll )
        DUP 7 = SWAP DUP 11 = ROT OR IF ( win )
            DROP 1
        ELSE DUP 2 = SWAP DUP 3 = ROT OR IF ( loss )
            DROP 2
        ELSE DUP 12 = IF ( tie )
            DROP 3
        ELSE POINT ! 0 THEN THEN THEN ( roll again )
    ELSE ( not the first roll )
        DUP POINT @ = IF ( win )
            DROP 1
        ELSE DUP 7 = IF ( loss )
            DROP 2
        ELSE DROP 0 THEN THEN ( roll again )
    THEN
    ;
          

CR
." Loading PLAY-ROUND"

: PLAY-ROUND ( -- n )
    ( Plays a round of the game )
    ( Leaves 1 on the stack for )
    ( another round, or 0 on the )
    ( stack to quit. )
    ASK-BET
    0 POINT ! ( Set initial "point" to zero )
    BEGIN
        ROLL CHECK-WIN
        DUP 0= IF
        CR ." Roll again!"
        ELSE DUP 1 = IF
            CR ." You win!"
            BANKROLL @ BET @ + BANKROLL !
        ELSE DUP 2 = IF
            CR ." You lose!"
            BANKROLL @ BET @ - BANKROLL !
        ELSE DUP 3 = IF
            CR ." Boxcars - no win or loss!"
        THEN THEN THEN THEN
    UNTIL
    CR ." Your bankroll is: $" BANKROLL @ .
    CR ." Play again (Y/N)? "
    ASK-YN 0= IF 1 ELSE 0 THEN
    ;

CR
." Loading PLAY-GAME"

: PLAY-GAME ( -- )
    ( Plays the entire game, exits )
    ( to OK when done )
    POKEY-RND SEEDHIGH !
    INTRO
    POKEY-RND SEEDLOW !
    ASK-NAME
    POKEY-RND RANDOMKICK ! SEEDHIGH @ SEEDLOW @ * RANDOMSEED !
    BEGIN PLAY-ROUND UNTIL
    CR ." Thanks, " PLAYER PRINT
    CR ." for playing RC-CRAPS!"
    CR ." Your final bankroll was: $" BANKROLL @ . CR CR
    ;

  CR
." RC-CRAPS load complete!" CR
." Type PLAY-GAME [return] to play." CR
CR

 

No comments: