@prog questionaire.muf
1 99999 d
1 i
( Something hastily cooked up to ask lots of questions
  Currently:
        @link action=thisprogram
        lsedit action=_question
                YN:Question one.. one long line, Yes or No, don't format it or anything
                1234:Question two.. long line, 1, 2, 3, or 4.. Hope you get the idea
                .end
        This lsedit is like 
                @set action=_question#/1:YN:Question one.. one long line, Yes or N...
                @set action=_question#/2:1234:Question two.. long line, 1, 2, 3, o...
`
        @succ action=You see this before you vote
`
        @set action=_hidden:You're not allowed to peek!        
                This property inhibits answers being listed.
        @set action=_once:You can only answer once.
                This property inhibits multiple answerers
        @set action=_closed:The polls are now closed!
                This property inhibits any more answers, but you can see the results
                if _hidden has been removed.
`
                Answers are answered with `action'
                Answers are listed with `action <anything>' or `action' if _closed
`
  Stored as:
        _/.answers#/1:YYYNNYNYYNNNYYYY          etc, so it's statistically useful
        _/.answers#/1/Y:4                                       etc, so it's easy to display
`
        .answerers/_1234:yup                            etc, so only one answer per character,
                                                                                but order becomes jumbled. This should
                                                                                be a wizprop, @ and ~
`
 Warwick
)
$define ANSWERS  "_/.answers#/" $enddef
$define QUESTION "_question#/" $enddef
$define ANSWERERS ".answerers/_" $enddef
($define ANSWERERS "@answerers/~" $enddef)
: bad ( i s -- )
        "** #" trig int intostr strcat ", " strcat 
        QUESTION 4 rotate intostr strcat 
        trig over getpropstr ":" swap strcat strcat strcat
        " - " strcat swap strcat trig owner swap notify
;
: show-list ( -- )
        1 begin
                QUESTION over intostr strcat trig swap getpropstr dup while
                dup ":" instr dup not if
                        pop pop "Need : between options and question" bad exit
                then
                1 - strcut 1 strcut swap pop 
                3 pick intostr ". " strcat swap strcat .tell
                "" swap begin
                        dup while
                        1 strcut swap dup 5 pick intostr "/" strcat swap strcat
                        ANSWERS swap strcat trig swap getpropstr
                        ":" swap strcat strcat " " strcat rot swap strcat swap
                repeat
                pop .tell 1 +
        repeat pop
;
: ask-list
        1 begin
                QUESTION over intostr strcat trig swap getpropstr dup while
                dup ":" instr dup not if
                        pop pop "Need : between options and question." bad 0 exit
                then 1 - strcut 1 strcut swap pop
                3 pick intostr ". " strcat swap strcat
                " (" strcat over strcat ")" strcat
                begin
                        dup .tell read 1 strcut pop toupper 
                        3 pick over instr not while pop
                repeat 
                swap pop swap pop
                ANSWERS 3 pick intostr strcat over over
                "/" strcat swap strcat trig over getpropstr atoi 1 + intostr
                trig -3 rotate 0 addprop
                trig over getpropstr rot strcat trig -3 rotate 0 addprop
                1 +
        repeat
        pop
;
: main ( "" -- )
        trig "_closed" getpropstr dup if dup .tell then or
        if
                trig "_hidden" getpropstr dup if .tell exit then pop
                show-list
                exit
        else
                trig ANSWERERS me @ intostr strcat getpropstr if
                        trig "_once" getpropstr dup if .tell exit then pop
                then
                trig ANSWERERS me @ intostr strcat "yus" 0 addprop
                ask-list
        then
        "<done>" .tell
;
97 lines displayed.
.
c
q
@register #me questionaire.muf=tmp/prog1
@set $tmp/prog1=L
@set $tmp/prog1=3
@propset $tmp/prog1=str:/_/de:A scroll containing a spell called questionaire.muf