remember-poc.rkt

#lang morph

(require db
         (except-in deta group-by)
         (only-in ffi/unsafe _double _int _string)
         ffi/unsafe/objc
         (only-in gregor now/moment)
         racket/gui
         racket/string)

(define db
  (sqlite3-connect #:database "remember.sqlite3"
                   #:mode 'create))

(define-schema entry
  #:table "entries"
  ([id id/f #:primary-key #:auto-increment]
   [content string/f #:contract non-empty-string?]
   [(created-at (now/moment)) datetime-tz/f]))

(create-table! db entry-schema)

(define-values (w h)
  (values 680 86))

(define (get-frame-location)
  (define-values (screen-w screen-h)
    (get-display-size #t))

  (values
   (round (- (/ screen-w 2) (/ w 2)))
   (round (- (/ screen-h 4) (/ h 2)))))

(define-values (init-x init-y)
  (get-frame-location))

(define frame
  (new (class frame%
         (super-new)
         (define/augment (display-changed)
           (define-values (x y)
             (get-frame-location))
           (send this move x y)))
       [label "Remember"]
       [width w]
       [height h]
       [x init-x]
       [y init-y]
       [border 5]))

(define handle
  (send frame get-handle))

(define-syntax-rule (tell* who-e (m arg ...) ...)
  (let ([who who-e])
    (begin0 who
      (tell who m arg ...) ...)))

(import-class NSColor
              NSVisualEffectView)

(define NSVisualEffectBlendingModeBehindWindow 0)
(define NSVisualEffectMaterialPopover 6)
(define NSVisualEffectStateActive 1)
(define NSWindowStyleMaskTitled 1)

(tell*
 handle
 (setBackgroundColor: (tell NSColor clearColor))
 (setHasShadow: #:type _BOOL YES)
 (setMovableByWindowBackground: #:type _BOOL YES)
 (setOpaque: #:type _BOOL NO)
 (setStyleMask: #:type _int NSWindowStyleMaskTitled)
 (setTitleVisibility: #:type _int 1)
 (setTitlebarAppearsTransparent: #:type _BOOL YES))

(define eff
  (tell*
   (tell NSVisualEffectView new)
   (setBlendingMode: #:type _int NSVisualEffectBlendingModeBehindWindow)
   (setMaterial: #:type _int NSVisualEffectMaterialPopover)
   (setState: #:type _int NSVisualEffectStateActive)
   (setWantsLayer: #:type _BOOL YES)))

(tell (tell eff layer) setCornerRadius: #:type _double 10.0)
(tell handle setContentView: eff)

(define editor
  (new text%))

(send editor change-style (let ([d (new style-delta%)])
                            (begin0 d
                              (send* d
                                (set-size-add 24)
                                (set-face "SF")))))

(send* (send editor get-keymap)
  (add-function "hide"
                (lambda _
                  (send frame show #f)))

  (add-function "save&hide"
                (lambda _
                  (define content (send editor get-text))
                  (unless (string=? content "")
                    (insert-one! db (make-entry #:content content)))
                  (send frame show #f)))

  (map-function "esc" "hide")
  (map-function "enter" "save&hide"))

(define ec
  (new editor-canvas%
       [parent frame]
       [editor editor]
       [style '(transparent
                no-border
                no-hscroll
                no-vscroll)]))

(send frame show #t)