<commit_before>
(module mrpict-extra mzscheme
  (require (lib "unitsig.ss")
	   (lib "class.ss")
           (lib "etc.ss"))

  (require (lib "mred-sig.ss" "mred"))

  (require "mrpict-sig.ss"
	   "common-sig.ss")

  (provide mrpict-extra@)
  (define mrpict-extra@
    (unit/sig ((open mrpict-extra^)
	       (open texpict-common-setup^))
      (import mred^
	      ((open texpict-common^)
	       (open texpict-internal^)))

      (define show-pict
        (opt-lambda (p [w #f] [h #f])
          (define the-pict p)
          (define pict-drawer (make-pict-drawer the-pict))
          (define no-redraw? #f)
          (define pict-frame%
            (class frame%
              (define/public (set-pict p)
                (set! the-pict p)
                (set! pict-drawer (make-pict-drawer the-pict))
                (set! no-redraw? #t)
                (let ([pw (inexact->exact (floor (pict-width the-pict)))]
                      [ph (inexact->exact (floor (pict-height the-pict)))])
                  (send c min-width (if w (max w pw) pw))
                  (send c min-height (if h (max h ph) ph)))
                (set! no-redraw? #f)
                (send c on-paint))
              (super-instantiate ())))
          (define pict-canvas%
            (class canvas%
              (inherit get-dc)
              (define/override (on-paint)
                (unless no-redraw?
                  (let ([dc (get-dc)])
                    (send dc clear)
                    (let* ([pw (pict-width the-pict)]
                           [ph (pict-height the-pict)]
                           [xo (if (and w
                                        (pw . < . w))
                                   (- (/ w 2) (/ pw 2))
                                   0)]
                           [yo (if (and h
                                        (ph . < . h))
                                   (- (/ h 2) (/ ph 2))
                                   0)])
                      (pict-drawer dc xo yo)))))
              (super-instantiate ())))
          (define f (make-object pict-frame% "MrPict"))
          (define c (make-object pict-canvas% f))
          (send f set-pict p)
          (send f show #t)))
      
      (define dc-for-text-size (make-parameter 
				#f
				(lambda (x)
				  (unless (or (not x)
					      (is-a? x dc<%>))
				    (raise-type-error 'dc-for-parameter "dc<%> object or #f" x))
				  x)))

      (define dc 
	(case-lambda
	 [(f w h a d)
	  (make-pict `(prog ,f ,h) w h a d null #f)]
	 [(f w h)
	  (dc f w h h 0)]))
      (define prog-picture dc)
<commit_msg>added smoothing to show-pict<commit_after>
(module mrpict-extra mzscheme
  (require (lib "unitsig.ss")
	   (lib "class.ss")
           (lib "etc.ss"))

  (require (lib "mred-sig.ss" "mred"))

  (require "mrpict-sig.ss"
	   "common-sig.ss")

  (provide mrpict-extra@)
  (define mrpict-extra@
    (unit/sig ((open mrpict-extra^)
	       (open texpict-common-setup^))
      (import mred^
	      ((open texpict-common^)
	       (open texpict-internal^)))

      (define show-pict
        (opt-lambda (p [w #f] [h #f])
          (define the-pict p)
          (define pict-drawer (make-pict-drawer the-pict))
          (define no-redraw? #f)
          (define pict-frame%
            (class frame%
              (define/public (set-pict p)
                (set! the-pict p)
                (set! pict-drawer (make-pict-drawer the-pict))
                (set! no-redraw? #t)
                (let ([pw (inexact->exact (floor (pict-width the-pict)))]
                      [ph (inexact->exact (floor (pict-height the-pict)))])
                  (send c min-width (if w (max w pw) pw))
                  (send c min-height (if h (max h ph) ph)))
                (set! no-redraw? #f)
                (send c on-paint))
              (super-instantiate ())))
          (define pict-canvas%
            (class canvas%
              (inherit get-dc)
              (define/override (on-paint)
                (unless no-redraw?
                  (let ([dc (get-dc)])
                    (send dc clear)
                    (let* ([pw (pict-width the-pict)]
                           [ph (pict-height the-pict)]
                           [xo (if (and w
                                        (pw . < . w))
                                   (- (/ w 2) (/ pw 2))
                                   0)]
                           [yo (if (and h
                                        (ph . < . h))
                                   (- (/ h 2) (/ ph 2))
                                   0)])
                      (pict-drawer dc xo yo)))))
              (super-instantiate ())))
          (define f (make-object pict-frame% "MrPict"))
          (define c (make-object pict-canvas% f))
          (send (send c get-dc) set-smoothing 'aligned)
          (send f set-pict p)
          (send f show #t)))
      
      (define dc-for-text-size (make-parameter 
				#f
				(lambda (x)
				  (unless (or (not x)
					      (is-a? x dc<%>))
				    (raise-type-error 'dc-for-parameter "dc<%> object or #f" x))
				  x)))

      (define dc 
	(case-lambda
	 [(f w h a d)
	  (make-pict `(prog ,f ,h) w h a d null #f)]
	 [(f w h)
	  (dc f w h h 0)]))
      (define prog-picture dc)

{'fraction_non_alphanumeric': 0.14528122020972353, 'fraction_numerical': 0.002669208770257388, 'mean_word_length': 1.138605788830004, 'pattern_counts': {'":': 0, '<': 11, '<?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': 24, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7646304', 'n_tokens_mistral': 1828, 'n_tokens_neox': 1658, 'n_words': 455}