# HG changeset patch # User Steve Losh # Date 1560120896 14400 # Node ID f51cda0a23b2b628a1c291d339280332e9914158 # Parent 09e9069036625810c131244e25ec309a46936fe4 Add string rendering and the characters we need for l-systems diff -r 09e906903662 -r f51cda0a23b2 flax.asd --- a/flax.asd Sun Jun 09 16:38:17 2019 -0400 +++ b/flax.asd Sun Jun 09 18:54:56 2019 -0400 @@ -33,7 +33,8 @@ (:file "colors") (:file "transform") (:module "drawing" :serial t - :components ((:file "api") + :components ((:file "letters") + (:file "api") (:file "png") (:file "svg") (:file "plot"))) diff -r 09e906903662 -r f51cda0a23b2 src/drawing/api.lisp --- a/src/drawing/api.lisp Sun Jun 09 16:38:17 2019 -0400 +++ b/src/drawing/api.lisp Sun Jun 09 18:54:56 2019 -0400 @@ -222,32 +222,97 @@ point) +;;;; Glyph -------------------------------------------------------------------- +(defclass* glyph (drawable) + ((pos :type vec3) + (width :type single-float) + (ch :type character) + (paths :type list))) + +(defun glyph (position width character &key (opacity 1.0d0) (color *black*)) + (make-instance 'glyph + :pos (homogenize position) + :width (coerce width 'single-float) + :ch character + :color color + :opacity (coerce opacity 'double-float))) + +(defun recompute-glyph-paths (glyph) + (let ((paths (letter-paths (ch glyph))) + (size (* 2 (width glyph)))) + (ntransform paths (transformation + (scale size size) + (translate (vx (pos glyph)) + (vy (pos glyph))))) + (setf (paths glyph) paths))) + +(defmethod initialize-instance :after ((glyph glyph) &key) + (recompute-glyph-paths glyph)) + +(defmethod print-object ((o glyph) s) + (print-unreadable-object (o s :type t :identity nil) + (format s "~A ~A" (ch o) (pos o)))) + +(defmethod ntransform ((glyph glyph) transformation) + (ntransform (pos glyph) transformation) + (ntransformf (width glyph) transformation) + (ntransformf (paths glyph) transformation) + ;; (recompute-glyph-paths glyph) + glyph) + +(defmethod draw (canvas (glyph glyph)) + (map-curried #'draw canvas (paths glyph))) + + ;;;; Text --------------------------------------------------------------------- (defclass* text (drawable) ((pos :type vec3) - (font :type string) - (size :type single-float) - (align :type keyword) - (content :type string))) + (letter-width :type single-float) + (letter-spacing :type single-float) + (content :type string) + (glyphs :type list))) -(defun text (position size font content - &key (opacity 1.0d0) (color *black*) (align :left)) +(defun rebuild-glyphs (text) + (setf (glyphs text) + (iterate + (with pos = (pos text)) + (with y = (vy (pos text))) + (with space = (+ (letter-width text) (letter-spacing text))) + (with scale = (/ (letter-width text) 0.5)) + (for ch :in-string (content text)) + (for pch :previous ch) + (for x :from (vx pos) :by space) + (incf x (* (kern pch ch) scale)) + (collect (glyph (vec x y) (letter-width text) ch + :opacity (opacity text) + :color (color text)))))) + +(defun text (position letter-width content &key (letter-spacing 0.0) (opacity 1.0d0) (color *black*)) (make-instance 'text - :pos (homogenize position) :size size :font font :content content - :align align + :pos (homogenize position) + :letter-width (coerce letter-width 'single-float) + :letter-spacing (coerce letter-spacing 'single-float) + :content content :color color :opacity (coerce opacity 'double-float))) +(defmethod initialize-instance :after ((text text) &key) + (rebuild-glyphs text)) + + (defmethod print-object ((o text) s) (print-unreadable-object (o s :type t :identity nil) - (format s "~S (~D, ~D)" + (format s "~S ~A" (content o) - (vx (pos o)) - (vy (pos o))))) + (pos o)))) + +(defmethod draw (canvas (text text)) + (map-curried #'draw canvas (glyphs text))) (defmethod ntransform ((text text) transformation) (ntransform (pos text) transformation) - (zapf (size text) (ntransform % transformation)) + (ntransformf (letter-width text) transformation) + (rebuild-glyphs text) text) diff -r 09e906903662 -r f51cda0a23b2 src/drawing/letters.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/drawing/letters.lisp Sun Jun 09 18:54:56 2019 -0400 @@ -0,0 +1,106 @@ +(in-package :flax.drawing) + +(defgeneric letter-paths (character)) + +(defmethod letter-paths ((character (eql #\Space))) + (list)) + +(defmethod letter-paths ((character (eql #\+))) + ;; p₁ + ;; | + ;; | + ;; p₃ ----+---- p₄ + ;; | + ;; | + ;; p₂ + (let ((p1 (vec 0.25 0.35)) + (p2 (vec 0.25 0.75)) + (p3 (vec 0.05 0.55)) + (p4 (vec 0.45 0.55))) + (list (path (list p1 p2)) + (path (list p3 p4))))) + +(defmethod letter-paths ((character (eql #\-))) + (let ((p1 (vec 0.05 0.55)) + (p2 (vec 0.45 0.55))) + (list (path (list p1 p2))))) + +(defmethod letter-paths ((character (eql #\L))) + ;; p₁ + ;; | + ;; | + ;; | + ;; | + ;; p₂|______ p₃ + (let ((p1 (vec 0.05 0.10)) + (p2 (vec 0.05 1.00)) + (p3 (vec 0.45 1.00))) + (list (path (list p1 p2 p3))))) + +(defmethod letter-paths ((character (eql #\R))) + ;; p₁___ p₃ + ;; | \ + ;; p₆|___/ p₄ + ;; | \ + ;; | \ + ;; p₂| \ p₅ + (let ((p1 (vec 0.05 0.10)) + (p2 (vec 0.05 1.00)) + (p3 (vec 0.25 0.10)) + (p4 (vec 0.25 0.55)) + (p5 (vec 0.45 1.00)) + (p6 (vec 0.05 0.55))) + (list (path (list p1 p2)) + (path (list p1 p3 + (list p4 + (vec 0.45 0.10) + (vec 0.45 0.55)) + p5)) + (path (list p4 p6))))) + +(defmethod letter-paths ((character (eql #\→))) + (let ((p1 (vec 0.05 0.55)) + (p2 (vec 0.45 0.55)) + (p3 (vec 0.30 0.45)) + (p4 (vec 0.30 0.65))) + (list (path (list p1 p2)) + (path (list p3 p2 p4))))) + +(defmethod letter-paths ((character (eql #\())) + (let ((p1 (vec 0.40 0.10)) + (p2 (vec 0.40 1.00))) + (list (path (list p1 + (list p2 + (vec 0.05 0.25) + (vec 0.05 0.85))))))) + +(defmethod letter-paths ((character (eql #\)))) + (let ((p1 (vec 0.10 0.10)) + (p2 (vec 0.10 1.00))) + (list (path (list p1 + (list p2 + (vec 0.45 0.25) + (vec 0.45 0.85))))))) + + +(defgeneric kern (a b)) + +(defmethod kern ((a character) (b character)) + 0.0) + +(defmethod kern ((a null) b) + 0.0) + +(defmethod kern ((a (eql #\L)) (b (eql #\+))) -0.15) +(defmethod kern ((a (eql #\L)) (b (eql #\-))) -0.15) +(defmethod kern ((a (eql #\L)) (b (eql #\→))) -0.15) +(defmethod kern ((a (eql #\L)) (b (eql #\())) -0.07) +(defmethod kern ((a (eql #\R)) (b (eql #\→))) -0.05) +(defmethod kern ((a (eql #\R)) (b (eql #\L))) 0.05) +(defmethod kern ((a (eql #\→)) (b (eql #\L))) 0.05) +(defmethod kern ((a (eql #\→)) (b (eql #\R))) 0.05) +(defmethod kern ((a (eql #\()) (b (eql #\-))) -0.05) +(defmethod kern ((a (eql #\()) (b (eql #\+))) -0.05) +(defmethod kern ((a (eql #\-)) (b (eql #\)))) -0.05) +(defmethod kern ((a (eql #\+)) (b (eql #\)))) -0.05) + diff -r 09e906903662 -r f51cda0a23b2 src/drawing/svg.lisp --- a/src/drawing/svg.lisp Sun Jun 09 16:38:17 2019 -0400 +++ b/src/drawing/svg.lisp Sun Jun 09 18:54:56 2019 -0400 @@ -61,21 +61,6 @@ :fill-opacity (opacity p))))) -;;;; Text --------------------------------------------------------------------- -(defmethod draw ((canvas svg-canvas) (text text)) - (with-coordinates canvas - ((x y (pos text)) - (size (size text))) - (svg:text (scene canvas) - (:x x :y y - :font-size size - :font-family (font text) - :text-anchor (string-downcase (align text)) ; dammit inkscape - :fill (web-color (color text)) - :fill-opacity (opacity text)) - (content text)))) - - ;;;; Paths -------------------------------------------------------------------- (defun points-to-pairs (canvas points) (loop :for ps :in points :collect (coords-to-pairs canvas ps))) diff -r 09e906903662 -r f51cda0a23b2 src/package.lisp --- a/src/package.lisp Sun Jun 09 16:38:17 2019 -0400 +++ b/src/package.lisp Sun Jun 09 18:54:56 2019 -0400 @@ -29,7 +29,8 @@ :rotate :place :translate - :ntransform)) + :ntransform + :ntransformf)) (defpackage :flax.drawing (:use :cl :iterate :losh :flax.base :flax.quickutils @@ -47,7 +48,8 @@ :rectangle :point :circle - :text)) + :text + :glyph)) (defpackage :flax.looms.001-triangles diff -r 09e906903662 -r f51cda0a23b2 src/transform.lisp --- a/src/transform.lisp Sun Jun 09 16:38:17 2019 -0400 +++ b/src/transform.lisp Sun Jun 09 18:54:56 2019 -0400 @@ -59,3 +59,7 @@ (defmethod ntransform ((sequence sequence) transformation) (map-into sequence (rcurry #'ntransform transformation) sequence)) + +(defmacro ntransformf (place transformation) + ;; im lazy + `(setf ,place (ntransform ,place ,transformation)))