(declare (special max-x min-x max-y min-y size-x size-y max-xf min-xf max-yf min-yf size-xf size-yf scale-x scale-y tty-graphics dsk-graphics $fasldisp) (fixnum x y ox oy) (fixnum filen ptr (fixin) (binfilen) (mfixin) (access fixnum) max-x min-x max-y min-y size-x size-y temp) (flonum max-xf min-xf max-yf min-yf size-xf size-yf scale-x scale-y dist rad) (notype (setpoint fixnum fixnum) (vector fixnum fixnum) ($entergraph) ($screensize fixnum fixnum fixnum fixnum) ($exitgraph))) (declare (eval (read))) (setq ibase 8.) (defun $worldplot (llong hlong llat hlat) (or (get '$plotmode 'mfexpr*s) (loadfile '(tekplt fasl dsk share) t $fasldisp)) (or (get 'directory 'lsubr) (loadfile '(allfiles fasl com) t $fasldisp)) ((lambda (rad dist temp) (setq rad (//$ (atan 0 -1) 180.0) dist (cos (*$ rad (//$ (+$ (float hlat) (float llat)) 2.0))) rad (//$ (float 400000) 180.0) max-xf (*$ (float hlong) rad) min-xf (*$ (float llong) rad) size-xf (-$ max-xf min-xf) max-yf (*$ (float hlat) rad) min-yf (*$ (float llat) rad) size-yf (-$ max-yf min-yf)) (cond (dsk-graphics ($screensize 0. 5. 1023. 790.)) ((eq tty-graphics 'imlac) ($screensize 0. 0. 1023. 1023.)) ((eq tty-graphics 'tek) ($screensize 0. 5. 1023. 789.)) (t ($screensize 0. 0. 1023. 1023.))) (cond ((> (//$ (*$ size-xf dist) (float size-x)) (//$ size-yf (float size-y))) (setq temp (fix (*$ size-yf (float size-x) (//$ (*$ size-xf dist))))) ($screensize min-x (// (- (+ min-y max-y) temp) 2.) max-x (// (+ (+ min-y max-y) temp) 2.))) (t (setq temp (fix (*$ size-xf dist (float size-y) (//$ size-yf)))) ($screensize (// (- (+ min-x max-x) temp) 2.) min-y (// (+ (+ min-x max-x) temp) 2.) max-y)))) 0.0 0.0 0) ($entergraph) (do ((files '(((dsk maxdmp) world geogra) ((dsk maxdmp) world politi)) (cdr files)) (file nil (close file)) (filen)) ((null files) ($exitgraph) '$done) (setq file (open (car files) '(in fixnum))) (setq filen (caddar (directory (list file) '(words)))) (in file) (do nil ((not (> filen (filepos file)))) (do ((first t nil) (x (in file) (in file)) (y 0.) (ox -1.) (oy -1.)) ((< x 0.)) (setq y (lsh x -18.) x (boole 1. x 777777)) (cond ((> x 377777) (setq x (- x 1000000)))) (cond ((> y 177777) (setq y (- y 400000)))) (setq x (+ min-x (fix (+$ 0.5 (//$ (-$ (float x) min-xf) scale-x)))) y (+ min-y (fix (+$ 0.5 (//$ (-$ (float y) min-yf) scale-y))))) (cond ((and (not first) (> (abs (- ox x)) 1000)) (filepos file (1- (filepos file))) (return nil))) (cond (first (setpoint x y)) ((not (and (= x ox) (= y oy))) (vector x y))) (setq ox x oy y))))) (declare (eval (read))) (setq ibase 10.)