From: Ramakrishnan Muthukrishnan Date: Tue, 31 Aug 2010 18:34:25 +0000 (+0530) Subject: Utilities for henderson's picture language. X-Git-Url: https://git.rkrishnan.org/components/com_hotproperty/%22doc.html/frontends/about.html?a=commitdiff_plain;h=3addc8bc8357b74728ca3d25dcfc87963a45ef44;p=sicp.git Utilities for henderson's picture language. --- diff --git a/src/pictlang/core.clj b/src/pictlang/core.clj new file mode 100644 index 0000000..79bf6dc --- /dev/null +++ b/src/pictlang/core.clj @@ -0,0 +1,36 @@ +(ns pictlang.core + (:import [javax.swing JPanel JFrame] + [java.awt Color Graphics Graphics2D] + [java.awt.image BufferedImage])) + +(def dim-frame [256 256]) + +(def img (BufferedImage. (dim-frame 0) (dim-frame 1) (BufferedImage/TYPE_INT_RGB))) +(def bg (.getGraphics img)) + +(defn draw-line [v1 v2] + (.setPaint bg Color/RED) + (.drawLine bg + (- (dim-frame 0) (* (first v1) (dim-frame 0))) + (- (dim-frame 1) (* (second v1) (dim-frame 1))) + (- (dim-frame 0) (* (first v2) (dim-frame 0))) + (- (dim-frame 1) (* (second v2) (dim-frame 1))))) + +(defn start-picture [] + (let [frame (JFrame.) + panel (doto (proxy [JPanel] [] + (paint [g] + (.drawImage g img 0 0 this))))] + (doto bg + (.setColor Color/BLACK) + (.fillRect 0 0 (dim-frame 0) (dim-frame 1))) + + (doto frame + (.add panel) + (.setSize (dim-frame 0) (dim-frame 1)) + (.show) + (.setDefaultCloseOperation JFrame/EXIT_ON_CLOSE)))) + +(defn show [picture frame] + (picture frame)) + diff --git a/src/pictlang/pictures.clj b/src/pictlang/pictures.clj new file mode 100644 index 0000000..04e143e --- /dev/null +++ b/src/pictlang/pictures.clj @@ -0,0 +1,44 @@ +(ns pictlang.pictures + (:use [pictlang.utils :only (make-vect make-segment segments->painter)])) + +(defn wave [frame] + (let [p01 (make-vect 0.40 1.00) + p02 (make-vect 0.60 1.00) + p03 (make-vect 0.00 0.80) + p04 (make-vect 0.35 0.80) + p05 (make-vect 0.65 0.80) + p06 (make-vect 0.00 0.60) + p07 (make-vect 0.30 0.60) + p08 (make-vect 0.40 0.60) + p09 (make-vect 0.60 0.60) + p10 (make-vect 0.70 0.60) + p11 (make-vect 0.20 0.55) + p12 (make-vect 0.30 0.55) + p13 (make-vect 0.35 0.50) + p14 (make-vect 0.65 0.50) + p15 (make-vect 0.20 0.45) + p16 (make-vect 1.00 0.40) + p17 (make-vect 0.50 0.20) + p18 (make-vect 1.00 0.20) + p19 (make-vect 0.25 0.00) + p20 (make-vect 0.40 0.00) + p21 (make-vect 0.60 0.00) + p22 (make-vect 0.75 0.00)] + ((segments->painter + (list (make-segment p01 p04) + (make-segment p04 p08) + (make-segment p08 p07) + (make-segment p07 p11) + (make-segment p11 p03) + (make-segment p06 p15) + (make-segment p15 p12) + (make-segment p12 p13) + (make-segment p13 p19) + (make-segment p20 p17) + (make-segment p17 p21) + (make-segment p22 p14) + (make-segment p14 p18) + (make-segment p16 p10) + (make-segment p10 p09) + (make-segment p09 p05) + (make-segment p05 p02))) frame))) \ No newline at end of file diff --git a/src/pictlang/utils.clj b/src/pictlang/utils.clj new file mode 100644 index 0000000..a9a6b90 --- /dev/null +++ b/src/pictlang/utils.clj @@ -0,0 +1,176 @@ +(ns pictlang.utils + (:use [sicp.ex2_23 :only (for-each)] + [pictlang.core :only (draw-line)])) + +(declare flip-vert up-split flip-horiz transform-painter rotate90 rotate270) + +(defn make-vect [x y] + (list x y)) + +(defn xcor-vect [v] + (first v)) + +(defn ycor-vect [v] + (second v)) + +(defn add-vect [v1 v2] + (make-vect (+ (xcor-vect v1) + (xcor-vect v2)) + (+ (ycor-vect v1) + (ycor-vect v2)))) + +(defn sub-vect [v1 v2] + (make-vect (- (xcor-vect v1) + (xcor-vect v2)) + (- (ycor-vect v1) + (ycor-vect v2)))) + +(defn scale-vect [v s] + (make-vect (* s (xcor-vect v)) + (* s (ycor-vect v)))) + +(defn make-frame [origin edge1 edge2] + (list origin edge1 edge2)) + +(defn origin-frame [frame] + (first frame)) + +(defn edge1-frame [frame] + (second frame)) + +(defn edge2-frame [frame] + (first (rest (rest frame)))) + +;; we define a segment as a list of 2 vectors +(defn make-segment [v1 v2] + (list v1 v2)) + +(defn start-segment [segment] + (first segment)) + +(defn end-segment [segment] + (second segment)) + + +(defn beside [painter1 painter2] + (let [split-point (make-vect 0.5 0) + paint-left (transform-painter painter1 + (make-vect 0 0) + split-point + (make-vect 0 1)) + paint-right (transform-painter painter2 + split-point + (make-vect 1 0) + (make-vect 0.5 1))] + (fn [frame] + (paint-left frame) + (paint-right frame)))) + +(defn below [painter1 painter2] + (rotate90 (beside (rotate270 painter1) (rotate270 painter2)))) + +(defn flipped-pairs [painter] + (let [painter2 (beside painter (flip-vert painter))] + (below painter2 painter2))) + +(defn right-split [painter n] + (if (= n 0) + painter + (let [smaller (right-split painter (- n 1))] + (beside painter (below smaller smaller))))) + +(defn corner-split [painter n] + (if (= n 0) + painter + (let [up (up-split painter (- n 1)) + right (right-split painter (- n 1)) + 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))))) + +(defn square-limit [painter n] + (let [quarter (corner-split painter n) + half (beside (flip-horiz quarter) quarter)] + (below (flip-vert half) half))) + +(defn frame-coord-map [frame] + (fn [v] + (add-vect + (origin-frame frame) + (add-vect (scale-vect (edge1-frame frame) (xcor-vect v)) + (scale-vect (edge2-frame frame) (ycor-vect v)))))) + +(defn segments->painter [segment-list] + (fn [frame] + (for-each + (fn [segment] + (draw-line + ((frame-coord-map frame) (start-segment segment)) + ((frame-coord-map frame) (end-segment segment)))) + segment-list))) + + +;; transformation +(defn transform-painter [painter origin corner1 corner2] + (fn [frame] + (let [m (frame-coord-map frame) + new-origin (m origin)] + (painter (make-frame new-origin + (sub-vect (m corner1) new-origin) + (sub-vect (m corner2) new-origin)))))) + +(defn flip-vert [painter] + (transform-painter painter + (make-vect 0 1) + (make-vect 1 1) + (make-vect 0 0))) + +(defn shrink-to-upper-right [painter] + (transform-painter painter + (make-vect 0.5 0.5) + (make-vect 1 0.5) + (make-vect 0.5 1))) + +(defn rotate90 [painter] + (transform-painter painter + (make-vect 1 0) + (make-vect 1 1) + (make-vect 0 0))) + +(defn squash-inwards [painter] + (transform-painter painter + (make-vect 0.0 0.0) + (make-vect 0.65 0.35) + (make-vect 0.35 0.65))) + + +(defn up-split [painter n] + (if (= n 0) + painter + (let [smaller (up-split painter (- n 1))] + (below painter (beside smaller smaller))))) + +(defn split [f1 f2] + (letfn [(split-fn [painter n] + (if (= n 0) + painter + (let [smaller (split-fn painter (- n 1))] + (f1 painter (f2 smaller smaller)))))] + split-fn)) + +(def right-split (split beside below)) +(def up-split (split below beside)) + +(defn flip-horiz [painter] + (transform-painter painter + (make-vect 1 0) + (make-vect 0 0) + (make-vect 1 1))) + +(defn rotate180 [painter] + ((repeatedly 2 rotate90) painter)) + +(defn rotate270 [painter] + ((repeatedly 3 rotate90) painter))