cleaned up old code so it now at least compiles (and, in some cases, runs)

svn: r16331

collects/games/paint-by-numbers/info.ss

@@ -3,23 +3,7 @@
 (define game "paint-by-numbers.ss")
 (define game-set "Puzzle Games")
 (define compile-omit-paths
-  '(;; Skipped because it's huge - lots of data-encoding units
+  '("main.ss"
-    "all-problems.ss"
-    ;; Skipped because it requires all-problems.ss
-    "paint-by-numbers.ss"
-    ;; Skipped because these are used only to build the huge units.
-    "build-hattori.ss"
-    "build-kajitani.ss"
-    "build-problems.ss"
-    "raw-hattori.ss"
-    "raw-kajitani.ss"
-    "raw-problems.ss"
-    "raw-misc.ss"
-    "build-rows-cols.ss"
-    "count-missing.ss"
-    "main.ss"
-    ;; directories too
     "hattori"
     "problems"
-    "raw-problems"
     "solution-sets"))

collects/games/paint-by-numbers/raw-problems/build-final.ss

@@ -1,6 +1,6 @@
-#!/bin/sh
+#lang mzscheme
+
 #| 
-exec mzscheme -qr $0 "$@"
 
 This script constructs the contents of the problems directory
 from the solutions directory. This process merely consists of
@@ -30,7 +30,7 @@ in ...
         
         (define set-name ,set-name)
         
-        (define problems (list ,@problems)))
+        (define problems (list ,problems ...)))
      `(unit/sig paint-by-numbers:problem-set^
         (import paint-by-numbers:problem^)
         
@@ -68,4 +68,6 @@ in ...
 (copy-file (build-path 'up "solution-sets" "directory")
            (build-path 'up "problems" "directory"))
 
-(for-each shrink-file (call-with-input-file (build-path 'up "problems" "directory") read))
+(provide main)
+(define (main)
+  (for-each shrink-file (call-with-input-file (build-path 'up "problems" "directory") read)))

collects/games/paint-by-numbers/raw-problems/build-hattori.ss

@@ -1,18 +1,13 @@
-#!/bin/sh
+#lang scheme/gui
-
-string=? ; exec mred -qmvr $0
 
 ;;; these come from:
 ;;; http://www.ask.ne.jp/~hattori/puzzle/menu.html
 ;;; We must cite him in the game somewhere...
 
-(require-library "pretty.ss")
-(require-library "errortrace.ss" "errortrace")
-
 (define pixel-size 10)
 
-(define (main n)
+(define (main-n n)
-  (let ([grid (calculate-grid (build-path "hattori" (format "~a.gif" n)))])
+  (let ([grid (calculate-grid (build-path 'up "hattori" (format "~a.gif" n)))])
     (display-grid grid)
     (pretty-print
      (build-problem 
@@ -162,14 +157,15 @@ string=? ; exec mred -qmvr $0
 	(map on-off->blocks (transpose on-off-lists))
 	on-off-lists))
 
-(call-with-output-file "raw-hattori.ss"
+(provide main)
-  (lambda (port)
+(define (main)
-    (parameterize ([current-output-port port])
+  (call-with-output-file "raw-hattori.ss"
-      (printf "`(~n")
+    (lambda (port)
-      (let loop ([n 1])
+      (parameterize ([current-output-port port])
-	(when (<= n 139)
+        (printf "`(~n")
-	  (main n)
+        (let loop ([n 1])
-	  (loop (+ n 1))))
+          (when (<= n 139)
-      (printf ")")))
+            (main-n n)
-  'text
+            (loop (+ n 1))))
-  'truncate)
+        (printf ")")))
+    #:exists 'truncate))

collects/games/paint-by-numbers/raw-problems/build-kajitani.ss

@@ -1,3 +1,7 @@
+#lang scheme
+
+;; AFAICT, the input to the thing is long gone.
+
 #!/bin/sh
 
 string=? ; exec mzscheme -qr $0
@@ -5,11 +9,6 @@ string=? ; exec mzscheme -qr $0
 ;; this builds raw-kajitani.ss from full-kajitani
 ;; raw-kajitani.ss is used in build-problems.ss
 
-(require-library "pretty.ss")
-(require-library "function.ss")
-(require-library "errortrace.ss" "errortrace")
-(require-library "string.ss")
-
 (define (make-strings-mutable sexp)
   (cond
    [(string? sexp) (string-copy sexp)]
@@ -29,40 +28,41 @@ string=? ; exec mzscheme -qr $0
 					 "allowed-email")
 	 read)))
 
-(define counters (make-hash-table))
+(define counters (make-hasheq))
 
-(define email-ht (make-hash-table))
+(define email-ht (make-hasheq))
-(for-each (lambda (email) (hash-table-put! email-ht (string->symbol email) null))
+(for-each (lambda (email) (hash-set! email-ht (string->symbol email) null))
           allowed-emails)
 
 (define kajitani-sets
-  (let ([ht (make-hash-table)])
+  (let ([ht (make-hasheq)])
     (for-each
      (lambda (kaj-set)
-       (let ([email (cadddr kaj-set)])
+       (let* ([raw-email (cadddr kaj-set)]
-         (when (string? email)
+              [email (if (string? raw-email)
-           (string-lowercase! email))
+                         (string-downcase raw-email)
+                         raw-email)])
          (when (member email allowed-emails)
            (let ([email-sym (string->symbol email)])
-             (hash-table-put! email-ht email-sym
+             (hash-set! email-ht email-sym
                               (cons
                                (car kaj-set)
-                               (hash-table-get email-ht email-sym))))
+                               (hash-ref email-ht email-sym))))
            
            (let ([tag (string->symbol (format "~ax~a" (car (car kaj-set)) (cadr (car kaj-set))))]
                  [rows/cols (list (caddr (car kaj-set)) (cdr kaj-set))])
-             (hash-table-put!
+             (hash-set!
               ht
               tag
               (cons
                rows/cols
-               (hash-table-get
+               (hash-ref
                 ht
                 tag
                 (lambda ()
                   null))))))))
      raw-kajitani)
-    (hash-table-map ht (lambda (x l) (list x (reverse l))))))
+    (hash-map ht (lambda (x l) (list x (reverse l))))))
      
 (printf "stats by email~n")
 (let ([total 0])
@@ -76,7 +76,7 @@ string=? ; exec mzscheme -qr $0
 		 len
 		 ;v
 		 ))))
-   (sort (hash-table-map email-ht list)
+   (sort (hash-map email-ht list)
          (lambda (x y) (> (length (cadr x)) (length (cadr y))))))
 
   

collects/games/paint-by-numbers/raw-problems/build-rows-cols.ss

@@ -1,6 +1,7 @@
-#!/bin/sh
+#lang mzscheme
-
+(require mred
-string=? ; exec mred -mvgqr $0 "$@"
+         mzlib/class)
+(define argv (current-command-line-arguments))
 
 (when (equal? (vector) argv)
   (error 'build-rows-cols.ss

collects/games/paint-by-numbers/raw-problems/build-solution-sets.ss

@@ -1,6 +1,4 @@
-#!/bin/sh
+#lang mzscheme
-
-string=? ; exec mred -qr $0 "$@"
 
 #|
 
@@ -24,9 +22,12 @@ The col and row type specs are in sig.ss and the solution type is:
          mzlib/list
          mzlib/file
          mzlib/pretty
+         mzlib/class
+         mred
+         "raw-hattori.ss"
          (prefix solve: "../solve.ss"))
 
-(if (eq? (vector) argv)
+(if (equal? (vector) argv)
     (fprintf (current-error-port) "pass any command line argument to skip the solver~n~n")
     (fprintf (current-error-port) "skipping the solver~n"))
 
@@ -34,7 +35,7 @@ The col and row type specs are in sig.ss and the solution type is:
 
 (define memory-frame%
   (class frame%
-    (define/override (can-close?) #f)
+    (define/augment (can-close?) #f)
     (super-instantiate ())))
 
 (define memory-frame (parameterize ([current-eventspace (make-eventspace)])
@@ -45,7 +46,7 @@ The col and row type specs are in sig.ss and the solution type is:
 (define memory-ec (make-object editor-canvas% memory-vp memory-text '(hide-hscroll hide-vscroll)))
 (define memory-gauge (make-object gauge% #f 10000 memory-vp))
 (define memory-canvas (make-object canvas% memory-hp))
-(define memory-on-bitmap (make-object bitmap% (build-path (collection-path "icons") "recycle.gif")))
+(define memory-on-bitmap (make-object bitmap% (build-path (collection-path "icons") "recycle.png")))
 (define memory-off-bitmap (make-object bitmap%
                             (send memory-on-bitmap get-width)
                             (send memory-on-bitmap get-height)))
@@ -82,9 +83,6 @@ The col and row type specs are in sig.ss and the solution type is:
 
 (define hattori-sets
   (let* ([set-size 30]
-         [raw-hattori
-          (call-with-input-file (build-path problems-dir "raw-problems" "raw-hattori.ss")
-            (compose eval read))]
          [hattori-count (length raw-hattori)])
     (let o-loop ([n 0])
       (cond
@@ -111,13 +109,14 @@ The col and row type specs are in sig.ss and the solution type is:
         output-file
         (call-with-input-file (build-path problems-dir input-file) (compose eval read))))
 
-(define games-set (build-set "Games Magazine" "games" "raw-problems/raw-problems.ss"))
+(require "raw-problems.ss")
+(define games-set (list "Games Magazine" "games" raw-problems))
 
-(define misc-set (build-set "Misc" "misc" "raw-problems/raw-misc.ss"))
+(require "raw-misc.ss")
+(define misc-set (list "Misc" "misc" raw-misc))
 
-(define kajitani-sets
+(require "raw-kajitani.ss")
-  (call-with-input-file (build-path (collection-path "games" "paint-by-numbers") "raw-problems" "raw-kajitani.ss")
+(define kajitani-sets raw-kajitani)
-    read))
 
 (define sets (append (list games-set)
                      (list misc-set)

collects/games/paint-by-numbers/raw-problems/count-missing.ss

@@ -1,45 +0,0 @@
-#!/bin/sh
-
-string=? ; exec mzscheme -qr $0
-
-(printf "checking problems in ~s~n" (collection-path "games" "paint-by-numbers"))
-
-(require-library "sig.ss" "games" "paint-by-numbers")
-
-(require-library "errortrace.ss" "errortrace")
-
-(define counter
-  (unit/sig ()
-    (import paint-by-numbers:problem^
-	    paint-by-numbers:all-problems^)
-
-    (define total 0)
-    (define total-missing 0)
-
-    (define (filter p l)
-      (cond
-       [(null? l) null]
-       [(p (car l)) (cons (car l) (filter p (cdr l)))]
-       [else (filter p (cdr l))]))
-
-    (define (check-set problems set-name)
-      (let ([missing (filter (lambda (x) x)
-			     (map (lambda (problem) (if (problem-solution problem) #f (problem-name problem)))
-				  problems))])
-	(set! total (+ (length problems) total))
-	(set! total-missing (+ (length missing) total-missing))
-	(unless (null? missing)
-	  (printf "~a missing ~a~n" set-name (length missing))
-	  (for-each (lambda (x) (printf "  ~a~n" x)) missing))))
-
-
-    (for-each check-set problemss set-names)
-    (printf "missing ~a of ~a~n" total-missing total)))
-
-(invoke-unit/sig
- (compound-unit/sig (import)
-   (link
-    [problem : paint-by-numbers:problem^ ((require-library "problem.ss" "games" "paint-by-numbers"))]
-    [all : paint-by-numbers:all-problems^ ((require-library "all-problems.ss" "games" "paint-by-numbers") problem)]
-    [counter : () (counter problem all)])
-   (export)))

collects/games/paint-by-numbers/raw-problems/raw-kajitani.ss

@@ -1,4 +1,7 @@
-(("Kajitani 15x15"
+#lang scheme/base
+(provide raw-kajitani)
+(define raw-kajitani
+'(("Kajitani 15x15"
   "k15x15"
   (("19980519-KHA (1)"
     ((2 2)
@@ -14474,4 +14477,4 @@
      (12)
      (7)
      ()
-     ())))))
+     ()))))))

collects/games/paint-by-numbers/raw-problems/raw-misc.ss

@@ -1,6 +1,9 @@
+#lang scheme/base
+(provide raw-misc)
+
 #|
 
-raw-problems.ss
+raw-misc.ss
 
 This file contains the built-in problems in a raw format. It is
 intended to be processed by the solver which will produce
@@ -12,9 +15,8 @@ type:
 The cols and rows types are specified in sig.ss
 
 |#
-
+(define raw-misc
 `(
-
   ("Happy Happy Joy Joy"
    ((5) (9) (2 7) (4 8) (4 7) (6 7) (7 7) (7 6) (7 5) (5 1 4) (4 2 3) (2 4 1) (9) (5))
    ((4) (8) (10) (12) (1 8 1) (2 5 2) (4 3 3) (5 4) (7 5) (8 3) (9 1) (10 1) (10) (8) (4)))
@@ -36,3 +38,4 @@ The cols and rows types are specified in sig.ss
    ((1) (2 2) (1 1) (1) (2 2) (1)))
 
   )
+)

collects/games/paint-by-numbers/raw-problems/raw-problems.ss

@@ -1,3 +1,5 @@
+#lang scheme/base
+
 #|
 
 raw-problems.ss
@@ -12,6 +14,8 @@ The cols and rows types are specified in sig.ss
 
 |#
 
+(provide raw-problems)
+(define raw-problems
 `(
 
   ("Izay (1)"
@@ -75,3 +79,4 @@ The cols and rows types are specified in sig.ss
     (2 4 2) (2 5) (5) (3) (3)))
 
   )
+)

collects/games/paint-by-numbers/raw-problems/size-calculation.ss

@@ -1,10 +1,6 @@
-(require-library "function.ss")
+#lang scheme
-(require-library "pretty.ss")
 
-(define raw-hattori (call-with-input-file 
+(require "raw-hattori.ss")
-			(build-path (collection-path "games" "paint-by-numbers")
-				    "raw-hattori.ss")
-		      (lambda (x) (eval (read x)))))
 
 (define (num-possibilities size col)
   (let* ([col-len (length col)]