@program ddr.muf
1 10000 d
i
( Dance Dance Revolution for ProtoMUCK )
( [C] 2000-2003 Alynna Trypnotk - alynna@animaltracks.net
  Release terms: GNU GPL v2
  http://www.gnu.org/copyleft/gpl.html
  Just tell me where you got me, where your using this program [host/port]
  and distribute your changes under the same terms as you got them [GNU GPL v2] )
( INSTALL:
  @act ddr;ddr6;ddr8=here
  @link ddr=ddr.muf
  @set ddr.muf=L
)
( Changelog:
  DDR for MUCKs, try it and believe.
  Changelog:
  v1.7: Fixed/Enhanced high score, made the high score list length definable,
        added the @A abort function.
  v1.5: Added DDR6 and DDR8 6foot and 8foot support.
  v1.3: Added high score support.
  v1.2: Added help and command line options.
  v1.0: Initial release
)
$author Alynna
$version 1.7
$note DDR in MUF

$iflib $lib/alynna
$include $lib/alynna
$else
$abort Required: lib/alynna .. http://frogpond.dyndns.org:7000/muf?page=list&list=Alynna
$endif

( Lots of variables to annoy the variable bigots )
lvar param

lvar ddrarray
lvar ddrscore
lvar ddrbest
lvar ddrtotal
lvar ddrcombo
lvar ddrmax
lvar ddrlevel
lvar ddrsteps
lvar ddrfinal
lvar ddrgrade
lvar ddrfeet

lvar perfect
lvar good
lvar ok
lvar fair
lvar uhoh
lvar boo

( I like to entertain myself with amusing defines )
$def READ_SHOOTS_BLANKS READ_WANTS_BLANKS
$def STEPS ddrsteps @
$def FD ddrfeet @ 4.0 / *
$define HIGHSCOREFMT
 { ddrfinal @ 4 round ftostrc 10 lj
   "^GREEN^" me @ name 15 lj
   "^NORMAL^MaxCombo: " ddrmax @ intostr "/" ddrsteps @ intostr strcat strcat 8 lj
   "^GREEN^" perfect @ intostr 4 lj
   "^CYAN^" good @ intostr 4 lj
   "^YELLOW^" ok @ intostr 4 lj
   "^PURPLE^" fair @ intostr 4 lj
   "^BLUE^" uhoh @ intostr 4 lj
   "^RED^" boo @ intostr 4 lj
   " ^NORMAL^DDR" ddrfeet @ " ^NORMAL^Grade: " ddrgrade @
   }cat
$enddef

$def STEPBONUS 0.8 FD
$def COMBOBONUS 1.25 FD
$def HSIZE 20

( Get ready ... )
: ddr.prepdance
ddrsteps !
var causality
var cur
{
1 STEPS 1 for pop 0 repeat
}array ddrscore !

( I want to sing the world a song )
{
command @ tolower case
 "ddr"  smatch when 16  causality ! end
 "ddr6" smatch when 64  causality ! end
 "ddr8" smatch when 256 causality ! end
endcase

1 STEPS 1 for pop
 random causality @ % cur !
 {
 cur @ 1   bitand if "A" else "-" then
 cur @ 2   bitand if "S" else "-" then
 cur @ 4   bitand if "D" else "-" then
 cur @ 8   bitand if "F" else "-" then
 ddrfeet @ 6 = if
 cur @ 16  bitand if "W" else "-" then
 cur @ 32  bitand if "E" else "-" then
 then
 ddrfeet @ 8 = if
 cur @ 16  bitand if "Q" else "-" then
 cur @ 32  bitand if "W" else "-" then
 cur @ 64  bitand if "E" else "-" then
 cur @ 128 bitand if "R" else "-" then
 then
 }cat
repeat
}array ddrarray !
;

: ddr.scoring
0 STEPS -- 1 for ddrscore @ swap [] ddrtotal @ + ddrtotal ! repeat
ddrtotal @ ddrsteps @ STEPBONUS * - ddrmax @ COMBOBONUS * - ddrfinal !
{ "Dance Dance Revolution " ddrfeet @ " scoring percentile (Lower is better): " }cat "DDR" pretty tellhere
{ "------------------" }cat tellhere
{ "^GREEN^Perfect:       " perfect @ }cat tellhere
{ "^CYAN^Good:          " good @ }cat tellhere
{ "^YELLOW^OK:            " ok @ }cat tellhere
{ "^PURPLE^Fair:          " fair @ }cat tellhere
{ "^BLUE^Uh-oh:         " uhoh @ }cat tellhere
{ "^RED^Boo:           " boo @ }cat tellhere
{ "------------------" }cat tellhere
{ "Total:         " ddrtotal @ 4 round }cat tellhere
{ "Step Bonus:    " ddrsteps @ " (-" ddrsteps @ STEPBONUS * ")" }cat tellhere
{ "Highest Combo: " ddrmax @ " (-" ddrmax @ COMBOBONUS * ")" }cat tellhere
{ "Final Score:   ^GREEN^" ddrfinal @ 4 round }cat tellhere
{ "Grade: "
  ddrfinal @ case
  ( You're not just another fella )
-9999.9 -99.9 .. when "^YELLOW^THE CHEAT^NORMAL^" dup ddrgrade ! end
  -99.9   0.0 .. boo @ not uhoh @ not fair @ not ok @ not and and and and
                 when "^GREEN^AAA^NORMAL^" dup ddrgrade ! end
  -99.9   0.0 .. boo @ not and
                 when "^GREEN^AA^NORMAL^" dup ddrgrade ! end
  -99.0  10.0 .. when "^CYAN^A^NORMAL^" dup ddrgrade ! end
   10.0  25.0 .. when "^YELLOW^B^NORMAL^" dup ddrgrade ! end
   25.0  50.0 .. when "^PURPLE^C^NORMAL^" dup ddrgrade ! end
   50.0 100.0 .. when "^BLUE^D^NORMAL^" dup ddrgrade ! end
  100.0        > when "^RED^E^NORMAL^" dup ddrgrade ! end
  endcase
}cat "DDR" pretty tellhere
;

( Dance, baby, dance )
: ddr.dance
var cur
var tmp
var dtime
var dscore

( *** BEGIN INNATE SKILL DETERMINATION *** )

( Level in DDR increases time allotment )
$ifdef __muckname=FF:DA
$include $lib/rp
$include $lib/rps
me @ "body" getstat toint 2 / me @ "skill/performance" getstat toint + 2.0 / 2.0 + 2.0 7.0 limit ddrlevel !
$endif
$ifdef __muckname=APA2
$include $lib/rp
$include $lib/rps
me @ "a/DanceDanceRevolution" getstat toint level 5.0 / 2.0 + 2.0 7.0 limit ddrlevel !
$endif
$ifdef __muckname=HotE
$include $lib/rp
me @ "Stamina" getstat toint
me @ "Performance" getstat toint +
me @ "Performance/DDR" getstat toint +
20.0 / 2.0 + 2.0 7.0 limit ddrlevel !
$endif
$ifdef __muckname=Multiverse
$include $lib/rp
me @ "Stamina" attr getstat toint
me @ "Dancing" skill getstat toint +
10.0 / 2.0 + 2.0 7.0 limit ddrlevel !
$endif
$ifndef __muckname
( *** Customize this for your MUCK *** )
frand 4.0 * 3.0 + 2 round ddrlevel !
$endif
$ifdef __fuzzball__
( *** Customize this for your MUCK *** )
frand 4.0 * 3.0 + 2 round ddrlevel !
$endif

( *** END INNATE SKILL DETERMINATION *** )

( make READ and TREAD shoot blanks )
READ_SHOOTS_BLANKS
{ "Enter the letters specified after 'Dance:' without spaces or dashes.  Use @A to abort your dance if you need to." }cat "DDR" pretty tellme
{ me @ " steps up onto the DDR" ddrfeet @ " pad for " STEPS " steps.. (DDR level " ddrlevel @ 2 round ")" }cat "DDR" pretty tellhere
"^RED^Ready?" "DDR" pretty tellme
1 sleep
"^YELLOW^Set?" "DDR" pretty tellme
1 sleep
"^GREEN^Go!" "DDR" pretty tellhere
1 sleep
"------------------------------------------------------------" tellme
( For STEPS steps )
0 STEPS -- 1 for cur !
 ( Display step )
 { "Dance: " ddrarray @ cur @ [] }cat tellme
 ( Get exact time, right down to the fucking microsecond )
 systime_precise
 ( Dont tread on me, tread lightly upon the earth )
 ddrlevel @ toint 2 7 limit tread not if pop "" then tmp !
 ( Get current time and subtract for time passed )
 systime_precise swap - dtime !
 ( Possibly abort the dance )
 tmp @ "@A" smatch if "Dance aborted" abort then
 ( If we got the step right )
 { me @ " dances (step ^GREEN^" cur @ ++ "^NORMAL^): '" ddrarray @ cur @ [] "" "-" subst "' -> '" tmp @ "" " " subst "': "
 ddrarray @ cur @ [] "" "-" subst tmp @ "" " " subst smatch if
  dtime @ ddrscore @ cur @ ->[] ddrscore !
  dtime @ case
   0.0  FD 1.25 FD .. when "^GREEN^Perfect!^NORMAL^" perfect ++ end
   1.25 FD 1.5  FD .. when "^CYAN^Good!^NORMAL^"     good ++    end
   1.5  FD 2.0  FD .. when "^YELLOW^Ok!^NORMAL^"     ok ++      end
   2.0  FD 4.0  FD .. when "^PURPLE^Fair..^NORMAL^"  fair ++    end
   4.0  FD 6.0  FD .. when "^BLUE^Uh oh...^NORMAL^"  uhoh ++    end
        6.0     FD >  when "^RED^Boo!^NORMAL^"       boo ++     end
  endcase
  else
  10.0 ddrlevel @ - ddrscore @ cur @ ->[] ddrscore !
  "^RED^Boo!^NORMAL^" boo ++
  then
 ddrscore @ cur @ [] dscore !
 dscore @ 1.5 FD < if
  ddrcombo ++
  ddrcombo @ 3.0 > if
   { " ^CYAN^" ddrcombo @ " combo^NORMAL^" }cat
  then
  ddrcombo @ ddrmax @ > if ddrcombo @ ddrmax ! then
 else
  0 ddrcombo !
 then
 " (" dscore @ 2 round ")" }cat tellhere
 "------------------------------------------------------------" tellme
repeat
;

: ddr.scores
"DDR Best Scores" header tellme
prog "highscores" array_get_proplist atellme
"DDR v1.7" footer tellme
;

: ddr.scorecheck
var highscores
var place
var target
var tgtscore
prog "highscores" array_get_proplist highscores !
highscores @ array_count case
 0 = when
   "Its a new record!" "DDR" pretty tellhere
   HIGHSCOREFMT highscores @ 0 array_insertitem highscores !
   { highscores @ foreach swap pop dup string? not if pop then repeat }array highscores !
   prog "highscores" highscores @ array_put_proplist
   ddr.scores exit
   end
 1 HSIZE 1 - .. when
   highscores @ foreach target ! place !
    target @ " " split pop tofloat tgtscore !
    ddrfinal @ tgtscore @ < if
     place @ not if
      "Its a new record!" "DDR" pretty tellhere
     else
      "Its a new high score!" "DDR" pretty tellhere
     then
     HIGHSCOREFMT highscores @ place @ array_insertitem 0 HSIZE 1 - array_getrange highscores !
     { highscores @ foreach swap pop dup string? not if pop then repeat }array highscores !
     prog "highscores" highscores @ array_put_proplist
     ddr.scores exit
    then
   repeat
   "Its a new high score!" "DDR" pretty tellhere
   HIGHSCOREFMT highscores @ dup array_count array_insertitem highscores !
   { highscores @ foreach swap pop dup string? not if pop then repeat }array highscores !
   prog "highscores" highscores @ array_put_proplist
   ddr.scores exit
   end
 HSIZE >= when
   highscores @ foreach target ! place !
   target @ " " split pop tofloat tgtscore !
   ddrfinal @ tgtscore @ < if
    place @ not if
     "Its a new record!" "DDR" pretty tellhere
    else
     "Its a new high score!" "DDR" pretty tellhere
    then
    HIGHSCOREFMT highscores @ place @ array_insertitem 0 HSIZE 1 - array_getrange highscores !
    { highscores @ foreach swap pop dup string? not if pop then repeat }array highscores !
    prog "highscores" highscores @ array_put_proplist
    ddr.scores exit
   then
  repeat
  end
endcase
;

: ddr.help
{
{ "Dance Dance Revolution v" prog "_version" getprop " for ProtoMUCK (C) 2003 Alynna Trypnotk" }cat
" "
"Syntaxii:"
" "
" ddr  <steps>     Defaulting to 25, plays a game of DDR4 of the steps specified."
" ddr6 <steps>     Defaulting to 25, plays a game of DDR6 of the steps specified."
" ddr8 <steps>     Defaulting to 25, plays a game of DDR8 of the steps specified."
" ddr #help        Heres looking at it, kid."
" ddr #scores      See the best scores to date."
" ddr #flush       Fix a broken DDR machine."
" ddr #reset       (Owner only) Reset high scores."
" "
" @A               (In game) Abort a dance"
" "
"DDR Hints and tips"
"------------------"
"1) Use 'DDR' as a command to start a game of Dance Dance Revolution."
"2) Depending on the MUCK, certain stats might increase your DDR level, giving"
"   you more time to do your move, and decreasing the severity of your mistakes."
"3) While 'ddr' as a command alone gives you a standard dance of 25 moves, using"
"   DDR <#> allows you to choose from 10 to 100 moves in a session.  More moves"
"   give you a bigger move bonus, but increases your chances of messing up."
"4) Enter the characters that are shown each time a 'Dance' move comes up, as"
"   quickly as you can.  The closer to one second you can get the better.  Hit"
"   'enter' to lock your move in."
"5) The characters need to be in the right order, and they shouldnt have any"
"   spaces or dashes in them."
"6) Getting combos, or unbroken moves that are either perfect or good, help your"
"   score.  The largest combo you make is taken off of your total time score."
}array atellme
;

: main
param !
command @ tolower case
 "ddr"  smatch when 4 ddrfeet ! end
 "ddr6" smatch when 6 ddrfeet ! end
 "ddr8" smatch when 8 ddrfeet ! end
endcase
param @ tolower case
 "#h*" smatch when
   ddr.help
 end
 "#f*" smatch when
  ( me @ trig controls ) 1 if
   trig "locked" 0 setprop
   "Pikachu back in play." "DDR" pretty tellme
  else
   "^RED^Permission denied.^NORMAL^" tellme
  then
 end
 "#r*" smatch when
  me @ trig controls if
   prog "highscores#" remove_prop
   "High scores reset" "DDR" pretty tellme
  else
   "^RED^Permission denied.^NORMAL^" tellme
  then
 end
 "#s*" smatch when
   ddr.scores
 end
 default
   ( One at a time, please )
   trig "locked" getprop if
    "Pikachu out of play." "DDR" pretty tellme exit
   then
   1 try 
    trig "locked" 1 setprop
    param @ if toint dup 10 < if pop 25 then else 25 then 10 250 limit
    ddr.prepdance
    ddr.dance
    ddr.scoring
    ddr.scorecheck
    trig "locked" 0 setprop
   catch 
    dup "Stack protection fault." smatch if pop "Stack protection fault, child processes spawned." then
    debug_line
    { "Caught error signal: " rot }cat "DDR" pretty tellhere
    { "Placed pikachu back in play. " }cat "DDR" pretty tellhere
    trig "locked" 0 setprop
   endcatch 
 end
endcase
;
.
c
q