Genpatsu Mita Ondanka by Koide Hiroaki
Uranium Womb to Tomb 子宮から墓までのウラン
Uranium begins in the ground and ultimately is disposed of there. Here are the details of its life cycle:
Out Of The Ground: When in the earth, Natural Uranium is slightly radioactive, containing 0.7% U235, which is fissile, meaning scientists can split its atoms and use its energy for other purposes, and the 99.3% remaining is non-fissile U238. Uranium is mined or physically extracted from underground rocks by pumping toxic acids into the earth. Once the U235 is enriched to between 6% and 19%, it is used to power atomic reactors. Unfortunately, enriching atomic fuel also creates lots of extra depleted U238, which is desired for explosive munitions that start a fire that cannot be put out.
Into The Ground: Once used in a nuclear reactor or munitions, the used [called spent] uranium is highly radioactive and must be stored underground for a quarter of a million years [250,000].
Residual On The Ground: Once the Uranium is unearthed and mined, the mining sites are open scars that release a witch’s brew of material that had been trapped under the earth’s surface before extraction. Many of these old mine sites are highly toxic from the chemicals used and the radioactivity left behind. Most of the world’s toxic mining sites are located on Indigenous lands.
This symposium tells the womb to tomb story of Uranium. The presenters discuss the roles and responsibilities of both Art And Science to analyze and reflect upon human use of the atom to generate electricity and create weapons.
https://www.fairewinds.org/demystify/special-event-uranium-the-waste-it-leaves-behind
原発の流れUML図
plantuml Genpatsu-100kW-Nagare.uml
@startuml
<style>
storage {
BackGroundColor #22ccaa
LineThickness 3
LineColor green
}
queue {
BackGroundColor #ccbb33
LineThickness 2
Linecolor black
}
</style>
storage "自然・材料" as inputs1
component "ウラン鉱山" as mine /'component ok, not stack'/
queue "エネルギー・化石燃料など" as energy1
cloud "残土: 240万トン" as waste1
inputs1 -> mine
energy1 -> mine
mine -> waste1
storage "自然・材料" as inputs2
component "製錬" as smelting
queue "エネルギー・化石燃料など" as energy2
cloud "鉱滓: 13万トン , 低レーベル廃物" as waste2
mine --> smelting : 253万トンを掘り出して
note on link: ウラン鉱石： 13万トン
inputs2 -> smelting
energy2 -> smelting
smelting -> waste2
storage "自然・材料" as inputs3
queue "エネルギー・化石燃料など" as energy3
component "濃縮・加工" as processing
cloud "劣化ウラン、160トン 、低レベル廃物" as waste3
smelting --> processing : "13万トンの鉱滓と\n低レベル放射能性廃物"
note on link: 天然ウラン：190万トン
inputs3 -> processing
energy3 -> processing
processing -> waste3
storage "自然・材料" as inputs4
queue "エネルギー・化石燃料など" as energy4
component "原子炉" as reactor
cloud "低レベル廃物、ドラム缶: 1000本 、 廃炉" as waste4
package "安い電力？" #DDDDDD {
node "70億kWhの電気" as electricity
}
processing ---> reactor : "兵器に利用される劣化ウランと\n160トン低レベル放射能性廃物"
note on link: 濃縮ウラン： 30トン
inputs4 -> reactor
energy4 -> reactor
reactor -> electricity
reactor -> waste4
storage "自然・材料" as inputs5
queue "エネルギー・化石燃料など" as energy5
component "再処理" as reprocessing
cloud "低レベル廃物\n中レベ廃物" as waste5
package "原子炉の実際の目的？" {
node "プルトニム： 300kg" as pluto
}
reactor ---> reprocessing : 廃炉もまだやっていない\nドラム缶は何年持つ？
note on link: 使用済み燃料： 30トン
inputs5 -> reprocessing
energy5 -> reprocessing
reprocessing -> waste5
reprocessing -> pluto
storage "自然・材料" as inputs6
queue "エネルギー・化石燃料など" as energy6
component "廃物処分" as eternity
reactor --> eternity: 数百年、万年に隔離が必要とする廃物
note on link: 使用済み燃料： 30トン
reprocessing --> eternity: "300kgのプロトニウム\nその他の核ゴミ"
note on link: "低レベル廃物\n個化体30本"
@enduml
小出さんの図、 PlantUML Style
@startuml
/' PlantUML Language Reference Guide p135~ '/
skinparam ComponentStyle rectangle
skinparam BackgroundColor white
skinparam FontSize 28
/' https://plantuml.com/skinparam '/
/'
' skinparam monochrome true /' ok!'/
'/
skinparam shadowing false
skinparam component {
compontentStyle rectangle
Font "IPA P明朝" /' "IPA Pゴシック" '/
FontSize 34
FontColor red
BackgroundColor Grey
}
skinparam package {
Font "IPA P明朝"
FontSize 36
FontColor Crimson
BackgroundColor Khaki
}
skinparam node {
Font "IPA P明朝"
FontSize 38
FontColor Red
BackgroundColor Black
}
skinparam storage {
Font "IPA P明朝"
FontSize 30
BackgroundColor OliveDrab
}
skinparam queue {
Font "IPA P明朝"
FontSize 30
BackgroundColor DodgerBlue
}
skinparam note {
Font "IPA P明朝"
FontSize 28
}
skinparam label {
Font "IPA Pゴシック"
FontSize 28
}
skinparam cloud {
Font "IPA P明朝"
FontSize 34
BackgroundColor WhiteSmoke
FontColor Maroon}
storage "自然・材料" as inputs1
component "ウラン鉱山" as mine /'component ok, not stack'/
queue "エネルギー・化石燃料など" as energy1
cloud "残土: 240万トン" as waste1
inputs1 -[thickness=5]> mine #green
energy1 -[thickness=7]> mine #blue
mine -[thickness=8]> waste1 #black
storage "自然・材料" as inputs2
component "___製錬__ " as smelting
queue "エネルギー・化石燃料など" as energy2
cloud "鉱滓: 13万トン , 低レーベル廃物" as waste2
mine -[thickness=5]-> smelting : 253万トンを掘り出して
note on link: ウラン鉱石： 13万トン
inputs2 -[thickness=5]> smelting #green
energy2 -[thickness=7]> smelting #blue
smelting -[thickness=8]> waste2 #black
storage "自然・材料" as inputs3
queue "エネルギー・化石燃料など" as energy3
component "濃縮・加工" as processing
cloud "劣化ウラン、160トン 、低レベル廃物" as waste3
smelting -[thickness=5]-> processing : "13万トンの鉱滓と\n低レベル放射能性廃物"
note on link: 天然ウラン：190万トン
inputs3 -[thickness=5]> processing #green
energy3 -[thickness=7]> processing #blue
processing -[thickness=8]> waste3 #black
storage "自然・材料" as inputs4
queue "エネルギー・化石燃料など" as energy4
component "_原子炉_" as reactor
cloud "低レベル廃物、ドラム缶: 1000本 、 廃炉" as waste4
package "安い電力？" #DDDDDD {
node "70億kWhの電気" as electricity
}
processing -[thickness=5]--> reactor : "兵器に利用される劣化ウランと\n160トン低レベル放射能性廃物"
note on link: 濃縮ウラン： 30トン
inputs4 -[thickness=5]> reactor #green
energy4 -[thickness=7]> reactor #blue
reactor -> electricity #black
reactor -[thickness=8]> waste4 #black
storage "自然・材料" as inputs5
queue "エネルギー・化石燃料など" as energy5
component "_再処理_" as reprocessing
cloud "低レベル廃物\n中レベ廃物" as waste5
package "原子炉の実際の目的？" {
node "プルトニム： 300kg" as pluto
}
reactor -[thickness=5]--> reprocessing : 廃炉もまだやっていない\nドラム缶は何年持つ？
note on link: 使用済み燃料： 30トン
inputs5 -[thickness=5]> reprocessing #green
energy5 -[thickness=7]> reprocessing #blue
reprocessing -[thickness=8]> waste5 #black
reprocessing -[thickness=5]-> pluto
storage "自然・材料" as inputs6
queue "エネルギー・化石燃料など" as energy6
component ">廃物処分>>∞>" as eternity
reactor -[thickness=5]-> eternity: 数百年、万年に隔離が必要とする廃物
note left on link: 使用済み燃料： 30トン
inputs6 -[thickness=5]> eternity #green
energy6 -[thickness=7]> eternity #blue
reprocessing -[thickness=5]-> eternity: "300kgのプロトニウム\nその他の核ゴミ"
note on link: "低レベル廃物\n個化体30本"
@enduml
原発流れの段階
pict utilities
#lang racket
(require pict pict-abbrevs)
(require racket/syntax syntax/parse/define)
(require (for-syntax racket/syntax))
(require "orgmode-transforms.rkt")
(require "kanji-furig-markup.rkt")
(provide (all-defined-out))
;;;; string utilities ;;;;;
(define (blank-string-bs? str) ;; Japanese spaces in [:space:] ?
(or (= 0 (string-length str))
(regexp-match #px"^[[:space:]].*$" str)))
(define (empty-string-bs? str)
(not (non-empty-string? str)))
;;; pict utilities ;;;;;
(define (add-bg pct (clr "white"))
(add-rectangle-background pct #:radius 0 #:color clr))
(define (pict->png-bg pct fnm (clr "white") (inst 10))
(save-pict fnm ; FileName
(add-bg (inset pct inst) clr)))
(define (make-spacer-blank choice-pcts)
(define w (pict-width (argmax pict-width choice-pcts)))
(define h (pict-height (argmax pict-height choice-pcts)))
(blank w h))
;;; preview in emacs' racket-mode when buffer has dark background
(define (pan-spot-view pct (x-m 80) (y-m 50)
(clr "pale green")(brdr-clr "forest-green")(btm-mrgn 20))
(panorama
(add-spotlight-background #:x-margin x-m #:y-margin y-m
#:color clr #:border-color brdr-clr
(inset pct 5 5 5 btm-mrgn))))
;;; utilities developed during nuclear-sequence-process-product-waste.rkt
(define (p-bt str) (text str 'bold))
(define (p-it str) (text str 'italic))
(define (place-in-shape pct (shpe filled-ellipse) (btm-mrgn 5) (inst 5) (clr "Chartreuse") (brdr-clr "Medium Aquamarine") (brdr-wdth 5))
(define inset-pct (inset pct inst inst inst btm-mrgn))
(define-values (p-w p-h) (values (pict-width inset-pct) (pict-height inset-pct)))
(cc-superimpose (shpe p-w p-h #:color clr #:border-color brdr-clr #:border-width brdr-wdth) inset-pct))
;;;;;; utilities -above - move from nuclear-sequence-process-product-waste to pict-procedres.rkt
;;; ruby, Kanji and Furigana from views, common, developed for KDHG
;;; Kawahara-san's Toroku 鉱毒被害メカニズム、borrow from quiz-slide-racket;;;;
(define kanji-size (make-parameter 36)) ;; slideshow (current-font-size)
(define furig-size (make-parameter (ceiling (/ (kanji-size) 2.5))))
(define furig-style (make-parameter "IPA Pゴシック"))
(define-values (inst-1 inst-t inst-r inst-b) (values 5 5 2 2))
(define kanji-style (make-parameter "IPAexゴシック"))
(define kanji-furi-gap (make-parameter 3))
(define (fgn->pct fg (sze furig-size)(stl furig-style))
(inset (text fg (furig-style) (furig-size)) inst-1 inst-t inst-r inst-b))
;; (fgn->pct "ちそく") ; ok!
(define (knj->pct kj (sze kanji-size) (stl kanji-style))
(text kj (kanji-style) (kanji-size)))
(define (ki-fa->pct k f (appnd vl-append) (gp (kanji-furi-gap)))
(appnd gp (fgn->pct f) (knj->pct k)))
(define (kj-fg-prt->pct part (sty (kanji-style)) (siz (kanji-size))) ;; (fga-sze furig-size)... etc
(cond ;; (raise-argument-error 'kj-fg-prt "string or '(\"知\" \"そく\") pair" part)
((pair? part) (ki-fa->pct (first part) (second part)))
(#t (text part sty siz))))
(define (kj-fg-mrkp-str->pct str (sty (kanji-style))(siz (kanji-size)))
(apply hbl-append
(map (lambda (str) (kj-fg-prt->pct str sty siz)) (get-kj-fg-parts str))))
;;; syntax : pict naming
;;; from racket-picture-showing and Imo, SeiButsu-Bunrui slideshows
(define-syntax-parser name-picts-n-list
[(_ names picts list-name)
#'(begin
(match-define names picts)
(define list-name names))])
;; example use from SeiButsu-noBunRui.rkt
#;(name-picts-n-list (list s1 s2 s3 s4 s5 s6 s7 s8 s9 s10 s11 s12)
(map launder (make-list 12 answer-slot))
slot-picts)
;; from other common/procedures.. probbly quiz-slide-racket and views
(define-syntax-parser name-txt->pct
[(_ name txt)
#:with nme (format-id #'name "~a" #'name)
#'(define nme (text txt))]
[(_ name txt pproc)
#:with nme (format-id #'name "~a" #'name)
#'(define nme (pproc txt))])
(define-syntax-parser nme-txt-lst->pct
[(_ lst)
#:with nme (format-id #'lst "~a" (car (cdr (syntax->list #'lst))))
#'(define nme (kj-fg-mrkp-str->pct (syntax-e (caddr (syntax->list #'lst)))) )]
[(_ lst sze) ;; too involved: need math to adjust fgn->pct, knj->pct, ki-fa->pct sizes
#:with nme (format-id #'lst "~a" (car (cdr (syntax->list #'lst))))
#'(define nme (kj-fg-mrkp-str->pct (syntax-e (caddr (syntax->list #'lst))) (kanji-style) sze))]
); end syntax-parser nme-txt-lst->pict
Expanded Version of Hiroaki Koide's Nuclear Reactor Flow chart
The org-chart and code (with labels) to generate the chart (not all) pasted below.
| Process | Product | Waste |
|----------------------------------+------------------------------------------------+-----------------------------------------------------------------------------------|
| Uranium Mine | Uranium Ore: 130000 tons | Residue: 24 Million Tons |
| Smelting | Natural Uranium: 19 tons | Slag: 130000 tons; Low Radiation Waste |
| Concentration; Processing | Enriched Uranium: 30 tons | Depleted Uranium: 160 tons; Low Level Waste |
| Nuclear Reactor | Spent Fuel: 30 tons | Heat: 21 Billion kWh's worth; Reactor Decommissioning Waste |
| Reprocessing | Plutonium: 300kg | Low Level Waste; Vitrified Nuclear Waste; High Level Waste |
| Factory, Office; Home , School | Shallow Consumers | Empty Lives |
| Waste Management | Eternal Troubles | Eternal Contamination of; Ground Water etc; Eternal Pollution |
| State; Military; Death Merchants | Atomic Bombs; Nuclear Missiles; Nucear Weapons | Eternal Radioactive Contamination; Risk of Human Extinction; Triggerless Missiles |
#lang racket
(require pict pict-abbrevs) ;; slideshow/text) with-size
(require "../common/pict-procedures.rkt")
(require "../common/orgmode-transforms.rkt")
;;; in-files
(define always-needed-fn "inputs-always-needed-table-en.org")
;; (define water-amounts-fn "water-amounts-table-en.org")
(define process-product-waste-fn "process-product-waste-table-en.org")
(define sea-warming-fn "sea-warming-strs-en.txt")
(define label-reactor-to-sea ;;"発電の熱の2倍 ")
"Twice the Heat used for Electricity")
;; consumers -- prcs-6
(define label-reactor-to-consumers ;; "電気：70億kWh")
"Electricity: 7 Billion kWh")
;;; Inputs: always needed
(define always-needed-tbl
(org-table-file->rows-list always-needed-fn))
;; always-needed-tbl ; ok!
(define always-needed-hdrs (first always-needed-tbl))
(define always-needed-lst (third always-needed-tbl))
;; (list always-needed-hdrs always-needed-lst) ; ok!
(match-define (list people things power)
(map kj-fg-mrkp-str->pct always-needed-hdrs))
#;(pan-spot-view (hbl-append people things power)) ; ok!
(match-define (list labor nature energy)
(map kj-fg-mrkp-str->pct always-needed-lst))
;; (pan-spot-view (hbl-append 20 labor nature energy)) ; ok!
(define sea-warming-strs (file->lines sea-warming-fn))
(define sea-txt-pct (apply vc-append (map kj-fg-mrkp-str->pct sea-warming-strs)))
(define sea-pct-s (place-in-shape sea-txt-pct filled-ellipse 30 10 "light sea green" "aquamarine" 10))
(define-values (s-p-s-w s-p-s-h)
(values (pict-width sea-pct-s) (pict-height sea-pct-s)))
(define sea-pct (scale-to-fit sea-pct-s (* 2 s-p-s-w)(* 2 s-p-s-h)))
;; get 段階 steps ready ...
(define p-p-w-tbl (org-table-file->rows-list process-product-waste-fn))
(define p-p-w-hdrs (first p-p-w-tbl))
(define step-1-lst (third p-p-w-tbl)) ;; (list p-p-w-hdrs step-1-lst) ; ok!
(define step-2-lst (fourth p-p-w-tbl))
(define step-3-lst (fifth p-p-w-tbl))
(name-picts-n-list (list process product waste)
(map kj-fg-mrkp-comma-stack->pct p-p-w-hdrs) p-p-w-parts)
(name-picts-n-list (list s1-prcs s1-prdct s1-waste)
(map kj-fg-mrkp-comma-stack->pct step-1-lst) s1-parts)
(name-picts-n-list (list s2-prcs s2-prdct s2-waste)
(map kj-fg-mrkp-comma-stack->pct step-2-lst) s2-parts)
(name-picts-n-list (list s3-prcs s3-prdct s3-waste)
(map kj-fg-mrkp-comma-stack->pct step-3-lst) s3-parts)
(match-define (list step-4-lst step-5-lst step-6-lst step-7-lst)
(take (drop p-p-w-tbl 5) 4)) ;; step-7-lst ; ok!
(name-picts-n-list (list s4-prcs s4-prdct s4-waste)
(map kj-fg-mrkp-comma-stack->pct step-4-lst) s4-parts)
(name-picts-n-list (list s5-prcs s5-prdct s5-waste)
(map kj-fg-mrkp-comma-stack->pct step-5-lst) s5-parts)
(name-picts-n-list (list s6-prcs s6-prdct s6-waste)
(map kj-fg-mrkp-comma-stack->pct step-6-lst) s6-parts)
(name-picts-n-list (list s7-prcs s7-prdct s7-waste)
(map kj-fg-mrkp-comma-stack->pct step-7-lst) s7-parts)
;; add step-8, step-aim-cause
(define step-aim-cause-lst (last p-p-w-tbl))
(name-picts-n-list (list step-aim-prcs step-aim-prdct step-aim-waste)
(map kj-fg-mrkp-comma-stack->pct step-aim-cause-lst) step-aim-lst)
;; (map pan-spot-view step-aim-lst) ; ok!
;;;; utility for checking markup- and other potential -bugs
(define (check-p-p-w lst) ;; for nuclear-sequence-process-product-waste.rkt
(add-rectangle-background #:radius 0
(table 3 ; ok! ; careful with col-number, col-seps
(flatten (list p-p-w-parts lst))
lbl-superimpose cbl-superimpose 20 10)))
#;(define steps-table-check
(check-p-p-w (list s1-parts s2-parts s3-parts s4-parts s5-parts s6-parts s7-parts))) ; ok!
(define parts-picts-list (list s1-parts s2-parts s3-parts s4-parts s5-parts s6-parts s7-parts))
;; (map pan-spot-view (map first parts-picts-list)) ; ok!
(define (check-pcts-lst lst) (map pan-spot-view lst))
(define processes-txt-pcts (map first parts-picts-list))
(define products-txt-pcts (map second parts-picts-list))
;; (check-pcts-lst products-txt-pcts)
(define waste-txt-pcts (map third parts-picts-list))
(name-picts-n-list (list processes-blank products-blank waste-blank)
(map make-spacer-blank (list processes-txt-pcts products-txt-pcts waste-txt-pcts)) column-blanks) ;; (map pan-spot-view column-blanks) ;; ok!
(define (make-spaced-blank pct spcr-blnk)
(cc-superimpose spcr-blnk
(inset pct 5 5 5 20)))
(define (make-process-pct txt-pct (spcr-blnk processes-blank))
(define spaced (make-spaced-blank txt-pct spcr-blnk))
(place-in-shape spaced filled-rectangle 10 5 "light gray" "dark gray"))
(name-picts-n-list (list prcs-1 prcs-2 prcs-3 prcs-4 prcs-5 prcs-6 prcs-7)
(map make-process-pct processes-txt-pcts) prcs-pcts)
;; (apply vc-append prcs-pcts) ; ok!!
(define (make-product-pct txt-pct (spcr-blnk products-blank))
(define spaced (make-spaced-blank
(colorize txt-pct "black") spcr-blnk))
(place-in-shape spaced filled-rectangle 10 5 "light sky blue" "gainsboro"))
(name-picts-n-list (list prdt-1 prdt-2 prdt-3 prdt-4 prdt-5 prdt-6 prdt-7)
(map make-product-pct products-txt-pcts) prdt-pcts)
;; (apply vc-append prdt-pcts) ; ok!
(define (make-waste-pct txt-pct (spcr-blnk waste-blank))
(define spaced (make-spaced-blank txt-pct spcr-blnk))
(define-values (p-w p-h) (values (pict-width spaced) (pict-height spaced)))
(cc-superimpose (cloud p-w p-h #:style '(square wide))
spaced))
(name-picts-n-list (list wste-1 wste-2 wste-3 wste-4 wste-5 wste-6 wste-7)
(map make-waste-pct waste-txt-pcts) wste-pcts)
;; (apply vc-append wste-pcts) ; ok!
;; (check-pcts-lst waste-txt-pcts) ; ok!
;; (place-in-shape s1-prcs filled-rectangle) ; ok!
(define always-input-p
(vc-append 5 nature energy labor))
(define always-input-pct
(place-in-shape always-input-p))
; always-input-pct ;; ok!
(match-define (list s1-always-in s2-always-in s3-always-in s4-always-in s5-always-in s6-always-in s7-always-in step-aim-always-in)
(map launder (make-list 8 always-input-pct)))
(define in-step-gap 50) ;; Spacing gaps
(define (make-step-base inpt prcs prdt wste)
(define process-product (vc-append in-step-gap prcs prdt))
(define with-input (ht-append in-step-gap inpt process-product))
(hc-append in-step-gap with-input wste))
(define bse-1
(make-step-base s1-always-in prcs-1 prdt-1 wste-1))
;;; arrow settings
(define arrw-sze 40)
(define arrw-wdt (/ arrw-sze 2))
;;;; arrow settings above
(define (place-base-arrows inpt prcs prdt wste)
(let* ([p (make-step-base inpt prcs prdt wste)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "green"
p inpt rc-find prcs lc-find)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "gray"
p prcs rc-find wste lc-find)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "crimson"
p prcs cb-find prdt ct-find)]
)
p))
(define stage-1 (place-base-arrows s1-always-in prcs-1 prdt-1 wste-1))
(define stage-2 (place-base-arrows s2-always-in prcs-2 prdt-2 wste-2))
(define stage-3 (place-base-arrows s3-always-in prcs-3 prdt-3 wste-3))
(define stage-4 (place-base-arrows s4-always-in prcs-4 prdt-4 wste-4))
(define stage-5 (place-base-arrows s5-always-in prcs-5 prdt-5 wste-5))
(define stage-6 (place-base-arrows s6-always-in prcs-6 prdt-6 wste-6))
(define stage-7 (place-base-arrows s7-always-in prcs-7 prdt-7 wste-7))
(define-values (prcs-aim prdct-aim wste-aim)
(values (make-process-pct step-aim-prcs) (make-product-pct step-aim-prdct)
(make-waste-pct step-aim-waste)))
(define (prdct-in-cloud pct)
(define c-sze 1.4)
(define-values (w h) (values (pict-width pct) (pict-height pct)))
(define c-bg (cloud (* c-sze w) (* c-sze h) "crimson" #:style '(square wide))) ;; #:style '(square wide)))
(cc-superimpose c-bg pct))
(define stage-aim (place-base-arrows step-aim-always-in
prcs-aim (prdct-in-cloud prdct-aim)
wste-aim))
;; (pan-spot-view stage-aim) ; ok!
(define stages-lst (list stage-1 stage-2 stage-3 stage-4 stage-5 stage-6 stage-7))
(define stages-v-gap 80) ;; Spacing Gaps
(define stages-5tl (apply vc-append stages-v-gap (take stages-lst 5)))
(define stages-extra (vl-append (* 1.8 stages-v-gap)
sea-pct
(apply vc-append stages-v-gap (drop stages-lst 5))))
#;(apply vc-append stages-v-gap
(flatten (list sea-pct
(drop stages-lst 5))))
(define stages-forked-flow (vl-append stages-v-gap (hb-append stages-5tl stages-extra) stage-aim))
;; (pict->png-bg stages-forked-flow "stages-forked-flow.png")
;; sea-warming
(define (link-origl-stages bse prdct prcss (sze arrw-sze)(wdt arrw-wdt)(clr "red"))
(pin-arrow-line sze #:line-width wdt #:color clr
bse prdct lb-find prcss ct-find))
(define heat-to-elctrc-clr "black")
(define heat-to-sea-clr "firebrick") ;; "orange") ;; "brown")
(define label-style (kanji-style)) ;; "IPA P明朝")
(define label-size (round (* 1.7 (kanji-size))))
(define stages-linked
(let* ([p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "red"
stages-forked-flow prdt-1 lb-find prcs-2 ct-find)]
[p (link-origl-stages p prdt-2 prcs-3)]
[p (link-origl-stages p prdt-3 prcs-4)]
[p (link-origl-stages p prdt-4 prcs-5)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color heat-to-elctrc-clr #:start-angle (/ pi 8) #:end-angle (/ pi -8)
#:label (colorize (kj-fg-mrkp-str->pct label-reactor-to-consumers
label-style label-size) heat-to-elctrc-clr)
#:x-adjust-label 950 #:y-adjust-label -45
p wste-4 lt-find prcs-6 ct-find)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "red"
p wste-4 cb-find prcs-7 lt-find)]
;; Heat to Sea line and label
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color heat-to-sea-clr
#:label (colorize (kj-fg-mrkp-str->pct label-reactor-to-sea
label-style label-size) heat-to-sea-clr)
;;#:x-adjust-label -460 #:y-adjust-label 60
#:x-adjust-label 1050 #:y-adjust-label -20
p prcs-4 rt-find sea-pct cb-find)]
;; link last stage aim/cause or entire flow
[p (link-origl-stages p prdt-5 prcs-aim)]
[p (pin-arrow-line (* 1.5 arrw-sze) #:under? #t #:solid? #f
#:line-width (* 1.5 arrw-wdt) #:color "dark gray"
p prcs-aim rt-find wste-6 cb-find)]
[p (pin-arrow-line (* 1.5 arrw-sze) #:under? #t #:solid? #f
#:line-width (* 1.5 arrw-wdt) #:color "dark gray"
p prcs-aim rt-find wste-7 cb-find)]
[p (pin-arrows-line (* 1.5 arrw-sze) #:under? #t #:solid? #f
#:line-width (* 1.5 arrw-wdt) #:color "hot pink"
p prdct-aim rc-find wste-6 lc-find)]
[p (pin-arrow-line (* 3.5 arrw-sze) #:line-width (* 1.5 arrw-wdt)
#:color "green" #:under? #t
p step-aim-always-in cb-find prdct-aim lt-find)]
)
p))
(pict->png-bg stages-linked "stages-linked-labels-w-aim-en.png")
;; (pict->png-bg aim-stage-added "nuclear-cycle-aim-cause.png")
#RacketLang #RacketPict #DataVisualization #TableViews
100万kWの原発を巡る一連の流れ(プラス)
天然ウランは190トン です、 190万の「万」が間違い
#lang racket
(require pict pict-abbrevs)
(require "../common/pict-procedures.rkt")
(require "../common/orgmode-transforms.rkt")
(define always-needed-fn "inputs-always-needed-table-furi.org")
(define water-amounts-fn "water-amounts-table-furi.org")
(define process-product-waste-fn "process-product-waste-table-furi.org")
;;; Inputs: always needed
(define always-needed-tbl
(org-table-file->rows-list always-needed-fn))
;; always-needed-tbl ; ok!
(define always-needed-hdrs (first always-needed-tbl))
(define always-needed-lst (third always-needed-tbl))
;; (list always-needed-hdrs always-needed-lst) ; ok!
(match-define (list people things power)
(map kj-fg-mrkp-str->pct always-needed-hdrs))
#;(pan-spot-view (hbl-append people things power)) ; ok!
(match-define (list labor nature energy)
(map kj-fg-mrkp-str->pct always-needed-lst))
;; (pan-spot-view (hbl-append 20 labor nature energy)) ; ok!
(define sea-warming-strs (list "140kWh電気分" "$海^うみ$が$受^う$ける" "$七^なな$度^ど$温^あたた$めた" "$温^おん$排^はい$水^すい$"))
(define sea-txt-pct (apply vc-append (map kj-fg-mrkp-str->pct sea-warming-strs)))
(define sea-pct-s (place-in-shape sea-txt-pct filled-ellipse 30 10 "sea green" "aquamarine" 10))
(define-values (s-p-s-w s-p-s-h)
(values (pict-width sea-pct-s) (pict-height sea-pct-s)))
(define sea-pct (scale-to-fit sea-pct-s (* 2 s-p-s-w)(* 2 s-p-s-h)))
;; get 段階 steps ready ...
(define p-p-w-tbl (org-table-file->rows-list process-product-waste-fn))
(define p-p-w-hdrs (first p-p-w-tbl))
(define step-1-lst (third p-p-w-tbl)) ;; (list p-p-w-hdrs step-1-lst) ; ok!
(define step-2-lst (fourth p-p-w-tbl))
(define step-3-lst (fifth p-p-w-tbl))
(name-picts-n-list (list process product waste)
(map kj-fg-mrkp-comma-stack->pct p-p-w-hdrs) p-p-w-parts)
(name-picts-n-list (list s1-prcs s1-prdct s1-waste)
(map kj-fg-mrkp-comma-stack->pct step-1-lst) s1-parts)
(name-picts-n-list (list s2-prcs s2-prdct s2-waste)
(map kj-fg-mrkp-comma-stack->pct step-2-lst) s2-parts)
(name-picts-n-list (list s3-prcs s3-prdct s3-waste)
(map kj-fg-mrkp-comma-stack->pct step-3-lst) s3-parts)
(match-define (list step-4-lst step-5-lst step-6-lst step-7-lst)
(take (drop p-p-w-tbl 5) 4)) ;; step-7-lst ; ok!
(name-picts-n-list (list s4-prcs s4-prdct s4-waste)
(map kj-fg-mrkp-comma-stack->pct step-4-lst) s4-parts)
(name-picts-n-list (list s5-prcs s5-prdct s5-waste)
(map kj-fg-mrkp-comma-stack->pct step-5-lst) s5-parts)
(name-picts-n-list (list s6-prcs s6-prdct s6-waste)
(map kj-fg-mrkp-comma-stack->pct step-6-lst) s6-parts)
(name-picts-n-list (list s7-prcs s7-prdct s7-waste)
(map kj-fg-mrkp-comma-stack->pct step-7-lst) s7-parts)
;; add step-8, step-aim-cause
(define step-aim-cause-lst (last p-p-w-tbl))
(name-picts-n-list (list step-aim-prcs step-aim-prdct step-aim-waste)
(map kj-fg-mrkp-comma-stack->pct step-aim-cause-lst) step-aim-lst)
;; (map pan-spot-view step-aim-lst) ; ok!
;;;; utility for checking markup- and other potential -bugs
(define (check-p-p-w lst) ;; for nuclear-sequence-process-product-waste.rkt
(add-rectangle-background #:radius 0
(table 3 ; ok! ; careful with col-number, col-seps
(flatten (list p-p-w-parts lst))
lbl-superimpose cbl-superimpose 20 10)))
#;(define steps-table-check
(check-p-p-w (list s1-parts s2-parts s3-parts s4-parts s5-parts s6-parts s7-parts))) ; ok!
(define parts-picts-list (list s1-parts s2-parts s3-parts s4-parts s5-parts s6-parts s7-parts))
;; (map pan-spot-view (map first parts-picts-list)) ; ok!
(define (check-pcts-lst lst) (map pan-spot-view lst))
(define processes-txt-pcts (map first parts-picts-list))
(define products-txt-pcts (map second parts-picts-list))
;; (check-pcts-lst products-txt-pcts)
(define waste-txt-pcts (map third parts-picts-list))
(name-picts-n-list (list processes-blank products-blank waste-blank)
(map make-spacer-blank (list processes-txt-pcts products-txt-pcts waste-txt-pcts)) column-blanks) ;; (map pan-spot-view column-blanks) ;; ok!
(define (make-spaced-blank pct spcr-blnk)
(cc-superimpose spcr-blnk
(inset pct 5 5 5 20)))
(define (make-process-pct txt-pct (spcr-blnk processes-blank))
(define spaced (make-spaced-blank txt-pct spcr-blnk))
(place-in-shape spaced filled-rectangle 10 5 "light gray" "dark gray"))
(name-picts-n-list (list prcs-1 prcs-2 prcs-3 prcs-4 prcs-5 prcs-6 prcs-7)
(map make-process-pct processes-txt-pcts) prcs-pcts)
;; (apply vc-append prcs-pcts) ; ok!!
(define (make-product-pct txt-pct (spcr-blnk products-blank))
(define spaced (make-spaced-blank
(colorize txt-pct "black") spcr-blnk))
(place-in-shape spaced filled-rectangle 10 5 "light sky blue" "gainsboro"))
(name-picts-n-list (list prdt-1 prdt-2 prdt-3 prdt-4 prdt-5 prdt-6 prdt-7)
(map make-product-pct products-txt-pcts) prdt-pcts)
;; (apply vc-append prdt-pcts) ; ok!
(define (make-waste-pct txt-pct (spcr-blnk waste-blank))
(define spaced (make-spaced-blank txt-pct spcr-blnk))
(define-values (p-w p-h) (values (pict-width spaced) (pict-height spaced)))
(cc-superimpose (cloud p-w p-h #:style '(square wide))
spaced))
(name-picts-n-list (list wste-1 wste-2 wste-3 wste-4 wste-5 wste-6 wste-7)
(map make-waste-pct waste-txt-pcts) wste-pcts)
;; (apply vc-append wste-pcts) ; ok!
;; (check-pcts-lst waste-txt-pcts) ; ok!
;; (place-in-shape s1-prcs filled-rectangle) ; ok!
(define always-input-p
(vc-append 5 nature energy labor))
(define always-input-pct
(place-in-shape always-input-p))
; always-input-pct ;; ok!
(match-define (list s1-always-in s2-always-in s3-always-in s4-always-in s5-always-in s6-always-in s7-always-in step-aim-always-in)
(map launder (make-list 8 always-input-pct)))
(define in-step-gap 50) ;; Spacing gaps
(define (make-step-base inpt prcs prdt wste)
(define process-product (vc-append in-step-gap prcs prdt))
(define with-input (ht-append in-step-gap inpt process-product))
(hc-append in-step-gap with-input wste))
(define bse-1
(make-step-base s1-always-in prcs-1 prdt-1 wste-1))
;;; arrow settings
(define arrw-sze 40)
(define arrw-wdt (/ arrw-sze 2))
;;;; arrow settings above
(define (place-base-arrows inpt prcs prdt wste)
(let* ([p (make-step-base inpt prcs prdt wste)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "green"
p inpt rc-find prcs lc-find)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "gray"
p prcs rc-find wste lc-find)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "crimson"
p prcs cb-find prdt ct-find)]
)
p))
(define stage-1 (place-base-arrows s1-always-in prcs-1 prdt-1 wste-1))
(define stage-2 (place-base-arrows s2-always-in prcs-2 prdt-2 wste-2))
(define stage-3 (place-base-arrows s3-always-in prcs-3 prdt-3 wste-3))
(define stage-4 (place-base-arrows s4-always-in prcs-4 prdt-4 wste-4))
(define stage-5 (place-base-arrows s5-always-in prcs-5 prdt-5 wste-5))
(define stage-6 (place-base-arrows s6-always-in prcs-6 prdt-6 wste-6))
(define stage-7 (place-base-arrows s7-always-in prcs-7 prdt-7 wste-7))
(define-values (prcs-aim prdct-aim wste-aim)
(values (make-process-pct step-aim-prcs) (make-product-pct step-aim-prdct)
(make-waste-pct step-aim-waste)))
(define (prdct-in-cloud pct)
(define c-sze 1.4)
(define-values (w h) (values (pict-width pct) (pict-height pct)))
(define c-bg (cloud (* c-sze w) (* c-sze h) "crimson" #:style '(square wide))) ;; #:style '(square wide)))
(cc-superimpose c-bg pct))
(define stage-aim (place-base-arrows step-aim-always-in
prcs-aim (prdct-in-cloud prdct-aim)
wste-aim))
;; (pan-spot-view stage-aim) ; ok!
(define stages-lst (list stage-1 stage-2 stage-3 stage-4 stage-5 stage-6 stage-7))
(define stages-v-gap 80) ;; Spacing Gaps
(define stages-5tl (apply vc-append stages-v-gap (take stages-lst 5)))
(define stages-extra (vl-append (* 1.8 stages-v-gap)
sea-pct
(apply vc-append stages-v-gap (drop stages-lst 5))))
#;(apply vc-append stages-v-gap
(flatten (list sea-pct
(drop stages-lst 5))))
(define stages-forked-flow (vl-append stages-v-gap (hb-append stages-5tl stages-extra) stage-aim))
;; (pict->png-bg stages-forked-flow "stages-forked-flow.png")
;; sea-warming
(define (link-origl-stages bse prdct prcss (sze arrw-sze)(wdt arrw-wdt)(clr "red"))
(pin-arrow-line sze #:line-width wdt #:color clr
bse prdct lb-find prcss ct-find))
(define heat-to-elctrc-clr "black")
(define heat-to-sea-clr "firebrick") ;; "orange") ;; "brown")
(define label-style (kanji-style)) ;; "IPA P明朝")
(define label-size (round (* 1.3 (kanji-size))))
(define stages-linked
(let* ([p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "red"
stages-forked-flow prdt-1 lb-find prcs-2 ct-find)]
[p (link-origl-stages p prdt-2 prcs-3)]
[p (link-origl-stages p prdt-3 prcs-4)]
[p (link-origl-stages p prdt-4 prcs-5)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color heat-to-elctrc-clr #:start-angle (/ pi 8) #:end-angle (/ pi -8) #:label (colorize (kj-fg-mrkp-str->pct "電気：70億kWh" label-style label-size) heat-to-elctrc-clr)
#:x-adjust-label 70 #:y-adjust-label -15
p wste-4 lt-find prcs-6 ct-find)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "red"
p wste-4 cb-find prcs-7 lt-find)]
;; Heat to Sea line and label
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color heat-to-sea-clr
;; #:start-angle (/ pi -4) #:end-angle (/ pi 2)
;; #:start-angle (/ pi 5)
#:label (colorize (kj-fg-mrkp-str->pct "発電の熱の2倍" label-style label-size) heat-to-sea-clr)
;; x -220
#:x-adjust-label -460 #:y-adjust-label 60
p prcs-4 rt-find sea-pct cb-find)] ;; lc-find with angles and -220
;;; Last Stage/ the aim/cause of nuclear reactors <-> Nuclear Weapons
;; pin-arrow-line #:under? #t
[p (link-origl-stages p prdt-5 prcs-aim)]
[p (pin-arrow-line (* 1.5 arrw-sze) #:under? #t #:solid? #f
#:line-width (* 1.5 arrw-wdt) #:color "dark gray"
p prcs-aim rt-find wste-6 cb-find)]
[p (pin-arrow-line (* 1.5 arrw-sze) #:under? #t #:solid? #f
#:line-width (* 1.5 arrw-wdt) #:color "dark gray"
p prcs-aim rt-find wste-7 cb-find)]
[p (pin-arrows-line (* 1.5 arrw-sze) #:under? #t #:solid? #f
#:line-width (* 1.5 arrw-wdt) #:color "hot pink"
p prdct-aim rc-find wste-6 lc-find)]
[p (pin-arrow-line (* 3.5 arrw-sze) #:line-width (* 1.5 arrw-wdt)
#:color "green" #:under? #t
p step-aim-always-in cb-find prdct-aim lt-find)]
)
p))
(pict->png-bg stages-linked "stages-linked-labels-w-aim.png")
;; (pict->png-bg aim-stage-added "nuclear-cycle-aim-cause.png")
温排水を考えるためのラベル付け
#lang racket
(require pict pict-abbrevs)
(require "../common/pict-procedures.rkt")
(require "../common/orgmode-transforms.rkt")
(define always-needed-fn "inputs-always-needed-table-furi.org")
(define water-amounts-fn "water-amounts-table-furi.org")
(define process-product-waste-fn "process-product-waste-table-furi.org")
;;; Inputs: always needed
(define always-needed-tbl
(org-table-file->rows-list always-needed-fn))
;; always-needed-tbl ; ok!
(define always-needed-hdrs (first always-needed-tbl))
(define always-needed-lst (third always-needed-tbl))
;; (list always-needed-hdrs always-needed-lst) ; ok!
(match-define (list people things power)
(map kj-fg-mrkp-str->pct always-needed-hdrs))
#;(pan-spot-view (hbl-append people things power)) ; ok!
(match-define (list labor nature energy)
(map kj-fg-mrkp-str->pct always-needed-lst))
;; (pan-spot-view (hbl-append 20 labor nature energy)) ; ok!
(define sea-warming-strs (list "140kWh電気分" "$海^うみ$が$受^う$ける" "$七^なな$度^ど$温^あたた$めた" "$温^おん$排^はい$水^すい$"))
(define sea-txt-pct (apply vc-append (map kj-fg-mrkp-str->pct sea-warming-strs)))
(define sea-pct-s (place-in-shape sea-txt-pct filled-ellipse 30 10 "sea green" "aquamarine" 10))
(define-values (s-p-s-w s-p-s-h)
(values (pict-width sea-pct-s) (pict-height sea-pct-s)))
(define sea-pct (scale-to-fit sea-pct-s (* 2 s-p-s-w)(* 2 s-p-s-h)))
;; get 段階 steps ready ...
(define p-p-w-tbl (org-table-file->rows-list process-product-waste-fn))
(define p-p-w-hdrs (first p-p-w-tbl))
(define step-1-lst (third p-p-w-tbl)) ;; (list p-p-w-hdrs step-1-lst) ; ok!
(define step-2-lst (fourth p-p-w-tbl))
(define step-3-lst (fifth p-p-w-tbl))
(name-picts-n-list (list process product waste)
(map kj-fg-mrkp-comma-stack->pct p-p-w-hdrs) p-p-w-parts)
(name-picts-n-list (list s1-prcs s1-prdct s1-waste)
(map kj-fg-mrkp-comma-stack->pct step-1-lst) s1-parts)
(name-picts-n-list (list s2-prcs s2-prdct s2-waste)
(map kj-fg-mrkp-comma-stack->pct step-2-lst) s2-parts)
(name-picts-n-list (list s3-prcs s3-prdct s3-waste)
(map kj-fg-mrkp-comma-stack->pct step-3-lst) s3-parts)
(match-define (list step-4-lst step-5-lst step-6-lst step-7-lst)
(drop p-p-w-tbl 5)) ;; step-7-lst ; ok!
(name-picts-n-list (list s4-prcs s4-prdct s4-waste)
(map kj-fg-mrkp-comma-stack->pct step-4-lst) s4-parts)
(name-picts-n-list (list s5-prcs s5-prdct s5-waste)
(map kj-fg-mrkp-comma-stack->pct step-5-lst) s5-parts)
(name-picts-n-list (list s6-prcs s6-prdct s6-waste)
(map kj-fg-mrkp-comma-stack->pct step-6-lst) s6-parts)
(name-picts-n-list (list s7-prcs s7-prdct s7-waste)
(map kj-fg-mrkp-comma-stack->pct step-7-lst) s7-parts)
;;;; utility for checking markup- and other potential -bugs
(define (check-p-p-w lst) ;; for nuclear-sequence-process-product-waste.rkt
(add-rectangle-background #:radius 0
(table 3 ; ok! ; careful with col-number, col-seps
(flatten (list p-p-w-parts lst))
lbl-superimpose cbl-superimpose 20 10)))
(define steps-table-check
(check-p-p-w (list s1-parts s2-parts s3-parts s4-parts s5-parts s6-parts s7-parts))) ; ok!
(define parts-picts-list (list s1-parts s2-parts s3-parts s4-parts s5-parts s6-parts s7-parts))
;; (map pan-spot-view (map first parts-picts-list)) ; ok!
(define (check-pcts-lst lst) (map pan-spot-view lst))
(define processes-txt-pcts (map first parts-picts-list))
(define products-txt-pcts (map second parts-picts-list))
;; (check-pcts-lst products-txt-pcts)
(define waste-txt-pcts (map third parts-picts-list))
(name-picts-n-list (list processes-blank products-blank waste-blank)
(map make-spacer-blank (list processes-txt-pcts products-txt-pcts waste-txt-pcts)) column-blanks) ;; (map pan-spot-view column-blanks) ;; ok!
(define (make-spaced-blank pct spcr-blnk)
(cc-superimpose spcr-blnk
(inset pct 5 5 5 20)))
(define (make-process-pct txt-pct (spcr-blnk processes-blank))
(define spaced (make-spaced-blank txt-pct spcr-blnk))
(place-in-shape spaced filled-rectangle 10 5 "light gray" "black"))
(name-picts-n-list (list prcs-1 prcs-2 prcs-3 prcs-4 prcs-5 prcs-6 prcs-7)
(map make-process-pct processes-txt-pcts) prcs-pcts)
;; (apply vc-append prcs-pcts) ; ok!!
(define (make-product-pct txt-pct (spcr-blnk products-blank))
(define spaced (make-spaced-blank
(colorize txt-pct "red") spcr-blnk))
(place-in-shape spaced filled-rectangle 10 5 "black" "light gray"))
(name-picts-n-list (list prdt-1 prdt-2 prdt-3 prdt-4 prdt-5 prdt-6 prdt-7)
(map make-product-pct products-txt-pcts) prdt-pcts)
;; (apply vc-append prdt-pcts) ; ok!
(define (make-waste-pct txt-pct (spcr-blnk waste-blank))
(define spaced (make-spaced-blank txt-pct spcr-blnk))
(define-values (p-w p-h) (values (pict-width spaced) (pict-height spaced)))
(cc-superimpose (cloud p-w p-h #:style '(square wide))
spaced))
(name-picts-n-list (list wste-1 wste-2 wste-3 wste-4 wste-5 wste-6 wste-7)
(map make-waste-pct waste-txt-pcts) wste-pcts)
;; (apply vc-append wste-pcts) ; ok!
;; (check-pcts-lst waste-txt-pcts) ; ok!
;; (place-in-shape s1-prcs filled-rectangle) ; ok!
(define always-input-p
(vc-append 5 nature energy labor))
(define always-input-pct
(place-in-shape always-input-p))
; always-input-pct ;; ok!
(match-define (list s1-always-in s2-always-in s3-always-in s4-always-in s5-always-in s6-always-in s7-always-in)
(map launder (make-list 7 always-input-pct)))
(define in-step-gap 50) ;; Spacing gaps
(define (make-step-base inpt prcs prdt wste)
(define process-product (vc-append in-step-gap prcs prdt))
(define with-input (ht-append in-step-gap inpt process-product))
(hc-append in-step-gap with-input wste))
(define bse-1
(make-step-base s1-always-in prcs-1 prdt-1 wste-1))
;;; arrow settings
(define arrw-sze 40)
(define arrw-wdt (/ arrw-sze 2))
;;;; arrow settings above
(define (place-base-arrows inpt prcs prdt wste)
(let* ([p (make-step-base inpt prcs prdt wste)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "green"
p inpt rc-find prcs lc-find)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "gray"
p prcs rc-find wste lc-find)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "crimson"
p prcs cb-find prdt ct-find)]
)
p))
(define stage-1 (place-base-arrows s1-always-in prcs-1 prdt-1 wste-1))
(define stage-2 (place-base-arrows s2-always-in prcs-2 prdt-2 wste-2))
(define stage-3 (place-base-arrows s3-always-in prcs-3 prdt-3 wste-3))
(define stage-4 (place-base-arrows s4-always-in prcs-4 prdt-4 wste-4))
(define stage-5 (place-base-arrows s5-always-in prcs-5 prdt-5 wste-5))
(define stage-6 (place-base-arrows s6-always-in prcs-6 prdt-6 wste-6))
(define stage-7 (place-base-arrows s7-always-in prcs-7 prdt-7 wste-7))
(define stages-lst (list stage-1 stage-2 stage-3 stage-4 stage-5 stage-6 stage-7))
(define stages-v-gap 80) ;; Spacing Gaps
(define stages-5tl (apply vc-append stages-v-gap (take stages-lst 5)))
(define stages-extra (vl-append stages-v-gap
sea-pct
(apply vc-append stages-v-gap (drop stages-lst 5))))
#;(apply vc-append stages-v-gap
(flatten (list sea-pct
(drop stages-lst 5))))
(define stages-forked-flow (hb-append stages-5tl stages-extra))
;; (pict->png-bg stages-forked-flow "stages-forked-flow.png")
;; sea-warming
(define (link-origl-stages bse prdct prcss (sze arrw-sze)(wdt arrw-wdt)(clr "red"))
(pin-arrow-line sze #:line-width wdt #:color clr
bse prdct lb-find prcss ct-find))
(define heat-to-elctrc-clr "black")
(define heat-to-sea-clr "firebrick") ;; "orange") ;; "brown")
(define label-style (kanji-style)) ;; "IPA P明朝")
(define label-size (round (* 1.3 (kanji-size))))
(define stages-linked
(let* ([p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "red"
stages-forked-flow prdt-1 lb-find prcs-2 ct-find)]
[p (link-origl-stages p prdt-2 prcs-3)]
[p (link-origl-stages p prdt-3 prcs-4)]
[p (link-origl-stages p prdt-4 prcs-5)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color heat-to-elctrc-clr #:start-angle (/ pi 10) #:end-angle (/ pi -10) #:label (colorize (kj-fg-mrkp-str->pct "70$億kWhの電気" label-style label-size) heat-to-elctrc-clr)
#:x-adjust-label 30
p wste-4 lt-find prcs-6 ct-find)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "red"
p wste-4 cb-find prcs-7 lt-find)]
;; Heat to Sea line and label
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color heat-to-sea-clr #:start-angle (/ pi -4) #:end-angle (/ pi 2) #:label (colorize (kj-fg-mrkp-str->pct "発電の熱の2倍" label-style label-size) heat-to-sea-clr)
#:x-adjust-label -220 #:y-adjust-label 160
p prcs-4 rt-find sea-pct lc-find)]
)
p))
(pict->png-bg stages-linked "stages-linked-labels.png")
発電と温排水のラベルがよくなった
#lang racket
(require pict pict-abbrevs)
(require "../common/pict-procedures.rkt")
(require "../common/orgmode-transforms.rkt")
(define always-needed-fn "inputs-always-needed-table-furi.org")
(define water-amounts-fn "water-amounts-table-furi.org")
(define process-product-waste-fn "process-product-waste-table-furi.org")
;;; Inputs: always needed
(define always-needed-tbl
(org-table-file->rows-list always-needed-fn))
;; always-needed-tbl ; ok!
(define always-needed-hdrs (first always-needed-tbl))
(define always-needed-lst (third always-needed-tbl))
;; (list always-needed-hdrs always-needed-lst) ; ok!
(match-define (list people things power)
(map kj-fg-mrkp-str->pct always-needed-hdrs))
#;(pan-spot-view (hbl-append people things power)) ; ok!
(match-define (list labor nature energy)
(map kj-fg-mrkp-str->pct always-needed-lst))
;; (pan-spot-view (hbl-append 20 labor nature energy)) ; ok!
(define sea-warming-strs (list "140kWh電気分" "$海^うみ$が$受^う$ける" "$七^なな$度^ど$温^あたた$めた" "$温^おん$排^はい$水^すい$"))
(define sea-txt-pct (apply vc-append (map kj-fg-mrkp-str->pct sea-warming-strs)))
(define sea-pct-s (place-in-shape sea-txt-pct filled-ellipse 30 10 "sea green" "aquamarine" 10))
(define-values (s-p-s-w s-p-s-h)
(values (pict-width sea-pct-s) (pict-height sea-pct-s)))
(define sea-pct (scale-to-fit sea-pct-s (* 2 s-p-s-w)(* 2 s-p-s-h)))
;; get 段階 steps ready ...
(define p-p-w-tbl (org-table-file->rows-list process-product-waste-fn))
(define p-p-w-hdrs (first p-p-w-tbl))
(define step-1-lst (third p-p-w-tbl)) ;; (list p-p-w-hdrs step-1-lst) ; ok!
(define step-2-lst (fourth p-p-w-tbl))
(define step-3-lst (fifth p-p-w-tbl))
(name-picts-n-list (list process product waste)
(map kj-fg-mrkp-comma-stack->pct p-p-w-hdrs) p-p-w-parts)
(name-picts-n-list (list s1-prcs s1-prdct s1-waste)
(map kj-fg-mrkp-comma-stack->pct step-1-lst) s1-parts)
(name-picts-n-list (list s2-prcs s2-prdct s2-waste)
(map kj-fg-mrkp-comma-stack->pct step-2-lst) s2-parts)
(name-picts-n-list (list s3-prcs s3-prdct s3-waste)
(map kj-fg-mrkp-comma-stack->pct step-3-lst) s3-parts)
(match-define (list step-4-lst step-5-lst step-6-lst step-7-lst)
(drop p-p-w-tbl 5)) ;; step-7-lst ; ok!
(name-picts-n-list (list s4-prcs s4-prdct s4-waste)
(map kj-fg-mrkp-comma-stack->pct step-4-lst) s4-parts)
(name-picts-n-list (list s5-prcs s5-prdct s5-waste)
(map kj-fg-mrkp-comma-stack->pct step-5-lst) s5-parts)
(name-picts-n-list (list s6-prcs s6-prdct s6-waste)
(map kj-fg-mrkp-comma-stack->pct step-6-lst) s6-parts)
(name-picts-n-list (list s7-prcs s7-prdct s7-waste)
(map kj-fg-mrkp-comma-stack->pct step-7-lst) s7-parts)
;;;; utility for checking markup- and other potential -bugs
(define (check-p-p-w lst) ;; for nuclear-sequence-process-product-waste.rkt
(add-rectangle-background #:radius 0
(table 3 ; ok! ; careful with col-number, col-seps
(flatten (list p-p-w-parts lst))
lbl-superimpose cbl-superimpose 20 10)))
(define steps-table-check
(check-p-p-w (list s1-parts s2-parts s3-parts s4-parts s5-parts s6-parts s7-parts))) ; ok!
(define parts-picts-list (list s1-parts s2-parts s3-parts s4-parts s5-parts s6-parts s7-parts))
;; (map pan-spot-view (map first parts-picts-list)) ; ok!
(define (check-pcts-lst lst) (map pan-spot-view lst))
(define processes-txt-pcts (map first parts-picts-list))
(define products-txt-pcts (map second parts-picts-list))
;; (check-pcts-lst products-txt-pcts)
(define waste-txt-pcts (map third parts-picts-list))
(name-picts-n-list (list processes-blank products-blank waste-blank)
(map make-spacer-blank (list processes-txt-pcts products-txt-pcts waste-txt-pcts)) column-blanks) ;; (map pan-spot-view column-blanks) ;; ok!
(define (make-spaced-blank pct spcr-blnk)
(cc-superimpose spcr-blnk
(inset pct 5 5 5 20)))
(define (make-process-pct txt-pct (spcr-blnk processes-blank))
(define spaced (make-spaced-blank txt-pct spcr-blnk))
(place-in-shape spaced filled-rectangle 10 5 "light gray" "black"))
(name-picts-n-list (list prcs-1 prcs-2 prcs-3 prcs-4 prcs-5 prcs-6 prcs-7)
(map make-process-pct processes-txt-pcts) prcs-pcts)
;; (apply vc-append prcs-pcts) ; ok!!
(define (make-product-pct txt-pct (spcr-blnk products-blank))
(define spaced (make-spaced-blank
(colorize txt-pct "red") spcr-blnk))
(place-in-shape spaced filled-rectangle 10 5 "black" "light gray"))
(name-picts-n-list (list prdt-1 prdt-2 prdt-3 prdt-4 prdt-5 prdt-6 prdt-7)
(map make-product-pct products-txt-pcts) prdt-pcts)
;; (apply vc-append prdt-pcts) ; ok!
(define (make-waste-pct txt-pct (spcr-blnk waste-blank))
(define spaced (make-spaced-blank txt-pct spcr-blnk))
(define-values (p-w p-h) (values (pict-width spaced) (pict-height spaced)))
(cc-superimpose (cloud p-w p-h #:style '(square wide))
spaced))
(name-picts-n-list (list wste-1 wste-2 wste-3 wste-4 wste-5 wste-6 wste-7)
(map make-waste-pct waste-txt-pcts) wste-pcts)
;; (apply vc-append wste-pcts) ; ok!
;; (check-pcts-lst waste-txt-pcts) ; ok!
;; (place-in-shape s1-prcs filled-rectangle) ; ok!
(define always-input-p
(vc-append 5 nature energy labor))
(define always-input-pct
(place-in-shape always-input-p))
; always-input-pct ;; ok!
(match-define (list s1-always-in s2-always-in s3-always-in s4-always-in s5-always-in s6-always-in s7-always-in)
(map launder (make-list 7 always-input-pct)))
(define in-step-gap 50) ;; Spacing gaps
(define (make-step-base inpt prcs prdt wste)
(define process-product (vc-append in-step-gap prcs prdt))
(define with-input (ht-append in-step-gap inpt process-product))
(hc-append in-step-gap with-input wste))
(define bse-1
(make-step-base s1-always-in prcs-1 prdt-1 wste-1))
;;; arrow settings
(define arrw-sze 40)
(define arrw-wdt (/ arrw-sze 2))
;;;; arrow settings above
(define (place-base-arrows inpt prcs prdt wste)
(let* ([p (make-step-base inpt prcs prdt wste)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "green"
p inpt rc-find prcs lc-find)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "gray"
p prcs rc-find wste lc-find)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "crimson"
p prcs cb-find prdt ct-find)]
)
p))
(define stage-1 (place-base-arrows s1-always-in prcs-1 prdt-1 wste-1))
(define stage-2 (place-base-arrows s2-always-in prcs-2 prdt-2 wste-2))
(define stage-3 (place-base-arrows s3-always-in prcs-3 prdt-3 wste-3))
(define stage-4 (place-base-arrows s4-always-in prcs-4 prdt-4 wste-4))
(define stage-5 (place-base-arrows s5-always-in prcs-5 prdt-5 wste-5))
(define stage-6 (place-base-arrows s6-always-in prcs-6 prdt-6 wste-6))
(define stage-7 (place-base-arrows s7-always-in prcs-7 prdt-7 wste-7))
(define stages-lst (list stage-1 stage-2 stage-3 stage-4 stage-5 stage-6 stage-7))
(define stages-v-gap 80) ;; Spacing Gaps
(define stages-5tl (apply vc-append stages-v-gap (take stages-lst 5)))
(define stages-extra (vl-append (* 1.8 stages-v-gap)
sea-pct
(apply vc-append stages-v-gap (drop stages-lst 5))))
#;(apply vc-append stages-v-gap
(flatten (list sea-pct
(drop stages-lst 5))))
(define stages-forked-flow (hb-append stages-5tl stages-extra))
;; (pict->png-bg stages-forked-flow "stages-forked-flow.png")
;; sea-warming
(define (link-origl-stages bse prdct prcss (sze arrw-sze)(wdt arrw-wdt)(clr "red"))
(pin-arrow-line sze #:line-width wdt #:color clr
bse prdct lb-find prcss ct-find))
(define heat-to-elctrc-clr "black")
(define heat-to-sea-clr "firebrick") ;; "orange") ;; "brown")
(define label-style (kanji-style)) ;; "IPA P明朝")
(define label-size (round (* 1.3 (kanji-size))))
(define stages-linked
(let* ([p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "red"
stages-forked-flow prdt-1 lb-find prcs-2 ct-find)]
[p (link-origl-stages p prdt-2 prcs-3)]
[p (link-origl-stages p prdt-3 prcs-4)]
[p (link-origl-stages p prdt-4 prcs-5)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color heat-to-elctrc-clr #:start-angle (/ pi 8) #:end-angle (/ pi -8) #:label (colorize (kj-fg-mrkp-str->pct "電気：70億kWh" label-style label-size) heat-to-elctrc-clr)
#:x-adjust-label 70 #:y-adjust-label -15
p wste-4 lt-find prcs-6 ct-find)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "red"
p wste-4 cb-find prcs-7 lt-find)]
;; Heat to Sea line and label
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color heat-to-sea-clr
;; #:start-angle (/ pi -4) #:end-angle (/ pi 2)
;; #:start-angle (/ pi 5)
#:label (colorize (kj-fg-mrkp-str->pct "発電の熱の2倍" label-style label-size) heat-to-sea-clr)
;; x -220
#:x-adjust-label -460 #:y-adjust-label 60
p prcs-4 rt-find sea-pct cb-find)] ;; lc-find with angles and -220
)
p))
(pict->png-bg stages-linked "stages-linked-labels.png")
温暖化を見る原発の流れ ```` | $過^か$程^てい | $製^せい$品^ひん | $廃^はい$物^ぶつ | |————————————+———————————–+——————————————————————–| | ウラン$鉱^こう$山^ざん | ウラン$鉱^こう$石^せき$：13万トン | $残^ぜん$土^ど$：240万トン | | $製^せい$錬^れん | $天^てん$然^ねん$ウラン：190万トン | $鉱^こう$滓^さい$：13万トン、低レベル$廃^はい$物^ぶつ | | $濃^のう$縮^しゅく・$加^か$工^こう | $濃^のう$縮^しゅく$ウラン：30トン | $劣^れっ$化^か$ウラン：160トン、低レベレル$廃^はい$物^ぶつ | | $原^げん$子^し$炉^ろ | $使^し$用^よう$済^す$み$燃^ねん$料^りょう$：30トン | 70億kWhの電気、$使^し$用^よう$済^す$み$燃^ねん$料^りょう$：30トン 、 $廃^はい$炉^ろ | | $再^さい$処^しょ$理^り | プロトニウム：300kg | 低レベル廃物、$個^こ$化^か$体^たい：30本 | | $工^こう$場^じょう$・$事^じ$務^む$・$家^か$庭^てい$・$学^がっ$校^こう | $空^から$っぽの $消^しょう$費^ひ$者^しゃ | $虚^むな$しい$人^じん$生^せい | | $廃^はい$物^ぶつ$処^しょ$分^ぶん | $永^えい$久^きゅう$の$恐^おそ$れ | $永^えい$久^きゅう$の$地^ち$下^か$水^すい$などの$汚^お$染^せん |
#lang racket (provide (all-defined-out)) ;; should also consult utils-text-files-to-scribble-html in texts/scripts
;; org-mode tables ;; from common-org-input-procedures in racket-picture-showing repo (define (org-line->string-list lne) (filter (lambda (s) (0 . < . (string-length s))) (map string-trim (string-split lne “|”))))
(define (org-table-string->rows-list tbl) (map org-line->string-list (port->lines (open-input-string tbl))))
(define (org-table-file->rows-list fname) (map org-line->string-list (regexp-match* #rx”(?m:^\|.*)” (port->string (open-input-file fname))))) ```
原発の段階流れを考えるための図
#lang racket
(require pict pict-abbrevs)
(require "../common/pict-procedures.rkt")
(require "../common/orgmode-transforms.rkt")
(define always-needed-fn "inputs-always-needed-table-furi.org")
(define water-amounts-fn "water-amounts-table-furi.org")
(define process-product-waste-fn "process-product-waste-table-furi.org")
;;; Inputs: always needed
(define always-needed-tbl
(org-table-file->rows-list always-needed-fn))
;; always-needed-tbl ; ok!
(define always-needed-hdrs (first always-needed-tbl))
(define always-needed-lst (third always-needed-tbl))
;; (list always-needed-hdrs always-needed-lst) ; ok!
(match-define (list people things power)
(map kj-fg-mrkp-str->pct always-needed-hdrs))
#;(pan-spot-view (hbl-append people things power)) ; ok!
(match-define (list labor nature energy)
(map kj-fg-mrkp-str->pct always-needed-lst))
;; (pan-spot-view (hbl-append 20 labor nature energy)) ; ok!
(define sea-warming-strs (list "140kWh電気" "$海^うみ$が$受^う$ける" "$七^なな$度^ど$温^あたた$めた" "$温^おん$排^はい$水^すい$"))
(define sea-txt-pct (apply vc-append (map kj-fg-mrkp-str->pct sea-warming-strs)))
(define sea-pct-s (place-in-shape sea-txt-pct filled-ellipse 30 10 "sea green" "aquamarine" 10))
(define-values (s-p-s-w s-p-s-h)
(values (pict-width sea-pct-s) (pict-height sea-pct-s)))
(define sea-pct (scale-to-fit sea-pct-s (* 2 s-p-s-w)(* 2 s-p-s-h)))
;; get 段階 steps ready ...
(define p-p-w-tbl (org-table-file->rows-list process-product-waste-fn))
(define p-p-w-hdrs (first p-p-w-tbl))
(define step-1-lst (third p-p-w-tbl)) ;; (list p-p-w-hdrs step-1-lst) ; ok!
(define step-2-lst (fourth p-p-w-tbl))
(define step-3-lst (fifth p-p-w-tbl))
(name-picts-n-list (list process product waste)
(map kj-fg-mrkp-str->pct p-p-w-hdrs) p-p-w-parts)
(name-picts-n-list (list s1-prcs s1-prdct s1-waste)
(map kj-fg-mrkp-str->pct step-1-lst) s1-parts)
(name-picts-n-list (list s2-prcs s2-prdct s2-waste)
(map kj-fg-mrkp-str->pct step-2-lst) s2-parts)
(name-picts-n-list (list s3-prcs s3-prdct s3-waste)
(map kj-fg-mrkp-str->pct step-3-lst) s3-parts)
(match-define (list step-4-lst step-5-lst step-6-lst step-7-lst)
(drop p-p-w-tbl 5)) ;; step-7-lst ; ok!
(name-picts-n-list (list s4-prcs s4-prdct s4-waste)
(map kj-fg-mrkp-str->pct step-4-lst) s4-parts)
(name-picts-n-list (list s5-prcs s5-prdct s5-waste)
(map kj-fg-mrkp-str->pct step-5-lst) s5-parts)
(name-picts-n-list (list s6-prcs s6-prdct s6-waste)
(map kj-fg-mrkp-str->pct step-6-lst) s6-parts)
(name-picts-n-list (list s7-prcs s7-prdct s7-waste)
(map kj-fg-mrkp-str->pct step-7-lst) s7-parts)
;;;; utility for checking markup- and other potential -bugs
(define (check-p-p-w lst) ;; for nuclear-sequence-process-product-waste.rkt
(add-rectangle-background #:radius 0
(table 3 ; ok! ; careful with col-number, col-seps
(flatten (list p-p-w-parts lst))
lbl-superimpose cbl-superimpose 20 10)))
(define steps-table-check
(check-p-p-w (list s1-parts s2-parts s3-parts s4-parts s5-parts s6-parts s7-parts))) ; ok!
(define parts-picts-list (list s1-parts s2-parts s3-parts s4-parts s5-parts s6-parts s7-parts))
;; (map pan-spot-view (map first parts-picts-list)) ; ok!
(define (check-pcts-lst lst) (map pan-spot-view lst))
(define processes-txt-pcts (map first parts-picts-list))
(define products-txt-pcts (map second parts-picts-list))
;; (check-pcts-lst products-txt-pcts)
(define waste-txt-pcts (map third parts-picts-list))
(name-picts-n-list (list processes-blank products-blank waste-blank)
(map make-spacer-blank (list processes-txt-pcts products-txt-pcts waste-txt-pcts)) column-blanks) ;; (map pan-spot-view column-blanks) ;; ok!
(define (make-spaced-blank pct spcr-blnk)
(cc-superimpose spcr-blnk
(inset pct 5 5 5 20)))
(define (make-process-pct txt-pct (spcr-blnk processes-blank))
(define spaced (make-spaced-blank txt-pct spcr-blnk))
(place-in-shape spaced filled-rectangle 10 5 "light gray" "black"))
(name-picts-n-list (list prcs-1 prcs-2 prcs-3 prcs-4 prcs-5 prcs-6 prcs-7)
(map make-process-pct processes-txt-pcts) prcs-pcts)
;; (apply vc-append prcs-pcts) ; ok!!
(define (make-product-pct txt-pct (spcr-blnk products-blank))
(define spaced (make-spaced-blank
(colorize txt-pct "red") spcr-blnk))
(place-in-shape spaced filled-rectangle 10 5 "black" "light gray"))
(name-picts-n-list (list prdt-1 prdt-2 prdt-3 prdt-4 prdt-5 prdt-6 prdt-7)
(map make-product-pct products-txt-pcts) prdt-pcts)
;; (apply vc-append prdt-pcts) ; ok!
(define (make-waste-pct txt-pct (spcr-blnk waste-blank))
(define spaced (make-spaced-blank txt-pct spcr-blnk))
(define-values (p-w p-h) (values (pict-width spaced) (pict-height spaced)))
(cc-superimpose (cloud p-w p-h #:style '(square wide))
spaced))
(name-picts-n-list (list wste-1 wste-2 wste-3 wste-4 wste-5 wste-6 wste-7)
(map make-waste-pct waste-txt-pcts) wste-pcts)
;; (apply vc-append wste-pcts) ; ok!
;; (check-pcts-lst waste-txt-pcts) ; ok!
;; (place-in-shape s1-prcs filled-rectangle) ; ok!
(define always-input-p
(vc-append 5 nature energy labor))
(define always-input-pct
(place-in-shape always-input-p))
; always-input-pct ;; ok!
(match-define (list s1-always-in s2-always-in s3-always-in s4-always-in s5-always-in s6-always-in s7-always-in)
(map launder (make-list 7 always-input-pct)))
(define in-step-gap 50) ;; Spacing gaps
(define (make-step-base inpt prcs prdt wste)
(define process-product (vc-append in-step-gap prcs prdt))
(define with-input (ht-append in-step-gap inpt process-product))
(hc-append in-step-gap with-input wste))
(define bse-1
(make-step-base s1-always-in prcs-1 prdt-1 wste-1))
;;; arrow settings
(define arrw-sze 40)
(define arrw-wdt (/ arrw-sze 2))
;;;; arrow settings above
(define (place-base-arrows inpt prcs prdt wste)
(let* ([p (make-step-base inpt prcs prdt wste)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "green"
p inpt rc-find prcs lc-find)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "gray"
p prcs rc-find wste lt-find)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "crimson"
p prcs cb-find prdt ct-find)]
)
p))
(define stage-1 (place-base-arrows s1-always-in prcs-1 prdt-1 wste-1))
(define stage-2 (place-base-arrows s2-always-in prcs-2 prdt-2 wste-2))
(define stage-3 (place-base-arrows s3-always-in prcs-3 prdt-3 wste-3))
(define stage-4 (place-base-arrows s4-always-in prcs-4 prdt-4 wste-4))
(define stage-5 (place-base-arrows s5-always-in prcs-5 prdt-5 wste-5))
(define stage-6 (place-base-arrows s6-always-in prcs-6 prdt-6 wste-6))
(define stage-7 (place-base-arrows s7-always-in prcs-7 prdt-7 wste-7))
(define stages-lst (list stage-1 stage-2 stage-3 stage-4 stage-5 stage-6 stage-7))
(define stages-v-gap 80) ;; Spacing Gaps
(define stages-5tl (apply vc-append stages-v-gap (take stages-lst 5)))
(define stages-extra (vl-append stages-v-gap
sea-pct
(apply vc-append (drop stages-lst 5))))
#;(apply vc-append stages-v-gap
(flatten (list sea-pct
(drop stages-lst 5))))
(define stages-forked-flow (hb-append stages-5tl stages-extra))
;; (pict->png-bg stages-forked-flow "stages-forked-flow.png")
;; sea-warming
(define (link-origl-stages bse prdct prcss (sze arrw-sze)(wdt arrw-wdt)(clr "red"))
(pin-arrow-line sze #:line-width wdt #:color clr
bse prdct lb-find prcss ct-find))
(define stages-linked
(let* ([p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "red"
stages-forked-flow prdt-1 lb-find prcs-2 ct-find)]
[p (link-origl-stages p prdt-2 prcs-3)]
[p (link-origl-stages p prdt-3 prcs-4)]
[p (link-origl-stages p prdt-4 prcs-5)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "black" #:start-angle (/ pi 10) #:end-angle (/ pi -10)
p wste-4 lt-find prcs-6 ct-find)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "red"
p wste-4 cb-find prcs-7 lt-find)]
[p (pin-arrow-line arrw-sze #:line-width arrw-wdt #:color "brown" #:start-angle (/ pi -4) #:end-angle (/ pi 2)
p prcs-4 rt-find sea-pct lc-find)]
)
p))
(pict->png-bg stages-linked "stages-linked.png")