handle message working, mutation of self working, draw not working
This commit is contained in:
stjet
88
ipc.scm
88
ipc.scm
@@ -1,47 +1,49 @@
|
||||
(load "utils.scm")
|
||||
|
||||
;since it will be the wm talking to us, invalid inputs won't happen
|
||||
(define listen (lambda (handle-message draw title resizable subtype ideal-dimensions)
|
||||
(display (let* (
|
||||
[_input (get-line (current-input-port))]
|
||||
[parts (split-string _input #\space 2)]
|
||||
[command (car parts)]
|
||||
[rest (if (= (length parts) 2)
|
||||
(car (cdr parts))
|
||||
"" ;if this is the case `rest` won't be used
|
||||
)]
|
||||
) (cond;
|
||||
[
|
||||
(string=? command "handle_message")
|
||||
(symbol->string (car (handle-message ""))) ;doesn't handle clipboard copy request yet... or parse the message, for that matter
|
||||
]
|
||||
;draw
|
||||
[
|
||||
(string=? command "draw")
|
||||
(draw "") ;placeholder, doesn't parse theme info or serialise
|
||||
]
|
||||
[
|
||||
(string=? command "title")
|
||||
(title)
|
||||
]
|
||||
[
|
||||
(string=? command "resizable")
|
||||
(s-bool->string (resizable))
|
||||
]
|
||||
[
|
||||
(string=? command "subtype")
|
||||
subtype
|
||||
]
|
||||
[
|
||||
(string=? command "ideal_dimensions")
|
||||
;placeholder
|
||||
(s-list->string (ideal-dimensions (s-string->list rest)))
|
||||
]
|
||||
[
|
||||
else
|
||||
"invalid"
|
||||
]
|
||||
)))
|
||||
(newline)
|
||||
(listen handle-message draw title resizable subtype ideal-dimensions)
|
||||
(define listen (lambda (window handle-message draw title resizable subtype ideal-dimensions)
|
||||
(let (
|
||||
[pair (let* (
|
||||
[_input (get-line (current-input-port))]
|
||||
[parts (split-string _input #\space 2)]
|
||||
[command (car parts)]
|
||||
[rest (if (= (length parts) 2)
|
||||
(car (cdr parts))
|
||||
"" ;if this is the case `rest` won't be used
|
||||
)]
|
||||
) (cond
|
||||
[
|
||||
(string=? command "handle_message")
|
||||
(let ([resp (handle-message window (split-string rest #\/ -1))])
|
||||
(cons (car resp) (join-string (cdr resp) "/"))
|
||||
)
|
||||
]
|
||||
;draw
|
||||
[
|
||||
(string=? command "draw")
|
||||
(cons window (join-string (draw window (s-string->theme-info rest)) "\x1D;"))
|
||||
]
|
||||
[
|
||||
(string=? command "title")
|
||||
(cons window (title))
|
||||
]
|
||||
[
|
||||
(string=? command "resizable")
|
||||
(cons window (s-bool->string (resizable)))
|
||||
]
|
||||
[
|
||||
(string=? command "subtype")
|
||||
(cons window subtype)
|
||||
]
|
||||
[
|
||||
(string=? command "ideal_dimensions")
|
||||
(cons window (s-list->string (ideal-dimensions (s-string->list rest))))
|
||||
]
|
||||
[
|
||||
else
|
||||
(cons window "invalid")
|
||||
]
|
||||
))]
|
||||
) (display (cdr pair)) (newline) (listen (car pair) handle-message draw title resizable subtype ideal-dimensions)
|
||||
)
|
||||
))
|
||||
115
main.scm
115
main.scm
@@ -2,15 +2,114 @@
|
||||
|
||||
(load "ipc.scm")
|
||||
|
||||
(define handle-message (lambda (message)
|
||||
;placeholder
|
||||
;return either ('DoNothing) ('JustRedraw) or ('Request "string") clipboard copy request
|
||||
(cons (string->symbol "JustRedraw") '())
|
||||
(define-record-type flashcards (fields
|
||||
(mutable dimensions)
|
||||
(mutable input)
|
||||
;questions to ask, to be removed when correctly answered
|
||||
(mutable questions)
|
||||
;current question
|
||||
(mutable current)
|
||||
;correct answer(s)
|
||||
(mutable answers)
|
||||
;total questions correctly asked
|
||||
(mutable correct)
|
||||
;total questions asked
|
||||
(mutable total)
|
||||
;if false, command mode
|
||||
(mutable answer-mode)
|
||||
))
|
||||
|
||||
(define draw (lambda (theme-info)
|
||||
(define handle-message (lambda (self whole-message)
|
||||
;placeholder
|
||||
""
|
||||
(let* (
|
||||
[message (car whole-message)]
|
||||
[args (if (= (length whole-message) 1)
|
||||
'("")
|
||||
(cdr whole-message)
|
||||
)]
|
||||
[arg (join-string args "/")]
|
||||
) (cond
|
||||
[
|
||||
(or (string=? message "Init") (string=? message "ChangeDimensions"))
|
||||
(begin
|
||||
(flashcards-dimensions-set! self (map string->number (s-string->list (car args))))
|
||||
(list self "JustRedraw")
|
||||
)
|
||||
]
|
||||
[
|
||||
(string=? message "KeyPress")
|
||||
;arg is the char
|
||||
(cond
|
||||
[
|
||||
(is-escape arg)
|
||||
(let* (
|
||||
[answer-mode (flashcards-answer-mode self)]
|
||||
[change (if answer-mode
|
||||
#t
|
||||
(= (length questions) 0) ;if no questions, can't switch to answer mode
|
||||
)]
|
||||
) (if change
|
||||
(begin
|
||||
(flashcards-answer-mode-set! self (not answer-mode))
|
||||
(cons self '("JustRedraw"))
|
||||
)
|
||||
(list self "DoNothing")
|
||||
))
|
||||
]
|
||||
[
|
||||
(is-enter arg)
|
||||
;process flashcards.input
|
||||
(if (flashcards-answer-mode self)
|
||||
;check to see if answer is correct
|
||||
(display "placeholder")
|
||||
;
|
||||
;process command
|
||||
(display "placeholder")
|
||||
;
|
||||
)
|
||||
]
|
||||
[
|
||||
(is-backspace arg)
|
||||
(if (= (length (flashcards-input self)) 0)
|
||||
'(self '("DoNothing"))
|
||||
(let ([input (flashcards-input self)])
|
||||
(flashcards-input-set! self (substring input 0 (- (length input) 1)))
|
||||
(list self "JustRedraw")
|
||||
)
|
||||
)
|
||||
]
|
||||
[
|
||||
else
|
||||
(begin
|
||||
;add char to input
|
||||
(flashcards-input-set! self (string-append (flashcards-input self) arg))
|
||||
(list self "JustRedraw")
|
||||
)
|
||||
]
|
||||
)
|
||||
]
|
||||
;
|
||||
[
|
||||
else
|
||||
(list self "DoNothing")
|
||||
]
|
||||
))
|
||||
))
|
||||
|
||||
(define draw (lambda (self ti)
|
||||
;placeholder
|
||||
(let* (
|
||||
[coords (flashcards-dimensions self)]
|
||||
[width (car coords)]
|
||||
[height (car (cdr coords))]
|
||||
) (list
|
||||
(draw-instructions-text (list 5 (- height 15)) '("nimbus-roman") (string-append (if (flashcards-answer-mode self)
|
||||
"ANS: "
|
||||
"CMD: "
|
||||
) (flashcards-input self)) (theme-info-text ti) (theme-info-background ti) #f #f)
|
||||
"b"
|
||||
)
|
||||
)
|
||||
))
|
||||
|
||||
(define title (lambda ()
|
||||
@@ -22,7 +121,7 @@
|
||||
))
|
||||
|
||||
(define ideal-dimensions (lambda (_)
|
||||
'(300 300)
|
||||
'(420 300)
|
||||
))
|
||||
|
||||
(listen handle-message draw title resizable "Window" ideal-dimensions)
|
||||
(listen (make-flashcards '(0 0) "" '() "" '() 0 0 #f) handle-message draw title resizable "Window" ideal-dimensions)
|
||||
|
||||
48
utils.scm
48
utils.scm
@@ -2,8 +2,12 @@
|
||||
|
||||
;s-string->theme-info
|
||||
(define s-string->theme-info (lambda (str)
|
||||
;split by : and then \x1F
|
||||
(display "placeholder")
|
||||
;split by : then \x1F
|
||||
(apply make-theme-info (map (lambda (s)
|
||||
(map string->number (split-string s #\x1F -1))
|
||||
)
|
||||
(split-string str #\: -1)
|
||||
))
|
||||
))
|
||||
|
||||
(define s-bool->string (lambda (b)
|
||||
@@ -21,14 +25,20 @@
|
||||
)
|
||||
))
|
||||
|
||||
;todo: generalise to more types
|
||||
(define s-list->string (lambda (li)
|
||||
(join-string (map number->string li) "\x1F;")
|
||||
(join-string (map (lambda (t)
|
||||
(if (string? t)
|
||||
t
|
||||
(number->string t)
|
||||
)
|
||||
) li) "\x1F;")
|
||||
))
|
||||
|
||||
;max should be 0 if no max is desired
|
||||
;max should be -1 if no max is desired
|
||||
(define split-string (lambda (str split-char max)
|
||||
(define split-string-tail (lambda (chars current splitted)
|
||||
(if (or (= (length chars) 0) (= (+ (length splitted) 1) max))
|
||||
(if (or (= (length chars) 0) (= (length splitted) max))
|
||||
(reverse (cons current splitted))
|
||||
(let (
|
||||
[c (car chars)]
|
||||
@@ -42,5 +52,31 @@
|
||||
))
|
||||
|
||||
(define s-string->list (lambda (str)
|
||||
(split-string str #\x1F 0)
|
||||
(split-string str #\x1F -1)
|
||||
))
|
||||
|
||||
(define s-option->string (lambda (opt)
|
||||
(if (not opt)
|
||||
;None
|
||||
"N"
|
||||
;Some
|
||||
(string-append "S" (number->string opt))
|
||||
)
|
||||
))
|
||||
|
||||
(define draw-instructions-text (lambda (point fonts text colour bg-colour option-horiz-spacing option-mono-width)
|
||||
;Text(Point, Vec<String>, String, RGBColor, RGBColor, Option<usize>, Option<u8>), //font and text
|
||||
(string-append "Text/\x1E;" (s-list->string point) (s-list->string fonts) text (s-list->string colour) (s-list->string bg-colour) (s-option->string option-horiz-spacing) (s-option->string option-mono-width))
|
||||
))
|
||||
|
||||
(define is-escape (lambda (c)
|
||||
(string=? c "𐘃")
|
||||
))
|
||||
|
||||
(define is-enter (lambda (c)
|
||||
(string=? c "𐘂")
|
||||
))
|
||||
|
||||
(define is-backspace (lambda (c)
|
||||
(string=? c "𐘁")
|
||||
))
|
||||
Reference in New Issue
Block a user