diff options
Diffstat (limited to 'js/games/nluqo.github.io/~bh/downloads/csls-programs')
29 files changed, 6515 insertions, 0 deletions
diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/Makefile.am b/js/games/nluqo.github.io/~bh/downloads/csls-programs/Makefile.am new file mode 100644 index 0000000..4b015f2 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/Makefile.am @@ -0,0 +1,5 @@ +cslsdir=$(pkgdatadir)/csls + +dist_csls_DATA = algs basic buttons cards crypto diff doctor dotgame \ + format fsm master match math mines multi pascal playfair plot poker \ + pour psort solitaire streams student tower ttt diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/basic b/js/games/nluqo.github.io/~bh/downloads/csls-programs/basic new file mode 100644 index 0000000..499461b --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/basic @@ -0,0 +1,235 @@ +to basic +make "linenumbers [] +make "readline [] +forever [basicprompt] +end + +to basicprompt +print [] +print "READY +print [] +make "line basicread +if emptyp :line [stop] +ifelse numberp first :line [compile split :line] [immediate :line] +end + +to compile :commands +make "number first :commands +make :number :line +ifelse emptyp butfirst :commands ~ + [eraseline :number] ~ + [makedef (word "basic% :number) butfirst :commands] +end + +to makedef :name :commands +make "definition [[]] +foreach :commands [run list (word "compile. first ?) ?] +queue "definition (list "nextline :number) +define :name :definition +make "linenumbers insert :number :linenumbers +end + +to insert :num :list +if emptyp :list [output (list :num)] +if :num = first :list [output :list] +if :num < first :list [output fput :num :list] +output fput first :list (insert :num butfirst :list) +end + +to eraseline :num +make "linenumbers remove :num :linenumbers +end + +to immediate :line +if equalp :line [list] [foreach :linenumbers [print thing ?] stop] +if equalp :line [run] [run (list (word "basic% first :linenumbers)) stop] +if equalp :line [exit] [throw "toplevel] +print sentence [Invalid command:] :line +end + +;; Compiling each BASIC command + +to compile.end :command +queue "definition [stop] +end + +to compile.goto :command +queue "definition (list (word "basic% last :command) "stop) +end + +to compile.gosub :command +queue "definition (list (word "basic% last :command)) +end + +to compile.return :command +queue "definition [stop] +end + +to compile.print :command +make "command butfirst :command +while [not emptyp :command] [c.print1] +queue "definition [print []] +end + +to c.print1 +make "exp expression +ifelse equalp first first :exp "" ~ + [make "sym gensym + make word "%% :sym butfirst butlast first :exp + queue "definition list "type word ":%% :sym] ~ + [queue "definition fput "type :exp] +if emptyp :command [stop] +make "delimiter pop "command +if equalp :delimiter ", [queue "definition [type char 9] stop] +if equalp :delimiter "\; [stop] +(throw "error [Comma or semicolon needed in print.]) +end + +to compile.input :command +make "command butfirst :command +if equalp first first :command "" ~ + [make "sym gensym + make "prompt pop "command + make word "%% :sym butfirst butlast :prompt + queue "definition list "type word ":%% :sym] +while [not emptyp :command] [c.input1] +end + +to c.input1 +make "var pop "command +queue "definition (list "make (word ""% :var) "readvalue) +if emptyp :command [stop] +make "delimiter pop "command +if equalp :delimiter ", [stop] +(throw "error [Comma needed in input.]) +end + +to compile.let :command +make "command butfirst :command +make "var pop "command +make "delimiter pop "command +if not equalp :delimiter "= [(throw "error [Need = in let.])] +make "exp expression +queue "definition (sentence "make (word ""% :var) :exp) +end + +to compile.if :command +make "command butfirst :command +make "exp expression +make "delimiter pop "command +if not equalp :delimiter "then [(throw "error [Need then after if.])] +queue "definition (sentence "if :exp (list c.if1)) +end + +to c.if1 +local "definition +make "definition [[]] +run list (word "compile. first :command) :command +ifelse (count :definition) = 2 ~ + [output last :definition] ~ + [make "newname word "% gensym + define :newname :definition + output (list :newname)] +end + +to compile.for :command +make "command butfirst :command +make "var pop "command +make "delimiter pop "command +if not equalp :delimiter "= [(throw "error [Need = after for.])] +make "start expression +make "delimiter pop "command +if not equalp :delimiter "to [(throw "error [Need to after for.])] +make "end expression +queue "definition (sentence "make (word ""% :var) :start) +queue "definition (sentence "make (word ""let% :var) :end) +make "newname word "% gensym +queue "definition (sentence "make (word ""next% :var) (list (list :newname))) +queue "definition (list :newname) +define :name :definition +make "name :newname +make "definition [[]] +end + +to compile.next :command +make "command butfirst :command +make "var pop "command +queue "definition (sentence "make (word ""% :var) (word ":% :var) [+ 1]) +queue "definition (sentence [if not greaterp] + (word ":% :var) (word ":let% :var) + (list (list "run (word ":next% :var) "stop))) +end + +;; Compile an expression for LET, IF, PRINT, or FOR + +to expression +make "expr [] +make "token expr1 +while [not emptyp :token] [queue "expr :token + make "token expr1] +output :expr +end + +to expr1 +if emptyp :command [output []] +make "token pop "command +if memberp :token [+ - * / = < > ( )] [output :token] +if memberp :token [, \; : then to] [push "command :token output []] +if numberp :token [output :token] +if equalp first :token "" [output :token] +output word ":% :token +end + +;; reading input + +to basicread +output basicread1 readword [] " +end + +to basicread1 :input :output :token +if emptyp :input [if not emptyp :token [push "output :token] + output reverse :output] +if equalp first :input "| | [if not emptyp :token [push "output :token] + output basicread1 (butfirst :input) :output "] +if equalp first :input "" [if not emptyp :token [push "output :token] + output breadstring butfirst :input :output "] +if memberp first :input [+ - * / = < > ( ) , \; :] ~ + [if not emptyp :token [push "output :token] + output basicread1 (butfirst :input) (fput first :input :output) "] +output basicread1 (butfirst :input) :output (word :token first :input) +end + +to breadstring :input :output :string +if emptyp :input [(throw "error [String needs ending quote.])] +if equalp first :input "" ~ + [output basicread1 (butfirst :input) + (fput (word "" :string "") :output) + "] +output breadstring (butfirst :input) :output (word :string first :input) +end + +to split :line +output fput first :line split1 (butfirst :line) [] [] +end + +to split1 :input :output :command +if emptyp :input [if not emptyp :command [push "output reverse :command] + output reverse :output] +if equalp first :input ": [if not emptyp :command + [push "output reverse :command] + output split1 (butfirst :input) :output []] +output split1 (butfirst :input) :output (fput first :input :command) +end + +;; Runtime library + +to nextline :num +make "target member :num :linenumbers +if not emptyp :target [make "target butfirst :target] +if not emptyp :target [run (list (word "basic% first :target))] +end + +to readvalue +while [emptyp :readline] [make "readline basicread] +output pop "readline +end diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/buttons b/js/games/nluqo.github.io/~bh/downloads/csls-programs/buttons new file mode 100644 index 0000000..d5527b1 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/buttons @@ -0,0 +1,211 @@ +;;; Primitive GUI for Logo games. + +;;; Displays buttons, then accepts mouseclicks or keystrokes +;;; to control actions. + +;;; To clear the screen and all the remembered buttons: +;;; init.buttons + +;;; To install a button: +;;; SETBUTTON [150 130] [40 25] [make "mysecret "true throw "newgame] ~ +;;; :mysecret 0 [Logo guess] [] +;;; +;;; Inputs are: +;;; 1. Position of lower left corner of button +;;; 2. Size [x y] of button +;;; 3. Action to take if button pressed +;;; 4. TRUE if box should be drawn thick, FALSE if thin +;;; 5. Color to fill box (0 if no fill) +;;; 6. Text caption inside button (a word or a two-word list for +;;; a two-line caption) or empty list for no caption +;;; 7. Equivalent keystroke (empty list if no equivalent keystroke) +;;; (DEL means char 8 or 127; RET means char 10 or 13) +;;; (Keystroke inside list, e.g., [X], means don't draw it.) + +;;; REBUTTON (same inputs as SETBUTTON) looks for existing matching button +;;; and, if found, just redraws border (possibly changing thickness). + +;;; To display a descriptive caption (e.g., for a group of buttons) +;;; without making a button: +;;; CAPTION [150 130] [40 25] [Number |of boxes:|] +;;; CENTER.CAPTION [150 130] [40 25] [Number |of boxes:|] +;;; +;;; Inputs are position, size, caption. +;;; CENTER.CAPTION centers the text within the box; CAPTION puts it +;;; at the left edge of the box. + +;;; To loop reading keystrokes or mouseclicks and taking actions as set: +;;; ACTION.LOOP +;;; Within an action, :CHAR is the character typed (or zero if the action +;;; was triggered by a mouse click), :BUTTON is the mouse button pressed +;;; (or zero if the action was triggered by a keystroke), and :MOUSEPOS is +;;; the mouse position (or unspecified for a keystroke). Actions triggered +;;; by a mouse click happen when the mouse button is released. + +; ----------------------------- + +;;; IMPORTANT: Here is how we know the size of a text character as +;;; drawn by the LABEL command. Change these numbers if necessary: + +make "labelcharsize ifelse equalp :LogoPlatform "Windows [[8 13]] [[6 11]] +; if equalp :LogoPlatform "wxWidgets [make "labelcharsize [7 14]] +if equalp :LogoPlatform "wxWidgets [make "labelcharsize labelsize] + +; ----------------------------- + +to init.buttons +cs ht +make "buttons [] +end + +; ----------------------------- + +to setbutton :corner :size :action :thickp :fillcolor :caption :key +center.caption :corner :size :caption +pu setpos :corner +seth 0 +pd setpensize ifelse :thickp [[3 3]] [[1 1]] +setpc 7 +apply "button.rectangle :size +setpensize [1 1] +if not equalp :fillcolor 0 [ + button.offset :corner 5 5 + setpc :fillcolor + fill + setpc 7 +] +if (and (not listp :key) (not emptyp :key) (not equalp :key :caption)) [ + caption (list (sum first :corner first :size 4) last :corner) ~ + (list (first :labelcharsize) (last :size)) ~ + :key +] +if and (listp :key) (not emptyp :key) [make "key first :key] +push "buttons (list :corner :size :key :action) +end + +to rebutton :corner :size :action :thickp :fillcolor :caption :key +localmake "thekey :key +if and listp :key not emptyp :key [make "thekey first :key] +localmake "test (list :corner :size :thekey :action) +localmake "button find [equalp ? :test] :buttons +if emptyp :button ~ + [setbutton :corner :size :action :thickp :fillcolor :caption :key stop] +penup setpos :corner +seth 0 +setpc 7 +penerase setpensize [3 3] +apply "button.rectangle :size +penpaint setpensize ifelse :thickp [[3 3]] [[1 1]] +apply "button.rectangle :size +setpensize [1 1] +end + +to button.offset :corner :dx :dy +penup setxy (first :corner)+:dx (last :corner)+:dy +end + +to button.rectangle :x :y +repeat 2 [fd :y rt 90 fd :x rt 90] +end + +; ----------------------------- + +to caption :corner :size :caption +if emptyp :caption [stop] +localmake "oldscrunch scrunch +if not namep "caption.scrunch [localmake "caption.scrunch 1] +localmake "myscrunch map [? * :caption.scrunch] :oldscrunch +localmake "y (last :labelcharsize)*:caption.scrunch +setpc 7 +ifelse listp :caption [ + button.offset :corner 0 ((14-:y)+((last :size)-25)/3) + if :caption.scrunch <> 1 [apply "setscrunch :myscrunch] + label last :caption + if :caption.scrunch <> 1 [apply "setscrunch :oldscrunch] + button.offset :corner 0 ((14-:y)+:y+2*((last :size)-25)/3) + if :caption.scrunch <> 1 [apply "setscrunch :myscrunch] + label first :caption + if :caption.scrunch <> 1 [apply "setscrunch :oldscrunch] +] [ + button.offset :corner 0 ((17-:y)+((last :size)-17)/2) + if :caption.scrunch <> 1 [apply "setscrunch :myscrunch] + label :caption + if :caption.scrunch <> 1 [apply "setscrunch :oldscrunch] +] +end + +to center.caption :corner :size :caption +if emptyp :caption [stop] +localmake "oldscrunch scrunch +if not namep "caption.scrunch [localmake "caption.scrunch 1] +localmake "myscrunch map [? * :caption.scrunch] :oldscrunch +localmake "halfx (first :labelcharsize)*:caption.scrunch/2 +localmake "y (last :labelcharsize)*:caption.scrunch +setpc 7 +ifelse listp :caption [ + button.offset :corner (1+(first :size)/2-:halfx*(count last :caption)) ~ + ((14-:y)+((last :size)-25)/3) + if :caption.scrunch <> 1 [apply "setscrunch :myscrunch] + label last :caption + if :caption.scrunch <> 1 [apply "setscrunch :oldscrunch] + button.offset :corner (1+(first :size)/2-:halfx*(count first :caption)) ~ + ((14-:y)+:y+2*((last :size)-25)/3) + if :caption.scrunch <> 1 [apply "setscrunch :myscrunch] + label first :caption + if :caption.scrunch <> 1 [apply "setscrunch :oldscrunch] +] [ + button.offset :corner (1+(first :size)/2-:halfx*(count :caption)) ~ + ((17-:y)+((last :size)-17)/2) + if :caption.scrunch <> 1 [apply "setscrunch :myscrunch] + label :caption + if :caption.scrunch <> 1 [apply "setscrunch :oldscrunch] +] +end + +; ----------------------------- + +to action.loop [:buttonact [button.mouseclick]] [:keyact [button.readkey]] +action.once +forever [wait 100] +end + +to action.off +ern [buttonact keyact] +ern "keyact +end + +to action.once +if keyp [button.readkey] +if buttonp [button.mouseclick] +end + +to button.readkey [:char rc] [:button 0] [:buttonact []] [:keyact []] +foreach :buttons [ + localmake "key item 3 ? + ifelse equalp :key "DEL [ + if memberp (ascii :char) [8 127] [run last ? action.once stop] + ] [ + ifelse equalp :key "RET [ + if memberp (ascii :char) [10 13] [run last ? action.once stop] + ] [ + if equalp :char :key [run last ? action.once stop] + ] + ] +] +end + +to button.mouseclick [:mousepos clickpos] [:button button] [:char 0] ~ + [:buttonact []] [:keyact []] +while [buttonp] [] ; wait for release of button +foreach :buttons [ + if apply "button.inrange ? [run last ? action.once stop] +] +end + +to button.inrange :corner :size :key :action +(foreach :mousepos :corner :size [ + if ?1 < ?2 [output "false] + if ?1 > (?2 + ?3) [output "false] +]) +output "true +end diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/cards b/js/games/nluqo.github.io/~bh/downloads/csls-programs/cards new file mode 100644 index 0000000..e0df3c6 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/cards @@ -0,0 +1,63 @@ +program cards; + {Shuffle a deck of cards} + +var ranks:array [0..51] of integer; + suits:array [0..51] of char; + i:integer; + +procedure showdeck; + {Print the deck arrays} + + begin {showdeck} + for i := 0 to 51 do + begin + if i mod 13 = 0 then writeln; + write(ranks[i]:3,suits[i]); + end; + writeln; + writeln + end; {showdeck} + +procedure deck; + {Create the deck in order} + + var i,j:integer; + suitnames:packed array [0..3] of char; + + begin {deck} + suitnames := 'HSDC'; + for i := 0 to 12 do + for j := 0 to 3 do + begin + ranks[13*j+i] := i+1; + suits[13*j+i] := suitnames[j] + end; + writeln('The initial deck:'); + showdeck + end; {deck} + +procedure shuffle; + {Shuffle the deck randomly} + + var rank,i,j:integer; + suit:char; + + begin {shuffle} + for i := 51 downto 1 do {For each card in the deck} + begin + j := random(i+1); {Pick a random card before it} + rank := ranks[i]; {Interchange ranks} + ranks[i] := ranks[j]; + ranks[j] := rank; + suit := suits[i]; {Interchange suits} + suits[i] := suits[j]; + suits[j] := suit + end; + writeln('The shuffled deck:'); + showdeck + end; {shuffle} + +begin {main program} + deck; + shuffle +end. diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/crypto b/js/games/nluqo.github.io/~bh/downloads/csls-programs/crypto new file mode 100644 index 0000000..7b1a835 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/crypto @@ -0,0 +1,355 @@ +to crypto :text +make "text map "uppercase :text +make "fulltext :text +make "moretext [] +make "textstack [] +if not procedurep "letterp [copydef "letterp "namep] +forletters "A "Z "initvars +make "maxcount 0 +initcount "single +initcount "triple +cleartext +histogram :text +redisplay "false +if or guess.single guess.triple [showclear :text] +parseloop +end + +;; Initialization + +to initcount :type +setlist. :type [] +setcount. :type 0 +end + +to initvars :letter +setcnt :letter 0 +make :letter "| | +setunbound :letter +end + +;; Histogram + +to histogram :text +foreach :text [localmake "word filter "letterp ? + foreach :word "histlet + prepare.guess :word] +end + +to histlet :letter +localmake "cnt 1+cnt :letter +setcursor list (index :letter) (nonneg 24-:cnt) +type :letter +setcnt :letter :cnt +if :maxcount < :cnt [make "maxcount :cnt] +end + +;; Guessing letters + +to prepare.guess :word +if equalp count :word 1 [tally "single :word] +if equalp count :word 3 [tally "triple :word] +end + +to tally :type :word +localmake "countvar word :type :word +if not memberp :word list. :type ~ + [setlist. :type fput :word list. :type make :countvar 0] +localmake "count (thing :countvar)+1 +make :countvar :count +if :count > (count. :type) ~ + [setcount. :type :count setmax. :type :word] +end + +to guess.single +if emptyp (list. "single) [output "false] +if emptyp butfirst (list. "single) ~ + [qbind first (list. "single) "A output "true] +qbind (max. "single) "A +qbind (ifelse equalp first (list. "single) (max. "single) + [last (list. "single)] + [first (list. "single)]) ~ + "I +output "true +end + +to guess.triple +if emptyp (list. "triple) [output "false] +if :maxcount < (3+cnt last (max. "triple)) ~ + [qbind first (max. "triple) "T + qbind first butfirst (max. "triple) "H + qbind last (max. "triple) "E + output "true] +output "false +end + +;; Keyboard commands + +to parseloop +forever [parsekey uppercase readchar] +end + +to parsekey :char +if :char = "@ [fullclear stop] +if :char = "+ [moretext stop] +if :char = "- [lesstext stop] +if not letterp :char [beep stop] +bind :char uppercase readchar +end + +;; Keeping track of guesses + +to bind :from :to +if not equalp :to "| | [if not letterp :to [beep stop] + if boundp :to [beep stop]] +if letterp thing :from [dark thing :from] +make :from :to +fixtop :from +if letterp :to [light :to] +showclear :text +end + +to qbind :from :to +if letterp thing :from [stop] +make :from :to +fixtop :from +light :to +end + +;; Maintaining the display + +to redisplay :flag +cleartext +showtop +alphabet +showcode :text +if :flag [showclear :text] +end + +;; Top section of display (letter counts and guesses) + +to showtop +setcursor [0 0] +showrow "A "E +showrow "F "J +showrow "K "O +showrow "P "T +showrow "U "Y +showrow "Z "Z +end + +to showrow :from :to +forletters :from :to [setposn ? cursor onetop ?] +print [] +end + +to onetop :letter +localmake "count cnt :letter +if :count = 0 [type word :letter "| | stop] +localmake "text (word :letter "- twocol :count "- thing :letter) +ifelse :maxcount < :count+3 [invtype :text] [type :text] +type "| | +end + +to twocol :number +if :number > 9 [output :number] +output word 0 :number +end + +to fixtop :letter +setcursor posn :letter +onetop :letter +end + +;; Middle section of display (guessed cleartext letters) + +to alphabet +setcursor [6 6] +forletters "A "Z [ifelse boundp ? [invtype ?] [type ?]] +end + +to light :letter +setcursor list 6+(index :letter) 6 +invtype :letter +setbound :letter +end + +to dark :letter +setcursor list 6+(index :letter) 6 +type :letter +setunbound :letter +end + +;; Bottom section of display (coded text) + +to showcode :text +make "moretext [] +showcode1 8 0 :text +end + +to showcode1 :row :col :text +if emptyp :text [make "moretext [] stop] +if :row > 22 [stop] +if and equalp :row 16 equalp :col 0 [make "moretext :text] +if (:col+count first :text) > 37 [showcode1 :row+2 0 :text stop] +codeword :row :col first :text +showcode1 :row (:col+1+count first :text) butfirst :text +end + +to codeword :row :col :word +setcursor list :col :row +invtype :word +end + +;; Bottom section of display (cleartext) + +to showclear :text +showclear1 8 0 :text 2 +end + +to showclear1 :row :col :text :delta +if emptyp :text [stop] +if :row > 23 [stop] +if keyp [stop] +if (:col+count first :text) > 37 ~ + [showclear1 :row+:delta 0 :text :delta stop] +clearword :row :col first :text +showclear1 :row (:col+1+count first :text) butfirst :text :delta +end + +to clearword :row :col :word +setcursor list :col :row+1 +foreach :word [ifelse letterp ? [type thing ?] [type ?]] +end + +;; Windowing commands + +to fullclear +cleartext +showclear1 0 0 :fulltext 1 +print [] +invtype [type any char to redisplay] +ignore readchar +redisplay "true +end + +to moretext +if emptyp :moretext [beep stop] +push "textstack :text +make "text :moretext +redisplay "true +end + +to lesstext +if emptyp :textstack [beep stop] +make "text pop "textstack +redisplay "true +end + +;; Iteration tool for letters + +to forletters :from :to :action +for [lettercode [ascii :from] [ascii :to]] ~ + [apply :action (list char :lettercode)] +end + +;; Data abstraction (constructors and selectors) + +to setbound :letter +make word "bound :letter "true +end + +to setunbound :letter +make word "bound :letter "false +end + +to boundp :letter +output thing word "bound :letter +end + +to setcnt :letter :thing +make (word "cnt :letter) :thing +end + +to cnt :letter +output thing (word "cnt :letter) +end + +to setposn :letter :thing +make (word "posn :letter) :thing +end + +to posn :letter +output thing (word "posn :letter) +end + +to setcount. :word :thing +make (word "count. :word) :thing +end + +to count. :word +output thing (word "count. :word) +end + +to setlist. :word :thing +make (word "list. :word) :thing +end + +to list. :word +output thing (word "list. :word) +end + +to setmax. :word :thing +make (word "max. :word) :thing +end + +to max. :word +output thing (word "max. :word) +end + +;; Miscellaneous helpers + +to index :letter +output (ascii :letter)-(ascii "A) +end + +to beep +tone 440 15 +end + +to invtype :text +type standout :text +end + +to nonneg :number +output ifelse :number < 0 [0] [:number] +end + +;; Sample cryptograms + +make "cgram1 [Dzynufqyjulli, jpqhq ok yr hoxpj qnzeujory qceqwj xhrtoyx + zw oyjr u trhjptpolq trhln. oynqqn, rzh qceqkkogq eryeqhy tojp + whrvlqfk rd qnzeujory uj whqkqyj kofwli fquyk jpuj jpq |xhrty-zwk| nr + yrj pugq kzep u trhln. u nqeqyj qnzeujory uofk uj, whqwuhqk drh, u + frhq trhjptpolq dzjzhq, tojp u noddqhqyj erffzyoji kwohoj, noddqhqyj + reezwujoryk, uyn frhq hqul zjoloji jpuy ujjuoyoyx kjujzk uyn kuluhi.] + +make "cgram2 [Lvo vfkp lfzj md opaxflimn iz lm gitokflo fnp zlkonblvon f + hmalv'z inilifliuo, fnp fl lvo zfyo liyo lm zoo lm il lvfl vo jnmwz + wvfl iz noxozzfkh lm xmco wilv lvo mnbminb fxliuilioz fnp xaglako md + zmxiolh, zm lvfl viz inilifliuo xfn to kogoufnl. il iz ftzakp lm + lvinj lvfl lviz lfzj xfn to fxxmycgizvop th zm yaxv zillinb in f tms + dfxinb dkmnl, yfnicagflinb zhytmgz fl lvo pikoxlimn md pizlfnl + fpyinizlkflmkz. lviz iz kflvok f wfh lm kobiyonl fnp tkfinwfzv.] + +make "cgram3 [Pcodl hbdcx qxdrdlh yihcodr, hbd rzbiier gxd lih ziyqdhdlh + hi hdgzb gwhbdlhcz echdxgzf, xdgnclp gr g ydglr ia ecudxghcil gln + zwehcoghcil. gln c niwuh hbgh yirh ia wr jbi rdxciwref xdgn gln jxchd + hbd dlpecrb eglpwgpd dodx edgxldn ch uf hbd xiwhd ia "xwl, rqih, xwl" + hi rcegr ygxldx.] + +make "cgram4 [Jw btn xnsgsyp ejke gfebbcg, dtyjbn fbccsksg, ryu fbccsksg + nswcsfpsu pes usgjns, wnssuba, ryu wtptns bw pes qbtyk, pesns zbtcu + ls yb knrujyk, yb psgpjyk svfsxp rg r psrfejyk aspebu, ryu yb + lcrfilbrnu dtykcsg. jy wrfp, zs rns ksppjyk cbfigpsx gfesutcjyk ryu + knrujyk pb pes xbjyp bw pbnptns.] diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/diff b/js/games/nluqo.github.io/~bh/downloads/csls-programs/diff new file mode 100644 index 0000000..8991bdc --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/diff @@ -0,0 +1,174 @@ +to diff :file1 :file2 :output +local "caseignoredp +make "caseignoredp "false +openread :file1 +openread :file2 +if not emptyp :output [openwrite :output] +setwrite :output +print [DIFF results:] +print sentence [< File 1 =] :file1 +print sentence [> File 2 =] :file2 +diff.same (makefile 1 :file1) (makefile 2 :file2) +print "========== +setread [] +setwrite [] +close :file1 +close :file2 +if not emptyp :output [close :output] +end + +;; Skip over identical lines in the two files. + +to diff.same :fib1 :fib2 +local [line1 line2] +do.while [make "line1 getline :fib1 + make "line2 getline :fib2 + if and listp :line1 listp :line2 [stop] ; Both files ended. +] [equalp :line1 :line2] +addline :fib1 :line1 ; Difference found. +addline :fib2 :line2 +diff.differ :fib1 :fib2 +end + +;; Remember differing lines while looking for ones that match. + +to diff.differ :fib1 :fib2 +local "line +make "line readline :fib1 +addline :fib1 :line +ifelse memberp :line lines :fib2 ~ + [diff.found :fib1 :fib2] ~ + [diff.differ :fib2 :fib1] +end + +to diff.found :fib1 :fib2 +local "lines +make "lines member2 (last butlast lines :fib1) ~ + (last lines :fib1) ~ + (lines :fib2) +ifelse emptyp :lines ~ + [diff.differ :fib2 :fib1] ~ + [report :fib1 :fib2 (butlast butlast lines :fib1) + (firstn (lines :fib2) (count lines :fib2)-(count :lines))] +end + +to member2 :line1 :line2 :lines +if emptyp butfirst :lines [output []] +if and equalp :line1 first :lines equalp :line2 first butfirst :lines ~ + [output :lines] +output member2 :line1 :line2 butfirst :lines +end + +to firstn :stuff :number +if :number = 0 [output []] +output fput (first :stuff) (firstn butfirst :stuff :number-1) +end + +;; Read from file or from saved lines. + +to getline :fib +nextlinenum :fib +output readline :fib +end + +to readline :fib +if savedp :fib [output popsaved :fib] +setread filename :fib +output readword +end + +;; Matching lines found, now report the differences. + +to report :fib1 :fib2 :lines1 :lines2 +local [end1 end2 dashes] +if equalp (which :fib1) 2 [report :fib2 :fib1 :lines2 :lines1 stop] +print "========== +make "end1 (linenum :fib1)+(count :lines1)-1 +make "end2 (linenum :fib2)+(count :lines2)-1 +make "dashes "false +ifelse :end1 < (linenum :fib1) [ + print (sentence "INSERT :end1+1 (word (linenum :fib2) "- :end2)) +] [ifelse :end2 < (linenum :fib2) [ + print (sentence "DELETE (word (linenum :fib1) "- :end1) :end2+1) +] [ + print (sentence "CHANGE (word (linenum :fib1) "- :end1) + (word (linenum :fib2) "- :end2)) + make "dashes "true +]] +process :fib1 "|< | :lines1 :end1 +if :dashes [print "-----] +process :fib2 "|> | :lines2 :end2 +diff.same :fib1 :fib2 +end + +to process :fib :prompt :lines :end +foreach :lines [type :prompt print ?] +savelines :fib butfirst butfirst chop :lines (lines :fib) +setlines :fib [] +setlinenum :fib :end+2 +end + +to chop :counter :stuff +if emptyp :counter [output :stuff] +output chop butfirst :counter butfirst :stuff +end + +;; Constructor, selectors, and mutators for File Information Block (FIB) +;; Five elements: file number, file name, line number, +;; differing lines, and saved lines for re-reading. + +to makefile :number :name +local "file +make "file array 5 ; Items 4 and 5 will be empty lists. +setitem 1 :file :number +setitem 2 :file :name +setitem 3 :file 0 +output :file +end + +to which :fib +output item 1 :fib +end + +to filename :fib +output item 2 :fib +end + +to linenum :fib +output item 3 :fib +end + +to nextlinenum :fib +setitem 3 :fib (item 3 :fib)+1 +end + +to setlinenum :fib :value +setitem 3 :fib :value +end + +to addline :fib :line +setitem 4 :fib (lput :line item 4 :fib) +end + +to setlines :fib :value +setitem 4 :fib :value +end + +to lines :fib +output item 4 :fib +end + +to savelines :fib :value +setitem 5 :fib (sentence :value item 5 :fib) +end + +to savedp :fib +output not emptyp item 5 :fib +end + +to popsaved :fib +local "result +make "result first item 5 :fib +setitem 5 :fib (butfirst item 5 :fib) +output :result +end diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/dotgame b/js/games/nluqo.github.io/~bh/downloads/csls-programs/dotgame new file mode 100644 index 0000000..f68d3fb --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/dotgame @@ -0,0 +1,268 @@ +;;; Connect-the-dots game + +to dotgame :size +; Connect-the-dots game. Input is the number of dots on each side. +if :LogoPlatform = "Windows [maximize.window "true] +ht cs +setpc 7 +setpensize [6 6] +localmake "offset (:size-1)*20 +pu setpos list -:offset -:offset +board :size +localmake "lines ~ + se (crossmap [list (list ?1 ?2) (list ?1 1+?2)] + (iseq 0 :size-1) (iseq 0 :size-2)) ~ + (crossmap [list (list ?1 ?2) (list 1+?1 ?2)] + (iseq 0 :size-2) (iseq 0 :size-1)) +localmake "computer 0 +localmake "person 0 +localmake "numboxes (:size-1)*(:size-1) +localmake "boxlists (array 5 0) +localmake "oldmove [] +for [i 1 4] [setitem :i :boxlists []] +setitem 0 :boxlists ~ + (crossmap [list ?1 ?2] (iseq 0 :size-2) (iseq 0 :size-2)) +localmake "boxes (array :size-1 0) +for [i 0 :size-2] [setitem :i :boxes (array :size-1 0)] + +CATCH "WIN [FOREVER [PERSONMOVE COMMOVE]] ; play the game! + +if not emptyp :oldmove [ ; make the last move white + setpc 7 + pu + setpos map [40*? - :offset] first :oldmove + pd + setpos map [40*? - :offset] last :oldmove +] +if computer > :person ~ + [print (se [you lost] :computer "to :person)] +if :computer < :person ~ + [print (se [you won] :person "to :computer)] +if :computer = :person [print (se [tie game])] +setpensize [1 1] +end + +; --------------- Initial board display ------------------------- + +to board :num +repeat :num [dots :num] +end + +to dots :num +pd +repeat :num [fd 0 pu rt 90 fd 40 lt 90 pd] +pu lt 90 fd 40 * :num rt 90 fd 40 +end + +; -------------- Human player's move --------------------- + +to personmove +; Read a mouse click, turn it into a move if legal. +localmake "move gmove +if not legal? :move [print [Not a legal move! Try again.] + personmove stop] +drawline :move 6 +localmake "direction reverse (map "difference (last :move) (first :move)) +localmake "found "false +fillboxes 6 "person +if :found [personmove] +end + +to gmove +while [not buttonp] [] +while [buttonp] [] +output findline (map [? + :offset] mousepos) +end + +to findline :pos +; Find the nearest vertical or horizontal line to the mouse click. +localmake "xrem remainder (first :pos)+10 40 +localmake "yrem remainder (last :pos)+10 40 +localmake "xpos (first :pos)+10-:xrem +localmake "ypos (last :pos)+10-:yrem +if :xrem > :yrem ~ + [output list (list :xpos/40 :ypos/40) (list :xpos/40+1 :ypos/40)] +output list (list :xpos/40 :ypos/40) (list :xpos/40 :ypos/40+1) +end + +to legal? :move +; Output true if this is an undrawn line segment connecting two dots. +output memberp :move :lines +end + +; ----------------- Computer's move ---------------------- + +to commove +; The computer chooses a move, does the housekeeping for it. +; Strategy: complete boxes if possible, otherwise pick a move that doesn't +; let the opponent complete a box. +ifelse not emptyp (item 3 :boxlists) [ + localmake "move lastline first (item 3 :boxlists) +] [ + localmake "goodlines filter "lineokay? :lines + ifelse not emptyp :goodlines [ + localmake "move pick :goodlines + ] [ + localmake "cohorts [] + makecohorts :lines + localmake "move lastline first smallest :cohorts + ] +] +drawline :move 4 +localmake "direction reverse (map "difference (last :move) (first :move)) +localmake "found "false +fillboxes 4 "computer +if :found [commove] +end + +to lineokay? :move +; Output true if this move won't let the opponent complete a box. +localmake "direction reverse (map "difference (last :move) (first :move)) +output and (boxokay? first :move) ~ + (boxokay? (map "difference (first :move) :direction)) +end + +to boxokay? :box +; Output true if this box has fewer than 2 edges already drawn. +if or ((first :box) < 0) ((last :box) < 0) [output "true] +if or ((first :box) > (:size-2)) ((last :box) > (:size-2)) [output "true] +localmake "count item (last :box) item (first :box) :boxes +if emptyp :count [make "count 0] +output :count<2 +end + +to lastline :box +; Box has three lines drawn; find the missing one for us to draw. +if memberp (list :box (map "sum :box [0 1])) :lines [ + output (list :box (map "sum :box [0 1]))] +if memberp (list :box (map "sum :box [1 0])) :lines [ + output (list :box (map "sum :box [1 0]))] +if memberp (list (map "sum :box [0 1]) (map "sum :box [1 1])) :lines [ + output (list (map "sum :box [0 1]) (map "sum :box [1 1]))] +if memberp (list (map "sum :box [1 0]) (map "sum :box [1 1])) :lines [ + output (list (map "sum :box [1 0]) (map "sum :box [1 1]))] +output [] ; box was full already (from makecohort) +end + +to makecohorts :lines +; Partition the available boxes into chains, to look for the smallest. +; Note, the partition is not necessarily optimal -- this algorithm needs work. +; It's important that LINES be a local variable here, so that we can "draw" +; lines hypothetically that we're not really going to draw on the board. +while [not emptyp :lines] [ + localmake "cohort [] + makecohort first :lines + push "cohorts :cohort +] +end + +to makecohort :line +; Group all the boxes in a chain that starts with this line. +; Mark the line as drawn (locally to caller), then look in both directions +; for completable boxes. +make "lines remove :line :lines +localmake "direction reverse (map "difference (last :line) (first :line)) +makecohort1 (map "difference (first :line) :direction) +makecohort1 first :line +end + +to makecohort1 :box +; Examine one of the boxes adjoining the line just hypothetically drawn. +; It has 0, 1, or 2 undrawn sides. (If 3 or 4, wouldn't have gotten here.) +; 0 sides -> count the box if not already, but no further lines in the chain. +; 1 side -> count the box, continue the chain with its last side. +; 2 sides -> the box isn't ready to complete, so it's not in this chain. +if or ((first :box) < 0) ((last :box) < 0) [stop] +if or ((first :box) > (:size-2)) ((last :box) > (:size-2)) [stop] +localmake "togo filter [memberp (list (map "sum :box first ?) + (map "sum :box last ?)) + :lines] ~ + [[[0 0] [0 1]] [[0 0] [1 0]] + [[1 0] [1 1]] [[0 1] [1 1]]] +if (count :togo)=2 [stop] +if not memberp :box :cohort [push "cohort :box] +if emptyp :togo [stop] +localmake "line (list (map "sum :box first first :togo) + (map "sum :box last first :togo)) +makecohort :line +end + +to smallest :cohorts [:sofar []] [:minsize :numboxes+1] +if emptyp :cohorts [output :sofar] +if (count first :cohorts) < :minsize ~ + [output (smallest bf :cohorts first :cohorts count first :cohorts)] +output (smallest bf :cohorts :sofar :minsize) +end + +; ----------- Common procedures for person and computer moves -------- + +to drawline :move :color +; Actually draw the selected move on the screen. +if not emptyp :oldmove [ + setpc 7 + pu + setpos map [40*? - :offset] first :oldmove + pd + setpos map [40*? - :offset] last :oldmove +] +setpc :color +pu +setpos map [40*? - :offset] first :move +pd +setpos map [40*? - :offset] last :move +make "oldmove :move +end + +to fillboxes :color :owner +; Implicit inputs (inherited from caller): +; :move is the move someone just made. +; :direction is [1 0] for vertical move, [0 1] for horizontal. +; Note that the line is drawn, check the two boxes (maybe) on either side, +; color them and count them for the appropriate player, see if game over. +make "lines remove :move :lines +if boxbefore? :move [fillbox (map "difference (first :move) :direction)] +if boxafter? :move [fillbox first :move] +testwin +end + +to boxafter? :move +; Output true if the box above or to the right of the move is now complete. +output (increment first :move)=4 +end + +to boxbefore? :move +; Output true if the box below or to the left of the move is now complete. +localmake "p3 (map "difference (first :move) :direction) +output (increment :p3)=4 +end + +to increment :box +; If this isn't a box at all (might be if the move was on a border), +; just output []. Otherwise, increment the number in the :boxes array, +; and move this box from one of the :boxlists to the next higher one. +; Output the new count of number of lines drawn in this box. +if or ((first :box) < 0) ((last :box) < 0) [output []] +if or ((first :box) > (:size-2)) ((last :box) > (:size-2)) [output []] +localmake "count item (last :box) item (first :box) :boxes +if emptyp :count [make "count 0] +setitem (last :box) item (first :box) :boxes :count+1 +setitem :count :boxlists (remove :box item :count :boxlists) +setitem :count+1 :boxlists (fput :box item :count+1 :boxlists) +output :count+1 +end + +to fillbox :box +; Color in a completed box, increase the box count of its owner, and +; flag that a box was completed. +pu +setpos (map [40*? - :offset] :box) +filled :color [repeat 4 [fd 40 rt 90]] +make :owner (thing :owner)+1 +make "found "true +end + +; ------------------- Endgame processing -------------------- + +to testwin +if :computer+:person = :numboxes [throw "win] +end diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/format b/js/games/nluqo.github.io/~bh/downloads/csls-programs/format new file mode 100644 index 0000000..13042b1 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/format @@ -0,0 +1,157 @@ +to format :from :to +openread :from +openwrite :to +setread :from +setwrite :to +init.vars +loop +setread [] +setwrite [] +close :from +close :to +end + +to init.vars +make "pageheight 66 +make "topmar 6 +make "lines 54 +make "leftmar 7 +make "width 65 +make "filltab 5 +make "nofilltab 0 +make "parskip 1 +make "spacing 1 +make "started "false +make "filling "true +make "printed 0 +make "inline [] +end + +to loop +forever [if process nextword [stop]] +end + +;; Add a word to the output file, starting a new line if necessary + +to process :word +if listp :word [output "true] +if not :started [start] +if (:linecount+1+count :word) > :width [putline] +addword :word +output "false +end + +to addword :word +if not emptyp :line [make "linecount :linecount+1] +make "line lput :word :line +make "linecount :linecount+count :word +end + +to putline +repeat :leftmar+:indent [type "| |] +putwords :line ((count :line)-1) (:width-:linecount) +newline +skip :spacing +end + +to putwords :line :spaces :filler +local "perword +if emptyp :line [stop] +type first :line +make "perword ifelse :spaces > 0 [int ((:filler+:spaces-1)/:spaces)] [0] +if :filler > 0 [repeat :perword [type "| |]] +type "| | +putwords (butfirst :line) (:spaces-1) (:filler-:perword) +end + +;; Get the next input word, reading a new line if necessary + +to nextword +if not emptyp :inline [output extract.word] +if not :filling [break] +make "inline readword +if listp :inline [break output []] +if emptyp :inline [break output nextword] +if equalp first :inline "|*| ~ + [run butfirst :inline + make "inline "] +make "inline skipspaces :inline +output nextword +end + +to extract.word +local "result +make "result firstword :inline +make "inline skipfirst :inline +output :result +end + +to firstword :word +if emptyp :word [output "] +if equalp first :word "| | [output "] +output word (first :word) (firstword butfirst :word) +end + +to skipfirst :word +if emptyp :word [output "] +if equalp first :word "| | [output skipspaces :word] +output skipfirst butfirst :word +end + +to skipspaces :word +if emptyp :word [output "] +if equalp first :word "| | [output skipspaces butfirst :word] +output :word +end + +;; Formatting helpers + +to start +make "started "true +repeat :topmar [print []] +newindent +end + +to newindent +newline +make "indent ifelse :filling [:filltab] [:nofilltab] +make "linecount :indent +end + +to newline +make "line [] +make "indent 0 +make "linecount 0 +end + +to break +if emptyp :line [stop] +make "linecount :width +putline +newindent +if :filling [skip :parskip] +end + +;; Formatting commands to be invoked by the user + +to skip :howmany +break +repeat :howmany [print []] +make "printed :printed+:howmany +if :printed < :lines [stop] +repeat :pageheight-:printed [print []] +make "printed 0 +end + +to nofill +break +make "filling "false +newindent +end + +to yesfill +break +if not :filling [skip :parskip] +make "filling "true +newindent +end diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/fsm b/js/games/nluqo.github.io/~bh/downloads/csls-programs/fsm new file mode 100644 index 0000000..27915e7 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/fsm @@ -0,0 +1,355 @@ +;;; Finite State Machine Interpreter (FSM) + +to game :which +fsm thing word "mach :which +end + +to fsm :machine +cleartext +setcursor [0 3] +localmake "start startpart :machine +localmake "moves movepart :machine +localmake "accept acceptpart :machine +fsm1 :start +end + +to fsm1 :here +ifelse memberp :here :accept [accept] [reject] +fsm1 (fsmnext :here readchar) +end + +to fsmnext :here :input +blank +if memberp :input (list char 13 char 10) ~ + [print ifelse memberp :here :accept ["| ACCEPT|] ["| REJECT|] + output :start] +type :input +catch "error [output last find [fsmtest :here :input ?] :moves] +output -1 +end + +to fsmtest :here :input :move +output and (equalp :here arrowtail :move) (memberp :input arrowtext :move) +end + +;; Display machine state + +to accept +display "accept +end + +to reject +display "reject +end + +to blank +display "| | +end + +to display :text +localmake "oldpos cursor +setcursor [15 1] +type :text +setcursor :oldpos +end + +;; Data abstraction for machines + +to startpart :machine +output first :machine +end + +to movepart :machine +output first bf :machine +end + +to acceptpart :machine +output last :machine +end + +to make.machine :start :moves :accept +output (list :start :moves :accept) +end + +;; Data abstraction for arrows + +to arrowtail :arrow +output first :arrow +end + +to arrowtext :arrow +output first butfirst :arrow +end + +to arrowhead :arrow +output last :arrow +end + +to make.arrow :tail :text :head +output (list :tail :text :head) +end + +;; Machine descriptions for the guessing game + +make "mach1 [1 [[1 AB 1]] [1]] +make "mach2 [1 [[1 ABC 2] [2 ABC 1]] [1]] +make "mach3 [1 [[1 A 2] [2 B 3] [3 ABC 3]] [3]] +make "mach4 [1 [[1 A 2] [1 B 3] [1 C 4] [2 A 1] [3 B 1] [4 C 1]] [1]] +make "mach5 [1 [[1 ABC 2] [2 B 1]] [1]] +make "mach6 [1 [[1 A 2] [2 AB 2] [2 C 3] [3 AB 2] [3 C 3]] [3]] +make "mach7 [1 [[1 AB 1] [1 C 2] [2 C 1]] [1]] +make "mach8 [1 [[1 A 2] [1 BC 1] [2 A 1] [2 BC 2]] [1]] +make "mach9 [1 [[1 AB 1] [1 C 2] [2 A 3] [2 B 1] [3 A 1]] [1]] +make "mach10 [1 [[1 A 2] [1 BC 1] [2 A 2] [2 B 3] [2 C 1] + [3 A 2] [3 B 1] [3 C 4] [4 A 2] [4 B 5] [4 C 1] + [5 A 6] [5 BC 1] [6 ABC 6]] + [6]] + + +;;; Regular Expression to FSM Translation (MACHINE) + +to machine :regexp +localmake "nextstate 0 +output optimize determine nondet :regexp +end + +;; First step: make a possibly nondeterministic machine + +to nondet :regexp +if and (wordp :regexp) (equalp count :regexp 1) [output ndletter :regexp] +if wordp :regexp [output ndor reduce "sentence :regexp] +if equalp first :regexp "or [output ndor butfirst :regexp] +if equalp first :regexp "* [output ndmany last :regexp] +output ndconcat :regexp +end + +;; Alphabet rule + +to ndletter :letter +localmake "from newstate +localmake "to newstate +output make.machine :from (list (make.arrow :from :letter :to)) (list :to) +end + +;; Concatenation rule + +to ndconcat :exprs +output reduce "string (map "nondet :exprs) +end + +to string :machine1 :machine2 +output (make.machine (startpart :machine1) + (sentence (movepart :machine1) + (splice acceptpart :machine1 :machine2) + (movepart :machine2)) + (stringa (acceptpart :machine1) + (startpart :machine2) + (acceptpart :machine2))) +end + +to stringa :accept1 :start2 :accept2 +if memberp :start2 :accept2 [output sentence :accept1 :accept2] +output :accept2 +end + +;; Alternatives rule + +to ndor :exprs +localmake "newstart newstate +localmake "machines (map "nondet :exprs) +localmake "accepts map.se "acceptpart :machines +output (make.machine :newstart + (sentence map.se "movepart :machines + map.se "or.splice :machines) + ifelse not emptyp find [memberp (startpart ?) + (acceptpart ?)] + :machines + [fput :newstart :accepts] + [:accepts]) +end + +to or.splice :machine +output map [newtail ? :newstart] (arrows.from.start :machine) +end + +;; Repetition rule + +to ndmany :regexp +localmake "machine nondet :regexp +output (make.machine (startpart :machine) + sentence (movepart :machine) + (splice (acceptpart :machine) :machine) + fput (startpart :machine) (acceptpart :machine)) +end + +;; Generate moves from a bunch of given states (:accepts) duplicating +;; the moves from the start state of some machine (:machine). +;; Used for concatenation rule to splice two formerly separate machines; +;; used for repetition rule to "splice" a machine to itself. + +to splice :accepts :machine +output map.se [copy.to.accepts ?] (arrows.from.start :machine) +end + +to arrows.from.start :machine +output filter [equalp startpart :machine arrowtail ?] movepart :machine +end + +to copy.to.accepts :move +output map [newtail :move ?] :accepts +end + +to newtail :arrow :tail +output make.arrow :tail (arrowtext :arrow) (arrowhead :arrow) +end + +;; Make a new state number + +to newstate +make "nextstate :nextstate+1 +output :nextstate +end + +;; Second step: Turn nondeterministic FSM into a deterministic one +;; Also eliminates "orphan" (unreachable) states. + +to determine :machine +localmake "moves movepart :machine +localmake "accepts acceptpart :machine +localmake "states [] +localmake "join.state.list [] +localmake "newmoves nd.traverse (startpart :machine) +output make.machine (startpart :machine) ~ + :newmoves ~ + filter [memberp ? :states] :accepts +end + +to nd.traverse :state +if memberp :state :states [output []] +make "states fput :state :states +localmake "newmoves (check.nd filter [equalp arrowtail ? :state] :moves) +output sentence :newmoves map.se "nd.traverse (map "arrowhead :newmoves) +end + +to check.nd :movelist +if emptyp :movelist [output []] +localmake "letter arrowtext first :movelist +localmake "heads sort map "arrowhead ~ + filter [equalp :letter arrowtext ?] :movelist +if emptyp butfirst :heads ~ + [output fput first :movelist + check.nd filter [not equalp :letter arrowtext ?] :movelist] +localmake "check.heads member :heads :join.state.list +if not emptyp :check.heads ~ + [output fput make.arrow :state :letter first butfirst :check.heads ~ + check.nd filter [not equalp :letter arrowtext ?] :movelist] +localmake "join.state newstate +make "join.state.list fput :heads fput :join.state :join.state.list +make "moves sentence :moves ~ + map [make.arrow :join.state arrowtext ? arrowhead ?] ~ + filter [memberp arrowtail ? :heads] :moves +if not emptyp find [memberp ? :accepts] :heads ~ + [make "accepts sentence :accepts :join.state] +output fput make.arrow :state :letter :join.state ~ + check.nd filter [not equalp :letter arrowtext ?] :movelist +end + +to sort :list +if emptyp :list [output []] +output insert first :list sort butfirst :list +end + +to insert :value :sorted +if emptyp :sorted [output (list :value)] +if :value = first :sorted [output :sorted] +if :value < first :sorted [output fput :value :sorted] +output fput first :sorted insert :value butfirst :sorted +end + +;; Third step: Combine redundant states. +;; Also combines arrows with same head and tail: [1 A 2] [1 B 2] -> [1 AB 2]. + +to optimize :machine +localmake "stubarray array :nextstate +foreach (movepart :machine) "array.save +localmake "states sort fput (startpart :machine) ~ + map "arrowhead movepart :machine +localmake "start startpart :machine +foreach reverse :states [optimize.state ? ?rest] +output (make.machine :start + map.se [fix.arrows ? item ? :stubarray] :states + filter [memberp ? :states] acceptpart :machine) +end + +to array.save :move +setitem (arrowtail :move) :stubarray ~ + stub.add (arrow.stub :move) (item (arrowtail :move) :stubarray) +end + +to stub.add :stub :stublist +if emptyp :stublist [output (list :stub)] +if (stub.head :stub) < (stub.head first :stublist) ~ + [output fput :stub :stublist] +if (stub.head :stub) = (stub.head first :stublist) ~ + [output fput make.stub letter.join (stub.text :stub) + (stub.text first :stublist) + stub.head :stub + butfirst :stublist] +output fput first :stublist (stub.add :stub butfirst :stublist) +end + +to letter.join :this :those +if emptyp :those [output :this] +if beforep :this first :those [output word :this :those] +output word (first :those) (letter.join :this butfirst :those) +end + +to optimize.state :state :others +localmake "candidates filter (ifelse memberp :state acceptpart :machine + [[memberp ? acceptpart :machine]] + [[not memberp ? acceptpart :machine]]) ~ + :others +localmake "mymoves item :state :stubarray +localmake "twin find [equalp (item ? :stubarray) :mymoves] :candidates +if emptyp :twin [stop] +make "states remove :state :states +if equalp :start :state [make "start :twin] +foreach :states ~ + [setitem ? :stubarray + (cascade [emptyp ?2] + [stub.add (change.head :state :twin first ?2) ?1] + filter [not equalp stub.head ? :state] item ? :stubarray + [butfirst ?2] + filter [equalp stub.head ? :state] item ? :stubarray)] +end + +to change.head :from :to :stub +if not equalp (stub.head :stub) :from [output :stub] +output list (stub.text :stub) :to +end + +to fix.arrows :state :stublist +output map [stub.arrow :state ?] :stublist +end + +;; Data abstraction for "stub" arrow (no tail) + +to arrow.stub :arrow +output butfirst :arrow +end + +to make.stub :text :head +output list :text :head +end + +to stub.text :stub +output first :stub +end + +to stub.head :stub +output last :stub +end + +to stub.arrow :tail :stub +output fput :tail :stub +end diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=D;O=A b/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=D;O=A new file mode 100644 index 0000000..a9fb169 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=D;O=A @@ -0,0 +1,41 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> +<html> + <head> + <title>Index of /~bh/downloads/csls-programs</title> + </head> + <body> +<h1>Index of /~bh/downloads/csls-programs</h1> + <table> + <tr><th valign="top"><img src="../../../icons/blank.gif" alt="[ICO]"></th><th><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/?C=N;O=A">Name</a></th><th><a href="index.html?C=M%3BO=A">Last modified</a></th><th><a href="index.html?C=S%3BO=A">Size</a></th><th><a href="index.html?C=D%3BO=D">Description</a></th></tr> + <tr><th colspan="5"><hr></th></tr> +<tr><td valign="top"><img src="../../../icons/back.gif" alt="[PARENTDIR]"></td><td><a href="../index.html">Parent Directory</a> </td><td> </td><td align="right"> - </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="Makefile.am">Makefile.am</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">218 </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/algs">algs</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.3K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="basic">basic</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="buttons">buttons</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="cards">cards</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.2K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="crypto">crypto</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">7.4K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="diff">diff</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/doctor">doctor</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 26K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="dotgame">dotgame</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">8.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="format">format</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="fsm">fsm</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">9.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="master">master</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 12K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="match">match</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.4K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/math">math</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">7.2K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="mines">mines</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 14K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="multi">multi</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">658 </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="pascal">pascal</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 29K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="playfair">playfair</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="plot">plot</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">928 </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/poker">poker</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="pour">pour</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.8K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="psort">psort</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="solitaire">solitaire</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">9.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="streams">streams</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.1K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="student">student</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 35K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="tower">tower</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/ttt">ttt</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.5K</td><td> </td></tr> + <tr><th colspan="5"><hr></th></tr> +</table> +</body></html> diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=D;O=D b/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=D;O=D new file mode 100644 index 0000000..e6a9e17 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=D;O=D @@ -0,0 +1,41 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> +<html> + <head> + <title>Index of /~bh/downloads/csls-programs</title> + </head> + <body> +<h1>Index of /~bh/downloads/csls-programs</h1> + <table> + <tr><th valign="top"><img src="../../../icons/blank.gif" alt="[ICO]"></th><th><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/?C=N;O=A">Name</a></th><th><a href="index.html?C=M%3BO=A">Last modified</a></th><th><a href="index.html?C=S%3BO=A">Size</a></th><th><a href="index.html?C=D%3BO=A">Description</a></th></tr> + <tr><th colspan="5"><hr></th></tr> +<tr><td valign="top"><img src="../../../icons/back.gif" alt="[PARENTDIR]"></td><td><a href="../index.html">Parent Directory</a> </td><td> </td><td align="right"> - </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/ttt">ttt</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="tower">tower</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="student">student</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 35K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="streams">streams</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.1K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="solitaire">solitaire</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">9.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="psort">psort</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="pour">pour</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.8K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/poker">poker</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="plot">plot</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">928 </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="playfair">playfair</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="pascal">pascal</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 29K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="multi">multi</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">658 </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="mines">mines</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 14K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/math">math</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">7.2K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="match">match</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.4K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="master">master</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 12K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="fsm">fsm</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">9.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="format">format</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="dotgame">dotgame</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">8.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/doctor">doctor</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 26K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="diff">diff</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="crypto">crypto</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">7.4K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="cards">cards</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.2K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="buttons">buttons</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="basic">basic</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/algs">algs</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.3K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="Makefile.am">Makefile.am</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">218 </td><td> </td></tr> + <tr><th colspan="5"><hr></th></tr> +</table> +</body></html> diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=M;O=A b/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=M;O=A new file mode 100644 index 0000000..ca7b486 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=M;O=A @@ -0,0 +1,41 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> +<html> + <head> + <title>Index of /~bh/downloads/csls-programs</title> + </head> + <body> +<h1>Index of /~bh/downloads/csls-programs</h1> + <table> + <tr><th valign="top"><img src="../../../icons/blank.gif" alt="[ICO]"></th><th><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/?C=N;O=A">Name</a></th><th><a href="index.html?C=M%3BO=D">Last modified</a></th><th><a href="index.html?C=S%3BO=A">Size</a></th><th><a href="index.html?C=D%3BO=A">Description</a></th></tr> + <tr><th colspan="5"><hr></th></tr> +<tr><td valign="top"><img src="../../../icons/back.gif" alt="[PARENTDIR]"></td><td><a href="../index.html">Parent Directory</a> </td><td> </td><td align="right"> - </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="Makefile.am">Makefile.am</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">218 </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/algs">algs</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.3K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="basic">basic</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="buttons">buttons</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="cards">cards</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.2K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="crypto">crypto</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">7.4K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="diff">diff</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/doctor">doctor</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 26K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="dotgame">dotgame</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">8.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="format">format</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="fsm">fsm</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">9.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="master">master</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 12K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="match">match</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.4K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/math">math</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">7.2K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="mines">mines</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 14K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="multi">multi</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">658 </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="pascal">pascal</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 29K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="playfair">playfair</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="plot">plot</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">928 </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/poker">poker</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="pour">pour</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.8K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="psort">psort</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="solitaire">solitaire</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">9.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="streams">streams</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.1K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="student">student</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 35K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="tower">tower</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/ttt">ttt</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.5K</td><td> </td></tr> + <tr><th colspan="5"><hr></th></tr> +</table> +</body></html> diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=M;O=D b/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=M;O=D new file mode 100644 index 0000000..e6a9e17 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=M;O=D @@ -0,0 +1,41 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> +<html> + <head> + <title>Index of /~bh/downloads/csls-programs</title> + </head> + <body> +<h1>Index of /~bh/downloads/csls-programs</h1> + <table> + <tr><th valign="top"><img src="../../../icons/blank.gif" alt="[ICO]"></th><th><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/?C=N;O=A">Name</a></th><th><a href="index.html?C=M%3BO=A">Last modified</a></th><th><a href="index.html?C=S%3BO=A">Size</a></th><th><a href="index.html?C=D%3BO=A">Description</a></th></tr> + <tr><th colspan="5"><hr></th></tr> +<tr><td valign="top"><img src="../../../icons/back.gif" alt="[PARENTDIR]"></td><td><a href="../index.html">Parent Directory</a> </td><td> </td><td align="right"> - </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/ttt">ttt</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="tower">tower</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="student">student</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 35K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="streams">streams</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.1K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="solitaire">solitaire</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">9.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="psort">psort</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="pour">pour</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.8K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/poker">poker</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="plot">plot</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">928 </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="playfair">playfair</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="pascal">pascal</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 29K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="multi">multi</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">658 </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="mines">mines</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 14K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/math">math</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">7.2K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="match">match</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.4K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="master">master</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 12K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="fsm">fsm</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">9.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="format">format</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="dotgame">dotgame</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">8.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/doctor">doctor</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 26K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="diff">diff</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="crypto">crypto</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">7.4K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="cards">cards</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.2K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="buttons">buttons</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="basic">basic</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/algs">algs</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.3K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="Makefile.am">Makefile.am</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">218 </td><td> </td></tr> + <tr><th colspan="5"><hr></th></tr> +</table> +</body></html> diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=N;O=D b/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=N;O=D new file mode 100644 index 0000000..e6a9e17 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=N;O=D @@ -0,0 +1,41 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> +<html> + <head> + <title>Index of /~bh/downloads/csls-programs</title> + </head> + <body> +<h1>Index of /~bh/downloads/csls-programs</h1> + <table> + <tr><th valign="top"><img src="../../../icons/blank.gif" alt="[ICO]"></th><th><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/?C=N;O=A">Name</a></th><th><a href="index.html?C=M%3BO=A">Last modified</a></th><th><a href="index.html?C=S%3BO=A">Size</a></th><th><a href="index.html?C=D%3BO=A">Description</a></th></tr> + <tr><th colspan="5"><hr></th></tr> +<tr><td valign="top"><img src="../../../icons/back.gif" alt="[PARENTDIR]"></td><td><a href="../index.html">Parent Directory</a> </td><td> </td><td align="right"> - </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/ttt">ttt</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="tower">tower</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="student">student</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 35K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="streams">streams</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.1K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="solitaire">solitaire</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">9.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="psort">psort</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="pour">pour</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.8K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/poker">poker</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="plot">plot</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">928 </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="playfair">playfair</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="pascal">pascal</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 29K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="multi">multi</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">658 </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="mines">mines</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 14K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/math">math</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">7.2K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="match">match</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.4K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="master">master</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 12K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="fsm">fsm</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">9.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="format">format</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="dotgame">dotgame</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">8.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/doctor">doctor</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 26K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="diff">diff</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="crypto">crypto</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">7.4K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="cards">cards</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.2K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="buttons">buttons</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="basic">basic</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/algs">algs</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.3K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="Makefile.am">Makefile.am</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">218 </td><td> </td></tr> + <tr><th colspan="5"><hr></th></tr> +</table> +</body></html> diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=S;O=A b/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=S;O=A new file mode 100644 index 0000000..ed69dfa --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=S;O=A @@ -0,0 +1,41 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> +<html> + <head> + <title>Index of /~bh/downloads/csls-programs</title> + </head> + <body> +<h1>Index of /~bh/downloads/csls-programs</h1> + <table> + <tr><th valign="top"><img src="../../../icons/blank.gif" alt="[ICO]"></th><th><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/?C=N;O=A">Name</a></th><th><a href="index.html?C=M%3BO=A">Last modified</a></th><th><a href="index.html?C=S%3BO=D">Size</a></th><th><a href="index.html?C=D%3BO=A">Description</a></th></tr> + <tr><th colspan="5"><hr></th></tr> +<tr><td valign="top"><img src="../../../icons/back.gif" alt="[PARENTDIR]"></td><td><a href="../index.html">Parent Directory</a> </td><td> </td><td align="right"> - </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="Makefile.am">Makefile.am</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">218 </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="multi">multi</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">658 </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="plot">plot</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">928 </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="tower">tower</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="cards">cards</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.2K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/poker">poker</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="psort">psort</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="playfair">playfair</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="streams">streams</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.1K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="format">format</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="pour">pour</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.8K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="match">match</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.4K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/ttt">ttt</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="diff">diff</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/algs">algs</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.3K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="basic">basic</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="buttons">buttons</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/math">math</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">7.2K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="crypto">crypto</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">7.4K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="dotgame">dotgame</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">8.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="fsm">fsm</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">9.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="solitaire">solitaire</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">9.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="master">master</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 12K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="mines">mines</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 14K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/doctor">doctor</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 26K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="pascal">pascal</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 29K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="student">student</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 35K</td><td> </td></tr> + <tr><th colspan="5"><hr></th></tr> +</table> +</body></html> diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=S;O=D b/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=S;O=D new file mode 100644 index 0000000..2dd432e --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/index.html?C=S;O=D @@ -0,0 +1,41 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN"> +<html> + <head> + <title>Index of /~bh/downloads/csls-programs</title> + </head> + <body> +<h1>Index of /~bh/downloads/csls-programs</h1> + <table> + <tr><th valign="top"><img src="../../../icons/blank.gif" alt="[ICO]"></th><th><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/?C=N;O=A">Name</a></th><th><a href="index.html?C=M%3BO=A">Last modified</a></th><th><a href="index.html?C=S%3BO=A">Size</a></th><th><a href="index.html?C=D%3BO=A">Description</a></th></tr> + <tr><th colspan="5"><hr></th></tr> +<tr><td valign="top"><img src="../../../icons/back.gif" alt="[PARENTDIR]"></td><td><a href="../index.html">Parent Directory</a> </td><td> </td><td align="right"> - </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="student">student</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 35K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="pascal">pascal</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 29K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/doctor">doctor</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 26K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="mines">mines</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 14K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="master">master</a> </td><td align="right">2020-12-30 07:37 </td><td align="right"> 12K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="solitaire">solitaire</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">9.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="fsm">fsm</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">9.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="dotgame">dotgame</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">8.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="crypto">crypto</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">7.4K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/math">math</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">7.2K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="buttons">buttons</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="basic">basic</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/algs">algs</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">6.3K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="diff">diff</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.9K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/ttt">ttt</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="match">match</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">3.4K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="pour">pour</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.8K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="format">format</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.7K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="streams">streams</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.1K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="playfair">playfair</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="psort">psort</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">2.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="https://people.eecs.berkeley.edu/~bh/downloads/csls-programs/poker">poker</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.5K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="cards">cards</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.2K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="tower">tower</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">1.0K</td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/text.gif" alt="[TXT]"></td><td><a href="plot">plot</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">928 </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="multi">multi</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">658 </td><td> </td></tr> +<tr><td valign="top"><img src="../../../icons/unknown.gif" alt="[ ]"></td><td><a href="Makefile.am">Makefile.am</a> </td><td align="right">2020-12-30 07:37 </td><td align="right">218 </td><td> </td></tr> + <tr><th colspan="5"><hr></th></tr> +</table> +</body></html> diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/master b/js/games/nluqo.github.io/~bh/downloads/csls-programs/master new file mode 100644 index 0000000..f876c6a --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/master @@ -0,0 +1,381 @@ +; [Mastermind game] + +cslsload "buttons +cslsload "streams + +to master [:numsquares 4] [:dup.ok "false] [:mysecret "true] +; Mastermind game program. +; Program is controlled by mouse clicks or keystrokes. +if :LogoPlatform = "Windows [maximize.window "true] +window +if :LogoPlatform = "wxWidgets [localmake "fontsize labelsize] +localmake "colors "ROYGBV +localmake "colornums [[R 4] [O 14] [Y 6] [G 2] [B 1] [V 13]] +localmake "exact "true +local [numguesses numcolors column guess gotnum winloop permuting] +local [perms oldcount newcount guess.exact guess.inexact guess.word] +catch "quit [forever [ + catch "master [ + make "numguesses 0 + make "numcolors 0 + make "column 0 + make "winloop "false + initdraw ; Clear screen, draw color palette + ifelse :mysecret [ + ifelse :dup.ok ; Choose secret permutation + [make "secret (choose.dup :numsquares :colors)] + [make "secret (choose.nodup :numsquares :colors)] + newguess ; Display first guess frame + action.loop ; Read keyboard characters or mouse clicks + ] [ + catch "win [ ; User's secret, program has to guess. + ifelse :dup.ok [ + make "permuting "false ; Lots of cases with dups okay, so + make "perms (list copies :numsquares "x) + make "newcount 0 ; find colors systematically first. + catch "perm [ + for [i 1 6] [ ; Learn how many red, then orange, etc. + make "oldcount :newcount + doguess subst :i "x head :perms + make "newcount :guess.exact + :guess.inexact + make "perms flatten stream.map + `[insert ,[:newcount-:oldcount] ,:i ?] :perms + make "perms stream.filter + `[okay? ? ,:guess.exact ,:guess.inexact ,:guess.word] + :perms + check.consistency :perms + if equalp :newcount :numsquares [throw "perm] + ] + check.consistency [] ; Tried all colors, user lied. + ] + make "permuting "true + ] [ + make "perms perms "123456 :numsquares ; not :dup.ok + make "permuting equalp :numsquares 6 + ] + forever [ ; common portion + doguess head :perms + if equalp :numsquares :guess.exact + :guess.inexact ~ + [make "permuting "true] + make "perms stream.filter + `[okay? ? ,:guess.exact ,:guess.inexact ,:guess.word] + :perms + check.consistency :perms + ] + ; Can't get here; either doguess finds a winner or + ; check.consistency complains. + ] ; We get here on throw "win from doguess. + move [15 12] + setpc 7 label "WIN! + ct print (sentence [I win in] :numguesses "turns.) + make "winloop "true + action.loop + ] +]]] +cs ct setpc 7 st +end + +;;; ================== LOGIC FOR MY GUESSES (USER SECRET) ================= + +to doguess :guessword +; Present computer's guess to user and ask about matches. +newguess ; Draw frame for guess. +make "guess.word :guessword ; Remember my colors. +foreach :guessword [apply "putguess item ? :colornums] ; Show colors. +askexact ; Ask user for exact matches. +make "gotnum "false +catch "ready [action.loop] +pu setpos [150 205] setpc 0 filled 0 [repeat 2 [fd 35 rt 90 fd 110 rt 90]] +setpc 7 +ifelse :guess.exact < :numsquares [ ; Not all colors are exact. + ifelse :permuting [ ; If we know all the colors, + make "exact "false ; compute how many are inexact + getnum :numsquares-:guess.exact ; without asking. + ] [ + askinexact ; Otherwise, ask for inexact. + make "gotnum "false + catch "ready [action.loop] + pu setpos [150 205] setpc 0 filled 0 [repeat 2 [fd 35 rt 90 fd 110 rt 90]] + setpc 7 + if :guess.exact + :guess.inexact > :numsquares ~ + [check.consistency []] ; Quick error message if too many matches. + ] +] [ + throw "win ; All colors are exact, we win. +] +end + +to subst :new :old :word +; For dups-okay guessing: Substitute the next trial color for +; all unknown squares in a partial permutation. +output map [ifelse equalp ? :old [:new] [?]] :word +end + +to copies :num :letter +output cascade :num [word ? :letter] " +end + +to insert :num :new :word +; For dups-okay guessing: We've learned that there are :NUM instances +; of color :NEW in the secret combination, so stick that many of them into +; a still-possible partial permutation, in every possible size=:NUM +; subset of the unknown slots. +; The result is a *stream* of possible (partial) permutations. +if :num=0 [output (list :word)] ; No slots needed, just one result. +if emptyp :word [output []] ; Not enough slots, no results! +if equalp first :word "x ; Else combine results of choosing or ~ + [op flatten ; not choosing to replace into this X. + stream insert :num-1 :new word :new butfirst :word + `[(list stream.map [word "x ?] insert ,:num ",:new bf ",:word )]] +output stream.map `[word ",[first :word] ?] insert :num :new butfirst :word +end + +to check.consistency :str +; If the stream of still-possible permutations is empty, then +; the user has lied to us. +if emptyp :str [ct print [Error -- inconsistent answers!] + repeat 2 [setbg 4 wait 1 setbg 0 wait 1] + type [Click or type anything to restart.] wait 0 + waitforclick + throw "master] +end + +to perms :word :num +; Output the stream of permutations of :NUM letters chosen from :WORD. +if :num=0 [output (list "|| )] +if emptyp :word [output []] ; Can't happen (would mean :num>count :word). +output flatten stream.map ~ + `[[letter] stream.map `[word ,:letter ?] + perms remonce :letter ,:word ,[:num-1]] ~ + :word +end + +to okay? :perm :guess.exact :guess.inexact :guess.word +output and (equalp :guess.exact exact :perm :guess.word) ~ + (equalp :guess.inexact inexact :perm :guess.word) +end + +to askexact +; ct type "|How many EXACT matches? | +; pu setpos [185 210] setpc 6 label "EXACT? +localmake "caption.scrunch 1.5 +setbutton [152 210] [100 25] [] "true 0 "EXACT? [] +ern "caption.scrunch +make "exact "true +end + +to askinexact +; ct type "|How many INEXACT matches? | +; pu setpos [185 210] setpc 6 label "INEXACT? +localmake "caption.scrunch 1.5 +setbutton [152 210] [100 25] [] "true 0 "INEXACT? [] +ern "caption.scrunch +make "exact "false +end + +;;; ================== LOGIC FOR USER GUESSES (MY SECRET) ================= + +to choose.dup :number :colors +if :number = 0 [output "] +output word (pick :colors) (choose.nodup :number-1 :colors) +end + +to choose.nodup :number :colors +if :number = 0 [output "] +make "color pick :colors +output word :color (choose.nodup :number-1 remonce :color :colors) +end + +;;;;; ================ Used by both kinds of logic ====================== + +to exact :secret :guess +if empty? :secret [output 0] +output ehelp + (exact butfirst :secret butfirst :guess) +end + +to ehelp +ifelse equal? (first :secret) (first :guess) [output 1] [output 0] +end + +to inexact :secret :guess +output (anymatch :secret :guess) - (exact :secret :guess) +end + +to anymatch :secret :guess +if empty? :secret [output 0] +if member? first :secret :guess ~ + [output 1 + anymatch (butfirst :secret) (remonce first :secret :guess)] +output anymatch butfirst :secret :guess +end + +to remonce :this :those +if empty? :those [output "] +if equal? :this first :those [output butfirst :those] +output word (first :those) (remonce :this butfirst :those) +end + +;;;;; =================== USER INTERFACE (DRAWING) ======================= + +to initdraw +fs init.buttons +localmake "bigwidth ifelse :LogoPlatform = "wxWidgets [5*first :fontsize] [40] +localmake "bigbutton list :bigwidth 25 +localmake "tallheight ifelse :LogoPlatform="wxWidgets [2+2*last :fontsize] [30] +localmake "tallbutton list :bigwidth :tallheight +ifelse :mysecret ~ + [colorchart 6 "ROYGBV [4 14 6 2 1 13] 165 + setbutton [-245 -15] :bigbutton [clear] "false 0 "erase "DEL] ~ + [numchart 0 165] +setbutton pos0 [-245 -45] :bigbutton [if not :winloop [guess]] "true 0 "OK "RET +setbutton nxt :tallheight :tallbutton [throw "master] "false 0 [new game] "N +setbutton nxt 25 :bigbutton [throw "quit] "false 0 "quit "Q +ignore nxt 10 +setbutton nxt :tallheight :tallbutton [make "mysecret "true throw "master] ~ + :mysecret 0 [I guess] "I +setbutton nxt :tallheight :tallbutton [make "mysecret "false throw "master] ~ + (not :mysecret) 0 [Logo guess] "L +caption [-245 206] [65 29] [Number |of colors:|] +numsquares -170 2 6 +caption [-10 206] [65 29] [Duplicates allowed:] +ifelse :LogoPlatform = "wxWidgets [ +localmake "buttonx ((first :fontsize)*10)-5 +setbutton list :buttonx 210 [25 25] [make "dup.ok "true throw "master] ~ + :dup.ok 0 "yes [] +setbutton list :buttonx+30 210 [25 25] [make "dup.ok "false throw "master] ~ + (not :dup.ok) 0 "no [] +] [ +setbutton [70 210] [25 25] [make "dup.ok "true throw "master] ~ + :dup.ok 0 "yes [] +setbutton [100 210] [25 25] [make "dup.ok "false throw "master] ~ + (not :dup.ok) 0 "no [] +] +end + +to numsquares :xcor :num :last +if :num > :last [stop] +setbutton (list :xcor 210) [25 25] `[make "numsquares ,:num throw "master] ~ + (:num = :numsquares) 0 :num [] +numsquares :xcor+30 :num+1 :last +end + +to colorchart :num :names :colors :ycor +if :num = 0 [stop] +setbutton (list -245 :ycor) [25 25] ~ + `[putguess ",[first :names] ,[first :colors]] "false ~ + (first :colors) [] (first :names) +colorchart :num-1 bf :names bf :colors :ycor-30 +end + +to numchart :num :ycor +if :num > :numsquares [stop] +setbutton (list -245 :ycor) [25 25] ~ + `[if not :winloop [getnum ,:num]] "false 0 :num :num +numchart :num+1 :ycor-30 +end + +to pos0 :pos +make "controlpos :pos +output :pos +end + +to nxt :height +make "controlpos list (first :controlpos) ((last :controlpos) - (:height + 5)) +output :controlpos +end + +to move :start +; Move the turtle to the given coordinates +; relative to the lower left corner of the first empty square +; in the current frame. +; Depends on :COLUMN (0 or 1 for >14 guesses), :NUMGUESSES, and :NUMCOLORS +; Note, since :NUMGUESSES starts at 1, +; first frame is at [-180 170] not [-180 200]. +pu +setpos (list (-145 + (first :start) + 210*:column + 25*(:numcolors-1)) + (200 + (last :start) - 30*(:numguesses - 14*:column))) +pd +end + +; ----------------------------------------------- + +to newguess +; Called from MASTER for first guess frame, +; then from GUESS for later guess frames (my secret), +; or from DOGUESS (user's secret). +make "numguesses :numguesses+1 +if :numguesses > 14 [make "column 1] +make "numcolors 1 +move [0 0] +drawframe +make "guess " +end + +to drawframe +setpc 7 seth 0 +repeat :numsquares [square 25 rt 90 fd 25 lt 90] +end + +to square :side +repeat 4 [fd :side rt 90] +end + +;;;;; =================== USER INTERFACE (READING) ======================= + +to waitforclick +action.off +; Wait for any key or mouse click, then return, ignoring which/where. +if buttonp [while [buttonp] [] stop] +if keyp [ignore rc stop] +waitforclick +end + +; ----------- Procedures to carry out user commands --------------- + +to getnum :num [:cursor cursor] +; Called for digit key or mouse click on digit button. +make ifelse :exact ["guess.exact] ["guess.inexact] :num +move list ifelse :exact [15] [35] 12 +setpc 0 filled 0 [repeat 4 [fd 20 rt 90]] +setpc 7 label :num +; type :num setcursor :cursor +make "gotnum "true +end + +to putguess :colorletter :colornumber +; Called from mouse click in color palette; +; first input is a letter for :GUESS (e.g. R for red), +; second input is a Logo color number for SETPC (e.g. 4 for red). +if :numcolors < 1 [stop] +if :numcolors > :numsquares [stop] +if not :dup.ok [if member? :colorletter :guess [stop]] +make "guess word :guess :colorletter +move [0 0] +filled :colornumber [repeat 4 [fd 25 rt 90]] +make "numcolors :numcolors+1 +end + +to clear +; Called by clicking ERASE button +if :numcolors < 2 [stop] +make "guess butlast :guess +make "numcolors :numcolors-1 +move [0 0] +filled 0 [repeat 4 [fd 25 rt 90]] +end + +to guess +; Called by clicking GUESS button. +if not :mysecret [if :gotnum [ct wait 0 throw "ready] stop] +if not (:numcolors > :numsquares) [stop] +ifelse equal? :guess :secret [ + move [15 12] + setpc 7 label "WIN! + print (sentence [You win in] :numguesses "turns.) +] [ + move [15 12] + setpc 7 label exact :secret :guess + move [35 12] + setpc 7 label inexact :secret :guess + newguess +] +end diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/match b/js/games/nluqo.github.io/~bh/downloads/csls-programs/match new file mode 100644 index 0000000..7b1d3b6 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/match @@ -0,0 +1,165 @@ +to match :pat :sen +local [special.var special.pred special.buffer in.list] +if or wordp :pat wordp :sen [output "false] +if emptyp :pat [output emptyp :sen] +if listp first :pat [output special fput "!: :pat :sen] +if memberp first first :pat [? # ! & @ ^] [output special :pat :sen] +if emptyp :sen [output "false] +if equalp first :pat first :sen [output match butfirst :pat butfirst :sen] +output "false +end + +;; Parsing quantifiers + +to special :pat :sen +set.special parse.special butfirst first :pat " +output run word "match first first :pat +end + +to parse.special :word :var +if emptyp :word [output list :var "always] +if equalp first :word ": [output list :var butfirst :word] +output parse.special butfirst :word word :var first :word +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 butfirst :pat +make "pat fput first :pat butfirst butfirst :pat +end + +to set.in +make "in.list first butfirst :pat +make "pat fput first :pat butfirst butfirst :pat +end + +;; Exactly one match + +to match! +if emptyp :sen [output "false] +if not try.pred [output "false] +make :special.var first :sen +output match butfirst :pat butfirst :sen +end + +;; Zero or one match + +to match? +make :special.var [] +if emptyp :sen [output match butfirst :pat :sen] +if not try.pred [output match butfirst :pat :sen] +make :special.var first :sen +if match butfirst :pat butfirst :sen [output "true] +make :special.var [] +output match butfirst :pat :sen +end + +;; Zero or more matches + +to match# +make :special.var [] +output #test #gather :sen +end + +to #gather :sen +if emptyp :sen [output :sen] +if not try.pred [output :sen] +make :special.var lput first :sen thing :special.var +output #gather butfirst :sen +end + +to #test :sen +if match butfirst :pat :sen [output "true] +if emptyp thing :special.var [output "false] +output #test2 fput last thing :special.var :sen +end + +to #test2 :sen +make :special.var butlast thing :special.var +output #test :sen +end + +;; One or more matches + +to match& +output &test match# +end + +to &test :tf +if emptyp thing :special.var [output "false] +output :tf +end + +;; Zero or more matches (as few as possible) + +to match^ +make :special.var [] +output ^test :sen +end + +to ^test :sen +if match butfirst :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 butfirst :sen +end + +;; Match words in a group + +to match@ +make :special.var :sen +output @test [] +end + +to @test :sen +if @try.pred [if match butfirst :pat :sen [output "true]] +if emptyp thing :special.var [output "false] +output @test2 fput last thing :special.var :sen +end + +to @test2 :sen +make :special.var butlast thing :special.var +output @test :sen +end + +;; Applying the predicates + +to try.pred +if listp :special.pred [output match :special.pred first :sen] +output run list :special.pred quoted first :sen +end + +to quoted :thing +if listp :thing [output :thing] +output word "" :thing +end + +to @try.pred +if listp :special.pred [output match :special.pred thing :special.var] +output run list :special.pred thing :special.var +end + +;; Special predicates + +to always :x +output "true +end + +to in :word +output memberp :word :in.list +end + +to anyof :sen +output anyof1 :sen :in.list +end + +to anyof1 :sen :pats +if emptyp :pats [output "false] +if match first :pats :sen [output "true] +output anyof1 :sen butfirst :pats +end diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/mines b/js/games/nluqo.github.io/~bh/downloads/csls-programs/mines new file mode 100644 index 0000000..76cf095 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/mines @@ -0,0 +1,483 @@ +; Minesweeper game + +; Mouse clicks call HIT procedure + +; Main data structure: array of arrays, e.g., +; (ITEM (ITEM STATUS 3) 5) for row 3 column 5. +; Values are: HIDDEN (tan square), +; FLAGGED (flagged as a mine), +; SHOWN (open, non-mine, shows number of mined neighbors), +; BORDER (just outside of actual playing field). +; Notice that a FLAGGED square might not really be a mine. +; (Player can make mistakes!) +; Actual mines are listed in MINES (list of [row col] lists). + +cslsload "buttons + +to mines +if :LogoPlatform = "Windows [maximize.window "true] +localmake "inference "false +localmake "newnmines 100 +localmake "newsize 15 +localmake "halfsize 10 +localmake "squaresize 2*:halfsize +localmake "maxxmax :halfsize*15*2 +localmake "maxymax :halfsize*15 +localmake "sizechoice 3 +localmake "hardchoice 2 +localmake "sizes [5 10 15] +localmake "hardness [38.1 44.45 59.26] +localmake "windows ifelse :LogoPlatform="Windows [16] [0] +if :LogoPlatform="wxWidgets [make "windows 16] +norefresh +catch "quit [forever [catch "newgame [setup :newnmines :newsize :newsize*2]]] +refresh +cs ct setpc 7 st +end + +; ------------------------ Initial setup --------------------------------- + +to setup :nmines :rows :columns +cs ct wait 0 ht fs +localmake "mines [] ; list of [row col] lists +localmake "statuses (array :rows+2 -1) ; status of each square +localmake "xmax :halfsize*:columns +localmake "ymax :halfsize*:rows +localmake "opening "true +localmake "playing "true ; false only at end of game +for [i -1 :rows] [setitem :i :statuses (array :columns+2 -1)] +putmines :nmines ; Choose mined squares randomly. +setbg 0 +setup.buttons +make "nhidden :rows * :columns +borderrow -1 :columns +borderrow :rows :columns + ; mark nonexistent squares just outside field as BORDER + ; to simplify how-many-of-my-neighbors computations +bordersides :rows-1 +hint ; open some safe squares so we don't have to guess blindly +localmake "prevmines -1 +pu setxy :maxxmax-100-2*:windows :maxymax+14 setpc 7 +label [Mines left:] +showminesleft +action.loop +end + +to putmines :num +; Choose random square, and make it a mine unless it already was one. +if :num = 0 [stop] +localmake "row random :rows +localmake "col random :columns +if member? (list :row :col) :mines [putmines :num stop] +make "mines fput (list :row :col) :mines +putmines :num-1 +end + +to setup.buttons +init.buttons +setbutton (list -:maxxmax :maxymax+10) [60 20] [throw "newgame] ~ + "false 0 "|NEW GAME| "G +setbutton (list 80-:maxxmax :maxymax+10) [40 20] [action.off throw "quit] ~ + "false 0 "QUIT "Q +caption (list 160-:maxxmax-:windows :maxymax+10) [60 20] "infer: +drawinferbuttons +caption (list -:maxxmax -(:maxymax+30)) [60 20] "size: +caption (list 160-:maxxmax-:windows -(:maxymax+30)) [80 20] "difficulty: +drawsizebuttons +setbutton (list -:xmax -:ymax) (list 2*:xmax 2*:ymax) ~ + [hit :mousepos showminesleft] "false 9 "|| [] + ; Entire board is one big button. +showboard "false ; input is TRUE to uncover entire board at end of game +pu +end + +to drawinferbuttons +rebutton (list 200-:maxxmax :maxymax+10) [20 20] ~ + [make "inference "true drawinferbuttons] ~ + :inference 0 "Y "Y +rebutton (list 230-:maxxmax :maxymax+10) [20 20] ~ + [make "inference "false drawinferbuttons] ~ + not :inference 0 "N "N +end + +to drawsizebuttons +make "newsize item :sizechoice :sizes +make "newnmines int (item :hardchoice :hardness)*:newsize*:newsize/100 +rebutton (list 40-:maxxmax -(:maxymax+30)) [20 20] ~ + [make "sizechoice 1 drawsizebuttons] ~ + :sizechoice=1 0 "S "S +rebutton (list 70-:maxxmax -(:maxymax+30)) [20 20] ~ + [make "sizechoice 2 drawsizebuttons] ~ + :sizechoice=2 0 "M "M +rebutton (list 100-:maxxmax -(:maxymax+30)) [20 20] ~ + [make "sizechoice 3 drawsizebuttons] ~ + :sizechoice=3 0 "L "L +rebutton (list 230-:maxxmax -(:maxymax+30)) [20 20] ~ + [make "hardchoice 1 drawsizebuttons] ~ + :hardchoice=1 0 "1 "1 +rebutton (list 260-:maxxmax -(:maxymax+30)) [20 20] ~ + [make "hardchoice 2 drawsizebuttons] ~ + :hardchoice=2 0 "2 "2 +rebutton (list 290-:maxxmax -(:maxymax+30)) [20 20] ~ + [make "hardchoice 3 drawsizebuttons] ~ + :hardchoice=3 0 "3 "3 +end + +to showminesleft +if :prevmines=:nmines [stop] +setpensize [2 2] +penerase +if :prevmines > 99 [pu seth 0 setxy :maxxmax-30 :maxymax+14 + invoke word "draw int :prevmines/100 7] +if :prevmines > 9 [pu seth 0 setxy :maxxmax-19 :maxymax+14 + invoke word "draw int (remainder :prevmines 100)/10 7] +if :prevmines > -1 [pu seth 0 setxy :maxxmax-8 :maxymax+14 + invoke word "draw remainder :prevmines 10 7] +penpaint +if :nmines > 99 [pu seth 0 setxy :maxxmax-30 :maxymax+14 + invoke word "draw int :nmines/100 7] +if :nmines > 9 [pu seth 0 setxy :maxxmax-19 :maxymax+14 + invoke word "draw int (remainder :nmines 100)/10 7] +if :nmines > -1 [pu seth 0 setxy :maxxmax-8 :maxymax+14 + invoke word "draw remainder :nmines 10 7] +make "prevmines :nmines +pu seth 0 setpensize [1 1] +end + +; --------------------------- Mark border squares ------------------------- + +to borderrow :row :col +; Mark all squares on this row (including -1 and :columns) as border +setstatus :row :col "border +if :col < 0 [stop] +borderrow :row :col-1 +end + +to bordersides :row +; Mark squares -1 and :columns on all rows as border +if :row < 0 [stop] +setstatus :row -1 "border +setstatus :row :columns "border +bordersides :row-1 +end + +; ---------------------- Initial and final display of entire board -------- + +to showboard :over +; Input is FALSE during setup, TRUE when a mine is uncovered and game ends. +setpc 7 +for [y -:ymax :ymax :squaresize] [pu setxy -:xmax :y pd setxy :xmax :y] +for [x -:xmax :xmax :squaresize] [pu setxy :x -:ymax pd setxy :x :ymax] +pu +turtlerows :rows-1 +end + +to turtlerows :row +if :row < 0 [stop] +turtlerow :columns-1 +turtlerows :row-1 +end + +to turtlerow :col +if :col < 0 [stop] +ifelse :over [ ; game over, only hidden squares need be displayed + if "hidden = status :row :col [onesquare] + if and ("flagged = status :row :col) + (not member? (list :row :col) :mines) [ + ; but indicate mistakenly flagged ones + setx (:col*:squaresize)-:xmax + sety (:row*:squaresize)-:ymax + setpensize [3 3] + setpc 4 ; draw red X over mine symbol + pd setxy xcor+:squaresize ycor+:squaresize + pu setx xcor-:squaresize + pd setxy xcor+:squaresize ycor-:squaresize + pu setpensize [1 1] setpc 7 + ] +] [ ; game starting, mark each square as hidden + setstatus :row :col "hidden + ] +turtlerow :col - 1 +end + +to onesquare +action.once +setx (:col*:squaresize)-:xmax +sety (:row*:squaresize)-:ymax +ifelse member? (list :row :col) :mines [ + setpc 2 ; thick green border + pu setxy xcor+1 ycor+1 + pd repeat 4 [fd :squaresize-2 rt 90] + pu setxy xcor+1 ycor+1 + pd filled 13 [repeat 4 [fd :squaresize-4 rt 90]] +] [ + setpc 11 ; grey in aqua border for empty + pu setxy xcor+1 ycor+1 + pd filled 15 [repeat 4 [fd :squaresize-2 rt 90]] +] +end + +; ---------------- Start game by uncovering a few safe squares -------------- + +to hint [:tries 30] [:inference "true] +if :tries=0 [stop] ; limit number of attempts +localmake "ohidden :nhidden +localmake "ry random :rows +localmake "rx random :columns +if and equalp status :ry :rx "hidden not member? (list :ry :rx) :mines [ + catch "error [hitsquare :ry :rx] + if (:ohidden - :nhidden) > 5 [stop] + ; stop when at least 5 neighbors were opened +] +(hint :tries-1) +end + +; -------- Main player activity, mouse clicks on minefield squares ----- + +to hit :pos +; Convert mouse (pixel) coordinate to column and row numbers +; (square is :squaresize x :squaresize pixels) +if not :playing [stop] +localmake "opening equalp :button 1 ; true to open, false to flag +catch "error [hitsquare (int (((last :pos) + :ymax) / :squaresize)) + (int (((first :pos) + :xmax) / :squaresize))] +end + +to hitsquare :row :col +; Called on player mouse click and automatic opening of neighbors +; when infering. +if :nhidden = 0 [stop] ; No hidden squares, game is over. +if (or (:row<0) (:row>=:rows) (:col<0) (:col>=:columns)) [stop] +penup +setx (:col*:squaresize)-:xmax ; Move turtle over chosen square +sety (:row*:squaresize)-:ymax +localmake "status status :row :col +localmake "near neighbors :row :col "minecheck +if not equal? :status "shown [ ; Clicking on hidden or flagged square. + if not :opening [showflag stop] ; FLAG mode. (Below is OPEN mode.) + if :status = "flagged [showflag stop] ; Can't open flagged square. + setstatus :row :col "shown ; This square is now shown. + if member? (list :row :col) :mines [lose stop] ; Oops! + setpc 11 ; aqua border + pu setxy xcor+1 ycor+1 + pd filled 15 [repeat 4 [fd :squaresize-2 rt 90]] + setpensize [2 2] seth 0 pu + setxy xcor+6 ycor+3 + if :near>0 word "draw :near ; Run procedure to draw digit + pu setpensize [1 1] seth 0 + make "nhidden :nhidden - 1 ; Keep track of number of squares still hidden. + if :nhidden = 0 [win stop] ; If all squares shown or flagged, we win! + if and (not equal? :near 0) (not :inference) [stop] + ; Finished if no automatic inference +] + ; Automatic inference section: +localmake "hnear neighbors :row :col "hiddencheck +localmake "fnear neighbors :row :col "flaggedcheck +ifelse :fnear = :near [ ; If number of neighboring mines equals + localmake "opening "true ; number of flagged neighbors, + hitfriends :row :col ; all hidden neighbors must be safe + ; (unless player has flagged wrongly!) +] [ + if (:hnear + :fnear) = :near [ ; If number of neighboring mines equals + localmake "opening "false ; number of non-shown (hidden or flagged) + hitfriends :row :col ; neighbors, all hidden neighbors must be + ; mines. + ] +] +end + +; --------------- Automatic inference to speed up game ------------------ + +; Either OPEN or FLAG all eight immediate neighbors unless already open or +; flagged. Note mutual recursion: HITSQUARE calls HITFRIENDS to do inference; +; HITFRIENDS calls HITSQUARE for each inferred opening/flagging. + +to hitfriends :row :col +hitfriendsrow :row-1 :col +hitfriendsrow :row :col +hitfriendsrow :row+1 :col +end + +to hitfriendsrow :row :col +hitfriend :row :col-1 +hitfriend :row :col +hitfriend :row :col+1 +end + +to hitfriend :row :col +if "hidden = status :row :col [hitsquare :row :col] +end + +; Here's where we count the neighbors that have some property +; (being truly mined, being flagged as mined, or being hidden). +; Third input is a procedure that takes ROW and COL inputs, +; returning 1 if property is satisfied, 0 if not. + +to neighbors :row :col :check +output (nrow :row-1 :col) + (nrow :row :col) + (nrow :row+1 :col) +end + +to nrow :row :col +output (invoke :check :row :col-1) + (invoke :check :row :col) + ~ + (invoke :check :row :col+1) +end + +; Here are the three property-checking procedures. + +to minecheck :row :col +output ifelse member? (list :row :col) :mines [1] [0] +end + +to hiddencheck :row :col +output ifelse "hidden = status :row :col [1] [0] +end + +to flaggedcheck :row :col +output ifelse "flagged = status :row :col [1] [0] +end + +; --------------------- Flag mode (user says where mines are) -------------- + +to showflag +if :nhidden = 0 [stop] ; Game is over, no action allowed. +localmake "flagged status :row :col +ifelse :flagged = "hidden [ ; Square was hidden, so flag it. + if :nmines = 0 [stop] ; But don't allow more flags than actual mines. + setstatus :row :col "flagged + setpc 7 + filled 2 [repeat 4 [fd :squaresize rt 90]] + pu setxy xcor+6 ycor+3 + drawflag ; with purple flag + make "nmines :nmines-1 + make "nhidden :nhidden-1 +] [ + if not equal? :flagged "flagged [stop] ; Square was shown, can't flag it. + setstatus :row :col "hidden + setpc 7 + filled 9 [repeat 4 [fd :squaresize rt 90]] + make "nmines :nmines + 1 + make "nhidden :nhidden + 1 +] +if :nhidden = 0 [win] ; Flagged last mine, so win. +end + +to drawflag +setpc 13 ; purple for flag +setpensize [2 2] +pd fd 5 filled 13 [repeat 4 [fd 5 rt 90]] +end + +; ------------ Notify user when game is won or lost ------------------- + +to win +make "playing "false +make "nhidden 0 +; print [You win!!!!] +pu setxy :xmax+3 0 ; flash screen green +repeat 5 [setpc 2 fill wait 0 action.once setpc 0 fill wait 0] +end + +to lose +make "playing "false +setpc 6 ; Yellow square on purple +setpensize [3 3] +pu setxy xcor+3 ycor+3 pd +filled 13 [repeat 4 [fd :squaresize-6 rt 90]] ; Show which mine was hit +setpensize [1 1] +make "nhidden 0 +; print [You lose!!!!] +pu setxy :xmax+3 0 ; flash screen red +repeat 5 [setpc 4 fill wait 0 action.once setpc 0 fill wait 0] +showboard "true +end + +; --------------- data abstraction for statuses array ------------- + +to status :row :col +output item :col (item :row :statuses) +end + +to setstatus :row :col :value +setitem :col (item :row :statuses) :value +end + + +; -------------------- draw digits ---------------------- + +to draw1 [:color 4] +setpc :color ; red +pd rt 90 fd 6 bk 3 +lt 90 fd 12 +lt 90+45 fd 4 +end + +to draw2 [:color 13] +setpc :color ; purple +pu setxy xcor-1 ycor+2 +pd rt 90 fd 6 bk 6 +lt 45 fd 8 +rt 45 pu bk 3 pd arc -180 3 +end + +to draw3 [:color 0] +setpc :color ; black +pu fd 12 rt 90 +pd fd 6 +rt 90+45 fd 7 +pu lt 45 fd 3 pd arc -130 3 +end + +to draw4 [:color 8] +setpc :color ; brown +pu fd 6 +pd fd 6 bk 6 +rt 90 fd 6 bk 3 +lt 90 fd 6 bk 12 +end + +to draw5 [:color 10] +setpc :color ; forest +pu fd 12 +pd rt 90 fd 6 bk 6 +rt 90 fd 5 +pu fd 3 pd arc -180 3 +end + +to draw6 [:color 12] +setpc :color ; salmon +pu fd 7 rt 90 fd 1 pd +repeat 270 [fd 0.07 rt 1] +repeat 45 [fd 0.3 rt 2] +end + +to draw7 [:color 1] +setpc :color ; blue +pu fd 11 rt 90 +pd fd 6 +rt 90+30 fd 9 +end + +to draw8 [:color 5] +setpc :color ; magenta +pu fd 3 rt 90 fd 2 +pd arc 359 3 +pu lt 90 fd 6 +pd arc 359 3 +end + +to draw9 [:color 7] +setpc :color +pu fd 12 rt 90 fd 6 rt 90 ; like 6 but upside down +pu fd 7 rt 90 fd 1 pd +repeat 270 [fd 0.07 rt 1] +repeat 45 [fd 0.3 rt 2] +end + +to draw0 [:color 7] +setpc :color +pu fd 6 pd +repeat 90 [fd (2-repcount/90)*6/150 rt 1] +repeat 90 [fd (1+repcount/90)*6/150 rt 1] +repeat 90 [fd (2-repcount/90)*6/150 rt 1] +repeat 90 [fd (1+repcount/90)*6/150 rt 1] +end diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/multi b/js/games/nluqo.github.io/~bh/downloads/csls-programs/multi new file mode 100644 index 0000000..53b7be3 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/multi @@ -0,0 +1,36 @@ +program multi; + {Multinomial expansion problem} + +var memo: array [0..4, 0..7] of integer; + i,j: integer; + +function t(n,k:integer) : integer; + + function realt(n,k:integer) : integer; + {without memoization} + + begin {realt} + if k = 0 then + realt := 1 + else + if n = 0 then + realt := 0 + else + realt := t(n,k-1)+t(n-1,k) + end; {realt} + + begin {t} + if memo[n,k] < 0 then + memo[n,k] := realt(n,k); + t := memo[n,k] + end; {t} + +begin {main program} + {initialization} + for i := 0 to 4 do + for j := 0 to 7 do + memo[i,j] := -1; + + {How many terms in (a+b+c+d)^7?} + writeln(t(4,7)); +end. diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/pascal b/js/games/nluqo.github.io/~bh/downloads/csls-programs/pascal new file mode 100644 index 0000000..0aae43c --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/pascal @@ -0,0 +1,1217 @@ +to compile :file +if namep "peekchar [ern "peekchar] +if namep "peektoken [ern "peektoken] +if not namep "idlist [opsetup] +if not emptyp :file [openread :file] +setread :file +ignore error +catch "error [program] +localmake "error error +if not emptyp :error [print first butfirst :error] +setread [] +if not emptyp :file [close :file] +end + +;; Global setup + +to opsetup +make "numregs 32 +make "memsize 3000 +pprop "|=| "binary [eql 2 [boolean []] 1] +pprop "|<>| "binary [neq 2 [boolean []] 1] +pprop "|<| "binary [less 2 [boolean []] 1] +pprop "|>| "binary [gtr 2 [boolean []] 1] +pprop "|<=| "binary [leq 2 [boolean []] 1] +pprop "|>=| "binary [geq 2 [boolean []] 1] +pprop "|+| "binary [add 2 [[] []] 2] +pprop "|-| "binary [sub 2 [[] []] 2] +pprop "or "binary [lor 2 [boolean boolean] 2] +pprop "|*| "binary [mul 2 [[] []] 3] +pprop "|/| "binary [quo 2 [real []] 3] +pprop "div "binary [div 2 [integer integer] 3] +pprop "mod "binary [rem 2 [integer integer] 3] +pprop "and "binary [land 2 [boolean boolean] 3] +pprop "|+| "unary [plus 1 [[] []] 4] +pprop "|-| "unary [minus 1 [[] []] 4] +pprop "not "unary [lnot 1 [boolean boolean] 4] +make "idlist `[[trunc function int [1 ,[framesize.fun+1]]] + [round function round [1 ,[framesize.fun+1]]] + [random function random [1 ,[framesize.fun+1]]]] +make "int [integer real] +make "round [integer real] +make "random [integer integer] +end + +;; Block structure + +to program +mustbe "program +localmake "progname token +ifbe "|(| [ignore commalist [id] mustbe "|)|] +mustbe "|;| +localmake "lexical.depth 0 +localmake "namesused [] +localmake "needint "false +localmake "needround "false +localmake "needrandom "false +localmake "idlist :idlist +localmake "frame [0 0] +localmake "id (list :progname "program (newlname :progname) :frame) +push "idlist :id +localmake "codeinto word "% :progname +make :codeinto [] +localmake "framesize framesize.proc +program1 +mustbe ". +code [exit] +foreach [int round random] "plibrary +make :codeinto reverse thing :codeinto +end + +to program1 +localmake "regsused (array :numregs 0) +for [i reg.firstfree :numregs-1] [setitem :i :regsused "false] +ifbe "var [varpart] +.setfirst butfirst :frame :framesize +if :lexical.depth = 0 [code (list "add reg.globalptr reg.zero reg.zero) + code (list "add reg.frameptr reg.zero reg.zero) + code (list "addi reg.stackptr reg.zero :framesize)] +localmake "bodytag gensym +code (list "jump (word "" :bodytag)) +tryprocpart +code :bodytag +mustbe "begin +blockbody "end +end + +to plibrary :func +if not thing (word "need :func) [stop] +code :func +code (list "rload reg.firstfree (memaddr framesize.fun reg.frameptr)) +code (list (word "s :func) reg.retval reg.firstfree) +code (list "add reg.stackptr reg.frameptr reg.zero) +code (list "rload reg.frameptr (memaddr frame.prevframe reg.stackptr)) +code (list "jr reg.retaddr) +end + +;; Variable declarations + +to varpart +local [token namelist type] +make "token token +make "peektoken :token +if reservedp :token [stop] +vargroup +foreach :namelist [newvar ? :type] +mustbe "|;| +varpart +end + +to vargroup +make "namelist commalist [id] +mustbe ": +ifbe "packed [] +make "type token +ifelse equalp :type "array [make "type arraytype] [typecheck :type] +end + +to id +local "token +make "token token +if letterp ascii first :token [output :token] +make "peektoken :token +output [] +end + +to arraytype +local [ranges type] +mustbe "|[| +make "ranges commalist [range] +mustbe "|]| +mustbe "of +make "type token +typecheck :type +output list :type :ranges +end + +to range +local [first last] +make "first range1 +mustbe ".. +make "last range1 +if :first > :last ~ + [(throw "error (sentence [array bounds not increasing:] + :first ".. :last))] +output list :first (1 + :last - :first) +end + +to range1 +local "bound +make "bound token +if equalp first :bound "' [output ascii first butfirst :bound] +if equalp :bound "|-| [make "bound minus token] +if equalp :bound int :bound [output :bound] +(throw "error sentence [array bound not ordinal:] :bound) +end + +to typecheck :type +if memberp :type [real integer char boolean] [stop] +(throw "error sentence [undefined type] :type) +end + +to newvar :pname :type +if reservedp :pname [(throw "error sentence :pname [reserved word])] +push "idlist (list :pname :type (list :lexical.depth :framesize) "false) +make "framesize :framesize + ifelse listp :type [arraysize :type] [1] +end + +to arraysize :type +output reduce "product map [last ?] last :type +end + +;; Procedure and function declarations + +to tryprocpart +ifbeelse "procedure ~ + [procedure tryprocpart] ~ + [ifbe "function [function tryprocpart]] +end + +to procedure +proc1 "procedure framesize.proc +end + +to function +proc1 "function framesize.fun +end + +to proc1 :proctype :framesize +localmake "procname token +localmake "lexical.depth :lexical.depth+1 +localmake "frame (list :lexical.depth 0) +push "idlist (list :procname :proctype (newlname :procname) :frame) +localmake "idlist :idlist +make lname :procname [] +ifbe "|(| [arglist] +if equalp :proctype "function ~ + [mustbe ": + localmake "type token + typecheck :type + make lname :procname fput :type thing lname :procname] +mustbe "|;| +code lname :procname +code (list "store reg.retaddr (memaddr frame.retaddr reg.frameptr)) +program1 +if equalp :proctype "function ~ + [code (list "rload reg.retval (memaddr frame.retval reg.frameptr))] +code (list "rload reg.retaddr (memaddr frame.retaddr reg.frameptr)) +code (list "add reg.stackptr reg.frameptr reg.zero) +code (list "rload reg.frameptr (memaddr frame.prevframe reg.stackptr)) +code (list "jr reg.retaddr) +mustbe "|;| +end + +to arglist +local [token namelist type varflag] +make "varflag "false +ifbe "var [make "varflag "true] +vargroup +foreach :namelist [newarg ? :type :varflag] +ifbeelse "|;| [arglist] [mustbe "|)|] +end + +to newarg :pname :type :varflag +if reservedp :pname [(throw "error sentence :pname [reserved word])] +localmake "pointer (list :lexical.depth :framesize) +push "idlist (list :pname :type :pointer :varflag) +make "framesize :framesize + ifelse (and listp :type not :varflag) ~ + [arraysize :type] [1] +queue lname :procname ifelse :varflag [list "var :type] [:type] +end + +;; Statement part + +to blockbody :endword +statement +ifbeelse "|;| [blockbody :endword] [mustbe :endword] +end + +to statement +local [token type] +ifbe "begin [compound stop] +ifbe "for [pfor stop] +ifbe "if [pif stop] +ifbe "while [pwhile stop] +ifbe "repeat [prepeat stop] +ifbe "write [pwrite stop] +ifbe "writeln [pwriteln stop] +make "token token +make "peektoken :token +if memberp :token [|;| end until] [stop] +make "type gettype :token +if emptyp :type [(throw "error sentence :token [can't begin statement])] +if equalp :type "procedure [pproccall stop] +if equalp :type "function [pfunset stop] +passign +end + +;; Compound statement + +to compound +blockbody "end +end + +;; Structured statements + +to pfor +local [var init step final looptag endtag testreg] +make "var token +mustbe "|:=| +make "init pinteger pexpr +make "step 1 +ifbeelse "downto [make "step -1] [mustbe "to] +make "final pinteger pexpr +mustbe "do +make "looptag gensym +make "endtag gensym +code :looptag +localmake "id getid :var +codestore :init (id.pointer :id) (id.varp :id) 0 +make "testreg newregister +code (list (ifelse :step<0 ["less] ["gtr]) :testreg :init :final) +code (list "jumpt :testreg (word "" :endtag)) +regfree :testreg +statement +code (list "addi :init :init :step) +code (list "jump (word "" :looptag)) +code :endtag +regfree :init +regfree :final +end + +to prepeat +local [cond looptag] +make "looptag gensym +code :looptag +blockbody "until +make "cond pboolean pexpr +code (list "jumpf :cond (word "" :looptag)) +regfree :cond +end + +to pif +local [cond elsetag endtag] +make "cond pboolean pexpr +make "elsetag gensym +make "endtag gensym +mustbe "then +code (list "jumpf :cond (word "" :elsetag)) +regfree :cond +statement +code (list "jump (word "" :endtag)) +code :elsetag +ifbe "else [statement] +code :endtag +end + +to pwhile +local [cond looptag endtag] +make "looptag gensym +make "endtag gensym +code :looptag +make "cond pboolean pexpr +code (list "jumpf :cond (word "" :endtag)) +regfree :cond +mustbe "do +statement +code (list "jump (word "" :looptag)) +code :endtag +end + +;; Simple statements: write and writeln + +to pwrite +mustbe "|(| +pwrite1 +end + +to pwrite1 +pwrite2 +ifbe "|)| [stop] +ifbeelse ", [pwrite1] [(throw "error [missing comma])] +end + +to pwrite2 +localmake "result pwrite3 +ifbe ": [.setfirst (butfirst :result) token] +code :result +if not equalp first :result "putstr [regfree last :result] +end + +to pwrite3 +localmake "token token +if equalp first :token "' ~ + [output (list "putstr 1 (list butlast butfirst :token))] +make "peektoken :token +localmake "result pexpr +if equalp first :result "char [output (list "putch 1 pchar :result)] +if equalp first :result "boolean [output (list "puttf 1 pboolean :result)] +if equalp first :result "integer [output (list "putint 10 pinteger :result)] +output (list "putreal 20 preal :result) +end + +to pwriteln +ifbe "|(| [pwrite1] +code [newline] +end + +;; Simple statements: procedure call + +to pproccall +localmake "pname token +localmake "id getid :pname +localmake "lname id.lname :id +localmake "vartypes thing :lname +pproccall1 framesize.proc +end + +to pproccall1 :offset +code (list "store reg.newfp (memaddr frame.save.newfp reg.stackptr)) +code (list "add reg.newfp reg.stackptr reg.zero) +code (list "addi reg.stackptr reg.stackptr (last id.frame :id)) +code (list "store reg.frameptr (memaddr frame.prevframe reg.newfp)) +localmake "newdepth first id.frame :id +ifelse :newdepth > :lexical.depth ~ + [code (list "store reg.frameptr + (memaddr frame.outerframe reg.newfp))] ~ + [localmake "tempreg newregister + code (list "rload :tempreg (memaddr frame.outerframe reg.frameptr)) + repeat (:lexical.depth - :newdepth) + [code (list "rload :tempreg + (memaddr frame.outerframe :tempreg))] + code (list "store :tempreg (memaddr frame.outerframe reg.newfp)) + regfree :tempreg] +if not emptyp :vartypes [mustbe "|(| procargs :vartypes :offset] +for [i reg.firstfree :numregs-1] ~ + [if item :i :regsused + [code (list "store :i (memaddr frame.regsave+:i reg.frameptr))]] +code (list "add reg.frameptr reg.newfp reg.zero) +code (list "rload reg.newfp (memaddr frame.save.newfp reg.frameptr)) +code (list "jal reg.retaddr (word "" :lname)) +for [i reg.firstfree :numregs-1] ~ + [if item :i :regsused + [code (list "rload :i (memaddr frame.regsave+:i reg.frameptr))]] +end + +to procargs :types :offset +if emptyp :types [mustbe "|)| stop] +localmake "next procarg first :types :offset +if not emptyp butfirst :types [mustbe ",] +procargs butfirst :types :offset+:next +end + +to procarg :type :offset +local "result +if equalp first :type "var [output procvararg last :type] +if listp :type [output procarrayarg :type] +make "result check.type :type pexpr +code (list "store :result (memaddr :offset reg.newfp)) +regfree :result +output 1 +end + +to procvararg :ftype +local [pname id type index] +make "pname token +make "id getid :pname +make "type id.type :id +ifelse wordp :ftype ~ + [setindex "true] ~ + [make "index 0] +if not equalp :type :ftype ~ + [(throw "error sentence :pname [arg wrong type])] +localmake "target memsetup (id.pointer :id) (id.varp :id) :index +localmake "tempreg newregister +code (list "addi :tempreg (last :target) (first :target)) +code (list "store :tempreg (memaddr :offset reg.newfp)) +regfree last :target +regfree :tempreg +output 1 +end + +to procarrayarg :type +localmake "pname token +localmake "id getid :pname +if not equalp :type (id.type :id) ~ + [(throw "error (sentence "array :pname [wrong type for arg]))] +localmake "size arraysize :type +localmake "rtarget memsetup (id.pointer :id) (id.varp :id) 0 +localmake "pointreg newregister +code (list "addi :pointreg reg.newfp :offset) +localmake "ltarget (list 0 :pointreg) +copyarray +output :size +end + +;; Simple statements: assignment statement (including function value) + +to passign +local [name id type index value pointer target] +make "name token +make "index [] +ifbe "|[| [make "index commalist [pexpr] mustbe "|]|] +mustbe "|:=| +make "id getid :name +make "pointer id.pointer :id +make "type id.type :id +passign1 +end + +to pfunset +local [name id type index value pointer target] +make "name token +make "index [] +if not equalp :name :procname ~ + [(throw "error sentence [assign to wrong function] :name)] +mustbe "|:=| +make "pointer (list :lexical.depth frame.retval) +make "type first thing lname :name +make "id (list :name :type :pointer "false) +passign1 +end + +to passign1 +if and (listp :type) (emptyp :index) [parrayassign :id stop] +setindex "false +make "value check.type :type pexpr +codestore :value (id.pointer :id) (id.varp :id) :index +regfree :value +end + +to noimmediate :value +if equalp exp.mode :value "immediate ~ + [localmake "reg newregister + code (list "addi :reg reg.zero exp.value :value) + output (list exp.type :value "register :reg)] +output :value +end + +to check.type :type :result +if equalp :type "real [output preal :result] +if equalp :type "integer [output pinteger :result] +if equalp :type "char [output pchar :result] +if equalp :type "boolean [output pboolean :result] +end + +to preal :expr [:pval noimmediate :expr] +if equalp exp.type :pval "real [output exp.value :pval] +output pinteger :pval +end + +to pinteger :expr [:pval noimmediate :expr] +local "type +make "type exp.type :pval +if memberp :type [integer boolean char] [output exp.value :pval] +(throw "error sentence exp.type :pval [isn't ordinal]) +end + +to pchar :expr [:pval noimmediate :expr] +if equalp exp.type :pval "char [output exp.value :pval] +(throw "error sentence exp.type :pval [not character value]) +end + +to pboolean :expr [:pval noimmediate :expr] +if equalp exp.type :pval "boolean [output exp.value :pval] +(throw "error sentence exp.type :pval [not true or false]) +end + +to parrayassign :id +localmake "right token +if equalp first :right "' ~ + [pstringassign :type (butlast butfirst :right) stop] +localmake "rid getid :right +if not equalp (id.type :id) (id.type :rid) ~ + [(throw "error (sentence "arrays :name "and :right [unequal types]))] +localmake "size arraysize id.type :id +localmake "ltarget memsetup (id.pointer :id) (id.varp :id) 0 +localmake "rtarget memsetup (id.pointer :rid) (id.varp :rid) 0 +copyarray +end + +to pstringassign :type :string +if not equalp first :type "char [stringlose] +if not emptyp butfirst last :type [stringlose] +if not equalp (last first last :type) (count :string) [stringlose] +localmake "ltarget memsetup (id.pointer :id) (id.varp :id) 0 +pstringassign1 newregister (first :ltarget) (last :ltarget) :string +regfree last :ltarget +end + +to pstringassign1 :tempreg :offset :reg :string +if emptyp :string [regfree :tempreg stop] +code (list "addi :tempreg reg.zero ascii first :string) +code (list "store :tempreg (memaddr :offset :reg)) +pstringassign1 :tempreg :offset+1 :reg (butfirst :string) +end + +to stringlose +(throw "error sentence :name [not string array or wrong size]) +end + +;; Multiple array indices to linear index computation + +to setindex :parseflag +ifelse listp :type ~ + [if :parseflag + [mustbe "|[| make "index commalist [pexpr] mustbe "|]| ] + make "index lindex last :type :index + make "type first :type] ~ + [make "index 0] +end + +to lindex :bounds :index +output lindex1 (offset pinteger noimmediate first :index + first first :bounds) ~ + butfirst :bounds butfirst :index +end + +to lindex1 :sofar :bounds :index +if emptyp :bounds [output :sofar] +output lindex1 (nextindex :sofar + last first :bounds + pinteger noimmediate first :index + first first :bounds) ~ + butfirst :bounds butfirst :index +end + +to nextindex :old :factor :new :offset +code (list "muli :old :old :factor) +localmake "newreg offset :new :offset +code (list "add :old :old :newreg) +regfree :newreg +output :old +end + +to offset :indexreg :lowbound +if not equalp :lowbound 0 [code (list "subi :indexreg :indexreg :lowbound)] +output :indexreg +end + +;; Memory interface: load and store instructions + +to codeload :reg :pointer :varflag :index +localmake "target memsetup :pointer :varflag :index +code (list "rload :reg targetaddr) +regfree last :target +end + +to codestore :reg :pointer :varflag :index +localmake "target memsetup :pointer :varflag :index +code (list "store :reg targetaddr) +regfree last :target +end + +to targetaddr +output memaddr (first :target) (last :target) +end + +to memaddr :offset :index +output (word :offset "\( :index "\)) +end + +to memsetup :pointer :varflag :index +localmake "depth first :pointer +localmake "offset last :pointer +local "newreg +ifelse equalp :depth 0 ~ + [make "newreg reg.globalptr] ~ + [ifelse equalp :depth :lexical.depth + [make "newreg reg.frameptr] + [make "newreg newregister + code (list "rload :newreg + (memaddr frame.outerframe reg.frameptr)) + repeat (:lexical.depth - :depth) - 1 + [code (list "rload :newreg + (memaddr frame.outerframe :newreg))]]] +if :varflag ~ + [ifelse :newreg = reg.frameptr + [make "newreg newregister + code (list "rload :newreg (memaddr :offset reg.frameptr))] + [code (list "rload :newreg (memaddr :offset :newreg))] + make "offset 0] +if not equalp :index 0 ~ + [code (list "add :index :index :newreg) + regfree :newreg + make "newreg :index] +output list :offset :newreg +end + +to copyarray +localmake "looptag gensym +localmake "sizereg newregister +code (list "addi :sizereg reg.zero :size) +code :looptag +localmake "tempreg newregister +code (list "rload :tempreg (memaddr (first :rtarget) (last :rtarget))) +code (list "store :tempreg (memaddr (first :ltarget) (last :ltarget))) +code (list "addi (last :rtarget) (last :rtarget) 1) +code (list "addi (last :ltarget) (last :ltarget) 1) +code (list "subi :sizereg :sizereg 1) +code (list "gtr :tempreg :sizereg reg.zero) +code (list "jumpt :tempreg (word "" :looptag)) +regfree :sizereg +regfree :tempreg +regfree last :ltarget +regfree last :rtarget +end + +;; Expressions + +to pexpr +local [opstack datastack parenlevel] +make "opstack [[popen 1 0]] +make "datastack [] +make "parenlevel 0 +output pexpr1 +end + +to pexpr1 +local [token op] +make "token token +while [equalp :token "|(|] [popen make "token token] +make "op pgetunary :token +if not emptyp :op [output pexprop :op] +push "datastack pdata :token +make "token token +while [and (:parenlevel > 0) (equalp :token "|)| )] ~ + [pclose make "token token] +make "op pgetbinary :token +if not emptyp :op [output pexprop :op] +make "peektoken :token +pclose +if not emptyp :opstack [(throw "error [too many operators])] +if not emptyp butfirst :datastack [(throw "error [too many operands])] +output pop "datastack +end + +to pexprop :op +while [(op.prec :op) < (1 + op.prec first :opstack)] [ppopop] +push "opstack :op +output pexpr1 +end + +to popen +push "opstack [popen 1 0] +make "parenlevel :parenlevel + 1 +end + +to pclose +while [(op.prec first :opstack) > 0] [ppopop] +ignore pop "opstack +make "parenlevel :parenlevel - 1 +end + +to pgetunary :token +output gprop :token "unary +end + +to pgetbinary :token +output gprop :token "binary +end + +to ppopop +local [op function args left right type reg] +make "op pop "opstack +make "function op.instr :op +if equalp :function "plus [stop] +make "args op.nargs :op +make "right pop "datastack +make "left (ifelse equalp :args 2 [pop "datastack] [[[] []]]) +make "type pnewtype :op exp.type :left exp.type :right +if equalp exp.mode :left "immediate ~ + [localmake "leftreg newregister + code (list "addi :leftreg reg.zero exp.value :left) + make "left (list exp.type :left "register :leftreg)] +ifelse equalp exp.mode :left "register ~ + [make "reg exp.value :left] ~ + [ifelse equalp exp.mode :right "register + [make "reg exp.value :right] + [make "reg newregister]] +if equalp :function "minus ~ + [make "left (list exp.type :right "register reg.zero) + make "function "sub + make "args 2] +if equalp exp.mode :right "immediate ~ + [make "function word :function "i] +ifelse equalp :args 2 ~ + [code (list :function :reg exp.value :left exp.value :right)] ~ + [code (list :function :reg exp.value :right)] +if not equalp :reg exp.value :left [regfree exp.value :left] +if (and (equalp exp.mode :right "register) + (not equalp :reg exp.value :right)) ~ + [regfree exp.value :right] +push "datastack (list :type "register :reg) +end + +to pnewtype :op :ltype :rtype +local "type +make "type op.types :op +if emptyp :ltype [make "ltype :rtype] +if not emptyp last :type [pchecktype last :type :ltype :rtype] +if and (equalp :ltype "real) (equalp :rtype "integer) [make "rtype "real] +if and (equalp :ltype "integer) (equalp :rtype "real) [make "ltype "real] +if not equalp :ltype :rtype [(throw "error [type clash])] +if emptyp last :type ~ + [if not memberp :rtype [integer real] + [(throw "error [nonarithmetic type])]] +if emptyp first :type [output :rtype] +output first :type +end + +to pchecktype :want :left :right +if not equalp :want :left [(throw "error (sentence :left "isn't :want))] +if not equalp :want :right [(throw "error (sentence :right "isn't :want))] +end + +;; Expression elements + +to pdata :token +if equalp :token "true [output [boolean immediate 1]] +if equalp :token "false [output [boolean immediate 0]] +if equalp first :token "' [output pchardata :token] +if numberp :token [output (list numtype :token "immediate :token)] +localmake "id getid :token +if emptyp :id [(throw "error sentence [undefined symbol] :token)] +localmake "type id.type :id +if equalp :type "function [output pfuncall :token] +local "index +setindex "true +localmake "reg newregister +codeload :reg (id.pointer :id) (id.varp :id) :index +output (list :type "register :reg) +end + +to pchardata :token +if not equalp count :token 3 ~ + [(throw "error sentence :token [not single character])] +output (list "char "immediate ascii first butfirst :token) +end + +to numtype :number +if memberp ". :number [output "real] +if memberp "e :number [output "real] +output "integer +end + +to pfuncall :pname +localmake "id getid :pname +localmake "lname id.lname :id +if namep (word "need :lname) [make (word "need :lname) "true] +localmake "vartypes thing :lname +localmake "returntype first :vartypes +make "vartypes butfirst :vartypes +pproccall1 framesize.fun +localmake "reg newregister +code (list "add :reg reg.retval reg.zero) +output (list :returntype "register :reg) +end + +;; Parsing assistance + +to code :stuff +if emptyp :stuff [stop] +push :codeinto :stuff +end + +to commalist :test [:sofar []] +local [result token] +make "result run :test +if emptyp :result [output :sofar] +ifbe ", [output (commalist :test (lput :result :sofar))] +output lput :result :sofar +end + +.macro ifbe :wanted :action +localmake "token token +if equalp :token :wanted [output :action] +make "peektoken :token +output [] +end + +.macro ifbeelse :wanted :action :else +localmake "token token +if equalp :token :wanted [output :action] +make "peektoken :token +output :else +end + +to mustbe :wanted +localmake "token token +if equalp :token :wanted [stop] +(throw "error (sentence "expected :wanted "got :token)) +end + +to newregister +for [i reg.firstfree :numregs-1] ~ + [if not item :i :regsused [setitem :i :regsused "true output :i]] +(throw "error [not enough registers available]) +end + +to regfree :reg +setitem :reg :regsused "false +end + +to reservedp :word +output memberp :word [and array begin case const div do downto else end ~ + file for forward function goto if in label mod nil ~ + not of packed procedure program record repeat set ~ + then to type until var while with] +end + +;; Lexical analysis + +to token +local [token char] +if namep "peektoken [make "token :peektoken + ern "peektoken output :token] +make "char getchar +if equalp :char "|{| [skipcomment output token] +if equalp :char char 32 [output token] +if equalp :char char 13 [output token] +if equalp :char char 10 [output token] +if equalp :char "' [output string "'] +if memberp :char [+ - * / = ( , ) |[| |]| |;|] [output :char] +if equalp :char "|<| [output twochar "|<| [= >]] +if equalp :char "|>| [output twochar "|>| [=]] +if equalp :char ". [output twochar ". [.]] +if equalp :char ": [output twochar ": [=]] +if numberp :char [output number :char] +if letterp ascii :char [output token1 lowercase :char] +(throw "error sentence [unrecognized character:] :char) +end + +to skipcomment +if equalp getchar "|}| [stop] +skipcomment +end + +to string :string +local "char +make "char getchar +if not equalp :char "' [output string word :string :char] +make "char getchar +if equalp :char "' [output string word :string :char] +make "peekchar :char +output word :string "' +end + +to twochar :old :ok +localmake "char getchar +if memberp :char :ok [output word :old :char] +make "peekchar :char +output :old +end + +to number :num +local "char +make "char getchar +if equalp :char ". ~ + [make "char getchar ~ + ifelse equalp :char ". ~ + [make "peektoken ".. output :num] ~ + [make "peekchar :char output number word :num ".]] +if equalp :char "e [output number word :num twochar "e [+ -]] +if numberp :char [output number word :num :char] +make "peekchar :char +output :num +end + +to token1 :token +local "char +make "char getchar +if or letterp ascii :char numberp :char ~ + [output token1 word :token lowercase :char] +make "peekchar :char +output :token +end + +to letterp :code +if and (:code > 64) (:code < 91) [output "true] +output and (:code > 96) (:code < 123) +end + +to getchar +local "char +if namep "peekchar [make "char :peekchar ern "peekchar output :char] +if eofp [output char 1] +output rc1 +end + +to rc1 +local "result +make "result readchar +type :result +output :result +end + +;; Data abstraction: ID List + +to newlname :word +if memberp :word :namesused [output gensym] +if namep word "% :word [output gensym] +push "namesused :word +output word "% :word +end + +to lname :word +local "result +make "result getid :word +if not emptyp :result [output item 3 :result] +(throw "error sentence [unrecognized identifier] :word) +end + +to gettype :word +local "result +make "result getid :word +if not emptyp :result [output item 2 :result] +(throw "error sentence [unrecognized identifier] :word) +end + +to getid :word [:list :idlist] +if emptyp :list [output []] +if equalp :word first first :list [output first :list] +output (getid :word butfirst :list) +end + +to id.type :id +output item 2 :id +end + +to id.pointer :id +output item 3 :id +end + +to id.lname :id +output item 3 :id +end + +to id.varp :id +output item 4 :id +end + +to id.frame :id +output item 4 :id +end + +;; Data abstraction: Frame slots + +to frame.retaddr +output 0 +end + +to frame.save.newfp +output 1 +end + +to frame.outerframe +output 2 +end + +to frame.prevframe +output 3 +end + +to frame.regsave +output 4 +end + +to framesize.proc +output 4+:numregs +end + +to frame.retval +output 4+:numregs +end + +to framesize.fun +output 5+:numregs +end + +;; Data abstraction: Operators + +to op.instr :op +output first :op +end + +to op.nargs :op +output first bf :op +end + +to op.types :op +output item 3 :op +end + +to op.prec :op +output last :op +end + +;; Data abstraction: Expressions + +to exp.type :exp +output first :exp +end + +to exp.mode :exp +output first butfirst :exp +end + +to exp.value :exp +output last :exp +end + +;; Data abstraction: Registers + +to reg.zero +output 0 +end + +to reg.retaddr +output 1 +end + +to reg.stackptr +output 2 +end + +to reg.globalptr +output 3 +end + +to reg.frameptr +output 4 +end + +to reg.newfp +output 5 +end + +to reg.retval +output 6 +end + +to reg.firstfree +output 7 +end + +;; Runtime (machine simulation) + +to prun :progname +localmake "prog thing word "% :progname +localmake "regs (array :numregs 0) +local filter "wordp :prog +foreach :prog [if wordp ? [make ? ?rest]] +localmake "memory (array :memsize 0) +setitem 0 :regs 0 +if not procedurep "add [runsetup] +prun1 :prog +end + +to prun1 :pc +if emptyp :pc [stop] +if listp first :pc [run first :pc] +prun1 butfirst :pc +end + +to rload :reg :offset :index +setitem :reg :regs (item (item :index :regs)+:offset :memory) +end + +to store :reg :offset :index +setitem (item :index :regs)+:offset :memory (item :reg :regs) +end + +to runsetup +foreach [[add sum] [sub difference] [mul product] [quo quotient] + [div [int quotient]] [rem remainder] [land product] + [lor [tobool lessp 0 sum]] [eql [tobool equalp]] + [neq [tobool not equalp]] [less [tobool lessp]] + [gtr [tobool greaterp]] [leq [tobool not greaterp]] + [geq [tobool not lessp]]] ~ + [define first ? + `[[dest src1 src2] + [setitem :dest :regs ,@[last ?] (item :src1 :regs) + (item :src2 :regs)]] + define word first ? "i + `[[dest src1 immed] + [setitem :dest :regs ,@[last ?] (item :src1 :regs) + :immed]]] +foreach [[lnot [difference 1]] [sint int] [sround round] [srandom random]] ~ + [define first ? + `[[dest src] + [setitem :dest :regs ,@[last ?] (item :src :regs)]] + define word first ? "i + `[[dest immed] + [setitem :dest :regs ,@[last ?] :immed]]] +end + +to tobool :tf +output ifelse :tf [1] [0] +end + +to jump :label +make "pc fput :label thing :label +end + +to jumpt :reg :label +if (item :reg :regs)=1 [jump :label] +end + +to jumpf :reg :label +if (item :reg :regs)=0 [jump :label] +end + +to jr :reg +make "pc item :reg :regs +end + +to jal :reg :label +setitem :reg :regs :pc +jump :label +end + +to putch :width :reg +spaces :width 1 +type char (item :reg :regs) +end + +to putstr :width :string +spaces :width (count first :string) +type :string +end + +to puttf :width :bool +spaces :width 1 +type ifelse (item :bool :regs)=0 ["F] ["T] +end + +to putint :width :reg +localmake "num (item :reg :regs) +spaces :width count :num +type :num +end + +to putreal :width :reg +putint :width :reg +end + +to spaces :width :count +if :width > :count [repeat :width - :count [type "| |]] +end + +to newline +print [] +end + +to exit +make "pc [exit] +end diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/playfair b/js/games/nluqo.github.io/~bh/downloads/csls-programs/playfair new file mode 100644 index 0000000..259b3d5 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/playfair @@ -0,0 +1,79 @@ +to playfair :keyword :message +local [matrix a b c d e f g h i j k l m n o p q r s t u v w x y z] +setkeyword jtoi lowercase :keyword +output encode (reduce "word :message) +end + +;; Prepare the code array + +to setkeyword :word +make "matrix reorder word :word (remove :word "abcdefghiklmnopqrstuvwxyz) +make "j :i +end + +to remove :letters :string +if emptyp :string [output "] +if memberp first :string :letters [output remove :letters bf :string] +output word first :string remove :letters bf :string +end + +to reorder :string +output reorder1 :string (mdarray [5 5]) 1 1 +end + +to reorder1 :string :array :row :column +if :row=6 [output :array] +if :column=6 [output reorder1 :string :array :row+1 1] +mdsetitem (list :row :column) :array first :string +make first :string (list :row :column) +output reorder1 (butfirst :string) :array :row :column+1 +end + +;; Encode the message + +to encode :message +if emptyp :message [output "] +if emptyp butfirst :message [output paircode first :message "q] +if equalp (jtoi first :message) (jtoi first butfirst :message) ~ + [output word (paircode first :message "q) (encode butfirst :message)] +output word (paircode first :message first butfirst :message) ~ + (encode butfirst butfirst :message) +end + +to paircode :one :two +local [row1 column1 row2 column2] +make "row1 first thing :one +make "column1 last thing :one +make "row2 first thing :two +make "column2 last thing :two +if :row1 = :row2 ~ + [output letters (list :row1 rotate (:column1+1)) ~ + (list :row1 rotate (:column2+1))] +if :column1 = :column2 ~ + [output letters (list rotate (:row1+1) :column1) ~ + (list rotate (:row2+1) :column1)] +output letters (list :row1 :column2) (list :row2 :column1) +end + +to rotate :index +output ifelse :index = 6 [1] [:index] +end + +to letters :one :two +output word letter :one letter :two +end + +to letter :rowcol +output itoj mditem :rowcol :matrix +end + +;; I and J conversion + +to jtoi :word +output map [ifelse equalp ? "j ["i] [?]] :word +end + +to itoj :letter +if :letter = "i [if (random 3) = 0 [output "j]] +output :letter +end diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/plot b/js/games/nluqo.github.io/~bh/downloads/csls-programs/plot new file mode 100644 index 0000000..bb144b9 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/plot @@ -0,0 +1,36 @@ +to plot :inputs +keyword :inputs [maxharm 5 deltax 2 yscale 75 cycles 1 xrange 230 skip 2] +localmake "xscale :cycles*180/:xrange +splitscreen clearscreen hideturtle penup +setpos list (-:xrange) 0 +pendown +for [x :deltax [2*:xrange] :deltax] ~ + [setpos list (xcor+:deltax) (:yscale * series :maxharm)] +end + +;; Compute the Fourier series values + +to series :harmonic +if :harmonic < 1 [output 0] +output (term :harmonic)+(series :harmonic-:skip) +end + +to term :harmonic +output (sin :xscale * :harmonic * :x) / :harmonic +end + +;; Handle keyword inputs + +.macro keyword :inputs :defaults +if or (wordp :inputs) (numberp first :inputs) ~ + [make "inputs sentence (first :defaults) :inputs] +output `[local ,[filter [not numberp ?] :defaults] + setup.values ,[:defaults] + setup.values ,[:inputs]] +end + +to setup.values :list +if emptyp :list [stop] +make first :list first butfirst :list +setup.values butfirst butfirst :list +end diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/pour b/js/games/nluqo.github.io/~bh/downloads/csls-programs/pour new file mode 100644 index 0000000..ee561e7 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/pour @@ -0,0 +1,130 @@ +;; Initialization + +to pour :sizes :goal +local [oldstates pitchers won] +make "oldstates (list all.empty :sizes) +make "pitchers fput 0 (map [#] :sizes) +make "won "false +win breadth.first make.path [] all.empty :sizes +end + +to all.empty :list +output map [0] :list +end + +;; Tree search + +to breadth.first :root +op breadth.descend (list :root) +end + +to breadth.descend :queue +if emptyp :queue [output []] +if :won [output last :queue] +op breadth.descend sentence (butfirst :queue) ~ + (children first :queue) +end + +;; Generate children + +to children :path +output map.se [children1 :path ?] :pitchers +end + +to children1 :path :from +output map.se [child :path :from ?] :pitchers +end + +to child :path :from :to +local [state newstate] +if :won [output []] +if equalp :from :to [output []] +make "state path.state :path +if not riverp :from ~ + [if equalp (water :from) 0 [output []]] +if not riverp :to ~ + [if equalp (water :to) (size :to) [output []]] +make "newstate (newstate :state :from :to) +if memberp :newstate :oldstates [output []] +make "oldstates fput :newstate :oldstates +if memberp :goal :newstate [make "won "true] +output (list make.path (fput list :from :to path.moves :path) :newstate) +end + +to newstate :state :from :to +if riverp :to [output replace :state :from 0] +if riverp :from [output replace :state :to (size :to)] +if (water :from) < (room :to) ~ + [output replace2 :state ~ + :from 0 ~ + :to ((water :from)+(water :to))] +output replace2 :state ~ + :from ((water :from)-(room :to)) ~ + :to (size :to) +end + +;; Printing the result + +to win :path +if emptyp :path [print [Can't do it!] stop] +foreach (reverse path.moves :path) "win1 +print sentence [Final quantities are] (path.state :path) +end + +to win1 :move +print (sentence [Pour from] (printform first :move) + [to] (printform last :move)) +end + +to printform :pitcher +if riverp :pitcher [output "river] +output size :pitcher +end + +;; Path data abstraction + +to make.path :moves :state +output fput :moves :state +end + +to path.moves :path +output first :path +end + +to path.state :path +output butfirst :path +end + +;; Pitcher data abstraction + +to riverp :pitcher +output equalp :pitcher 0 +end + +to size :pitcher +output item :pitcher :sizes +end + +to water :pitcher +output item :pitcher :state +end + +to room :pitcher +output (size :pitcher)-(water :pitcher) +end + +;; List processing utilities + +to replace :list :index :value +if equalp :index 1 [output fput :value butfirst :list] +output fput first :list (replace butfirst :list :index-1 :value) +end + +to replace2 :list :index1 :value1 :index2 :value2 +if equalp :index1 1 ~ + [output fput :value1 replace butfirst :list :index2-1 :value2] +if equalp :index2 1 ~ + [output fput :value2 replace butfirst :list :index1-1 :value1] +output fput first :list ~ + replace2 butfirst :list :index1-1 :value1 :index2-1 :value2 +end diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/psort b/js/games/nluqo.github.io/~bh/downloads/csls-programs/psort new file mode 100644 index 0000000..69aca33 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/psort @@ -0,0 +1,97 @@ +program psort; + {partition sort demo} + +var data: array [0..100] of integer; + i: integer; + +procedure showdata; + {print the array} + + var i: integer; + + begin {showdata} + for i := 0 to 99 do + begin + if i mod 20 = 0 then writeln; + write(data[i]:3) + end; + writeln; + writeln + end; {showdata} + +function median(lower,upper:integer):integer; + {find the median of three values from the data array} + var mid: integer; + + begin + mid := (lower+upper) div 2; + if (data[lower] <= data[mid]) and (data[mid] <= data[upper]) then + median := mid + else if (data[lower] >= data[mid]) and + (data[mid] >= data[upper]) then + median := mid + else if (data[mid] <= data[lower]) and + (data[lower] <= data[upper]) then + median := lower + else if (data[mid] >= data[lower]) and + (data[lower] >= data[upper]) then + median := lower + else median := upper + end; + +procedure sort(lower,upper:integer); + {sort part of the array} + + var key,i,j:integer; + + procedure exch(var a,b:integer); + {exchange two integers} + + var temp:integer; + + begin {exch} + temp := a; + a := b; + b := temp + end; {exch} + + begin {sort} + if upper > lower then + begin + exch (data[lower],data[median(lower,upper)]); + key := data[lower]; + i := lower; + j := upper+1; + repeat + i := i+1 + until data[i] >= key; + repeat + j := j-1 + until data[j] <= key; + while (i <= j) do + begin + exch(data[i], data[j]); + repeat + i := i+1 + until data[i] >= key; + repeat + j := j-1 + until data[j] <= key + end; + exch(data[lower], data[j]); + sort(lower,j-1); + sort(i,upper) + end + end; {sort} + +begin {main program} + data[100] := 200; + for i := 0 to 99 do + data[i] := random(100); + writeln('Data before sorting:'); + showdata; + + sort(0,99); + writeln('Data after sorting:'); + showdata +end. diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/solitaire b/js/games/nluqo.github.io/~bh/downloads/csls-programs/solitaire new file mode 100644 index 0000000..24211dc --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/solitaire @@ -0,0 +1,484 @@ +to solitaire +print [Welcome to solitaire] +instruct +localmake "allranks [A 2 3 4 5 6 7 8 9 10 J Q K] +localmake "numranks map "ranknum :allranks +localmake "suits [H S D C] +localmake "reds [H D] +localmake "deckarray (listtoarray (crossmap "word :allranks :suits) 0) +localmake "upping "false +catch "exit [forever [onegame cleartext]] +cleartext +end + +to s +solitaire +end + +to onegame +print [Shuffling, please wait...] +local [card cards digit pile where] +localmake "onto [] +local map [word "top ?] :suits +local cascade 9 [(sentence (word "shown #) (word "hidden #) ?)] [] +localmake "ranks :allranks +localmake "numstacks 7 +local map [word "num ?] :numranks +foreach :numranks [make word "num ? 4] +localmake "hand shuffle 52 :deckarray +setempty "pile +initstacks +foreach :suits [settop ? "] +redisplay +catch "endgame [forever [catch "bell [parsecmd]]] +end + +;; Initialization + +to instruct +print [] print [Here are the commands you can type:] +type "| | type (sentence standout "+ standout "=) +type "| | print [Deal three cards onto pile] +instruct1 "P [Play top card from pile] +instruct1 "R [Redisplay the board] +instruct1 "? [Retype these instructions] +instruct1 "card [Play that card] +instruct1 "M [Move same card again] +instruct1 "W [Play up as much as possible (Win)] +instruct1 "G [Give up (start a new game)] +instruct1 "X [Exit to Logo] +print [A card consists of a rank:] +type "| | print (sentence standout [A 2 3 4 5 6 7 8 9 10 J Q K] + "or standout "T [for 10]) +print [followed by a suit:] +type "| | print standout [H S D C] +print (sentence [or followed by] standout ". + [to play all possible suits up]) +print [] print [If you make a mistake, hit delete or backspace.] +print [] print [To move an entire stack,] +type "| | print [hit the shifted stack number:] +type "| | print (sentence standout [! @ # $ % ^ &] [for stacks]) +type "| | print [1 2 3 4 5 6 7] +print [] +end + +to instruct1 :key :meaning +type "| | +type standout :key +repeat 5-count :key [type "| |] +print :meaning +end + +to shuffle :len :array +if :len=0 [output arraytolist :array] +localmake "choice random :len +localmake "temp item :choice :array +setitem :choice :array (item :len-1 :array) +setitem :len-1 :array :temp +output shuffle :len-1 :array +end + +to initstacks +for [num 1 7] [inithidden :num + turnup :num] +end + +to inithidden :num +localmake "name hidden :num +setempty :name +repeat :num [push :name deal] +end + +;; Reading and interpreting user commands + +to parsecmd +if emptyp :digit [setcursor [1 22] type "| | setcursor [1 22]] +local "char +make "char uppercase readchar +if equalp :char "T [parsedigit 1 parsezero stop] +if memberp :char [1 2 3 4 5 6 7 8 9 A J Q K] [parsedigit :char stop] +if equalp :char "0 [parsezero stop] +if memberp :char :suits [play.by.name :char stop] +if equalp :char ". [allup stop] +if equalp :char "W [wingame stop] +if equalp :char "M [again stop] +if memberp :char [+ =] [hand3 stop] +if equalp :char "R [redisplay stop] +if equalp :char "? [helper stop] +if equalp :char "P [playpile stop] +if and equalp :char "|(| not emptyp :digit [cheat stop] +if and equalp :char "|)| not emptyp :digit [newstack stop] +if memberp :char [! @ # $ % ^ & * ( )] ~ + [playstack :char [! @ # $ % ^ & * ( )] stop] +if memberp :char (list "| | char 8 char 127) [rubout stop] +if equalp :char "G [throw "endgame] +if equalp :char "X [throw "exit] +bell +end + +to parsedigit :char +if not emptyp :digit [bell] +make "digit :char +type :digit +end + +to parsezero +if not equalp :digit 1 [bell] +make "digit 10 +type 0 +end + +to rubout +setcursor [1 22] +type "| | +setcursor [1 22] +setempty "digit +end + +to bell +if not :upping [type char 7] +setempty "digit +throw "bell +end + +;; Deal three cards from the hand + +to hand3 +if not emptyp :digit [bell] +if and emptyp :hand emptyp :pile [bell] +push "pile deal +repeat 2 [if not emptyp :hand [push "pile deal]] +dispile dishand +end + +to deal +if emptyp :hand [make "hand reverse :pile setempty "pile] +if emptyp :hand [output []] +output pop "hand +end + +;; Select card to play by position (pile or stack) or by name + +to playpile +if emptyp :pile [bell] +if not emptyp :digit [bell] +make "card first :pile +make "where [rempile] +carddis :card +playcard +end + +to playstack :which :list +if not emptyp :digit [bell] +foreach :list [if equalp :which ? [playstack1 # stop]] +end + +to playstack1 :num +if greaterp :num :numstacks [bell] +if stackemptyp shown :num [bell] +make "card last thing shown :num +make "where sentence "remshown :num +carddis :card +playcard +end + +to play.by.name :char +if emptyp :digit [bell] +if equalp :digit 1 [make "digit "a] +type :char +wait 0 +make "card word :digit :char +setempty "digit +findcard +if not emptyp :where [playcard] +end + +to findcard +if findpile [stop] +make "where findshown +if emptyp :where [bell] +end + +to findpile +if emptyp :pile [output "false] +if equalp :card first :pile [make "where [rempile] output "true] +output "false +end + +to findshown +for [num 1 :numstacks] ~ + [if memberp :card thing shown :num [output sentence "remshown :num]] +output [] +end + +;; Figure out all possible places to play card, then pick one + +to playcard +setempty "onto +if not coveredp [checktop] +if and not :upping ~ + or (emptyp :onto) (not upsafep rank :card) ~ + [checkonto] +if emptyp :onto [bell] +run :where +run first :onto +end + +to coveredp +if equalp :where [rempile] [output "false] +output not equalp :card first thing shown last :where +end + +to upsafep :rank +if memberp :rank [A 2] [output "true] +output equalp 0 thing word "num ((ranknum :rank)-2) +end + +to checktop +if (ranknum rank :card) = 1 + (ranknum top suit :card) ~ + [push "onto (list "playtop word "" suit :card)] +end + +to checkonto +for [num :numstacks 1] ~ + [ifelse stackemptyp shown :num + [checkempty :num] + [checkfull :num thing shown :num]] +end + +to checkempty :num +if equalp rank :card "k [push "onto (list "playonto :num)] +end + +to checkfull :num :stack +if equalp (redp :card) (redp first :stack) [stop] +if ((ranknum rank first :stack) = 1 + (ranknum rank :card)) ~ + [push "onto (list "playonto :num)] +end + +;; Play card, step 1: remove from old position + +to rempile +make "cards (list (pop "pile)) +dispile +end + +to remshown :num +setempty "cards +remshown1 :num (count thing shown :num) +if stackemptyp shown :num [turnup :num disstack :num] +end + +to remshown1 :num :length +do.until [push "cards (pop shown :num)] ~ + [equalp :card first :cards] +for [i 1 [count :cards]] ~ + [setcursor list (5*:num - 4) (5+:length-:i) type "| |] +end + +to turnup :num +setempty shown :num +if stackemptyp hidden :num [stop] +push (shown :num) (pop hidden :num) +end + +;; Play card, step 2: put in new position + +to playtop :suit +localmake "var word "num ranknum rank :card +settop :suit rank :card +distop :suit +make :var (thing :var)-1 +if (thing :var)=0 [make "ranks butfirst :ranks] +end + +to playonto :num +localmake "row 4+count thing shown :num +localmake "col 5*:num-4 +for [i 1 [count :cards]] ~ + [localmake "card pop "cards + push (shown :num) :card + setcursor list :col :row+:i + carddis :card] +end + +;; Update screen display + +to redisplay +cleartext +for [num 1 :numstacks] [disstack :num] +foreach :suits "distop +dispile +dishand +setcursor [1 22] +setempty "digit +end + +to disstack :num +setcursor list (-3 + 5 * :num) 4 +type ifelse stackemptyp hidden :num ["| |] ["-] +if stackemptyp shown :num [setcursor list (-4 + 5 * :num) 5 + type "| | stop] +localmake "stack (thing shown :num) +localmake "col 5*:num-4 +for [i [count :stack] 1] ~ + [setcursor list :col :i+4 + carddis pop "stack] +end + +to distop :suit +if emptyp top :suit [stop] +if equalp :suit "H [distop1 4 stop] +if equalp :suit "S [distop1 11 stop] +if equalp :suit "D [distop1 18 stop] +distop1 25 +end + +to distop1 :col +setcursor list :col 2 +carddis word (top :suit) :suit +end + +to dispile +setcursor [32 23] +ifelse emptyp :pile [type "| |] [carddis first :pile] +end + +to dishand +setcursor [27 23] +type count :hand +type "| | +end + +to carddis :card +ifelse memberp suit :card :reds [redtype :card] [blacktype :card] +type "| | +end + +to redtype :word +type :word +end + +to blacktype :word +type standout :word +end + + +;; Miscellaneous user commands + +to again +if not emptyp :digit [bell] +if emptyp :onto [bell] +make "where list "remshown last pop "onto +if emptyp :onto [bell] +carddis :card +run :where +run first :onto +end + +to helper +cleartext +instruct +print standout [type any key to continue] +ignore rc +redisplay +end + +to allup +if emptyp :digit [bell] +if equalp :digit 1 [make "digit "a] +localmake "upping "true +type ". wait 0 +foreach map [word :digit ?] [H S D C] ~ + [catch "bell [make "card ? + findcard + if not emptyp :where [playcard]]] +setempty "digit +end + +to wingame +type "W +localmake "cursor cursor +foreach :ranks [if not upsafep ? [stop] + make "digit ? ~ + allup ~ + setempty "digit ~ + setcursor :cursor] +if equalp (map "top [H S D C]) [K K K K] ~ + [ct print [you win!] wait 120 throw "endgame] +end + +to newstack +localmake "num :numstacks+1 +setcursor [1 22] type "| | +if not equalp :digit 9 [bell] +setempty hidden :num +setempty shown :num +make "numstacks :num +setempty "digit +end + +to cheat +setcursor [1 22] type "| | +if not equalp :digit 8 [bell] +if and emptyp :hand emptyp :pile [bell] +push "pile deal +dispile +dishand +setempty "digit +end + +;; Data abstraction (ranks) + +to rank :card +output butlast :card +end + +to ranknum :rank +if emptyp :rank [output 0] +if numberp :rank [output :rank] +if :rank = "A [output 1] +if :rank = "J [output 11] +if :rank = "Q [output 12] +if :rank = "K [output 13] +end + +;; Data abstraction (suits) + +to suit :card +output last :card +end + +to redp :card +output memberp (suit :card) :reds +end + +;; Data abstraction (tops) + +to top :suit +output thing word "top :suit +end + +to settop :suit :value +make (word "top :suit) :value +end + +;; Data abstraction (card stacks) + +to shown :num +output word "shown :num +end + +to hidden :num +output word "hidden :num +end + +;; Data abstraction (pushdown stacks) + +to stackemptyp :name +output emptyp thing :name +end + +to setempty :stack +make :stack [] +end diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/streams b/js/games/nluqo.github.io/~bh/downloads/csls-programs/streams new file mode 100644 index 0000000..3fc96a9 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/streams @@ -0,0 +1,85 @@ +; Implementation of SICP streams (lazy-evaluation lists) in Logo. + +; Since we don't have special forms, we put the second argument to STREAM +; in a (quoted) list. + +; Since we don't have lexical scope, we use substitution (`) into saved +; expressions. + +to stream :car :delayed.cdr +output fput :car (list "*delayed* :delayed.cdr) +end + +to head :stream +output first :stream +end + +to tail :stream +if emptyp bf :stream [output []] +if not equalp first bf :stream "*delayed* [output bf :stream] +localmake "result run last :stream +.setbf :stream :result +output :result +end + +; higher order functions for streams + +; Remember that if the functional argument uses local variables, it has to +; be backquoted. + +to stream.map :fun [:streams] 2 +if emptyp first :streams [output []] +output stream apply :fun firsts :streams ~ + `[(apply "stream.map fput ,[quoted :fun] (map "tail ,[:streams]))] +end + +to stream.filter :fun :stream +if emptyp :stream [output []] +if invoke :fun head :stream ~ + [output stream head :stream `[stream.filter ,[quoted :fun] tail ,[:stream]]] +output stream.filter :fun tail :stream +end + +to flatten :stream.of.streams +if emptyp :stream.of.streams [output []] +output flatten1 head :stream.of.streams :stream.of.streams +end + +to flatten1 :stream :delayed.more.streams +if emptyp :stream [output flatten tail :delayed.more.streams] +output stream (head :stream) ~ + `[flatten1 tail ,[:stream] + ,[:delayed.more.streams]] +end + +; helper for debugging + +to show.stream :stream [:num 10] +show show.stream1 :stream :num +end + +to show.stream1 :stream :num +if emptyp :stream [output []] +if equalp :num 0 [output [...]] +output fput head :stream (show.stream1 tail :stream :num-1) +end + +; examples + +to integers.from :n +output stream :n `[integers.from ,[:n+1]] +end + +make "integers integers.from 1 + +to sieve :stream +output stream (head :stream) ~ + `[sieve stream.filter [not divisiblep ? ,[head :stream]] + tail ,[:stream]] +end + +to divisiblep :big :small +output 0 = remainder :big :small +end + +make "primes sieve tail :integers diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/student b/js/games/nluqo.github.io/~bh/downloads/csls-programs/student new file mode 100644 index 0000000..0e3df7c --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/student @@ -0,0 +1,1181 @@ +to student :prob +say [The problem to be solved is] :prob +make "prob map.se [depunct ?] :prob +localmake "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 (sentence "^beg first ? "#end) :orgprob] :idioms ~ + tryidiom stop] +while [match [^beg the the #end] :prob] [make "prob (sentence :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 +foreach [aunits wanted ans var lasteqn ref units] [make ? []] +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 [print [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 sentence (map.se [varterms ?] :eqt1) :var +make "eqt1 sentence :eqt1 vartest :var +if not emptyp :eqt1 ~ + [if trysolve (sentence :shelf :eqt1) :wanted :units :aunits + [print [The problem is solved.] stop]] +make "idiom find [match (sentence "^beg first ? "#end) :orgprob] :idioms +if not emptyp :idiom [tryidiom stop] +lsay [Do you know any more relationships among these variables?] :var +make "reply readlist +if equalp :reply [yes] [print [Tell me.] make "reply readlist] +if equalp :reply [no] [print [] print [I can't solve this problem.] stop] +make "reply map.se [depunct ?] :reply +if dlm last :reply [make "reply butlast :reply] +if not match [^beg is #end] :reply [print [I don't understand that.] stop] +make "shelf sentence :shelf :eqt1 +student2 (list (list "equal opform :beg opform :end)) +end + +;; Mandatory substitutions + +to depunct :word +if emptyp :word [output []] +if equalp first :word "$ [output sentence "$ depunct butfirst :word] +if equalp last :word "% [output sentence depunct butlast :word "percent] +if memberp last :word [. ? |;| ,] [output sentence depunct butlast :word last :word] +if emptyp butfirst :word [output :word] +if equalp last2 :word "'s [output sentence depunct butlast butlast :word "s] +output :word +end + +to last2 :word +output word (last butlast :word) (last :word) +end + +to idioms :sent +local "number +output 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] [sentence :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 changes :sent :list +localmake "keywords map.se [findkey first ?] :list +output changes1 :sent :list :keywords +end + +to findkey :pattern +if equalp first :pattern "!:in [output first butfirst :pattern] +if equalp first :pattern "?:in [output sentence (item 2 :pattern) (item 3 :pattern)] +output first :pattern +end + +to changes1 :sent :list :keywords +if emptyp :sent [output []] +if memberp first :sent :keywords [output changes2 :sent :list :keywords] +output fput first :sent changes1 butfirst :sent :list :keywords +end + +to changes2 :sent :list :keywords +changes3 :list :list +output fput first :sent changes1 butfirst :sent :list :keywords +end + +to changes3 :biglist :nowlist +if emptyp :nowlist [stop] +if changeone first :nowlist [changes3 :biglist :biglist stop] +changes3 :biglist butfirst :nowlist +end + +to changeone :change +local "end +if not match (sentence first :change [#end]) :sent [output "false] +make "sent run (sentence "sentence last :change ":end) +output "true +end + +;; Division into simple sentences + +to bracket :prob +output bkt1 finddelim :prob +end + +to finddelim :sent +output finddelim1 :sent [] [] +end + +to finddelim1 :in :out :simples +if emptyp :in ~ + [ifelse emptyp :out [output :simples] [output lput (sentence :out ".) :simples]] +if dlm first :in ~ + [output finddelim1 (nocap butfirst :in) [] + (lput (sentence :out first :in) :simples)] +output finddelim1 (butfirst :in) (sentence :out first :in) :simples +end + +to nocap :words +if emptyp :words [output []] +if personp first :words [output :words] +output sentence (lowercase first :words) butfirst :words +end + +to bkt1 :problist +local [first word rest] +if emptyp :problist [output []] +if not memberp ", first :problist ~ + [output fput first :problist bkt1 butfirst :problist] +if match [if ^first , !word:qword #rest] first :problist ~ + [output bkt1 fput (sentence :first ".) + fput (sentence :word :rest) butfirst :problist] +if match [^first , and #rest] first :problist ~ + [output fput (sentence :first ".) (bkt1 fput :rest butfirst :problist)] +output fput first :problist bkt1 butfirst :problist +end + +;; Age problems + +to ageprob +local [beg end sym who num subj ages] +while [match [^beg as old as #end] :prob] [make "prob sentence :beg :end] +while [match [^beg years old #end] :prob] [make "prob sentence :beg :end] +while [match [^beg will be when #end] :prob] ~ + [make "sym gensym + make "prob (sentence :beg "in :sym [years . in] :sym "years :end)] +while [match [^beg was when #end] :prob] ~ + [make "sym gensym + make "prob (sentence :beg :sym [years ago .] :sym [years ago] :end)] +while [match [^beg !who:personp will be in !num years #end] :prob] ~ + [make "prob (sentence :beg :who [s age in] :num "years #end)] +while [match [^beg was #end] :prob] [make "prob (sentence :beg "is :end)] +while [match [^beg will be #end] :prob] [make "prob (sentence :beg "is :end)] +while [match [^beg !who:personp is now #end] :prob] ~ + [make "prob (sentence :beg :who [s age now] :end)] +while [match [^beg !num years from now #end] :prob] ~ + [make "prob (sentence :beg "in :num "years :end)] +make "prob ageify :prob +ifelse match [^ !who:personp ^end s age #] :prob ~ + [make "subj sentence :who :end] [make "subj "someone] +make "prob agepron :prob +make "end :prob +make "ages [] +while [match [^ !who:personp ^beg age #end] :end] ~ + [push "ages (sentence "and :who :beg "age)] +make "ages butfirst reduce "sentence remdup :ages +while [match [^beg their ages #end] :prob] [make "prob (sentence :beg :ages :end)] +make "simsen map [agesen ?] bracket :prob +end + +to ageify :sent +if emptyp :sent [output []] +if not personp first :sent [output fput first :sent ageify butfirst :sent] +catch "error [if equalp first butfirst :sent "s + [output fput first :sent ageify butfirst :sent]] +output (sentence first :sent [s age] ageify butfirst :sent) +end + +to agepron :sent +if emptyp :sent [output []] +if not pronoun first :sent [output fput first :sent agepron butfirst :sent] +if posspro first :sent [output (sentence :subj "s agepron butfirst :sent)] +output (sentence :subj [s age] agepron butfirst :sent) +end + +to agesen :sent +local [when rest num] +make "when [] +if match [in !num years #rest] :sent ~ + [make "when sentence "pluss :num make "sent :rest] +if match [!num years ago #rest] :sent ~ + [make "when sentence "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 butfirst :sent] +if match [in !num years #rest] butfirst :sent ~ + [output (sentence [age pluss] :num agewhen :rest)] +if match [!num years ago #rest] butfirst :sent ~ + [output (sentence [age minuss] :num agewhen :rest)] +if equalp "now first butfirst :sent ~ + [output sentence "age agewhen butfirst butfirst :sent] +output (sentence "age :when agewhen butfirst :sent) +end + +;; Translation from sentences into equations + +to senform :sent +make "lasteqn senform1 :sent +output :lasteqn +end + +to senform1 :sent +local [one two verb1 verb2 stuff1 stuff2 factor] +if emptyp :sent [output []] +if match [^ what are ^one and ^two !:dlm] :sent ~ + [output fput (qset :one) (senform (sentence [what are] :two "?))] +if match [^ what !:in [is are] #one !:dlm] :sent ~ + [output (list qset :one)] +if match [^ howm !one is #two !:dlm] :sent ~ + [push "aunits (list :one) output (list qset :two)] +if match [^ howm ^one do ^two have !:dlm] :sent ~ + [output (list qset (sentence [the number of] :one :two "have))] +if match [^ howm ^one does ^two have !:dlm] :sent ~ + [output (list qset (sentence [the number of] :one :two "has))] +if match [^ find ^one and #two] :sent ~ + [output fput (qset :one) (senform sentence "find :two)] +if match [^ find #one !:dlm] :sent [output (list qset :one)] +make "sent filter [not article ?] :sent +if match [^one ismulby #two] :sent ~ + [push "ref (list "product opform :one opform :two) output []] +if match [^one isdivby #two] :sent ~ + [push "ref (list "quotient opform :one opform :two) output []] +if match [^one is increased by #two] :sent ~ + [push "ref (list "sum opform :one opform :two) output []] +if match [^one is #two] :sent ~ + [output (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] + output (list (list "equal ~ + opform (sentence [the number of] :stuff1 :one :verb1) ~ + opform (sentence :factor [the number of] :stuff2 :two :verb2)))] +if match [^one !verb1:verb !factor:numberp #stuff1 !:dlm] :sent ~ + [output (list (list "equal ~ + opform (sentence [the number of] :stuff1 :one :verb1) ~ + opform (list :factor)))] +say [This sentence form is not recognized:] :sent +throw "error +end + +to qset :sent +localmake "opform opform filter [not article ?] :sent +if not operatorp first :opform ~ + [queue "wanted :opform queue "ans list :opform oprem :sent output []] +localmake "gensym gensym +queue "wanted :gensym +queue "ans list :gensym oprem :sent +output (list "equal :gensym opform (filter [not article ?] :sent)) +end + +to oprem :sent +output map [ifelse equalp ? "numof ["of] [?]] :sent +end + +to opform :expr +local [left right op] +if match [^left !op:op2 #right] :expr [output optest :op :left :right] +if match [^left !op:op1 #right] :expr [output optest :op :left :right] +if match [^left !op:op0 #right] :expr [output optest :op :left :right] +if match [#left !:dlm] :expr [make "expr :left] +output nmtest filter [not article ?] :expr +end + +to optest :op :left :right +output run (list (word "tst. :op) :left :right) +end + +to tst.numof :left :right +if numberp last :left [output (list "product opform :left opform :right)] +output opform (sentence :left "of :right) +end + +to tst.divby :left :right +output (list "quotient opform :left opform :right) +end + +to tst.tothepower :left :right +output (list "expt opform :left opform :right) +end + +to expt :num :pow +if :pow < 1 [output 1] +output :num * expt :num :pow - 1 +end + +to tst.per :left :right +output (list "quotient ~ + opform :left ~ + opform (ifelse numberp first :right [:right] [fput 1 :right])) +end + +to tst.lessthan :left :right +output opdiff opform :right opform :left +end + +to opdiff :left :right +output (list "sum :left (list "minus :right)) +end + +to tst.minus :left :right +if emptyp :left [output list "minus opform :right] +output opdiff opform :left opform :right +end + +to tst.minuss :left :right +output tst.minus :left :right +end + +to tst.sum :left :right +local [one two three] +if match [^one and ^two and #three] :right ~ + [output (list "sum opform :one opform (sentence "sum :two "and :three))] +if match [^one and #two] :right ~ + [output (list "sum opform :one opform :two)] +say [sum used wrong:] :right +throw "error +end + +to tst.squared :left :right +output list "square opform :left +end + +to tst.difference :left :right +local [one two] +if match [between ^one and #two] :right [output opdiff opform :one opform :two] +say [Incorrect use of difference:] :right +throw "error +end + +to tst.plus :left :right +output (list "sum opform :left opform :right) +end + +to tst.pluss :left :right +output tst.plus :left :right +end + +to square :x +output :x * :x +end + +to tst.square :left :right +output list "square opform :right +end + +to tst.percent :left :right +if not numberp last :left ~ + [say [Incorrect use of percent:] :left throw "error] +output opform (sentence butlast :left ((last :left) / 100) :right) +end + +to tst.perless :left :right +if not numberp last :left ~ + [say [Incorrect use of percent:] :left throw "error] +output (list "product ~ + (opform sentence butlast :left ((100 - (last :left)) / 100)) ~ + opform :right) +end + +to tst.times :left :right +if emptyp :left [say [Incorrect use of times:] :right throw "error] +output (list "product opform :left opform :right) +end + +to nmtest :expr +if match [& !:numberp #] :expr [say [argument error:] :expr throw "error] +if and (equalp first :expr 1) (1 < count :expr) ~ + [make "expr (sentence 1 plural (first butfirst :expr) (butfirst butfirst :expr))] +if and (numberp first :expr) (1 < count :expr) ~ + [push "units (list first butfirst :expr) ~ + output (list "product (first :expr) (opform butfirst :expr))] +if numberp first :expr [output first :expr] +if memberp "this :expr [output this :expr] +if not memberp :expr :var [push "var :expr] +output :expr +end + +to this :expr +if not emptyp :ref [output pop "ref] +if not emptyp :lasteqn [output first butfirst last :lasteqn] +if equalp first :expr "this [make "expr butfirst :expr] +push "var :expr +output :expr +end + +;; Solving the equations + +to trysolve :shelf :wanted :units :aunits +local "solution +make "solution solve :wanted :shelf (ifelse emptyp :aunits [:units] [:aunits]) +output pranswers :ans :solution +end + +to solve :wanted :eqt :terms +output solve.reduce solver :wanted :terms [] [] "insufficient +end + +to solve.reduce :soln +if emptyp :soln [output []] +if wordp :soln [output :soln] +if emptyp butfirst :soln [output :soln] +local "part +make "part solve.reduce butfirst :soln +output fput (list (first first :soln) (subord last first :soln :part)) :part +end + +to solver :wanted :terms :alis :failed :err +local [one result restwant] +if emptyp :wanted [output :err] +make "one solve1 (first :wanted) ~ + (sentence butfirst :wanted :failed :terms) ~ + :alis :eqt [] "insufficient +if wordp :one ~ + [output solver (butfirst :wanted) :terms :alis (fput first :wanted :failed) :one] +make "restwant (sentence :failed butfirst :wanted) +if emptyp :restwant [output :one] +make "result solver :restwant :terms :one [] "insufficient +if listp :result [output :result] +output solver (butfirst :wanted) :terms :alis (fput first :wanted :failed) :one +end + +to solve1 :x :terms :alis :eqns :failed :err +local [thiseq vars extras xterms others result] +if emptyp :eqns [output :err] +make "thiseq subord (first :eqns) :alis +make "vars varterms :thiseq +if not memberp :x :vars ~ + [output solve1 :x :terms :alis (butfirst :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 sentence :failed :eqns + output solve1 :x :terms :alis (butfirst :eqns) + (fput first :eqns :failed) :others] + [make "alis :others + make "thiseq subord (first :eqns) :alis]] +make "result solveq :x :thiseq +if listp :result [output lput :result :alis] +make "eqt sentence :failed :eqns +output solve1 :x :terms :alis (butfirst :eqns) (fput first :eqns :failed) :result +end + +to solveq :var :eqn +local [left right] +make "left first butfirst :eqn +ifelse occvar :var :left ~ + [make "right last :eqn] [make "right :left make "left last :eqn] +output solveq1 :left :right "true +end + +to solveq1 :left :right :bothtest +if :bothtest [if occvar :var :right [output solveqboth :left :right]] +if equalp :left :var [output list :var :right] +if wordp :left [output "unsolvable] +local "oper +make "oper first :left +if memberp :oper [sum product minus quotient] [output run (list word "solveq. :oper)] +output "unsolvable +end + +to solveqboth :left :right +if not equalp first :right "sum [output solveq1 (subterm :left :right) 0 "false] +output solveq.rplus :left butfirst :right [] +end + +to solveq.rplus :left :right :newright +if emptyp :right [output solveq1 :left (simone "sum :newright) "false] +if occvar :var first :right ~ + [output solveq.rplus (subterm :left first :right) butfirst :right :newright] +output solveq.rplus :left butfirst :right (fput first :right :newright) +end + +to solveq.sum +if emptyp butfirst butfirst :left [output solveq1 first butfirst :left :right "true] +output solveq.sum1 butfirst :left :right [] +end + +to solveq.sum1 :left :right :newleft +if emptyp :left [output solveq.sum2] +if occvar :var first :left ~ + [output solveq.sum1 butfirst :left :right fput first :left :newleft] +output solveq.sum1 butfirst :left (subterm :right first :left) :newleft +end + +to solveq.sum2 +if emptyp butfirst :newleft [output solveq1 first :newleft :right "true] +localmake "factor factor :newleft :var +if equalp first :factor "unknown [output "unsolvable] +if equalp last :factor 0 [output "unsolvable] +output solveq1 first :factor (divterm :right last :factor) "true +end + +to solveq.minus +output solveq1 (first butfirst :left) (minusin :right) "false +end + +to solveq.product +output solveq.product1 :left :right +end + +to solveq.product1 :left :right +if emptyp butfirst butfirst :left [output solveq1 (first butfirst :left) :right "true] +if not occvar :var first butfirst :left ~ + [output solveq.product1 (fput "product butfirst butfirst :left) + (divterm :right first butfirst :left)] +localmake "rest simone "product butfirst butfirst :left +if occvar :var :rest [output "unsolvable] +output solveq1 (first butfirst :left) (divterm :right :rest) "false +end + +to solveq.quotient +if occvar :var first butfirst :left ~ + [output solveq1 (first butfirst :left) (simtimes list :right last :left) "true] +output solveq1 (simtimes list :right last :left) (first butfirst :left) "true +end + +to denom :fract :addends +make "addends simplus :addends +localmake "den last :fract +if not equalp first :addends "quotient ~ + [output simdiv list (simone "sum + (remop "sum list (distribtimes (list :addends) :den) + first butfirst :fract)) + :den] +if equalp :den last :addends ~ + [output simdiv (simplus list (first butfirst :fract) (first butfirst :addends)) + :den] +localmake "lowterms simdiv list :den last :addends +output simdiv list (simplus (simtimes list first butfirst :fract last :lowterms) + (simtimes list first butfirst :addends + first butfirst :lowterms)) ~ + (simtimes list first butfirst :lowterms last :addends) +end + +to distribtimes :trms :multiplier +output simplus map [simtimes (list ? :multiplier)] :trms +end + +to distribx :expr +local [oper args] +if emptyp :expr [output :expr] +make "oper first :expr +if not operatorp :oper [output :expr] +make "args map [distribx ?] butfirst :expr +if reduce "and map [numberp ?] :args [output run (sentence [(] :oper :args [)])] +if equalp :oper "sum [output simplus :args] +if equalp :oper "minus [output minusin first :args] +if equalp :oper "product [output simtimes :args] +if equalp :oper "quotient [output simdiv :args] +output fput :oper :args +end + +to divterm :dividend :divisor +if equalp :dividend 0 [output 0] +output simdiv list :dividend :divisor +end + +to factor :exprs :var +local "trms +make "trms map [factor1 :var ?] :exprs +if memberp "unknown :trms [output fput "unknown :exprs] +output list :var simplus :trms +end + +to factor1 :var :expr +localmake "negvar minusin :var +if equalp :var :expr [output 1] +if equalp :negvar :expr [output -1] +if emptyp :expr [output "unknown] +if equalp first :expr "product [output factor2 butfirst :expr] +if not equalp first :expr "quotient [output "unknown] +localmake "dividend first butfirst :expr +if equalp :var :dividend [output (list "quotient 1 last :expr)] +if not equalp first :dividend "product [output "unknown] +localmake "result factor2 butfirst :dividend +if equalp :result "unknown [output "unknown] +output (list "quotient :result last :expr) +end + +to factor2 :trms +if memberp :var :trms [output simone "product (remove :var :trms)] +if memberp :negvar :trms [output minusin simone "product (remove :negvar :trms)] +output "unknown +end + +to maybeadd :num :rest +if equalp :num 0 [output :rest] +output fput :num :rest +end + +to maybemul :num :rest +if equalp :num 1 [output :rest] +output fput :num :rest +end + +to minusin :expr +if emptyp :expr [output -1] +if equalp first :expr "sum [output fput "sum map [minusin ?] butfirst :expr] +if equalp first :expr "minus [output last :expr] +if memberp first :expr [product quotient] ~ + [output fput first :expr + (fput (minusin first butfirst :expr) butfirst butfirst :expr)] +if numberp :expr [output minus :expr] +output list "minus :expr +end + +to occvar :var :expr +if emptyp :expr [output "false] +if wordp :expr [output equalp :var :expr] +if operatorp first :expr [output not emptyp find [occvar :var ?] butfirst :expr] +output equalp :var :expr +end + +to remfactor :num :den +foreach butfirst :num [remfactor1 ?] +output (list "quotient (simone "product butfirst :num) (simone "product butfirst :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 +output map.se [ifelse equalp first ? :oper [butfirst ?] [(list ?)]] :exprs +end + +to simdiv :list +local [num den numop denop] +make "num first :list +make "den last :list +if equalp :num :den [output 1] +if numberp :den [output simtimes (list (quotient 1 :den) :num)] +make "numop first :num +make "denop first :den +if equalp :numop "quotient ~ + [output simdiv list (first butfirst :num) (simtimes list last :num :den)] +if equalp :denop "quotient ~ + [output simdiv list (simtimes list :num last :den) (first butfirst :den)] +if and equalp :numop "product equalp :denop "product [output remfactor :num :den] +if and equalp :numop "product memberp :den :num [output remove :den :num] +output fput "quotient :list +end + +to simone :oper :trms +if emptyp :trms [output ifelse equalp :oper "product [1] [0]] +if emptyp butfirst :trms [output first :trms] +output fput :oper :trms +end + +to simplus :exprs +make "exprs remop "sum :exprs +localmake "factor [unknown] +catch "simplus ~ + [foreach :terms ~ + [make "factor (factor :exprs ?) ~ + if not equalp first :factor "unknown [throw "simplus]]] +if not equalp first :factor "unknown [output fput "product remop "product :factor] +localmake "nums 0 +localmake "nonnums [] +localmake "quick [] +catch "simplus [simplus1 :exprs] +if not emptyp :quick [output :quick] +if not equalp :nums 0 [push "nonnums :nums] +output simone "sum :nonnums +end + +to simplus1 :exprs +if emptyp :exprs [stop] +simplus2 first :exprs +simplus1 butfirst :exprs +end + +to simplus2 :pos +local "neg +make "neg minusin :pos +if numberp :pos [make "nums sum :pos :nums stop] +if memberp :neg butfirst :exprs [make "exprs remove :neg :exprs stop] +if equalp first :pos "quotient ~ + [make "quick (denom :pos (maybeadd :nums sentence :nonnums butfirst :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 [output :quick] +if equalp :nums 0 [output 0] +if not equalp :nums 1 [push "nonnums :nums] +output 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 (butfirst :expr) + (simone "product maybemul :nums sentence :nonnums ?rest) + throw "simtimes] +if equalp first :expr "quotient ~ + [make "quick + simdiv (list (simtimes (list (first butfirst :expr) + (simone "product + maybemul :nums + sentence :nonnums ?rest))) + (last :expr)) + throw "simtimes] +push "nonnums :expr +end + +to subord :expr :alist +output distribx subord1 :expr :alist +end + +to subord1 :expr :alist +if emptyp :alist [output :expr] +output subord (substop (last first :alist) (first first :alist) :expr) ~ + (butfirst :alist) +end + +to substop :val :var :expr +if emptyp :expr [output []] +if equalp :expr :var [output :val] +if not operatorp first :expr [output :expr] +output fput first :expr map [substop :val :var ?] butfirst :expr +end + +to subterm :minuend :subtrahend +if equalp :minuend 0 [output minusin :subtrahend] +if equalp :minuend :subtrahend [output 0] +output simplus (list :minuend minusin :subtrahend) +end + +to varterms :expr +if emptyp :expr [output []] +if numberp :expr [output []] +if wordp :expr [output (list :expr)] +if operatorp first :expr [output map.se [varterms ?] butfirst :expr] +output (list :expr) +end + +;; Printing the solutions + +to pranswers :ans :solution +print [] +if equalp :solution "unsolvable ~ + [print [Unable to solve this set of equations.] output "false] +if equalp :solution "insufficient ~ + [print [The equations were insufficient to find a solution.] output "false] +localmake "gotall "true +foreach :ans [if prans ? :solution [make "gotall "false]] +if not :gotall [print [] print [Unable to solve this set of equations.]] +output :gotall +end + +to prans :ans :solution +localmake "result find [equalp first ? first :ans] :solution +if emptyp :result [output "true] +print (sentence cap last :ans "is unitstring last :result) +print [] +output "false +end + +to unitstring :expr +if numberp :expr [output roundoff :expr] +if equalp first :expr "product ~ + [output sentence (unitstring first butfirst :expr) + (reduce "sentence butfirst butfirst :expr)] +if (and (listp :expr) + (not numberp first :expr) + (not operatorp first :expr)) ~ + [output (sentence 1 (singular first :expr) (butfirst :expr))] +output :expr +end + +to roundoff :num +if (abs (:num - round :num)) < 0.0001 [output round :num] +output :num +end + +to abs :num +output ifelse (:num < 0) [-:num] [:num] +end + +;; Using known relationships + +to geteqns :vars +output map.se [gprop varkey ? "eqns] :vars +end + +to varkey :var +local "word +if match [number of !word #] :var [output :word] +output first :var +end + +;; Assuming equality of similar variables + +to vartest :vars +if emptyp :vars [output []] +local [var beg end] +make "var first :vars +output (sentence (ifelse match [^beg !:pronoun #end] :var + [vartest1 :var (sentence :beg "& :end) butfirst :vars] + [[]]) + (vartest1 :var (sentence "# :var "#) butfirst :vars) + (vartest butfirst :vars)) +end + +to vartest1 :target :pat :vars +output map [varequal :target ?] filter [match :pat ?] :vars +end + +to varequal :target :var +print [] +print [Assuming that] +print (sentence (list :target) [is equal to] (list :var)) +output (list "equal :target :var) +end + +;; Optional substitutions + +to tryidiom +make "prob (sentence :beg last :idiom :end) +while [match (sentence "^beg first :idiom "#end) :prob] ~ + [make "prob (sentence :beg last :idiom :end)] +say [The problem with an idiomatic substitution is] :prob +student1 :prob (remove :idiom :idioms) +end + +;; Utility procedures + +to qword :word +output memberp :word [find what howm how] +end + +to dlm :word +output memberp :word [. ? |;|] +end + +to article :word +output memberp :word [a an the] +end + +to verb :word +output memberp :word [have has get gets weigh weighs] +end + +to personp :word +output memberp :word [Mary Ann Bill Tom Sally Frank father uncle] +end + +to pronoun :word +output memberp :word [he she it him her they them his her its] +end + +to posspro :word +output memberp :word [his her its] +end + +to op0 :word +output memberp :word [pluss minuss squared tothepower per sum difference numof] +end + +to op1 :word +output memberp :word [times divby square] +end + +to op2 :word +output memberp :word [plus minus lessthan percent perless] +end + +to operatorp :word +output memberp :word [sum minus product quotient expt square equal] +end + +to plural :word +localmake "plural gprop :word "plural +if not emptyp :plural [output :plural] +if not emptyp gprop :word "sing [output :word] +if equalp last :word "s [output :word] +output word :word "s +end + +to singular :word +localmake "sing gprop :word "sing +if not emptyp :sing [output :sing] +if not emptyp gprop :word "plural [output :word] +if equalp last :word "s [output butlast :word] +output :word +end + +to setminus :big :little +output filter [not memberp ? :little] :big +end + +to say :herald :text +print [] +print :herald +print [] +print :text +print [] +end + +to lsay :herald :text +print [] +print :herald +print [] +foreach :text [print cap ? print []] +end + +to cap :sent +if emptyp :sent [output []] +output sentence (word uppercase first first :sent butfirst first :sent) ~ + butfirst :sent +end + +;; The pattern matcher + +to match :pat :sen +if prematch :pat :sen [output rmatch :pat :sen] +output "false +end + +to prematch :pat :sen +if emptyp :pat [output "true] +if listp first :pat [output prematch butfirst :pat :sen] +if memberp first first :pat [! @ # ^ & ?] [output prematch butfirst :pat :sen] +if emptyp :sen [output "false] +localmake "rest member first :pat :sen +if not emptyp :rest [output prematch butfirst :pat :rest] +output "false +end + +to rmatch :pat :sen +local [special.var special.pred special.buffer in.list] +if or wordp :pat wordp :sen [output "false] +if emptyp :pat [output emptyp :sen] +if listp first :pat [output special fput "!: :pat :sen] +if memberp first first :pat [? # ! & @ ^] [output special :pat :sen] +if emptyp :sen [output "false] +if equalp first :pat first :sen [output rmatch butfirst :pat butfirst :sen] +output "false +end + +to special :pat :sen +set.special parse.special butfirst first :pat " +output run word "match first first :pat +end + +to parse.special :word :var +if emptyp :word [output list :var "always] +if equalp first :word ": [output list :var butfirst :word] +output parse.special butfirst :word word :var first :word +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 butfirst :pat +make "pat fput first :pat butfirst butfirst :pat +end + +to set.in +make "in.list first butfirst :pat +make "pat fput first :pat butfirst butfirst :pat +end + +to match! +if emptyp :sen [output "false] +if not try.pred [output "false] +make :special.var first :sen +output rmatch butfirst :pat butfirst :sen +end + +to match? +make :special.var [] +if emptyp :sen [output rmatch butfirst :pat :sen] +if not try.pred [output rmatch butfirst :pat :sen] +make :special.var first :sen +if rmatch butfirst :pat butfirst :sen [output "true] +make :special.var [] +output rmatch butfirst :pat :sen +end + +to match# +make :special.var [] +output #test #gather :sen +end + +to #gather :sen +if emptyp :sen [output :sen] +if not try.pred [output :sen] +make :special.var lput first :sen thing :special.var +output #gather butfirst :sen +end + +to #test :sen +if rmatch butfirst :pat :sen [output "true] +if emptyp thing :special.var [output "false] +output #test2 fput last thing :special.var :sen +end + +to #test2 :sen +make :special.var butlast thing :special.var +output #test :sen +end + +to match& +output &test match# +end + +to &test :tf +if emptyp thing :special.var [output "false] +output :tf +end + +to match^ +make :special.var [] +output ^test :sen +end + +to ^test :sen +if rmatch butfirst :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 butfirst :sen +end + +to match@ +make :special.var :sen +output @test [] +end + +to @test :sen +if @try.pred [if rmatch butfirst :pat :sen [output "true]] +if emptyp thing :special.var [output "false] +output @test2 fput last thing :special.var :sen +end + +to @test2 :sen +make :special.var butlast thing :special.var +output @test :sen +end + +to try.pred +if listp :special.pred [output rmatch :special.pred first :sen] +output run list :special.pred quoted first :sen +end + +to quoted :thing +if listp :thing [output :thing] +output word "" :thing +end + +to @try.pred +if listp :special.pred [output rmatch :special.pred thing :special.var] +output run list :special.pred thing :special.var +end + +to always :x +output "true +end + +to in :word +output memberp :word :in.list +end + +to anyof :sen +output anyof1 :sen :in.list +end + +to anyof1 :sen :pats +if emptyp :pats [output "false] +if rmatch first :pats :sen [output "true] +output anyof1 :sen butfirst :pats +end + +;; Sample word problems + +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 "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 "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 "nums [A number is multiplied by 6 . This product is increased by 44 . + This result is 68 . Find the number.] +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 "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 "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 "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 "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.] + +;; Initial data base + +pprop "distance "eqns ~ + [[equal [distance] [product [speed] [time]]] + [equal [distance] [product [gas consumtion] [number of gallons of gas used]]]] +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 "people "sing "person +pprop "person "plural "people +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]]]] diff --git a/js/games/nluqo.github.io/~bh/downloads/csls-programs/tower b/js/games/nluqo.github.io/~bh/downloads/csls-programs/tower new file mode 100644 index 0000000..62e2824 --- /dev/null +++ b/js/games/nluqo.github.io/~bh/downloads/csls-programs/tower @@ -0,0 +1,31 @@ +program tower; + {This program solves the 5-disk tower of hanoi problem.} + +procedure hanoi(number:integer;from,onto,other:char); + {Recursive procedure that solves a subproblem of the original problem, + moving some number of disks, not necessarily 5. To move n disks, it + must get the topmost n-1 out of the way, move the nth to the target + stack, then move the n-1 to the target stack.} + + procedure movedisk(number:integer;from,onto:char); + {This procedure moves one single disk. It assumes that the move is + legal, i.e., the disk is at the top of its stack and the target stack + has no smaller disks already. Procedure hanoi is responsible for + making sure that's all true.} + + begin {movedisk} + writeln('Move disk ',number:1,' from ',from,' to ',onto) + end; {movedisk} + + begin {hanoi} + if number <> 0 then + begin + hanoi(number-1,from,other,onto); + movedisk(number,from,onto); + hanoi(number-1,other,onto,from) + end + end; {hanoi} + +begin {main program} + hanoi(5,'a','b','c') +end. |