<commit_before>#lang scheme/base

(require mred
         scheme/class
         scheme/cmdline
         scheme/list
         framework/private/bday
         framework/splash
         scheme/file
         "eb.ss")

(define files-to-open (command-line #:args filenames filenames))

;; updates the command-line-arguments with only the files
;; to open. See also main.ss.
(current-command-line-arguments (apply vector files-to-open))

(define-values (texas-independence-day? prince-kuhio-day? kamehameha-day? halloween? weekend?)
  (let* ([date (seconds->date (current-seconds))]
         [month (date-month date)]
         [day (date-day date)]
         [dow (date-week-day date)])
    (values (and (= 3 month) (= 2 day))
            (and (= 3 month) (= 26 day))
            (and (= 6 month) (= 11 day))
            (and (= 10 month) (= 31 day))
            (or (= dow 6) (= dow 0)))))

(define high-color? ((get-display-depth) . > . 8))
(define special-state #f)
(define normal-bitmap #f) ; set by load-magic-images

(define icons-bitmap
  (let ([icons (collection-path "icons")])
    (lambda (name)
      (make-object bitmap% (build-path icons name)))))

(define-struct magic-image (chars filename [bitmap #:mutable]))

(define (magic-img str img)
  (make-magic-image (reverse (string->list str)) img #f))

;; magic strings and their associated images.  There should not be a string
;; in this list that is a prefix of another.
(define magic-images
  (list #;(magic-img "larval" "PLT-206-larval.png")
        (magic-img "mars"   "PLT-206-mars.jpg")))

(define (load-magic-images)
  (set! load-magic-images void) ; run only once
  (unless normal-bitmap (set! normal-bitmap (icons-bitmap "PLT-206.png")))
  (for-each (λ (magic-image)
              (unless (magic-image-bitmap magic-image)
                (set-magic-image-bitmap!
                 magic-image
                 (icons-bitmap (magic-image-filename magic-image)))))
            magic-images))

(define longest-magic-string
  (apply max (map (λ (s) (length (magic-image-chars s))) magic-images)))

(define key-codes null)

(define (find-magic-image)
  (define (prefix? l1 l2)
    (or (null? l1)
        (and (pair? l2)
             (eq? (car l1) (car l2))
             (prefix? (cdr l1) (cdr l2)))))
  (ormap (λ (i) (and (prefix? (magic-image-chars i) key-codes) i))
         magic-images))

(define (add-key-code new-code)
  (set! key-codes (cons new-code key-codes))
  (when ((length key-codes) . > . longest-magic-string)
    (set! key-codes (take key-codes longest-magic-string))))

(set-splash-char-observer
 (λ (evt)
   (let ([ch (send evt get-key-code)])
     (when (equal? ch 'escape) (exit))
     (when (char? ch)
       ;; as soon as something is typed, load the bitmaps
       (load-magic-images)
       (add-key-code ch)
       (let ([match (find-magic-image)])
         (when match
           (set! key-codes null)
           (set-splash-bitmap
            (if (eq? special-state match)
                (begin (set! special-state #f) normal-bitmap)
                (begin (set! special-state match)
                       (magic-image-bitmap match))))))))))

(when (eb-bday?) (install-eb))

(start-splash
 (cond
   [(or prince-kuhio-day? kamehameha-day?)
    (set-splash-progress-bar? #f)
    (let ([size ((dynamic-require 'drscheme/private/palaka 'palaka-pattern-size) 4)])
      (vector (dynamic-require 'drscheme/private/honu-logo 'draw-honu) <commit_msg>escape no longer quits during splash screen, not control-q does<commit_after>#lang scheme/base

(require mred
         scheme/class
         scheme/cmdline
         scheme/list
         framework/private/bday
         framework/splash
         scheme/file
         "eb.ss")

(define files-to-open (command-line #:args filenames filenames))

;; updates the command-line-arguments with only the files
;; to open. See also main.ss.
(current-command-line-arguments (apply vector files-to-open))

(define-values (texas-independence-day? prince-kuhio-day? kamehameha-day? halloween? weekend?)
  (let* ([date (seconds->date (current-seconds))]
         [month (date-month date)]
         [day (date-day date)]
         [dow (date-week-day date)])
    (values (and (= 3 month) (= 2 day))
            (and (= 3 month) (= 26 day))
            (and (= 6 month) (= 11 day))
            (and (= 10 month) (= 31 day))
            (or (= dow 6) (= dow 0)))))

(define high-color? ((get-display-depth) . > . 8))
(define special-state #f)
(define normal-bitmap #f) ; set by load-magic-images

(define icons-bitmap
  (let ([icons (collection-path "icons")])
    (lambda (name)
      (make-object bitmap% (build-path icons name)))))

(define-struct magic-image (chars filename [bitmap #:mutable]))

(define (magic-img str img)
  (make-magic-image (reverse (string->list str)) img #f))

;; magic strings and their associated images.  There should not be a string
;; in this list that is a prefix of another.
(define magic-images
  (list #;(magic-img "larval" "PLT-206-larval.png")
        (magic-img "mars"   "PLT-206-mars.jpg")))

(define (load-magic-images)
  (set! load-magic-images void) ; run only once
  (unless normal-bitmap (set! normal-bitmap (icons-bitmap "PLT-206.png")))
  (for-each (λ (magic-image)
              (unless (magic-image-bitmap magic-image)
                (set-magic-image-bitmap!
                 magic-image
                 (icons-bitmap (magic-image-filename magic-image)))))
            magic-images))

(define longest-magic-string
  (apply max (map (λ (s) (length (magic-image-chars s))) magic-images)))

(define key-codes null)

(define (find-magic-image)
  (define (prefix? l1 l2)
    (or (null? l1)
        (and (pair? l2)
             (eq? (car l1) (car l2))
             (prefix? (cdr l1) (cdr l2)))))
  (ormap (λ (i) (and (prefix? (magic-image-chars i) key-codes) i))
         magic-images))

(define (add-key-code new-code)
  (set! key-codes (cons new-code key-codes))
  (when ((length key-codes) . > . longest-magic-string)
    (set! key-codes (take key-codes longest-magic-string))))

(set-splash-char-observer
 (λ (evt)
   (let ([ch (send evt get-key-code)])
     (when (and (eq? ch #\q)
                (send evt get-control-down))
       (exit))
     (when (char? ch)
       ;; as soon as something is typed, load the bitmaps
       (load-magic-images)
       (add-key-code ch)
       (let ([match (find-magic-image)])
         (when match
           (set! key-codes null)
           (set-splash-bitmap
            (if (eq? special-state match)
                (begin (set! special-state #f) normal-bitmap)
                (begin (set! special-state match)
                       (magic-image-bitmap match))))))))))

(when (eb-bday?) (install-eb))

(start-splash
 (cond
   [(or prince-kuhio-day? kamehameha-day?)
    (set-splash-progress-bar? #f)
    (let ([size ((dynamic-require 'drscheme/private/palaka 'palaka-pattern-size) 4)])
      (vector (dynamic-require 'drscheme/private/honu-logo 'draw-honu) 
{'fraction_non_alphanumeric': 0.15823512503592987, 'fraction_numerical': 0.009485484334578902, 'mean_word_length': 2.491721023582539, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 11, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '360116', 'n_tokens_mistral': 2439, 'n_tokens_neox': 2333, 'n_words': 635}