TO #GATHER :SEN
IF EMPTYP :SEN [OP :SEN]
IF NOT TRY.PRED [OP :SEN]
MAKE :SPECIAL.VAR LPUT FIRST :SEN THING :SPECIAL.VAR
OP #GATHER BF :SEN
END

TO #TEST :SEN
IF RMATCH BF :PAT :SEN [OP "TRUE]
IF EMPTYP THING :SPECIAL.VAR [OP "FALSE]
OP #TEST2 FPUT LAST THING :SPECIAL.VAR :SEN
END

TO #TEST2 :SEN
MAKE :SPECIAL.VAR BL THING :SPECIAL.VAR
OP #TEST :SEN
END

TO &TEST :TF
IF EMPTYP THING :SPECIAL.VAR [OP "FALSE]
OP :TF
END

TO @TEST :SEN
IF @TRY.PRED [IF RMATCH BF :PAT :SEN [OP "TRUE]]
IF EMPTYP THING :SPECIAL.VAR [OP "FALSE]
OP @TEST2 FPUT LAST THING :SPECIAL.VAR :SEN
END

TO @TEST2 :SEN
MAKE :SPECIAL.VAR BL THING :SPECIAL.VAR
OP @TEST :SEN
END

TO @TRY.PRED
IF LISTP :SPECIAL.PRED [OP RMATCH :SPECIAL.PRED THING :SPECIAL.VAR]
OP RUN LIST :SPECIAL.PRED THING :SPECIAL.VAR
END

TO ^TEST :SEN
IF RMATCH BF :PAT :SEN [OUTPUT "TRUE]
IF EMPTYP :SEN [OUTPUT "FALSE]
IF NOT TRY.PRED [OUTPUT "FALSE]
MAKE :SPECIAL.VAR LPUT FIRST :SEN THING :SPECIAL.VAR
OUTPUT ^TEST BF :SEN
END

to aaaaaa
;
; Function:
;
; This function is a simple DialogBox editor. It is still incomplete
; but is usable. In fact I wrote part of this application with itself !!!
;
; To run:
;
; Load "visual.lgo
; Call visual
; <click on load button>
; <enter "boxes">
;
; To move a control, click down with mouse in the upper left corner inside
; the box and drag it. Then let mouse button go.
;
; To resize a control, click down with mouse in the lower right corner inside
; the box and drag it. Then let mouse button go.
;
; To change parameters on a box or delete it click in the middle of the control
;
; To see what the dialog really looks like click on the Test Button.
; Click EndTest button to close it.
;
; To snap each control to a grid in the snap to grid button and enter
; grid size.
;
; To save the changes click on save (note testing does a save).
;
; If dragging is to slow hot fast drag
;
; To add a control hit one of the "NEW-" bottons. The control will be
; placed in the upper left corner outside of the dialog box.
;
; To select the DIalog box itself for resizing, click
; anywhere inside the dialog box but not on a control.
;
; It does not know about the code that actaully makes the dialog
; box/window itself, just the control in one.
;
; It does not know about ANY other code except "SOMETHINGcreate".
;
; If you put all your code that "CREATE"s controls in one procedure,
; it's almost usable. I used it for all the dialogs in this application
; and found an improment over calculating coordinates.
;
; If also expects ALL text arguments to be LISTs (even though
; words are legal).
;
; Some day I hope to finish this and perhaps add hooks (or rewrite in C)
; to MswLogo so that REAL buttons can be dragged FAST. 
;
end

TO ABS :NUM
OP IFELSE (:NUM < 0) [-:NUM] [:NUM]
END

TO AGEIFY :SENT
IF EMPTYP :SENT [OUTPUT []]
IF NOT PERSONP FIRST :SENT [OUTPUT FPUT FIRST :SENT AGEIFY BF :SENT]
CATCH "ERROR [IF EQUALP FIRST BF :SENT "S ~
                 [OUTPUT FPUT FIRST :SENT AGEIFY BF :SENT]]
OUTPUT (SE FIRST :SENT [S AGE] AGEIFY BF :SENT)
END

TO AGEPROB
LOCAL [BEG END SYM WHO NUM SUBJ AGES]
WHILE [MATCH [^BEG AS OLD AS #END] :PROB] [MAKE "PROB SE :BEG :END]
WHILE [MATCH [^BEG YEARS OLD #END] :PROB] [MAKE "PROB SE :BEG :END]
WHILE [MATCH [^BEG WILL BE WHEN #END] :PROB] ~
      [MAKE "SYM GENSYM ~
       MAKE "PROB (SE :BEG "IN :SYM [YEARS . IN] :SYM "YEARS :END)]
WHILE [MATCH [^BEG WAS WHEN #END] :PROB] ~
      [MAKE "SYM GENSYM ~
       MAKE "PROB (SE :BEG :SYM [YEARS AGO .] :SYM [YEARS AGO] :END)]
WHILE [MATCH [^BEG !WHO:PERSONP WILL BE IN !NUM YEARS #END] :PROB] ~
      [MAKE "PROB (SE :BEG :WHO [S AGE IN] :NUM "YEARS #END)]
WHILE [MATCH [^BEG WAS #END] :PROB] [MAKE "PROB (SE :BEG "IS :END)]
WHILE [MATCH [^BEG WILL BE #END] :PROB] [MAKE "PROB (SE :BEG "IS :END)]
WHILE [MATCH [^BEG !WHO:PERSONP IS NOW #END] :PROB] ~
      [MAKE "PROB (SE :BEG :WHO [S AGE NOW] :END)]
WHILE [MATCH [^BEG !NUM YEARS FROM NOW #END] :PROB] ~
      [MAKE "PROB (SE :BEG "IN :NUM "YEARS :END)]
MAKE "PROB AGEIFY :PROB
IFELSE MATCH [^ !WHO:PERSONP ^END S AGE #] :PROB ~
       [MAKE "SUBJ SE :WHO :END] [MAKE "SUBJ "SOMEONE]
MAKE "PROB AGEPRON :PROB
MAKE "END :PROB
MAKE "AGES []
WHILE [MATCH [^ !WHO:PERSONP ^BEG AGE #END] :END] ~
      [PUSH "AGES (SE "AND :WHO :BEG "AGE)]
MAKE "AGES BF REDUCE "SE REMDUP :AGES
WHILE [MATCH [^BEG THEIR AGES #END] :PROB] [MAKE "PROB (SE :BEG :AGES :END)]
MAKE "SIMSEN MAP [AGESEN ?] BRACKET :PROB
END

TO AGEPRON :SENT
IF EMPTYP :SENT [OUTPUT []]
IF NOT PRONOUN FIRST :SENT [OUTPUT FPUT FIRST :SENT AGEPRON BF :SENT]
IF POSSPRO FIRST :SENT [OUTPUT (SE :SUBJ "S AGEPRON BF :SENT)]
OUTPUT (SE :SUBJ [S AGE] AGEPRON BF :SENT)
END

TO AGESEN :SENT
LOCAL [WHEN REST NUM]
MAKE "WHEN []
IF MATCH [IN !NUM YEARS #REST] :SENT ~
   [MAKE "WHEN SE "PLUSS :NUM MAKE "SENT :REST]
IF MATCH [!NUM YEARS AGO #REST] :SENT ~
   [MAKE "WHEN SE "MINUSS :NUM MAKE "SENT :REST]
OUTPUT AGEWHEN :SENT
END

TO AGEWHEN :SENT
IF EMPTYP :SENT [OUTPUT []]
IF NOT EQUALP FIRST :SENT "AGE [OUTPUT FPUT FIRST :SENT AGEWHEN BF :SENT]
IF MATCH [IN !NUM YEARS #REST] BF :SENT ~
   [OUTPUT (SE [AGE PLUSS] :NUM AGEWHEN :REST)]
IF MATCH [!NUM YEARS AGO #REST] BF :SENT ~
   [OUTPUT (SE [AGE MINUSS] :NUM AGEWHEN :REST)]
IF EQUALP "NOW FIRST BF :SENT [OUTPUT SE "AGE AGEWHEN BF BF :SENT]
OUTPUT (SE "AGE :WHEN AGEWHEN BF :SENT)
END

TO ALWAYS :X
OP "TRUE
END

TO ANYOF :SEN
OP ANYOF1 :SEN :IN.LIST
END

TO ANYOF1 :SEN :PATS
IF EMPTYP :PATS [OP "FALSE]
IF RMATCH FIRST :PATS :SEN [OP "TRUE]
OP ANYOF1 :SEN BF :PATS
END

TO ARTICLE :WORD
OP MEMBERP :WORD [A AN THE]
END

TO BKT1 :PROBLIST
LOCAL [FIRST WORD REST]
IF EMPTYP :PROBLIST [OUTPUT []]
IF NOT MEMBERP ", FIRST :PROBLIST [OP FPUT FIRST :PROBLIST BKT1 BF :PROBLIST]
IF MATCH [IF ^FIRST , !WORD:QWORD #REST] FIRST :PROBLIST ~
   [OP BKT1 FPUT (SE :FIRST ".) FPUT (SE :WORD :REST) BF :PROBLIST]
IF MATCH [^FIRST , AND #REST] FIRST :PROBLIST ~
   [OP FPUT (SE :FIRST ".) (BKT1 FPUT :REST BF :PROBLIST)]
OP FPUT FIRST :PROBLIST BKT1 BF :PROBLIST
END

to boxes
groupboxcreate "main [group1] 20 50 70 50
radiobuttoncreate "main [group1] [Radio1] [Radio Button] 30 60 50 10
checkboxcreate "main [group1] [check1] [Check Box] 30 80 50 10
scrollbarcreate "main [Scroll1] 20 30 70 10 [Print "Scrolled]
buttoncreate "main [Button1] [Button to be Push] 20 10 50 10 [Print "Push]
comboboxcreate "main [combo1] 20 110 50 30
listboxcreate "main [list1] 20 150 70 20
staticcreate "main [static1] [This is a static box] 20 180 140 10
end

TO BRACKET :PROB
OUTPUT BKT1 FINDDELIM :PROB
END

TO CATEGORY :NAME :MEMBERS
PRINT (LIST "CATEGORY :NAME :MEMBERS)
IF NOT NAMEP "CATEGORIES [MAKE "CATEGORIES []]
MAKE "CATEGORIES LPUT :NAME :CATEGORIES
MAKE :NAME :MEMBERS
FOREACH :MEMBERS [PPROP ? "CATEGORY :NAME]
END

TO CHANGEONE :CHANGE
LOCAL "END
IF NOT MATCH (SE FIRST :CHANGE [#END]) :SENT [OP "FALSE]
MAKE "SENT RUN (SE "SE LAST :CHANGE ":END)
OP "TRUE
END

TO CHANGES :SENT :LIST
LOCAL "KEYWORDS
MAKE "KEYWORDS MAP.SE [FINDKEY FIRST ?] :LIST
OP CHANGES1 :SENT :LIST :KEYWORDS
END

TO CHANGES1 :SENT :LIST :KEYWORDS
IF EMPTYP :SENT [OP []]
IF MEMBERP FIRST :SENT :KEYWORDS [OP CHANGES2 :SENT :LIST :KEYWORDS]
OP FPUT FIRST :SENT CHANGES1 BF :SENT :LIST :KEYWORDS
END

TO CHANGES2 :SENT :LIST :KEYWORDS
CHANGES3 :LIST :LIST
OP FPUT FIRST :SENT CHANGES1 BF :SENT :LIST :KEYWORDS
END

TO CHANGES3 :BIGLIST :NOWLIST
IF EMPTYP :NOWLIST [STOP]
IF CHANGEONE FIRST :NOWLIST [CHANGES3 :BIGLIST :BIGLIST STOP]
CHANGES3 :BIGLIST BF :NOWLIST
END

TO CHOOSE :N :R
OUTPUT (PERMS :N :R)/(FACT :R)
END

TO CLEAN1 :CATEGORY
FOREACH THING :CATEGORY [ERPL ?]
ERN :CATEGORY
END

TO CLEANUP
FOREACH :CATEGORIES [CLEAN1 ?]
ERN "CATEGORIES
END

TO COMBS :LIST :HOWMANY
IF EQUALP :HOWMANY 0 [OP [[]]]
IF EQUALP :HOWMANY COUNT :LIST [OP (LIST :LIST)]
OP SE (MAP [FPUT FIRST :LIST ?] COMBS (BF :LIST) (:HOWMANY-1)) ~
      (COMBS (BF :LIST) :HOWMANY)
END

TO DENOM :FRACT :ADDENDS
MAKE "ADDENDS SIMPLUS :ADDENDS
LOCAL "DEN
MAKE "DEN LAST :FRACT
IF NOT EQUALP FIRST :ADDENDS "QUOTIENT ~
   [OP SIMDIV LIST ~
               (SIMONE "SUM ~
                       (REMOP "SUM LIST (DISTRIBTIMES (LIST :ADDENDS) :DEN) ~
                                        FIRST BF :FRACT)) :DEN]
IF EQUALP :DEN LAST :ADDENDS ~
   [OP SIMDIV (SIMPLUS LIST (FIRST BF :FRACT) (FIRST BF :ADDENDS)) :DEN]
LOCAL "LOWTERMS
MAKE "LOWTERMS SIMDIV LIST :DEN LAST :ADDENDS
OP SIMDIV LIST (SIMPLUS (SIMTIMES LIST FIRST BF :FRACT LAST :LOWTERMS) ~
                        (SIMTIMES LIST FIRST BF :ADDENDS FIRST BF :LOWTERMS)) ~
               (SIMTIMES LIST FIRST BF :LOWTERMS LAST :ADDENDS)
END

TO DEPUNCT :WORD
IF EMPTYP :WORD [OP []]
IF EQUALP FIRST :WORD "$ [OP SE "$ DEPUNCT BF :WORD]
IF EQUALP LAST :WORD "% [OP SE DEPUNCT BL :WORD "PERCENT]
IF MEMBERP LAST :WORD [. ? |;| ,] [OP SE DEPUNCT BL :WORD LAST :WORD]
IF EMPTYP BF :WORD [OP :WORD]
IF EQUALP LAST2 :WORD "'S [OP SE DEPUNCT BL BL :WORD "S]
OP :WORD
END

TO DIFFER :LIST
PRINT (LIST "DIFFER :LIST)
FOREACH :LIST [DIFFER1 ? ?REST]
END

TO DIFFER1 :WHO :THEM
FOREACH :THEM ~
        [IF NOT EQUALP (GPROP :WHO "CATEGORY) (GPROP ? "CATEGORY) ~
            [FALSIFY :WHO ?]]
END

TO DISTRIBTIMES :TRMS :MULTIPLIER
OP SIMPLUS MAP [SIMTIMES (LIST ? :MULTIPLIER)] :TRMS
END

TO DISTRIBX :EXPR
LOCAL [OPER ARGS]
IF EMPTYP :EXPR [OP :EXPR]
MAKE "OPER FIRST :EXPR
IF NOT OPERATORP :OPER [OP :EXPR]
MAKE "ARGS MAP [DISTRIBX ?] BF :EXPR
IF REDUCE "AND MAP [NUMBERP ?] :ARGS [OP RUN (SE [(] :OPER :ARGS [)])]
IF EQUALP :OPER "SUM [OP SIMPLUS :ARGS]
IF EQUALP :OPER "MINUS [OP MINUSIN FIRST :ARGS]
IF EQUALP :OPER "PRODUCT [OP SIMTIMES :ARGS]
IF EQUALP :OPER "QUOTIENT [OP SIMDIV :ARGS]
OP FPUT :OPER :ARGS
END

TO DIVTERM :DIVIDEND :DIVISOR
IF EQUALP :DIVIDEND 0 [OP 0]
OP SIMDIV LIST :DIVIDEND :DIVISOR
END

TO DLM :WORD
OP MEMBERP :WORD [. ? |;|]
END

TO DRAW :X
IF XCOR > :XRANGE [STOP]
SETPOS LIST (XCOR+:DELTAX) (:YRANGE*FF :MAXHARM)
DRAW :X+:DELTAX
END

to echo :arg
print mci sentence [open new type waveaudio alias wa buffer] :arg
mci [record wa]
print "Recording...
wait :arg*60
print "Stopped...
mci [seek wa to start]
print "Playing...
mci [play wa wait]
print "Stopped...
mci [close wa]
end

TO EXPAND :LIST
IF EMPTYP :LIST [OP []]
IF NUMBERP FIRST :LIST ~
   [OP CASCADE (FIRST :LIST) [FPUT FIRST BF :LIST ?] (EXPAND BF BF :LIST)]
OP FPUT FIRST :LIST EXPAND BF :LIST
END

TO EXPT :NUM :POW
IF :POW < 1 [OP 1]
OP :NUM * EXPT :NUM :POW - 1
END

TO F :NUM
OP (RADSIN :COEFF*:NUM*:X) / :NUM
END

TO FACT :N
OUTPUT CASCADE :N [# * ?] 1
END

TO FACTOR :EXPRS :VAR
LOCAL "TRMS
MAKE "TRMS MAP [FACTOR1 :VAR ?] :EXPRS
IF MEMBERP "UNKNOWN :TRMS [OP FPUT "UNKNOWN :EXPRS]
OP LIST :VAR SIMPLUS :TRMS
END

TO FACTOR1 :VAR :EXPR
LOCAL "NEGVAR
MAKE "NEGVAR MINUSIN :VAR
IF EQUALP :VAR :EXPR [OP 1]
IF EQUALP :NEGVAR :EXPR [OP -1]
IF EMPTYP :EXPR [OP "UNKNOWN]
IF EQUALP FIRST :EXPR "PRODUCT [OP FACTOR2 BF :EXPR]
IF NOT EQUALP FIRST :EXPR "QUOTIENT [OP "UNKNOWN]
LOCAL "DIVIDEND
MAKE "DIVIDEND FIRST BF :EXPR
IF EQUALP :VAR :DIVIDEND [OP (LIST "QUOTIENT 1 LAST :EXPR)]
IF NOT EQUALP FIRST :DIVIDEND "PRODUCT [OP "UNKNOWN]
LOCAL "RESULT
MAKE "RESULT FACTOR2 BF :DIVIDEND
IF EQUALP :RESULT "UNKNOWN [OP "UNKNOWN]
OP (LIST "QUOTIENT :RESULT LAST :EXPR)
END

TO FACTOR2 :TRMS
IF MEMBERP :VAR :TRMS [OP SIMONE "PRODUCT (REMOVE :VAR :TRMS)]
IF MEMBERP :NEGVAR :TRMS [OP MINUSIN SIMONE "PRODUCT (REMOVE :NEGVAR :TRMS)]
OP "UNKNOWN
END

TO FALSES :WHO :WHAT
OUTPUT COUNT FILTER [EQUALP "FALSE GET ? :WHAT] PEERS :WHO
END

TO FALSIFY :WHO :WHAT
LOCAL "OLDVALUE
MAKE "OLDVALUE GET :WHO :WHAT
IF EQUALP :OLDVALUE "FALSE [STOP]
IF EQUALP :OLDVALUE "TRUE ~
   [PR (SE [INCONSISTENCY FALSIFYING] :WHO "IS :WHAT) THROW "TOPLEVEL]
PR (LIST "FALSIFY :WHO :WHAT)
STORE :WHO :WHAT "FALSE
IF NOT EMPTYP :OLDVALUE [LINKFALSE :OLDVALUE]
IF EQUALP (COUNT PEERS :WHO) (1+FALSES :WHO :WHAT) [FINDTRUE :WHO :WHAT]
IF EQUALP (COUNT PEERS :WHAT) (1+FALSES :WHAT :WHO) [FINDTRUE :WHAT :WHO]
FOREACH (GPROP :WHO "TRUTH) [MAYBEFALSIFY ? :WHAT]
FOREACH (GPROP :WHAT "TRUTH) [MAYBEFALSIFY :WHO ?]
PPROP :WHO "FALSEHOOD (FPUT :WHAT GPROP :WHO "FALSEHOOD)
PPROP :WHAT "FALSEHOOD (FPUT :WHO GPROP :WHAT "FALSEHOOD)
END

TO FF :NUM
IF :NUM < 1 [OP 0]
OP (F :NUM)+(FF :NUM-:SKIP)
END

TO FINDDELIM :SENT
OP FINDDELIM1 :SENT [] []
END

TO FINDDELIM1 :IN :OUT :SIMPLES
IF EMPTYP :IN ~
   [IFELSE EMPTYP :OUT [OP :SIMPLES] [OP LPUT (SE :OUT ".) :SIMPLES]]
IF DLM FIRST :IN ~
   [OP FINDDELIM1 (BF :IN) [] (LPUT (SE :OUT FIRST :IN) :SIMPLES)]
OP FINDDELIM1 (BF :IN) (SE :OUT FIRST :IN) :SIMPLES
END

TO FINDFALSE :THEM :WHAT
FOREACH (FILTER [NOT EQUALP GET ? :WHAT "TRUE] :THEM) [FALSIFY ? :WHAT]
END

TO FINDKEY :PATTERN
IF EQUALP FIRST :PATTERN "!:IN [OP FIRST BF :PATTERN]
IF EQUALP FIRST :PATTERN "?:IN [OP SE (ITEM 2 :PATTERN) (ITEM 3 :PATTERN)]
OP FIRST :PATTERN
END

TO FINDTRUE :WHO :WHAT
VERIFY (FIND [NOT EQUALP "FALSE GET ? :WHAT] PEERS :WHO) :WHAT
END

TO GET :A :B
OUTPUT GETINORDER :A :B :CATEGORIES
END

TO GETEQNS :VARS
OP MAP.SE [GPROP VARKEY ? "EQNS] :VARS
END

TO GETINORDER :A :B :ORDER
IF EMPTYP :ORDER [PRINT (SE [UNKNOWN OBJECTS] :A :B) THROW "TOPLEVEL]
IF MEMBERP :A THING FIRST :ORDER [OUTPUT GPROP :A :B]
IF MEMBERP :B THING FIRST :ORDER [OUTPUT GPROP :B :A]
OUTPUT GETINORDER :A :B BF :ORDER
END

TO IDIOMS :SENT
LOCAL "NUMBER
OP CHANGES :SENT ~
    [[[THE SUM OF] ["SUM]] [[SQUARE OF] ["SQUARE]] [[OF] ["NUMOF]] ~
     [[HOW OLD] ["WHAT]] [[IS EQUAL TO] ["IS]] ~
     [[YEARS YOUNGER THAN] [[LESS THAN]]] [[YEARS OLDER THAN] ["PLUS]] ~
     [[PERCENT LESS THAN] ["PERLESS]] [[LESS THAN] ["LESSTHAN]] ~
     [[THESE] ["THE]] [[MORE THAN] ["PLUS]] ~
     [[FIRST TWO NUMBERS] [[THE FIRST NUMBER AND THE SECOND NUMBER]]] ~
     [[THREE NUMBERS] ~
      [[THE FIRST NUMBER AND THE SECOND NUMBER AND THE THIRD NUMBER]]] ~
     [[ONE HALF] [0.5]] [[TWICE] [[2 TIMES]]] ~
     [[$ !NUMBER] [SE :NUMBER "DOLLARS]] [[CONSECUTIVE TO] [[1 PLUS]]] ~
     [[LARGER THAN] ["PLUS]] [[PER CENT] ["PERCENT]] [[HOW MANY] ["HOWM]] ~
     [[IS MULTIPLIED BY] ["ISMULBY]] [[IS DIVIDED BY] ["ISDIVBY]] ~
     [[MULTIPLIED BY] ["TIMES]] [[DIVIDED BY] ["DIVBY]]]
END

TO IN :WORD
OP MEMBERP :WORD :IN.LIST
END

TO KEYWORD :INPUTS :DEFAULTS
SETUP.VALUES :DEFAULTS
IF WORDP :INPUTS [MAKE FIRST :DEFAULTS :INPUTS STOP]
SETUP.VALUES :INPUTS
END

TO LAST2 :WORD
OP WORD (LAST BL :WORD) (LAST :WORD)
END

to linf
cs ht ppt setsc [200 2 255] setpensize [2 2] 
 rt 90 label [Vpisi koeficient k]
make "k rw cs rt 90
label [Vpisi stalni clen n]
make "n rw*35 cs pu home  setpc [222 222 255]
pu home setxy -300 190 rt 90 pd setpc [200 255 234] label  [y =] pu setxy -270 190 pd 
 label :k pu setxy -235 190 pd ifelse :n<0 [ label [x ]] [label [x +]] pu setxy -203 190 pd label :n/35
  pu setxy -300 150 pd ifelse :k=0 [label [nima nicel]] [make "i :n/(-:k*35) label [nicla=] pu setxy -240 150 pd label :i]
pu setxy 300 -150 label [by Koren] pu home
ifelse :k=0 [sety :n rt 90 pd fd 400 bk 800] [setx :i*35 rt 90 lt arctan( :k) pd fd 500 bk 1000]
 pu home setpc [0 255 255]

 setxy -350 210 rt 90 pd label [LINEARNA FUNKCIJA] pu home pd setpc [0 0 0]
bk 400 fd 800 home repeat 12 [rt 90 bk 3 fd 6 pu bk 3 lt 90 bk 35 pd ]
pu home pd  repeat 12 [rt 90 bk 3 fd 6 pu bk 3 lt 90 fd 35 pd ]
pu home rt 90 pd bk 400 fd 800 pu home rt 90 pd repeat 12 [rt 90 bk 3 fd 6 pu bk 3 lt 90 fd 35 pd]

pu home rt 90 pd  repeat 12 [rt 90 bk 3 fd 6 pu bk 3 lt 90 bk 36 pd ] pu home setpensize [1 1]
lt 90 pd for [ 1 120 1] [fd 3.5 rt 90 fd 2 bk 4 fd 2 lt 90] pu home
rt 90 pd for [ 1 120 1] [fd 3.5 rt 90 fd 2 bk 4 fd 2 lt 90] pu home
 pd for [ 1 120 1] [fd 3.5 rt 90 fd 2 bk 4 fd 2 lt 90] pu home
rt 180 pd for [ 1 120 1] [fd 3.5 rt 90 fd 2 bk 4 fd 2 lt 90]

pu home setpensize [2 2]  rt 90 setx 34 pd for [n 1 10 1] [label :n pu fd 34 pd] pu home
pd rt 90 for [n 0 -10 -1] [label :n pu bk 39 pd] pu
home setxy -23 45    pd for [n 1 10  1] [rt 90 label :n lt 90 pu fd 36 pd] pu home 
 setxy -28 -25 rt 180   pd for [n -1 -10  -1] [lt 90 label :n rt 90 pu fd 34 pd] pu home
end

TO LINK :WHO :WHAT1 :WHAT2
LOCAL "OLDVALUE
MAKE "OLDVALUE GET :WHO :WHAT1
IF EMPTYP :OLDVALUE [STORE :WHO :WHAT1 (LIST :WHO :WHAT2) STOP]
IF EQUALP :OLDVALUE "TRUE [FALSIFY :WHO :WHAT2 STOP]
IF EQUALP :OLDVALUE "FALSE [VERIFY :WHO :WHAT2 STOP]
STORE :WHO :WHAT1 (SE :OLDVALUE :WHO :WHAT2)
END

TO LINKFALSE :LIST
IF EMPTYP :LIST [STOP]
VERIFY (FIRST :LIST) (FIRST BF :LIST)
LINKFALSE BF BF :LIST
END

TO LINKTRUE :LIST
IF EMPTYP :LIST [STOP]
FALSIFY (FIRST :LIST) (FIRST BF :LIST)
LINKTRUE BF BF :LIST
END

TO LOCK :BUTTONS
OUTPUT CASCADE :BUTTONS [? + LOCK1 :BUTTONS #] 1
END

TO LOCK1 :TOTAL :BUTTONS
LOCAL "PERMS
MAKE "PERMS PERMS :TOTAL :BUTTONS
OUTPUT CASCADE (TWOTO (:BUTTONS-1)) [? + LOCK2 :PERMS #-1 1] 0
END

TO LOCK2 :PERMS :LINKS :FACTOR
IF EQUALP :LINKS 0 [OUTPUT :PERMS/(FACT :FACTOR)]
IF EQUALP (REMAINDER :LINKS 2) 0 [OUTPUT LOCK2 :PERMS/(FACT :FACTOR) :LINKS/2 1]
OUTPUT LOCK2 :PERMS (:LINKS-1)/2 :FACTOR+1
END

TO LSAY :HERALD :TEXT
PR []
PR :HERALD
PR []
FOREACH :TEXT [PR ? PR []]
END

TO MATCH :PAT :SEN
IF PREMATCH :PAT :SEN [OP RMATCH :PAT :SEN]
OP "FALSE
END

TO MATCH!
IF EMPTYP :SEN [OP "FALSE]
IF NOT TRY.PRED [OP "FALSE]
MAKE :SPECIAL.VAR FIRST :SEN
OP RMATCH BF :PAT BF :SEN
END

TO MATCH#
MAKE :SPECIAL.VAR []
OP #TEST #GATHER :SEN
END

TO MATCH&
OP &TEST MATCH#
END

TO MATCH?
MAKE :SPECIAL.VAR []
IF EMPTYP :SEN [OP RMATCH BF :PAT :SEN]
IF NOT TRY.PRED [OP RMATCH BF :PAT :SEN]
MAKE :SPECIAL.VAR FIRST :SEN
IF RMATCH BF :PAT BF :SEN [OP "TRUE]
MAKE :SPECIAL.VAR []
OP RMATCH BF :PAT :SEN
END

TO MATCH@
MAKE :SPECIAL.VAR :SEN
OP @TEST []
END

TO MATCH^
MAKE :SPECIAL.VAR []
OUTPUT ^TEST :SEN
END

TO MAYBEADD :NUM :REST
IF EQUALP :NUM 0 [OP :REST]
OP FPUT :NUM :REST
END

TO MAYBEFALSIFY :WHO :WHAT
IF NOT EQUALP (GPROP :WHO "CATEGORY) (GPROP :WHAT "CATEGORY) [FALSIFY :WHO :WHAT]
END

TO MAYBEMUL :NUM :REST
IF EQUALP :NUM 1 [OP :REST]
OP FPUT :NUM :REST
END

to memo :a
if a<3 [fd100]
if a>3 [fd 30]
end

TO MINUSIN :EXPR
IF EMPTYP :EXPR [OP -1]
IF EQUALP FIRST :EXPR "SUM [OP FPUT "SUM MAP [MINUSIN ?] BF :EXPR]
IF EQUALP FIRST :EXPR "MINUS [OP LAST :EXPR]
IF MEMBERP FIRST :EXPR [PRODUCT QUOTIENT] ~
   [OP FPUT FIRST :EXPR (FPUT (MINUSIN FIRST BF :EXPR) BF BF :EXPR)]
IF NUMBERP :EXPR [OP MINUS :EXPR]
OP LIST "MINUS :EXPR
END

to netlocal :machine
netstartup
show netaccepton 5124 [] [run netacceptreceivevalue]
show netconnecton :machine 5124 [print "aok] []
wait 100 ; Wait for net to start
repeat 360 [make "foo netconnectsendvalue [fd 1 rt 1]]
end

TO NMTEST :EXPR
IF MATCH [& !:NUMBERP #] :EXPR [SAY [ARGUMENT ERROR:] :EXPR TOPLEVEL]
IF AND (EQUALP FIRST :EXPR 1) (1 < COUNT :EXPR) ~
   [MAKE "EXPR (SE 1 PLURAL (FIRST BF :EXPR) (BF BF :EXPR))]
IF AND (NUMBERP FIRST :EXPR) (1 < COUNT :EXPR) ~
   [PUSH "UNITS (LIST FIRST BF :EXPR) ~
    OP (LIST "PRODUCT (FIRST :EXPR) (OPFORM BF :EXPR))]
IF NUMBERP FIRST :EXPR [OP FIRST :EXPR]
IF MEMBERP "THIS :EXPR [OP THIS :EXPR]
IF NOT MEMBERP :EXPR :VAR [PUSH "VAR :EXPR]
OP :EXPR
END

TO OCCVAR :VAR :EXPR
IF EMPTYP :EXPR [OP "FALSE]
IF WORDP :EXPR [OP EQUALP :VAR :EXPR]
IF OPERATORP FIRST :EXPR [OP NOT EMPTYP FIND [OCCVAR :VAR ?] BF :EXPR]
OP EQUALP :VAR :EXPR
END

TO OP0 :WORD
OP MEMBERP :WORD [PLUSS MINUSS SQUARED TOTHEPOWER PER SUM DIFFERENCE NUMOF]
END

TO OP1 :WORD
OP MEMBERP :WORD [TIMES DIVBY SQUARE]
END

TO OP2 :WORD
OP MEMBERP :WORD [PLUS MINUS LESSTHAN PERCENT PERLESS]
END

TO OPDIFF :LEFT :RIGHT
OP (LIST "SUM :LEFT (LIST "MINUS :RIGHT))
END

TO OPERATORP :WORD
OP MEMBERP :WORD [SUM MINUS PRODUCT QUOTIENT EXPT SQUARE EQUAL]
END

TO OPFORM :EXPR
LOCAL [LEFT RIGHT OP]
IF MATCH [^LEFT !OP:OP2 #RIGHT] :EXPR [OP OPTEST :OP :LEFT :RIGHT]
IF MATCH [^LEFT !OP:OP1 #RIGHT] :EXPR [OP OPTEST :OP :LEFT :RIGHT]
IF MATCH [^LEFT !OP:OP0 #RIGHT] :EXPR [OP OPTEST :OP :LEFT :RIGHT]
IF MATCH [#LEFT !:DLM] :EXPR [MAKE "EXPR :LEFT]
OP NMTEST FILTER [NOT ARTICLE ?] :EXPR
END

TO OPREM :SENT
OP MAP [IFELSE EQUALP ? "NUMOF ["OF] [?]] :SENT
END

TO OPTEST :OP :LEFT :RIGHT
OP RUN (LIST (WORD "TST. :OP) :LEFT :RIGHT)
END

TO PARSE.SPECIAL :WORD :VAR
IF EMPTYP :WORD [OP LIST :VAR "ALWAYS]
IF EQUALP FIRST :WORD ": [OP LIST :VAR BF :WORD]
OP PARSE.SPECIAL BF :WORD WORD :VAR FIRST :WORD
END

TO PEERS :WHO
OUTPUT THING GPROP :WHO "CATEGORY
END

TO PERMS :N :R
IF EQUALP :R 0 [OUTPUT 1]
OUTPUT :N * PERMS :N-1 :R-1
END

TO PERSONP :WORD
OUTPUT MEMBERP :WORD [MARY ANN BILL FATHER UNCLE]
END

to pitagora
cs ht ppt rt 90 pu
setsc [200 100 100] setpc [0 0 0] setpensize [2 2] bk 100 pd
label [vnesi dolzino 1.katete, za neznanko vnesi 0] make "a rw cs
rt 90 pu bk 100 pd label [vnesi dolzino 2.katete, zaneznanko vnesi 0] make "b rw cs
rt 90 pu bk 100 pd label [vnesi dolzino hipotenuze, za neznanko vnesi 0]  make "c rw cs
make "x sqrt abs( :c* :c- :b* :b)
make "y sqrt abs( :c* :c- :a* :a)
make "z sqrt abs( :a* :a+ :b* :b)
rt 90 pu setxy 100 150 pd label [kateta 1 =] pu home rt 90 pu setxy 100 130 pd label [kateta 2 =] pu home
rt 90 pu setxy 100 110 pd label [hipoten. =] pu setxy 100 180 label [STRANICE :] home
 rt 90 pu setxy 200 150 pd ifelse :a=0 [label :x] [label :a] pu setxy 200 130 pd
 ifelse :b=0 [label :y] [label :b]  pu setxy 200 110 pd ifelse :c=0 [label :z] [label :c]
setpc [0 255 100] pu setxy -50 230 pd label [PITAGOROV IZREK]
pu home  lt 90 setpc [0 0 0] pd
 ifelse :b=0 [fd :y] [fd :b] rt 90
 ifelse :a=0 [fd :x] [fd :a]
if :c=0 [make "h arctan( :b/:a)] if :a=0 [make "h arctan( :b/:x)] if :b=0 [make "h arctan( :y/:a)]
 rt (180- :h)  ifelse :c=0 [fd :z] [fd :c]
home rt 90 pu sety -10 pd label [A] pu  ifelse :b=0 [bk (:y+5)] [bk (:b+5)] label [C]
pu lt 90 ifelse :a=0 [fd (:x+35)] [fd (:a+35)] pd rt 90 label [B]
 setpc [23 46 100] pu setxy 100 80 label [KOTI :] setxy 100 50 label [C = 90]
setxy 100 30 label [B =] setxy 140 30 label :h
make "g (90- :h) setxy 100 10 label [A =] setxy 140 10 label :g
setpc [0 0 0] pu home rt 90 sety -5 ifelse :b=0 [bk (:y/2+10)] [bk (:b/2+10)] label [k2]
 ifelse :b=0 [bk (:y/2+15)] [bk (:b/2+15)] lt 90  ifelse :a=0 [fd (:x/2-10)] [fd (:a/2-10)] label [k1]
pu home  rt (90+ :g)  ifelse :c=0 [bk (:z/2+10)] [bk (:c/2+10)] lt 90 fd 25 rt 90 label [h]
setfc [0 200 255] pu home
lt 90 ifelse :b=0 [fd :y] [fd :b] rt 135 fd 2 fill 

end

TO PLOT :INPUTS
KEYWORD :INPUTS [MAXHARM 5 DELTAX 3 YRANGE 75 CYCLES 1 XRANGE 230 SKIP 2]
MAKE "COEFF :CYCLES*(RADARCTAN -1 0)/:XRANGE
SS CS HT PU
SETPOS LIST (-:XRANGE) 0
PD
DRAW :DELTAX
END

TO PLURAL :WORD
LOCAL "PLURAL
MAKE "PLURAL GPROP :WORD "PLURAL
IF NOT EMPTYP :PLURAL [OP :PLURAL]
IF NOT EMPTYP GPROP :WORD "SING [OP :WORD]
IF EQUALP LAST :WORD "S [OP :WORD]
OP WORD :WORD "S
END

TO POSSPRO :WORD
OP MEMBERP :WORD [HIS HER ITS]
END

TO PRANS :ANS :SOLUTION
LOCAL "RESULT
MAKE "RESULT FIND [EQUALP FIRST ? FIRST :ANS] :SOLUTION
IF EMPTYP :RESULT [OP "TRUE]
PR (SE LAST :ANS "IS UNITSTRING LAST :RESULT)
PR []
OP "FALSE
END

TO PRANSWERS :ANS :SOLUTION
PR []
IF EQUALP :SOLUTION "UNSOLVABLE ~
   [PR [UNABLE TO SOLVE THIS SET OF EQUATIONS.] OP "FALSE]
IF EQUALP :SOLUTION "INSUFFICIENT ~
   [PR [THE EQUATIONS WERE INSUFFICIENT TO FIND A SOLUTION.] OP "FALSE]
LOCAL "GOTALL
MAKE "GOTALL "TRUE
FOREACH :ANS [IF PRANS ? :SOLUTION [MAKE "GOTALL "FALSE]]
IF NOT :GOTALL [PR [] PR [UNABLE TO SOLVE THIS SET OF EQUATIONS.]]
OP :GOTALL
END

TO PREMATCH :PAT :SEN [:CONSEC "TRUE]
IF EMPTYP :PAT [OP "TRUE]
IF LISTP FIRST :PAT [OP (PREMATCH BF :PAT :SEN "FALSE)]
IF MEMBERP FIRST FIRST :PAT [! @ # ^ & ?] [OP (PREMATCH BF :PAT :SEN "FALSE)]
IF EMPTYP :SEN [OP "FALSE]
IF EQUALP FIRST :PAT FIRST :SEN [OP (PREMATCH BF :PAT BF :SEN "TRUE)]
IF :CONSEC [OP "FALSE]
OP (PREMATCH :PAT BF :SEN "FALSE)
END

TO PROBLEM
CATEGORY "FIRST [JANE LARRY OPAL PERRY]
CATEGORY "LAST [IRVING KING MENDLE NATHAN]
CATEGORY "AGE [32 38 45 55]
CATEGORY "JOB [DRAFTER PILOT SERGEANT DRIVER]
DIFFER [JANE KING LARRY NATHAN]
SAYS "JANE "IRVING 45
SAYS "KING "PERRY "DRIVER
SAYS "LARRY "SERGEANT 45
SAYS "NATHAN "DRAFTER 38
DIFFER [MENDLE JANE OPAL NATHAN]
SAYS "MENDLE "PILOT "LARRY
SAYS "JANE "PILOT 45
SAYS "OPAL 55 "DRIVER
SAYS "NATHAN 38 "DRIVER
PRINT []
SOLUTION
END

TO PRONOUN :WORD
OP MEMBERP :WORD [HE SHE IT HIM HER THEY THEM HIS HER ITS]
END

TO QSET :SENT
LOCAL "OPFORM
MAKE "OPFORM OPFORM FILTER [NOT ARTICLE ?] :SENT
IF NOT OPERATORP FIRST :OPFORM ~
   [QUEUE "WANTED :OPFORM QUEUE "ANS LIST :OPFORM OPREM :SENT OP []]
LOCAL "GENSYM
MAKE "GENSYM GENSYM
QUEUE "WANTED :GENSYM
QUEUE "ANS LIST :GENSYM OPREM :SENT
OP (LIST "EQUAL :GENSYM OPFORM (FILTER [NOT ARTICLE ?] :SENT))
END

TO QUOTED :THING
IF LISTP :THING [OP :THING]
OP WORD "" :THING
END

TO QWORD :WORD
OP MEMBERP :WORD [FIND WHAT HOWM HOW]
END

TO REMFACTOR :NUM :DEN
FOREACH BF :NUM [REMFACTOR1 ?]
OP (LIST "QUOTIENT (SIMONE "PRODUCT BF :NUM) (SIMONE "PRODUCT BF :DEN))
END

TO REMFACTOR1 :EXPR
LOCAL "NEG
IF MEMBERP :EXPR :DEN ~
   [MAKE "NUM REMOVE :EXPR :NUM MAKE "DEN REMOVE :EXPR :DEN STOP]
MAKE "NEG MINUSIN :EXPR
IF NOT MEMBERP :NEG :DEN [STOP]
MAKE "NUM REMOVE :EXPR :NUM
MAKE "DEN MINUSIN REMOVE :NEG :DEN
END

TO REMOP :OPER :EXPRS
OP MAP.SE [IFELSE EQUALP FIRST ? :OPER [BF ?] [(LIST ?)]] :EXPRS
END

TO RMATCH :PAT :SEN
LOCAL [SPECIAL.VAR SPECIAL.PRED SPECIAL.BUFFER IN.LIST]
IF OR WORDP :PAT WORDP :SEN [OP "FALSE]
IF EMPTYP :PAT [OP EMPTYP :SEN]
IF LISTP FIRST :PAT [OP SPECIAL FPUT "!: :PAT :SEN]
IF MEMBERP FIRST FIRST :PAT [? # ! & @ ^] [OP SPECIAL :PAT :SEN]
IF EMPTYP :SEN [OP "FALSE]
IF EQUALP FIRST :PAT FIRST :SEN [OP RMATCH BF :PAT BF :SEN]
OP "FALSE
END

TO ROUNDOFF :NUM
IF (ABS (:NUM - ROUND :NUM)) < 0.0001 [OP ROUND :NUM]
OP :NUM
END

TO SAY :HERALD :TEXT
PR []
PR :HERALD
PR []
PR :TEXT
PR []
END

TO SAYS :WHO :WHAT1 :WHAT2
PRINT (LIST "SAYS :WHO :WHAT1 :WHAT2)
LINK :WHO :WHAT1 :WHAT2
LINK :WHO :WHAT2 :WHAT1
END

TO SENFORM :SENT
MAKE "LASTEQN SENFORM1 :SENT
OP :LASTEQN
END

TO SENFORM1 :SENT
LOCAL [ONE TWO VERB1 VERB2 STUFF1 STUFF2 FACTOR]
IF EMPTYP :SENT [OP []]
IF MATCH [^ WHAT ARE ^ONE AND ^TWO !:DLM] :SENT ~
   [OP FPUT (QSET :ONE) (SENFORM (SE [WHAT ARE] :TWO "?))]
IF MATCH [^ WHAT !:IN [IS ARE] #ONE !:DLM] :SENT ~
   [OP (LIST QSET :ONE)]
IF MATCH [^ HOWM !ONE IS #TWO !:DLM] :SENT ~
   [PUSH "AUNITS (LIST :ONE) OP (LIST QSET :TWO)]
IF MATCH [^ HOWM ^ONE DO ^TWO HAVE !:DLM] :SENT ~
   [OP (LIST QSET (SE [THE NUMBER OF] :ONE :TWO "HAVE))]
IF MATCH [^ HOWM ^ONE DOES ^TWO HAVE !:DLM] :SENT ~
   [OP (LIST QSET (SE [THE NUMBER OF] :ONE :TWO "HAS))]
IF MATCH [^ FIND ^ONE AND #TWO] :SENT ~
   [OP FPUT (QSET :ONE) (SENFORM SE "FIND :TWO)]
IF MATCH [^ FIND #ONE !:DLM] :SENT [OP (LIST QSET :ONE)]
MAKE "SENT FILTER [NOT ARTICLE ?] :SENT
IF MATCH [^ONE ISMULBY #TWO] :SENT ~
   [PUSH "REF (LIST "PRODUCT OPFORM :ONE OPFORM :TWO) OP []]
IF MATCH [^ONE ISDIVBY #TWO] :SENT ~
   [PUSH "REF (LIST "QUOTIENT OPFORM :ONE OPFORM :TWO) OP []]
IF MATCH [^ONE IS INCREASED BY #TWO] :SENT ~
   [PUSH "REF (LIST "SUM OPFORM :ONE OPFORM :TWO) OP []]
IF MATCH [^ONE IS #TWO] :SENT ~
   [OP (LIST (LIST "EQUAL OPFORM :ONE OPFORM :TWO))]
IF MATCH ~
     [^ONE !VERB1:VERB ^FACTOR AS MANY ^STUFF1 AS ^TWO !VERB2:VERB ^STUFF2 !:DLM] ~
     :SENT ~
   [IF EMPTYP :STUFF2 [MAKE "STUFF2 :STUFF1] ~
    OP (LIST (LIST "EQUAL ~
                   OPFORM (SE [THE NUMBER OF] :STUFF1 :ONE :VERB1) ~
                   OPFORM (SE :FACTOR [THE NUMBER OF] :STUFF2 :TWO :VERB2)))]
IF MATCH [^ONE !VERB1:VERB !FACTOR:NUMBERP #STUFF1 !:DLM] :SENT ~
   [OP (LIST (LIST "EQUAL ~
                   OPFORM (SE [THE NUMBER OF] :STUFF1 :ONE :VERB1) ~
                   OPFORM (LIST :FACTOR)))]
SAY [THIS SENTENCE FORM IS NOT RECOGNIZED:] :SENT
TOPLEVEL
END

TO SET.IN
MAKE "IN.LIST FIRST BF :PAT
MAKE "PAT FPUT FIRST :PAT BF BF :PAT
END

TO SET.SPECIAL :LIST
MAKE "SPECIAL.VAR FIRST :LIST
MAKE "SPECIAL.PRED LAST :LIST
IF EMPTYP :SPECIAL.VAR [MAKE "SPECIAL.VAR "SPECIAL.BUFFER]
IF MEMBERP :SPECIAL.PRED [IN ANYOF] [SET.IN]
IF NOT EMPTYP :SPECIAL.PRED [STOP]
MAKE "SPECIAL.PRED FIRST BF :PAT
MAKE "PAT FPUT FIRST :PAT BF BF :PAT
END

TO SETMINUS :BIG :LITTLE
OP FILTER [NOT MEMBERP ? :LITTLE] :BIG
END

TO SETUP.SIMPLE :LIST
MAKE FIRST :DEFAULTS FIRST :LIST
SETUP.VALUES BF :LIST
END

TO SETUP.VALUES :LIST
IF EMPTYP :LIST [STOP]
IF NUMBERP FIRST :LIST [SETUP.SIMPLE :LIST STOP]
MAKE FIRST :LIST FIRST BF :LIST
SETUP.VALUES BF BF :LIST
END

TO SIMDIV :LIST
LOCAL [NUM DEN NUMOP DENOP]
MAKE "NUM FIRST :LIST
MAKE "DEN LAST :LIST
IF EQUALP :NUM :DEN [OP 1]
IF NUMBERP :DEN [OP SIMTIMES (LIST (QUOTIENT 1 :DEN) :NUM)]
MAKE "NUMOP FIRST :NUM
MAKE "DENOP FIRST :DEN
IF EQUALP :NUMOP "QUOTIENT ~
   [OP SIMDIV LIST (FIRST BF :NUM) (SIMTIMES LIST LAST :NUM :DEN)]
IF EQUALP :DENOP "QUOTIENT ~
   [OP SIMDIV LIST (SIMTIMES LIST :NUM LAST :DEN) (FIRST BF :DEN)]
IF AND EQUALP :NUMOP "PRODUCT EQUALP :DENOP "PRODUCT [OP REMFACTOR :NUM :DEN]
IF AND EQUALP :NUMOP "PRODUCT MEMBERP :DEN :NUM [OP REMOVE :DEN :NUM]
OP FPUT "QUOTIENT :LIST
END

TO SIMONE :OPER :TRMS
IF EMPTYP :TRMS [OP IFELSE EQUALP :OPER "PRODUCT [1] [0]]
IF EMPTYP BF :TRMS [OP FIRST :TRMS]
OP FPUT :OPER :TRMS
END

TO SIMPLEX :BUTTONS
OUTPUT 2 * F :BUTTONS
END

TO SIMPLUS :EXPRS
MAKE "EXPRS REMOP "SUM :EXPRS
LOCAL "FACTOR
MAKE "FACTOR [UNKNOWN]
CATCH "SIMPLUS ~
      [FOREACH :TERMS ~
               [MAKE "FACTOR (FACTOR :EXPRS ?) ~
                IF NOT EQUALP FIRST :FACTOR "UNKNOWN [THROW "SIMPLUS]]]
IF NOT EQUALP FIRST :FACTOR "UNKNOWN [OP FPUT "PRODUCT REMOP "PRODUCT :FACTOR]
LOCAL [NUMS NONNUMS QUICK]
MAKE "NUMS 0
MAKE "NONNUMS []
MAKE "QUICK []
CATCH "SIMPLUS [SIMPLUS1 :EXPRS]
IF NOT EMPTYP :QUICK [OP :QUICK]
IF NOT EQUALP :NUMS 0 [PUSH "NONNUMS :NUMS]
OP SIMONE "SUM :NONNUMS
END

TO SIMPLUS1 :EXPRS
IF EMPTYP :EXPRS [STOP]
SIMPLUS2 FIRST :EXPRS
SIMPLUS1 BF :EXPRS
END

TO SIMPLUS2 :POS
LOCAL "NEG
MAKE "NEG MINUSIN :POS
IF NUMBERP :POS [MAKE "NUMS SUM :POS :NUMS STOP]
IF MEMBERP :NEG BF :EXPRS [MAKE "EXPRS REMOVE :NEG :EXPRS STOP]
IF EQUALP FIRST :POS "QUOTIENT ~
   [MAKE "QUICK (DENOM :POS (MAYBEADD :NUMS SE :NONNUMS BF :EXPRS)) ~
    THROW "SIMPLUS]
PUSH "NONNUMS :POS
END

TO SIMTIMES :EXPRS
LOCAL [NUMS NONNUMS QUICK]
MAKE "NUMS 1
MAKE "NONNUMS []
MAKE "QUICK []
CATCH "SIMTIMES [FOREACH REMOP "PRODUCT :EXPRS [SIMTIMES1 ?]]
IF NOT EMPTYP :QUICK [OP :QUICK]
IF EQUALP :NUMS 0 [OP 0]
IF NOT EQUALP :NUMS 1 [PUSH "NONNUMS :NUMS]
OP SIMONE "PRODUCT :NONNUMS
END

TO SIMTIMES1 :EXPR
IF EQUALP :EXPR 0 [MAKE "NUMS 0 THROW "SIMTIMES]
IF NUMBERP :EXPR [MAKE "NUMS PRODUCT :EXPR :NUMS STOP]
IF EQUALP FIRST :EXPR "SUM ~
   [MAKE "QUICK DISTRIBTIMES (BF :EXPR) ~
                             (SIMONE "PRODUCT MAYBEMUL :NUMS SE :NONNUMS ?REST) ~
    THROW "SIMTIMES]
IF EQUALP FIRST :EXPR "QUOTIENT ~
   [MAKE "QUICK ~
          SIMDIV (LIST (SIMTIMES (LIST (FIRST BF :EXPR) ~
                                       (SIMONE "PRODUCT ~
                                               MAYBEMUL :NUMS ~
                                                        SE :NONNUMS ?REST))) ~
                       (LAST :EXPR)) ~
    THROW "SIMTIMES]
PUSH "NONNUMS :EXPR
END

TO SINGULAR :WORD
LOCAL "SING
MAKE "SING GPROP :WORD "SING
IF NOT EMPTYP :SING [OP :SING]
IF NOT EMPTYP GPROP :WORD "PLURAL [OP :WORD]
IF EQUALP LAST :WORD "S [OP BL :WORD]
OP :WORD
END

TO SOCKS :LIST
LOCAL [TOTAL MATCHING]
MAKE "TOTAL COMBS (EXPAND :LIST) 2
MAKE "MATCHING FILTER [EQUALP FIRST ? LAST ?] :TOTAL
PR (SE [THERE ARE] COUNT :TOTAL [POSSIBLE PAIRS OF SOCKS.])
PR (SE [OF THESE,] COUNT :MATCHING [ARE MATCHING PAIRS.])
PR SE [PROBABILITY OF MATCH =] ~
      WORD (100 * (COUNT :MATCHING)/(COUNT :TOTAL)) "%
END

TO SOCKTEST
LOCAL [FIRST SECOND]
MAKE "FIRST PICK [BROWN BROWN BROWN BROWN BROWN BROWN BLUE BLUE BLUE BLUE]
MAKE "SECOND ~
     PICK (IFELSE EQUALP :FIRST "BROWN ~
                  [[BROWN BROWN BROWN BROWN BROWN BLUE BLUE BLUE BLUE]] ~
                  [[BROWN BROWN BROWN BROWN BROWN BROWN BLUE BLUE BLUE]])
OUTPUT EQUALP :FIRST :SECOND
END

TO SOLUTION
FOREACH THING FIRST :CATEGORIES [SOLVE1 ? BF :CATEGORIES]
END

TO SOLVE :WANTED :EQT :TERMS
OP SOLVE.REDUCE SOLVER :WANTED :TERMS [] [] "INSUFFICIENT
END

TO SOLVE.REDUCE :SOLN
IF EMPTYP :SOLN [OP []]
IF WORDP :SOLN [OP :SOLN]
IF EMPTYP BF :SOLN [OP :SOLN]
LOCAL "PART
MAKE "PART SOLVE.REDUCE BF :SOLN
OP FPUT (LIST (FIRST FIRST :SOLN) (SUBORD LAST FIRST :SOLN :PART)) :PART
END

TO SOLVE1 :X :TERMS :ALIS :EQNS :FAILED :ERR
LOCAL [THISEQ VARS EXTRAS XTERMS OTHERS RESULT]
IF EMPTYP :EQNS [OP :ERR]
MAKE "THISEQ SUBORD (FIRST :EQNS) :ALIS
MAKE "VARS VARTERMS :THISEQ
IF NOT MEMBERP :X :VARS ~
   [OP SOLVE1 :X :TERMS :ALIS (BF :EQNS) (FPUT FIRST :EQNS :FAILED) :ERR]
MAKE "XTERMS FPUT :X :TERMS
MAKE "EXTRAS SETMINUS :VARS :XTERMS
MAKE "EQT REMOVE (FIRST :EQNS) :EQT
IF NOT EMPTYP :EXTRAS ~
   [MAKE "OTHERS SOLVER :EXTRAS :XTERMS :ALIS [] "INSUFFICIENT ~
    IFELSE WORDP :OTHERS ~
           [MAKE "EQT SE :FAILED :EQNS ~
            OP SOLVE1 :X :TERMS :ALIS (BF :EQNS) ~
                      (FPUT FIRST :EQNS :FAILED) :OTHERS] ~
           [MAKE "ALIS :OTHERS ~
            MAKE "THISEQ SUBORD (FIRST :EQNS) :ALIS]]
MAKE "RESULT SOLVEQ :X :THISEQ
IF LISTP :RESULT [OP LPUT :RESULT :ALIS]
MAKE "EQT SE :FAILED :EQNS
OP SOLVE1 :X :TERMS :ALIS (BF :EQNS) (FPUT FIRST :EQNS :FAILED) :RESULT
END

TO SOLVEQ :VAR :EQN
LOCAL [LEFT RIGHT]
MAKE "LEFT FIRST BF :EQN
IFELSE OCCVAR :VAR :LEFT ~
   [MAKE "RIGHT LAST :EQN] [MAKE "RIGHT :LEFT MAKE "LEFT LAST :EQN]
OP SOLVEQ1 :LEFT :RIGHT "TRUE
END

TO SOLVEQ.MINUS
OP SOLVEQ1 (FIRST BF :LEFT) (MINUSIN :RIGHT) "FALSE
END

TO SOLVEQ.PRODUCT
OP SOLVEQ.PRODUCT1 :LEFT :RIGHT
END

TO SOLVEQ.PRODUCT1 :LEFT :RIGHT
IF EMPTYP BF BF :LEFT [OP SOLVEQ1 (FIRST BF :LEFT) :RIGHT "TRUE]
IF NOT OCCVAR :VAR FIRST BF :LEFT ~
   [OP SOLVEQ.PRODUCT1 (FPUT "PRODUCT BF BF :LEFT) ~
                       (DIVTERM :RIGHT FIRST BF :LEFT)]
LOCAL "REST
MAKE "REST SIMONE "PRODUCT BF BF :LEFT
IF OCCVAR :VAR :REST [OP "UNSOLVABLE]
OP SOLVEQ1 (FIRST BF :LEFT) (DIVTERM :RIGHT :REST) "FALSE
END

TO SOLVEQ.QUOTIENT
IF OCCVAR :VAR FIRST BF :LEFT ~
   [OP SOLVEQ1 (FIRST BF :LEFT) (SIMTIMES LIST :RIGHT LAST :LEFT) "TRUE]
OP SOLVEQ1 (SIMTIMES LIST :RIGHT LAST :LEFT) (FIRST BF :LEFT) "TRUE
END

TO SOLVEQ.RPLUS :LEFT :RIGHT :NEWRIGHT
IF EMPTYP :RIGHT [OP SOLVEQ1 :LEFT (SIMONE "SUM :NEWRIGHT) "FALSE]
IF OCCVAR :VAR FIRST :RIGHT ~
   [OP SOLVEQ.RPLUS (SUBTERM :LEFT FIRST :RIGHT) BF :RIGHT :NEWRIGHT]
OP SOLVEQ.RPLUS :LEFT BF :RIGHT (FPUT FIRST :RIGHT :NEWRIGHT)
END

TO SOLVEQ.SUM
IF EMPTYP BF BF :LEFT [OP SOLVEQ1 FIRST BF :LEFT :RIGHT "TRUE]
OP SOLVEQ.SUM1 BF :LEFT :RIGHT []
END

TO SOLVEQ.SUM1 :LEFT :RIGHT :NEWLEFT
IF EMPTYP :LEFT [OP SOLVEQ.SUM2]
IF OCCVAR :VAR FIRST :LEFT ~
   [OP SOLVEQ.SUM1 BF :LEFT :RIGHT FPUT FIRST :LEFT :NEWLEFT]
OP SOLVEQ.SUM1 BF :LEFT (SUBTERM :RIGHT FIRST :LEFT) :NEWLEFT
END

TO SOLVEQ.SUM2
IF EMPTYP BF :NEWLEFT [OP SOLVEQ1 FIRST :NEWLEFT :RIGHT "TRUE]
LOCAL "FACTOR
MAKE "FACTOR FACTOR :NEWLEFT :VAR
IF EQUALP FIRST :FACTOR "UNKNOWN [OP "UNSOLVABLE]
IF EQUALP LAST :FACTOR 0 [OP "UNSOLVABLE]
OP SOLVEQ1 FIRST :FACTOR (DIVTERM :RIGHT LAST :FACTOR) "TRUE
END

TO SOLVEQ1 :LEFT :RIGHT :BOTHTEST
IF :BOTHTEST [IF OCCVAR :VAR :RIGHT [OP SOLVEQBOTH :LEFT :RIGHT]]
IF EQUALP :LEFT :VAR [OP LIST :VAR :RIGHT]
IF WORDP :LEFT [OP "UNSOLVABLE]
LOCAL "OPER
MAKE "OPER FIRST :LEFT
IF MEMBERP :OPER [SUM PRODUCT MINUS QUOTIENT] [OP RUN (LIST WORD "SOLVEQ. :OPER)]
OP "UNSOLVABLE
END

TO SOLVEQBOTH :LEFT :RIGHT
IF NOT EQUALP FIRST :RIGHT "SUM [OP SOLVEQ1 (SUBTERM :LEFT :RIGHT) 0 "FALSE]
OP SOLVEQ.RPLUS :LEFT BF :RIGHT []
END

TO SOLVER :WANTED :TERMS :ALIS :FAILED :ERR
LOCAL [ONE RESULT RESTWANT]
IF EMPTYP :WANTED [OP :ERR]
MAKE "ONE SOLVE1 (FIRST :WANTED) ~
                 (SE BF :WANTED :FAILED :TERMS) :ALIS :EQT [] "INSUFFICIENT
IF WORDP :ONE ~
   [OP SOLVER (BF :WANTED) :TERMS :ALIS (FPUT FIRST :WANTED :FAILED) :ONE]
MAKE "RESTWANT (SE :FAILED BF :WANTED)
IF EMPTYP :RESTWANT [OP :ONE]
MAKE "RESULT SOLVER :RESTWANT :TERMS :ONE [] "INSUFFICIENT
IF LISTP :RESULT [OP :RESULT]
OP SOLVER (BF :WANTED) :TERMS :ALIS (FPUT FIRST :WANTED :FAILED) :ONE
END

to sounds
print mci [open c:/windows/media/chimes.wav type waveaudio alias wa]
print mci [open c:/windows/media/ding.wav type waveaudio alias w2] 
mci [seek wa to start] 
mci [play wa wait] 
repeat 2~
  [~
  mci [seek w2 to start]~
  mci [play w2 wait]~
  ]
mci [close w2] 
mci [seek wa to start] 
(mci [play wa notify] [mci [close wa]]) 
end

TO SPECIAL :PAT :SEN
SET.SPECIAL PARSE.SPECIAL BF FIRST :PAT "
OP RUN FPUT WORD "MATCH FIRST FIRST :PAT []
END

to spirala :x
ifelse  x<3 [fd 200 fd 500]
end

TO SQUARE :X
OP :X * :X
END

TO STORE :A :B :VAL
STOREINORDER :A :B :VAL :CATEGORIES
END

TO STOREINORDER :A :B :VAL :ORDER
IF EMPTYP :ORDER [PRINT (SE [UNKNOWN OBJECTS] :A :B) THROW "TOPLEVEL]
IF MEMBERP :A THING FIRST :ORDER [PPROP :A :B :VAL STOP]
IF MEMBERP :B THING FIRST :ORDER [PPROP :B :A :VAL STOP]
STOREINORDER :A :B :VAL BF :ORDER
END

TO STUDENT :PROB
LOCAL "ORGPROB
SAY [THE PROBLEM TO BE SOLVED IS] :PROB
MAKE "PROB MAP.SE [DEPUNCT ?] :PROB
MAKE "ORGPROB :PROB
STUDENT1 :PROB ~
         [[[THE PERIMETER OF ! RECTANGLE] ~
           [TWICE THE SUM OF THE LENGTH AND WIDTH OF THE RECTANGLE]] ~
          [[TWO NUMBERS] [ONE OF THE NUMBERS AND THE OTHER NUMBER]] ~
          [[TWO NUMBERS] [ONE NUMBER AND THE OTHER NUMBER]]]
END

TO STUDENT1 :PROB :IDIOMS
LOCAL [SIMSEN SHELF AUNITS UNITS WANTED ANS VAR LASTEQN ~
        REF EQT1 BEG END IDIOM REPLY]
MAKE "PROB IDIOMS :PROB
IF MATCH [^ TWO NUMBERS #] :PROB ~
   [MAKE "IDIOM FIND [MATCH (SE "^BEG FIRST ? "#END) :ORGPROB] :IDIOMS ~
    TRYIDIOM STOP]
WHILE [MATCH [^BEG THE THE #END] :PROB] [MAKE "PROB (SE :BEG "THE :END)]
SAY [WITH MANDATORY SUBSTITUTIONS THE PROBLEM IS] :PROB
IFELSE MATCH [# @:IN [[AS OLD AS] [AGE] [YEARS OLD]] #] :PROB ~
       [AGEPROB] [MAKE "SIMSEN BRACKET :PROB]
LSAY [THE SIMPLE SENTENCES ARE] :SIMSEN
MAKE "AUNITS []
MAKE "WANTED []
MAKE "ANS []
MAKE "VAR []
MAKE "LASTEQN []
MAKE "REF []
MAKE "UNITS []
MAKE "SHELF FILTER [NOT EMPTYP ?] MAP.SE [SENFORM ?] :SIMSEN
LSAY [THE EQUATIONS TO BE SOLVED ARE] :SHELF
MAKE "UNITS REMDUP :UNITS
IF TRYSOLVE :SHELF :WANTED :UNITS :AUNITS [PR [THE PROBLEM IS SOLVED.] STOP]
MAKE "EQT1 REMDUP GETEQNS :VAR
IF NOT EMPTYP :EQT1 [LSAY [USING THE FOLLOWING KNOWN RELATIONSHIPS] :EQT1]
STUDENT2 :EQT1
END

TO STUDENT2 :EQT1
MAKE "VAR REMDUP SE (MAP.SE [VARTERMS ?] :EQT1) :VAR
MAKE "EQT1 SE :EQT1 VARTEST :VAR
IF NOT EMPTYP :EQT1 ~
   [IF TRYSOLVE (SE :SHELF :EQT1) :WANTED :UNITS :AUNITS ~
       [PR [THE PROBLEM IS SOLVED.] STOP]]
MAKE "IDIOM FIND [MATCH (SE "^BEG FIRST ? "#END) :ORGPROB] :IDIOMS
IF NOT EMPTYP :IDIOM [TRYIDIOM STOP]
LSAY [DO YOU KNOW ANY MORE RELATIONSHIPS AMONG THESE VARIABLES?] :VAR
MAKE "REPLY RL
IF EQUALP :REPLY [YES] [PR [TELL ME.] MAKE "REPLY RL]
IF EQUALP :REPLY [NO] [PR [] PR [I CAN'T SOLVE THIS PROBLEM.] STOP]
MAKE "REPLY MAP.SE [DEPUNCT ?] :REPLY
IF DLM LAST :REPLY [MAKE "REPLY BL :REPLY]
IF NOT MATCH [^BEG IS #END] :REPLY [PR [I DON'T UNDERSTAND THAT.] STOP]
MAKE "SHELF SE :SHELF :EQT1
STUDENT2 (LIST (LIST "EQUAL OPFORM :BEG OPFORM :END))
END

TO SUBORD :EXPR :ALIST
OP DISTRIBX SUBORD1 :EXPR :ALIST
END

TO SUBORD1 :EXPR :ALIST
IF EMPTYP :ALIST [OP :EXPR]
OP SUBORD (SUBSTOP (LAST FIRST :ALIST) (FIRST FIRST :ALIST) :EXPR) ~
          (BF :ALIST)
END

TO SUBSTOP :VAL :VAR :EXPR
IF EMPTYP :EXPR [OP []]
IF EQUALP :EXPR :VAR [OP :VAL]
IF NOT OPERATORP FIRST :EXPR [OP :EXPR]
OP FPUT FIRST :EXPR MAP [SUBSTOP :VAL :VAR ?] BF :EXPR
END

TO SUBTERM :MINUEND :SUBTRAHEND
IF EQUALP :MINUEND 0 [OP MINUSIN :SUBTRAHEND]
IF EQUALP :MINUEND :SUBTRAHEND [OP 0]
OP SIMPLUS (LIST :MINUEND MINUSIN :SUBTRAHEND)
END

TO T :N :K
IF EQUALP :K 0 [OUTPUT 1]
IF EQUALP :N 0 [OUTPUT 0]
OUTPUT (T :N :K-1)+(T :N-1 :K)
END

TO THIS :EXPR
IF NOT EMPTYP :REF [OP POP "REF]
IF NOT EMPTYP :LASTEQN [OP FIRST BF LAST :LASTEQN]
IF EQUALP FIRST :EXPR "THIS [MAKE "EXPR BF :EXPR]
PUSH "VAR :EXPR
OP :EXPR
END

TO TRY.PRED
IF LISTP :SPECIAL.PRED [OP RMATCH :SPECIAL.PRED FIRST :SEN]
OP RUN LIST :SPECIAL.PRED QUOTED FIRST :SEN
END

TO TRYIDIOM
MAKE "PROB (SE :BEG LAST :IDIOM :END)
WHILE [MATCH (SE "^BEG FIRST :IDIOM "#END) :PROB] ~
      [MAKE "PROB (SE :BEG LAST :IDIOM :END)]
SAY [THE PROBLEM WITH AN IDIOMATIC SUBSTITUTION IS] :PROB
STUDENT1 :PROB (REMOVE :IDIOM :IDIOMS)
END

TO TRYSOLVE :SHELF :WANTED :UNITS :AUNITS
LOCAL "SOLUTION
MAKE "SOLUTION SOLVE :WANTED :SHELF (IFELSE EMPTYP :AUNITS [:UNITS] [:AUNITS])
OP PRANSWERS :ANS :SOLUTION
END

TO TST.DIFFERENCE :LEFT :RIGHT
LOCAL [ONE TWO]
IF MATCH [BETWEEN ^ONE AND #TWO] :RIGHT [OP OPDIFF OPFORM :ONE OPFORM :TWO]
SAY [INCORRECT USE OF DIFFERENCE:] :RIGHT
TOPLEVEL
END

TO TST.DIVBY :LEFT :RIGHT
OP (LIST "QUOTIENT OPFORM :LEFT OPFORM :RIGHT)
END

TO TST.LESSTHAN :LEFT :RIGHT
OP OPDIFF OPFORM :RIGHT OPFORM :LEFT
END

TO TST.MINUS :LEFT :RIGHT
IF EMPTYP :LEFT [OP LIST "MINUS OPFORM :RIGHT]
OP OPDIFF OPFORM :LEFT OPFORM :RIGHT
END

TO TST.MINUSS :LEFT :RIGHT
OP TST.MINUS :LEFT :RIGHT
END

TO TST.NUMOF :LEFT :RIGHT
IF NUMBERP LAST :LEFT [OP (LIST "PRODUCT OPFORM :LEFT OPFORM :RIGHT)]
OP OPFORM (SE :LEFT "OF :RIGHT)
END

TO TST.PER :LEFT :RIGHT
OP (LIST "QUOTIENT ~
          OPFORM :LEFT ~
          OPFORM (IFELSE NUMBERP FIRST :RIGHT [:RIGHT] [FPUT 1 :RIGHT]))
END

TO TST.PERCENT :LEFT :RIGHT
IF NOT NUMBERP LAST :LEFT ~
   [SAY [INCORRECT USE OF PERCENT:] :LEFT TOPLEVEL]
OP OPFORM (SE BL :LEFT ((LAST :LEFT) / 100) :RIGHT)
END

TO TST.PERLESS :LEFT :RIGHT
IF NOT NUMBERP LAST :LEFT ~
   [SAY [INCORRECT USE OF PERCENT:] :LEFT TOPLEVEL]
OP (LIST "PRODUCT ~
          (OPFORM SE BL :LEFT ((100 - (LAST :LEFT)) / 100)) ~
          OPFORM :RIGHT)
END

TO TST.PLUS :LEFT :RIGHT
OP (LIST "SUM OPFORM :LEFT OPFORM :RIGHT)
END

TO TST.PLUSS :LEFT :RIGHT
OP TST.PLUS :LEFT :RIGHT
END

TO TST.SQUARE :LEFT :RIGHT
OP LIST "SQUARE OPFORM :RIGHT
END

TO TST.SQUARED :LEFT :RIGHT
OP LIST "SQUARE OPFORM :LEFT
END

TO TST.SUM :LEFT :RIGHT
LOCAL [ONE TWO THREE]
IF MATCH [^ONE AND ^TWO AND #THREE] :RIGHT ~
   [OP (LIST "SUM OPFORM :ONE OPFORM (SE "SUM :TWO "AND :THREE))]
IF MATCH [^ONE AND #TWO] :RIGHT ~
   [OP (LIST "SUM OPFORM :ONE OPFORM :TWO)]
SAY [SUM USED WRONG:] :RIGHT
TOPLEVEL
END

TO TST.TIMES :LEFT :RIGHT
IF EMPTYP :LEFT [SAY [INCORRECT USE OF TIMES:] :RIGHT TOPLEVEL]
OP (LIST "PRODUCT OPFORM :LEFT OPFORM :RIGHT)
END

TO TST.TOTHEPOWER :LEFT :RIGHT
OP (LIST "EXPT OPFORM :LEFT OPFORM :RIGHT)
END

TO TWOTO :POWER
OUTPUT CASCADE :POWER [2 * ?] 1
END

to ukazi
make "myarray (array 3 0)
setitem 2 :myarray 1
setitem 1 :myarray 2
setitem 0 :myarray 3
show :myarray

end

to ulomek
cs ppt ht
pu rt 90 bk 250 pd
label [vpisi imenovalec ?]
make "n 360/rw
setpensize [2 2]
setfc [255 0 55]
cs setsc [0 255 255]
lt 90 
 ifelse :n=360 [arc 360 100] [arc 360- :n 100]
bk 100 fd 100 lt :n bk 100
pu home bk 10 pd
fill
pu fd 10 rt 90 fd 150 rt 90 pd
ifelse :n=360 [pu home pd] [arc :n 100
bk 100 fd 100  lt 360- :n bk 100]
pu rt 30 fd 10 pd
fill make "h 360/:n
pu home sety 150 pd rt 90 setpc [0 0 255]
label [DELI  CELOTE]
pu setpc [0 0 0]  setxy 250 -20  pd label [1] pu setxy 245 -25 pd label [__]
pu setxy 250 -45 pd label :h
pu home pd lt :n-90 repeat :h [fd 100 bk 100 lt :n]
end

TO UNITSTRING :EXPR
IF NUMBERP :EXPR [OP ROUNDOFF :EXPR]
IF EQUALP FIRST :EXPR "PRODUCT ~
   [OP SE (UNITSTRING FIRST BF :EXPR) (REDUCE "SE BF BF :EXPR)]
IF (AND (LISTP :EXPR) ~
         (NOT NUMBERP FIRST :EXPR) ~
         (NOT OPERATORP FIRST :EXPR)) ~
   [OP (SE 1 (SINGULAR FIRST :EXPR) (BF :EXPR))]
OP :EXPR
END

TO VAREQUAL :TARGET :VAR
PR []
PR [ASSUMING THAT]
PR (SE (LIST :TARGET) [IS EQUAL TO] (LIST :VAR))
OP (LIST "EQUAL :TARGET :VAR)
END

TO VARKEY :VAR
LOCAL "WORD
IF MATCH [NUMBER OF !WORD #] :VAR [OP :WORD]
OP FIRST :VAR
END

TO VARTERMS :EXPR
IF EMPTYP :EXPR [OP []]
IF NUMBERP :EXPR [OP []]
IF WORDP :EXPR [OP (LIST :EXPR)]
IF OPERATORP FIRST :EXPR [OP MAP.SE [VARTERMS ?] BF :EXPR]
OP (LIST :EXPR)
END

TO VARTEST :VARS
IF EMPTYP :VARS [OP []]
LOCAL [VAR BEG END]
MAKE "VAR FIRST :VARS
OP (SE (IFELSE MATCH [^BEG !:PRONOUN #END] :VAR ~
                 [VARTEST1 :VAR (SE :BEG "& :END) BF :VARS] ~
                 [[]]) ~
       (VARTEST1 :VAR (SE "# :VAR "#) BF :VARS) (VARTEST BF :VARS))
END

TO VARTEST1 :TARGET :PAT :VARS
OP MAP [VAREQUAL :TARGET ?] FILTER [MATCH :PAT ?] :VARS
END

TO VERB :WORD
OP MEMBERP :WORD [HAVE HAS GET GETS WEIGH WEIGHS]
END

TO VERIFY :WHO :WHAT
LOCAL "OLDVALUE
MAKE "OLDVALUE GET :WHO :WHAT
IF EQUALP :OLDVALUE "TRUE [STOP]
IF EQUALP :OLDVALUE "FALSE ~
   [PR (SE [INCONSISTENCY VERIFYING] :WHO "IS :WHAT) THROW "TOPLEVEL]
PR (LIST "VERIFY :WHO :WHAT)
STORE :WHO :WHAT "TRUE
PPROP :WHO (GPROP :WHAT "CATEGORY) :WHAT
PPROP :WHAT (GPROP :WHO "CATEGORY) :WHO
IF NOT EMPTYP :OLDVALUE [LINKTRUE :OLDVALUE]
FINDFALSE (PEERS :WHO) :WHAT
FINDFALSE (PEERS :WHAT) :WHO
FOREACH (GPROP :WHO "TRUTH) [VERIFY ? :WHAT]
FOREACH (GPROP :WHAT "TRUTH) [VERIFY :WHO ?]
FOREACH (GPROP :WHO "FALSEHOOD) [MAYBEFALSIFY ? :WHAT]
FOREACH (GPROP :WHAT "FALSEHOOD) [MAYBEFALSIFY :WHO ?]
PPROP :WHO "TRUTH (FPUT :WHAT GPROP :WHO "TRUTH)
PPROP :WHAT "TRUTH (FPUT :WHO GPROP :WHAT "TRUTH)
END

Make "a 0.617792946851381
Make "age [32 38 45 55]
Make "ann [MARY IS TWICE AS OLD AS ANN WAS WHEN MARY WAS AS OLD AS ANN IS NOW. IF MARY IS 24 YEARS OLD, HOW OLD IS ANN?]
Make "arg "boxes
Make "b 77
Make "backupselect [buttoncreate "main [Button1] [Button to be Push] [Print "Push] [40 -20 100 20]]
Make "boxisselected "false
Make "c 0
Make "categories [FIRST LAST AGE JOB]
Make "coeff 0.0136590984938687
Make "cycles 1
Make "deltax 3
Make "edgeisselected "false
Make "first [JANE LARRY OPAL PERRY]
Make "g 29.7448812969422
Make "groupisselected "false
Make "groupname [group1]
Make "guns [THE NUMBER OF SOLDIERS THE RUSSIANS HAVE IS ONE HALF OF THE NUMBER OF GUNS THEY HAVE. THEY HAVE 7000 GUNS. HOW MANY SOLDIERS DO THEY HAVE?]
Make "h 20
Make "h25 15
Make "h75 18.75
Make "hb 20
Make "hhh 20
Make "i 6
Make "jet [THE DISTANCE FROM NEW YORK TO LOS ANGELES IS 3000 MILES. IF THE AVERAGE SPEED OF A JET PLANE IS 600 MILES PER HOUR, FIND THE TIME IT TAKES TO TRAVEL FROM NEW YORK TO LOS ANGELES BY JET.]
Make "job [DRAFTER PILOT SERGEANT DRIVER]
Make "k 1
Make "kind "buttoncreate
Make "last [IRVING KING MENDLE NATHAN]
Make "main_x 200
Make "main_y 200
Make "master [[radiobuttoncreate "main [group1] [Radio1] [Radio Button] [60 -120 100 20]] [checkboxcreate "main [group1] [check1] [Check Box] [60 -160 100 20]] [scrollbarcreate "main [Scroll1] [Print "Scrolled] [40 -60 140 20]] [comboboxcreate "main [combo1] [40 -220 100 60]] [listboxcreate "main [list1] [40 -300 140 40]] [staticcreate "main [static1] [This is a static box] [40 -360 280 20]] [buttoncreate "main [Button1] [Button to Push] [Print "Push] [40 -20 100 20]]]
Make "master_group [[groupboxcreate "main [group1] [40 -100 140 100]]]
Make "mastermodule "boxes
Make "mastername "main
Make "maxharm 0.5
Make "mousedn "false
Make "myarray {3 2 1}@0
Make "n -210
Make "name []
Make "nums [A NUMBER IS MULTIPLIED BY 6 . THIS PRODUCT IS INCREASED BY 44 . THIS RESULT IS 68 . FIND THE NUMBER.]
Make "posd [75 -33]
Make "posm [75 -33]
Make "q -2.4453276721201
Make "radio [THE PRICE OF A RADIO IS $69.70. IF THIS PRICE IS 15 PERCENT LESS THAN THE MARKED PRICE, FIND THE MARKED PRICE.]
Make "sally [THE SUM OF SALLY'S SHARE OF SOME MONEY AND FRANK'S SHARE IS $4.50. SALLY'S SHARE IS TWICE FRANK'S. FIND FRANK'S AND SALLY'S SHARE.]
Make "select [buttoncreate "main [Button1] [Button to Push] [Print "Push] [40 -20 100 20]]
Make "ship [THE GROSS WEIGHT OF A SHIP IS 20000 TONS. IF ITS NET WEIGHT IS 15000 TONS, WHAT IS THE WEIGHT OF THE SHIPS CARGO?]
Make "skip 2
Make "slowmode "false
Make "snapbox [120 -24 120 24]
Make "span [IF 1 SPAN IS 9 INCHES, AND 1 FATHOM IS 6 FEET, HOW MANY SPANS IS 1 FATHOM?]
Make "sumtwo [THE SUM OF TWO NUMBERS IS 96, AND ONE NUMBER IS 16 LARGER THAN THE OTHER NUMBER. FIND THE TWO NUMBERS.]
Make "tempboxs [[comboboxcreate "dlg2 "cb21 [120 -24 120 24]] [comboboxcreate "dlg2 "cb22 [120 -72 120 24]] [staticcreate "dlg2 "st22 [Title] [24 -72 72 24]] [staticcreate "dlg2 "st21 [Callback] [24 -24 72 24]] [staticcreate "dlg2 "st23 [Name] [24 -120 72 24]] [buttoncreate "dlg2 "dlg2_OK [OK] [doclose2] [24 -264 96 24]] [buttoncreate "dlg2 "btn23 [Cancel] [dialogdelete "dlg2] [144 -264 96 24]] [comboboxcreate "dlg2 "cb23 [120 -120 120 24]] [comboboxcreate "dlg2 [cb24] [120 -168 120 24]] [buttoncreate "dlg2 "del [Delete] [deletething dialogdelete "dlg2] [72 -216 96 24]] [staticcreate "dlg2 [st24] [Group] [24 -168 72 24]]]
Make "the_cb [Print "Push]
Make "the_grid 24
Make "the_group "N/A
Make "the_last [40 -20 100 20]
Make "the_name [Button1]
Make "the_scale 2
Make "the_title [Button to Push]
Make "thebox [comboboxcreate "dlg2 "cb21 [120 -24 120 24]]
Make "title []
Make "tom [IF THE NUMBER OF CUSTOMERS TOM GETS IS TWICE THE SQUARE OF 20 PER CENT OF THE NUMBER OF ADVERTISEMENTS HE RUNS, AND THE NUMBER OF ADVERTISEMENTS HE RUNS IS 45, WHAT IS THE NUMBER OF CUSTOMERS TOM GETS?]
Make "trec [staticcreate "main [static1] [This is a static box] 20 180 140 10]
Make "uncle [BILL'S FATHER'S UNCLE IS TWICE AS OLD AS BILL'S FATHER. 2 YEARS FROM NOW BILL'S FATHER WILL BE 3 TIMES AS OLD AS BILL. THE SUM OF THEIR AGES IS 92 . FIND BILL'S AGE.]
Make "w 100
Make "w25 35
Make "w75 105
Make "wb 100
Make "whichone 3
Make "wholeisselected "false
Make "windowisselected "true
Make "www 95
Make "x 40
Make "xb 40
Make "xp 75
Make "xrange 230
Make "xrec []
Make "xxx 121
Make "y -20
Make "yb -20
Make "yp -33
Make "yrange 75
Make "yrec [Print "Push]
Make "yyy -168
Make "z 88.684835231284
Pprop 32 "CATEGORY "AGE
Pprop 32 "FALSEHOOD [NATHAN SERGEANT PERRY IRVING PILOT JANE DRAFTER MENDLE LARRY]
Pprop 32 "DRAFTER "FALSE
Pprop 32 "LAST "KING
Pprop 32 "PILOT "FALSE
Pprop 32 "SERGEANT "FALSE
Pprop 32 "DRIVER "TRUE
Pprop 32 "JOB "DRIVER
Pprop 32 "FIRST "OPAL
Pprop 32 "TRUTH [KING DRIVER OPAL]
Pprop 38 "CATEGORY "AGE
Pprop 38 "LAST "NATHAN
Pprop 38 "FALSEHOOD [KING DRIVER OPAL IRVING PILOT JANE DRAFTER MENDLE LARRY]
Pprop 38 "DRAFTER "FALSE
Pprop 38 "PILOT "FALSE
Pprop 38 "DRIVER "FALSE
Pprop 38 "SERGEANT "TRUE
Pprop 38 "JOB "SERGEANT
Pprop 38 "FIRST "PERRY
Pprop 38 "TRUTH [NATHAN SERGEANT PERRY]
Pprop 45 "CATEGORY "AGE
Pprop 45 "FALSEHOOD [SERGEANT PERRY NATHAN OPAL KING DRIVER PILOT IRVING JANE]
Pprop 45 "PILOT "FALSE
Pprop 45 "FIRST "LARRY
Pprop 45 "DRIVER "FALSE
Pprop 45 "LAST "MENDLE
Pprop 45 "TRUTH [DRAFTER LARRY MENDLE]
Pprop 45 "DRAFTER "TRUE
Pprop 45 "JOB "DRAFTER
Pprop 45 "SERGEANT "FALSE
Pprop 55 "CATEGORY "AGE
Pprop 55 "DRIVER "FALSE
Pprop 55 "FALSEHOOD [NATHAN SERGEANT PERRY DRAFTER MENDLE LARRY OPAL KING DRIVER]
Pprop 55 "DRAFTER "FALSE
Pprop 55 "LAST "IRVING
Pprop 55 "SERGEANT "FALSE
Pprop 55 "PILOT "TRUE
Pprop 55 "JOB "PILOT
Pprop 55 "FIRST "JANE
Pprop 55 "TRUTH [IRVING PILOT JANE]
Pprop "distance "EQNS [[EQUAL [DISTANCE] [PRODUCT [SPEED] [TIME]]] [EQUAL [DISTANCE] [PRODUCT [GAS CONSUMTION] [NUMBER OF GALLONS OF GAS USED]]]]
Pprop "drafter "CATEGORY "JOB
Pprop "drafter "FALSEHOOD [NATHAN 55 38 32 PERRY IRVING JANE OPAL KING]
Pprop "drafter "LAST "MENDLE
Pprop "drafter "FIRST "LARRY
Pprop "drafter "AGE 45
Pprop "drafter "TRUTH [MENDLE LARRY 45]
Pprop "driver "CATEGORY "JOB
Pprop "driver "LAST "KING
Pprop "driver "FALSEHOOD [38 45 55 PERRY NATHAN MENDLE LARRY IRVING JANE]
Pprop "driver "TRUTH [32 OPAL KING]
Pprop "driver "FIRST "OPAL
Pprop "driver "AGE 32
Pprop "feet "EQNS [[EQUAL [PRODUCT 1 [FEET]] [PRODUCT 12 [INCHES]]] [EQUAL [PRODUCT 1 [YARDS]] [PRODUCT 3 [FEET]]]]
Pprop "feet "SING "FOOT
Pprop "foot "PLURAL "FEET
Pprop "gallons "EQNS [[EQUAL [DISTANCE] [PRODUCT [GAS CONSUMTION] [NUMBER OF GALLONS OF GAS USED]]]]
Pprop "gas "EQNS [[EQUAL [DISTANCE] [PRODUCT [GAS CONSUMTION] [NUMBER OF GALLONS OF GAS USED]]]]
Pprop "inch "PLURAL "INCHES
Pprop "inches "EQNS [[EQUAL [PRODUCT 1 [FEET]] [PRODUCT 12 [INCHES]]]]
Pprop "irving "CATEGORY "LAST
Pprop "irving "FIRST "JANE
Pprop "irving "FALSEHOOD [32 38 SERGEANT DRAFTER DRIVER 45 PERRY OPAL LARRY]
Pprop "irving 45 "FALSE
Pprop "irving "TRUTH [55 PILOT JANE]
Pprop "irving "DRIVER "FALSE
Pprop "irving "PILOT "TRUE
Pprop "irving "JOB "PILOT
Pprop "irving "DRAFTER "FALSE
Pprop "irving "SERGEANT "FALSE
Pprop "irving 38 "FALSE
Pprop "irving 32 "FALSE
Pprop "irving 55 "TRUE
Pprop "irving "AGE 55
Pprop "jane "CATEGORY "FIRST
Pprop "jane "KING "FALSE
Pprop "jane "FALSEHOOD [32 38 SERGEANT DRAFTER DRIVER MENDLE 45 NATHAN KING]
Pprop "jane "NATHAN "FALSE
Pprop "jane "IRVING "TRUE
Pprop "jane 45 "FALSE
Pprop "jane "MENDLE "FALSE
Pprop "jane "LAST "IRVING
Pprop "jane "TRUTH [55 PILOT IRVING]
Pprop "jane "DRIVER "FALSE
Pprop "jane "PILOT "TRUE
Pprop "jane "JOB "PILOT
Pprop "jane "DRAFTER "FALSE
Pprop "jane "SERGEANT "FALSE
Pprop "jane 38 "FALSE
Pprop "jane 32 "FALSE
Pprop "jane 55 "TRUE
Pprop "jane "AGE 55
Pprop "king "CATEGORY "LAST
Pprop "king "FALSEHOOD [38 45 55 PERRY SERGEANT PILOT DRAFTER LARRY JANE]
Pprop "king "DRIVER "TRUE
Pprop "king "JOB "DRIVER
Pprop "king "DRAFTER "FALSE
Pprop "king "PILOT "FALSE
Pprop "king "SERGEANT "FALSE
Pprop "king "TRUTH [32 OPAL DRIVER]
Pprop "king "FIRST "OPAL
Pprop "king 55 "FALSE
Pprop "king 45 "FALSE
Pprop "king 38 "FALSE
Pprop "king 32 "TRUE
Pprop "king "AGE 32
Pprop "larry "CATEGORY "FIRST
Pprop "larry "KING "FALSE
Pprop "larry "FALSEHOOD [SERGEANT 55 38 32 PILOT DRIVER IRVING NATHAN KING]
Pprop "larry "NATHAN "FALSE
Pprop "larry "SERGEANT "FALSE
Pprop "larry 45 "TRUE
Pprop "larry "IRVING "FALSE
Pprop "larry "MENDLE "TRUE
Pprop "larry "LAST "MENDLE
Pprop "larry "TRUTH [DRAFTER 45 MENDLE]
Pprop "larry "DRIVER "FALSE
Pprop "larry "PILOT "FALSE
Pprop "larry "AGE 45
Pprop "larry 32 "FALSE
Pprop "larry 38 "FALSE
Pprop "larry 55 "FALSE
Pprop "larry "DRAFTER "TRUE
Pprop "larry "JOB "DRAFTER
Pprop "mendle "CATEGORY "LAST
Pprop "mendle "FIRST "LARRY
Pprop "mendle "FALSEHOOD [SERGEANT 55 38 32 PILOT DRIVER JANE PERRY OPAL]
Pprop "mendle "TRUTH [DRAFTER 45 LARRY]
Pprop "mendle "DRIVER "FALSE
Pprop "mendle "PILOT "FALSE
Pprop "mendle "DRAFTER "TRUE
Pprop "mendle "JOB "DRAFTER
Pprop "mendle "SERGEANT "FALSE
Pprop "mendle 45 "TRUE
Pprop "mendle "AGE 45
Pprop "mendle 32 "FALSE
Pprop "mendle 38 "FALSE
Pprop "mendle 55 "FALSE
Pprop "nathan "CATEGORY "LAST
Pprop "nathan "FALSEHOOD [32 55 DRAFTER 45 PILOT OPAL DRIVER LARRY JANE]
Pprop "nathan "DRAFTER "FALSE
Pprop "nathan 38 "TRUE
Pprop "nathan "FIRST "PERRY
Pprop "nathan "DRIVER "FALSE
Pprop "nathan "TRUTH [38 SERGEANT PERRY]
Pprop "nathan "PILOT "FALSE
Pprop "nathan "AGE 38
Pprop "nathan "SERGEANT "TRUE
Pprop "nathan "JOB "SERGEANT
Pprop "nathan 45 "FALSE
Pprop "nathan 55 "FALSE
Pprop "nathan 32 "FALSE
Pprop "opal "CATEGORY "FIRST
Pprop "opal "MENDLE "FALSE
Pprop "opal "FALSEHOOD [38 45 55 NATHAN SERGEANT PILOT DRAFTER IRVING MENDLE]
Pprop "opal "IRVING "FALSE
Pprop "opal "NATHAN "FALSE
Pprop "opal "KING "TRUE
Pprop "opal "LAST "KING
Pprop "opal "DRIVER "TRUE
Pprop "opal "JOB "DRIVER
Pprop "opal "DRAFTER "FALSE
Pprop "opal "PILOT "FALSE
Pprop "opal "SERGEANT "FALSE
Pprop "opal "TRUTH [32 KING DRIVER]
Pprop "opal 55 "FALSE
Pprop "opal 45 "FALSE
Pprop "opal 38 "FALSE
Pprop "opal 32 "TRUE
Pprop "opal "AGE 32
Pprop "people "SING "PERSON
Pprop "perry "CATEGORY "FIRST
Pprop "perry "KING "FALSE
Pprop "perry "MENDLE "FALSE
Pprop "perry "FALSEHOOD [32 55 DRAFTER 45 PILOT KING DRIVER IRVING MENDLE]
Pprop "perry "IRVING "FALSE
Pprop "perry "NATHAN "TRUE
Pprop "perry "LAST "NATHAN
Pprop "perry "DRIVER "FALSE
Pprop "perry "TRUTH [38 SERGEANT NATHAN]
Pprop "perry "PILOT "FALSE
Pprop "perry "SERGEANT "TRUE
Pprop "perry "JOB "SERGEANT
Pprop "perry 45 "FALSE
Pprop "perry "DRAFTER "FALSE
Pprop "perry 55 "FALSE
Pprop "perry 38 "TRUE
Pprop "perry "AGE 38
Pprop "perry 32 "FALSE
Pprop "person "PLURAL "PEOPLE
Pprop "pilot "CATEGORY "JOB
Pprop "pilot "FALSEHOOD [32 38 PERRY NATHAN 45 MENDLE LARRY OPAL KING]
Pprop "pilot "FIRST "JANE
Pprop "pilot "LAST "IRVING
Pprop "pilot "TRUTH [55 JANE IRVING]
Pprop "pilot "AGE 55
Pprop "sergeant "CATEGORY "JOB
Pprop "sergeant "FALSEHOOD [32 55 MENDLE LARRY 45 IRVING JANE OPAL KING]
Pprop "sergeant "LAST "NATHAN
Pprop "sergeant "FIRST "PERRY
Pprop "sergeant "TRUTH [38 NATHAN PERRY]
Pprop "sergeant "AGE 38
Pprop "speed "EQNS [[EQUAL [DISTANCE] [PRODUCT [SPEED] [TIME]]]]
Pprop "time "EQNS [[EQUAL [DISTANCE] [PRODUCT [SPEED] [TIME]]]]
Pprop "yards "EQNS [[EQUAL [PRODUCT 1 [YARDS]] [PRODUCT 3 [FEET]]]]