*

1 files changed, 174 insertions, 0 deletions

diff --git a/js/games/nluqo.github.io/~bh/v2ch2/diff.lg b/js/games/nluqo.github.io/~bh/v2ch2/diff.lg
new file mode 100644
index 0000000..8991bdc
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/v2ch2/diff.lg
@@ -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