cleanup for release 0.1.0

devices/rpi2/usbkeys.c

@@ -13,7 +13,20 @@ static int ki = 0;
 void uspi_keypress_handler (const char *str)
 {
   printf("[uspi-keyboard] pressed: '%s' (%d)\r\n",str,str[0]);
-  usb_key_in[ki] = str[0];
+
+  char k=str[0];
+  if (strlen(str)>1) {
+    if (k==27) {
+      k = str[2];
+      printf("[uspi-keyboard] esc seq key2: %d",k);
+    }
+    if (k==68) k=19;
+    if (k==67) k=20;
+    if (k==65) k=17;
+    if (k==66) k=18;
+  }
+  
+  usb_key_in[ki] = k;
   ki++;
   if (ki>=KBUFSZ) ki = 0;
 }

release-rpi2/config.txt

@@ -0,0 +1,62 @@
+# For more options and information see 
+# http://www.raspberrypi.org/documentation/configuration/config-txt.md
+# Some settings may impact device functionality. See link above for details
+
+# uncomment if you get no picture on HDMI for a default "safe" mode
+#hdmi_safe=1
+
+# uncomment this if your display has a black border of unused pixels visible
+# and your display can output without overscan
+disable_overscan=1
+
+# uncomment the following to adjust overscan. Use positive numbers if console
+# goes off screen, and negative if there is too much border
+#overscan_left=16
+#overscan_right=16
+#overscan_top=16
+#overscan_bottom=16
+
+# uncomment to force a console size. By default it will be display's size minus
+# overscan.
+framebuffer_width=1920
+framebuffer_height=1080
+
+# uncomment if hdmi display is not detected and composite is being output
+#hdmi_force_hotplug=1
+
+# uncomment to force a specific HDMI mode (this will force VGA)
+#hdmi_group=1
+#hdmi_mode=1
+
+# uncomment to force a HDMI mode rather than DVI. This can make audio work in
+# DMT (computer monitor) modes
+hdmi_drive=1
+hdmi_ignore_edid_audio=1
+
+# uncomment to increase signal to HDMI, if you have interference, blanking, or
+# no display
+#config_hdmi_boost=4
+
+# uncomment for composite PAL
+#sdtv_mode=2
+
+#uncomment to overclock the arm. 700 MHz is the default.
+arm_freq=800
+
+# Uncomment some or all of these to enable the optional hardware interfaces
+#dtparam=i2c_arm=on
+#dtparam=i2s=on
+#dtparam=spi=on
+
+# Uncomment this to enable the lirc-rpi module
+#dtoverlay=lirc-rpi
+
+# Additional overlays and parameters are documented /boot/overlays/README
+
+core_freq=250
+sdram_freq=400
+over_voltage=0
+
+# 128 MB of vram, 880 for CPU
+gpu_mem=128
+gpu_mem_1024=128

rpi2-deploy.sh

@@ -1,9 +1,5 @@
 sudo mount /dev/sdb1 /1/
-sudo cp ./build/kernel7.img /1/
-sudo cp ./sledge/unifont.bin /1/
-sudo cp ./sledge/tests/shell.l /1/
-sudo cp ./sledge/tests/editlite.l /1/
-sudo cp ./sledge/tests/gfx.l /1/
+sudo cp ./release-rpi2/* /1/
 sudo sync
 sudo umount /dev/sdb1
 sudo sync

rpi2-release.sh

@@ -0,0 +1,7 @@
+cp ./build/kernel7.img ./release-rpi2/
+cp ./sledge/unifont.bin ./release-rpi2/
+cp ./sledge/os/shell.l ./release-rpi2/
+cp ./sledge/os/editor.l ./release-rpi2/
+cp ./sledge/os/paint.l ./release-rpi2/
+rm docs/interim-0.1.0-rpi2.tgz
+tar cfz docs/interim-0.1.0-rpi2.tgz ./release-rpi2

sledge/os/editor.l

@@ -0,0 +1,290 @@
+(
+(def editor-running 1)
+
+(def buf (alloc-str 1024))
+
+(def find-prev (fn buf rune pos (do
+  (let p pos)
+  (while (and (gt p 0) (not (eq rune (get buf p))))
+    (let p (- p 1)))
+  (+ p 0)
+)))
+
+(def find-next (fn buf rune pos (do
+  (let p pos)
+  (while (and (lt p (size buf)) (not (eq rune (get buf p))))
+    (let p (+ p 1)))
+  (+ p 0)
+)))
+
+(def find-prev-ws (fn buf pos (do
+  (let p (+ pos 0))
+  (while (and (gt p 0) (not (or (eq 10 (get buf p)) (eq 32 (get buf p)))))
+    (let p (- p 1)))
+  (if (eq p 0) 0 (+ p 1))
+)))
+
+(def find-next-ws (fn buf pos (do
+  (let p (+ pos 0))
+  (while (and (lt p (size buf)) (not (or (eq 10 (get buf p)) (eq 32 (get buf p)))))
+    (let p (+ p 1)))
+  (+ p 0)
+)))
+
+(def copy (fn buf from to num (do
+  (let i 0)
+  (let c 0)
+
+  ;(print (list "copy: " buf from to num))
+  
+  (if (lt from to)
+    (do 
+      (let i (- num 1)) 
+      (while (gt i -1) (do
+        (let c (get buf (+ from i)))
+        (put buf (+ to i) c)
+        (let i (- i 1))
+      )) 0)
+    (do
+      (let i 0)
+      (while (lt i num) (do
+        (let c (get buf (+ from i)))
+        (put buf (+ to i) c)
+        (let i (+ i 1))
+      )) 0)
+  )
+  num
+)))
+
+; fixme clobbered reg loading broken on x64?
+; fixme use substr instead of mutation
+
+(def remove (fn buf pos (do
+  (let p (+ pos 0))
+  (let from (+ pos 1))
+  (let num (- (size buf) pos))
+  (copy buf from p num)
+  (put buf (- (size buf) 1) 0)
+  buf
+)))
+
+(def insert (fn buf pos k (do
+  (let p (+ pos 0))
+  (let to (+ pos 1))
+  (let c (+ k 0))
+  (let num (- (size buf) (+ pos 1)))
+  (copy buf p to num)
+  (put buf p c)
+  buf
+)))
+
+(def buf-render-x 32)
+(def buf-render-y 32)
+(def cursor-char 32)
+(def cursor-x 0)
+(def cursor-y 0)
+(def last-num-lines 0)
+(def scroll-y 0)
+(def scroll-dirty 0)
+
+(def buf-render (fn cursor b (do
+  (let lines (split b [0a]))
+  (let i 0)
+  (let y 0)
+  (let ln (car lines))
+  (let pos 0)
+  (let nextpos 0)
+  (let y buf-render-y)
+  (let render-all 0)
+  
+  ; number of lines changed? then rerender
+  (if (or scroll-dirty (not (eq last-num-lines (list-size lines)))) (do
+      (let render-all 1)
+      (boxfill minx miny maxx maxy 0xffff)
+      (def scroll-dirty 0)
+    )
+  0)
+
+  (def last-num-lines (list-size lines))
+
+  (let i 0)
+  
+  (while ln (do
+    (let is-current-line 0)
+    (let i (+ i 1))
+    
+    (let nextpos (+ 1 (+ pos (size ln))))
+
+    (if (and (gt cursor (- pos 1)) (lt cursor (+ nextpos 1))) (do
+      ; cursor is in this line
+      (def term-y (+ y 0))
+      (def cursor-x (- cursor pos))
+      (def cursor-y (- (- i 1) scroll-y ))
+      (def term-x (+ buf-render-x (* rune-spacing cursor-x)))
+      (def cursor-char (get ln cursor-x))
+      (let is-current-line 1)
+
+      ; blank out the line
+      ;(if only-current (do
+      ;  (boxfill buf-render-x term-y (- maxx buf-render-x) rune-h 0xffff)
+      ;) 0)
+    ) 0)
+
+    ; this crashes arm
+    ; (or is-current-line (not only-current))
+    
+    (if (or render-all is-current-line) (do
+      (if (and (lt y maxy) (not (gt scroll-y i)))
+        (blit-str ln buf-render-x y)
+        0)
+    ) 0)
+    
+    (let pos (+ nextpos 0))
+    
+    (if (not (gt scroll-y i))
+      (let y (+ y 16))
+      0)
+    
+    (let lines (cdr lines))
+    (let ln (car lines))
+  ))
+  0
+)))
+
+(def word-at (fn buf pos (do
+  (let from (find-prev-ws buf pos))
+  (let to   (find-next-ws buf pos))
+  (substr buf from (- to from))
+)))
+
+(def cursor 0)
+(def buf-dirty 0)
+
+(def backspace (fn (if (gt cursor 0) (do
+  (remove buf (- cursor 1))
+  (def cursor (- cursor 1))
+  (def buf-dirty 1)
+) 0)))
+
+(def repair-at-cursor (fn (do
+  (print "repair-at-cursor")
+  (blit-char (if (eq cursor-char 0) 32 cursor-char) term-x term-y)
+)))
+
+(def cursor-left (fn (do
+  (repair-at-cursor)
+  (def cursor (- cursor 1))
+  (def buf-dirty 1)
+)))
+
+(def cursor-right (fn (do
+  (repair-at-cursor)
+  (def cursor (+ cursor 1))
+  (def buf-dirty 1)
+)))
+
+(def scroll-speed 10)
+
+(def cursor-up (fn (do
+  (repair-at-cursor)
+  (def cursor (find-prev buf 10 (- cursor 1)))
+  (if (and (lt cursor-y 5) (gt scroll-y 0)) (do
+    (def scroll-y (- scroll-y scroll-speed))
+    (if (lt scroll-y 0) (def scroll-y 0) 0)
+    (def scroll-dirty 1)
+  ) 0)
+  (def buf-dirty 1)
+)))
+
+(def cursor-down (fn (do
+  (repair-at-cursor)
+  (let nextzero (find-next buf 0 (+ cursor 1)))
+  (let nextnl (find-next buf 10 (+ cursor 1)))
+  (def cursor (if (lt nextzero nextnl) cursor nextnl))
+  (if (and (gt cursor-y 30) (lt scroll-y last-num-lines)) (do
+    (def scroll-y (+ scroll-y scroll-speed))
+    (if (gt scroll-y (- last-num-lines 1)) (def scroll-y (- last-num-lines 1)) 0)
+    (def scroll-dirty 1)
+  ) 0)
+  (def buf-dirty 1)
+)))
+
+(def exit-editor (fn (do
+  (print "exit-editor")
+  (def editor-running 0)
+)))
+
+(def handle-editor-key (fn k (do
+  (if (eq k 20) (cursor-right)
+    (if (eq k 19) (cursor-left)
+      (if (eq k 0x7f) (backspace)
+        (if (eq k 17) (cursor-up)
+          (if (eq k 18) (cursor-down)
+            (if (eq k 27) (exit-editor)
+
+  (if (and (gt k 0) (lt k 250))
+    (do
+      (print (list "handle-editor-key2" k))
+      (def buf (concat buf " ")) ; room for new character
+      (insert buf cursor (+ k 0))
+      (def cursor (+ cursor 1))
+      (def buf-dirty 1)
+    ) 0)
+  
+  ))))))
+
+  (if buf-dirty (do
+    (buf-render cursor buf)
+    (def buf-dirty 0)
+  ) 0)
+  0
+)))
+
+(def handle-command-key (fn 0))
+
+(def edit (fn edit-buf (do
+  (def buf edit-buf)
+  (def editor-running 1)
+  (def last-num-lines -1)
+  (def cursor 0)
+
+  (let blink 0)
+  (clear)
+  (gc)
+  (def term-x buf-render-x)
+  (def term-y buf-render-y)
+  (def buf-dirty 1)
+  
+  (while (eq 1 editor-running) (do
+    (let str (recv keyboard))
+    (let k (get str 0))
+
+    (handle-editor-key k)
+
+    (if (lt cursor 0) (def cursor 0) 0)
+    (if (gt cursor (size buf)) (def cursor (size buf)) 0)
+
+    ; (print (list "term-x/y" term-x term-y))
+    (if (gt blink 9)
+      (blit-char 0x2588 term-x term-y)
+      (do
+        (blit-char (if (eq cursor-char 0) 32 cursor-char) term-x term-y)
+      ))
+      
+    (let blink (% (+ blink 1) 20))
+    
+    (send scr 0)
+    (gc)
+  ))
+  (concat buf "")
+)))
+
+(def edit-file (fn path (do
+  (let content (load path))
+  (edit content)
+)))
+
+(def edit-new (fn (do
+  (edit (alloc-str 4096))
+)))
+)

sledge/os/paint.l

@@ -0,0 +1,75 @@
+(
+(def gfx-w 16)
+(def gfx-h 16)
+(def block-size 16)
+(def gfxbuf (alloc (shl (* gfx-w gfx-h) 1)))
+(def palette (list 0x0000 0xffff 0x8888 0xf000 0x0f00 0x00f0 0x0f70 0xf00f))
+(def gfx-color 0x0000)
+
+(def get-gfx (fn x y (do
+  (let ofs 0)
+  (let ofs (shl (+ x (* y gfx-w)) 1))
+  (let a (get gfxbuf ofs))
+  (let b (get gfxbuf (+ 1 ofs)))
+  (bitor (shl a 8) b)
+)))
+
+(def put-gfx (fn x y c (do
+  (put gfxbuf (shl (+ x (* y gfx-w)) 1) (shr c 8))
+  (put gfxbuf (+ (shl (+ x (* y gfx-w)) 1) 1) (bitand c 0xff))
+  c
+)))
+
+(def render-gfx (fn (do
+  (let x 0)
+  (let y 0)
+  (while (lt y gfx-h) (do
+    (let x 0)
+    (while (lt x gfx-w) (do
+      (let c (get-gfx x y))
+      (boxfill (* x block-size) (* y block-size) block-size block-size c)
+      (let x (+ x 1))
+    ))
+    (let y (+ y 1))
+  ))
+  0
+)))
+
+(def render-palette (fn (do
+  (let x (* block-size gfx-w))
+  (let y 0)
+  (let pal palette)
+  (let pal-bs 32)
+  (while (cdr pal) (do
+    (let c (car pal))
+    (let x1 x)
+    (let y1 (* y pal-bs))
+    (boxfill x1 y1 pal-bs pal-bs c)
+    (if (and mouse-btn (and (gt mouse-x x1) (and (lt mouse-y (+ y1 pal-bs)) (and (gt mouse-y y1) (lt mouse-x (+ x1 pal-bs))))))
+      (def gfx-color c)
+    0)
+    (let y (+ y 1))
+    (let pal (cdr pal))
+  ))
+  0
+)))
+
+(def gfx-task (fn (do
+  (if mouse-btn (do
+    (let mx (/ mouse-x block-size))
+    (let my (/ mouse-y block-size))
+    (if (and (lt mx gfx-w) (lt my gfx-h)) (do
+      (put-gfx mx my gfx-color)
+    ) 0)
+  ) 0)
+
+  (render-gfx)
+  (render-palette)
+)))
+
+(def gfx (fn do
+  (def tasks (list)) ; FIXME hack
+  (mt-test)
+  (add-task gfx-task)
+))
+)

sledge/os/shell.l

@@ -0,0 +1,598 @@
+(
+(def and (fn a b (if a (if b 1 0) 0)))
+(def or (fn a b (+ a b)))
+(def not (fn a (if a 0 1)))
+(def eq (fn a b (lt (+ (lt a b) (gt a b)) 1)))
+
+(def item (fn lst idx (do
+  (let i 0)
+  (let l lst)
+  (while (gt idx i) (do
+    (let l (cdr l))
+    (let i (+ i 1))))
+  (car l)
+)))
+
+(def list-size (fn lst (do
+  (let i 0)
+  (let l lst)
+  (while (car l) (do
+    (let l (cdr l))
+    (let i (+ i 1))))
+  i
+)))
+
+(def split (fn str sepstr (do
+  (let sep (get sepstr 0))
+  (let result (quote ()))
+  (let sz (size str))
+  (let i 0)
+  (let i (- sz 1))
+  (let last-i 0)
+  (let last-i (+ i 1))
+  (let partsize 0)
+  
+  (while (gt i -2) (do
+    (if (or (eq (get str i) sep) (eq i -1)) (do
+      (let partsize (- (- last-i i) 1))
+  
+      (if (gt partsize -1)
+        (let result (cons (substr str (+ i 1) partsize) result)) 0)
+      (let last-i i)
+    ) 0)
+    (let i (- i 1))
+  ))
+  result
+)))
+
+(def sintab [80828486888b8d8f919496989a9c9ea1a3a5a7a9abadafb2b4b6b8babcbec0c1c3c5c7c9cbcdced0d2d3d5d7d8dadcdddfe0e2e3e4e6e7e8eaebecedeeeff1f2f3f4f4f5f6f7f8f9f9fafbfbfcfcfdfdfefefefffffffffffffffffffffffffffffffefefefdfdfcfcfbfbfaf9f9f8f7f6f5f4f4f3f2f1efeeedecebeae8e7e6e4e3e2e0dfdddcdad8d7d5d3d2d0cecdcbc9c7c5c3c1c0bebcbab8b6b4b2afadaba9a7a5a3a19e9c9a989694918f8d8b88868482807d7b79777472706e6b69676563615e5c5a58565452504d4b49474543413f3e3c3a38363432312f2d2c2a2827252322201f1d1c1b1918171514131211100e0d0c0b0b0a0908070606050404030302020101010000000000000000000000000000000101010202030304040506060708090a0b0b0c0d0e1011121314151718191b1c1d1f2022232527282a2c2d2f31323436383a3c3e3f41434547494b4d50525456585a5c5e61636567696b6e70727477797b7d])
+
+(def sin (fn deg (get sintab (% deg 360))))
+(def cos (fn deg (get sintab (% (+ deg 90) 360))))
+(def abs (fn a (if (lt a 0) (- 0 a) a)))
+
+(def load (fn path (recv (open path))))
+(def ls (fn (do
+  (split (load "/sd/") [0a])
+)))
+(def import (fn path (eval (read (recv (open path))))))
+
+(def scr (open "/framebuffer"))
+(def fb (mmap "/framebuffer"))
+(def screen-pitch  3840) ; // TODO read from framebuffer
+
+(def stroke-color 0x0000)
+
+(def set-pixel (fn x y c (do
+  (let ofs (+ (* y screen-pitch) (shl x 1)))
+  (put fb ofs (shr c 8))
+  (put fb (+ 1 ofs) c)
+  c
+)))
+
+(def pt list)
+
+(def line (fn a b (do
+  (let xa (car a))
+  (let ya (car (cdr a)))
+  (let xb (car b))
+  (let yb (car (cdr b)))
+  
+  (let dx (abs (- xb xa)))
+  (let dy (abs (- yb ya)))
+  (let sx (if (lt xa xb) 1 -1))
+  (let sy (if (lt ya yb) 1 -1))
+
+  (let err (if (gt dx dy) dx (- 0 dy)))
+  (let err (/ err 2))
+  (let e2 0)
+
+  (while (not (and (eq xa xb) (eq ya yb))) (do
+    (set-pixel xa ya stroke-color)
+    (let e2 err)
+    (if (gt e2 (- 0 dx)) (do (let err (- err dy)) (let xa (+ xa sx))) 0)
+    (if (lt e2       dy) (do (let err (+ err dx)) (let ya (+ ya sy))) 0)
+  ))
+  0
+)))
+
+(def draw-logo (fn ox oy (do
+  (def stroke-color 0xff8e)
+  (line (pt (+ ox 16) (- oy 38)) (pt (+ ox 16) (- oy 102)))
+  (line (pt (+ ox 16) (- oy 102)) (pt (+ ox 80) (- oy 38)))
+  (line (pt (+ ox 80) (- oy 38)) (pt (+ ox 80) (- oy 102)))
+  (line (pt (+ ox 80) (- oy 102)) (pt (+ ox 144) (- oy 38)))
+  (line (pt (+ ox 144) (- oy 38)) (pt (+ ox 144) (- oy 102)))
+  (line (pt (+ ox 144) (- oy 102)) (pt (+ ox 208) (- oy 38)))
+  (line (pt (+ ox 208) (- oy 38)) (pt (+ ox 208) (- oy 102)))
+  (line (pt (+ ox 208) (- oy 102)) (pt (+ ox 272) (- oy 102)))
+)))
+
+(draw-logo 824 550)
+(draw-logo 825 550)
+(draw-logo 824 551)
+
+(def f (open "/sd/unifont.bin"))
+(def unifont (recv f))
+(def unifont-pitch 4096)
+
+(def font unifont)
+(def font-pitch unifont-pitch)
+
+(def rune-w 16)
+(def rune-spacing 8)
+(def rune-h 16)
+(def rune-mod 256)
+
+(def set-unifont (fn (do
+  (def font unifont)
+  (def font-pitch unifont-pitch)
+  (def rune-w 16)
+  (def rune-spacing 8)
+  (def rune-h 16)
+  (def rune-mod 256)
+)))
+
+(def fghi 0xff)
+(def fglo 0x00)
+
+(def blit-char16 (fn rune x y (do
+  (let sx 0)
+  (let sy 0)
+  (let so 0)
+  (let do 0)
+  (let iy 0)
+  (let rune-ww 0)
+  (let c 0)
+  (let d 0)
+  
+  (let sx (* rune-w (% rune rune-mod)))
+  (let sy (* rune-h (/ rune rune-mod)))
+  (let so (+ (* sx 2) (* sy font-pitch)))
+  (let do (+ (*  x 2) (*  y screen-pitch)))
+
+  (let rune-ww (+ rune-spacing rune-spacing))
+  
+  (while (lt iy rune-h) (do
+    (let ix 0)
+    (while (lt ix rune-ww) (do
+      (let c (get font (+ so ix)))
+      (let d (get font (+ 1 (+ so ix))))
+      (put fb (+ do ix) c)
+      (put fb (+ (+ do ix) 1) d)
+      (let ix (+ ix 2))
+    ))
+    (let so (+ so font-pitch))
+    (let do (+ do screen-pitch))
+    (let iy (+ iy 1))
+  ))
+  0
+)))
+
+(def blit-char (fn rune x y (do
+  (let sx 0)
+  (let sy 0)
+  (let so 0)
+  (let do 0)
+  (let iy 0)
+  (let rune-ww 0)
+  (let c 0)
+  (let d 0)
+  
+  (let sx (* rune-w (% rune rune-mod)))
+  (let sy (* rune-h (/ rune rune-mod)))
+  (let so (+ sx (* sy font-pitch)))
+  (let do (+ (*  x 2) (*  y screen-pitch)))
+
+  (let rune-ww rune-spacing)
+  
+  (while (lt iy rune-h) (do
+    (let ix 0)
+    (let dx 0)
+    (while (lt ix rune-ww) (do
+      (let c (get font (+ so ix)))
+      (let dx (+ do (shl ix 1)))
+      (put fb dx c)
+      (put fb (+ dx 1) c)
+      (let ix (+ ix 1))
+    ))
+    (let so (+ so font-pitch))
+    (let do (+ do screen-pitch))
+    (let iy (+ iy 1))
+  ))
+  0
+)))
+
+(def grab-from fb)
+(def grab-pitch screen-pitch)
+(def grab (fn x y w h (do
+  (let xx 0)
+  (let yy 0)
+  (let di 0)
+  (let yy (+ y 0))
+  (let xw (+ x w))
+  (let yh (+ y h)) 
+  (let res (alloc (* (shl w 1) h)))
+  (let from grab-from)
+  (let pitch grab-pitch)
+  (while (lt yy yh) (do
+    (let xx (+ x 0))
+    (while (lt xx xw) (do
+      (put res di (get from (+ xx (* pitch yy))))
+      (let di (+ di 1))
+      (put res di (get from (+ (+ xx (* pitch yy)) 1)))
+      (let di (+ di 1))
+      (let xx (+ xx 1))
+    ))
+    (let yy (+ yy 1))
+  ))
+  res
+)))
+
+(def paste (fn from x y w h (do
+  (let xx 0)
+  (let yy 0)
+  (let di 0)
+  (let si 0)
+  (let yy (+ y 0))
+  (let xw (+ x w))
+  (let yh (+ y h))
+  (let to grab-from)
+  (let pitch (+ grab-pitch 0))
+  (while (lt yy yh) (do
+    (let xx (+ x 0))
+    (while (lt xx xw) (do
+      (let di (+ xx (* pitch yy)))
+      (put to di (get from si))
+      (put to (+ di 1) (get from (+ si 1)))
+      (let si (+ si 2))
+      (let di (+ di 2))
+      (let xx (+ xx 1))
+    ))
+    (let yy (+ yy 1))
+  ))
+  1
+)))
+
+; 112 x 30 chars at scale 2
+
+(def scale 2)
+(def maxx (/ 1847 scale))
+(def maxy 1015)
+(def minx 32)
+(def miny 32)
+
+(def blit-str (fn str x y (do
+  (let i 0)
+  (let xx 0)
+  (let yy 0)
+  (let xx (+ x 0))
+  (let yy (+ y 0))
+  (let sz (+ (size str) 0))
+  (let c 0)
+  (while (lt i sz) (do
+    (let c (get str i))
+    (blit-char c xx yy)
+    (let xx (+ xx rune-spacing))
+    ; newline
+    (if (or (eq c 10) (gt xx maxx)) (do
+      (let xx minx)
+      (let yy (+ yy rune-h))
+      (if (gt yy maxy) (do
+        (let yy miny)) 0)
+    ) 0)
+    (let i (+ i 1))
+    (if (get str i) 0 (let i sz)) ; stop at 0
+  ))
+  yy
+)))
+
+(def boxfill (fn x y w h color (do
+  (let ofs 0)
+  (let xi 0)
+  (let yi 0)
+  (let xi (+ x 0))
+  (let yi (+ y 0))
+  (let xx (+ x w))
+  (let yy (+ y h))
+  (let chi 0)
+  (let clo 0)
+  (let chi (shr color 8))
+  (let clo (bitand color 0xff))
+  (let ofs (+ (* y screen-pitch) (shl x 1)))
+  (let ww (shl w 1))
+
+  (while (lt yi yy) (do
+    (let xi (+ x 0))
+    (while (lt xi xx) (do
+      (put fb ofs chi)
+      (put fb (+ 1 ofs) clo)
+      (let xi (+ xi 1))
+      (let ofs (+ ofs 2))
+    ))
+    (let ofs (- (+ ofs screen-pitch) ww))
+    (let yi (+ yi 1))
+  ))
+  0 ; crashes x64 if this is not here
+)))
+
+(def clear (fn (do
+  (boxfill 0 0 maxx maxy 0xffff)
+  (def term-x minx)
+  (def term-y miny)
+0)))
+
+(blit-str "Welcome to Interim OS." 32 32)
+
+(def evbuf (alloc-str 4096))
+(def p (fn xp x y (do
+  (write xp evbuf)
+  (blit-str evbuf x y)
+)))
+
+(def keyboard (open "/keyboard"))
+
+(def strlen (fn s (if s (do
+  (let i 0)
+  (let sz (size s))
+  (let c (get s 0))
+  (while (* (gt c 0) (lt i sz)) (do
+    (let i (+ i 1))
+    (let c (get s i))
+  ))
+  i) 0)
+))
+
+(def term-x minx)
+(def term-y (+ miny 32))
+
+(def history (list))
+(def future (list))
+
+(def buffer "")
+
+(def history-back (fn (do
+  (def buffer (car history))
+
+  (def future (cons (car history) future))
+  (def history (cdr history))
+  (print (list "history:" history "future:" future))
+
+  (def term-x (+ minx (* rune-spacing (strlen buffer))))
+  (blit-str buffer minx term-y)
+)))
+
+(def history-forth (fn (do
+  (def buffer (car future))
+  
+  (def history (cons (car future) history))
+  (def future (cdr future))
+  (print (list "history:" history "future:" future))
+  
+  (def term-x (+ minx (* rune-spacing (strlen buffer))))
+  (blit-str buffer minx term-y)
+)))
+
+(def tasks (list))
+
+(def add-task (fn t (do
+  (def tasks (cons t tasks))
+)))
+
+(def mouse (open "/mouse"))
+(def mouse-x 0)
+(def mouse-y 0)
+(def mouse-dx 0)
+(def mouse-dy 0)
+(def mouse-btn 0)
+(def mouse-task (fn (do
+  (add-task (fn (do
+    (blit-char 32 mouse-x mouse-y)
+    
+    (let mouse-info (recv mouse))
+    (def mouse-dx (car (car mouse-info)))
+    (def mouse-dy (cdr (car mouse-info)))
+    (def mouse-x (+ mouse-x mouse-dx))
+    (def mouse-y (+ mouse-y mouse-dy))
+    (if (lt mouse-x 0) (def mouse-x 0) 0)
+    (if (lt mouse-y 0) (def mouse-y 0) 0)
+    (if (gt mouse-x maxx) (def mouse-x maxx) 0)
+    (if (gt mouse-y maxy) (def mouse-y maxy) 0)
+    
+    (def mouse-btn (cdr mouse-info))
+
+    (if mouse-btn (blit-char 0x219c mouse-x mouse-y)
+      (blit-char 0x2196 mouse-x mouse-y))
+
+  )))
+)))
+
+(def net (open "/net"))
+(def net-y 32)
+
+(def temp-minx minx)
+(def temp-maxx maxx)
+
+(def irc-msg (fn msg (do
+  (let ircbuf (concat "PRIVMSG #nodrama.de :" msg))
+  (send net ircbuf)
+  (send net [0a])
+)))
+
+(def cmdbuf (alloc-str 512))
+(def cmd-read (list))
+(def remote-cmd (fn msg (do
+  (let parts (split msg "$"))
+  (if (gt (list-size parts) 1) (do
+    (let cmd (concat (concat "(" (item parts 1)) ")"))
+    (print (list "remote cmd" cmd))
+    (def cmdbuf (alloc-str 512))
+    (def cmd-read (read cmd))
+    (write (eval cmd-read) cmdbuf)
+    (print (list "result" cmdbuf))
+    (irc-msg cmdbuf)
+  ) 0)
+  0
+)))
+
+(def freenode "/net/tcp/62.231.75.133/6667")
+(def sternfreunde "/net/tcp/46.101.207.85/80")
+(def interim-os "/net/tcp/91.250.115.15/80")
+
+(def connect (fn net-path (do
+  (def net (open net-path))
+)))
+
+(def net-task (fn (do
+  (add-task (fn (do
+    (let packet (recv net))
+    (if (size packet) (do
+      (def temp-minx minx)
+      (def temp-maxx maxx)
+
+      (def minx 1000)
+      (def maxx 1700)
+      (let msg (bytes->str packet))
+
+      (boxfill 1000 net-y 716 64 0xffff)
+      (let ofsy (+ (blit-str msg minx net-y) rune-h))
+      
+      (def minx temp-minx)
+      (def maxx temp-maxx)
+      (def net-y (+ 0 ofsy))
+      (if (gt net-y maxy) (def net-y miny) 0)
+
+      (remote-cmd msg)
+      
+    ) 0)
+  )))
+  1
+)))
+
+(def http-get (fn host path (do
+  (boxfill 1000 0 800 1000 0xffff)
+  (let header (concat (concat "Host: " host) (bytes->str [0d0a0d0a])))
+  (send net (concat (concat (concat (concat "GET " path) " HTTP/1.1") (bytes->str [0d0a])) header))
+)))
+
+(def irc-join (fn nick (do
+  (send net "PASS *")
+  (send net [0a])
+  (send net (concat "NICK " nick))
+  (send net [0a])
+  (send net (concat "USER " (concat nick " 8 * :Interim OS")))
+  (send net [0a])
+  (send net "JOIN #nodrama.de")
+  (send net [0a])
+)))
+
+(def task-func (fn (print "empty task-func")))
+
+(def run-tasks (fn (do
+  (let tl tasks)
+  (while (car tl) (do
+    (def task-func (car tl))
+    ; (print (list "run-task " task-func))
+    (task-func)
+    (let tl (cdr tl))
+  ))
+)))
+
+(def triangle (fn a b c (do
+  (line a b)
+  (line b c)
+  (line a c)
+)))
+
+(def box (fn tl br (do
+  (let tr (list (car br) (car (cdr tl))))
+  (let bl (list (car tl) (car (cdr br))))
+  
+  (line tl tr)
+  (line bl br)
+  (line tr br)
+  (line tl bl)
+)))
+
+(def circle (fn cx cy r (do
+  (let x 0)
+  (while (lt x 359) (do
+    (set-pixel (+ cx (* (sin x) r)) (+ cy (* (cos x) r)) stroke-color)
+    (let x (+ x 1))
+  ))
+  x
+)))
+
+(def ed (fn (import "/sd/tests/editlite.l") ))
+
+(def buffer-read (list))
+
+(def main (fn (do
+  (let blink 0)
+  (let running 1)
+
+  (while running (do
+    (let str (recv keyboard))
+    (let c (get str 0))
+
+    (if (gt c 0) (print c) 0)
+
+    ; FIXME this aint working
+    (if (* (gt c 0x1f) (not (eq 0x7f c))) (do
+      (def term-y (blit-str str term-x term-y))
+      (def buffer (concat buffer str))
+      (def term-x (+ term-x rune-spacing)) ) 0)
+      
+    (if (eq c 9) ; tab
+      (do
+        (blit-char 32 term-x term-y)
+        (def term-y (+ term-y 16))
+        (def term-x 32) (def buffer "")) 0)
+      
+    (if (eq c 10) ; return
+      (do
+        (blit-char 32 term-x term-y)
+        (def history (cons buffer history))
+
+        (def buffer-read (list (read buffer))) ; FIXME let here crashes
+        (let result (eval buffer-read))
+        
+        (def buffer "")
+        (def term-x minx)
+        (def term-y (+ term-y rune-h))
+        (def term-y (+ rune-h (p result term-x term-y)))
+        0
+      ) 0)
+
+    (if (eq c 17) ; cursor up
+      (history-back) 0)
+        
+    (if (eq c 18) ; cursor down
+      (history-forth) 0)
+
+    (if (eq c 0x7f) ; bksp
+      (if (gt (strlen buffer) 0)
+      (do
+        (blit-char 32 term-x term-y)
+        (def term-x (- term-x rune-spacing))
+        (let nl (- (strlen buffer) 1))
+        (def buffer (substr buffer 0 nl)) ) 0) 0)
+
+    (if (gt term-x maxx) (do (def term-x minx) (def term-y (+ term-y rune-h))) 0)
+
+    (if (gt term-y maxy) (def term-y miny) 0)
+
+    (if (lt term-x 32) (def term-x minx) 0)
+    
+    (if (gt blink 9)
+      (blit-char 0x2588 term-x term-y) (blit-char 32 term-x term-y))
+    (let blink (% (+ blink 1) 20))
+
+    (run-tasks)
+    (send scr 0)
+    (gc)
+  ))
+)))
+
+(main)
+)

sledge/tests/boot2.l

@@ -1 +1 @@
-(eval (read (recv (open "/sd/tests/shell.l"))))
+(eval (read (recv (open "/sd/os/shell.l"))))

sledge/tests/bootmario.l

@@ -1 +0,0 @@
-(eval (read (recv (open "/sd/tests/mario.l"))))

sledge/tests/bootsledge.l

@@ -1,7 +0,0 @@
-(def keymap (load "keymap"))
-(eval (load "lists.l"))
-(eval (load "string.l"))
-(eval (load "editor.l"))
-(eval (load "irc.l"))
-(eval (load "web.l"))
-(eval editor)

sledge/tests/editor.l

@@ -1,381 +0,0 @@
-(def = (fn a b (if (- a b) 0 1)))
-(def not (fn a (if a 0 1)))
-(def and (fn a b (if a (if b 1 0) 0)))
-(def or (fn a b (if a 1 (if b 1 0) 0)))
-
-
-(def item (fn lst idx (do
-  (def i 0)
-  (while (gt idx i) (do
-    (def lst (cdr lst))
-    (def i (+ i 1))))
-  (car lst)
-)))
-
-(def substr (fn str beg sz (do
-  (def res (alloc-str (* 2 sz)))
-  (def ii 0)
-  
-  (while (lt ii sz) (do
-    (uput res ii (uget str (+ beg ii)))
-    (def ii (+ ii 1))
-  ))
-  res
-)))
-
-(def debug-buf (alloc-str 128))
-
-(def split (fn str sepstr (do
-  (def sep (uget sepstr 0))
-  (def result (quote ()))
-  (def sz (usize str))
-  (def i (- sz 1))
-  (def last-i (+ i 1))
-  (while (gt i -2) (do
-    (if (or (= (uget str i) sep) (= i -1)) (do
-      (def partsize (- (- last-i i) 1))
-  
-      (if (gt partsize 0)
-        (def result (cons (substr str (+ i 1) partsize) result)) 0)
-      (def last-i i)
-    ) 0)
-    (def i (- i 1))
-  ))
-  result
-)))
-
-(def unifont (load "unifont"))
-(def white 16777215)
-(def cyan 65535)
-(def color white)
-(def unifont-width 4128)
-(def unifont-height 4160)
-
-(def blit-char (fn rune x y color
-  (blit-mono unifont 
-    (* (+ 2 (% rune 256)) 2) 
-    (* (+ 4 (/ rune 256)) 16) (/ 4128 8) 2 16 x y color)
-))
-
-(def blit-char-inv (fn rune x y color (do
-  (blit-mono-inv unifont 
-    (* (+ 2 (% rune 256)) 2) 
-    (* (+ 4 (/ rune 256)) 16) (/ 4128 8) 2 16 x y color)
-)))
-
-(def cursor-size 1)
-
-(def debug (fn o (write eval-buf o)))
-
-(def blit-str (fn cursor str xx y color (do
-  (mut l (+ (size str) 1))
-  (mut i -1)
-  (mut x xx)
-  (while (lt (mut i (+ i 1)) l) (do
-    (mut chr (uget str i))
-    (if (= i cursor)
-      (blit-char-inv chr x y color)
-      (if (or (= chr 10) (= chr 32)) 0 (blit-char chr x y color)))
-    (mut x (+ x 8))
-    (if (= chr 10)
-      (do
-        (mut y (+ y 16))
-        (mut x xx)))
-    (if chr 0 (mut i l))
-    0
-  ))
-  0
-)))
-
-(def cursor 0)
-(def running 1)
-(def cmd-mode 0)
-
-(def buf (alloc-str 500))
-
-(def eval-buf "welcome to bomber jacket OS (x86/64bit) ☕ ☕ ☕                                                                                                                                       ")
-
-(def help-buf "[e] eval buffer [tab] toggle menu")
-
-(def focus-buffer buf)
-(def padding 20)
-
-(def buf-render (fn focused b bx by (do
-  (rectfill bx by (- 1024 bx) (- 768 by) color)
-  (rectfill bx by 1024 1 0)
-  (blit-str focused b (+ padding bx) (+ padding by) color)
-)))
-
-(def toggle-command (fn (do
-  (if (= color cyan)
-    (def color white)
-    (def color cyan))
-  (def cmd-mode (- 1 cmd-mode))
-)))
-
-(def chr (fn s (uget s 0)))
-
-(def eval-tmp 0)
-
-(def handle-command-key (fn k (do
-  (def kidx k)
-  (def kchr (uget keymap kidx))
-
-  (if (= kchr 101) (do
-    (def eval-tmp (eval buf))
-    (def eval-buf (alloc-str 1024))
-    (write eval-buf main)
-    0
-  ))
-)))
-
-(def keymap (load "keymap"))
-
-(def ufind-prev (fn buf rune pos (do
-  (while (* (gt pos 0) (not (= rune (uget buf pos))))
-    (def pos (- pos 1)))
-  (+ pos 0)
-)))
-
-(def ufind-next (fn buf rune pos (do
-  (while (* (lt pos (usize buf)) (not (= rune (uget buf pos))))
-    (def pos (+ pos 1)))
-  (+ pos 0)
-)))
-
-(def cursor-left (fn modif (do
-  (if (= modif 1)
-    (def cursor-size (- cursor-size 1))
-    (def cursor (- cursor 1)))
-  (if (lt cursor-size 1) (def cursor-size 1) 0)
-)))
-
-(def cursor-right (fn modif (do
-  (if (= modif 1)
-    (def cursor-size (+ cursor-size 1))
-    (def cursor (+ cursor 1)))
-)))
-
-(def ucopy (fn buf from to num (do
-  (if (lt from to)
-    (do 
-      (def i (- num 1)) 
-      (while (gt (def i (- i 1)) -1) (do
-        (def c (uget buf (+ from i)))
-        (uput buf (+ to i) c)
-      )))
-    (do
-      (def i 0)
-      (while (lt (def i (+ i 1)) num) (do
-        (def c (uget buf (+ from i)))
-        (uput buf (+ to i) c)
-      )))
-  )
-)))
-
-(def backspace (fn (if (gt cursor 0) (do
-  (def cursor (- cursor 1))
-  (ucopy buf cursor (- cursor 1) (- (usize buf) (+ cursor 1)))
-) 0)))
-
-(def handle-editor-key (fn k modif (do
-    (if (= k 79) (cursor-right)
-      (if (= k 80) (cursor-left)
-        (if (= k 42) (backspace)
-          (if (= k 82) (def cursor (ufind-prev buf 10 (- cursor 1)))
-            (if (= k 81) (def cursor (+ 1 (ufind-next buf 10 (+ cursor 1))))
-              (if (= modif 1024) (handle-command-key k)
-
-  (if (* (gt k 0) (lt k 64))
-    (do
-      (def kidx (if (+ (= 1 modif) (= 2 modif)) (+ k 128) k))
-      (def kchr (uget keymap kidx))
-      (ucopy buf cursor (+ cursor 1) (- (usize buf) (+ cursor 1)))
-      (uput buf cursor kchr)
-      (def cursor (+ cursor 1))
-    )
-  0)
-  
-  ))))))
-)))
-
-(def parse-ip (fn ipstr (do
-  (def s (usize ipstr))
-  (def ipbytes (alloc 4))
-  (def i 0)
-  (def j 0)
-  (while (and (lt j 4) (lt i s)) (do
-    (def c (uget ipstr i))
-    (if (= c 46)
-        (def j (+ j 1))
-      (put ipbytes j (+ (- c 48) (* 10 (get ipbytes j)))))
-    (def i (+ i 1))
-  ))
-  ipbytes
-)))
-
-
-(def tcp-open (fn path opened-fn data-fn (do
-  (def parts (split path "/"))
-  (def host (item parts 0))
-  (def host (parse-ip host))
-  (def port (eval (item parts 1)))
-)))
-
-
-(def network-task (fn buf (do
-  (def u (udp-poll))
-  (def us (usize u))
-  (def ui 0)
-
-  (while (* (lt ui (size buf)) (lt ui us)) (do
-    (def ui (+ ui 1))
-    (uput buf ui (uget u ui))
-  ))
-)))
-
-(def network-input "")
-
-(def freenode [5bd9bd2a])
-(def mntmn [5bfa730f])
-(def server [0a000001])
-(def dwigns [5eba9793])
-(def facebook [1f0d5d03])
-
-;;; HTTP -----------------------------------------------------------------
-
-(def http-get (fn (do
-  (def header (concat (concat "Host: " http-hostname) [0d0a0d0a]))
-  (tcp-send (concat (concat (concat (concat "GET " http-path) " HTTP/1.1") [0d0a]) header))
-)))
-
-(def http-connect-handler (fn (http-get path)))
-
-(def html-parse-state 0)
-; 0: in text
-; 1: in tag
-; 2: whitespace
-
-(def html-parse (fn raw (do
-  (def i 0)
-  (def j 0)
-  (def k 0)
-  (def l 0)
-  (def rsz (usize raw))
-  (def out (alloc-str rsz))
-  (def html-tag (alloc-str 10))
-
-  (while (lt i rsz) (do
-    (def c (uget raw i))
-    (if (= html-parse-state 0)
-      (if (= c 60)
-        (def html-parse-state 1)
-      (if (or (= c 10) (= c 32))
-        (do 
-          (uput out j c)
-          (def j (+ j 1))
-          (def l (+ l 1))
-          (def html-parse-state 2)
-        )
-      (do
-        (uput out j c)
-        (def j (+ j 1))
-        (def l (+ l 1))
-      )))
-    (if (= html-parse-state 1)
-      (if (= c 62)
-        (def html-parse-state 0)
-        0)
-    (if (= html-parse-state 2)
-      (if (not (or (= c 32) (= c 10)))
-        (if (= c 60)
-          (def html-parse-state 1)
-        (do
-          (def html-parse-state 0)
-          (uput out j c)
-          (def j (+ j 1))
-          (def l (+ l 1))
-        )) 0)
-    0)))
-    (def i (+ i 1))
-    
-    (if (and (= c 32) (gt l 80)) (do
-      (uput out j 10)
-      (def j (+ j 1))
-      (def l 0)
-    ) 0)
-  ))
-  out
-)))
-
-(def http-handler (fn (do
-  (def eval-buf (concat eval-buf (html-parse network-input)))
-)))
-
-(def hget (fn ip hostname path (do
-  (def eval-buf (concat "loading… " [0a]))
-  (def html-parse-state 0)
-  (def http-path path)
-  (def http-hostname hostname)
-  (tcp-connect ip 80 http-connect-handler http-handler))))
-
-(def webtest (fn (hget dwigns "news.dieweltistgarnichtso.net" "/notes/nokia-n900.html")))
-
-;;; IRC ------------------------------------------------------------------
-
-(def irc-connect-handler (fn (do
-  (tcp-send "PASS *")
-  (tcp-send [0a])
-  (tcp-send "NICK bomberjacket_")
-  (tcp-send [0a])
-  (tcp-send "USER bomberjacket_ 8 * :Bomberjacket OS")
-  (tcp-send [0a])
-  (tcp-send "JOIN #nodrama.de")
-  (tcp-send [0a])
-)))
-
-(def irc-handler (fn (do
-  (def eval-buf (concat eval-buf network-input))
-  
-  (if (gt (usize eval-buf) 1200) (def eval-buf (substr eval-buf (- (usize eval-buf) 1200) 1200)) 0)
-)))
-
-(def irc-msg (fn msg (do
-  (def ircbuf (concat "PRIVMSG #nodrama.de :" msg))
-  (tcp-send ircbuf)
-  (tcp-send [0a])
-  (def eval-buf (concat (concat eval-buf ircbuf) [0a]))
-  (uput buf 10 34)
-  (uput buf 11 41)
-  (uput buf 12 59)
-  (def i 13)
-  (while (lt i (usize buf)) (do (uput buf i 32) (def i (+ i 1))))
-  (def cursor 10)
-  (toggle-command)
-)))
-
-(def irc (fn
-  (tcp-connect freenode 6667 irc-connect-handler irc-handler)))
-
-(def k 0)
-(def modif 0)
-
-(def main (fn
-(while running (do
-  (def k (inkey 0))
-  (def modif (inkey 1))
-
-  (if (= modif 1024)
-    (handle-command-key k modif)
-    (handle-editor-key k modif))
-
-  (if (lt cursor 0) (mut cursor 0))
-  (if (gt cursor (usize buf)) (mut cursor (- (usize buf) 1)))
-
-  (buf-render cursor buf 0 0)
-  (buf-render 0 eval-buf 0 100)
-  (flip)
-  (gc)
-))))
-
-(main)

sledge/tests/editor2.l

@@ -1,224 +0,0 @@
-(def = (fn a b (if (- a b) 0 1)))
-(def not (fn a (if a 0 1)))
-(def and (fn a b (if a (if b 1 0) 0)))
-(def or (fn a b (if a 1 (if b 1 0) 0)))
-
-
-(def item (fn lst idx (do
-  (def i 0)
-  (while (gt idx i) (do
-    (def lst (cdr lst))
-    (def i (+ i 1))))
-  (car lst)
-)))
-
-(def substr (fn str beg sz (do
-  (def res (alloc-str (* 2 sz)))
-  (def ii 0)
-  
-  (while (lt ii sz) (do
-    (uput res ii (uget str (+ beg ii)))
-    (def ii (+ ii 1))
-  ))
-  res
-)))
-
-(def debug-buf (alloc-str 128))
-
-(def split (fn str sepstr (do
-  (def sep (uget sepstr 0))
-  (def result (quote ()))
-  (def sz (usize str))
-  (def i (- sz 1))
-  (def last-i (+ i 1))
-  (while (gt i -2) (do
-    (if (or (= (uget str i) sep) (= i -1)) (do
-      (def partsize (- (- last-i i) 1))
-  
-      (if (gt partsize 0)
-        (def result (cons (substr str (+ i 1) partsize) result)) 0)
-      (def last-i i)
-    ) 0)
-    (def i (- i 1))
-  ))
-  result
-)))
-
-(def unifont (load "unifont"))
-(def white 16777215)
-(def cyan 65535)
-(def color white)
-(def unifont-width 4128)
-(def unifont-height 4160)
-
-(def blit-char (fn rune x y color
-  (blit-mono unifont 
-    (* (+ 2 (% rune 256)) 2) 
-    (* (+ 4 (/ rune 256)) 16) (/ 4128 8) 2 16 x y color)
-))
-
-(def blit-char-inv (fn rune x y color (do
-  (blit-mono-inv unifont 
-    (* (+ 2 (% rune 256)) 2) 
-    (* (+ 4 (/ rune 256)) 16) (/ 4128 8) 2 16 x y color)
-)))
-
-(def cursor-size 1)
-
-(def debug (fn o (write eval-buf o)))
-
-(def blit-str (fn cursor str xx y color (do
-  (mut l (+ (size str) 1))
-  (mut i -1)
-  (mut x xx)
-  (while (lt (mut i (+ i 1)) l) (do
-    (mut chr (uget str i))
-    (if (= i cursor)
-      (blit-char-inv chr x y color)
-      (if (or (= chr 10) (= chr 32)) 0 (blit-char chr x y color)))
-    (mut x (+ x 8))
-    (if (= chr 10)
-      (do
-        (mut y (+ y 16))
-        (mut x xx)))
-    (if chr 0 (mut i l))
-    0
-  ))
-  0
-)))
-
-(def cursor 0)
-(def running 1)
-(def cmd-mode 0)
-
-(def buf (alloc-str 500))
-
-(def eval-buf "welcome to bomber jacket OS (x86/64bit) ☕ ☕ ☕                                                                                                                                       ")
-
-(def help-buf "[e] eval buffer [tab] toggle menu")
-
-(def focus-buffer buf)
-(def padding 20)
-
-(def buf-render (fn focused b bx by (do
-  (rectfill bx by (- 1024 bx) (- 768 by) color)
-  (rectfill bx by 1024 1 0)
-  (blit-str focused b (+ padding bx) (+ padding by) color)
-)))
-
-(def toggle-command (fn (do
-  (if (= color cyan)
-    (def color white)
-    (def color cyan))
-  (def cmd-mode (- 1 cmd-mode))
-)))
-
-(def chr (fn s (uget s 0)))
-
-(def eval-tmp 0)
-
-(def handle-command-key (fn kidx (do
-  (def kchr (uget keymap kidx))
-
-  (if (= kchr 101) (do
-    (def eval-tmp (eval buf))
-    (def eval-buf (alloc-str 1024))
-    (write eval-buf eval-tmp)
-    0
-  ))
-)))
-
-(def keymap (load "keymap"))
-
-(def ufind-prev (fn buf rune pos (do
-  (while (* (gt pos 0) (not (= rune (uget buf pos))))
-    (def pos (- pos 1)))
-  (+ pos 0)
-)))
-
-(def ufind-next (fn buf rune pos (do
-  (while (* (lt pos (usize buf)) (not (= rune (uget buf pos))))
-    (def pos (+ pos 1)))
-  (+ pos 0)
-)))
-
-(def cursor-left (fn modif (do
-  (if (= modif 1)
-    (def cursor-size (- cursor-size 1))
-    (def cursor (- cursor 1)))
-  (if (lt cursor-size 1) (def cursor-size 1) 0)
-)))
-
-(def cursor-right (fn modif (do
-  (if (= modif 1)
-    (def cursor-size (+ cursor-size 1))
-    (def cursor (+ cursor 1)))
-)))
-
-(def ucopy (fn buf from to num (do
-  (if (lt from to)
-    (do 
-      (def i (- num 1)) 
-      (while (gt (def i (- i 1)) -1) (do
-        (def c (uget buf (+ from i)))
-        (uput buf (+ to i) c)
-      )))
-    (do
-      (def i 0)
-      (while (lt (def i (+ i 1)) num) (do
-        (def c (uget buf (+ from i)))
-        (uput buf (+ to i) c)
-      )))
-  )
-)))
-
-(def backspace (fn (if (gt cursor 0) (do
-  (def cursor (- cursor 1))
-  (ucopy buf cursor (- cursor 1) (- (usize buf) (+ cursor 1)))
-) 0)))
-
-(def handle-editor-key (fn k modif (do
-    (if (= k 79) (cursor-right)
-      (if (= k 80) (cursor-left)
-        (if (= k 42) (backspace)
-          (if (= k 82) (def cursor (ufind-prev buf 10 (- cursor 1)))
-            (if (= k 81) (def cursor (+ 1 (ufind-next buf 10 (+ cursor 1))))
-              (if (= modif 1024) (handle-command-key k)
-
-  (if (* (gt k 0) (lt k 64))
-    (do
-      (def kidx (if (+ (= 1 modif) (= 2 modif)) (+ k 128) k))
-      (def kchr (uget keymap kidx))
-      (ucopy buf cursor (+ cursor 1) (- (usize buf) (+ cursor 1)))
-      (uput buf cursor kchr)
-      (def cursor (+ cursor 1))
-    )
-  0)
-  
-  ))))))
-)))
-
-(def k 0)
-(def modif 0)
-
-(def eval-buf-y 500)
-
-(def main (fn
-(while running (do
-  (def k (inkey 0))
-  (def modif (inkey 1))
-
-  (if (= modif 1024)
-    (handle-command-key k modif)
-    (handle-editor-key k modif))
-
-  (if (lt cursor 0) (mut cursor 0))
-  (if (gt cursor (usize buf)) (mut cursor (- (usize buf) 1)))
-
-  (buf-render cursor buf 0 0)
-  (buf-render 0 eval-buf 0 eval-buf-y)
-  (flip)
-  (gc)
-))))
-
-(main)

sledge/tests/experiments.l

@@ -1,43 +0,0 @@
-
-(def net (open "/net"))
-
-(def netblit (fn (do
-  (while 1 (do
-  (let packet (recv net))
-  (let sz 0)
-  (let sz (size packet))
-
-  (if sz (do
-    (let i 0)
-    (let j 0)
-    (let b 0)
-    (let ofs 0)
-    (print sz)
-    (while (lt i sz) (do
-      (let b (get packet i))
-      (put fb ofs b)
-      (let i (+ i 1))
-      (let ofs (+ ofs 1))
-      (let j (+ j 1))
-      (if (gt j 127) (do
-        (let j 0)
-        (let ofs (+ ofs (- screen-pitch 128)))
-      ) 0)
-    ))
-  ) 0)
-
-  (print "about to gc") ; FIXME gc crashes here
-  ))
-)))
-
-
-; fixme crashes on device
-(def graph (fn center max (do
-  (let x 0)
-  (while (lt x max) (do
-    (print x)
-    (set-pixel x (+ center (sin (sin x))) stroke-color)
-    (let x (+ x 1))
-  ))
-  x
-  )))

sledge/tests/font.l.txt

@@ -1,127 +0,0 @@
-(
-(def scr (open "/framebuffer"))
-(def fb (mmap "/framebuffer"))
-(def f (open "/sd/unifont.565"))
-(def unifont (recv f))
-(def unifont-pitch 8256)
-
-(def f (open "/sd/smb3.565"))
-(def mariotiles (recv f))
-(def mario-pitch 1000)
-
-(def font unifont)
-(def font-pitch unifont-pitch)
-
-(def font mariotiles)
-(def font-pitch mario-pitch)
-
-(def screen-pitch  3840)
-
-(def blit-char (fn rune x y (do
-  (let sx (* (+ 2 (% rune 256)) 16))
-  (let sy (* (+ 2 (/ rune 256)) 16))
-  (let so (+ (* sx 2) (* sy font-pitch)))
-  (let do (+ (*  x 2) (*  y screen-pitch)))
-  (let iy 0)
-  
-  (while (lt iy 16) (do
-    (let ix 0)
-    (while (lt ix 32) (do
-      (let c (get font (+ so ix)))
-      (put fb (+ do ix) c)
-      (put fb (+ (+ do ix) 1) c)
-      (let ix (+ ix 2))
-    ))
-    (let so (+ so font-pitch))
-    (let do (+ do screen-pitch))
-    (let iy (+ iy 1))
-  ))
-)))
-
-(def blit-str (fn str x y (do
-  (let i 0)
-  (let xx x)
-  (let sz (size str))
-  (while (lt i sz) (do
-    (blit-char (get str i) xx y)
-    (let xx (+ xx 8))
-    (let i (+ i 1))
-    (if (get str i) 0 (let i sz)) ; stop at 0
-  ))
-)))
-
-(blit-str "Welcome to Interim OS." 32 32)
-
-(def evbuf (alloc-str 512))
-(def p (fn xp x y (do (write xp evbuf) (blit-str evbuf x y))))
-
-(def k (open "/keyboard"))
-(def maxx 1863)
-(def maxy 1031)
-
-(def strlen (fn s (do
-  (let i 0)
-  (let sz (size s))
-  (while (lt i sz) (do
-    (let i (+ i 1))
-    (if (get str i) 0 (let i sz)) ; stop at 0
-  ))
-  i
-)))
-
-(def eq (fn a b (lt (+ (lt a b) (gt a b)) 1)))
-
-(def main (fn (do
-  (let x 32)
-  (let y 64)
-  (let blink 0)
-  (let buffer "")
-
-  (while 1 (do
-    (let str (recv k))
-    (let c (get str 0))
-
-    (if (gt c 0) (print c) 0)
-
-    (if (gt c 0x1f) (do
-      (blit-str str x y)
-      (let buffer (concat buffer str))
-      (let x (+ x 8)) ) 0)
-      
-    (if (* (gt c 8) (lt c 10)) ; tab
-      (do (blit-char 32 x y) (let y (+ y 16)) (let x 32) (let buffer "")) 0)
-      
-    (if (* (gt c 9) (lt c 11)) ; return
-      (do
-        (blit-char 32 x y)
-        (let r (eval (list (read buffer))))
-        (print r)
-        (let buffer "")
-        (let x 32) (let y (+ y 16))
-        (p r x y) (let y (+ y 16))) 0)
-
-    (if (* (gt c 0x7e) (lt c 0x80)) ; bksp
-      (do
-        (blit-char 32 x y)
-        (let x (- x 16))
-        (let nl (- (strlen buffer) 3))
-        (let buffer (substr buffer 0 nl))
-        (print (cons nl buffer))) 0)
-
-    (if (gt x maxx) (do (let x 32) (let y (+ y 16))) 0)
-
-    (if (gt y maxy) (let y 32) 0)
-
-    (if (lt x 32) (let x 32) 0)
-    
-    (if (gt blink 9)
-      (blit-char 0x275a x y) (blit-char 32 x y))
-    (let blink (% (+ blink 1) 20))
-    (send scr 0)
-    
-    (gc)
-  ))
-)))
-
-(main)
-)

sledge/tests/gtn.l

@@ -103,8 +103,7 @@
 
 (def fill-tile-rect (fn x y xx yy tile (do
   (print (cons "fill-tile-rect" tile))
-  (let y (+ 0 y))
-  (let x (+ 0 x))
+  (print (list x y xx yy))
   (while (lt y (+ yy 1)) (do
     (let i x)
     (while (lt i (+ xx 1)) (do
@@ -242,7 +241,7 @@
     (def state state-playing)
   ) 0)
 
-  (let str (recv k))
+  (let str (recv keyboard))
   (let c (get str 0))
 
   (handle-game-key c)
@@ -255,4 +254,4 @@
 
 (main)
 
-)
+)

sledge/tests/html.l

@@ -0,0 +1,56 @@
+(def html-parse-state 0)
+; 0: in text
+; 1: in tag
+; 2: whitespace
+
+(def html-parse (fn raw (do
+  (def i 0)
+  (def j 0)
+  (def k 0)
+  (def l 0)
+  (def rsz (usize raw))
+  (def out (alloc-str rsz))
+  (def html-tag (alloc-str 10))
+
+  (while (lt i rsz) (do
+    (def c (uget raw i))
+    (if (= html-parse-state 0)
+      (if (= c 60)
+        (def html-parse-state 1)
+      (if (or (= c 10) (= c 32))
+        (do 
+          (uput out j c)
+          (def j (+ j 1))
+          (def l (+ l 1))
+          (def html-parse-state 2)
+        )
+      (do
+        (uput out j c)
+        (def j (+ j 1))
+        (def l (+ l 1))
+      )))
+    (if (= html-parse-state 1)
+      (if (= c 62)
+        (def html-parse-state 0)
+        0)
+    (if (= html-parse-state 2)
+      (if (not (or (= c 32) (= c 10)))
+        (if (= c 60)
+          (def html-parse-state 1)
+        (do
+          (def html-parse-state 0)
+          (uput out j c)
+          (def j (+ j 1))
+          (def l (+ l 1))
+        )) 0)
+    0)))
+    (def i (+ i 1))
+    
+    (if (and (= c 32) (gt l 80)) (do
+      (uput out j 10)
+      (def j (+ j 1))
+      (def l 0)
+    ) 0)
+  ))
+  out
+)))

sledge/tests/jit_arm_test.c

@@ -1,53 +0,0 @@
-#include <stdio.h>
-#include <string.h>
-#include <malloc.h>
-#include "jit_arm_raw.c"
-#include <stdint.h>
-#include <sys/stat.h>
-#include <stdlib.h>
-#include <sys/mman.h>
-
-#define CODESZ 1024*4
-
-typedef uint32_t (*funcptr)();
-
-void hello() {
-  printf("hello!\n");
-}
-
-int main() {
-  code = mmap(0, CODESZ, PROT_READ | PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
-  memset(code, 0, CODESZ);
-  cpool_idx = 128; // 128 ops gap
-
-  uint32_t* fb = malloc(1024);
-
-  jit_movi(1,0);
-  jit_movi(5,0);
-  jit_movi(2,0xffffff);
-  jit_lea(3,fb);
-  jit_label("loop");
-  
-  jit_strw(2);
-  jit_addr(3,4);
-  jit_addr(5,1);
-  jit_cmpi(5,0xff);
-  
-  jit_jne("loop");
-  jit_ret();
-  jit_ret();
-  
-
-  FILE* f = fopen("/tmp/test","w");
-  fwrite(code, CODESZ, 1, f);
-  fclose(f);
-
-  int mp_res = mprotect(code, CODESZ, PROT_EXEC|PROT_READ);
-
-  funcptr fn = (funcptr)code;
-  uint32_t res = fn();
-  printf("asm result: %lx\n",res);
-
-  //free(code);
-  //munmap(code);
-}

sledge/tests/speed.l

@@ -1,51 +0,0 @@
-(
-(def scr (open "/framebuffer"))
-(def fb (mmap "/framebuffer"))
-(def f (open "/sd/unifont.565"))
-
-(def unifont (recv f))
-(def unifont-pitch 8256)
-(def screen-pitch  3840)
-
-(def blit-char (fn rune x y (do
-  (let sx (* (+ 2 (% rune 256)) 16))
-  (let sy (* (+ 2 (/ rune 256)) 16))
-  (let so (+ (* sx 2) (* sy unifont-pitch)))
-  (let do (+ (*  x 2) (*  y screen-pitch)))
-  (let iy 0)
-  
-  (while (lt iy 16) (do
-    (let ix 0)
-    (while (lt ix 32) (do
-      (let c (get unifont (+ so ix)))
-      (put fb (+ do ix) c)
-      (put fb (+ (+ do ix) 1) c)
-      (let ix (+ ix 2))
-    ))
-    (let so (+ so unifont-pitch))
-    (let do (+ do screen-pitch))
-    (let iy (+ iy 1))
-  ))
-)))
-
-(def main (fn (do
-  (let i 1)
-  (while 1 (do
-    (let y 0)
-    (while (lt y 48) (do
-      (let x 0)
-      (while (lt x 128) (do
-        (blit-char i (+ 100 (* x 8)) (+ 100 (* y 16)))
-        (let x (+ x 1))
-      ))
-      (let y (+ y 1))
-    ))
-    (send scr 0)
-    (gc)
-    (let i (+ i 1))
-    (if (gt i 1000) (do (let i 0)) 0)
-  ))
-)))
-
-(main)
-)

sledge/tests/startup.l

@@ -1,2 +0,0 @@
-(def f (open "/sd/font.l"))
-(def s (recv f))