;; ============================================= ;; Script: texture-lab.r ;; downloaded from: www.REBOL.org ;; on: 29-Mar-2024 ;; at: 12:50:01.730907 UTC ;; owner: rebolek [script library member who can ;; update this script] ;; ============================================= REBOL[ Title: "TextureLab - Texture generator" Author: "ReBolek" Email: "rebolek>!a!t!!d!o!t!!a!t!!d!o!t! "png"] [filename: to-file append filename ".png"] save/png filename f-image/image ] ] engines: has [tmp engs][ tmp: copy [] engs: ctx-texture/engines forskip engs 2 [append tmp to string! engs/1] tmp ] get-gui-settings: does [ ctx-texture/prefs: make ctx-texture/prefs [ size: to pair! ~fld-size/text color: ~btn-color/color color2: ~btn-color2/color colorize?: ~chk-colorize/data strength: to integer! ~fld-strength/text engine: to block! ~fld-engine/text pre: to block! ~fld-preeffect/text post: to block! ~fld-posteffect/text tile?: ~chk-tile/data seed: either 1 < length? parse to string! ~fld-seed/text ":" [to time! ~fld-seed/text][to integer! ~fld-seed/text] ] ;ctx-texture/prefs/colorize?: cls ] ] ;------------------------------------------------------------------------------------- ~editor: layout compose/deep [ origin 2x2 style text text white style btn btn 80x25 style h1 h1 250.250.100 backeffect [gradient 0x1 water coal] across space 0 btn "New" [ ~fld-strength/text: "1" ~sld-strength/data: 0 ~fld-preeffect/text: copy "" ~fld-posteffect/text: copy "" ~fld-engine/text: copy "" ~btn-color/color: white ~btn-color/text: 255.255.255 ~btn-color2/color: none ~btn-color2/text: "none" show ~editor ctx-guifunc/show-preview ] btn "Open" [ result: copy [] foreach [name block] ctx-texture/presets [append result to-string name] append result "----" foreach [name block] ctx-texture/user-presets [append result to-string name] value: request-list "Select preset" result if any [none? value value = "----"] [exit] ;ctx-texture/prefs/init ctx-texture/set-preset select append copy ctx-texture/presets ctx-texture/user-presets to-word value f-image/image: texture/no-init none ~fld-strength/text: to-string ctx-texture/prefs/strength ;~sld-strength ~fld-seed/text: to-string ctx-texture/prefs/seed ~chk-tile/data: ctx-texture/prefs/tile? ~btn-color/color: ctx-texture/prefs/color ~btn-color/text: to-string ctx-texture/prefs/color ~btn-color2/color: ctx-texture/prefs/color2 ~btn-color2/text: to-string ctx-texture/prefs/color2 ~fld-preeffect/text: block-to-string ctx-texture/prefs/pre ~fld-posteffect/text: block-to-string ctx-texture/prefs/post ~fld-engine/text: block-to-string ctx-texture/prefs/engine ;show reduce [~fld-strength ~fld-seed ~chk-tile ~btn-color ~btn-color2 ~fld-preeffect ~fld-posteffect ~fld-engine f-image] ;get-gui-settings show ~editor current-preset: ctx-texture/prefs-to-dialect ] btn red "Save" [inform layout [h1 "not yet.."]] btn red "Save As PNG" [ctx-guifunc/save-as-png] bar 3x24 btn yellow "Dialect code" [view/new center-face layout compose [text (to paren! [ctx-guifunc/get-gui-settings mold/only prefs-to-dialect]) as-is font [size: 14 style: 'bold]]] ;ctx-guifunc/get-gui-settings ctx-guifunc/show-preview] box 117x10 btn "Help" [ctx-guifunc/show-help] return bar 600 return panel [ tabs 50 across h1 "Source ------>" return space 0x8 text "Size:" tab ~fld-size: field 70 "100x100" [~fld-size/data: ~fld-size/text if error? try [to pair! ~fld-size/text][use 'tmp [tmp: pick [10 25 50 75 100 150 200 300 400] 1 + to integer! ~sld-size/data * 8 ~fld-size/text: rejoin [tmp "x" tmp]] show ~fld-size] ctx-guifunc/show-preview] ~sld-size: slider 80x24 with [data: 0.5] [ use 'tmp [tmp: pick [10 25 50 75 100 150 200 300 400] 1 + to integer! ~sld-size/data * 8 ~fld-size/text: rejoin [tmp "x" tmp]] show ~fld-size ctx-guifunc/show-preview] return text "Seed:" tab ~fld-seed: field 70 "0" [~fld-seed/data: ~fld-seed/text if error? try [to integer! ~fld-seed/text][~fld-seed/text: random 99999 show ~fld-seed] ctx-guifunc/show-preview] btn "random" [~fld-seed/text: random 99999 show ~fld-seed ctx-guifunc/show-preview] return text "Pre-Effect:" return ~fld-preeffect: field 200x60 wrap [ctx-guifunc/show-preview] ] panel [ tabs 60 across h1 "Engine ------>" return space 0x8 text "Strength:" tab ~fld-strength: field 40 "30" [~fld-strength/data: ~fld-strength/text if error? try [to integer! ~fld-strength/text][~fld-strength/text: 1 + to integer! ~sld-strength/data ** 2 * 99 ~fld-strength/data: ~fld-strength/text show ~fld-strength] ctx-guifunc/show-preview] ~sld-strength: slider 100x24 with [data: 0.55] [~fld-strength/text: 1 + to integer! ~sld-strength/data ** 2 * 99 show ~fld-strength ctx-guifunc/show-preview] return text "Engine:" tab (tmp: [drop-down 140] append tmp ctx-guifunc/engines tmp) [all [not none? value ~fld-engine/text: block-to-string select engines to word! value show ~fld-engine ctx-guifunc/show-preview]] return text "Main-Effect:" return ~fld-engine: field 200x60 wrap "multiply 150.150.150 blur luma -20" [ctx-guifunc/show-preview] ] panel [ across space 0x8 h1 "Post-production" return text "Colors:" 50 ~btn-color: box 75x24 (ctx-texture/prefs/color) (to string! ctx-texture/prefs/color) font-size 10 [~btn-color/color: request-color/color ~btn-color/color ~btn-color/text: to string! ~btn-color/color show ~btn-color ctx-guifunc/show-preview] ~btn-color2: box 75x24 (either none? ctx-texture/prefs/color2 [0.0.0][ctx-texture/prefs/color2]) (to string! ctx-texture/prefs/color2) font-size 10 [~btn-color2/color: request-color/color ~btn-color2/color ~btn-color2/text: to string! ~btn-color2/color show ~btn-color2 ctx-guifunc/show-preview] return ~chk-tile: check-line "tile" on font-color white 40x24 [ctx-guifunc/show-preview] ~chk-colorize: check-line "colorize" font-color white 66x24 [ctx-guifunc/show-preview] ~chk-cache: check-line "disk cache" font-color white 92x24 [either value [cache-type: 'disk if not exists? cache-path [make-dir/deep cache-path]][cache-type: 'memory]] ;~fld-colorize: field 40 "0" [ctx-guifunc/show-preview] return text "Post-Effect:" return ~fld-posteffect: field 200x60 wrap [ctx-guifunc/show-preview] ] return bar 600 return f-image: image 600x200 effect 'tile return ~txt-copy: text "(c)2001-2006 REBolek" ] ctx-guifunc/show-preview view/title/options center-face ~editor "TextureLab" 'resize quit ;view/title center-face editor "TextureX Texture Studio" exit ] ;if no parrameter supplied, runs GUI if none? dialect [dialect: prefs-to-dialect] unless no-init [prefs: make *prefs []] if word? dialect [dialect: select presets dialect if none? dialect [dialect: copy []]] img: cache-get dialect: compose dialect if image? img [return img] set-preset dialect img: make image! either prefs/tile? [prefs/size][prefs/size + 6x6] random/seed prefs/seed if not none? prefs/color2 [set-gradient] repeat i (length? img) [ either none? prefs/color2 [ poke img i random 255.255.255 ;prefs/color ][ poke img i pick gradient random 256 ] ] if prefs/tile? [ img: to image! make face [ edge: none size: img/size * 3 image: img effect: 'tile ] ] img: to image! make face [ image: img size: img/size edge: none effect: copy prefs/pre repeat i prefs/strength [ append effect prefs/engine ] effect ] img: to image! make face [ edge: none size: either prefs/tile? [img/size / 3][img/size - 6x6] effect: either prefs/tile? [compose/deep [draw [image (- img/size / 3) img]]][[draw [image -3x-3 img]]] ] img: to image! make face [ image: img size: img/size edge: none effect: copy [] append effect prefs/post if none? prefs/color2 [append effect compose [grayscale colorize (prefs/color)]] ] if prefs/colorize? [ img1: to image! layout compose/deep [origin 0 image img effect [grayscale colorize (prefs/color)]] img2: to image! layout compose/deep [origin 0 image img effect [grayscale invert colorize (prefs/color2)]] img: to image! layout [origin 0 image img1 effect [add img2]] ] cache-add dialect img img ] select-engine: func [ "Returns engine name or input if engine does not exist" block /local eng ][ either none? eng: find/only engines block [block][first back eng] ] change-engine: func [block][prefs/engine: to-block block f-engine/text: block-to-string block show f-engine] set 'block-to-string func [block ][head trim remove back tail remove mold block ] ;----request texture function set 'request-texture func [/local rt result][ rt: center-face layout compose [ label "Select texture:" ( result: copy [text-list 100x140] foreach [name block] presets [append result to-string name] append/only result [ datas: select presets to-word value unview self result: texture datas ] result ) ] result: none view rt result ] ] texturex: :texture texturex