Very Secure
The little hut known as ztkfg.com was engulfed by the flames of the recent fire within tmsr. This blog now temporarily lives in enemy territory while I wait for republic lands to return to their inhabitable state.
Previous blog posts should be restored shortly.
UPDATE: Previous posts have been salvaged from the fire.1
Note: This is meant to be a picture post. But I failed to do a systems check on my blog before heading out, so I don't have the ability to upload photos. Consequently, the picture part of this picture post will have to wait until I get back.
UPDATE: Photos uploaded.
My 28 hour journey from NYC to Kyoto was made pleasurable by enjoying the superiority of Japanese transit. This began with Japan airlines.
The stewardesses on Japan airlines spoke in such a soft gentle manner that it was nice to hear any announcement they had to make. The main course meal they served was notbad for airplane food, certainly better than anything I have ever had on a US airline. They also had red wine bottles as a standard free drink, which the passenger sitting next to me took full advantage of.
After about thirteen hours of flying, we arrived in Tokyo Narita airport. We took a local train to another station to get on the famous bullet train.
While waiting for the local train I noticed that different trains arriving on our track were coming/going from different directions. While on the train, they announced that after a certain station cars 1-p would split off into one direction and p+1-n would go in another. A nice feature of the disassembling, multi-direction-track train was little lockers for your luggage. 
They announced that should you forget your combo, you would need to ride the train all the way to the terminal station to get your bag.
The bullet train station had floor diagrams of how to stand in line for the arriving trains.
What's the point of making a train hit 300km/h if it loses time to dorks shuffling into the cars at every station?
Our white privilege was checked by Kyoto's dangerously low entryway height. We have a running counter of how many times we have each banged our forehead on some doorway our trip. My counter is already at 4.
In Kyoto, there are vending machines everywhere.
The first site seeing we did was the Kiyomizu Temple.
We did this tour through "the womb" where you are taken through a completely pitch-black tunnel, guided by holding a handrail. The spiritual experience was ruined by a child screaming ahead of us.
Off the beaten path near the temple was a large graveyard.
"Not bad for a canned coffee from a vending machine in a graveyard"
Oh hey it's my neighbor Totoro
Next up was a World War II memorial.
Throughout everywhere they have flowing water with ladles you use to pour the water on your hands as some sort of spiritual cleanse.
Appalling littering on shrines or liquid donations to the dead?
Money is thrown into all sorts of things for good luck.
Now this is what I call a flower.
We went to some street market after temple seeing. Have you tried Melonpan?
The next day we went to a bamboo forest.
Not pictured: around here they have carriages for couples - but instead of being pulled by horses they are pulled by young, fit Japanese men.
Next up, the Tenry-ji Temple and garden.
The gravel in front of this pond is raked in neat lines. A tourist stepped over the fence and a police officer came running to throw them out, and called in the incident so that the gravel would be reraked.
After walking about in the heat we decided to check out an Onsen, a Japanese bathhouse. These are nude-required and tattooed-person-banned "hot springs." The land of 100 dicks had a bunch of different stations: a normal shower, jacuzzis with massage jets, muddy "hot spring' water, a freezing cold pool "the shrinker', a sauna, and a massage room. I paid thirty bucks extra to get the massage. But instead of the borderline sexual experience I was hoping for, I was scrubbed down furiously by an older Korean woman. I can't say I felt particularly relaxed afterwards, but I did feel clean.
That night we went to a bar where the bartenders are incentivized to make the cocktails nice.
Our last day in Kyoto was spent at the orange gates. They did an exhibit of this once in Central Park in NYC when I was younger.
But first, conveyer belt sushi. The way this works is that each different colored plate has a different price. When you're done eating they tally up all the plates you have to pay.
We also stumbled upon a University campus on our way to the orange gates.
It's a decent hike up, as you get closer to the top there are more opportunities for pics without hundreds of people in the gates.
And that wraps it up for Kyoto, next up Seoul, Korea.
My contributions to the republic, while having spent years twiddling my thumbs reading the logs, are as follow:
1. 5 Qntra posts, found here: 1
My first post was an inside perspective of MIT's "blockchain" curriculum. It confirmed what the republic already knew, namely that there was no interesting work going on at MIT re bitcoin, and any "work" being done there was hostile towards republican interests. Two other posts were tabloidal, making fun of pantsuitism. And the last two posts were reports on Coinbase shenanagins during the bitcoin cash hard fork.
2. Setting up my own trb bitcoin node. (failed)
There was naivety in my attempts to setup a running bitcoin node. When I first attempted to setup a node, I tried to get it goig on an old unused laptop. One mistake was believing that 2gb of ram is enough to get a timely block sync. I had thought at the time that the only bottleneck to getting a node up to speed was downloading the blocks, and I did not intuit the time it takes to locally verify all the blocks along the way2 I later attempted to sync a node on a dedicated machine hosted by dreamhost.com,3 paying a little over $100 usd per month. I can't quite recall what happened, but I think around block 350,000 it got stuck. Later, without trying to reboot bitcoind, I decided to cut my expense with dreamhost and gave up on running a full node.
3. Researching how many bitcoins are tied up in P2SH4 (failed)
The goal was getting an upper bound of how many coins are in anyone-can-spend scripts in order to answer the question: how many coins are in addresses related to segwit?
To do this, I first used ben_vulpes's block explorer5 to grab sexprs containing the data for every block. This was obtained by looping from 0...max_block_height and running
wget -0 http://mimisbrunnr.cascadianhacker.com/blocks/blk{n}
where {n} was the block number. While I was running a loop performing this task I noticed that occasionally ben's block explorer would give me some malformed file - and I had to simply re-wget the same url until i got back a properly formatted sexpr. It took a while to download all the blocks from Ben (even though I was not verifying them) and so I paid for a digitalocean droplet to run my scraper script on.6
Once I had blocks 0..n, I ran a script7 that would go through a chunk of blocks and keep an ongoing hashmap mapping "(txn hash, output number) -> num_satoshis_sent_to_output" for all the outputs in the block that were sent to non-trb conforming addresses. For each new block, the script would first iterate through the txns in the block to see if any of them spent the coins in the ongoing hashmap obtained from all the previous blocks. If a txn in the new block consumed one of the P2SH UTXOs that was being stored, that UTXO would be deleted from the ongoing hashmap. Once the purge of transaction outputs that had just been spent was completed, the script reiterated through the new block's txns to add any txn outputs that were directed to non-trb P2SH's to the ongoing hashmap. After iterating through all the blocks, one could calculate how many satoshis were in non-trb addresses by summig up all the values in the obtained hashmap.
I don't recall at what point/why I just faded away and stopped working on this tool. It may have been because I hit a problem with running out of memory for storing all the segwit UTXOs. It was an interesting investigation and perhaps the republic would still find a counter of coins that are contained in non-trb addresses useful. Which brings us to part two of this post:
Potential Future TMSR Work
diana_coman: whaack_pura_vida: that8 is obsolete so not a lot of help in itself; nobody is going to make the list ready for you to pick and choose, wtf.
diana_coman: whaack_pura_vida: publish what you figure out by Sunday together with *how you went about* the figuring out
My initial internal response to diana_coman was " (1) why is that a ridiculous expectation since there previously was a list of entry points? and (2) how is that list obsolete if a young hand such as shrysr is digesting V, which is more or less a task on that list?"
The best answer I can come up with to my own questions are "Yes, a list was once generously made, but doesn't mean that lords have time to keep an up to date task list for noobs. That post was THREE YEARS AGO and now there are new tasks to do - which you must find yourself. The current task list may or may not coincide with the three year old post, you have to have read the logs to find out."
With that being said, and keeping with the "how you went about figuring out", here is a list of potential tasks, with an annotation denoting how/why I came to choose that task.
1. Creating my own V9
2. Related to 1, taking up the task of maintaining a vpatch viewer10
3. Creating a new trb block explorer11
4. Continuing fighting the war on Segwit, first by completing the task of sizing up the coins held in P2SH. 12
5. Learning ADA and completing Stan's FFA series.13
Tasks (3) and (4) seems the most interesting to me, but I believe the v-related tasks (1) and (2) should be my starting point.
This post is my notes from a more detailed write up from the "Mimic Method" which comes with visual and audio aids. This only contains information on monophthongs - details of diphthongs and triphthongs and will come in a future part in this series.
There are five vowel sounds, and the alphabetic letters are the same as their corresponding phonetic letter [a] [e] [i] [o] [u].
One of the main differences between the Spanish vowels and their English equivalents is that the Spanish vowels are "short and crisp." They do not glide/change to a different sound as you say them. If you put your lips/mouth in the correction position, hold them there, and then perform a voiced sound1, you will get the right sound without having to alter the initial articulation. This is in contrast to some English vowels, like the o in "no" which glides something like a "w" as you say it.
A - The tongue is low and center, lips unrounded. You need to draw your tongue/jaw lower than when you make the ah sound in English words (like pot)
E - The tongue is at middle height and forward, lips unrounded. Be careful not to glide it to a y as we do in many English words such as "hey" and "bay".
I - The tongue is high and forward, lips unrounded. It is pronounced like the e's in the English word see.
O - The tongue is back and center, lips rounded.2
U - The tongue is back and high, lips rounded. Once again make sure not to curl the lips while saying the vowel.
Common Gringo Mistakes:
1. Closing/reducing/changing vowels: A, O, E. Each of the five (lone) vowels sound the same no matter where they are located in a word. When a gringo says nada they may say nah-duh. But the correct pronunciation has the A vowel the same both before and after the d.
2. Gliding vowels. Vowels (by themselves) in Spanish are never diphthongs. They are short sounds with an articulation that remains constant.
3. Lip rounding of vowels. Don't have your o's and u's morph to w's, like they do in the English for the words "no" and "Sue".
This is part 1 of a series that goes through all of the major differences of pronunciation between Spanish and English. It assumes the reader knows a little bit of knowledge of phonetic1 lingo and knows some very basic Spanish pronunciation - like that i is pronounced ee as in see and that ll is pronounced like an English y. To begin:
d and t:
In English, d and t are both stops2 that are created by placing the tongue on the alveolar ridge.3 In Spanish, d and t are also stops, but they have a less forceful explosion of air, and the tongue blocks the airflow by being placed on the upper teeth instead of on the alveolar ridge. Relatedly, the stops in Spanish are not aspirated as they are in English.4 So in English we say tea [thi] en español se dice ti [ti].
p and /k/ (k or hard c):
p and /k/ have the same oral articulation in Spanish as they do in English. The difference is that -once again- in Spanish there is the release of air at the end of the stops is gentle and the stops are not aspirated.
I saw the sentence in the title of this post in my Spanish version of For Whom The Bell Tolls - Por quién doblan las campanas. It took me a minute to grok the meaning, since there are a few different grammar concepts packed into the sentence. Let's go over them.
1. Hace falta. If something "hace falta"'s , it literally makes a fault, which means it is necessary.
2. Decir is conjugated in the first person subjective. The change in subject between the clauses connected with the "que" in the impersonal expression1
3. Se is used for various different reasons in Spanish. In this case, it is being used as an indirect object pronoun. One would use "le" for the singular third person/formal 2nd person, but since the direct object pronoun "lo" immediately follows, the le is converted to se.
Put those together and given the context, the translates to : "I don't need to tell it to you."
Western music is based on the major scale. To play the major scale, you need to start at some note and then do the following sequence: WWHWWWH. Each H represents half, which means you increase the frequency by one semitone, (i.e. 2 ^ (1/12), i.e. 1 fret on the guitar.) The W represents two semitones. When you start on a note1 , you can stay in the key of that note by following any rotation of the major scale sequence. The index of the major scale that you start with determines the mode you are in.2
Switching modes throughout a piece is not advised. It swaps the mood of the piece, and gives the sense you are changing your style mid performance. However, switching keys while staying in the same mode can add lots of variety to the music.
Plato suggests only playing in the Dorian and Phrygian.
The notes listed to the right of the mode are the note sequences for that mode that have no flats or sharps. But a mode can start with any note.
[↩]
One of the gifts I would give my younger self, had I the ability to be my own father1, would be music lessons for a decent instrument. My childhood music career consisted of meeting once a week in school to play the recorder. The recorder sounds awful, and I had horrible instruction. So for my whole life I considered playing an instrument an activity I was not good at and did not enjoy.
But when I was living in Costa Rica, I had the good fortune to have a neighbor who had a guitar lying around. After borrowing his for a few months, I got my own, and I've been playing ever since. I oscillate between whether or not I consider the guitar a waste of time. Playing an instrument gives an enjoyable way to measure progress in your ability to be self disciplined. The meta learning skill that comes with practicing an instrument can be carried into other aspects of life. The drawback is that it is easy to sink _lots_ of time into the guitar. Today I skipped my daily Spanish lesson in order to jam on the guitar for an extra hour and a half.
I've taken a pause on going through SICP, and have instead been focusing on making arrangements to get out of the US. This involves earning a few more benjies, finding a lease in a little Spanish speaking town,1, and saying goodbye to friends and family.
I regret not blogging more frequently. Taking a few minutes to write down and reflect on current goals can go a long way, especially when you do it publicly and give opportunities for criticism. Going forward, I aim to write at least twice a week.
Do you know every time I post these, I need to go through and put extra spaces in in between double parens to avoid my code turning into footnotes? Holy hell.
This is probably the first useful post to someone going through SICP using Common Lisp since it contains a little bit of code to draw your images from the end of the chapter to svg markup. Look at print-svg-header, draw-to-square-svg, and draw-line at the bottom to see the details.
;; 2.17
(defun last-pair (lst)
(if (equal (cdr lst) nil)
lst
(last-pair (cdr lst))))
;; 2.18
(defun my-reverse (lst)
(if (equal lst nil)
nil
(append (my-reverse (cdr lst)) (list (car lst)))))
;; 2.19
(defparameter *us-coins* (list 50 25 10 5 1))
(defun cc (amount coin-values)
(defun no-more? (values) (null values))
(defun except-first-denomination (values) (cdr values))
(defun first-denomination (values) (car values))
(cond ( (equal amount 0) 1)
( (or (< amount 0) (no-more? coin-values)) 0)
(t
(+ (cc amount
(except-first-denomination coin-values))
(cc (- amount
(first-denomination coin-values))
coin-values)))))
;; 2.20
(defun same-parity (x &rest y)
(let ( (parity (mod x 2)))
(defun filter-parity (remaining)
(cond
((null remaining) nil)
((equal (mod (car remaining) 2) parity)
(cons (car remaining) (filter-parity (cdr remaining))))
(t (filter-parity (cdr remaining))))))
(cons x (filter-parity y)))
;; 2.21
(defun square-list (items)
(if (null items)
nil
(cons (square (car items)) (square-list (cdr items)))))
(defun square-list-two (items)
(mapcar (lambda (x) (square x)) items))
;; 2.22
;; This would make the first element in the list nil, and would make the cons chain
;; look something like (nil (1 (4 (9 16)))) which is a malformed list.
;; 2.23
(defun for-each (f lst)
(if (not (null lst)) (funcall f (car lst)))
(if (null lst) nil (for-each f (cdr lst))))
;; Seems like a better verison, but we do not have progn as a construct so far in the book.
(defun for-each-progn (f lst)
(if (null lst)
nil
(progn (funcall f (car lst)) (for-each f (cdr lst)))))
;; 2.24 see picture
;; 2.25
;; (car (cdaddr '(1 3 (5 7) 9)))
;; (caar '((7)))
;; (cadadr ( cadadr (cadadr '(1 (2 (3 (4 (5 (6 7))))))))
;; 2.26
(defun twotwosix ()
(let ( (x (list 1 2 3))
(y (list 4 5 6)))
(print (append x y)) ; (1 2 3 4 5 6)
(print (cons x y)) ; ( (1 2 3) 4 5 6)
(print (list x y)))) ; ( (1 2 3) (4 5 6))
;; 2.27
;; This was easy to do by looking at the simple solution of shallow-reverse.
(defun deep-reverse (lst)
(cond
( (null lst) nil)
( (atom (car lst)) (append (deep-reverse (cdr lst)) (list (car lst))))
(t (append (deep-reverse (cdr lst)) (list (deep-reverse (car lst)))))))
;; 2.28
;; flatten the list
(defun fringe (lst)
(cond
( (null lst) nil)
( (atom (car lst)) (cons (car lst) (fringe (cdr lst))))
(t (append (fringe (car lst)) (fringe (cdr lst))))))
;; 2.29
(defun make-mobile (left right) (list left right))
(defun left-branch (mobile) (car mobile))
(defun right-branch (mobile) (cadr mobile))
(defun make-branch (length structure) (list length structure))
(defun branch-length (branch) (car branch))
(defun branch-structure (branch) (cadr branch))
(defun is-leaf-branch (branch) (atom (branch-structure branch)))
;; I wonder if I should not have these circular definitions of get-weight and total-weight.
;; But it seems very useful to separate the block structure for the is-balanced method.
(defun get-weight (branch)
(if (is-leaf-branch branch)
(branch-structure branch)
(total-weight (branch-structure branch))))
(defun total-weight (mobile)
(let ( (left (left-branch mobile))
(right (right-branch mobile)))
(+ (get-weight left) (get-weight right))))
(defun is-balanced (mobile)
(defun torque-of-branch (branch) (* (branch-length branch) (get-weight branch)))
(defun is-just-a-weight (mobile) (atom mobile))
(if (is-just-a-weight mobile)
t
(let ( (left (left-branch mobile))
(right (right-branch mobile)))
(and
(equal (torque-of-branch left) (torque-of-branch right))
(is-balanced (branch-structure left))
(is-balanced (branch-structure right))))))
(make-mobile (make-branch 5 10) (make-branch 6 (make-mobile (make-branch 5 5) (make-branch 6 6))))
(make-mobile (make-branch 5 20) (make-branch 10 (make-mobile (make-branch 2 8) (make-branch 8 2))))
;; d) we would just need to change "cad" in branch-structure and right-branch to "cdr"
;; 2.30
(defun square-tree-direct (tree)
(cond
( (null tree) nil)
( (atom tree) (square tree))
(t (cons (square-tree-direct (car tree)) (square-tree-direct (cdr tree))))))
(defun square-tree (tree)
(mapcar
(lambda (element)
(if (listp element)
(square-tree element)
(square element))) tree))
;; 2.31
(defun tree-map (f tree)
(mapcar (lambda (element) (if (listp element) (tree-map f element) (funcall f element))) tree))
;; 2.32
;; To find the subsets of s, we append the first element of s to all the subsets of s minus
;; the first element.
(defun subsets (s)
(if (null s)
(list nil)
(let ( (rest (subsets (cdr s))))
(append rest (mapcar (lambda (ele) (append ele (list (car s)))) rest)))))
;; 2.33
(defun accumulate (op initial sequence)
(if (null sequence)
initial
(funcall op
(car sequence)
(accumulate op initial (cdr sequence)))))
(defun my-map (f sequence)
(accumulate (lambda (x y) (cons (funcall f x) y)) nil sequence))
(defun my-append (seq1 seq2)
(accumulate #'cons seq2 seq1))
(defun my-length (sequence)
(accumulate (lambda (x y) (declare (ignore x)) (+ 1 y)) 0 sequence))
;; 2.34
(defun horner-eval (x-val coefficients)
(accumulate (lambda (coefficient processed) (+ coefficient (* x-val processed))) 0 coefficients))
;; 2.35
(defun count-leaves-acc (tree)
(accumulate #'+ 0
(mapcar (lambda (ele)
(if (listp ele)
(count-leaves-acc ele)
1)) tree)))
;; 2.36
(defun accumulate-n (op init seqs)
(if (null (car seqs))
nil
(cons (accumulate op init (mapcar #'car seqs))
(accumulate-n op init (mapcar #'cdr seqs)))))
;; 2.37
;; I'm not sure how to get the equivilant map function found in scheme,
;; so I rewrote dot-product.
(defun dot-product (v w)
(defun multiply-same-indices (v w)
(cond
( (null v) nil)
(t
(cons (* (car v) (car w))
(multiply-same-indices (cdr v) (cdr w))))))
(accumulate #'+ 0 (multiply-same-indices v w)))
(defun matrix-*-vector (m v)
(mapcar (lambda (w) (dot-product w v)) m))
(defun transpose (mat)
(accumulate-n #'cons nil mat))
(defun matrix-*-matrix (m n)
(let ( (cols (transpose n)))
(mapcar (lambda (row) (matrix-*-vector cols row)) m)))
;; 2.38
(defun fold-right (op initial sequence) (accumulate op initial sequence))
(defun fold-left (op initial sequence)
(defun iter (result rest)
(if (null rest)
result
(iter (funcall op result (car rest))
(cdr rest))))
(iter initial sequence))
;; (iter (list nil 1) (2 3))
;; (iter (list (list nil 1) 2) (3))
;; (iter (list (list (list nil 1) 2) 3))
;; (fold-right / 1 (list 1 2 3 )) = 3/2
;; (fold-left / 1 (list 1 2 3 )) = 1/6
;; (fold-right list nil (list 1 2 3)) = (1 (2 (3 nil)))
;; (fold-left list nil (list 1 2 3)) = ( ( (nil 1) 2) 3)
;; op must be communative and associative.
;; 2.39
(defun fold-right-reverse (sequence)
(fold-right (lambda (x y) (append y (list x))) nil sequence))
(defun fold-left-reverse (sequence)
(fold-left (lambda (x y) (cons y x)) nil sequence))
;; 2.40
(defun enumerate-interval (start finish)
(defun iter (current)
(if (> current finish)
nil
(cons current (iter (+ current 1)))))
(iter start))
(defun flatmap (proc seq)
(accumulate #'append nil (mapcar proc seq)))
(defun pair-sum (pair)
(+ (car pair) (cadr pair)))
;; primep must be imported from chapter1
(defun prime-sump (pair)
(primep (pair-sum pair)))
(defun make-pair-sum (pair)
(list (car pair) (cadr pair) (pair-sum pair)))
(defun unique-pairs (n)
(flatmap
(lambda (i) (mapcar (lambda (j) (list j i)) (enumerate-interval 1 (- i 1))))
(enumerate-interval 2 n)))
(defun prime-sum-pairs (n)
(mapcar #'make-pair-sum (remove-if-not #'prime-sump (unique-pairs n))))
;; 2.41
;; (1 2 3 4)
;; (1
(defun unique-triplets (n)
(flatmap (lambda (i) (mapcar (lambda (pair) (append pair (list i))) (unique-pairs (- i 1)))) (enumerate-interval 3 n)))
(defun unique-triplets-that-sum-to (n s)
(defun triplet-sums-to-s (triplet) (equal (+ (car triplet) (cadr triplet) (caddr triplet)) s))
(remove-if-not #'triplet-sums-to-s (unique-triplets n)))
;; 2.42
;; Each board is represented as a list of numbers 1-8 that represent the position of the queen
;; in that column.
(defun queens (board-size)
(defun adjoin-position (new-row k rest-of-queens)
(declare (ignore k))
(cons new-row rest-of-queens))
(defun safe? (k positions)
(declare (ignore k))
(defun safe?-helper (ascending-diag horiz descending-diag positions)
(cond
((null positions) t)
((or (equal (car positions) ascending-diag)
(equal (car positions) horiz)
(equal (car positions) descending-diag)) nil)
(t (safe?-helper (+ ascending-diag 1) horiz (- descending-diag 1) (cdr positions)))))
(safe?-helper (+ 1 (car positions)) (car positions) (- (car positions) 1) (cdr positions)))
(defun queen-cols (k)
(if (equal k 0)
(list nil)
(remove-if-not
(lambda (positions) (safe? k positions))
(flatmap
(lambda (rest-of-queens)
(mapcar (lambda (new-row)
(adjoin-position new-row k rest-of-queens))
(enumerate-interval 1 board-size)))
(queen-cols (- k 1))))))
(queen-cols board-size))
;; 2.43
;; Louis Reasoner's solution is much slower because his program now calls queens-col for every
;; new possible position of a queen, instead of considering every new possible position of a queen
;; for one recusrive call to queens-cols.
;; This makes the recursive relationship switch from
;; T(k) = T(k-1) + C
;; to
;; T(k) = board-size * T(k-1) + C
;; So if the previous time was T the new time will be ~board-size^T.
;; 2.44
;; TODO Implement
(defun flip-vert (painter)
(transform-painter painter
(make-vect 0.0 1.0)
(make-vect 1.0 1.0)
(make-vect 0.0 0.0)))
(defun right-split (painter n)
(if (equal n 0)
painter
(let ( (smaller (right-split painter (- n 1))))
(beside painter (below smaller smaller)))))
(defun up-split (painter n)
(if (equal n 0)
painter
(let ( (smaller (up-split painter (- n 1))))
(below painter (beside smaller smaller)))))
(defun corner-split (painter n)
(if (equal n 0)
painter
(let ( (up (up-split painter (- n 1)))
(right (right-split painter (- n 1))))
(let ( (top-left (beside up up))
(bottom-right (below right right))
(corner (corner-split painter (- n 1))))
(beside (below painter top-left)
(below bottom-right corner))))))
(defun square-limit (painter n)
(let ( (quarter (corner-split painter n)))
(let ( (half (beside (flip-horiz quarter) quarter)))
(below (flip-vert half) half))))
(defun square-of-four (tl tr bl br)
(lambda (painter)
(let ( (top (beside (funcall tl painter) (funcall tr painter)))
(bottom (beside (funcall bl painter) (funcall br painter))))
(below bottom top))))
(defun flipped-pairs (painter)
(funcall (square-of-four #'identity #'flip-vert #'identity #'flip-vert) painter))
;; 2.45
(defun split (direction combine-smaller)
(defun split-func (painter n)
(if (equal n 0)
painter
(let ( (smaller (split-func painter (- n 1))))
(funcall direction painter (funcall combine-smaller smaller smaller)))))
#'split-func)
;; 2.46
(defun frame-coord-map (frame)
(lambda (v)
(add-vect
(origin-frame frame)
(add-vect (scale-vect (xcor-vect v)
(edge1-frame frame))
(scale-vect (ycor-vect v)
(edge2-frame frame))))))
(defun make-vect (x y)
(cons x y))
(defun add-vect (v1 v2)
(make-vect (+ (xcor-vect v1) (xcor-vect v2))
(+ (ycor-vect v1) (ycor-vect v2))))
(defun sub-vect (v1 v2)
(make-vect (- (xcor-vect v1) (xcor-vect v2))
(- (ycor-vect v1) (ycor-vect v2))))
(defun xcor-vect (v) (car v))
(defun ycor-vect (v) (cdr v))
(defun scale-vect (s v)
(make-vect (* s (xcor-vect v)) (* s (ycor-vect v))))
;; 2.47
(defun make-frame (origin edge1 edge2)
(list origin edge1 edge2))
(defun origin-frame (frame) (car frame))
(defun edge1-frame (frame) (cadr frame))
(defun edge2-frame (frame) (caddr frame))
(defun make-frame-2 (origin edge1 edge2)
(cons origin (cons edge1 edge2)))
(defun origin-frame-2 (frame) (car frame))
(defun edge1-frame-2 (frame) (cadr frame))
(defun edge2-frame-2 (frame) (cddr frame))
;; 2.48
(defun make-segment-two (start-segment end-segment) (cons start-segment end-segment))
(defun start-segment-two (segment) (car segment))
(defun end-segment-two (segment) (cdr segment))
;; 2.49
(defun segments->painter (segment-list)
(lambda (frame)
(for-each
(lambda (segment)
(draw-line
(funcall (frame-coord-map frame) (start-segment segment))
(funcall (frame-coord-map frame) (end-segment segment))))
segment-list)))
;; a
(defun draw-outline ()
(segments->painter
(list
(make-segment (make-vect 0 0) (make-vect 0 1))
(make-segment (make-vect 0 1) (make-vect 1 1))
(make-segment (make-vect 1 1) (make-vect 1 0))
(make-segment (make-vect 1 0) (make-vect 0 0)))))
;; b
(defun draw-x ()
(segments->painter
(list
(make-segment (make-vect 0 0) (make-vect 1 1))
(make-segment (make-vect 0 1) (make-vect 1 0)))))
;; c
(defun draw-diamond ()
(segments->painter
(list
(make-segment (make-vect .5 0) (make-vect 1 .5))
(make-segment (make-vect 1 .5) (make-vect .5 1))
(make-segment (make-vect .5 1) (make-vect 0 .5))
(make-segment (make-vect 0 .5) (make-vect .5 0)))))
;; d
(defun draw-wave ()
(segments->painter
;; note that left = left of screen, not left of body. same with right.
(list
(make-segment (make-vect .3 0) (make-vect .35 .5)) ;; start with bottom left leg
(make-segment (make-vect .35 .5) (make-vect .31 .55)) ;; to armpit
(make-segment (make-vect .31 .55) (make-vect .2 .44)) ;; bottom left elbow
(make-segment (make-vect .2 .44) (make-vect 0 .6)) ;; to end of left hand
(make-segment (make-vect 0 .8) (make-vect .19 .58)) ;; top of left hand to weenus
(make-segment (make-vect .19 .58) (make-vect .31 .62)) ;; weenus to left shoulder
(make-segment (make-vect .31 .62) (make-vect .4 .62)) ;; left shoulder to bottom of head
(make-segment (make-vect .4 .62) (make-vect .33 .8)) ;; bottom of head to left ear
(make-segment (make-vect .33 .8) (make-vect .4 1)) ;; left ear to top left head
(make-segment (make-vect .6 1) (make-vect .67 .8)) ;; top right head to top right ear
(make-segment (make-vect .67 .8) (make-vect .6 .62)) ;; top right ear to bottom of head
(make-segment (make-vect .6 .62) (make-vect .78 .62)) ;; bottom of head to right shoulder
(make-segment (make-vect .78 .62) (make-vect 1 .3)) ;; right shouldre to top of right hand
(make-segment (make-vect 1 .15) (make-vect .61 .46)) ;; bottom right of hand to right armpit
(make-segment (make-vect .61 .46) (make-vect .77 0)) ;; right armpit to right of right leg
(make-segment (make-vect .6 0) (make-vect .5 .28)) ;; left of right leg to penis
(make-segment (make-vect .5 .28) (make-vect .4 0)) ;; penis to right of left leg.
)))
;; 2.50
(defun transform-painter (painter origin corner1 corner2)
(lambda (frame)
(let ( (m (frame-coord-map frame)))
(let ( (new-origin (funcall m origin)))
(funcall painter
(make-frame new-origin
(sub-vect (funcall m corner1) new-origin)
(sub-vect (funcall m corner2) new-origin)))))))
(defun flip-horiz (painter)
(transform-painter painter
(make-vect 1.0 0)
(make-vect 0.0 0.0)
(make-vect 1.0 1.0)))
(defun rotate90 (painter)
(transform-painter painter
(make-vect 1.0 0.0)
(make-vect 1.0 1.0)
(make-vect 0.0 0.0)))
(defun rotate180 (painter)
(rotate90 (rotate90 painter)))
(defun rotate270 (painter)
(rotate90 (rotate180 painter)))
;; 2.51
(defun beside (painter1 painter2)
(let ( (split-point (make-vect 0.5 0.0)))
(let ( (paint-left
(transform-painter painter1
(make-vect 0.0 0.0)
split-point
(make-vect 0.0 1.0)))
(paint-right
(transform-painter painter2
split-point
(make-vect 1.0 0.0)
(make-vect 0.5 1.0))))
(lambda (frame)
(funcall paint-left frame)
(funcall paint-right frame)))))
(defun below (painter1 painter2)
(let ( (split-point (make-vect 0.0 .5)))
(let ( (paint-bottom
(transform-painter painter1
(make-vect 0 0)
(make-vect 1.0 0)
split-point))
(paint-top
(transform-painter painter2
split-point
(make-vect 1.0 .5)
(make-vect 0.0 1.0))))
(lambda (frame)
(funcall paint-bottom frame)
(funcall paint-top frame)))))
(defun below-rotate (painter1 painter2)
(rotate90 (beside (rotate270 painter1) (rotate270 painter2))))
;; 2.52
;; Maybe we draw
;;
;; extra code to draw
;; a
(defun draw-wave-with-smile ()
(segments->painter
;; note that left = left of screen, not left of body. same with right.
(list
(make-segment (make-vect .3 0) (make-vect .35 .5)) ;; start with bottom left leg
(make-segment (make-vect .35 .5) (make-vect .31 .55)) ;; to armpit
(make-segment (make-vect .31 .55) (make-vect .2 .44)) ;; bottom left elbow
(make-segment (make-vect .2 .44) (make-vect 0 .6)) ;; to end of left hand
(make-segment (make-vect 0 .8) (make-vect .19 .58)) ;; top of left hand to weenus
(make-segment (make-vect .19 .58) (make-vect .31 .62)) ;; weenus to left shoulder
(make-segment (make-vect .31 .62) (make-vect .4 .62)) ;; left shoulder to bottom of head
(make-segment (make-vect .4 .62) (make-vect .33 .8)) ;; bottom of head to left ear
(make-segment (make-vect .33 .8) (make-vect .4 1)) ;; left ear to top left head
;; smile
(make-segment (make-vect .37 .75) (make-vect .5 .65))
(make-segment (make-vect .5 .65) (make-vect .63 .75))
(make-segment (make-vect .6 1) (make-vect .67 .8)) ;; top right head to top right ear
(make-segment (make-vect .67 .8) (make-vect .6 .62)) ;; top right ear to bottom of head
(make-segment (make-vect .6 .62) (make-vect .78 .62)) ;; bottom of head to right shoulder
(make-segment (make-vect .78 .62) (make-vect 1 .3)) ;; right shouldre to top of right hand
(make-segment (make-vect 1 .15) (make-vect .61 .46)) ;; bottom right of hand to right armpit
(make-segment (make-vect .61 .46) (make-vect .77 0)) ;; right armpit to right of right leg
(make-segment (make-vect .6 0) (make-vect .5 .28)) ;; left of right leg to penis
(make-segment (make-vect .5 .28) (make-vect .4 0)) ;; penis to right of left leg.
)))
;; b
(defun new-corner-split (painter n)
(if (equal n 0)
painter
(let ( (up (up-split painter (- n 1)))
(right (right-split painter (- n 1))))
(let ( (top-left up)
(bottom-right right)
(corner (corner-split painter (- n 1))))
(beside (below painter top-left)
(below bottom-right corner))))))
;; c
(defun outward-square-limit (painter n)
(let ( (quarter (corner-split (flip-horiz painter) n)))
(let ( (half (beside (flip-horiz quarter) quarter)))
(below (flip-vert half) half))))
(defmacro print-svg-header (width height &body body)
;; I have the intuition that there is a proper way to do this without the use of progn.
`(progn
(format 't "<svg width=\"~a\" height=\"~a\" version=\"1.1\" xlmns=\"http://www.w3.org/2000/svg\">" ,width ,height)
,@body
(format 't "</svg>")))
;; This perhaps should just be a function, and not a macro.
(defun draw-to-square-svg (painter &optional (width 500) (height 500))
(print-svg-header width height
(funcall painter
(make-frame (make-vect 0 height) (make-vect width 0) (make-vect 0 (- height))))))
(defun draw-line (start end)
(format 't "<line x1=\"~a\" y1=\"~a\" x2=\"~a\" y2=\"~a\" stroke=\"black\" stroke-width=\"5\"/>"
(xcor-vect start)
(ycor-vect start)
(xcor-vect end)
(ycor-vect end)))