[FORTH] Shaco Calculator

( CALC I MADE LONG TIME AGO WHICH CALCULATES DIFFERENT ITEM BUILDS FOR SHACO )
( SUPER OUT OF DATE, WAS FOR OLD SHACO. )
( ENTER ITEM NAMES AT THE COMMAND LINE. )
( FOR USE IN GFORTH. )

: TEXT PAD 258 BL FILL WORD COUNT PAD SWAP MOVE ;
CREATE STRUSPELLS 18 CHARS ALLOT
CREATE STRSPELLS  4 CHARS ALLOT

VARIABLE   .BONUSAD
VARIABLE   .ENEMYARMOR
VARIABLE   .LETHALITY
VARIABLE   .LEVEL
VARIABLE   .BONUSAD
VARIABLE   .CRIT
VARIABLE   .QLVL
VARIABLE   .WLVL
VARIABLE   .ELVL
VARIABLE   .RLVL
VARIABLE   .TOTALAD
VARIABLE   .STR
VARIABLE   .MAXHP
VARIABLE   .BASEAD

FVARIABLE  FLETHALITY
FVARIABLE  FPEN
FVARIABLE  FCRIT
FVARIABLE  FTIAMAT
FVARIABLE  FCRITMULT
FVARIABLE  FCURRENTHP

80 CONSTANT ,IE
25 CONSTANT ,TIAMAT
60 CONSTANT ,YOUMUU
55 CONSTANT ,DUSK

( ABSTRACTION )
: F+!   ( ADDR F2 -- )               ( FLOAT ADD-BANG, ADDS THEN BINDS )
           DUP F@ F+ F! ;
: CONF  ( ADDR  -- F )               ( GETS INT VALUE AT ADDR, CONVERTS TO FLOAT )
           @ S>F  ;
: ASK                                ( ACCEPTS TXT, PLACES TO TIB TO BE PLACED LATER )
           TIB 40 ACCEPT #TIB ! 0 >IN ! 1 TEXT ;
: RNDNUM                             ( PSEUDO RNG BASED ON TIME, PROBABLY BAD )
           UTIME DROP  ;
: RND1     RNDNUM RNDNUM RNDNUM * * 20 UM* NIP ;
: RND2     RNDNUM RND1 MS RNDNUM RND1 MS RNDNUM RND1 MS * * 100 UM* NIP ;
( ITEMS )
: LETH     .LEVEL @  S>F 0.4E F* 18E F/ 0.6E F+ .LETHALITY CONF F* FPEN F! CR ." ARMOR PEN IS: " FPEN F@ F. ;
: IE       CR ,IE     .BONUSAD +! ." IE DETECTED... " 0.25E FCRIT F+! 0.25E FCRITMULT F+! ;
: TIAMAT   CR ,TIAMAT .BONUSAD +! ." TIAMAT DETECTED... " .BONUSAD CONF 0.80E F* FTIAMAT F+!  ;
: YOUMUU   CR ,YOUMUU .BONUSAD +! ." YOUMUU DETECTED... " 18 .LETHALITY +! ;
: DUSKBLADE  CR ,DUSK .BONUSAD +!  ." DUSKBLADE DETECTED... " 21 .LETHALITY +! ;
( COMBAT MATHS )
: ARMR     CR ." ENTER ENEMY ARMOR: " ASK 0. PAD 3 >NUMBER 2DROP DROP .ENEMYARMOR ! ;
: CHKLV    DUP DUP 18 > SWAP 1 < OR IF DROP ." WHAT? INVALID LVL, TRY AGAIN. " 0  ELSE .LEVEL ! 1 THEN ;
: LVL RECURSIVE      CR ." ENTER YOUR LEVEL: " ASK 0. PAD 2 >NUMBER 2DROP DROP  CHKLV 0 = IF LVL THEN ;
: RED      100E 100E .ENEMYARMOR CONF FPEN F@ F- F+ F/  ;
: CRIT     ( -- CRIT MULTI ) 100E FCRIT F@  F* F>S 1 - .CRIT !   2 1 DO  RND2 .CRIT @ < IF   2E FCRITMULT F@ F+
                                                                                        ELSE 1E   THEN   LOOP ." CRIT " ;
: DUSKDMG  22.941E .LEVEL CONF 7.059E F* F+ ;
: QDMG     10 .QLVL @ * S>F .BONUSAD CONF 0.40E F* F+ ;
: EDMG     .BONUSAD @ 55 25 .ELVL @ DUP S>F * + SWAP S>F 0.6E 0.15E FROT F* F+ F* S>F F+    ( SPONGE )
           1E  FCURRENTHP F@  .MAXHP S>F F/   F-  0.5E F*  FSWAP FDUP FOVER  F* F+   F*   ;
: ENEMYHP  571 86 .LEVEL @ 1 - * + DUP .MAXHP ! S>F FCURRENTHP F! ;
(         LEVEL STUFF         )
: USPELLS  STRUSPELLS CHARS + C@ ; ( N -- CHAR# ) ( FINDS CHARACTER # AT N'TH POSITION )
: DEFCHECK 0 USPELLS DUP DUP  68 = SWAP 100 =  OR IF CR CR ." DEFAULT BUILD  "
                     S" WQEQQRQEQEREEWWRWW" STRUSPELLS PLACE DROP DROP DROP .LEVEL @ 1 + 1 THEN ;
: INITLVL RECURSIVE CR CR ." ENTER YOUR SKILL ORDER, OR TYPE 'DEFAULT' FOR A STANDARD ORDER: "
                     ASK PAD .STR 18 MOVE
                     S" QWER" STRSPELLS PLACE   .LEVEL @ 0
                    .STR COUNT STRUSPELLS PLACE  DEFCHECK   ( UNPACKS AND PLACES 1ST LETTER TO STRUSPELLS )
                    17 USPELLS DUP 2DUP CR    ( ALL HOPE ABANDON, YE WHO LOOK BELOW )
                    82 <> SWAP 69 <> AND SWAP ROT 87 <> SWAP 81 <> AND CR AND IF ( IF NOT Q,W,E,R THEN IT'S INVALID )
                    ." TRY AGAIN. " INITLVL THEN ;                               ( AS OF NOW IT'S REDUNDANT BUT FUNNY LOOKING )
: STATS    66E  .LEVEL @  1  - S>F 2.5E F* F+ FDUP F>S .BASEAD !  .BONUSAD @ S>F F+  F>S .TOTALAD +! ;
: AUTO     CRIT .TOTALAD @ S>F F* FDUP ." AUTO DMG:  " F. ;
: QSPELL   STRSPELLS 1 CHARS + C@ ;
: WSPELL   STRSPELLS 2 CHARS + C@ ;
: ESPELL   STRSPELLS 3 CHARS + C@ ;
: RSPELL   STRSPELLS 4 CHARS + C@ ;  ( MAY BE UNNECESSARY )
: LEVELS  RECURSIVE DO   I USPELLS QSPELL = IF 1 .QLVL +! ELSE                  ( SETS OUR SPELL LEVELS )
                           I USPELLS WSPELL = IF 1 .WLVL +! ELSE
                             I USPELLS ESPELL = IF 1 .ELVL +! ELSE
                               I USPELLS RSPELL = IF 1 .RLVL +! ELSE
                                 0 .QLVL ! 0 .WLVL ! 0 .ELVL ! 0 .RLVL !
                                 CR ." you did something bad.  " INITLVL LEVELS LEAVE THEN THEN THEN THEN    LOOP
               CR ." Q LEVEL:  " .QLVL @ .
               CR ." W LEVEL:  " .WLVL @ .
               CR ." E LEVEL:  " .ELVL @ .
               CR ." R LEVEL:  " .RLVL @ . CR ;

: RUNES    18E 0.6E F* F>S .BONUSAD +! ;
: TLORDS   21.176E 8.824E F+ .LEVEL @ S>F F*   0.40E .BONUSAD @ S>F F*    F+ ;

: COMBAT 0.0E 5 0     DO
                    0.0E  5 1 DO
              I 1 = IF   CRIT FDUP ." CRIT :  " F. QDMG S>F F+ F* .TOTALAD @ F+
                         DUSKDMG F+  ." FIRST AUTO DONE " THEN
              I 2 = IF   FTIAMAT F@
                         AUTO    F+ CR ." SECOND AUTO DONE "  THEN
              I 3 = IF   EDMG       CR ." E DONE "  THEN
                         TLORDS  F+
              I 4 = IF   AUTO       CR ." THIRD AUTO DONE "  THEN
                   F+ LOOP
               F+ .MAXHP @ S>F FCURRENTHP F! LOOP
   25  S>F F/ F. ." AVERAGE DAMAGE " ;

18 .TOTALAD +!
: GO      CR CR   LVL   INITLVL  RUNES  LEVELS  STATS  ARMR  LETH  ENEMYHP ;





PAGE ." TYPE ANY OF THE FOLLOWING, THEN 'GO' ! " CR CR ." AVAILABLE ITEMS: TIAMAT DUSKBLADE IE YOUMUU " CR CR ." AWAITING INPUT... " CR
( TO-DO : FIX E )