Add crazy box example
author |
Steve Losh <steve@stevelosh.com> |
date |
Fri, 07 Apr 2017 18:17:50 +0000 |
parents |
(none) |
children |
55af36925fd1 |
(ql:quickload '(:cl-blt :losh :iterate))
(defpackage :cl-blt.examples.box
(:use :cl :losh :iterate))
(in-package :cl-blt.examples.box)
;;;; GUI ----------------------------------------------------------------------
(defun draw-background ()
(setf (blt:layer) 0)
(iterate (for-nested ((x :from 0 :below (truncate (blt:width) 2))
(y :from 0 :below (truncate (blt:height) 2))))
(for color = (random-range 0.5 0.9))
(setf (blt:color) (blt:rgba color color color)
(blt:cell-char (* 2 x) (* 2 y))
(random-elt "abcdefghijklmnopqrstuvwxyz"))))
(defun draw-outline (x y w h
top bottom left right
top-left top-right
bot-left bot-right)
(iterate (for bx :from (1+ x) :below (+ x w -1))
(setf (blt:cell-char bx y) top
(blt:cell-char bx (+ y h -1)) bottom))
(iterate (for by :from (1+ y) :below (+ y h -1))
(setf (blt:cell-char x by) left
(blt:cell-char (+ x w -1) by) right))
(setf
(blt:cell-char x y) top-left
(blt:cell-char (+ x w -1) y) top-right
(blt:cell-char x (+ y h -1)) bot-left
(blt:cell-char (+ x w -1) (+ y h -1)) bot-right))
(defun draw-fill (x y w h &optional (char #\full_block))
(iterate (for-nested ((bx :from x :below (+ x w))
(by :from y :below (+ y h))))
(setf (blt:cell-char bx by) char)))
(defun draw-box-background (x y w h layer)
(setf (blt:color) (blt:rgba 0 0 200)
(blt:layer) layer)
(draw-fill (1+ x) (1+ y) (1- w) (1- h))
(draw-outline x y w h
#\lower_half_block
#\upper_half_block
#\right_half_block
#\left_half_block
#\quadrant_lower_right
#\quadrant_lower_left
#\quadrant_upper_right
#\quadrant_upper_left))
(defun draw-box-border (x y w h layer)
(setf (blt:color) (blt:rgba 255 255 255)
(blt:layer) (1+ layer))
(draw-outline x y w h
#\box_drawings_double_horizontal
#\box_drawings_double_horizontal
#\box_drawings_double_vertical
#\box_drawings_double_vertical
#\box_drawings_double_down_and_right
#\box_drawings_double_down_and_left
#\box_drawings_double_up_and_right
#\box_drawings_double_up_and_left))
(defun draw-box (x y w h contents layer)
(draw-box-background x y w h layer)
(draw-box-border x y w h layer)
(setf (blt:color) (blt:rgba 1.0 1.0 1.0)
(blt:layer) (+ layer 2))
(blt:clear-area x y w h)
(blt:print (1+ x) (1+ y)
(format nil "[font=tall]~S[/font]" contents)
:width (- w 2) :height (- h 2)))
(defun draw ()
(draw-box 3 3 10 10 "hello, world! how close can we get here, what if we go over oh no!" 5)
(blt:refresh))
(defun config ()
(blt:set "tall font: ./examples/UbuntuMono/UbuntuMono-R.ttf, size=10x20, spacing=1x2, align=center;")
(blt:set "font: ./examples/ProggySquare/ProggySquare.ttf, size=20x20, spacing=2x2, align=dead-center;")
(blt:set "window.resizeable = false")
(blt:set "window.cellsize = 10x10")
(blt:set "window.size = 30x20")
(blt:set "window.title = Box Demo"))
(defun main ()
(blt:with-terminal
(config)
(draw-background)
(iterate
(draw)
(blt:key-case (blt:read)
(:space (draw-background))
(:escape (return))
(:close (return))))))