Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
#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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.