-- <<<-

-- calif.bmp

-- 125,40	120,40
-- 125,35	120,35

-- http://pubweb.parc.xerox.com:80/map/color=1/features=alltypes
-- /lat=39.3/lon=9.05/ht=20/mark=39.24,9.14

-- http://pubweb.parc.xerox.com/map/color/border=1/nogrid/ht=24/
-- lat=37/lon=-96/mark=39.733333333333334281,-121.63333333333333997,6,9

global theWorld := undefined


global theWorldPage := object (WebPage)
	title: "ScriptX World"
	base: "scriptx:"
	contents
		object (WebMacro)
			func: (self stream props ->
				if (theWorld == undefined) do (
					guard (
						local lc := open LibraryContainer \
										 dir: theStartDir \
										 path: "worldmap.sxl"
						theWorld := lc[1]
					) catching all: caught ok end
				)
				if (theWorld == undefined) do (
					return "Sorry, no world to look at!\r"
				)
				local x := getInt props[@x] 0
				local y := getInt props[@y] (theWorld.bbox.x2 / 2)
				local w := getInt props[@w] 50
				local h := getInt props[@h] 50
				local s := getInt props[@s] 100
				
				if (w < 1) do (w := 1)
				if (h < 1) do (h := 1)
				if (w > 1000) do (w := 1000)
				if (h > 1000) do (h := 1000)

				local cx := floor (w / 2)
				local cy := floor (h / 2)
				
				if (s < 1) do (s := 1)
				if (s > 10000) do (s := 10000)
				local sc := s / 100.0

				local ix := "image.x" as NameClass
				local iy := "image.y" as NameClass
				local dx := getInt props[ix] -1
				local dy := getInt props[iy] -1
				deleteKeyOne props ix
				deleteKeyOne props iy

				if ((dx >= 0) and (dy >= 0)) do (
					dx := (((dx - cx) / theWorld.bbox.x2) * 360.0) / sc
					dy := (((dy - cy) / theWorld.bbox.y2) * -180.0) / sc
					x := x + dx
					y := y + dy
				)

				x := round (mod x 360.0)
				if (y > 180.0) do (y := 180.0)
				if (y < -180.0) do (y := -180.0)
				y := round y
				
				webLog theWebServer "Drawing world ..."

				local box := new Rect x2:w y2:h
				local bms := new BitmapSurface bbox:box colormap:theDefault8Colormap

				local m := new TwoDMatrix
				m.a := sc
				m.d := sc
				m.tx := cx - (x / 360.0 * theWorld.bbox.x2 * sc)
				m.ty := cy - ((90.0 - y) / 180.0 * theWorld.bbox.y2 * sc)

				erase bms (new Brush color: redColor)
				transfer bms (theWorld as BitmapSurface) bms m
				
				-- Make a copy of the map to the left and/or right if 
				-- the left or right edge is in the frame.
				local pt := new Point
				pt.x := 0.0
				transform pt m @mutate
				local left := pt.x
				pt.x := theWorld.bbox.x2
				transform pt m @mutate
				local right := pt.x
				local xx := m.tx
				if ((left >= 0) and (left <= w)) do (
					m.tx := xx - (theWorld.bbox.x2 * sc)
					transfer bms (theWorld as BitmapSurface) bms m
				)
				if ((right >= 0) and (right <= w)) do (
					m.tx := xx + (theWorld.bbox.x2 * sc)
					transfer bms (theWorld as BitmapSurface) bms m
				)

				bms := bms as Bitmap

				local imageDir := theTempDir
				local gifFileName := "worldmap" + ((uniqueID()) as String) + ".gif"
				local gifURL := "file:///" + (imageDir as String) + gifFileName

				webLog theWebServer ("exporting to " + gifURL + " ...")

				if (isFile imageDir gifFileName) do (
					delete imageDir gifFileName
				)
				gifFileName := createFile imageDir gifFileName @binary
				local gifStream := getStream imageDir gifFileName @writable

				exportGif bms gifStream
				plug gifStream

				webLog theWebServer "Done exporting!"

				object (WebForm)
					formMethod: "get"
					action: (anchorProps dialog:"world" x:x y:y w:w h:h s:s)
					contents
						object (WebHiddenValue)
							name: "dialog"
							value: "world"
						end
						"X:"
						object (WebIntInput)
							name: "x"
							value: (x as String)
							size: 4
						end
						"Y:"
						object (WebIntInput)
							name: "y"
							value: (y as String)
							size: 4
						end
						"W:"
						object (WebIntInput)
							name: "w"
							value: (w as String)
							size: 4
						end
						"H:"
						object (WebIntInput)
							name: "h"
							value: (h as String)
							size: 4
						end
						"Scale:"
						object (WebIntInput)
							name: "s"
							value: (s as String)
							size: 4
						end
						object (WebSubmitInput)
							value:"Submit!"
						end
						object (WebHorizontalLine) end
						object (WebImageInput)
							url: gifURL
							name: "image"
						end
						object (WebHorizontalLine) end
						object (WebLink)
							url: (anchorProps dialog:"world" \
									x:x y:y w:w h:h s:(round (s / 2)))
							contents
								"Zoom Out"
						end
						" "
						object (WebLink)
							url: (anchorProps dialog:"world" \
									x:x y:y w:w h:h s:(s * 2))
							contents
								"Zoom In"
						end
				end
			)
		end
end


registerService theWebServer \
	(new WebService \
		 name: "World" \
		 about: "Scroll around the world!" \
		 handler: (service request params -> 
		 			   printHTML theWorldPage (new String) #(
							@dialog: "World",
							@x: "0",
							@y: ((theWorld.bbox.x2 / 2) as String),
							@w: "100",
							@h: "100")))


registerDialog theWebServer \
				(new WebService \
					 name: "World" \
					 handler: (dialog props params -> 
					 	 printHTML theWorldPage (new String) props))


-- >>>