123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255 |
- (
- (def ls (fn (do
- (split (load "/sd/") [0a])
- )))
- (struct task
- id 0
- name "untitled task"
- focused 0
- z 0
- needs-redraw 0
- redrawn 0
- surface (surface))
- (def draw-logo (fn ox oy (do
- (let c 0xff8e)
- (line fb (pt (+ ox 16) (- oy 38)) (pt (+ ox 16) (- oy 102)) c)
- (line fb (pt (+ ox 16) (- oy 102)) (pt (+ ox 80) (- oy 38)) c)
- (line fb (pt (+ ox 80) (- oy 38)) (pt (+ ox 80) (- oy 102)) c)
- (line fb (pt (+ ox 80) (- oy 102)) (pt (+ ox 144) (- oy 38)) c)
- (line fb (pt (+ ox 144) (- oy 38)) (pt (+ ox 144) (- oy 102)) c)
- (line fb (pt (+ ox 144) (- oy 102)) (pt (+ ox 208) (- oy 38)) c)
- (line fb (pt (+ ox 208) (- oy 38)) (pt (+ ox 208) (- oy 102)) c)
- (line fb (pt (+ ox 208) (- oy 102)) (pt (+ ox 272) (- oy 102)) c)
- )))
- (def desktop-task (fn (t task) (do
- (if (sget t needs-redraw) (do
- (clear)
- (draw-logo (- (/ (sget fb width) 2) 140) (/ (sget fb height) 2))
- (draw-logo (- (/ (sget fb width) 2) 139) (/ (sget fb height) 2))
- (draw-logo (- (/ (sget fb width) 2) 140) (+ 1 (/ (sget fb height) 2)))
- (send screen 0)
- ) 0)
- 0
- )))
- (def keyboard (open "/keyboard"))
- (import "/sd/os/mouse.l")
- (draw-logo (- (/ (sget fb width) 2) 140) (/ (sget fb height) 2))
- (blit-str fb unifont "hello" 100 100)
- (def tasks (list))
- (def new-tasks (list))
- (def add-task (fn task-func task-obj task-state (do
- (def tasks (cons (list task-func task-obj task-state) tasks))
- (list-size tasks)
- )))
- (def task-func (fn task-obj task-state (print "empty task-func")))
- (def paint-task (fn (t task) (do
- (if (sget t redrawn)
- (do
- (let task-surf (sget t surface))
- (let x (sget task-surf x))
- (let y (sget task-surf y))
- (let w (sget task-surf width))
- (let h (sget task-surf height))
- (if (and (gt w 0) (gt h 0)) (do
- (box task-surf 0 0 (- w 1) (- h 1) 0)
- (box task-surf 0 0 (- w 1) 20 0)
- (box task-surf (- w 16) (- h 16) (- w 1) (- h 1) 0)
- (blit-str task-surf unifont (sget t name) 2 2)
- (blit fb task-surf)
- ) 0)
- (sput t redrawn 0))
- 0)
- 0
- )))
- (def null-task (task))
- (sput null-task id 0) ; "null" task
- (def focused-task null-task)
- (def point-in-rect (fn px py x y x2 y2
- (if (gt px x)
- (if (gt py y)
- (if (lt px x2)
- (if (lt py y2)
- 1 0) 0) 0) 0)))
- (def mouse-resizing 0)
- (def focus-given 0)
- (def check-task-focus (fn (t task) (do
- (let surf (sget t surface))
- (let x (sget surf x))
- (let y (sget surf y))
- (let x2 (+ x (sget surf width)))
- (let y2 (+ y (sget surf height)))
- (let z (sget t z))
- (if (not mouse-dragging) (do
- (def mouse-resizing 0)
- (let already-focused (sget t focused))
- (if (point-in-rect mouse-x mouse-y x y x2 y2)
- (if (not focus-given)
- (do
- (def focus-given 1)
- (sput t focused 1)) 0)
- (sput t focused 0))) 0)
- (if mouse-dragging
- (if (sget t focused)
- (do
- (boxfill fb x y (- x2 x) (- y2 y) 0xffff)
- (if (or mouse-resizing (and (gt mouse-x (- x2 16)) (gt mouse-y (- y2 16))))
- (do ; resize
- (let nw (+ (sget surf width) mouse-dx))
- (let nh (+ (sget surf height) mouse-dy))
- (sput surf width nw)
- (sput surf height nh)
- (sput surf pitch (* 2 nw))
- (sput surf pixels (alloc (* 2 (* nw nh))))
- (sput t needs-redraw 1)
- (def mouse-resizing 1) ; sticky
- )
- (do ; move
- (sput surf x (+ mouse-dx x))
- (sput surf y (+ mouse-dy y))) )
- (sput t redrawn 1) ) 0) 0)
- 0
- )))
- (def focused-at-mouse (fn (t task) (do
- (let surf (sget t surface))
- (let x (sget surf x))
- (let y (sget surf y))
- (let x2 (+ x (sget surf width)))
- (let y2 (+ y (sget surf height)))
- (if (point-in-rect mouse-x mouse-y x y x2 y2)
- (sget t focused) 0)
- )))
- (def run-tasks (fn (do
- (let tl tasks)
- (let new-tl (list))
- (let i 0)
- (let highest-z-at-mouse 0)
- (def focus-given 0)
- (while (car tl) (do
- (let task-item (car tl))
- (let task-obj (car (cdr task-item)))
- (def focus-given (or focus-given (focused-at-mouse task-obj)))
- (let tl (cdr tl))
- ))
- (let tl tasks)
-
- (while (car tl) (do
- (let task-item (car tl))
- (def task-func (car task-item))
- (let task-obj (car (cdr task-item)))
- (let task-state (car (cdr (cdr task-item))))
- (check-task-focus task-obj)
- (task-func task-obj task-state)
- (paint-task task-obj)
-
- (let i (+ i 1))
- (let tl (cdr tl))
- ))
- )))
- ;(def zz (fn (import "/sd/tests/gtn.l")))
- (def cursor-blink 0)
- (def cursor-blink-delay 20)
- (import "/sd/os/repl.l")
- (import "/sd/os/editor.l")
- (def make-surface (fn x y w h (do
- (let surf (new surface))
- (sput surf pixels (alloc (* 2 (* w h))))
- (sput surf x x)
- (sput surf y y)
- (sput surf width w)
- (sput surf height h)
- (sput surf pitch (shl w 1))
- surf
- )))
- ;(add-task repl-task (repl-make 1 432 32 200 300))
- (def max-task-id 0)
- (def spawn-editor (fn x y title (do
- (let my-editor (new editor))
- (let my-editor-task (new task))
- (sput my-editor-task id (+ max-task-id 1))
- (sput my-editor-task name title)
- (sput my-editor buffer " ")
- (sput my-editor-task focused 0)
- (sput my-editor-task surface (make-surface x y 400 240))
- (add-task editor-task my-editor-task my-editor)
- (def mask-task-id (+ max-task-id 1))
- )))
- (def spawn-repl (fn x y title (do
- (let my-repl (new repl))
- (let my-task (new task))
- (sput my-task id (+ max-task-id 1))
- (sput my-task name title)
- ;(sput my-repl buffer " ")
- (sput my-task focused 0)
- (sput my-task surface (make-surface x y 400 240))
- (let s (sget my-task surface))
- (boxfill s 0 0 400 240 0xffff)
- (sput my-task redrawn 1)
- (add-task repl-task my-task my-repl)
- (def mask-task-id (+ max-task-id 1))
- )))
- (spawn-editor 32 32 "editor ")
- (spawn-repl 32 300 "repl ")
- (def mouse-task (new task))
- (sput mouse-task id (+ max-task-id 1))
- (sput mouse-task name "mouse")
- (add-task mouse-func mouse-task 0)
- (def launched 0)
- (def launcher-func (fn (t task) dummy (do
- (let f (sget t focused))
- (if (* f (* (not launched) mouse-btn)) (do
- (def launched 1)
- (spawn-editor 100 100 "new editor")
- ) 0)
- (if (not mouse-btn) (def launched 0) 0)
- 0
- )))
- (def launcher-task (new task))
- (sput launcher-task id (+ max-task-id 1))
- (sput launcher-task name "icon")
- (sput launcher-task surface (make-surface 0 0 32 32))
- (sput launcher-task redrawn 1)
- ;(add-task launcher-func launcher-task 0)
- (def main (fn (while 1 (do
- (run-tasks)
- (send screen 0)
- (gc)
- (def cursor-blink (% (+ cursor-blink 1) cursor-blink-delay))
- ))))
- (main)
- )
|