home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / armforth / !ARMforth / Examples / Breakout / Hightable < prev    next >
Encoding:
Text File  |  1991-04-06  |  2.5 KB  |  129 lines
  1. 15 CONSTANT MAXNAME
  2. 5 CONSTANT NUMNAMES
  3.  
  4. MAXNAME STRING NEWHIGH
  5. NUMNAMES ARRAY HIGHSCORES
  6.  
  7. NUMNAMES MAXNAME STRING[] HIGHTABLE
  8.  
  9. : STORENAME ( POS / STRADDR )
  10.    >R HIGHTABLE R> STRCPY
  11.    ;
  12.  
  13. : INITHIGHTABLE
  14.    NUMNAMES 0 DO
  15.       I HIGHTABLE STRCPY" ROB TURNER"
  16.       300 I HIGHSCORES !
  17.    LOOP
  18.    ;
  19.  
  20. : PRINTHIGHTABLE.OLD
  21.    CR CR CR CR
  22.    2 COLOUR1
  23.    14 SPACES ." HIGH SCORES" CR CR
  24.    3 COLOUR1
  25.    NUMNAMES 0 DO
  26.       10 SPACES
  27.       I HIGHTABLE DUP .STR
  28.       MAXNAME 1+ SWAP STRLEN - SPACES
  29.       I HIGHSCORES ? CR
  30.    LOOP
  31.    ;
  32.  
  33. : PRINTHIGHTABLE
  34.    3 COLOUR1
  35.    NUMNAMES 0 DO
  36.       30 I 20 + TAB2 DROP ( TAB2 LEAVES 30 STACKED! )
  37.       I HIGHTABLE DUP .STR
  38.       MAXNAME 1+ SWAP STRLEN - SPACES
  39.       I HIGHSCORES ?
  40.    LOOP
  41.    ;
  42.  
  43. : HIGHTABLEPOS ( SCORE -> POS )
  44.    0 ( A FLAG ) NUMNAMES 0 DO
  45.       DROP
  46.       DUP I HIGHSCORES @ > IF
  47.          DROP I 1 LEAVE
  48.       ELSE
  49.          0
  50.       THEN
  51.    LOOP
  52.    IF ( HIGHER SCORE )
  53.    ELSE
  54.       DROP -1
  55.    THEN
  56.    ;
  57.  
  58. : INSERTNAME ( POS / NAME STRING )
  59.    SWAP DUP ( NAME / POS / POS )
  60.    NUMNAMES 1- <> IF ( NAME / POS )
  61.       DUP ( NAME / POS / POS )
  62.       NUMNAMES 1- DUP ROT
  63.       ( NAME / POS / END / END / START ) DO
  64.          ( NAME / POS / END )
  65.          2DUP 1- I - +
  66.          ( NAME / POS / END / END-I+POS )
  67.          DUP
  68.          1+ HIGHTABLE SWAP HIGHTABLE STRCPY
  69.       LOOP DROP
  70.    ELSE
  71.    THEN
  72.    HIGHTABLE SWAP STRCPY ( INSERT NEW NAME )
  73.    ;
  74.  
  75. : INSERTSCORE ( SCORE / POS )
  76.    DUP ( SCORE / POS / POS )
  77.    NUMNAMES 1- <> IF ( SCORE / POS )
  78.       DUP ( SCORE / POS / POS )
  79.       NUMNAMES 1- DUP ROT
  80.       ( SCORE / POS / END / END / START ) DO
  81.          ( SCORE / POS / END )
  82.          2DUP 1- I - +
  83.          ( SCORE / POS / END / END-I+POS )
  84.          DUP
  85.          HIGHSCORES @ SWAP 1+ HIGHSCORES !
  86.       LOOP DROP
  87.    ELSE
  88.    THEN
  89.    HIGHSCORES ! ( INSERT NEW SCORE )
  90.    ;
  91.  
  92. : READSTRING ( ADDR OF STRING CHARS / MAXLEN )
  93.    >R DUP R> EXPECT DUP
  94.    0 ( ST ADDR / ST ADDR / LENGTH COUNT )
  95.    BEGIN
  96.       SWAP DUP ( ST ADDR / CNT / C ADDR / C ADDR )
  97.       C@ 0= IF ( ST ADDR / CNT / C ADDR )
  98.          DROP
  99.          SWAP 4 - ! EXIT
  100.       ELSE
  101.          1+ SWAP 1+ ( ST ADDR / C ADDR+1 / CNT+1 )
  102.       THEN
  103.    AGAIN
  104.    ;
  105.  
  106. : GETNAME ( STRING )
  107.    4 COLOUR1
  108.    CR CR 13 SPACES ." HIGH SCORE!" CR CR CR
  109.    5 COLOUR1
  110.    6 SPACES ." Enter Your Name: "
  111.    6 COLOUR1
  112.    4 + MAXNAME 2 - READSTRING
  113.    ;
  114.  
  115. : UPDATEHIGHTABLE ( SCORE )
  116.    DUP
  117.    HIGHTABLEPOS ( SCORE / POS )
  118.    DUP 0< IF ( SCORE / POS )
  119.       2DROP EXIT
  120.    ELSE
  121.       DUP ( SCORE / POS / POS )
  122.       NEWHIGH GETNAME
  123.       NEWHIGH INSERTNAME
  124.       INSERTSCORE
  125.    THEN
  126.    ;
  127.  
  128. INITHIGHTABLE
  129.